Artifact 8717c71756d995bf0b4e1ff6a2fc47da6b67dab8:
- File dashboard-tests.scm — part of check-in [3469edbbf7] at 2011-10-08 20:23:24 on branch trunk — 90% converted to using units (user: matt size: 18327)
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 64 65 63 6c 61 72 65 20 28 75 6e 69 74 ..(declare (unit 0290: 20 64 61 73 68 62 6f 61 72 64 2d 74 65 73 74 73 dashboard-tests 02a0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use 02b0: 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c s common)).(decl 02c0: 61 72 65 20 28 75 73 65 73 20 64 62 29 29 0a 28 are (uses db)).( 02d0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 declare (uses db 02e0: 6f 61 72 64 29 29 0a 0a 28 69 6e 63 6c 75 64 65 oard))..(include 02f0: 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 "common_records 0300: 2e 73 63 6d 22 29 0a 0a 28 64 65 66 69 6e 65 20 .scm")..(define 0310: 28 74 65 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 6c (test-info-panel 0320: 20 74 65 73 74 64 61 74 20 73 74 6f 72 65 2d 6c testdat store-l 0330: 61 62 65 6c 20 77 69 64 67 65 74 73 29 0a 20 20 abel widgets). 0340: 28 69 75 70 3a 66 72 61 6d 65 20 0a 20 20 20 23 (iup:frame . # 0350: 3a 74 69 74 6c 65 20 22 54 65 73 74 20 49 6e 66 :title "Test Inf 0360: 6f 22 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 o" ; #:expand "Y 0370: 45 53 22 0a 20 20 20 28 69 75 70 3a 68 62 6f 78 ES". (iup:hbox 0380: 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 ; #:expand "YES 0390: 22 0a 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 ". (apply iup 03a0: 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 :vbox ; #:expand 03b0: 20 22 59 45 53 22 0a 09 20 20 20 28 61 70 70 65 "YES".. (appe 03c0: 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 nd (map (lambda 03d0: 28 76 61 6c 29 0a 09 09 09 20 20 28 69 75 70 3a (val).... (iup: 03e0: 6c 61 62 65 6c 20 76 61 6c 20 3b 20 23 3a 65 78 label val ; #:ex 03f0: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL 0400: 22 0a 09 09 09 09 20 20 20 20 20 29 29 0a 09 09 "..... ))... 0410: 09 28 6c 69 73 74 20 22 54 65 73 74 6e 61 6d 65 .(list "Testname 0420: 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 49 74 : ".... "It 0430: 65 6d 20 70 61 74 68 3a 20 22 0a 09 09 09 20 20 em path: ".... 0440: 20 20 20 20 22 43 75 72 72 65 6e 74 20 73 74 61 "Current sta 0450: 74 65 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 te: ".... " 0460: 43 75 72 72 65 6e 74 20 73 74 61 74 75 73 3a 20 Current status: 0470: 22 0a 09 09 09 20 20 20 20 20 20 22 54 65 73 74 ".... "Test 0480: 20 63 6f 6d 6d 65 6e 74 3a 20 22 0a 09 09 09 20 comment: ".... 0490: 20 20 20 20 20 22 54 65 73 74 20 69 64 3a 20 22 "Test id: " 04a0: 29 29 0a 09 09 20 20 20 28 6c 69 73 74 20 28 69 ))... (list (i 04b0: 75 70 3a 6c 61 62 65 6c 20 22 22 20 23 3a 65 78 up:label "" #:ex 04c0: 70 61 6e 64 20 22 56 45 52 54 49 43 41 4c 22 29 pand "VERTICAL") 04d0: 29 29 29 0a 20 20 20 20 28 61 70 70 6c 79 20 69 ))). (apply i 04e0: 75 70 3a 76 62 6f 78 20 20 3b 20 23 3a 65 78 70 up:vbox ; #:exp 04f0: 61 6e 64 20 22 59 45 53 22 0a 09 20 20 20 28 6c and "YES".. (l 0500: 69 73 74 20 0a 09 20 20 20 20 28 73 74 6f 72 65 ist .. (store 0510: 2d 6c 61 62 65 6c 20 22 74 65 73 74 6e 61 6d 65 -label "testname 0520: 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c ".... (iup:label 0530: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 (db:test-get-te 0540: 73 74 6e 61 6d 65 20 20 74 65 73 74 64 61 74 29 stname testdat) 0550: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ 0560: 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d ONTAL").... (lam 0570: 62 64 61 20 28 74 65 73 74 64 61 74 29 28 64 62 bda (testdat)(db 0580: 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 :test-get-testna 0590: 6d 65 20 74 65 73 74 64 61 74 29 29 29 0a 09 20 me testdat))).. 05a0: 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 (store-label 05b0: 22 69 74 65 6d 2d 70 61 74 68 22 0a 09 09 09 20 "item-path".... 05c0: 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 (iup:label (db:t 05d0: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat 05e0: 68 20 74 65 73 74 64 61 74 29 20 23 3a 65 78 70 h testdat) #:exp 05f0: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL" 0600: 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 ).... (lambda (t 0610: 65 73 74 64 61 74 29 28 64 62 3a 74 65 73 74 2d estdat)(db:test- 0620: 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 get-item-path te 0630: 73 74 64 61 74 29 29 29 0a 09 20 20 20 20 28 73 stdat))).. (s 0640: 74 6f 72 65 2d 6c 61 62 65 6c 20 22 74 65 73 74 tore-label "test 0650: 73 74 61 74 65 22 20 0a 09 09 09 20 28 69 75 70 state" .... (iup 0660: 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 74 2d :label (db:test- 0670: 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 64 61 get-state testda 0680: 74 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 t) #:expand "HOR 0690: 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c IZONTAL").... (l 06a0: 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 0a ambda (testdat). 06b0: 09 09 09 20 20 20 28 64 62 3a 74 65 73 74 2d 67 ... (db:test-g 06c0: 65 74 2d 73 74 61 74 65 20 74 65 73 74 64 61 74 et-state testdat 06d0: 29 29 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 ))).. (let (( 06e0: 6c 62 6c 20 20 20 28 69 75 70 3a 6c 61 62 65 6c lbl (iup:label 06f0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st 0700: 61 74 75 73 20 74 65 73 74 64 61 74 29 20 23 3a atus testdat) #: 0710: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT 0720: 41 4c 22 29 29 29 0a 09 20 20 20 20 20 20 28 68 AL"))).. (h 0730: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 77 ash-table-set! w 0740: 69 64 67 65 74 73 20 22 74 65 73 74 73 74 61 74 idgets "teststat 0750: 75 73 22 0a 09 09 09 20 20 20 20 20 20 20 28 6c us".... (l 0760: 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 0a ambda (testdat). 0770: 09 09 09 09 20 28 6c 65 74 20 28 28 6e 65 77 73 .... (let ((news 0780: 74 61 74 75 73 20 28 64 62 3a 74 65 73 74 2d 67 tatus (db:test-g 0790: 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 64 61 et-status testda 07a0: 74 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 t))..... ( 07b0: 6f 6c 64 73 74 61 74 75 73 20 28 69 75 70 3a 61 oldstatus (iup:a 07c0: 74 74 72 69 62 75 74 65 20 6c 62 6c 20 22 54 49 ttribute lbl "TI 07d0: 54 4c 45 22 29 29 29 0a 09 09 09 09 20 20 20 28 TLE")))..... ( 07e0: 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 if (not (equal? 07f0: 6f 6c 64 73 74 61 74 75 73 20 6e 65 77 73 74 61 oldstatus newsta 0800: 74 75 73 29 29 0a 09 09 09 09 20 20 20 20 20 20 tus))..... 0810: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 28 69 (begin...... (i 0820: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set 0830: 21 20 6c 62 6c 20 22 46 47 43 4f 4c 4f 52 22 20 ! lbl "FGCOLOR" 0840: 28 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 (get-color-for-s 0850: 74 61 74 65 2d 73 74 61 74 75 73 20 28 64 62 3a tate-status (db: 0860: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t 0870: 65 73 74 64 61 74 29 0a 09 09 09 09 09 09 09 09 estdat)......... 0880: 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a 74 .... (db:t 0890: 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 est-get-status t 08a0: 65 73 74 64 61 74 29 29 29 0a 09 09 09 09 09 20 estdat)))...... 08b0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s 08c0: 65 74 21 20 6c 62 6c 20 22 54 49 54 4c 45 22 20 et! lbl "TITLE" 08d0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta 08e0: 74 75 73 20 74 65 73 74 64 61 74 29 29 29 29 29 tus testdat))))) 08f0: 29 29 0a 09 20 20 20 20 20 20 6c 62 6c 29 0a 09 )).. lbl).. 0900: 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c (store-label 0910: 20 22 74 65 73 74 63 6f 6d 6d 65 6e 74 22 0a 09 "testcomment".. 0920: 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 54 .. (iup:label "T 0930: 65 73 74 43 6f 6d 6d 65 6e 74 20 20 20 20 20 20 estComment 0940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0950: 20 20 20 20 20 20 20 22 0a 09 09 09 09 20 20 20 "..... 0960: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ 0970: 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d ONTAL").... (lam 0980: 62 64 61 20 28 74 65 73 74 64 61 74 29 0a 09 09 bda (testdat)... 0990: 09 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 . (db:test-get 09a0: 2d 63 6f 6d 6d 65 6e 74 20 74 65 73 74 64 61 74 -comment testdat 09b0: 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d ))).. (store- 09c0: 6c 61 62 65 6c 20 22 74 65 73 74 69 64 22 0a 09 label "testid".. 09d0: 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 54 .. (iup:label "T 09e0: 65 73 74 49 64 20 20 20 20 20 20 20 20 20 20 20 estId 09f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a00: 20 20 22 0a 09 09 09 09 20 20 20 20 23 3a 65 78 "..... #:ex 0a10: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL 0a20: 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 ").... (lambda ( 0a30: 74 65 73 74 64 61 74 29 0a 09 09 09 20 20 20 28 testdat).... ( 0a40: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 db:test-get-id t 0a50: 65 73 74 64 61 74 29 29 29 0a 09 20 20 20 20 29 estdat))).. ) 0a60: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;======== 0a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.; 0ab0: 3b 20 54 65 73 74 20 6d 65 74 61 20 70 61 6e 65 ; Test meta pane 0ac0: 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d l.;;============ 0ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 66 69 ==========.(defi 0b10: 6e 65 20 28 74 65 73 74 2d 6d 65 74 61 2d 70 61 ne (test-meta-pa 0b20: 6e 65 6c 20 74 65 73 74 6d 65 74 61 20 73 74 6f nel testmeta sto 0b30: 72 65 2d 6d 65 74 61 29 0a 20 20 28 69 75 70 3a re-meta). (iup: 0b40: 66 72 61 6d 65 20 0a 20 20 20 23 3a 74 69 74 6c frame . #:titl 0b50: 65 20 22 54 65 73 74 20 4d 65 74 61 20 44 61 74 e "Test Meta Dat 0b60: 61 22 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 a" ; #:expand "Y 0b70: 45 53 22 0a 20 20 20 28 69 75 70 3a 68 62 6f 78 ES". (iup:hbox 0b80: 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 ; #:expand "YES 0b90: 22 0a 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 ". (apply iup 0ba0: 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 :vbox ; #:expand 0bb0: 20 22 59 45 53 22 0a 09 20 20 20 28 61 70 70 65 "YES".. (appe 0bc0: 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 nd (map (lambda 0bd0: 28 76 61 6c 29 0a 09 09 09 20 20 28 69 75 70 3a (val).... (iup: 0be0: 6c 61 62 65 6c 20 76 61 6c 20 3b 20 23 3a 65 78 label val ; #:ex 0bf0: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL 0c00: 22 0a 09 09 09 09 20 20 20 20 20 29 29 0a 09 09 "..... ))... 0c10: 09 28 6c 69 73 74 20 22 41 75 74 68 6f 72 3a 20 .(list "Author: 0c20: 22 0a 09 09 09 20 20 20 20 20 20 22 4f 77 6e 65 ".... "Owne 0c30: 72 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 52 r: ".... "R 0c40: 65 76 69 65 77 65 64 3a 20 22 0a 09 09 09 20 20 eviewed: ".... 0c50: 20 20 20 20 22 54 61 67 73 3a 20 22 0a 09 09 09 "Tags: ".... 0c60: 20 20 20 20 20 20 22 44 65 73 63 72 69 70 74 69 "Descripti 0c70: 6f 6e 3a 20 22 0a 09 09 09 20 20 20 20 20 20 29 on: ".... ) 0c80: 29 0a 09 09 20 20 20 28 6c 69 73 74 20 28 69 75 )... (list (iu 0c90: 70 3a 6c 61 62 65 6c 20 22 22 20 23 3a 65 78 70 p:label "" #:exp 0ca0: 61 6e 64 20 22 56 45 52 54 49 43 41 4c 22 29 29 and "VERTICAL")) 0cb0: 29 29 0a 20 20 20 20 28 61 70 70 6c 79 20 69 75 )). (apply iu 0cc0: 70 3a 76 62 6f 78 20 20 3b 20 23 3a 65 78 70 61 p:vbox ; #:expa 0cd0: 6e 64 20 22 59 45 53 22 0a 09 20 20 20 28 6c 69 nd "YES".. (li 0ce0: 73 74 20 0a 09 20 20 20 20 28 73 74 6f 72 65 2d st .. (store- 0cf0: 6d 65 74 61 20 22 61 75 74 68 6f 72 22 0a 09 09 meta "author"... 0d00: 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 62 . (iup:label (db 0d10: 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 61 75 :testmeta-get-au 0d20: 74 68 6f 72 20 74 65 73 74 6d 65 74 61 29 20 23 thor testmeta) # 0d30: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON 0d40: 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 TAL").... (lambd 0d50: 61 20 28 74 65 73 74 6d 65 74 61 29 28 64 62 3a a (testmeta)(db: 0d60: 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 61 75 74 testmeta-get-aut 0d70: 68 6f 72 20 74 65 73 74 6d 65 74 61 29 29 29 0a hor testmeta))). 0d80: 09 20 20 20 20 28 73 74 6f 72 65 2d 6d 65 74 61 . (store-meta 0d90: 20 22 6f 77 6e 65 72 22 0a 09 09 09 20 28 69 75 "owner".... (iu 0da0: 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 74 p:label (db:test 0db0: 6d 65 74 61 2d 67 65 74 2d 6f 77 6e 65 72 20 74 meta-get-owner t 0dc0: 65 73 74 6d 65 74 61 29 20 23 3a 65 78 70 61 6e estmeta) #:expan 0dd0: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a d "HORIZONTAL"). 0de0: 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 ... (lambda (tes 0df0: 74 6d 65 74 61 29 28 64 62 3a 74 65 73 74 6d 65 tmeta)(db:testme 0e00: 74 61 2d 67 65 74 2d 6f 77 6e 65 72 20 74 65 73 ta-get-owner tes 0e10: 74 6d 65 74 61 29 29 29 0a 09 20 20 20 20 28 73 tmeta))).. (s 0e20: 74 6f 72 65 2d 6d 65 74 61 20 22 72 65 76 69 65 tore-meta "revie 0e30: 77 65 64 22 20 0a 09 09 09 20 28 69 75 70 3a 6c wed" .... (iup:l 0e40: 61 62 65 6c 20 28 64 62 3a 74 65 73 74 6d 65 74 abel (db:testmet 0e50: 61 2d 67 65 74 2d 72 65 76 69 65 77 65 64 20 74 a-get-reviewed t 0e60: 65 73 74 6d 65 74 61 29 20 23 3a 65 78 70 61 6e estmeta) #:expan 0e70: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a d "HORIZONTAL"). 0e80: 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 ... (lambda (tes 0e90: 74 6d 65 74 61 29 28 64 62 3a 74 65 73 74 6d 65 tmeta)(db:testme 0ea0: 74 61 2d 67 65 74 2d 72 65 76 69 65 77 65 64 20 ta-get-reviewed 0eb0: 74 65 73 74 6d 65 74 61 29 29 29 0a 09 20 20 20 testmeta))).. 0ec0: 20 28 73 74 6f 72 65 2d 6d 65 74 61 20 22 74 61 (store-meta "ta 0ed0: 67 73 22 20 0a 09 09 09 20 28 69 75 70 3a 6c 61 gs" .... (iup:la 0ee0: 62 65 6c 20 28 64 62 3a 74 65 73 74 6d 65 74 61 bel (db:testmeta 0ef0: 2d 67 65 74 2d 74 61 67 73 20 74 65 73 74 6d 65 -get-tags testme 0f00: 74 61 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f ta) #:expand "HO 0f10: 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 RIZONTAL").... ( 0f20: 6c 61 6d 62 64 61 20 28 74 65 73 74 6d 65 74 61 lambda (testmeta 0f30: 29 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 )(db:testmeta-ge 0f40: 74 2d 74 61 67 73 20 74 65 73 74 6d 65 74 61 29 t-tags testmeta) 0f50: 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6d )).. (store-m 0f60: 65 74 61 20 22 64 65 73 63 72 69 70 74 69 6f 6e eta "description 0f70: 22 20 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 " .... (iup:labe 0f80: 6c 20 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 l (db:testmeta-g 0f90: 65 74 2d 64 65 73 63 72 69 70 74 69 6f 6e 20 74 et-description t 0fa0: 65 73 74 6d 65 74 61 29 20 23 3a 65 78 70 61 6e estmeta) #:expan 0fb0: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a d "HORIZONTAL"). 0fc0: 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 ... (lambda (tes 0fd0: 74 6d 65 74 61 29 28 64 62 3a 74 65 73 74 6d 65 tmeta)(db:testme 0fe0: 74 61 2d 67 65 74 2d 64 65 73 63 72 69 70 74 69 ta-get-descripti 0ff0: 6f 6e 20 74 65 73 74 6d 65 74 61 29 29 29 0a 09 on testmeta))).. 1000: 20 20 20 20 29 29 29 29 29 0a 0a 0a 3b 3b 3d 3d )))))...;;== 1010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1050: 3d 3d 3d 3d 0a 3b 3b 20 52 75 6e 20 69 6e 66 6f ====.;; Run info 1060: 20 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d panel.;;======= 1070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 10a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============. 10b0: 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 69 6e 66 (define (run-inf 10c0: 6f 2d 70 61 6e 65 6c 20 6b 65 79 64 61 74 20 74 o-panel keydat t 10d0: 65 73 74 64 61 74 20 72 75 6e 6e 61 6d 65 29 0a estdat runname). 10e0: 20 20 28 69 75 70 3a 66 72 61 6d 65 20 0a 20 20 (iup:frame . 10f0: 20 23 3a 74 69 74 6c 65 20 22 4d 65 67 61 74 65 #:title "Megate 1100: 73 74 20 52 75 6e 20 49 6e 66 6f 22 20 3b 20 23 st Run Info" ; # 1110: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 20 :expand "YES". 1120: 20 28 69 75 70 3a 68 62 6f 78 20 3b 20 23 3a 65 (iup:hbox ; #:e 1130: 78 70 61 6e 64 20 22 59 45 53 22 0a 20 20 20 20 xpand "YES". 1140: 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 (apply iup:vbox 1150: 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 ; #:expand "YES" 1160: 0a 09 20 20 20 28 61 70 70 65 6e 64 20 28 6d 61 .. (append (ma 1170: 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 76 61 p (lambda (keyva 1180: 6c 29 0a 09 09 09 20 20 28 69 75 70 3a 6c 61 62 l).... (iup:lab 1190: 65 6c 20 28 63 6f 6e 63 20 28 63 61 72 20 6b 65 el (conc (car ke 11a0: 79 76 61 6c 29 20 22 20 22 29 20 3b 20 23 3a 65 yval) " ") ; #:e 11b0: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA 11c0: 4c 22 0a 09 09 09 09 20 20 20 20 20 29 29 0a 09 L"..... )).. 11d0: 09 09 6b 65 79 64 61 74 29 0a 09 09 20 20 20 28 ..keydat)... ( 11e0: 6c 69 73 74 20 28 69 75 70 3a 6c 61 62 65 6c 20 list (iup:label 11f0: 22 72 75 6e 6e 61 6d 65 20 22 29 29 29 29 0a 20 "runname ")))). 1200: 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 (apply iup:vb 1210: 6f 78 0a 09 20 20 20 28 61 70 70 65 6e 64 20 28 ox.. (append ( 1220: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 map (lambda (key 1230: 76 61 6c 29 0a 09 09 09 20 20 28 69 75 70 3a 6c val).... (iup:l 1240: 61 62 65 6c 20 28 63 61 64 72 20 6b 65 79 76 61 abel (cadr keyva 1250: 6c 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 l) #:expand "HOR 1260: 49 5a 4f 4e 54 41 4c 22 29 29 0a 09 09 09 6b 65 IZONTAL"))....ke 1270: 79 64 61 74 29 0a 09 09 20 20 20 28 6c 69 73 74 ydat)... (list 1280: 20 28 69 75 70 3a 6c 61 62 65 6c 20 72 75 6e 6e (iup:label runn 1290: 61 6d 65 29 28 69 75 70 3a 6c 61 62 65 6c 20 22 ame)(iup:label " 12a0: 22 20 23 3a 65 78 70 61 6e 64 20 22 56 45 52 54 " #:expand "VERT 12b0: 49 43 41 4c 22 29 29 29 29 29 29 29 0a 20 20 0a ICAL"))))))). . 12c0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============== 12d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 12e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 12f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1300: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 48 6f 73 74 ========.;; Host 1310: 20 69 6e 66 6f 20 70 61 6e 65 6c 0a 3b 3b 3d 3d info panel.;;== 1320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1360: 3d 3d 3d 3d 0a 28 64 65 66 69 6e 65 20 28 68 6f ====.(define (ho 1370: 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 6c 20 74 65 st-info-panel te 1380: 73 74 64 61 74 20 73 74 6f 72 65 2d 6c 61 62 65 stdat store-labe 1390: 6c 29 0a 20 20 28 69 75 70 3a 66 72 61 6d 65 0a l). (iup:frame. 13a0: 20 20 20 23 3a 74 69 74 6c 65 20 22 52 65 6d 6f #:title "Remo 13b0: 74 65 20 68 6f 73 74 20 61 6e 64 20 54 65 73 74 te host and Test 13c0: 20 52 75 6e 20 49 6e 66 6f 22 20 3b 20 23 3a 65 Run Info" ; #:e 13d0: 78 70 61 6e 64 20 22 59 45 53 22 0a 20 20 20 28 xpand "YES". ( 13e0: 69 75 70 3a 68 62 6f 78 20 3b 20 23 3a 65 78 70 iup:hbox ; #:exp 13f0: 61 6e 64 20 22 59 45 53 22 0a 20 20 20 20 28 61 and "YES". (a 1400: 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 3b 20 pply iup:vbox ; 1410: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 20 3b #:expand "YES" ; 1420: 3b 20 54 68 65 20 68 65 61 64 69 6e 67 20 6c 61 ; The heading la 1430: 62 65 6c 73 0a 09 20 20 20 28 61 70 70 65 6e 64 bels.. (append 1440: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 76 (map (lambda (v 1450: 61 6c 29 0a 09 09 09 20 20 28 69 75 70 3a 6c 61 al).... (iup:la 1460: 62 65 6c 20 76 61 6c 20 3b 20 23 3a 65 78 70 61 bel val ; #:expa 1470: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a nd "HORIZONTAL". 1480: 09 09 09 09 20 20 20 20 20 29 29 0a 09 09 09 28 .... ))....( 1490: 6c 69 73 74 20 22 48 6f 73 74 6e 61 6d 65 3a 20 list "Hostname: 14a0: 22 0a 09 09 09 20 20 20 20 20 20 22 55 6e 61 6d ".... "Unam 14b0: 65 20 2d 61 3a 20 22 0a 09 09 09 20 20 20 20 20 e -a: ".... 14c0: 20 22 44 69 73 6b 20 66 72 65 65 3a 20 22 0a 09 "Disk free: ".. 14d0: 09 09 20 20 20 20 20 20 22 43 50 55 20 4c 6f 61 .. "CPU Loa 14e0: 64 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 52 d: ".... "R 14f0: 75 6e 20 64 75 72 61 74 69 6f 6e 3a 20 22 0a 09 un duration: ".. 1500: 09 09 20 20 20 20 20 20 22 4c 6f 67 66 69 6c 65 .. "Logfile 1510: 3a 20 22 29 29 0a 09 09 20 20 20 28 69 75 70 3a : "))... (iup: 1520: 6c 61 62 65 6c 20 22 22 20 23 3a 65 78 70 61 6e label "" #:expan 1530: 64 20 22 56 45 52 54 49 43 41 4c 22 29 29 29 0a d "VERTICAL"))). 1540: 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 (apply iup:v 1550: 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 box ; #:expand " 1560: 59 45 53 22 0a 09 20 20 20 28 6c 69 73 74 0a 09 YES".. (list.. 1570: 20 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 59 65 73 ;; NOTE: Yes 1580: 2c 20 74 68 65 20 68 6f 73 74 20 63 61 6e 20 63 , the host can c 1590: 68 61 6e 67 65 21 0a 09 20 20 20 20 28 73 74 6f hange!.. (sto 15a0: 72 65 2d 6c 61 62 65 6c 20 22 48 6f 73 74 4e 61 re-label "HostNa 15b0: 6d 65 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 me".... (iup:lab 15c0: 65 6c 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d el (db:test-get- 15d0: 68 6f 73 74 20 74 65 73 74 64 61 74 29 20 23 3a host testdat) #: 15e0: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT 15f0: 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 AL").... (lambda 1600: 20 28 74 65 73 74 64 61 74 29 28 64 62 3a 74 65 (testdat)(db:te 1610: 73 74 2d 67 65 74 2d 68 6f 73 74 20 74 65 73 74 st-get-host test 1620: 64 61 74 29 29 29 0a 09 20 20 20 20 28 73 74 6f dat))).. (sto 1630: 72 65 2d 6c 61 62 65 6c 20 22 55 6e 61 6d 65 22 re-label "Uname" 1640: 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 .... (iup:label 1650: 22 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 " 1660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1680: 20 20 20 20 22 20 23 3a 65 78 70 61 6e 64 20 22 " #:expand " 1690: 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 HORIZONTAL").... 16a0: 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 (lambda (testda 16b0: 74 29 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 75 t)(db:test-get-u 16c0: 6e 61 6d 65 20 74 65 73 74 64 61 74 29 29 29 0a name testdat))). 16d0: 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 . (store-labe 16e0: 6c 20 22 44 69 73 6b 46 72 65 65 22 0a 09 09 09 l "DiskFree".... 16f0: 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e (iup:label (con 1700: 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 64 c (db:test-get-d 1710: 69 73 6b 66 72 65 65 20 74 65 73 74 64 61 74 29 iskfree testdat) 1720: 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ) #:expand "HORI 1730: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la 1740: 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 28 63 mbda (testdat)(c 1750: 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 onc (db:test-get 1760: 2d 64 69 73 6b 66 72 65 65 20 74 65 73 74 64 61 -diskfree testda 1770: 74 29 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 t)))).. (stor 1780: 65 2d 6c 61 62 65 6c 20 22 43 50 55 4c 6f 61 64 e-label "CPULoad 1790: 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c ".... (iup:label 17a0: 20 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d (conc (db:test- 17b0: 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 73 74 get-cpuload test 17c0: 64 61 74 29 29 20 23 3a 65 78 70 61 6e 64 20 22 dat)) #:expand " 17d0: 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 HORIZONTAL").... 17e0: 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 (lambda (testda 17f0: 74 29 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 t)(conc (db:test 1800: 2d 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 73 -get-cpuload tes 1810: 74 64 61 74 29 29 29 29 0a 09 20 20 20 20 28 73 tdat)))).. (s 1820: 74 6f 72 65 2d 6c 61 62 65 6c 20 22 52 75 6e 44 tore-label "RunD 1830: 75 72 61 74 69 6f 6e 22 0a 09 09 09 20 28 69 75 uration".... (iu 1840: 70 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 20 28 73 p:label (conc (s 1850: 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e 2d 73 econds->hr-min-s 1860: 65 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ec (db:test-get- 1870: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 run_duration tes 1880: 74 64 61 74 29 29 29 20 23 3a 65 78 70 61 6e 64 tdat))) #:expand 1890: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 "HORIZONTAL").. 18a0: 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 .. (lambda (test 18b0: 64 61 74 29 28 63 6f 6e 63 20 28 73 65 63 6f 6e dat)(conc (secon 18c0: 64 73 2d 3e 68 72 2d 6d 69 6e 2d 73 65 63 20 28 ds->hr-min-sec ( 18d0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f db:test-get-run_ 18e0: 64 75 72 61 74 69 6f 6e 20 74 65 73 74 64 61 74 duration testdat 18f0: 29 29 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 ))))).. (stor 1900: 65 2d 6c 61 62 65 6c 20 22 43 50 55 4c 6f 61 64 e-label "CPULoad 1910: 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c ".... (iup:label 1920: 20 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d (conc (db:test- 1930: 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 get-final_logf t 1940: 65 73 74 64 61 74 29 29 20 23 3a 65 78 70 61 6e estdat)) #:expan 1950: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a d "HORIZONTAL"). 1960: 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 ... (lambda (tes 1970: 74 64 61 74 29 28 63 6f 6e 63 20 28 64 62 3a 74 tdat)(conc (db:t 1980: 65 73 74 2d 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f est-get-final_lo 1990: 67 66 20 74 65 73 74 64 61 74 29 29 29 29 29 29 gf testdat)))))) 19a0: 29 29 29 0a 0a 3b 3b 20 75 73 65 20 61 20 67 6c )))..;; use a gl 19b0: 6f 62 61 6c 20 66 6f 72 20 73 65 74 74 69 6e 67 obal for setting 19c0: 20 74 68 65 20 62 75 74 74 6f 6e 73 20 63 6f 6c the buttons col 19d0: 6f 72 73 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 ors.;; 19e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 19f0: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 74 65 state status te 1a00: 73 74 73 74 65 70 73 0a 28 64 65 66 69 6e 65 20 ststeps.(define 1a10: 2a 73 74 61 74 65 2d 73 74 61 74 75 73 2a 20 28 *state-status* ( 1a20: 76 65 63 74 6f 72 20 23 66 20 23 66 20 23 66 29 vector #f #f #f) 1a30: 29 0a 28 64 65 66 69 6e 65 20 28 75 70 64 61 74 ).(define (updat 1a40: 65 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 e-state-status-b 1a50: 75 74 74 6f 6e 73 20 74 65 73 74 64 61 74 29 0a uttons testdat). 1a60: 20 20 28 6c 65 74 2a 20 28 28 73 74 61 74 65 20 (let* ((state 1a70: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st 1a80: 61 74 65 20 20 74 65 73 74 64 61 74 29 29 0a 09 ate testdat)).. 1a90: 20 28 73 74 61 74 75 73 20 28 64 62 3a 74 65 73 (status (db:tes 1aa0: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t-get-status tes 1ab0: 74 64 61 74 29 29 0a 09 20 28 63 6f 6c 6f 72 20 tdat)).. (color 1ac0: 20 28 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d (get-color-for- 1ad0: 73 74 61 74 65 2d 73 74 61 74 75 73 20 73 74 61 state-status sta 1ae0: 74 65 20 73 74 61 74 75 73 29 29 29 0a 20 20 20 te status))). 1af0: 20 28 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 73 ((vector-ref *s 1b00: 74 61 74 65 2d 73 74 61 74 75 73 2a 20 30 29 20 tate-status* 0) 1b10: 73 74 61 74 65 20 63 6f 6c 6f 72 29 0a 20 20 20 state color). 1b20: 20 28 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 73 ((vector-ref *s 1b30: 74 61 74 65 2d 73 74 61 74 75 73 2a 20 31 29 20 tate-status* 1) 1b40: 73 74 61 74 75 73 20 63 6f 6c 6f 72 29 29 29 0a status color))). 1b50: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;============= 1b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 65 74 =========.;; Set 1ba0: 20 66 69 65 6c 64 73 20 0a 3b 3b 3d 3d 3d 3d 3d fields .;;===== 1bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1bf0: 3d 0a 28 64 65 66 69 6e 65 20 28 73 65 74 2d 66 =.(define (set-f 1c00: 69 65 6c 64 73 2d 70 61 6e 65 6c 20 74 65 73 74 ields-panel test 1c10: 2d 69 64 20 74 65 73 74 64 61 74 29 0a 20 20 28 -id testdat). ( 1c20: 6c 65 74 20 28 28 6e 65 77 63 6f 6d 6d 65 6e 74 let ((newcomment 1c30: 20 23 66 29 0a 09 28 6e 65 77 73 74 61 74 75 73 #f)..(newstatus 1c40: 20 20 23 66 29 0a 09 28 6e 65 77 73 74 61 74 65 #f)..(newstate 1c50: 20 20 20 23 66 29 29 0a 20 20 20 20 28 69 75 70 #f)). (iup 1c60: 3a 66 72 61 6d 65 0a 20 20 20 20 20 23 3a 74 69 :frame. #:ti 1c70: 74 6c 65 20 22 53 65 74 20 66 69 65 6c 64 73 22 tle "Set fields" 1c80: 0a 20 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a . (iup:vbox. 1c90: 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 20 (iup:hbox 1ca0: 28 69 75 70 3a 6c 61 62 65 6c 20 22 43 6f 6d 6d (iup:label "Comm 1cb0: 65 6e 74 3a 22 29 0a 09 09 28 69 75 70 3a 74 65 ent:")...(iup:te 1cc0: 78 74 62 6f 78 20 23 3a 61 63 74 69 6f 6e 20 28 xtbox #:action ( 1cd0: 6c 61 6d 62 64 61 20 28 76 61 6c 20 61 20 62 29 lambda (val a b) 1ce0: 0a 09 09 09 09 09 28 64 62 3a 74 65 73 74 2d 73 ......(db:test-s 1cf0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status- 1d00: 62 79 2d 69 64 20 2a 64 62 2a 20 74 65 73 74 2d by-id *db* test- 1d10: 69 64 20 23 66 20 23 66 20 62 29 0a 09 09 09 09 id #f #f b)..... 1d20: 09 28 73 65 74 21 20 6e 65 77 63 6f 6d 6d 65 6e .(set! newcommen 1d30: 74 20 62 29 29 0a 09 09 09 20 20 20 20 20 23 3a t b)).... #: 1d40: 76 61 6c 75 65 20 28 64 62 3a 74 65 73 74 2d 67 value (db:test-g 1d50: 65 74 2d 63 6f 6d 6d 65 6e 74 20 74 65 73 74 64 et-comment testd 1d60: 61 74 29 0a 09 09 09 20 20 20 20 20 23 3a 65 78 at).... #:ex 1d70: 70 61 6e 64 20 22 59 45 53 22 29 29 0a 20 20 20 pand "YES")). 1d80: 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 68 62 (apply iup:hb 1d90: 6f 78 0a 09 20 20 20 20 20 28 69 75 70 3a 6c 61 ox.. (iup:la 1da0: 62 65 6c 20 22 53 54 41 54 45 3a 22 20 23 3a 73 bel "STATE:" #:s 1db0: 69 7a 65 20 22 33 30 78 22 29 0a 09 20 20 20 20 ize "30x").. 1dc0: 20 28 6c 65 74 2a 20 28 28 62 74 6e 73 20 20 28 (let* ((btns ( 1dd0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 73 74 61 map (lambda (sta 1de0: 74 65 29 0a 09 09 09 09 20 20 28 6c 65 74 20 28 te)..... (let ( 1df0: 28 62 74 6e 20 28 69 75 70 3a 62 75 74 74 6f 6e (btn (iup:button 1e00: 20 73 74 61 74 65 0a 09 09 09 09 09 09 09 20 23 state........ # 1e10: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 20 23 3a :expand "YES" #: 1e20: 73 69 7a 65 20 22 35 30 78 22 20 23 3a 66 6f 6e size "50x" #:fon 1e30: 74 20 22 43 6f 75 72 69 65 72 20 4e 65 77 2c 20 t "Courier New, 1e40: 2d 31 30 22 0a 09 09 09 09 09 09 09 20 23 3a 61 -10"........ #:a 1e50: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 78 ction (lambda (x 1e60: 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 28 64 )......... (d 1e70: 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 b:test-set-state 1e80: 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 20 2a 64 -status-by-id *d 1e90: 62 2a 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 b* test-id state 1ea0: 20 23 66 20 23 66 29 0a 09 09 09 09 09 09 09 09 #f #f)......... 1eb0: 20 20 20 20 28 64 62 3a 74 65 73 74 2d 73 65 74 (db:test-set 1ec0: 2d 73 74 61 74 65 21 20 74 65 73 74 64 61 74 20 -state! testdat 1ed0: 73 74 61 74 65 29 29 29 29 29 0a 09 09 09 09 20 state)))))..... 1ee0: 20 20 20 62 74 6e 29 29 0a 09 09 09 09 28 6c 69 btn)).....(li 1ef0: 73 74 20 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 st "COMPLETED" " 1f00: 4e 4f 54 5f 53 54 41 52 54 45 44 22 20 22 52 55 NOT_STARTED" "RU 1f10: 4e 4e 49 4e 47 22 20 22 52 45 4d 4f 54 45 48 4f NNING" "REMOTEHO 1f20: 53 54 53 54 41 52 54 22 20 22 4b 49 4c 4c 45 44 STSTART" "KILLED 1f30: 22 20 22 4b 49 4c 4c 52 45 51 22 29 29 29 29 0a " "KILLREQ")))). 1f40: 09 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d . (vector- 1f50: 73 65 74 21 20 2a 73 74 61 74 65 2d 73 74 61 74 set! *state-stat 1f60: 75 73 2a 20 30 0a 09 09 09 20 20 20 20 28 6c 61 us* 0.... (la 1f70: 6d 62 64 61 20 28 73 74 61 74 65 20 63 6f 6c 6f mbda (state colo 1f80: 72 29 0a 09 09 09 20 20 20 20 20 20 28 66 6f 72 r).... (for 1f90: 2d 65 61 63 68 20 0a 09 09 09 20 20 20 20 20 20 -each .... 1fa0: 20 28 6c 61 6d 62 64 61 20 28 62 74 6e 29 0a 09 (lambda (btn).. 1fb0: 09 09 09 20 28 6c 65 74 2a 20 28 28 6e 61 6d 65 ... (let* ((name 1fc0: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib 1fd0: 75 74 65 20 62 74 6e 20 22 54 49 54 4c 45 22 29 ute btn "TITLE") 1fe0: 29 0a 09 09 09 09 09 28 6e 65 77 63 6f 6c 6f 72 )......(newcolor 1ff0: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 6e 61 6d (if (equal? nam 2000: 65 20 73 74 61 74 65 29 20 63 6f 6c 6f 72 20 22 e state) color " 2010: 31 39 32 20 31 39 32 20 31 39 32 22 29 29 29 0a 192 192 192"))). 2020: 09 09 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 .... (if (not 2030: 28 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c 61 72 3f (colors-similar? 2040: 20 6e 65 77 63 6f 6c 6f 72 20 28 69 75 70 3a 61 newcolor (iup:a 2050: 74 74 72 69 62 75 74 65 20 62 74 6e 20 22 42 47 ttribute btn "BG 2060: 43 4f 4c 4f 52 22 29 29 29 0a 09 09 09 09 20 20 COLOR")))..... 2070: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib 2080: 75 74 65 2d 73 65 74 21 20 62 74 6e 20 22 42 47 ute-set! btn "BG 2090: 43 4f 4c 4f 52 22 20 6e 65 77 63 6f 6c 6f 72 29 COLOR" newcolor) 20a0: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 62 74 ))).... bt 20b0: 6e 73 29 29 29 0a 09 20 20 20 20 20 20 20 62 74 ns))).. bt 20c0: 6e 73 29 29 0a 20 20 20 20 20 20 28 61 70 70 6c ns)). (appl 20d0: 79 20 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 20 y iup:hbox.. 20e0: 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 53 54 41 (iup:label "STA 20f0: 54 55 53 3a 22 20 23 3a 73 69 7a 65 20 22 33 30 TUS:" #:size "30 2100: 78 22 29 0a 09 20 20 20 20 20 28 6c 65 74 2a 20 x").. (let* 2110: 28 28 62 74 6e 73 20 20 28 6d 61 70 20 28 6c 61 ((btns (map (la 2120: 6d 62 64 61 20 28 73 74 61 74 75 73 29 0a 09 09 mbda (status)... 2130: 09 09 20 20 28 6c 65 74 20 28 28 62 74 6e 20 28 .. (let ((btn ( 2140: 69 75 70 3a 62 75 74 74 6f 6e 20 73 74 61 74 75 iup:button statu 2150: 73 0a 09 09 09 09 09 09 09 20 23 3a 65 78 70 61 s........ #:expa 2160: 6e 64 20 22 59 45 53 22 20 23 3a 73 69 7a 65 20 nd "YES" #:size 2170: 22 35 30 78 22 20 23 3a 66 6f 6e 74 20 22 43 6f "50x" #:font "Co 2180: 75 72 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 0a urier New, -10". 2190: 09 09 09 09 09 09 09 20 23 3a 61 63 74 69 6f 6e ....... #:action 21a0: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x).... 21b0: 09 09 09 09 09 20 20 20 20 28 64 62 3a 74 65 73 ..... (db:tes 21c0: 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 t-set-state-stat 21d0: 75 73 2d 62 79 2d 69 64 20 2a 64 62 2a 20 74 65 us-by-id *db* te 21e0: 73 74 2d 69 64 20 23 66 20 73 74 61 74 75 73 20 st-id #f status 21f0: 23 66 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 #f)......... 2200: 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 (db:test-set-sta 2210: 74 75 73 21 20 74 65 73 74 64 61 74 20 73 74 61 tus! testdat sta 2220: 74 75 73 29 29 29 29 29 0a 09 09 09 09 20 20 20 tus)))))..... 2230: 20 62 74 6e 29 29 0a 09 09 09 09 28 6c 69 73 74 btn)).....(list 2240: 20 20 22 50 41 53 53 22 20 22 57 41 52 4e 22 20 "PASS" "WARN" 2250: 22 46 41 49 4c 22 20 22 43 48 45 43 4b 22 20 22 "FAIL" "CHECK" " 2260: 6e 2f 61 22 20 22 57 41 49 56 45 44 22 29 29 29 n/a" "WAIVED"))) 2270: 29 0a 09 20 20 20 20 20 20 20 28 76 65 63 74 6f ).. (vecto 2280: 72 2d 73 65 74 21 20 2a 73 74 61 74 65 2d 73 74 r-set! *state-st 2290: 61 74 75 73 2a 20 31 0a 09 09 09 20 20 20 20 28 atus* 1.... ( 22a0: 6c 61 6d 62 64 61 20 28 73 74 61 74 75 73 20 63 lambda (status c 22b0: 6f 6c 6f 72 29 0a 09 09 09 20 20 20 20 20 20 28 olor).... ( 22c0: 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 20 20 for-each .... 22d0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 62 74 6e (lambda (btn 22e0: 29 0a 09 09 09 09 20 28 6c 65 74 2a 20 28 28 6e )..... (let* ((n 22f0: 61 6d 65 20 20 20 20 20 28 69 75 70 3a 61 74 74 ame (iup:att 2300: 72 69 62 75 74 65 20 62 74 6e 20 22 54 49 54 4c ribute btn "TITL 2310: 45 22 29 29 0a 09 09 09 09 09 28 6e 65 77 63 6f E"))......(newco 2320: 6c 6f 72 20 28 69 66 20 28 65 71 75 61 6c 3f 20 lor (if (equal? 2330: 6e 61 6d 65 20 73 74 61 74 75 73 29 20 63 6f 6c name status) col 2340: 6f 72 20 22 31 39 32 20 31 39 32 20 31 39 32 22 or "192 192 192" 2350: 29 29 29 0a 09 09 09 09 20 20 20 28 69 66 20 28 )))..... (if ( 2360: 6e 6f 74 20 28 63 6f 6c 6f 72 73 2d 73 69 6d 69 not (colors-simi 2370: 6c 61 72 3f 20 6e 65 77 63 6f 6c 6f 72 20 28 69 lar? newcolor (i 2380: 75 70 3a 61 74 74 72 69 62 75 74 65 20 62 74 6e up:attribute btn 2390: 20 22 42 47 43 4f 4c 4f 52 22 29 29 29 0a 09 09 "BGCOLOR")))... 23a0: 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 .. (iup:at 23b0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 62 74 6e tribute-set! btn 23c0: 20 22 42 47 43 4f 4c 4f 52 22 20 6e 65 77 63 6f "BGCOLOR" newco 23d0: 6c 6f 72 29 29 29 29 0a 09 09 09 20 20 20 20 20 lor)))).... 23e0: 20 20 62 74 6e 73 29 29 29 0a 09 20 20 20 20 20 btns))).. 23f0: 20 20 62 74 6e 73 29 29 29 29 29 29 0a 0a 0a 3b btns))))))...; 2400: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;=============== 2410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2440: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 0a 3b 3b 3d 3d 3d =======.;;.;;=== 2450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2490: 3d 3d 3d 0a 28 64 65 66 69 6e 65 20 28 65 78 61 ===.(define (exa 24a0: 6d 69 6e 65 2d 74 65 73 74 20 64 62 20 74 65 73 mine-test db tes 24b0: 74 2d 69 64 29 20 3b 3b 20 72 75 6e 2d 69 64 20 t-id) ;; run-id 24c0: 72 75 6e 2d 6b 65 79 20 6f 72 69 67 74 65 73 74 run-key origtest 24d0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 ). (let* ((test 24e0: 64 61 74 20 20 20 20 20 20 20 28 64 62 3a 67 65 dat (db:ge 24f0: 74 2d 74 65 73 74 2d 64 61 74 61 2d 62 79 2d 69 t-test-data-by-i 2500: 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 0a 09 d db test-id)).. 2510: 20 28 72 75 6e 2d 69 64 20 20 20 20 20 20 20 20 (run-id 2520: 28 69 66 20 74 65 73 74 64 61 74 20 28 64 62 3a (if testdat (db: 2530: 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 69 64 20 test-get-run_id 2540: 74 65 73 74 64 61 74 29 20 23 66 29 29 0a 09 20 testdat) #f)).. 2550: 28 6b 65 79 64 61 74 20 20 20 20 20 20 20 20 28 (keydat ( 2560: 69 66 20 74 65 73 74 64 61 74 20 28 6b 65 79 73 if testdat (keys 2570: 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 :get-key-val-pai 2580: 72 73 20 64 62 20 72 75 6e 2d 69 64 29 20 23 66 rs db run-id) #f 2590: 29 29 0a 09 20 28 72 75 6e 64 61 74 20 20 20 20 )).. (rundat 25a0: 20 20 20 20 28 69 66 20 74 65 73 74 64 61 74 20 (if testdat 25b0: 28 64 62 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 6f (db:get-run-info 25c0: 20 64 62 20 72 75 6e 2d 69 64 29 20 23 66 29 29 db run-id) #f)) 25d0: 0a 09 20 28 72 75 6e 6e 61 6d 65 20 20 20 20 20 .. (runname 25e0: 20 20 28 69 66 20 74 65 73 74 64 61 74 20 28 64 (if testdat (d 25f0: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h 2600: 65 61 64 65 72 20 28 64 62 3a 67 65 74 2d 72 6f eader (db:get-ro 2610: 77 20 72 75 6e 64 61 74 29 0a 09 09 09 09 09 09 w rundat)....... 2620: 09 20 20 20 20 28 64 62 3a 67 65 74 2d 68 65 61 . (db:get-hea 2630: 64 65 72 20 72 75 6e 64 61 74 29 0a 09 09 09 09 der rundat)..... 2640: 09 09 09 20 20 20 20 22 72 75 6e 6e 61 6d 65 22 ... "runname" 2650: 29 20 23 66 29 29 0a 09 20 3b 28 74 65 73 74 73 ) #f)).. ;(tests 2660: 74 65 70 73 20 20 20 20 20 28 69 66 20 74 65 73 teps (if tes 2670: 74 64 61 74 20 28 64 62 3a 67 65 74 2d 73 74 65 tdat (db:get-ste 2680: 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 74 ps-for-test db t 2690: 65 73 74 2d 69 64 29 20 23 66 29 29 0a 09 20 28 est-id) #f)).. ( 26a0: 6c 6f 67 66 69 6c 65 20 20 20 20 20 20 20 22 2f logfile "/ 26b0: 74 68 69 73 2f 64 69 72 2f 62 65 74 74 65 72 2f this/dir/better/ 26c0: 6e 6f 74 2f 65 78 69 73 74 22 29 0a 09 20 28 72 not/exist").. (r 26d0: 75 6e 64 69 72 20 20 20 20 20 20 20 20 6c 6f 67 undir log 26e0: 66 69 6c 65 29 0a 09 20 28 74 65 73 74 66 75 6c file).. (testful 26f0: 6c 6e 61 6d 65 20 20 28 69 66 20 74 65 73 74 64 lname (if testd 2700: 61 74 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d at (db:test-get- 2710: 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 64 61 74 fullname testdat 2720: 29 20 22 47 61 74 68 65 72 69 6e 67 20 64 61 74 ) "Gathering dat 2730: 61 20 2e 2e 2e 22 29 29 0a 09 20 28 74 65 73 74 a ...")).. (test 2740: 6e 61 6d 65 20 20 20 20 20 20 28 69 66 20 74 65 name (if te 2750: 73 74 64 61 74 20 28 64 62 3a 74 65 73 74 2d 67 stdat (db:test-g 2760: 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 et-testname test 2770: 64 61 74 29 20 22 6e 2f 61 22 29 29 0a 09 20 28 dat) "n/a")).. ( 2780: 74 65 73 74 6d 65 74 61 20 20 20 20 20 20 28 69 testmeta (i 2790: 66 20 74 65 73 74 64 61 74 20 0a 09 09 09 20 20 f testdat .... 27a0: 20 20 28 6c 65 74 20 28 28 74 6d 20 28 64 62 3a (let ((tm (db: 27b0: 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 72 65 63 testmeta-get-rec 27c0: 6f 72 64 20 64 62 20 74 65 73 74 6e 61 6d 65 29 ord db testname) 27d0: 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 )).... (if 27e0: 74 6d 20 74 6d 20 28 6d 61 6b 65 2d 64 62 3a 74 tm tm (make-db:t 27f0: 65 73 74 6d 65 74 61 29 29 29 0a 09 09 09 20 20 estmeta))).... 2800: 20 20 28 6d 61 6b 65 2d 64 62 3a 74 65 73 74 6d (make-db:testm 2810: 65 74 61 29 29 29 0a 0a 09 20 28 6b 65 79 73 74 eta)))... (keyst 2820: 72 69 6e 67 20 20 28 73 74 72 69 6e 67 2d 69 6e ring (string-in 2830: 74 65 72 73 70 65 72 73 65 20 0a 09 09 20 20 20 tersperse ... 2840: 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda 2850: 28 6b 65 79 76 61 6c 29 0a 09 09 09 20 20 20 20 (keyval).... 2860: 20 28 63 6f 6e 63 20 22 3a 22 20 28 63 61 72 20 (conc ":" (car 2870: 6b 65 79 76 61 6c 29 20 22 20 22 20 28 63 61 64 keyval) " " (cad 2880: 72 20 6b 65 79 76 61 6c 29 29 29 0a 09 09 09 20 r keyval))).... 2890: 20 20 6b 65 79 64 61 74 29 0a 09 09 20 20 20 20 keydat)... 28a0: 20 20 22 20 22 29 29 0a 09 20 28 69 74 65 6d 2d " ")).. (item- 28b0: 70 61 74 68 20 20 28 64 62 3a 74 65 73 74 2d 67 path (db:test-g 28c0: 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 et-item-path tes 28d0: 74 64 61 74 29 29 0a 09 20 28 76 69 65 77 6c 6f tdat)).. (viewlo 28e0: 67 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 g (lambda (x) 28f0: 0a 09 09 20 20 20 20 20 20 20 28 69 66 20 28 66 ... (if (f 2900: 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6f 67 66 ile-exists? logf 2910: 69 6c 65 29 0a 09 09 09 20 20 20 3b 28 73 79 73 ile).... ;(sys 2920: 74 65 6d 20 28 63 6f 6e 63 20 22 66 69 72 65 66 tem (conc "firef 2930: 6f 78 20 22 20 6c 6f 67 66 69 6c 65 20 22 26 22 ox " logfile "&" 2940: 29 29 0a 09 09 09 20 20 20 28 69 75 70 3a 73 65 )).... (iup:se 2950: 6e 64 2d 75 72 6c 20 6c 6f 67 66 69 6c 65 29 0a nd-url logfile). 2960: 09 09 09 20 20 20 28 6d 65 73 73 61 67 65 2d 77 ... (message-w 2970: 69 6e 64 6f 77 20 28 63 6f 6e 63 20 22 46 69 6c indow (conc "Fil 2980: 65 20 22 20 6c 6f 67 66 69 6c 65 20 22 20 6e 6f e " logfile " no 2990: 74 20 66 6f 75 6e 64 22 29 29 29 29 29 0a 09 20 t found"))))).. 29a0: 28 78 74 65 72 6d 20 20 20 20 20 20 28 6c 61 6d (xterm (lam 29b0: 62 64 61 20 28 78 29 0a 09 09 20 20 20 20 20 20 bda (x)... 29c0: 20 28 69 66 20 28 64 69 72 65 63 74 6f 72 79 2d (if (directory- 29d0: 65 78 69 73 74 73 3f 20 72 75 6e 64 69 72 29 0a exists? rundir). 29e0: 09 09 09 20 20 20 28 6c 65 74 20 28 28 73 68 65 ... (let ((she 29f0: 6c 6c 20 28 69 66 20 28 67 65 74 2d 65 6e 76 69 ll (if (get-envi 2a00: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable 2a10: 20 22 53 48 45 4c 4c 22 29 20 0a 09 09 09 09 09 "SHELL") ...... 2a20: 20 20 20 20 28 63 6f 6e 63 20 22 2d 65 20 22 20 (conc "-e " 2a30: 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment 2a40: 2d 76 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c -variable "SHELL 2a50: 22 29 29 0a 09 09 09 09 09 20 20 20 20 22 22 29 "))...... "") 2a60: 29 29 0a 09 09 09 20 20 20 20 20 28 73 79 73 74 )).... (syst 2a70: 65 6d 20 28 63 6f 6e 63 20 22 63 64 20 22 20 72 em (conc "cd " r 2a80: 75 6e 64 69 72 20 0a 09 09 09 09 09 20 20 20 22 undir ...... " 2a90: 3b 78 74 65 72 6d 20 2d 54 20 5c 22 22 20 28 73 ;xterm -T \"" (s 2aa0: 74 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 tring-translate 2ab0: 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 22 28 29 testfullname "() 2ac0: 22 20 22 20 20 22 29 20 22 5c 22 20 22 20 73 68 " " ") "\" " sh 2ad0: 65 6c 6c 20 22 26 22 29 29 29 0a 09 09 09 20 20 ell "&"))).... 2ae0: 20 28 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 (message-window 2af0: 20 20 28 63 6f 6e 63 20 22 44 69 72 65 63 74 6f (conc "Directo 2b00: 72 79 20 22 20 72 75 6e 64 69 72 20 22 20 6e 6f ry " rundir " no 2b10: 74 20 66 6f 75 6e 64 22 29 29 29 29 29 0a 09 20 t found"))))).. 2b20: 28 72 65 66 72 65 73 68 64 61 74 20 28 6c 61 6d (refreshdat (lam 2b30: 62 64 61 20 28 29 0a 09 09 20 20 20 20 20 20 20 bda ()... 2b40: 28 6c 65 74 20 28 28 6e 65 77 74 65 73 74 64 61 (let ((newtestda 2b50: 74 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d 64 t (db:get-test-d 2b60: 61 74 61 2d 62 79 2d 69 64 20 64 62 20 74 65 73 ata-by-id db tes 2b70: 74 2d 69 64 29 29 29 0a 09 09 09 20 28 69 66 20 t-id))).... (if 2b80: 6e 65 77 74 65 73 74 64 61 74 20 0a 09 09 09 20 newtestdat .... 2b90: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 (begin.... 2ba0: 20 20 20 20 20 3b 28 6d 75 74 65 78 2d 6c 6f 63 ;(mutex-loc 2bb0: 6b 21 20 6d 78 31 29 0a 09 09 09 20 20 20 20 20 k! mx1).... 2bc0: 20 20 28 73 65 74 21 20 74 65 73 74 64 61 74 20 (set! testdat 2bd0: 6e 65 77 74 65 73 74 64 61 74 29 0a 09 09 09 20 newtestdat).... 2be0: 20 20 20 20 20 20 28 73 65 74 21 20 74 65 73 74 (set! test 2bf0: 73 74 65 70 73 20 20 20 20 28 64 62 3a 67 65 74 steps (db:get 2c00: 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 -steps-for-test 2c10: 64 62 20 74 65 73 74 2d 69 64 29 29 0a 09 09 09 db test-id)).... 2c20: 20 20 20 20 20 20 20 28 73 65 74 21 20 6c 6f 67 (set! log 2c30: 66 69 6c 65 20 20 20 20 20 20 28 63 6f 6e 63 20 file (conc 2c40: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e (db:test-get-run 2c50: 64 69 72 20 74 65 73 74 64 61 74 29 20 22 2f 22 dir testdat) "/" 2c60: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 69 (db:test-get-fi 2c70: 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 74 64 61 74 nal_logf testdat 2c80: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 ))).... (s 2c90: 65 74 21 20 72 75 6e 64 69 72 20 20 20 20 20 20 et! rundir 2ca0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru 2cb0: 6e 64 69 72 20 74 65 73 74 64 61 74 29 29 0a 09 ndir testdat)).. 2cc0: 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 74 .. (set! t 2cd0: 65 73 74 66 75 6c 6c 6e 61 6d 65 20 28 64 62 3a estfullname (db: 2ce0: 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d test-get-fullnam 2cf0: 65 20 74 65 73 74 64 61 74 29 29 0a 09 09 09 20 e testdat)).... 2d00: 20 20 20 20 20 20 3b 28 6d 75 74 65 78 2d 75 6e ;(mutex-un 2d10: 6c 6f 63 6b 21 20 6d 78 31 29 0a 09 09 09 20 20 lock! mx1).... 2d20: 20 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 28 ).... ( 2d30: 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 20 begin.... 2d40: 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 74 65 73 (db:test-set-tes 2d50: 74 6e 61 6d 65 21 20 74 65 73 74 64 61 74 20 22 tname! testdat " 2d60: 44 45 41 44 20 4f 52 20 44 45 4c 45 54 45 44 20 DEAD OR DELETED 2d70: 54 45 53 54 22 29 29 29 29 29 29 0a 09 20 28 77 TEST")))))).. (w 2d80: 69 64 67 65 74 73 20 20 20 20 20 20 28 6d 61 6b idgets (mak 2d90: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 e-hash-table)).. 2da0: 20 28 6d 65 74 61 2d 77 69 64 67 65 74 73 20 28 (meta-widgets ( 2db0: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table) 2dc0: 29 0a 09 20 28 73 65 6c 66 20 20 20 20 20 20 20 ).. (self 2dd0: 20 20 23 66 29 0a 09 20 28 73 74 6f 72 65 2d 6c #f).. (store-l 2de0: 61 62 65 6c 20 20 28 6c 61 6d 62 64 61 20 28 6e abel (lambda (n 2df0: 61 6d 65 20 6c 62 6c 20 63 6d 64 29 0a 09 09 09 ame lbl cmd).... 2e00: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set 2e10: 21 20 77 69 64 67 65 74 73 20 6e 61 6d 65 20 0a ! widgets name . 2e20: 09 09 09 09 09 20 20 28 6c 61 6d 62 64 61 20 28 ..... (lambda ( 2e30: 74 65 73 74 64 61 74 29 0a 09 09 09 09 09 20 20 testdat)...... 2e40: 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 (let ((newval 2e50: 28 63 6d 64 20 74 65 73 74 64 61 74 29 29 0a 09 (cmd testdat)).. 2e60: 09 09 09 09 09 20 20 28 6f 6c 64 76 61 6c 20 28 ..... (oldval ( 2e70: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c 62 iup:attribute lb 2e80: 6c 20 22 54 49 54 4c 45 22 29 29 29 0a 09 09 09 l "TITLE"))).... 2e90: 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not 2ea0: 20 28 65 71 75 61 6c 3f 20 6e 65 77 76 61 6c 20 (equal? newval 2eb0: 6f 6c 64 76 61 6c 29 29 0a 09 09 09 09 09 09 20 oldval))....... 2ec0: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 (begin....... 2ed0: 20 20 3b 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 ;(mutex-lock! 2ee0: 6d 78 31 29 0a 09 09 09 09 09 09 20 20 20 20 28 mx1)....... ( 2ef0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se 2f00: 74 21 20 6c 62 6c 20 22 54 49 54 4c 45 22 20 6e t! lbl "TITLE" n 2f10: 65 77 76 61 6c 29 0a 09 09 09 09 09 09 20 20 20 ewval)....... 2f20: 20 3b 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 ;(mutex-unlock! 2f30: 20 6d 78 31 29 0a 09 09 09 09 09 09 20 20 20 20 mx1)....... 2f40: 29 29 29 29 29 0a 09 09 09 20 6c 62 6c 29 29 0a ))))).... lbl)). 2f50: 09 20 28 73 74 6f 72 65 2d 6d 65 74 61 20 20 28 . (store-meta ( 2f60: 6c 61 6d 62 64 61 20 28 6e 61 6d 65 20 6c 62 6c lambda (name lbl 2f70: 20 63 6d 64 29 0a 09 09 09 20 28 68 61 73 68 2d cmd).... (hash- 2f80: 74 61 62 6c 65 2d 73 65 74 21 20 6d 65 74 61 2d table-set! meta- 2f90: 77 69 64 67 65 74 73 20 6e 61 6d 65 20 0a 09 09 widgets name ... 2fa0: 09 09 09 20 20 28 6c 61 6d 62 64 61 20 28 74 65 ... (lambda (te 2fb0: 73 74 6d 65 74 61 29 0a 09 09 09 09 09 20 20 20 stmeta)...... 2fc0: 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 28 (let ((newval ( 2fd0: 63 6d 64 20 74 65 73 74 6d 65 74 61 29 29 0a 09 cmd testmeta)).. 2fe0: 09 09 09 09 09 20 20 28 6f 6c 64 76 61 6c 20 28 ..... (oldval ( 2ff0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c 62 iup:attribute lb 3000: 6c 20 22 54 49 54 4c 45 22 29 29 29 0a 09 09 09 l "TITLE"))).... 3010: 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not 3020: 20 28 65 71 75 61 6c 3f 20 6e 65 77 76 61 6c 20 (equal? newval 3030: 6f 6c 64 76 61 6c 29 29 0a 09 09 09 09 09 09 20 oldval))....... 3040: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 (begin....... 3050: 20 20 3b 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 ;(mutex-lock! 3060: 6d 78 31 29 0a 09 09 09 09 09 09 20 20 20 20 28 mx1)....... ( 3070: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se 3080: 74 21 20 6c 62 6c 20 22 54 49 54 4c 45 22 20 6e t! lbl "TITLE" n 3090: 65 77 76 61 6c 29 0a 09 09 09 09 09 09 20 20 20 ewval)....... 30a0: 20 3b 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 ;(mutex-unlock! 30b0: 20 6d 78 31 29 0a 09 09 09 09 09 09 20 20 20 20 mx1)....... 30c0: 29 29 29 29 29 0a 09 09 09 20 6c 62 6c 29 29 0a ))))).... lbl)). 30d0: 09 20 28 73 74 6f 72 65 2d 62 75 74 74 6f 6e 20 . (store-button 30e0: 73 74 6f 72 65 2d 6c 61 62 65 6c 29 0a 09 20 28 store-label).. ( 30f0: 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 6f 78 command-text-box 3100: 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a (iup:textbox #: 3110: 65 78 70 61 6e 64 20 22 59 45 53 22 20 23 3a 66 expand "YES" #:f 3120: 6f 6e 74 20 22 43 6f 75 72 69 65 72 20 4e 65 77 ont "Courier New 3130: 2c 20 2d 31 30 22 29 29 0a 09 20 28 63 6f 6d 6d , -10")).. (comm 3140: 61 6e 64 2d 6c 61 75 6e 63 68 2d 62 75 74 74 6f and-launch-butto 3150: 6e 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 45 n (iup:button "E 3160: 78 65 63 75 74 65 21 22 20 23 3a 61 63 74 69 6f xecute!" #:actio 3170: 6e 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 n (lambda (x)... 3180: 09 09 09 09 09 09 20 20 28 6c 65 74 20 28 28 63 ...... (let ((c 3190: 6d 64 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 md (iup:attribut 31a0: 65 20 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 e command-text-b 31b0: 6f 78 20 22 56 41 4c 55 45 22 29 29 29 0a 09 09 ox "VALUE")))... 31c0: 09 09 09 09 09 09 20 20 20 20 28 73 79 73 74 65 ...... (syste 31d0: 6d 20 28 63 6f 6e 63 20 63 6d 64 20 22 20 20 26 m (conc cmd " & 31e0: 22 29 29 29 29 29 29 0a 09 20 28 72 75 6e 2d 74 ")))))).. (run-t 31f0: 65 73 74 20 20 28 6c 61 6d 62 64 61 20 28 78 29 est (lambda (x) 3200: 0a 09 09 20 20 20 20 20 20 28 69 75 70 3a 61 74 ... (iup:at 3210: 74 72 69 62 75 74 65 2d 73 65 74 21 20 0a 09 09 tribute-set! ... 3220: 20 20 20 20 20 20 20 63 6f 6d 6d 61 6e 64 2d 74 command-t 3230: 65 78 74 2d 62 6f 78 20 22 56 41 4c 55 45 22 0a ext-box "VALUE". 3240: 09 09 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 .. (conc " 3250: 6d 65 67 61 74 65 73 74 20 2d 72 75 6e 74 65 73 megatest -runtes 3260: 74 73 20 22 20 74 65 73 74 6e 61 6d 65 20 22 20 ts " testname " 3270: 22 20 6b 65 79 73 74 72 69 6e 67 20 22 20 3a 72 " keystring " :r 3280: 75 6e 6e 61 6d 65 20 22 20 72 75 6e 6e 61 6d 65 unname " runname 3290: 20 0a 09 09 09 20 20 20 20 20 22 20 2d 69 74 65 .... " -ite 32a0: 6d 70 61 74 74 20 22 20 28 69 66 20 28 65 71 75 mpatt " (if (equ 32b0: 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 al? item-path "" 32c0: 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 22 25 )...... "% 32d0: 22 20 0a 09 09 09 09 09 20 20 20 20 20 20 20 69 " ...... i 32e0: 74 65 6d 2d 70 61 74 68 29 0a 09 09 09 20 20 20 tem-path).... 32f0: 20 20 22 20 2d 6b 65 65 70 67 6f 69 6e 67 20 3e " -keepgoing > 3300: 20 72 75 6e 2e 6c 6f 67 22 20 29 29 29 29 0a 09 run.log" )))).. 3310: 20 28 72 65 6d 6f 76 65 2d 74 65 73 74 20 28 6c (remove-test (l 3320: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 28 69 75 ambda (x)....(iu 3330: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set! 3340: 0a 09 09 09 20 63 6f 6d 6d 61 6e 64 2d 74 65 78 .... command-tex 3350: 74 2d 62 6f 78 20 22 56 41 4c 55 45 22 0a 09 09 t-box "VALUE"... 3360: 09 20 28 63 6f 6e 63 20 22 6d 65 67 61 74 65 73 . (conc "megates 3370: 74 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 20 22 t -remove-runs " 3380: 20 6b 65 79 73 74 72 69 6e 67 20 22 20 3a 72 75 keystring " :ru 3390: 6e 6e 61 6d 65 20 22 20 72 75 6e 6e 61 6d 65 20 nname " runname 33a0: 22 20 2d 74 65 73 74 70 61 74 74 20 22 20 74 65 " -testpatt " te 33b0: 73 74 6e 61 6d 65 20 22 20 2d 69 74 65 6d 70 61 stname " -itempa 33c0: 74 74 20 22 0a 09 09 09 20 20 20 20 20 20 20 28 tt ".... ( 33d0: 69 66 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d if (equal? item- 33e0: 70 61 74 68 20 22 22 29 0a 09 09 09 09 20 20 20 path "")..... 33f0: 22 25 22 0a 09 09 09 09 20 20 20 69 74 65 6d 2d "%"..... item- 3400: 70 61 74 68 29 0a 09 09 09 20 20 20 20 20 20 20 path).... 3410: 22 20 3e 20 63 6c 65 61 6e 2e 6c 6f 67 22 29 29 " > clean.log")) 3420: 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 ))). (cond. 3430: 20 20 20 28 28 6e 6f 74 20 74 65 73 74 64 61 74 ((not testdat 3440: 29 28 62 65 67 69 6e 20 28 70 72 69 6e 74 20 22 )(begin (print " 3450: 45 52 52 4f 52 3a 20 62 61 64 20 74 65 73 74 20 ERROR: bad test 3460: 69 6e 66 6f 20 66 6f 72 20 22 20 74 65 73 74 2d info for " test- 3470: 69 64 29 28 65 78 69 74 20 31 29 29 29 0a 20 20 id)(exit 1))). 3480: 20 20 20 28 28 6e 6f 74 20 72 75 6e 64 61 74 29 ((not rundat) 3490: 28 62 65 67 69 6e 20 28 70 72 69 6e 74 20 22 45 (begin (print "E 34a0: 52 52 4f 52 3a 20 66 6f 75 6e 64 20 74 65 73 74 RROR: found test 34b0: 20 69 6e 66 6f 20 62 75 74 20 74 68 65 72 65 20 info but there 34c0: 69 73 20 61 20 70 72 6f 62 6c 65 6d 20 77 69 74 is a problem wit 34d0: 68 20 74 68 65 20 72 75 6e 20 69 6e 66 6f 20 66 h the run info f 34e0: 6f 72 20 22 20 72 75 6e 2d 69 64 29 28 65 78 69 or " run-id)(exi 34f0: 74 20 31 29 29 29 0a 20 20 20 20 20 28 65 6c 73 t 1))). (els 3500: 65 0a 20 20 20 20 20 20 3b 3b 20 20 28 74 65 73 e. ;; (tes 3510: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 t-set-status! db 3520: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam 3530: 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 69 e state status i 3540: 74 65 6d 64 61 74 29 0a 20 20 20 20 20 20 28 73 temdat). (s 3550: 65 74 21 20 73 65 6c 66 20 3b 20 0a 09 20 20 20 et! self ; .. 3560: 20 28 69 75 70 3a 64 69 61 6c 6f 67 20 23 3a 63 (iup:dialog #:c 3570: 6c 6f 73 65 5f 63 62 20 28 6c 61 6d 62 64 61 20 lose_cb (lambda 3580: 28 61 29 28 65 78 69 74 29 29 20 3b 20 23 3a 65 (a)(exit)) ; #:e 3590: 78 70 61 6e 64 20 22 59 45 53 22 0a 09 20 20 20 xpand "YES".. 35a0: 20 20 23 3a 74 69 74 6c 65 20 74 65 73 74 66 75 #:title testfu 35b0: 6c 6c 6e 61 6d 65 0a 09 20 20 20 20 20 28 69 75 llname.. (iu 35c0: 70 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e p:vbox ; #:expan 35d0: 64 20 22 59 45 53 22 0a 20 20 20 20 20 20 20 20 d "YES". 35e0: 20 20 20 20 20 20 20 3b 3b 20 54 68 65 20 72 75 ;; The ru 35f0: 6e 20 61 6e 64 20 74 65 73 74 20 69 6e 66 6f 0a n and test info. 3600: 09 20 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f . (iup:hbo 3610: 78 20 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 x ; #:expand "Y 3620: 45 53 22 0a 09 09 28 72 75 6e 2d 69 6e 66 6f 2d ES"...(run-info- 3630: 70 61 6e 65 6c 20 6b 65 79 64 61 74 20 74 65 73 panel keydat tes 3640: 74 64 61 74 20 72 75 6e 6e 61 6d 65 29 0a 09 09 tdat runname)... 3650: 28 74 65 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 6c (test-info-panel 3660: 20 74 65 73 74 64 61 74 20 73 74 6f 72 65 2d 6c testdat store-l 3670: 61 62 65 6c 20 77 69 64 67 65 74 73 29 0a 09 09 abel widgets)... 3680: 28 74 65 73 74 2d 6d 65 74 61 2d 70 61 6e 65 6c (test-meta-panel 3690: 20 74 65 73 74 6d 65 74 61 20 73 74 6f 72 65 2d testmeta store- 36a0: 6d 65 74 61 29 29 0a 09 20 20 20 20 20 20 20 28 meta)).. ( 36b0: 68 6f 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 6c 20 host-info-panel 36c0: 74 65 73 74 64 61 74 20 73 74 6f 72 65 2d 6c 61 testdat store-la 36d0: 62 65 6c 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 bel).. ;; 36e0: 54 68 65 20 63 6f 6e 74 72 6f 6c 73 0a 09 20 20 The controls.. 36f0: 20 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 20 (iup:frame 3700: 23 3a 74 69 74 6c 65 20 22 41 63 74 69 6f 6e 73 #:title "Actions 3710: 22 20 0a 09 09 09 20 20 28 69 75 70 3a 76 62 6f " .... (iup:vbo 3720: 78 0a 09 09 09 20 20 20 28 69 75 70 3a 68 62 6f x.... (iup:hbo 3730: 78 20 0a 09 09 09 20 20 20 20 28 69 75 70 3a 62 x .... (iup:b 3740: 75 74 74 6f 6e 20 22 56 69 65 77 20 4c 6f 67 22 utton "View Log" 3750: 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 76 69 65 #:action vie 3760: 77 6c 6f 67 20 20 20 20 20 23 3a 73 69 7a 65 20 wlog #:size 3770: 22 38 30 78 22 29 0a 09 09 09 20 20 20 20 28 69 "80x").... (i 3780: 75 70 3a 62 75 74 74 6f 6e 20 22 53 74 61 72 74 up:button "Start 3790: 20 58 74 65 72 6d 22 20 23 3a 61 63 74 69 6f 6e Xterm" #:action 37a0: 20 78 74 65 72 6d 20 20 20 20 20 20 20 23 3a 73 xterm #:s 37b0: 69 7a 65 20 22 38 30 78 22 29 0a 09 09 09 20 20 ize "80x").... 37c0: 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 (iup:button "R 37d0: 75 6e 20 54 65 73 74 22 20 20 20 20 23 3a 61 63 un Test" #:ac 37e0: 74 69 6f 6e 20 72 75 6e 2d 74 65 73 74 20 20 20 tion run-test 37f0: 20 23 3a 73 69 7a 65 20 22 38 30 78 22 29 0a 09 #:size "80x").. 3800: 09 09 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f .. (iup:butto 3810: 6e 20 22 43 6c 65 61 6e 20 54 65 73 74 22 20 20 n "Clean Test" 3820: 23 3a 61 63 74 69 6f 6e 20 72 65 6d 6f 76 65 2d #:action remove- 3830: 74 65 73 74 20 23 3a 73 69 7a 65 20 22 38 30 78 test #:size "80x 3840: 22 29 0a 09 09 09 20 20 20 20 28 69 75 70 3a 62 ").... (iup:b 3850: 75 74 74 6f 6e 20 22 43 6c 6f 73 65 22 20 20 20 utton "Close" 3860: 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 #:action (la 3870: 6d 62 64 61 20 28 78 29 28 65 78 69 74 29 29 20 mbda (x)(exit)) 3880: 23 3a 73 69 7a 65 20 22 38 30 78 22 29 29 0a 09 #:size "80x")).. 3890: 09 09 20 20 20 28 61 70 70 6c 79 20 0a 09 09 09 .. (apply .... 38a0: 20 20 20 20 69 75 70 3a 68 62 6f 78 0a 09 09 09 iup:hbox.... 38b0: 20 20 20 20 28 6c 69 73 74 20 63 6f 6d 6d 61 6e (list comman 38c0: 64 2d 74 65 78 74 2d 62 6f 78 20 63 6f 6d 6d 61 d-text-box comma 38d0: 6e 64 2d 6c 61 75 6e 63 68 2d 62 75 74 74 6f 6e nd-launch-button 38e0: 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 73 65 )))).. (se 38f0: 74 2d 66 69 65 6c 64 73 2d 70 61 6e 65 6c 20 74 t-fields-panel t 3900: 65 73 74 2d 69 64 20 74 65 73 74 64 61 74 29 0a est-id testdat). 3910: 09 20 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f . (iup:hbo 3920: 78 0a 09 09 28 69 75 70 3a 66 72 61 6d 65 20 0a x...(iup:frame . 3930: 09 09 20 23 3a 74 69 74 6c 65 20 22 54 65 73 74 .. #:title "Test 3940: 20 53 74 65 70 73 22 0a 09 09 20 28 6c 65 74 20 Steps"... (let 3950: 28 28 73 74 65 70 73 64 61 74 20 3b 3b 28 69 75 ((stepsdat ;;(iu 3960: 70 3a 6c 61 62 65 6c 20 22 54 65 73 74 20 73 74 p:label "Test st 3970: 65 70 73 20 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e eps ............ 3980: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e ................ 3990: 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 2e 22 20 0a ............." . 39a0: 09 09 09 3b 3b 09 20 20 20 23 3a 65 78 70 61 6e ...;;. #:expan 39b0: 64 20 22 59 45 53 22 20 0a 09 09 09 3b 3b 09 20 d "YES" ....;;. 39c0: 20 20 23 3a 73 69 7a 65 20 22 32 30 30 78 31 35 #:size "200x15 39d0: 30 22 0a 09 09 09 3b 3b 09 20 20 20 23 3a 61 6c 0"....;;. #:al 39e0: 69 67 6e 6d 65 6e 74 20 22 41 4c 45 46 54 3a 41 ignment "ALEFT:A 39f0: 54 4f 50 22 29 29 29 0a 09 09 09 28 69 75 70 3a TOP")))....(iup: 3a00: 74 65 78 74 62 6f 78 20 3b 3b 20 23 3a 61 63 74 textbox ;; #:act 3a10: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj 3a20: 20 63 68 61 72 20 76 61 6c 29 0a 09 09 09 09 20 char val)..... 3a30: 20 20 20 20 3b 3b 20 20 20 20 09 23 66 29 0a 09 ;; .#f).. 3a40: 09 09 09 20 20 20 20 20 23 3a 65 78 70 61 6e 64 ... #:expand 3a50: 20 22 59 45 53 22 0a 09 09 09 09 20 20 20 20 20 "YES"..... 3a60: 23 3a 6d 75 6c 74 69 6c 69 6e 65 20 22 59 45 53 #:multiline "YES 3a70: 22 0a 09 09 09 09 20 20 20 20 20 23 3a 66 6f 6e "..... #:fon 3a80: 74 20 22 43 6f 75 72 69 65 72 20 4e 65 77 2c 20 t "Courier New, 3a90: 2d 31 30 22 0a 09 09 09 09 20 20 20 20 20 23 3a -10"..... #: 3aa0: 73 69 7a 65 20 22 36 30 78 31 30 30 22 29 29 29 size "60x100"))) 3ab0: 0a 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c ... (hash-tabl 3ac0: 65 2d 73 65 74 21 20 77 69 64 67 65 74 73 20 22 e-set! widgets " 3ad0: 54 65 73 74 20 53 74 65 70 73 22 20 0a 09 09 09 Test Steps" .... 3ae0: 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 . (lambda (te 3af0: 73 74 64 61 74 29 0a 09 09 09 09 20 20 20 20 20 stdat)..... 3b00: 20 28 6c 65 74 2a 20 28 28 63 75 72 72 76 61 6c (let* ((currval 3b10: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute 3b20: 73 74 65 70 73 64 61 74 20 22 56 41 4c 55 45 22 stepsdat "VALUE" 3b30: 29 29 20 3b 3b 20 22 54 49 54 4c 45 22 29 29 0a )) ;; "TITLE")). 3b40: 09 09 09 09 09 20 20 20 20 20 28 66 6d 74 73 74 ..... (fmtst 3b50: 72 20 20 22 7e 32 30 61 7e 31 30 61 7e 31 30 61 r "~20a~10a~10a 3b60: 7e 31 32 61 7e 31 35 61 22 29 0a 09 09 09 09 09 ~12a~15a")...... 3b70: 20 20 20 20 20 28 63 6f 6d 70 72 73 74 65 70 73 (comprsteps 3b80: 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 74 (db:get-steps-t 3b90: 61 62 6c 65 20 64 62 20 74 65 73 74 2d 69 64 29 able db test-id) 3ba0: 29 0a 09 09 09 09 09 20 20 20 20 20 28 6e 65 77 )...... (new 3bb0: 76 61 6c 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 val (string-int 3bc0: 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 09 09 ersperse ....... 3bd0: 20 20 20 20 20 20 20 28 61 70 70 65 6e 64 0a 09 (append.. 3be0: 09 09 09 09 09 09 28 6c 69 73 74 20 0a 09 09 09 ......(list .... 3bf0: 09 09 09 09 20 28 66 6f 72 6d 61 74 20 23 66 20 .... (format #f 3c00: 66 6d 74 73 74 72 20 22 53 74 65 70 6e 61 6d 65 fmtstr "Stepname 3c10: 22 20 22 53 74 61 72 74 22 20 22 45 6e 64 22 20 " "Start" "End" 3c20: 22 53 74 61 74 75 73 22 20 22 54 69 6d 65 22 29 "Status" "Time") 3c30: 0a 09 09 09 09 09 09 09 20 28 66 6f 72 6d 61 74 ........ (format 3c40: 20 23 66 20 66 6d 74 73 74 72 20 22 3d 3d 3d 3d #f fmtstr "==== 3c50: 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d ====" "=====" "= 3c60: 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d ==" "======" "== 3c70: 3d 3d 22 29 29 0a 09 09 09 09 09 09 09 28 6d 61 =="))........(ma 3c80: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 p (lambda (x)... 3c90: 09 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 74 ..... ;; t 3ca0: 61 6b 65 20 61 64 76 61 6e 74 61 67 65 20 6f 66 ake advantage of 3cb0: 20 74 68 65 20 5c 6e 20 6f 6e 20 74 69 6d 65 2d the \n on time- 3cc0: 3e 73 74 72 69 6e 67 0a 09 09 09 09 09 09 09 20 >string........ 3cd0: 20 20 20 20 20 20 28 66 6f 72 6d 61 74 20 23 66 (format #f 3ce0: 20 66 6d 74 73 74 72 0a 09 09 09 09 09 09 09 09 fmtstr......... 3cf0: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 (vector-r 3d00: 65 66 20 78 20 30 29 0a 09 09 09 09 09 09 09 09 ef x 0)......... 3d10: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 20 (let ((s 3d20: 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 31 29 (vector-ref x 1) 3d30: 29 29 0a 09 09 09 09 09 09 09 09 09 20 28 69 66 )).......... (if 3d40: 20 28 6e 75 6d 62 65 72 3f 20 73 29 28 73 65 63 (number? s)(sec 3d50: 6f 6e 64 73 2d 3e 74 69 6d 65 2d 73 74 72 69 6e onds->time-strin 3d60: 67 20 73 29 20 73 29 29 0a 09 09 09 09 09 09 09 g s) s))........ 3d70: 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 . (let ((s 3d80: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 32 (vector-ref x 2 3d90: 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 28 69 ))).......... (i 3da0: 66 20 28 6e 75 6d 62 65 72 3f 20 73 29 28 73 65 f (number? s)(se 3db0: 63 6f 6e 64 73 2d 3e 74 69 6d 65 2d 73 74 72 69 conds->time-stri 3dc0: 6e 67 20 73 29 20 73 29 29 0a 09 09 09 09 09 09 ng s) s))....... 3dd0: 09 09 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 .. (vector 3de0: 2d 72 65 66 20 78 20 33 29 20 20 20 20 3b 3b 20 -ref x 3) ;; 3df0: 73 74 61 74 75 73 0a 09 09 09 09 09 09 09 09 20 status......... 3e00: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re 3e10: 66 20 78 20 34 29 29 29 20 20 3b 3b 20 74 69 6d f x 4))) ;; tim 3e20: 65 20 64 65 6c 74 61 0a 09 09 09 09 09 09 09 20 e delta........ 3e30: 20 20 20 20 28 73 6f 72 74 20 28 68 61 73 68 2d (sort (hash- 3e40: 74 61 62 6c 65 2d 76 61 6c 75 65 73 20 63 6f 6d table-values com 3e50: 70 72 73 74 65 70 73 29 0a 09 09 09 09 09 09 09 prsteps)........ 3e60: 09 20 20 20 28 6c 61 6d 62 64 61 20 28 61 20 62 . (lambda (a b 3e70: 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 28 )......... ( 3e80: 6c 65 74 20 28 28 74 69 6d 65 2d 61 20 28 76 65 let ((time-a (ve 3e90: 63 74 6f 72 2d 72 65 66 20 61 20 31 29 29 0a 09 ctor-ref a 1)).. 3ea0: 09 09 09 09 09 09 09 09 20 20 20 28 74 69 6d 65 ........ (time 3eb0: 2d 62 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 -b (vector-ref b 3ec0: 20 31 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 1)))......... 3ed0: 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e 75 6d (if (and (num 3ee0: 62 65 72 3f 20 74 69 6d 65 2d 61 29 28 6e 75 6d ber? time-a)(num 3ef0: 62 65 72 3f 20 74 69 6d 65 2d 62 29 29 0a 09 09 ber? time-b))... 3f00: 09 09 09 09 09 09 09 20 28 3c 20 74 69 6d 65 2d ....... (< time- 3f10: 61 20 74 69 6d 65 2d 62 29 0a 09 09 09 09 09 09 a time-b)....... 3f20: 09 09 09 20 23 74 29 29 29 29 29 29 0a 09 09 09 ... #t)))))).... 3f30: 09 09 09 20 20 20 20 20 20 20 22 5c 6e 22 29 29 ... "\n")) 3f40: 29 0a 09 09 09 09 09 28 69 66 20 28 6e 6f 74 20 )......(if (not 3f50: 28 65 71 75 61 6c 3f 20 63 75 72 72 76 61 6c 20 (equal? currval 3f60: 6e 65 77 76 61 6c 29 29 0a 09 09 09 09 09 20 20 newval))...... 3f70: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute 3f80: 2d 73 65 74 21 20 73 74 65 70 73 64 61 74 20 22 -set! stepsdat " 3f90: 56 41 4c 55 45 22 20 6e 65 77 76 61 6c 20 29 29 VALUE" newval )) 3fa0: 29 29 29 20 3b 3b 20 22 54 49 54 4c 45 22 20 6e ))) ;; "TITLE" n 3fb0: 65 77 76 61 6c 29 29 29 29 29 0a 09 09 20 20 20 ewval)))))... 3fc0: 73 74 65 70 73 64 61 74 29 29 0a 09 09 3b 3b 20 stepsdat))...;; 3fd0: 70 6f 70 75 6c 61 74 65 20 74 68 65 20 54 65 73 populate the Tes 3fe0: 74 20 44 61 74 61 20 70 61 6e 65 6c 0a 09 09 28 t Data panel...( 3ff0: 69 75 70 3a 66 72 61 6d 65 0a 09 09 20 23 3a 74 iup:frame... #:t 4000: 69 74 6c 65 20 22 54 65 73 74 20 44 61 74 61 22 itle "Test Data" 4010: 0a 09 09 20 28 6c 65 74 20 28 28 74 65 73 74 2d ... (let ((test- 4020: 64 61 74 61 0a 09 09 09 28 69 75 70 3a 74 65 78 data....(iup:tex 4030: 74 62 6f 78 20 20 3b 3b 20 23 3a 61 63 74 69 6f tbox ;; #:actio 4040: 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 63 n (lambda (obj c 4050: 68 61 72 20 76 61 6c 29 0a 09 09 09 09 20 20 20 har val)..... 4060: 20 20 20 3b 3b 20 20 20 09 23 66 29 0a 09 09 09 ;; .#f).... 4070: 09 20 20 20 20 20 20 23 3a 65 78 70 61 6e 64 20 . #:expand 4080: 22 59 45 53 22 0a 09 09 09 09 20 20 20 20 20 20 "YES"..... 4090: 23 3a 6d 75 6c 74 69 6c 69 6e 65 20 22 59 45 53 #:multiline "YES 40a0: 22 0a 09 09 09 09 20 20 20 20 20 20 23 3a 66 6f "..... #:fo 40b0: 6e 74 20 22 43 6f 75 72 69 65 72 20 4e 65 77 2c nt "Courier New, 40c0: 20 2d 31 30 22 0a 09 09 09 09 20 20 20 20 20 20 -10"..... 40d0: 23 3a 73 69 7a 65 20 22 31 30 30 78 31 30 30 22 #:size "100x100" 40e0: 29 29 29 0a 09 09 20 20 20 28 68 61 73 68 2d 74 )))... (hash-t 40f0: 61 62 6c 65 2d 73 65 74 21 20 77 69 64 67 65 74 able-set! widget 4100: 73 20 22 54 65 73 74 20 44 61 74 61 22 0a 09 09 s "Test Data"... 4110: 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 .. (lambda (t 4120: 65 73 74 64 61 74 29 20 3b 3b 20 0a 09 09 09 09 estdat) ;; ..... 4130: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 75 (let* ((cu 4140: 72 72 76 61 6c 20 28 69 75 70 3a 61 74 74 72 69 rrval (iup:attri 4150: 62 75 74 65 20 74 65 73 74 2d 64 61 74 61 20 22 bute test-data " 4160: 56 41 4c 55 45 22 29 29 20 3b 3b 20 22 54 49 54 VALUE")) ;; "TIT 4170: 4c 45 22 29 29 0a 09 09 09 09 09 20 20 20 20 20 LE"))...... 4180: 28 66 6d 74 73 74 72 20 20 22 7e 31 30 61 7e 31 (fmtstr "~10a~1 4190: 30 61 7e 31 30 61 7e 31 30 61 7e 37 61 7e 37 61 0a~10a~10a~7a~7a 41a0: 7e 36 61 7e 61 22 29 20 3b 3b 20 63 61 74 65 67 ~6a~a") ;; categ 41b0: 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 6c ory,variable,val 41c0: 75 65 2c 65 78 70 65 63 74 65 64 2c 74 6f 6c 2c ue,expected,tol, 41d0: 75 6e 69 74 73 2c 63 6f 6d 6d 65 6e 74 0a 09 09 units,comment... 41e0: 09 09 09 20 20 20 20 20 28 6e 65 77 76 61 6c 20 ... (newval 41f0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp 4200: 65 72 73 65 20 0a 09 09 09 09 09 09 20 20 20 20 erse ....... 4210: 20 20 20 28 61 70 70 65 6e 64 0a 09 09 09 09 09 (append...... 4220: 09 09 28 6c 69 73 74 20 0a 09 09 09 09 09 09 09 ..(list ........ 4230: 20 28 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 (format #f fmts 4240: 74 72 20 22 43 61 74 65 67 6f 72 79 22 20 22 56 tr "Category" "V 4250: 61 72 69 61 62 6c 65 22 20 22 56 61 6c 75 65 22 ariable" "Value" 4260: 20 22 45 78 70 65 63 74 65 64 22 20 22 54 6f 6c "Expected" "Tol 4270: 22 20 22 53 74 61 74 75 73 22 20 22 55 6e 69 74 " "Status" "Unit 4280: 73 22 20 22 43 6f 6d 6d 65 6e 74 22 29 0a 09 09 s" "Comment")... 4290: 09 09 09 09 09 20 28 66 6f 72 6d 61 74 20 23 66 ..... (format #f 42a0: 20 66 6d 74 73 74 72 20 22 3d 3d 3d 3d 3d 3d 3d fmtstr "======= 42b0: 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d =" "========" "= 42c0: 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 ====" "========" 42d0: 20 22 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 22 20 "===" "======" 42e0: 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d "=====" "======= 42f0: 22 29 29 0a 09 09 09 09 09 09 09 28 6d 61 70 20 "))........(map 4300: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 (lambda (x)..... 4310: 09 09 09 20 20 20 20 20 20 20 28 66 6f 72 6d 61 ... (forma 4320: 74 20 23 66 20 66 6d 74 73 74 72 0a 09 09 09 09 t #f fmtstr..... 4330: 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a 74 .... (db:t 4340: 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 63 61 74 est-data-get-cat 4350: 65 67 6f 72 79 20 78 29 0a 09 09 09 09 09 09 09 egory x)........ 4360: 09 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 . (db:test 4370: 2d 64 61 74 61 2d 67 65 74 2d 76 61 72 69 61 62 -data-get-variab 4380: 6c 65 20 78 29 0a 09 09 09 09 09 09 09 09 20 20 le x)......... 4390: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 64 61 (db:test-da 43a0: 74 61 2d 67 65 74 2d 76 61 6c 75 65 20 20 20 20 ta-get-value 43b0: 78 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 x)......... 43c0: 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d (db:test-data- 43d0: 67 65 74 2d 65 78 70 65 63 74 65 64 20 78 29 0a get-expected x). 43e0: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ ( 43f0: 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 db:test-data-get 4400: 2d 74 6f 6c 20 20 20 20 20 20 78 29 0a 09 09 09 -tol x).... 4410: 09 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a ..... (db: 4420: 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 73 74 test-data-get-st 4430: 61 74 75 73 20 20 20 78 29 0a 09 09 09 09 09 09 atus x)....... 4440: 09 09 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 .. (db:tes 4450: 74 2d 64 61 74 61 2d 67 65 74 2d 75 6e 69 74 73 t-data-get-units 4460: 20 20 20 20 78 29 0a 09 09 09 09 09 09 09 09 20 x)......... 4470: 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 64 (db:test-d 4480: 61 74 61 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 ata-get-comment 4490: 20 78 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 x)))........ 44a0: 20 20 28 64 62 3a 72 65 61 64 2d 74 65 73 74 2d (db:read-test- 44b0: 64 61 74 61 20 64 62 20 74 65 73 74 2d 69 64 20 data db test-id 44c0: 22 25 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 "%")))....... 44d0: 20 20 20 20 22 5c 6e 22 29 29 29 0a 09 09 09 09 "\n")))..... 44e0: 09 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c .(if (not (equal 44f0: 3f 20 63 75 72 72 76 61 6c 20 6e 65 77 76 61 6c ? currval newval 4500: 29 29 0a 09 09 09 09 09 20 20 20 20 28 69 75 70 ))...... (iup 4510: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set! 4520: 74 65 73 74 2d 64 61 74 61 20 22 56 41 4c 55 45 test-data "VALUE 4530: 22 20 6e 65 77 76 61 6c 20 29 29 29 29 29 20 3b " newval ))))) ; 4540: 3b 20 22 54 49 54 4c 45 22 20 6e 65 77 76 61 6c ; "TITLE" newval 4550: 29 29 29 29 29 0a 09 09 20 20 20 74 65 73 74 2d )))))... test- 4560: 64 61 74 61 29 29 29 0a 09 09 29 29 29 0a 20 20 data)))...))). 4570: 20 20 20 20 28 69 75 70 3a 73 68 6f 77 20 73 65 (iup:show se 4580: 6c 66 29 0a 20 20 20 20 20 20 28 69 75 70 3a 63 lf). (iup:c 4590: 61 6c 6c 62 61 63 6b 2d 73 65 74 21 20 2a 74 69 allback-set! *ti 45a0: 6d 2a 20 22 41 43 54 49 4f 4e 5f 43 42 22 0a 09 m* "ACTION_CB".. 45b0: 09 09 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 .. (lambda (x).. 45c0: 09 09 20 20 20 3b 3b 20 4e 6f 77 20 73 74 61 72 .. ;; Now star 45d0: 74 20 6b 65 65 70 69 6e 67 20 74 68 65 20 67 75 t keeping the gu 45e0: 69 20 75 70 64 61 74 65 64 20 66 72 6f 6d 20 74 i updated from t 45f0: 68 65 20 64 62 0a 09 09 09 20 20 20 28 72 65 66 he db.... (ref 4600: 72 65 73 68 64 61 74 29 20 3b 3b 20 75 70 64 61 reshdat) ;; upda 4610: 74 65 20 66 72 6f 6d 20 74 68 65 20 64 62 20 68 te from the db h 4620: 65 72 65 0a 09 09 09 09 09 3b 28 74 68 72 65 61 ere......;(threa 4630: 64 2d 73 75 73 70 65 6e 64 21 20 6f 74 68 65 72 d-suspend! other 4640: 2d 74 68 72 65 61 64 29 0a 09 09 09 20 20 20 3b -thread).... ; 4650: 3b 20 75 70 64 61 74 65 20 74 68 65 20 67 75 69 ; update the gui 4660: 20 65 6c 65 6d 65 6e 74 73 20 68 65 72 65 0a 09 elements here.. 4670: 09 09 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a .. (for-each . 4680: 09 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ... (lambda ( 4690: 6b 65 79 29 0a 09 09 09 20 20 20 20 20 20 3b 3b key).... ;; 46a0: 20 28 70 72 69 6e 74 20 22 55 70 64 61 74 69 6e (print "Updatin 46b0: 67 20 22 20 6b 65 79 29 0a 09 09 09 20 20 20 20 g " key).... 46c0: 20 20 28 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ((hash-table-r 46d0: 65 66 20 77 69 64 67 65 74 73 20 6b 65 79 29 20 ef widgets key) 46e0: 74 65 73 74 64 61 74 29 29 0a 09 09 09 20 20 20 testdat)).... 46f0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 (hash-table-key 4700: 73 20 77 69 64 67 65 74 73 29 29 0a 09 09 09 20 s widgets)).... 4710: 20 20 28 75 70 64 61 74 65 2d 73 74 61 74 65 2d (update-state- 4720: 73 74 61 74 75 73 2d 62 75 74 74 6f 6e 73 20 74 status-buttons t 4730: 65 73 74 64 61 74 29 0a 09 09 09 09 09 3b 20 28 estdat)......; ( 4740: 69 75 70 3a 72 65 66 72 65 73 68 20 73 65 6c 66 iup:refresh self 4750: 29 0a 09 09 09 20 20 20 28 69 66 20 2a 65 78 69 ).... (if *exi 4760: 74 2d 73 74 61 72 74 65 64 2a 0a 09 09 09 20 20 t-started*.... 4770: 20 20 20 20 20 28 73 65 74 21 20 2a 65 78 69 74 (set! *exit 4780: 2d 73 74 61 72 74 65 64 2a 20 27 6f 6b 29 29 29 -started* 'ok))) 4790: 29 29 29 29 29 0a 0a )))))..