Artifact
cd363a9628cd7b0be32461ddf9f768e0d9df1c8d:
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d ==========..;;==
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 20 69 6e 66 ====.;; Test inf
0230: 6f 20 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d o panel.;;======
0240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0280: 0a 0a 28 75 73 65 20 66 6f 72 6d 61 74 20 66 6d ..(use format fm
0290: 74 29 0a 28 72 65 71 75 69 72 65 2d 6c 69 62 72 t).(require-libr
02a0: 61 72 79 20 69 75 70 29 0a 28 69 6d 70 6f 72 74 ary iup).(import
02b0: 20 28 70 72 65 66 69 78 20 69 75 70 20 69 75 70 (prefix iup iup
02c0: 3a 29 29 0a 0a 28 75 73 65 20 63 61 6e 76 61 73 :))..(use canvas
02d0: 2d 64 72 61 77 29 0a 0a 28 75 73 65 20 73 72 66 -draw)..(use srf
02e0: 69 2d 31 20 70 6f 73 69 78 20 72 65 67 65 78 20 i-1 posix regex
02f0: 72 65 67 65 78 2d 63 61 73 65 20 73 72 66 69 2d regex-case srfi-
0300: 36 39 29 0a 28 75 73 65 20 28 70 72 65 66 69 78 69).(use (prefix
0310: 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 sqlite3 sqlite3
0320: 3a 29 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 :))..(declare (u
0330: 6e 69 74 20 64 61 73 68 62 6f 61 72 64 2d 74 65 nit dashboard-te
0340: 73 74 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 sts)).(declare (
0350: 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 uses common)).(d
0360: 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 29 eclare (uses db)
0370: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0380: 20 67 75 74 69 6c 73 29 29 0a 28 64 65 63 6c 61 gutils)).(decla
0390: 72 65 20 28 75 73 65 73 20 72 6d 74 29 29 0a 28 re (uses rmt)).(
03a0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 65 7a declare (uses ez
03b0: 73 74 65 70 73 29 29 0a 3b 3b 20 28 64 65 63 6c steps)).;; (decl
03c0: 61 72 65 20 28 75 73 65 73 20 73 64 62 29 29 0a are (uses sdb)).
03d0: 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 75 73 65 ;; (declare (use
03e0: 73 20 66 69 6c 65 64 62 29 29 0a 0a 28 69 6e 63 s filedb))..(inc
03f0: 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 lude "common_rec
0400: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl
0410: 75 64 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e ude "db_records.
0420: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
0430: 72 75 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 run_records.scm"
0440: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
0450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 ===========.;; C
0490: 20 4f 20 4d 20 4d 20 4f 20 4e 0a 3b 3b 3d 3d 3d O M M O N.;;===
04a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
04b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
04c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
04d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
04e0: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 2a 64 61 ===..(define *da
04f0: 73 68 62 6f 61 72 64 2d 63 6f 6d 6d 65 6e 74 2d shboard-comment-
0500: 73 68 61 72 65 2d 73 6c 6f 74 2a 20 23 66 29 0a share-slot* #f).
0510: 0a 28 64 65 66 69 6e 65 20 28 64 74 65 73 74 73 .(define (dtests
0520: 3a 67 65 74 2d 70 72 65 2d 63 6f 6d 6d 61 6e 64 :get-pre-command
0530: 20 23 21 6b 65 79 20 28 64 65 66 61 75 6c 74 2d #!key (default-
0540: 6f 76 65 72 72 69 64 65 20 23 66 29 29 0a 20 20 override #f)).
0550: 28 6c 65 74 20 28 28 63 66 67 2d 6f 76 72 64 20 (let ((cfg-ovrd
0560: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
0570: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 64 61 73 *configdat* "das
0580: 68 62 6f 61 72 64 22 20 22 70 72 65 2d 63 6f 6d hboard" "pre-com
0590: 6d 61 6e 64 22 29 29 29 0a 20 20 20 20 28 6f 72 mand"))). (or
05a0: 20 63 66 67 2d 6f 76 72 64 20 64 65 66 61 75 6c cfg-ovrd defaul
05b0: 74 2d 6f 76 65 72 72 69 64 65 20 22 76 69 65 77 t-override "view
05c0: 73 63 72 65 65 6e 20 22 29 29 29 20 3b 3b 20 22 screen "))) ;; "
05d0: 78 74 65 72 6d 20 2d 67 65 6f 6d 65 74 72 79 20 xterm -geometry
05e0: 31 38 30 78 32 30 20 2d 65 20 5c 22 22 29 29 29 180x20 -e \"")))
05f0: 0a 0a 28 64 65 66 69 6e 65 20 28 64 74 65 73 74 ..(define (dtest
0600: 73 3a 67 65 74 2d 70 6f 73 74 2d 63 6f 6d 6d 61 s:get-post-comma
0610: 6e 64 20 23 21 6b 65 79 20 28 64 65 66 61 75 6c nd #!key (defaul
0620: 74 2d 6f 76 65 72 72 69 64 65 20 23 66 29 29 0a t-override #f)).
0630: 20 20 28 6c 65 74 20 28 28 63 66 67 2d 6f 76 72 (let ((cfg-ovr
0640: 64 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 d (configf:looku
0650: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 64 p *configdat* "d
0660: 61 73 68 62 6f 61 72 64 22 20 22 70 6f 73 74 2d ashboard" "post-
0670: 63 6f 6d 6d 61 6e 64 22 29 29 29 0a 20 20 20 20 command"))).
0680: 28 6f 72 20 63 66 67 2d 6f 76 72 64 20 64 65 66 (or cfg-ovrd def
0690: 61 75 6c 74 2d 6f 76 65 72 72 69 64 65 20 22 22 ault-override ""
06a0: 29 29 29 20 3b 3b 20 22 3b 65 63 68 6f 20 50 72 ))) ;; ";echo Pr
06b0: 65 73 73 20 61 6e 79 20 6b 65 79 20 74 6f 20 63 ess any key to c
06c0: 6f 6e 74 69 6e 75 65 3b 62 61 73 68 20 2d 63 20 ontinue;bash -c
06d0: 27 72 65 61 64 20 2d 6e 20 31 20 2d 73 27 5c 22 'read -n 1 -s'\"
06e0: 20 26 22 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 &")))...(define
06f0: 20 28 74 65 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 (test-info-pane
0700: 6c 20 74 65 73 74 64 61 74 20 73 74 6f 72 65 2d l testdat store-
0710: 6c 61 62 65 6c 20 77 69 64 67 65 74 73 29 0a 20 label widgets).
0720: 20 28 69 75 70 3a 66 72 61 6d 65 20 0a 20 20 20 (iup:frame .
0730: 23 3a 74 69 74 6c 65 20 22 54 65 73 74 20 49 6e #:title "Test In
0740: 66 6f 22 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 fo" ; #:expand "
0750: 59 45 53 22 0a 20 20 20 28 69 75 70 3a 68 62 6f YES". (iup:hbo
0760: 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 x ; #:expand "YE
0770: 53 22 0a 20 20 20 20 28 61 70 70 6c 79 20 69 75 S". (apply iu
0780: 70 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e p:vbox ; #:expan
0790: 64 20 22 59 45 53 22 0a 09 20 20 20 28 61 70 70 d "YES".. (app
07a0: 65 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 end (map (lambda
07b0: 20 28 76 61 6c 29 0a 09 09 09 20 20 28 69 75 70 (val).... (iup
07c0: 3a 6c 61 62 65 6c 20 76 61 6c 20 3b 20 23 3a 65 :label val ; #:e
07d0: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
07e0: 4c 22 0a 09 09 09 09 20 20 20 20 20 29 29 0a 09 L"..... ))..
07f0: 09 09 28 6c 69 73 74 20 22 54 65 73 74 6e 61 6d ..(list "Testnam
0800: 65 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 49 e: ".... "I
0810: 74 65 6d 20 70 61 74 68 3a 20 22 0a 09 09 09 20 tem path: "....
0820: 20 20 20 20 20 22 43 75 72 72 65 6e 74 20 73 74 "Current st
0830: 61 74 65 3a 20 22 0a 09 09 09 20 20 20 20 20 20 ate: "....
0840: 22 43 75 72 72 65 6e 74 20 73 74 61 74 75 73 3a "Current status:
0850: 20 22 0a 09 09 09 20 20 20 20 20 20 22 54 65 73 ".... "Tes
0860: 74 20 63 6f 6d 6d 65 6e 74 3a 20 22 0a 09 09 09 t comment: "....
0870: 20 20 20 20 20 20 22 54 65 73 74 20 69 64 3a 20 "Test id:
0880: 22 0a 09 09 09 20 20 20 20 20 20 22 54 65 73 74 ".... "Test
0890: 20 64 61 74 65 3a 20 22 29 29 0a 09 09 20 20 20 date: "))...
08a0: 28 6c 69 73 74 20 28 69 75 70 3a 6c 61 62 65 6c (list (iup:label
08b0: 20 22 22 20 23 3a 65 78 70 61 6e 64 20 22 56 45 "" #:expand "VE
08c0: 52 54 49 43 41 4c 22 29 29 29 29 0a 20 20 20 20 RTICAL")))).
08d0: 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 (apply iup:vbox
08e0: 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 ; #:expand "YES
08f0: 22 0a 09 20 20 20 28 6c 69 73 74 20 0a 09 20 20 ".. (list ..
0900: 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 (store-label "
0910: 74 65 73 74 6e 61 6d 65 22 0a 09 09 09 20 28 69 testname".... (i
0920: 75 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 up:label (db:tes
0930: 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 t-get-testname
0940: 74 65 73 74 64 61 74 29 20 23 3a 65 78 70 61 6e testdat) #:expan
0950: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a d "HORIZONTAL").
0960: 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 ... (lambda (tes
0970: 74 64 61 74 29 28 64 62 3a 74 65 73 74 2d 67 65 tdat)(db:test-ge
0980: 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 64 t-testname testd
0990: 61 74 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 at))).. (stor
09a0: 65 2d 6c 61 62 65 6c 20 22 69 74 65 6d 2d 70 61 e-label "item-pa
09b0: 74 68 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 th".... (iup:lab
09c0: 65 6c 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d el (db:test-get-
09d0: 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 64 61 item-path testda
09e0: 74 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 t) #:expand "HOR
09f0: 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c IZONTAL").... (l
0a00: 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 28 ambda (testdat)(
0a10: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d db:test-get-item
0a20: 2d 70 61 74 68 20 74 65 73 74 64 61 74 29 29 29 -path testdat)))
0a30: 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 .. (store-lab
0a40: 65 6c 20 22 74 65 73 74 73 74 61 74 65 22 20 0a el "teststate" .
0a50: 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 ... (iup:label (
0a60: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
0a70: 65 20 74 65 73 74 64 61 74 29 20 23 3a 65 78 70 e testdat) #:exp
0a80: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
0a90: 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 ).... (lambda (t
0aa0: 65 73 74 64 61 74 29 0a 09 09 09 20 20 20 28 64 estdat).... (d
0ab0: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
0ac0: 20 74 65 73 74 64 61 74 29 29 29 0a 09 20 20 20 testdat)))..
0ad0: 20 28 6c 65 74 20 28 28 6c 62 6c 20 20 20 28 69 (let ((lbl (i
0ae0: 75 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 up:label (db:tes
0af0: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t-get-status tes
0b00: 74 64 61 74 29 20 23 3a 65 78 70 61 6e 64 20 22 tdat) #:expand "
0b10: 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 29 29 0a 09 HORIZONTAL")))..
0b20: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
0b30: 65 2d 73 65 74 21 20 77 69 64 67 65 74 73 20 22 e-set! widgets "
0b40: 74 65 73 74 73 74 61 74 75 73 22 0a 09 09 09 20 teststatus"....
0b50: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 (lambda (t
0b60: 65 73 74 64 61 74 29 0a 09 09 09 09 20 28 6c 65 estdat)..... (le
0b70: 74 20 28 28 6e 65 77 73 74 61 74 75 73 20 28 64 t ((newstatus (d
0b80: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 b:test-get-statu
0b90: 73 20 74 65 73 74 64 61 74 29 29 0a 09 09 09 09 s testdat)).....
0ba0: 20 20 20 20 20 20 20 28 6f 6c 64 73 74 61 74 75 (oldstatu
0bb0: 73 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 s (iup:attribute
0bc0: 20 6c 62 6c 20 22 54 49 54 4c 45 22 29 29 29 0a lbl "TITLE"))).
0bd0: 09 09 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 .... (if (not
0be0: 28 65 71 75 61 6c 3f 20 6f 6c 64 73 74 61 74 75 (equal? oldstatu
0bf0: 73 20 6e 65 77 73 74 61 74 75 73 29 29 0a 09 09 s newstatus))...
0c00: 09 09 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a .. (begin.
0c10: 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 ..... (iup:attri
0c20: 62 75 74 65 2d 73 65 74 21 20 6c 62 6c 20 22 46 bute-set! lbl "F
0c30: 47 43 4f 4c 4f 52 22 20 28 63 61 72 20 28 67 75 GCOLOR" (car (gu
0c40: 74 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 tils:get-color-f
0c50: 6f 72 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 or-state-status
0c60: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
0c70: 74 65 20 74 65 73 74 64 61 74 29 0a 09 09 09 09 te testdat).....
0c80: 09 09 09 09 09 09 09 09 09 09 20 20 20 28 64 62 .......... (db
0c90: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
0ca0: 20 74 65 73 74 64 61 74 29 29 29 29 0a 09 09 09 testdat))))....
0cb0: 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 .. (iup:attribut
0cc0: 65 2d 73 65 74 21 20 6c 62 6c 20 22 54 49 54 4c e-set! lbl "TITL
0cd0: 45 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d E" (db:test-get-
0ce0: 73 74 61 74 75 73 20 74 65 73 74 64 61 74 29 29 status testdat))
0cf0: 29 29 29 29 29 0a 09 20 20 20 20 20 20 6c 62 6c ))))).. lbl
0d00: 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 ).. (store-la
0d10: 62 65 6c 20 22 74 65 73 74 63 6f 6d 6d 65 6e 74 bel "testcomment
0d20: 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c ".... (iup:label
0d30: 20 22 54 65 73 74 43 6f 6d 6d 65 6e 74 20 20 20 "TestComment
0d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d50: 20 20 20 20 20 20 20 20 20 20 22 0a 09 09 09 09 ".....
0d60: 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 48 4f #:expand "HO
0d70: 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 RIZONTAL").... (
0d80: 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 lambda (testdat)
0d90: 0a 09 09 09 20 20 20 28 6c 65 74 20 28 28 6e 65 .... (let ((ne
0da0: 77 63 6f 6d 6d 65 6e 74 20 28 64 62 3a 74 65 73 wcomment (db:tes
0db0: 74 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 74 65 t-get-comment te
0dc0: 73 74 64 61 74 29 29 29 0a 09 09 09 20 20 20 20 stdat)))....
0dd0: 20 28 69 66 20 2a 64 61 73 68 62 6f 61 72 64 2d (if *dashboard-
0de0: 63 6f 6d 6d 65 6e 74 2d 73 68 61 72 65 2d 73 6c comment-share-sl
0df0: 6f 74 2a 0a 09 09 09 09 20 28 69 66 20 28 6e 6f ot*..... (if (no
0e00: 74 20 28 65 71 75 61 6c 3f 20 28 69 75 70 3a 61 t (equal? (iup:a
0e10: 74 74 72 69 62 75 74 65 20 2a 64 61 73 68 62 6f ttribute *dashbo
0e20: 61 72 64 2d 63 6f 6d 6d 65 6e 74 2d 73 68 61 72 ard-comment-shar
0e30: 65 2d 73 6c 6f 74 2a 20 22 56 41 4c 55 45 22 29 e-slot* "VALUE")
0e40: 0a 09 09 09 09 09 09 20 20 6e 65 77 63 6f 6d 6d ....... newcomm
0e50: 65 6e 74 29 29 0a 09 09 09 09 20 20 20 20 20 28 ent))..... (
0e60: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
0e70: 74 21 20 2a 64 61 73 68 62 6f 61 72 64 2d 63 6f t! *dashboard-co
0e80: 6d 6d 65 6e 74 2d 73 68 61 72 65 2d 73 6c 6f 74 mment-share-slot
0e90: 2a 0a 09 09 09 09 09 09 09 20 22 56 41 4c 55 45 *........ "VALUE
0ea0: 22 0a 09 09 09 09 09 09 09 20 6e 65 77 63 6f 6d "........ newcom
0eb0: 6d 65 6e 74 29 29 29 0a 09 09 09 20 20 20 20 20 ment)))....
0ec0: 6e 65 77 63 6f 6d 6d 65 6e 74 29 29 29 0a 09 20 newcomment)))..
0ed0: 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 (store-label
0ee0: 22 74 65 73 74 69 64 22 0a 09 09 09 20 28 69 75 "testid".... (iu
0ef0: 70 3a 6c 61 62 65 6c 20 22 54 65 73 74 49 64 20 p:label "TestId
0f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f10: 20 20 20 20 20 20 20 20 20 20 20 20 22 0a 09 09 "...
0f20: 09 09 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 .. #:expand "
0f30: 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 HORIZONTAL")....
0f40: 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 (lambda (testda
0f50: 74 29 0a 09 09 09 20 20 20 28 64 62 3a 74 65 73 t).... (db:tes
0f60: 74 2d 67 65 74 2d 69 64 20 74 65 73 74 64 61 74 t-get-id testdat
0f70: 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d ))).. (store-
0f80: 6c 61 62 65 6c 20 22 74 65 73 74 64 61 74 65 22 label "testdate"
0f90: 20 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c .... (iup:label
0fa0: 20 22 54 65 73 74 44 61 74 65 20 20 20 20 20 20 "TestDate
0fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fc0: 20 20 20 20 20 22 0a 09 09 09 09 20 20 20 20 23 "..... #
0fd0: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON
0fe0: 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 TAL").... (lambd
0ff0: 61 20 28 74 65 73 74 64 61 74 29 0a 09 09 09 20 a (testdat)....
1000: 20 20 28 73 65 63 6f 6e 64 73 2d 3e 77 6f 72 6b (seconds->work
1010: 2d 77 65 65 6b 2f 64 61 79 2d 74 69 6d 65 20 28 -week/day-time (
1020: 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e db:test-get-even
1030: 74 5f 74 69 6d 65 20 74 65 73 74 64 61 74 29 29 t_time testdat))
1040: 29 29 0a 09 20 20 20 20 29 29 29 29 29 0a 0a 3b )).. )))))..;
1050: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
1060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 54 65 73 74 20 =======.;; Test
10a0: 6d 65 74 61 20 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d meta panel.;;===
10b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d0: 3d 3d 3d 3d 3d 3d 3d 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 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 ===..(define (te
1100: 73 74 2d 6d 65 74 61 2d 70 61 6e 65 6c 2d 67 65 st-meta-panel-ge
1110: 74 2d 64 65 73 63 72 69 70 74 69 6f 6e 20 74 65 t-description te
1120: 73 74 6d 65 74 61 29 0a 20 20 28 66 6d 74 20 23 stmeta). (fmt #
1130: 66 20 28 77 69 74 68 2d 77 69 64 74 68 20 34 30 f (with-width 40
1140: 20 28 77 72 61 70 2d 6c 69 6e 65 73 20 28 64 62 (wrap-lines (db
1150: 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 64 65 :testmeta-get-de
1160: 73 63 72 69 70 74 69 6f 6e 20 74 65 73 74 6d 65 scription testme
1170: 74 61 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 ta)))))..(define
1180: 20 28 74 65 73 74 2d 6d 65 74 61 2d 70 61 6e 65 (test-meta-pane
1190: 6c 20 74 65 73 74 6d 65 74 61 20 73 74 6f 72 65 l testmeta store
11a0: 2d 6d 65 74 61 29 0a 20 20 28 69 75 70 3a 66 72 -meta). (iup:fr
11b0: 61 6d 65 20 0a 20 20 20 23 3a 74 69 74 6c 65 20 ame . #:title
11c0: 22 54 65 73 74 20 4d 65 74 61 20 44 61 74 61 22 "Test Meta Data"
11d0: 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 ; #:expand "YES
11e0: 22 0a 20 20 20 28 69 75 70 3a 68 62 6f 78 20 3b ". (iup:hbox ;
11f0: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
1200: 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 (apply iup:v
1210: 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 box ; #:expand "
1220: 59 45 53 22 0a 09 20 20 20 28 61 70 70 65 6e 64 YES".. (append
1230: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 76 (map (lambda (v
1240: 61 6c 29 0a 09 09 09 20 20 28 69 75 70 3a 6c 61 al).... (iup:la
1250: 62 65 6c 20 76 61 6c 20 3b 20 23 3a 65 78 70 61 bel val ; #:expa
1260: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a nd "HORIZONTAL".
1270: 09 09 09 09 20 20 20 20 20 29 29 0a 09 09 09 28 .... ))....(
1280: 6c 69 73 74 20 22 41 75 74 68 6f 72 3a 20 22 0a list "Author: ".
1290: 09 09 09 20 20 20 20 20 20 22 4f 77 6e 65 72 3a ... "Owner:
12a0: 20 22 0a 09 09 09 20 20 20 20 20 20 22 52 65 76 ".... "Rev
12b0: 69 65 77 65 64 3a 20 22 0a 09 09 09 20 20 20 20 iewed: "....
12c0: 20 20 22 54 61 67 73 3a 20 22 0a 09 09 09 20 20 "Tags: "....
12d0: 20 20 20 20 22 44 65 73 63 72 69 70 74 69 6f 6e "Description
12e0: 3a 20 22 29 29 0a 09 09 20 20 20 28 6c 69 73 74 : "))... (list
12f0: 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 22 20 23 (iup:label "" #
1300: 3a 65 78 70 61 6e 64 20 22 56 45 52 54 49 43 41 :expand "VERTICA
1310: 4c 22 29 29 29 29 0a 20 20 20 20 28 61 70 70 6c L")))). (appl
1320: 79 20 69 75 70 3a 76 62 6f 78 20 20 3b 20 23 3a y iup:vbox ; #:
1330: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 20 20 expand "YES"..
1340: 20 28 6c 69 73 74 20 0a 09 20 20 20 20 28 73 74 (list .. (st
1350: 6f 72 65 2d 6d 65 74 61 20 22 61 75 74 68 6f 72 ore-meta "author
1360: 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c ".... (iup:label
1370: 20 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 (db:testmeta-ge
1380: 74 2d 61 75 74 68 6f 72 20 74 65 73 74 6d 65 74 t-author testmet
1390: 61 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 a) #:expand "HOR
13a0: 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c IZONTAL").... (l
13b0: 61 6d 62 64 61 20 28 74 65 73 74 6d 65 74 61 29 ambda (testmeta)
13c0: 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 (db:testmeta-get
13d0: 2d 61 75 74 68 6f 72 20 74 65 73 74 6d 65 74 61 -author testmeta
13e0: 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d ))).. (store-
13f0: 6d 65 74 61 20 22 6f 77 6e 65 72 22 0a 09 09 09 meta "owner"....
1400: 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 62 3a (iup:label (db:
1410: 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 6f 77 6e testmeta-get-own
1420: 65 72 20 74 65 73 74 6d 65 74 61 29 20 23 3a 65 er testmeta) #:e
1430: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
1440: 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 L").... (lambda
1450: 28 74 65 73 74 6d 65 74 61 29 28 64 62 3a 74 65 (testmeta)(db:te
1460: 73 74 6d 65 74 61 2d 67 65 74 2d 6f 77 6e 65 72 stmeta-get-owner
1470: 20 74 65 73 74 6d 65 74 61 29 29 29 0a 09 20 20 testmeta)))..
1480: 20 20 28 73 74 6f 72 65 2d 6d 65 74 61 20 22 72 (store-meta "r
1490: 65 76 69 65 77 65 64 22 20 0a 09 09 09 20 28 69 eviewed" .... (i
14a0: 75 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 up:label (db:tes
14b0: 74 6d 65 74 61 2d 67 65 74 2d 72 65 76 69 65 77 tmeta-get-review
14c0: 65 64 20 74 65 73 74 6d 65 74 61 29 20 23 3a 65 ed testmeta) #:e
14d0: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
14e0: 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 L").... (lambda
14f0: 28 74 65 73 74 6d 65 74 61 29 28 64 62 3a 74 65 (testmeta)(db:te
1500: 73 74 6d 65 74 61 2d 67 65 74 2d 72 65 76 69 65 stmeta-get-revie
1510: 77 65 64 20 74 65 73 74 6d 65 74 61 29 29 29 0a wed testmeta))).
1520: 09 20 20 20 20 28 73 74 6f 72 65 2d 6d 65 74 61 . (store-meta
1530: 20 22 74 61 67 73 22 20 0a 09 09 09 20 28 69 75 "tags" .... (iu
1540: 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 74 p:label (db:test
1550: 6d 65 74 61 2d 67 65 74 2d 74 61 67 73 20 74 65 meta-get-tags te
1560: 73 74 6d 65 74 61 29 20 23 3a 65 78 70 61 6e 64 stmeta) #:expand
1570: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 "HORIZONTAL")..
1580: 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 .. (lambda (test
1590: 6d 65 74 61 29 28 64 62 3a 74 65 73 74 6d 65 74 meta)(db:testmet
15a0: 61 2d 67 65 74 2d 74 61 67 73 20 74 65 73 74 6d a-get-tags testm
15b0: 65 74 61 29 29 29 0a 09 20 20 20 20 28 73 74 6f eta))).. (sto
15c0: 72 65 2d 6d 65 74 61 20 22 64 65 73 63 72 69 70 re-meta "descrip
15d0: 74 69 6f 6e 22 20 0a 09 09 09 20 28 69 75 70 3a tion" .... (iup:
15e0: 6c 61 62 65 6c 20 28 74 65 73 74 2d 6d 65 74 61 label (test-meta
15f0: 2d 70 61 6e 65 6c 2d 67 65 74 2d 64 65 73 63 72 -panel-get-descr
1600: 69 70 74 69 6f 6e 20 74 65 73 74 6d 65 74 61 29 iption testmeta)
1610: 20 23 3a 73 69 7a 65 20 22 78 35 30 22 29 3b 20 #:size "x50");
1620: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
1630: 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 NTAL").... (lamb
1640: 64 61 20 28 74 65 73 74 6d 65 74 61 29 0a 09 09 da (testmeta)...
1650: 09 20 20 20 28 74 65 73 74 2d 6d 65 74 61 2d 70 . (test-meta-p
1660: 61 6e 65 6c 2d 67 65 74 2d 64 65 73 63 72 69 70 anel-get-descrip
1670: 74 69 6f 6e 20 74 65 73 74 6d 65 74 61 29 29 29 tion testmeta)))
1680: 0a 09 20 20 20 20 29 29 29 29 29 0a 0a 0a 3b 3b .. )))))...;;
1690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16d0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 75 6e 20 69 6e ======.;; Run in
16e0: 66 6f 20 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d 3d 3d fo panel.;;=====
16f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1730: 3d 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 69 =.(define (run-i
1740: 6e 66 6f 2d 70 61 6e 65 6c 20 64 62 20 6b 65 79 nfo-panel db key
1750: 64 61 74 20 74 65 73 74 64 61 74 20 72 75 6e 6e dat testdat runn
1760: 61 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 ame). (let* ((r
1770: 75 6e 2d 69 64 20 20 20 20 20 28 64 62 3a 74 65 un-id (db:te
1780: 73 74 2d 67 65 74 2d 72 75 6e 5f 69 64 20 74 65 st-get-run_id te
1790: 73 74 64 61 74 29 29 0a 09 20 28 72 75 6e 64 61 stdat)).. (runda
17a0: 74 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 72 t (rmt:get-r
17b0: 75 6e 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 29 29 un-info run-id))
17c0: 0a 09 20 28 68 65 61 64 65 72 20 20 20 20 20 28 .. (header (
17d0: 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 db:get-header ru
17e0: 6e 64 61 74 29 29 0a 09 20 28 65 76 65 6e 74 5f ndat)).. (event_
17f0: 74 69 6d 65 20 28 64 62 3a 67 65 74 2d 76 61 6c time (db:get-val
1800: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 28 64 62 ue-by-header (db
1810: 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e 64 61 74 :get-rows rundat
1820: 29 0a 09 09 09 09 09 20 20 20 20 20 28 64 62 3a )...... (db:
1830: 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 64 61 get-header runda
1840: 74 29 0a 09 09 09 09 09 20 20 20 20 20 22 65 76 t)...... "ev
1850: 65 6e 74 5f 74 69 6d 65 22 29 29 29 0a 20 20 20 ent_time"))).
1860: 20 28 69 75 70 3a 66 72 61 6d 65 20 0a 20 20 20 (iup:frame .
1870: 20 20 23 3a 74 69 74 6c 65 20 22 4d 65 67 61 74 #:title "Megat
1880: 65 73 74 20 52 75 6e 20 49 6e 66 6f 22 20 3b 20 est Run Info" ;
1890: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 #:expand "YES".
18a0: 20 20 20 20 28 69 75 70 3a 68 62 6f 78 20 3b 20 (iup:hbox ;
18b0: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 #:expand "YES".
18c0: 20 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a (apply iup:
18d0: 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 vbox ; #:expand
18e0: 22 59 45 53 22 0a 09 20 20 20 20 20 28 61 70 70 "YES".. (app
18f0: 65 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 end (map (lambda
1900: 20 28 6b 65 79 76 61 6c 29 0a 09 09 09 20 20 20 (keyval)....
1910: 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e (iup:label (con
1920: 63 20 28 63 61 72 20 6b 65 79 76 61 6c 29 20 22 c (car keyval) "
1930: 20 22 29 29 29 0a 09 09 09 20 20 6b 65 79 64 61 "))).... keyda
1940: 74 29 0a 09 09 20 20 20 20 20 28 6c 69 73 74 20 t)... (list
1950: 28 69 75 70 3a 6c 61 62 65 6c 20 22 72 75 6e 6e (iup:label "runn
1960: 61 6d 65 20 22 29 0a 09 09 09 20 20 20 28 69 75 ame ").... (iu
1970: 70 3a 6c 61 62 65 6c 20 22 72 75 6e 2d 69 64 22 p:label "run-id"
1980: 29 0a 09 09 09 20 20 20 28 69 75 70 3a 6c 61 62 ).... (iup:lab
1990: 65 6c 20 22 72 75 6e 2d 64 61 74 65 22 29 29 29 el "run-date")))
19a0: 29 0a 20 20 20 20 20 20 28 61 70 70 6c 79 20 69 ). (apply i
19b0: 75 70 3a 76 62 6f 78 0a 09 20 20 20 20 20 28 61 up:vbox.. (a
19c0: 70 70 65 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 ppend (map (lamb
19d0: 64 61 20 28 6b 65 79 76 61 6c 29 0a 09 09 09 20 da (keyval)....
19e0: 20 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 (iup:label (c
19f0: 61 64 72 20 6b 65 79 76 61 6c 29 20 23 3a 65 78 adr keyval) #:ex
1a00: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL
1a10: 22 29 29 0a 09 09 09 20 20 6b 65 79 64 61 74 29 ")).... keydat)
1a20: 0a 09 09 20 20 20 20 20 28 6c 69 73 74 20 28 69 ... (list (i
1a30: 75 70 3a 6c 61 62 65 6c 20 72 75 6e 6e 61 6d 65 up:label runname
1a40: 29 0a 09 09 09 20 20 20 28 69 75 70 3a 6c 61 62 ).... (iup:lab
1a50: 65 6c 20 28 63 6f 6e 63 20 72 75 6e 2d 69 64 29 el (conc run-id)
1a60: 29 0a 09 09 09 20 20 20 28 69 75 70 3a 6c 61 62 ).... (iup:lab
1a70: 65 6c 20 28 73 65 63 6f 6e 64 73 2d 3e 79 65 61 el (seconds->yea
1a80: 72 2d 77 6f 72 6b 2d 77 65 65 6b 2f 64 61 79 2d r-work-week/day-
1a90: 74 69 6d 65 20 65 76 65 6e 74 5f 74 69 6d 65 29 time event_time)
1aa0: 29 0a 09 09 09 20 20 20 28 69 75 70 3a 6c 61 62 ).... (iup:lab
1ab0: 65 6c 20 22 22 20 23 3a 65 78 70 61 6e 64 20 22 el "" #:expand "
1ac0: 56 45 52 54 49 43 41 4c 22 29 29 29 29 29 29 29 VERTICAL")))))))
1ad0: 29 0a 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ). .;;=========
1ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
1b20: 20 48 6f 73 74 20 69 6e 66 6f 20 70 61 6e 65 6c Host info panel
1b30: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
1b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1b50: 3d 3d 3d 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 0a 28 64 65 66 69 6e =========.(defin
1b80: 65 20 28 68 6f 73 74 2d 69 6e 66 6f 2d 70 61 6e e (host-info-pan
1b90: 65 6c 20 74 65 73 74 64 61 74 20 73 74 6f 72 65 el testdat store
1ba0: 2d 6c 61 62 65 6c 29 0a 20 20 28 69 75 70 3a 66 -label). (iup:f
1bb0: 72 61 6d 65 0a 20 20 20 23 3a 74 69 74 6c 65 20 rame. #:title
1bc0: 22 52 65 6d 6f 74 65 20 68 6f 73 74 20 61 6e 64 "Remote host and
1bd0: 20 54 65 73 74 20 52 75 6e 20 49 6e 66 6f 22 20 Test Run Info"
1be0: 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 ; #:expand "YES"
1bf0: 0a 20 20 20 28 69 75 70 3a 68 62 6f 78 20 3b 20 . (iup:hbox ;
1c00: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 #:expand "YES".
1c10: 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 (apply iup:vb
1c20: 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 ox ; #:expand "Y
1c30: 45 53 22 20 3b 3b 20 54 68 65 20 68 65 61 64 69 ES" ;; The headi
1c40: 6e 67 20 6c 61 62 65 6c 73 0a 09 20 20 20 28 61 ng labels.. (a
1c50: 70 70 65 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 ppend (map (lamb
1c60: 64 61 20 28 76 61 6c 29 0a 09 09 09 20 20 28 69 da (val).... (i
1c70: 75 70 3a 6c 61 62 65 6c 20 76 61 6c 20 3b 20 23 up:label val ; #
1c80: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON
1c90: 54 41 4c 22 0a 09 09 09 09 20 20 20 20 20 29 29 TAL"..... ))
1ca0: 0a 09 09 09 28 6c 69 73 74 20 22 48 6f 73 74 6e ....(list "Hostn
1cb0: 61 6d 65 3a 20 22 0a 09 09 09 20 20 20 20 20 20 ame: "....
1cc0: 22 44 69 73 6b 20 66 72 65 65 3a 20 22 0a 09 09 "Disk free: "...
1cd0: 09 20 20 20 20 20 20 22 43 50 55 20 4c 6f 61 64 . "CPU Load
1ce0: 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 52 75 : ".... "Ru
1cf0: 6e 20 64 75 72 61 74 69 6f 6e 3a 20 22 0a 09 09 n duration: "...
1d00: 09 20 20 20 20 20 20 22 4c 6f 67 66 69 6c 65 3a . "Logfile:
1d10: 20 22 0a 09 09 09 20 20 20 20 20 20 22 54 6f 70 ".... "Top
1d20: 20 70 72 6f 63 65 73 73 20 69 64 3a 20 22 0a 09 process id: "..
1d30: 09 09 20 20 20 20 20 20 22 55 6e 61 6d 65 20 2d .. "Uname -
1d40: 61 3a 20 22 29 29 0a 09 09 20 20 20 28 69 75 70 a: "))... (iup
1d50: 3a 6c 61 62 65 6c 20 22 22 20 23 3a 65 78 70 61 :label "" #:expa
1d60: 6e 64 20 22 56 45 52 54 49 43 41 4c 22 29 29 29 nd "VERTICAL")))
1d70: 0a 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a . (apply iup:
1d80: 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 vbox ; #:expand
1d90: 22 59 45 53 22 0a 09 20 20 20 28 6c 69 73 74 0a "YES".. (list.
1da0: 09 20 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 59 65 . ;; NOTE: Ye
1db0: 73 2c 20 74 68 65 20 68 6f 73 74 20 63 61 6e 20 s, the host can
1dc0: 63 68 61 6e 67 65 21 0a 09 20 20 20 20 28 73 74 change!.. (st
1dd0: 6f 72 65 2d 6c 61 62 65 6c 20 22 48 6f 73 74 4e ore-label "HostN
1de0: 61 6d 65 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 ame".... (iup:la
1df0: 62 65 6c 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 bel ;; (sdb:qry
1e00: 27 67 65 74 73 74 72 20 0a 09 09 09 20 20 28 64 'getstr .... (d
1e10: 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 20 b:test-get-host
1e20: 74 65 73 74 64 61 74 29 20 3b 3b 20 29 0a 09 09 testdat) ;; )...
1e30: 09 20 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 . #:expand "HOR
1e40: 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c IZONTAL").... (l
1e50: 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 28 ambda (testdat)(
1e60: 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 db:test-get-host
1e70: 20 74 65 73 74 64 61 74 29 29 29 0a 09 20 20 20 testdat)))..
1e80: 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 44 (store-label "D
1e90: 69 73 6b 46 72 65 65 22 0a 09 09 09 20 28 69 75 iskFree".... (iu
1ea0: 70 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 20 28 64 p:label (conc (d
1eb0: 62 3a 74 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 b:test-get-diskf
1ec0: 72 65 65 20 74 65 73 74 64 61 74 29 29 20 23 3a ree testdat)) #:
1ed0: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT
1ee0: 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 AL").... (lambda
1ef0: 20 28 74 65 73 74 64 61 74 29 28 63 6f 6e 63 20 (testdat)(conc
1f00: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 64 69 73 (db:test-get-dis
1f10: 6b 66 72 65 65 20 74 65 73 74 64 61 74 29 29 29 kfree testdat)))
1f20: 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 ).. (store-la
1f30: 62 65 6c 20 22 43 50 55 4c 6f 61 64 22 0a 09 09 bel "CPULoad"...
1f40: 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f . (iup:label (co
1f50: 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d nc (db:test-get-
1f60: 63 70 75 6c 6f 61 64 20 74 65 73 74 64 61 74 29 cpuload testdat)
1f70: 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ) #:expand "HORI
1f80: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la
1f90: 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 28 63 mbda (testdat)(c
1fa0: 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 onc (db:test-get
1fb0: 2d 63 70 75 6c 6f 61 64 20 74 65 73 74 64 61 74 -cpuload testdat
1fc0: 29 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 )))).. (store
1fd0: 2d 6c 61 62 65 6c 20 22 52 75 6e 44 75 72 61 74 -label "RunDurat
1fe0: 69 6f 6e 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 ion".... (iup:la
1ff0: 62 65 6c 20 28 63 6f 6e 63 20 28 73 65 63 6f 6e bel (conc (secon
2000: 64 73 2d 3e 68 72 2d 6d 69 6e 2d 73 65 63 20 28 ds->hr-min-sec (
2010: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f db:test-get-run_
2020: 64 75 72 61 74 69 6f 6e 20 74 65 73 74 64 61 74 duration testdat
2030: 29 29 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f ))) #:expand "HO
2040: 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 RIZONTAL").... (
2050: 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 lambda (testdat)
2060: 28 63 6f 6e 63 20 28 73 65 63 6f 6e 64 73 2d 3e (conc (seconds->
2070: 68 72 2d 6d 69 6e 2d 73 65 63 20 28 64 62 3a 74 hr-min-sec (db:t
2080: 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 est-get-run_dura
2090: 74 69 6f 6e 20 74 65 73 74 64 61 74 29 29 29 29 tion testdat))))
20a0: 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 ).. (store-la
20b0: 62 65 6c 20 22 4c 6f 67 46 69 6c 65 22 0a 09 09 bel "LogFile"...
20c0: 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f . (iup:label (co
20d0: 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d nc (db:test-get-
20e0: 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 74 64 final_logf testd
20f0: 61 74 29 29 20 23 3a 65 78 70 61 6e 64 20 22 48 at)) #:expand "H
2100: 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 ORIZONTAL")....
2110: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 (lambda (testdat
2120: 29 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d )(conc (db:test-
2130: 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 get-final_logf t
2140: 65 73 74 64 61 74 29 29 29 29 0a 09 20 20 20 20 estdat))))..
2150: 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 50 72 (store-label "Pr
2160: 6f 63 65 73 73 49 64 22 0a 09 09 09 20 28 69 75 ocessId".... (iu
2170: 70 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 20 28 64 p:label (conc (d
2180: 62 3a 74 65 73 74 2d 67 65 74 2d 70 72 6f 63 65 b:test-get-proce
2190: 73 73 5f 69 64 20 74 65 73 74 64 61 74 29 29 20 ss_id testdat))
21a0: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
21b0: 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 NTAL").... (lamb
21c0: 64 61 20 28 74 65 73 74 64 61 74 29 28 63 6f 6e da (testdat)(con
21d0: 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 c (db:test-get-p
21e0: 72 6f 63 65 73 73 5f 69 64 20 74 65 73 74 64 61 rocess_id testda
21f0: 74 29 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 t)))).. (stor
2200: 65 2d 6c 61 62 65 6c 20 22 55 6e 61 6d 65 22 0a e-label "Uname".
2210: 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 ... (iup:label "
2220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2250: 20 20 20 22 20 23 3a 65 78 70 61 6e 64 20 22 48 " #:expand "H
2260: 4f 52 49 5a 4f 4e 54 41 4c 22 29 20 3b 3b 20 20 ORIZONTAL") ;;
2270: 23 3a 77 6f 72 64 77 72 61 70 20 22 59 45 53 22 #:wordwrap "YES"
2280: 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 ).... (lambda (t
2290: 65 73 74 64 61 74 29 20 3b 3b 20 28 73 64 62 3a estdat) ;; (sdb:
22a0: 71 72 79 20 27 67 65 74 73 74 72 20 0a 09 09 09 qry 'getstr ....
22b0: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
22c0: 75 6e 61 6d 65 20 74 65 73 74 64 61 74 29 29 29 uname testdat)))
22d0: 20 3b 3b 20 29 0a 09 20 20 20 20 29 29 29 29 29 ;; ).. )))))
22e0: 0a 0a 3b 3b 20 69 66 20 74 68 65 72 65 20 69 73 ..;; if there is
22f0: 20 61 20 73 75 62 6d 65 67 61 74 65 73 74 20 63 a submegatest c
2300: 72 65 61 74 65 20 61 20 62 75 74 74 6f 6e 20 74 reate a button t
2310: 6f 20 6c 61 75 6e 63 68 20 64 61 73 68 62 6f 61 o launch dashboa
2320: 72 64 20 69 6e 20 74 68 61 74 20 61 72 65 61 0a rd in that area.
2330: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 73 75 62 6d ;;.(define (subm
2340: 65 67 61 74 65 73 74 2d 70 61 6e 65 6c 20 64 62 egatest-panel db
2350: 73 74 72 75 63 74 20 6b 65 79 64 61 74 20 74 65 struct keydat te
2360: 73 74 64 61 74 20 72 75 6e 6e 61 6d 65 20 74 65 stdat runname te
2370: 73 74 63 6f 6e 66 69 67 29 0a 20 20 28 6c 65 74 stconfig). (let
2380: 2a 20 28 28 73 75 62 61 72 65 61 20 28 63 6f 6e * ((subarea (con
2390: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 74 65 73 74 figf:lookup test
23a0: 63 6f 6e 66 69 67 20 22 73 65 74 75 70 22 20 22 config "setup" "
23b0: 73 75 62 6d 65 67 61 74 65 73 74 22 29 29 0a 09 submegatest"))..
23c0: 20 28 61 72 65 61 2d 65 78 69 73 74 73 20 28 61 (area-exists (a
23d0: 6e 64 20 73 75 62 61 72 65 61 20 28 66 69 6c 65 nd subarea (file
23e0: 2d 65 78 69 73 74 73 3f 20 73 75 62 61 72 65 61 -exists? subarea
23f0: 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 64 65 62 )))). ;; (deb
2400: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
2410: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
2420: 74 2a 20 22 4d 65 67 61 74 65 73 74 20 73 75 62 t* "Megatest sub
2430: 61 72 65 61 3d 22 20 73 75 62 61 72 65 61 20 22 area=" subarea "
2440: 2c 20 61 72 65 61 2d 65 78 69 73 74 73 3d 22 20 , area-exists="
2450: 61 72 65 61 2d 65 78 69 73 74 73 29 0a 20 20 20 area-exists).
2460: 20 28 69 66 20 73 75 62 61 72 65 61 0a 09 28 69 (if subarea..(i
2470: 75 70 3a 66 72 61 6d 65 20 0a 09 20 23 3a 74 69 up:frame .. #:ti
2480: 74 6c 65 20 22 4d 65 67 61 74 65 73 74 20 52 75 tle "Megatest Ru
2490: 6e 20 49 6e 66 6f 22 20 3b 20 23 3a 65 78 70 61 n Info" ; #:expa
24a0: 6e 64 20 22 59 45 53 22 0a 09 20 28 69 75 70 3a nd "YES".. (iup:
24b0: 62 75 74 74 6f 6e 0a 09 20 20 22 4c 61 75 6e 63 button.. "Launc
24c0: 68 20 44 61 73 68 62 6f 61 72 64 22 0a 09 20 20 h Dashboard"..
24d0: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda
24e0: 20 28 6f 62 6a 29 0a 09 09 20 20 20 20 20 28 73 (obj)... (s
24f0: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 63 64 20 ystem (conc "cd
2500: 22 20 73 75 62 61 72 65 61 20 22 3b 65 6e 76 20 " subarea ";env
2510: 2d 69 20 50 41 54 48 3d 24 50 41 54 48 20 44 49 -i PATH=$PATH DI
2520: 53 50 4c 41 59 3d 24 44 49 53 50 4c 41 59 20 48 SPLAY=$DISPLAY H
2530: 4f 4d 45 3d 24 48 4f 4d 45 20 55 53 45 52 3d 24 OME=$HOME USER=$
2540: 55 53 45 52 20 64 61 73 68 62 6f 61 72 64 20 26 USER dashboard &
2550: 22 29 29 29 29 29 0a 09 28 69 75 70 3a 76 62 6f ")))))..(iup:vbo
2560: 78 29 29 29 29 0a 0a 3b 3b 20 75 73 65 20 61 20 x))))..;; use a
2570: 67 6c 6f 62 61 6c 20 66 6f 72 20 73 65 74 74 69 global for setti
2580: 6e 67 20 74 68 65 20 62 75 74 74 6f 6e 73 20 63 ng the buttons c
2590: 6f 6c 6f 72 73 0a 3b 3b 20 20 20 20 20 20 20 20 olors.;;
25a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25b0: 20 20 20 73 74 61 74 65 20 73 74 61 74 75 73 20 state status
25c0: 74 65 73 74 73 74 65 70 73 0a 28 64 65 66 69 6e teststeps.(defin
25d0: 65 20 2a 73 74 61 74 65 2d 73 74 61 74 75 73 2a e *state-status*
25e0: 20 28 76 65 63 74 6f 72 20 23 66 20 23 66 20 23 (vector #f #f #
25f0: 66 29 29 0a 28 64 65 66 69 6e 65 20 28 75 70 64 f)).(define (upd
2600: 61 74 65 2d 73 74 61 74 65 2d 73 74 61 74 75 73 ate-state-status
2610: 2d 62 75 74 74 6f 6e 73 20 74 65 73 74 64 61 74 -buttons testdat
2620: 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 61 74 ). (let* ((stat
2630: 65 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d e (db:test-get-
2640: 73 74 61 74 65 20 20 74 65 73 74 64 61 74 29 29 state testdat))
2650: 0a 09 20 28 73 74 61 74 75 73 20 28 64 62 3a 74 .. (status (db:t
2660: 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 est-get-status t
2670: 65 73 74 64 61 74 29 29 0a 09 20 28 63 6f 6c 6f estdat)).. (colo
2680: 72 20 20 28 63 61 72 20 28 67 75 74 69 6c 73 3a r (car (gutils:
2690: 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 get-color-for-st
26a0: 61 74 65 2d 73 74 61 74 75 73 20 73 74 61 74 65 ate-status state
26b0: 20 73 74 61 74 75 73 29 29 29 29 0a 20 20 20 20 status)))).
26c0: 28 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 73 74 ((vector-ref *st
26d0: 61 74 65 2d 73 74 61 74 75 73 2a 20 30 29 20 73 ate-status* 0) s
26e0: 74 61 74 65 20 63 6f 6c 6f 72 29 0a 20 20 20 20 tate color).
26f0: 28 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 73 74 ((vector-ref *st
2700: 61 74 65 2d 73 74 61 74 75 73 2a 20 31 29 20 73 ate-status* 1) s
2710: 74 61 74 75 73 20 63 6f 6c 6f 72 29 29 29 0a 0a tatus color)))..
2720: 28 64 65 66 69 6e 65 20 2a 64 61 73 68 62 6f 61 (define *dashboa
2730: 72 64 2d 74 65 73 74 2d 64 62 2a 20 23 74 29 0a rd-test-db* #t).
2740: 28 64 65 66 69 6e 65 20 2a 64 61 73 68 62 6f 61 (define *dashboa
2750: 72 64 2d 63 6f 6d 6d 65 6e 74 2d 73 68 61 72 65 rd-comment-share
2760: 2d 73 6c 6f 74 2a 20 23 66 29 0a 0a 3b 3b 3d 3d -slot* #f)..;;==
2770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
27a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
27b0: 3d 3d 3d 3d 0a 3b 3b 20 53 65 74 20 66 69 65 6c ====.;; Set fiel
27c0: 64 73 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ds .;;==========
27d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
27e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
27f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 ============.(de
2810: 66 69 6e 65 20 28 73 65 74 2d 66 69 65 6c 64 73 fine (set-fields
2820: 2d 70 61 6e 65 6c 20 64 62 73 74 72 75 63 74 20 -panel dbstruct
2830: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 run-id test-id t
2840: 65 73 74 64 61 74 20 23 21 6b 65 79 20 28 64 62 estdat #!key (db
2850: 20 23 66 29 29 0a 20 20 28 6c 65 74 20 28 28 6e #f)). (let ((n
2860: 65 77 63 6f 6d 6d 65 6e 74 20 23 66 29 0a 09 28 ewcomment #f)..(
2870: 6e 65 77 73 74 61 74 75 73 20 20 23 66 29 0a 09 newstatus #f)..
2880: 28 6e 65 77 73 74 61 74 65 20 20 20 23 66 29 0a (newstate #f).
2890: 09 28 77 74 78 74 62 6f 78 20 20 20 20 23 66 29 .(wtxtbox #f)
28a0: 29 0a 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 ). (iup:frame
28b0: 0a 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 53 . #:title "S
28c0: 65 74 20 66 69 65 6c 64 73 22 0a 20 20 20 20 20 et fields".
28d0: 28 69 75 70 3a 76 62 6f 78 0a 20 20 20 20 20 20 (iup:vbox.
28e0: 28 69 75 70 3a 68 62 6f 78 20 28 69 75 70 3a 6c (iup:hbox (iup:l
28f0: 61 62 65 6c 20 22 43 6f 6d 6d 65 6e 74 3a 22 29 abel "Comment:")
2900: 0a 09 09 28 6c 65 74 20 28 28 74 78 74 62 6f 78 ...(let ((txtbox
2910: 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a (iup:textbox #:
2920: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
2930: 76 61 6c 20 61 20 62 29 0a 09 09 09 09 09 09 20 val a b).......
2940: 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 2d 73 (rmt:test-s
2950: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
2960: 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 by-id run-id tes
2970: 74 2d 69 64 20 23 66 20 23 66 20 62 29 0a 09 09 t-id #f #f b)...
2980: 09 09 09 09 20 20 20 20 20 20 3b 3b 20 49 44 45 .... ;; IDE
2990: 41 3a 20 4a 75 73 74 20 73 65 74 20 61 20 76 61 A: Just set a va
29a0: 72 69 61 62 6c 65 20 77 69 74 68 20 74 68 65 20 riable with the
29b0: 70 72 6f 63 20 74 6f 20 63 61 6c 6c 3f 0a 09 09 proc to call?...
29c0: 09 09 09 09 20 20 20 20 20 20 28 72 6d 74 3a 74 .... (rmt:t
29d0: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
29e0: 61 74 75 73 2d 62 79 2d 69 64 20 72 75 6e 2d 69 atus-by-id run-i
29f0: 64 20 74 65 73 74 2d 69 64 20 23 66 20 23 66 20 d test-id #f #f
2a00: 62 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 b)....... (
2a10: 73 65 74 21 20 6e 65 77 63 6f 6d 6d 65 6e 74 20 set! newcomment
2a20: 62 29 29 0a 09 09 09 09 09 20 20 20 23 3a 76 61 b))...... #:va
2a30: 6c 75 65 20 28 64 62 3a 74 65 73 74 2d 67 65 74 lue (db:test-get
2a40: 2d 63 6f 6d 6d 65 6e 74 20 74 65 73 74 64 61 74 -comment testdat
2a50: 29 0a 09 09 09 09 09 20 20 20 23 3a 65 78 70 61 )...... #:expa
2a60: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 nd "HORIZONTAL")
2a70: 29 29 0a 09 09 20 20 28 73 65 74 21 20 77 74 78 ))... (set! wtx
2a80: 74 62 6f 78 20 74 78 74 62 6f 78 29 0a 09 09 20 tbox txtbox)...
2a90: 20 74 78 74 62 6f 78 29 29 0a 09 09 20 20 0a 20 txtbox))... .
2aa0: 20 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a (apply iup:
2ab0: 68 62 6f 78 0a 09 20 20 20 20 20 28 69 75 70 3a hbox.. (iup:
2ac0: 6c 61 62 65 6c 20 22 53 54 41 54 45 3a 22 20 23 label "STATE:" #
2ad0: 3a 73 69 7a 65 20 22 33 30 78 22 29 0a 09 20 20 :size "30x")..
2ae0: 20 20 20 28 6c 65 74 2a 20 28 28 62 74 6e 73 20 (let* ((btns
2af0: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 73 (map (lambda (s
2b00: 74 61 74 65 29 0a 09 09 09 09 20 20 28 6c 65 74 tate)..... (let
2b10: 20 28 28 62 74 6e 20 28 69 75 70 3a 62 75 74 74 ((btn (iup:butt
2b20: 6f 6e 20 73 74 61 74 65 0a 09 09 09 09 09 09 09 on state........
2b30: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ
2b40: 4f 4e 54 41 4c 22 20 23 3a 73 69 7a 65 20 22 35 ONTAL" #:size "5
2b50: 30 78 22 20 23 3a 66 6f 6e 74 20 22 43 6f 75 72 0x" #:font "Cour
2b60: 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 0a 09 09 ier New, -10"...
2b70: 09 09 09 09 09 20 23 3a 61 63 74 69 6f 6e 20 28 ..... #:action (
2b80: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 lambda (x)......
2b90: 09 09 09 20 20 20 20 3b 3b 20 28 72 6d 74 3a 74 ... ;; (rmt:t
2ba0: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
2bb0: 61 74 75 73 2d 62 79 2d 69 64 20 72 75 6e 2d 69 atus-by-id run-i
2bc0: 64 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 d test-id state
2bd0: 23 66 20 23 66 29 0a 09 09 09 09 09 09 09 09 20 #f #f).........
2be0: 20 20 20 28 72 6d 74 3a 72 6f 6c 6c 2d 75 70 2d (rmt:roll-up-
2bf0: 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 pass-fail-counts
2c00: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
2c10: 23 66 20 73 74 61 74 65 20 23 66 20 23 66 29 20 #f state #f #f)
2c20: 3b 3b 20 74 65 73 74 2d 6e 61 6d 65 20 70 61 73 ;; test-name pas
2c30: 73 65 64 20 69 6e 20 61 73 20 74 65 73 74 2d 69 sed in as test-i
2c40: 64 20 69 73 20 72 65 73 70 65 63 74 65 64 0a 09 d is respected..
2c50: 09 09 09 09 09 09 09 20 20 20 20 28 64 62 3a 74 ....... (db:t
2c60: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 21 20 74 est-set-state! t
2c70: 65 73 74 64 61 74 20 73 74 61 74 65 29 29 29 29 estdat state))))
2c80: 29 0a 09 09 09 09 20 20 20 20 62 74 6e 29 29 0a )..... btn)).
2c90: 09 09 09 09 28 6d 61 70 20 63 61 64 72 20 2a 63 ....(map cadr *c
2ca0: 6f 6d 6d 6f 6e 3a 73 74 64 2d 73 74 61 74 65 73 ommon:std-states
2cb0: 2a 29 29 29 29 20 3b 3b 20 28 6c 69 73 74 20 22 *)))) ;; (list "
2cc0: 43 4f 4d 50 4c 45 54 45 44 22 20 22 4e 4f 54 5f COMPLETED" "NOT_
2cd0: 53 54 41 52 54 45 44 22 20 22 52 55 4e 4e 49 4e STARTED" "RUNNIN
2ce0: 47 22 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 G" "REMOTEHOSTST
2cf0: 41 52 54 22 20 22 4c 41 55 4e 43 48 45 44 22 20 ART" "LAUNCHED"
2d00: 22 4b 49 4c 4c 45 44 22 20 22 4b 49 4c 4c 52 45 "KILLED" "KILLRE
2d10: 51 22 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 Q")))).. (
2d20: 76 65 63 74 6f 72 2d 73 65 74 21 20 2a 73 74 61 vector-set! *sta
2d30: 74 65 2d 73 74 61 74 75 73 2a 20 30 0a 09 09 09 te-status* 0....
2d40: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 74 61 (lambda (sta
2d50: 74 65 20 63 6f 6c 6f 72 29 0a 09 09 09 20 20 20 te color)....
2d60: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 (for-each ...
2d70: 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 . (lambda
2d80: 28 62 74 6e 29 0a 09 09 09 09 20 28 6c 65 74 2a (btn)..... (let*
2d90: 20 28 28 6e 61 6d 65 20 20 20 20 20 28 69 75 70 ((name (iup
2da0: 3a 61 74 74 72 69 62 75 74 65 20 62 74 6e 20 22 :attribute btn "
2db0: 54 49 54 4c 45 22 29 29 0a 09 09 09 09 09 28 6e TITLE"))......(n
2dc0: 65 77 63 6f 6c 6f 72 20 28 69 66 20 28 65 71 75 ewcolor (if (equ
2dd0: 61 6c 3f 20 6e 61 6d 65 20 73 74 61 74 65 29 20 al? name state)
2de0: 63 6f 6c 6f 72 20 22 31 39 32 20 31 39 32 20 31 color "192 192 1
2df0: 39 32 22 29 29 29 0a 09 09 09 09 20 20 20 28 69 92")))..... (i
2e00: 66 20 28 6e 6f 74 20 28 63 6f 6c 6f 72 73 2d 73 f (not (colors-s
2e10: 69 6d 69 6c 61 72 3f 20 6e 65 77 63 6f 6c 6f 72 imilar? newcolor
2e20: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute
2e30: 62 74 6e 20 22 42 47 43 4f 4c 4f 52 22 29 29 29 btn "BGCOLOR")))
2e40: 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 75 70 ..... (iup
2e50: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
2e60: 62 74 6e 20 22 42 47 43 4f 4c 4f 52 22 20 6e 65 btn "BGCOLOR" ne
2e70: 77 63 6f 6c 6f 72 29 29 29 29 0a 09 09 09 20 20 wcolor))))....
2e80: 20 20 20 20 20 62 74 6e 73 29 29 29 0a 09 20 20 btns)))..
2e90: 20 20 20 20 20 62 74 6e 73 29 29 0a 20 20 20 20 btns)).
2ea0: 20 20 28 61 70 70 6c 79 20 69 75 70 3a 68 62 6f (apply iup:hbo
2eb0: 78 0a 09 20 20 20 20 20 28 69 75 70 3a 6c 61 62 x.. (iup:lab
2ec0: 65 6c 20 22 53 54 41 54 55 53 3a 22 20 23 3a 73 el "STATUS:" #:s
2ed0: 69 7a 65 20 22 33 30 78 22 29 0a 09 20 20 20 20 ize "30x")..
2ee0: 20 28 6c 65 74 2a 20 28 28 62 74 6e 73 20 20 28 (let* ((btns (
2ef0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 73 74 61 map (lambda (sta
2f00: 74 75 73 29 0a 09 09 09 09 20 20 28 6c 65 74 20 tus)..... (let
2f10: 28 28 62 74 6e 20 28 69 75 70 3a 62 75 74 74 6f ((btn (iup:butto
2f20: 6e 20 73 74 61 74 75 73 0a 09 09 09 09 09 09 09 n status........
2f30: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ
2f40: 4f 4e 54 41 4c 22 20 23 3a 73 69 7a 65 20 22 35 ONTAL" #:size "5
2f50: 30 78 22 20 23 3a 66 6f 6e 74 20 22 43 6f 75 72 0x" #:font "Cour
2f60: 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 0a 09 09 ier New, -10"...
2f70: 09 09 09 09 09 20 23 3a 61 63 74 69 6f 6e 20 28 ..... #:action (
2f80: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 lambda (x)......
2f90: 09 09 09 20 20 20 20 28 6c 65 74 20 28 28 74 20 ... (let ((t
2fa0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 78 (iup:attribute x
2fb0: 20 22 54 49 54 4c 45 22 29 29 29 0a 09 09 09 09 "TITLE"))).....
2fc0: 09 09 09 09 20 20 20 20 20 20 28 69 66 20 28 65 .... (if (e
2fd0: 71 75 61 6c 3f 20 74 20 22 57 41 49 56 45 44 22 qual? t "WAIVED"
2fe0: 29 0a 09 09 09 09 09 09 09 09 09 20 20 28 69 75 ).......... (iu
2ff0: 70 3a 73 68 6f 77 20 28 64 61 73 68 62 6f 61 72 p:show (dashboar
3000: 64 2d 74 65 73 74 73 3a 77 61 69 76 65 72 20 72 d-tests:waiver r
3010: 75 6e 2d 69 64 20 74 65 73 74 64 61 74 20 0a 09 un-id testdat ..
3020: 09 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 ............
3030: 28 69 66 20 77 74 78 74 62 6f 78 20 28 69 75 70 (if wtxtbox (iup
3040: 3a 61 74 74 72 69 62 75 74 65 20 77 74 78 74 62 :attribute wtxtb
3050: 6f 78 20 22 56 41 4c 55 45 22 29 20 23 66 29 0a ox "VALUE") #f).
3060: 09 09 09 09 09 09 09 09 09 09 09 09 09 20 20 20 .............
3070: 20 28 6c 61 6d 62 64 61 20 28 63 29 0a 09 09 09 (lambda (c)....
3080: 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
3090: 28 73 65 74 21 20 6e 65 77 63 6f 6d 6d 65 6e 74 (set! newcomment
30a0: 20 63 29 0a 09 09 09 09 09 09 09 09 09 09 09 09 c).............
30b0: 09 20 20 20 20 20 20 28 69 66 20 77 74 78 74 62 . (if wtxtb
30c0: 6f 78 20 0a 09 09 09 09 09 09 09 09 09 09 09 09 ox .............
30d0: 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 .. (begin......
30e0: 09 09 09 09 09 09 09 09 09 20 20 20 20 28 69 75 ......... (iu
30f0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
3100: 20 77 74 78 74 62 6f 78 20 22 56 41 4c 55 45 22 wtxtbox "VALUE"
3110: 20 63 29 0a 09 09 09 09 09 09 09 09 09 09 09 09 c).............
3120: 09 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 2a .. (if (not *
3130: 64 61 73 68 62 6f 61 72 64 2d 63 6f 6d 6d 65 6e dashboard-commen
3140: 74 2d 73 68 61 72 65 2d 73 6c 6f 74 2a 29 0a 09 t-share-slot*)..
3150: 09 09 09 09 09 09 09 09 09 09 09 09 09 09 28 73 ..............(s
3160: 65 74 21 20 2a 64 61 73 68 62 6f 61 72 64 2d 63 et! *dashboard-c
3170: 6f 6d 6d 65 6e 74 2d 73 68 61 72 65 2d 73 6c 6f omment-share-slo
3180: 74 2a 20 77 74 78 74 62 6f 78 29 29 29 0a 09 09 t* wtxtbox)))...
3190: 09 09 09 09 09 09 09 09 09 09 09 09 20 20 29 29 ............ ))
31a0: 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 28 62 )).......... (b
31b0: 65 67 69 6e 0a 09 09 09 09 09 09 09 09 09 20 20 egin..........
31c0: 20 20 3b 3b 20 28 72 6d 74 3a 74 65 73 74 2d 73 ;; (rmt:test-s
31d0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
31e0: 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 by-id run-id tes
31f0: 74 2d 69 64 20 23 66 20 73 74 61 74 75 73 20 23 t-id #f status #
3200: 66 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 f)..........
3210: 28 72 6d 74 3a 72 6f 6c 6c 2d 75 70 2d 70 61 73 (rmt:roll-up-pas
3220: 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 72 75 s-fail-counts ru
3230: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 23 66 20 n-id test-id #f
3240: 23 66 20 73 74 61 74 75 73 20 23 66 29 20 3b 3b #f status #f) ;;
3250: 20 74 65 73 74 2d 6e 61 6d 65 20 70 61 73 73 65 test-name passe
3260: 64 20 69 6e 20 61 73 20 74 65 73 74 2d 69 64 20 d in as test-id
3270: 69 73 20 72 65 73 70 65 63 74 65 64 0a 09 09 09 is respected....
3280: 09 09 09 09 09 09 20 20 20 20 28 64 62 3a 74 65 ...... (db:te
3290: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 st-set-status! t
32a0: 65 73 74 64 61 74 20 73 74 61 74 75 73 29 29 29 estdat status)))
32b0: 29 29 29 29 29 0a 09 09 09 09 20 20 20 20 62 74 )))))..... bt
32c0: 6e 29 29 0a 09 09 09 09 28 6d 61 70 20 63 61 64 n)).....(map cad
32d0: 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 64 2d 73 74 r *common:std-st
32e0: 61 74 75 73 65 73 2a 29 29 29 29 20 3b 3b 20 28 atuses*)))) ;; (
32f0: 6c 69 73 74 20 20 22 50 41 53 53 22 20 22 57 41 list "PASS" "WA
3300: 52 4e 22 20 22 46 41 49 4c 22 20 22 43 48 45 43 RN" "FAIL" "CHEC
3310: 4b 22 20 22 6e 2f 61 22 20 22 57 41 49 56 45 44 K" "n/a" "WAIVED
3320: 22 20 22 53 4b 49 50 22 29 29 29 29 0a 09 20 20 " "SKIP"))))..
3330: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set
3340: 21 20 2a 73 74 61 74 65 2d 73 74 61 74 75 73 2a ! *state-status*
3350: 20 31 0a 09 09 09 20 20 20 20 28 6c 61 6d 62 64 1.... (lambd
3360: 61 20 28 73 74 61 74 75 73 20 63 6f 6c 6f 72 29 a (status color)
3370: 0a 09 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 .... (for-e
3380: 61 63 68 20 0a 09 09 09 20 20 20 20 20 20 20 28 ach .... (
3390: 6c 61 6d 62 64 61 20 28 62 74 6e 29 0a 09 09 09 lambda (btn)....
33a0: 09 20 28 6c 65 74 2a 20 28 28 6e 61 6d 65 20 20 . (let* ((name
33b0: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
33c0: 65 20 62 74 6e 20 22 54 49 54 4c 45 22 29 29 0a e btn "TITLE")).
33d0: 09 09 09 09 09 28 6e 65 77 63 6f 6c 6f 72 20 28 .....(newcolor (
33e0: 69 66 20 28 65 71 75 61 6c 3f 20 6e 61 6d 65 20 if (equal? name
33f0: 73 74 61 74 75 73 29 20 63 6f 6c 6f 72 20 22 31 status) color "1
3400: 39 32 20 31 39 32 20 31 39 32 22 29 29 29 0a 09 92 192 192")))..
3410: 09 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ... (if (not (
3420: 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c 61 72 3f 20 colors-similar?
3430: 6e 65 77 63 6f 6c 6f 72 20 28 69 75 70 3a 61 74 newcolor (iup:at
3440: 74 72 69 62 75 74 65 20 62 74 6e 20 22 42 47 43 tribute btn "BGC
3450: 4f 4c 4f 52 22 29 29 29 0a 09 09 09 09 20 20 20 OLOR"))).....
3460: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
3470: 74 65 2d 73 65 74 21 20 62 74 6e 20 22 42 47 43 te-set! btn "BGC
3480: 4f 4c 4f 52 22 20 6e 65 77 63 6f 6c 6f 72 29 29 OLOR" newcolor))
3490: 29 29 0a 09 09 09 20 20 20 20 20 20 20 62 74 6e )).... btn
34a0: 73 29 29 29 0a 09 20 20 20 20 20 20 20 62 74 6e s))).. btn
34b0: 73 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 s))))))..(define
34c0: 20 28 64 61 73 68 62 6f 61 72 64 2d 74 65 73 74 (dashboard-test
34d0: 73 3a 72 75 6e 2d 68 74 6d 6c 2d 76 69 65 77 65 s:run-html-viewe
34e0: 72 20 6c 66 69 6c 65 6e 61 6d 65 29 0a 20 20 28 r lfilename). (
34f0: 6c 65 74 20 28 28 68 74 6d 6c 76 69 65 77 65 72 let ((htmlviewer
3500: 63 6d 64 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f cmd (configf:loo
3510: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
3520: 22 73 65 74 75 70 22 20 22 68 74 6d 6c 76 69 65 "setup" "htmlvie
3530: 77 65 72 63 6d 64 22 29 29 29 0a 20 20 20 20 28 wercmd"))). (
3540: 69 66 20 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 if htmlviewercmd
3550: 0a 09 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 ..(system (conc
3560: 22 28 22 20 68 74 6d 6c 76 69 65 77 65 72 63 6d "(" htmlviewercm
3570: 64 20 22 20 22 20 6c 66 69 6c 65 6e 61 6d 65 20 d " " lfilename
3580: 22 20 29 20 26 22 29 29 20 0a 09 28 69 75 70 3a " ) &")) ..(iup:
3590: 73 65 6e 64 2d 75 72 6c 20 6c 66 69 6c 65 6e 61 send-url lfilena
35a0: 6d 65 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 me))))..(define
35b0: 28 64 61 73 68 62 6f 61 72 64 2d 74 65 73 74 73 (dashboard-tests
35c0: 3a 72 75 6e 2d 61 2d 73 74 65 70 20 69 6e 66 6f :run-a-step info
35d0: 29 0a 20 20 23 74 29 0a 0a 28 64 65 66 69 6e 65 ). #t)..(define
35e0: 20 28 64 61 73 68 62 6f 61 72 64 2d 74 65 73 74 (dashboard-test
35f0: 73 3a 73 74 65 70 2d 72 75 6e 2d 63 6f 6e 74 72 s:step-run-contr
3600: 6f 6c 20 74 65 73 74 64 61 74 20 73 74 65 70 6e ol testdat stepn
3610: 61 6d 65 20 74 65 73 74 63 6f 6e 66 69 67 29 0a ame testconfig).
3620: 20 20 28 69 75 70 3a 64 69 61 6c 6f 67 20 3b 3b (iup:dialog ;;
3630: 20 23 3a 63 6c 6f 73 65 5f 63 62 20 28 6c 61 6d #:close_cb (lam
3640: 62 64 61 20 28 61 29 28 65 78 69 74 29 29 20 3b bda (a)(exit)) ;
3650: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
3660: 20 20 20 23 3a 74 69 74 6c 65 20 73 74 65 70 6e #:title stepn
3670: 61 6d 65 0a 20 20 20 28 69 75 70 3a 76 62 6f 78 ame. (iup:vbox
3680: 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 ; #:expand "YES
3690: 22 0a 20 20 20 20 28 69 75 70 3a 6c 61 62 65 6c ". (iup:label
36a0: 20 28 63 6f 6e 63 20 22 53 74 65 70 3a 20 22 20 (conc "Step: "
36b0: 73 74 65 70 6e 61 6d 65 20 22 5c 6e 4e 42 2f 2f stepname "\nNB//
36c0: 20 54 68 65 73 65 20 62 75 74 74 6f 6e 73 20 6f These buttons o
36d0: 6e 6c 79 20 72 75 6e 20 74 68 65 20 74 65 73 74 nly run the test
36e0: 20 73 74 65 70 5c 6e 66 6f 72 20 74 68 65 20 70 step\nfor the p
36f0: 75 72 70 6f 73 65 20 6f 66 20 64 65 62 75 67 67 urpose of debugg
3700: 69 6e 67 2e 5c 6e 4e 6f 74 20 61 6c 6c 20 64 61 ing.\nNot all da
3710: 74 61 62 61 73 65 20 75 70 64 61 74 65 73 20 61 tabase updates a
3720: 72 65 20 64 6f 6e 65 2e 22 29 29 0a 20 20 20 20 re done.")).
3730: 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 65 2d (iup:button "Re-
3740: 72 75 6e 22 20 20 20 20 20 20 20 20 20 20 20 20 run"
3750: 0a 09 09 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 ...#:expand "HOR
3760: 49 5a 4f 4e 54 41 4c 22 20 0a 09 09 23 3a 61 63 IZONTAL" ...#:ac
3770: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 tion (lambda (ob
3780: 6a 29 0a 09 09 09 20 20 20 28 74 68 72 65 61 64 j).... (thread
3790: 2d 73 74 61 72 74 21 20 0a 09 09 09 20 20 20 20 -start! ....
37a0: 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 (make-thread (la
37b0: 6d 62 64 61 20 28 29 0a 09 09 09 09 09 20 20 20 mbda ()......
37c0: 28 65 7a 73 74 65 70 73 3a 72 75 6e 2d 66 72 6f (ezsteps:run-fro
37d0: 6d 20 74 65 73 74 64 61 74 20 73 74 65 70 6e 61 m testdat stepna
37e0: 6d 65 20 23 74 29 29 0a 09 09 09 09 09 20 28 63 me #t))...... (c
37f0: 6f 6e 63 20 22 65 7a 73 74 65 70 20 72 75 6e 20 onc "ezstep run
3800: 73 69 6e 67 6c 65 20 73 74 65 70 20 22 20 73 74 single step " st
3810: 65 70 6e 61 6d 65 29 29 29 29 29 0a 20 20 20 20 epname))))).
3820: 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 65 2d (iup:button "Re-
3830: 72 75 6e 20 61 6e 64 20 63 6f 6e 74 69 6e 75 65 run and continue
3840: 22 20 20 20 20 20 20 20 20 20 0a 09 09 23 3a 65 " ...#:e
3850: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
3860: 4c 22 20 0a 09 09 23 3a 61 63 74 69 6f 6e 20 28 L" ...#:action (
3870: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 lambda (obj)....
3880: 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 (thread-start
3890: 21 0a 09 09 09 20 20 20 20 28 6d 61 6b 65 2d 74 !.... (make-t
38a0: 68 72 65 61 64 20 28 6c 61 6d 62 64 61 20 28 29 hread (lambda ()
38b0: 0a 09 09 09 09 09 20 20 20 28 65 7a 73 74 65 70 ...... (ezstep
38c0: 73 3a 72 75 6e 2d 66 72 6f 6d 20 74 65 73 74 64 s:run-from testd
38d0: 61 74 20 73 74 65 70 6e 61 6d 65 20 23 66 29 29 at stepname #f))
38e0: 0a 09 09 09 09 09 20 28 63 6f 6e 63 20 22 65 7a ...... (conc "ez
38f0: 73 74 65 70 20 72 75 6e 20 66 72 6f 6d 20 73 74 step run from st
3900: 65 70 20 22 20 73 74 65 70 6e 61 6d 65 29 29 29 ep " stepname)))
3910: 29 29 0a 20 20 20 20 3b 3b 20 28 69 75 70 3a 62 )). ;; (iup:b
3920: 75 74 74 6f 6e 20 22 52 65 66 72 65 73 68 20 74 utton "Refresh t
3930: 65 73 74 20 64 61 74 61 22 0a 20 20 20 20 3b 3b est data". ;;
3940: 20 20 20 20 20 09 23 3a 65 78 70 61 6e 64 20 22 .#:expand "
3950: 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 20 20 20 20 HORIZONTAL".
3960: 3b 3b 20 20 20 20 20 09 23 3a 61 63 74 69 6f 6e ;; .#:action
3970: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 20 (lambda (obj).
3980: 20 20 20 3b 3b 20 20 20 20 20 09 09 20 20 20 28 ;; .. (
3990: 70 72 69 6e 74 20 22 52 65 66 72 65 73 68 20 74 print "Refresh t
39a0: 65 73 74 20 64 61 74 61 20 22 20 73 74 65 70 6e est data " stepn
39b0: 61 6d 65 29 29 0a 20 20 20 20 29 29 29 0a 0a 28 ame)). )))..(
39c0: 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 define (dashboar
39d0: 64 2d 74 65 73 74 73 3a 77 61 69 76 65 72 20 72 d-tests:waiver r
39e0: 75 6e 2d 69 64 20 74 65 73 74 64 61 74 20 6f 76 un-id testdat ov
39f0: 72 64 76 61 6c 20 63 6d 74 63 6d 64 29 0a 20 20 rdval cmtcmd).
3a00: 28 6c 65 74 2a 20 28 28 77 70 61 74 74 20 28 63 (let* ((wpatt (c
3a10: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 onfigf:lookup *c
3a20: 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 onfigdat* "setup
3a30: 22 20 22 77 61 69 76 65 72 63 6f 6d 6d 65 6e 74 " "waivercomment
3a40: 70 61 74 74 22 29 29 0a 09 20 28 77 72 65 67 78 patt")).. (wregx
3a50: 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 77 70 (if (string? wp
3a60: 61 74 74 29 28 72 65 67 65 78 70 20 77 70 61 74 att)(regexp wpat
3a70: 74 29 20 23 66 29 29 0a 09 20 28 77 6d 65 73 67 t) #f)).. (wmesg
3a80: 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 69 66 20 (iup:label (if
3a90: 77 70 61 74 74 20 28 63 6f 6e 63 20 22 43 6f 6d wpatt (conc "Com
3aa0: 6d 65 6e 74 20 6d 75 73 74 20 6d 61 74 63 68 20 ment must match
3ab0: 70 61 74 74 65 72 6e 20 22 20 77 70 61 74 74 29 pattern " wpatt)
3ac0: 20 22 22 29 29 29 0a 09 20 28 63 6f 6d 6e 74 20 ""))).. (comnt
3ad0: 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 61 (iup:textbox #:a
3ae0: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 76 ction (lambda (v
3af0: 61 6c 20 61 20 62 29 0a 09 09 09 09 09 28 69 66 al a b)......(if
3b00: 20 77 70 61 74 74 0a 09 09 09 09 09 20 20 20 20 wpatt......
3b10: 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (if (string-matc
3b20: 68 20 77 72 65 67 78 20 62 29 0a 09 09 09 09 09 h wregx b)......
3b30: 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d .(iup:attribute-
3b40: 73 65 74 21 20 77 6d 65 73 67 20 22 54 49 54 4c set! wmesg "TITL
3b50: 45 22 20 28 63 6f 6e 63 20 22 43 6f 6d 6d 65 6e E" (conc "Commen
3b60: 74 20 6d 61 74 63 68 65 73 20 22 20 77 70 61 74 t matches " wpat
3b70: 74 29 29 0a 09 09 09 09 09 09 28 69 75 70 3a 61 t)).......(iup:a
3b80: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 77 6d ttribute-set! wm
3b90: 65 73 67 20 22 54 49 54 4c 45 22 20 28 63 6f 6e esg "TITLE" (con
3ba0: 63 20 22 43 6f 6d 6d 65 6e 74 20 64 6f 65 73 20 c "Comment does
3bb0: 6e 6f 74 20 6d 61 74 63 68 20 22 20 77 70 61 74 not match " wpat
3bc0: 74 29 29 0a 09 09 09 09 09 09 29 29 29 0a 09 09 t)).......)))...
3bd0: 09 20 20 20 20 20 23 3a 76 61 6c 75 65 20 28 69 . #:value (i
3be0: 66 20 6f 76 72 64 76 61 6c 20 6f 76 72 64 76 61 f ovrdval ovrdva
3bf0: 6c 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 l (db:test-get-c
3c00: 6f 6d 6d 65 6e 74 20 74 65 73 74 64 61 74 29 29 omment testdat))
3c10: 0a 09 09 09 20 20 20 20 20 23 3a 65 78 70 61 6e .... #:expan
3c20: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 29 d "HORIZONTAL"))
3c30: 0a 09 20 28 64 6c 6f 67 20 20 23 66 29 29 0a 20 .. (dlog #f)).
3c40: 20 20 20 28 73 65 74 21 20 64 6c 6f 67 20 28 69 (set! dlog (i
3c50: 75 70 3a 64 69 61 6c 6f 67 20 3b 3b 20 23 3a 63 up:dialog ;; #:c
3c60: 6c 6f 73 65 5f 63 62 20 28 6c 61 6d 62 64 61 20 lose_cb (lambda
3c70: 28 61 29 28 65 78 69 74 29 29 20 3b 20 23 3a 65 (a)(exit)) ; #:e
3c80: 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 23 3a xpand "YES"...#:
3c90: 74 69 74 6c 65 20 22 53 45 54 20 57 41 49 56 45 title "SET WAIVE
3ca0: 52 22 0a 09 09 28 69 75 70 3a 76 62 6f 78 20 3b R"...(iup:vbox ;
3cb0: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
3cc0: 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 .. (iup:label (c
3cd0: 6f 6e 63 20 22 45 6e 74 65 72 20 6a 75 73 74 69 onc "Enter justi
3ce0: 66 69 63 61 74 69 6f 6e 20 66 6f 72 20 77 61 69 fication for wai
3cf0: 76 69 6e 67 20 74 65 73 74 20 22 0a 09 09 09 09 ving test ".....
3d00: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 (db:test-get-t
3d10: 65 73 74 6e 61 6d 65 20 74 65 73 74 64 61 74 29 estname testdat)
3d20: 0a 09 09 09 09 20 20 28 69 66 20 28 65 71 75 61 ..... (if (equa
3d30: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
3d40: 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 64 61 item-path testda
3d50: 74 29 20 22 22 29 20 0a 09 09 09 09 20 20 20 20 t) "") .....
3d60: 20 20 22 22 0a 09 09 09 09 20 20 20 20 20 20 28 ""..... (
3d70: 63 6f 6e 63 20 22 2f 22 20 28 64 62 3a 74 65 73 conc "/" (db:tes
3d80: 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 t-get-item-path
3d90: 74 65 73 74 64 61 74 29 29 29 29 29 0a 09 09 20 testdat)))))...
3da0: 77 6d 65 73 67 20 3b 3b 20 74 68 65 20 69 6e 66 wmesg ;; the inf
3db0: 6f 72 6d 61 74 69 6f 6e 61 6c 20 6d 73 67 20 6f ormational msg o
3dc0: 6e 20 77 68 65 74 68 65 72 20 69 74 20 6d 61 74 n whether it mat
3dd0: 63 68 65 73 0a 09 09 20 63 6f 6d 6e 74 0a 09 09 ches... comnt...
3de0: 20 28 69 75 70 3a 68 62 6f 78 0a 09 09 20 20 28 (iup:hbox... (
3df0: 69 75 70 3a 62 75 74 74 6f 6e 20 22 41 70 70 6c iup:button "Appl
3e00: 79 20 61 6e 64 20 43 6c 6f 73 65 20 22 0a 09 09 y and Close "...
3e10: 09 20 20 20 20 20 20 23 3a 65 78 70 61 6e 64 20 . #:expand
3e20: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 "HORIZONTAL"....
3e30: 20 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 #:action (
3e40: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 lambda (obj)....
3e50: 09 09 20 28 6c 65 74 20 28 28 63 6f 6d 6d 65 6e .. (let ((commen
3e60: 74 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 t (iup:attribute
3e70: 20 63 6f 6d 6e 74 20 22 56 41 4c 55 45 22 29 29 comnt "VALUE"))
3e80: 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 74 65 ...... (te
3e90: 73 74 2d 69 64 20 28 64 62 3a 74 65 73 74 2d 67 st-id (db:test-g
3ea0: 65 74 2d 69 64 20 74 65 73 74 64 61 74 29 29 29 et-id testdat)))
3eb0: 0a 09 09 09 09 09 20 20 20 28 69 66 20 28 6f 72 ...... (if (or
3ec0: 20 28 6e 6f 74 20 77 70 61 74 74 29 0a 09 09 09 (not wpatt)....
3ed0: 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d 6d 61 ... (string-ma
3ee0: 74 63 68 20 77 72 65 67 78 20 63 6f 6d 6d 65 6e tch wregx commen
3ef0: 74 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 t))......
3f00: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 20 28 72 (begin....... (r
3f10: 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 mt:test-set-stat
3f20: 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 20 72 e-status-by-id r
3f30: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 23 66 un-id test-id #f
3f40: 20 22 57 41 49 56 45 44 22 20 63 6f 6d 6d 65 6e "WAIVED" commen
3f50: 74 29 0a 09 09 09 09 09 09 20 28 64 62 3a 74 65 t)....... (db:te
3f60: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 st-set-status! t
3f70: 65 73 74 64 61 74 20 22 57 41 49 56 45 44 22 29 estdat "WAIVED")
3f80: 0a 09 09 09 09 09 09 20 28 63 6d 74 63 6d 64 20 ....... (cmtcmd
3f90: 63 6f 6d 6d 65 6e 74 29 0a 09 09 09 09 09 09 20 comment).......
3fa0: 28 69 75 70 3a 64 65 73 74 72 6f 79 21 20 64 6c (iup:destroy! dl
3fb0: 6f 67 29 29 29 29 29 29 0a 09 09 20 20 28 69 75 og))))))... (iu
3fc0: 70 3a 62 75 74 74 6f 6e 20 22 43 61 6e 63 65 6c p:button "Cancel
3fd0: 22 0a 09 09 09 20 20 20 20 20 20 23 3a 65 78 70 ".... #:exp
3fe0: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
3ff0: 20 0a 09 09 09 20 20 20 20 20 20 23 3a 61 63 74 .... #:act
4000: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
4010: 29 0a 09 09 09 09 09 20 28 69 75 70 3a 64 65 73 )...... (iup:des
4020: 74 72 6f 79 21 20 64 6c 6f 67 29 29 29 29 29 29 troy! dlog))))))
4030: 29 0a 20 20 20 20 64 6c 6f 67 29 29 0a 0a 0a 3b ). dlog))...;
4040: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
4050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4080: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 0a 3b 3b 3d 3d 3d =======.;;.;;===
4090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40d0: 3d 3d 3d 0a 28 64 65 66 69 6e 65 20 28 64 61 73 ===.(define (das
40e0: 68 62 6f 61 72 64 2d 74 65 73 74 73 3a 65 78 61 hboard-tests:exa
40f0: 6d 69 6e 65 2d 74 65 73 74 20 72 75 6e 2d 69 64 mine-test run-id
4100: 20 74 65 73 74 2d 69 64 29 20 3b 3b 20 72 75 6e test-id) ;; run
4110: 2d 69 64 20 72 75 6e 2d 6b 65 79 20 6f 72 69 67 -id run-key orig
4120: 74 65 73 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 test). (let* ((
4130: 64 62 2d 70 61 74 68 20 20 20 20 20 20 20 28 64 db-path (d
4140: 62 3a 64 62 66 69 6c 65 2d 70 61 74 68 29 29 20 b:dbfile-path))
4150: 3b 3b 20 28 63 6f 6e 63 20 28 63 6f 6e 66 69 67 ;; (conc (config
4160: 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
4170: 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c 69 dat* "setup" "li
4180: 6e 6b 74 72 65 65 22 29 20 22 2f 64 62 2f 22 20 nktree") "/db/"
4190: 72 75 6e 2d 69 64 20 22 2e 64 62 22 29 29 0a 09 run-id ".db"))..
41a0: 20 28 64 62 73 74 72 75 63 74 20 20 20 20 20 20 (dbstruct
41b0: 23 66 29 20 3b 3b 20 4e 4f 54 20 41 43 54 55 41 #f) ;; NOT ACTUA
41c0: 4c 4c 59 20 55 53 45 44 20 28 64 62 3a 73 65 74 LLY USED (db:set
41d0: 75 70 29 29 20 3b 3b 20 28 6d 61 6b 65 2d 64 62 up)) ;; (make-db
41e0: 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 68 3a r:dbstruct path:
41f0: 20 20 28 64 62 3a 64 62 66 69 6c 65 2d 70 61 74 (db:dbfile-pat
4200: 68 20 23 66 29 20 3b 3b 20 28 63 6f 6e 66 69 67 h #f) ;; (config
4210: 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
4220: 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c 69 dat* "setup" "li
4230: 6e 6b 74 72 65 65 22 29 20 0a 09 09 09 20 20 20 nktree") ....
4240: 20 3b 3b 09 09 20 20 20 6c 6f 63 61 6c 3a 20 23 ;;.. local: #
4250: 74 29 29 0a 09 20 28 74 65 73 74 64 61 74 20 20 t)).. (testdat
4260: 20 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 (rmt:get-t
4270: 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 72 est-info-by-id r
4280: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 20 un-id test-id))
4290: 3b 3b 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d ;; (db:get-test-
42a0: 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 73 74 72 info-by-id dbstr
42b0: 75 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d uct run-id test-
42c0: 69 64 29 29 0a 09 20 28 64 62 2d 6d 6f 64 2d 74 id)).. (db-mod-t
42d0: 69 6d 65 20 20 20 30 29 20 3b 3b 20 28 66 69 6c ime 0) ;; (fil
42e0: 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d 74 e-modification-t
42f0: 69 6d 65 20 64 62 2d 70 61 74 68 29 29 0a 09 20 ime db-path))..
4300: 28 6c 61 73 74 2d 75 70 64 61 74 65 20 20 20 30 (last-update 0
4310: 29 20 3b 3b 20 28 63 75 72 72 65 6e 74 2d 73 65 ) ;; (current-se
4320: 63 6f 6e 64 73 29 29 0a 09 20 28 72 65 71 75 65 conds)).. (reque
4330: 73 74 2d 75 70 64 61 74 65 20 23 74 29 29 0a 20 st-update #t)).
4340: 20 20 20 28 69 66 20 28 6e 6f 74 20 74 65 73 74 (if (not test
4350: 64 61 74 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 dat)..(begin..
4360: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a (debug:print 2 *
4370: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
4380: 2a 20 22 45 52 52 4f 52 3a 20 4e 6f 20 74 65 73 * "ERROR: No tes
4390: 74 20 64 61 74 61 20 66 6f 75 6e 64 20 66 6f 72 t data found for
43a0: 20 74 65 73 74 20 22 20 74 65 73 74 2d 69 64 20 test " test-id
43b0: 22 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 ", exiting")..
43c0: 28 65 78 69 74 20 31 29 29 0a 09 28 6c 65 74 2a (exit 1))..(let*
43d0: 20 28 3b 3b 20 28 72 75 6e 2d 69 64 20 20 20 20 (;; (run-id
43e0: 20 20 20 20 28 69 66 20 74 65 73 74 64 61 74 20 (if testdat
43f0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e (db:test-get-run
4400: 5f 69 64 20 74 65 73 74 64 61 74 29 20 23 66 29 _id testdat) #f)
4410: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d ).. (test-
4420: 72 65 67 69 73 74 72 79 20 28 74 65 73 74 73 3a registry (tests:
4430: 67 65 74 2d 61 6c 6c 29 29 0a 09 20 20 20 20 20 get-all))..
4440: 20 20 28 6b 65 79 64 61 74 20 20 20 20 20 20 20 (keydat
4450: 20 28 69 66 20 74 65 73 74 64 61 74 20 28 72 6d (if testdat (rm
4460: 74 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 t:get-key-val-pa
4470: 69 72 73 20 72 75 6e 2d 69 64 29 20 23 66 29 29 irs run-id) #f))
4480: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 64 61 74 .. (rundat
4490: 20 20 20 20 20 20 20 20 28 69 66 20 74 65 73 74 (if test
44a0: 64 61 74 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e dat (rmt:get-run
44b0: 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 29 20 23 66 -info run-id) #f
44c0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 6e )).. (runn
44d0: 61 6d 65 20 20 20 20 20 20 20 28 69 66 20 74 65 ame (if te
44e0: 73 74 64 61 74 20 28 64 62 3a 67 65 74 2d 76 61 stdat (db:get-va
44f0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 28 64 lue-by-header (d
4500: 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e 64 61 b:get-rows runda
4510: 74 29 0a 09 09 09 09 09 09 09 09 20 20 28 64 62 t)......... (db
4520: 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 64 :get-header rund
4530: 61 74 29 0a 09 09 09 09 09 09 09 09 20 20 22 72 at)......... "r
4540: 75 6e 6e 61 6d 65 22 29 20 23 66 29 29 0a 09 20 unname") #f))..
4550: 20 20 20 20 20 20 3b 3b 20 28 74 64 62 20 20 20 ;; (tdb
4560: 20 20 20 20 20 20 20 20 28 74 64 62 3a 6f 70 65 (tdb:ope
4570: 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 n-test-db-by-tes
4580: 74 2d 69 64 2d 6c 6f 63 61 6c 20 64 62 73 74 72 t-id-local dbstr
4590: 75 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d uct run-id test-
45a0: 69 64 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 id)).. ;;
45b0: 54 68 65 73 65 20 6e 65 78 74 20 74 77 6f 20 61 These next two a
45c0: 72 65 20 69 6e 74 65 6e 74 69 6f 6e 61 6c 20 62 re intentional b
45d0: 61 64 20 76 61 6c 75 65 73 20 74 6f 20 65 6e 73 ad values to ens
45e0: 75 72 65 20 65 72 72 6f 72 73 20 69 66 20 74 68 ure errors if th
45f0: 65 79 20 73 68 6f 75 6c 64 20 6e 6f 74 0a 09 20 ey should not..
4600: 20 20 20 20 20 20 3b 3b 20 67 65 74 20 66 69 6c ;; get fil
4610: 6c 65 64 20 69 6e 20 70 72 6f 70 65 72 6c 79 2e led in properly.
4620: 0a 09 20 20 20 20 20 20 20 28 6c 6f 67 66 69 6c .. (logfil
4630: 65 20 20 20 20 20 20 20 22 2f 74 68 69 73 2f 64 e "/this/d
4640: 69 72 2f 62 65 74 74 65 72 2f 6e 6f 74 2f 65 78 ir/better/not/ex
4650: 69 73 74 22 29 0a 09 20 20 20 20 20 20 20 28 72 ist").. (r
4660: 75 6e 64 69 72 20 20 20 20 20 20 20 20 28 69 66 undir (if
4670: 20 74 65 73 74 64 61 74 20 0a 09 09 09 09 20 20 testdat .....
4680: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e (db:test-get-run
4690: 64 69 72 20 74 65 73 74 64 61 74 29 0a 09 09 09 dir testdat)....
46a0: 09 20 20 6c 6f 67 66 69 6c 65 29 29 0a 09 20 20 . logfile))..
46b0: 20 20 20 20 20 3b 3b 20 28 74 65 73 74 64 61 74 ;; (testdat
46c0: 2d 70 61 74 68 20 20 28 63 6f 6e 63 20 72 75 6e -path (conc run
46d0: 64 69 72 20 22 2f 74 65 73 74 64 61 74 2e 64 62 dir "/testdat.db
46e0: 22 29 29 20 3b 3b 20 74 68 69 73 20 67 65 74 73 ")) ;; this gets
46f0: 20 72 65 63 61 6c 63 75 6c 61 74 65 64 20 75 6e recalculated un
4700: 74 69 6c 20 66 6f 75 6e 64 20 0a 09 20 20 20 20 til found ..
4710: 20 20 20 28 74 65 73 74 73 74 65 70 73 20 20 20 (teststeps
4720: 20 20 28 69 66 20 74 65 73 74 64 61 74 20 28 74 (if testdat (t
4730: 65 73 74 73 3a 67 65 74 2d 63 6f 6d 70 72 65 73 ests:get-compres
4740: 73 65 64 2d 73 74 65 70 73 20 72 75 6e 2d 69 64 sed-steps run-id
4750: 20 74 65 73 74 2d 69 64 29 20 27 28 29 29 29 0a test-id) '())).
4760: 09 20 20 20 20 20 20 20 28 74 65 73 74 66 75 6c . (testful
4770: 6c 6e 61 6d 65 20 20 28 69 66 20 74 65 73 74 64 lname (if testd
4780: 61 74 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d at (db:test-get-
4790: 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 64 61 74 fullname testdat
47a0: 29 20 22 47 61 74 68 65 72 69 6e 67 20 64 61 74 ) "Gathering dat
47b0: 61 20 2e 2e 2e 22 29 29 0a 09 20 20 20 20 20 20 a ..."))..
47c0: 20 28 74 65 73 74 6e 61 6d 65 20 20 20 20 20 20 (testname
47d0: 28 69 66 20 74 65 73 74 64 61 74 20 28 64 62 3a (if testdat (db:
47e0: 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d test-get-testnam
47f0: 65 20 74 65 73 74 64 61 74 29 20 22 6e 2f 61 22 e testdat) "n/a"
4800: 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 74 )).. ;; (t
4810: 65 73 74 73 3a 67 65 74 2d 74 65 73 74 63 6f 6e ests:get-testcon
4820: 66 69 67 20 74 65 73 74 64 61 74 20 74 65 73 74 fig testdat test
4830: 6e 61 6d 65 20 27 72 65 74 75 72 6e 2d 70 72 6f name 'return-pro
4840: 63 73 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 cs)).. (te
4850: 73 74 6d 65 74 61 20 20 20 20 20 20 28 69 66 20 stmeta (if
4860: 74 65 73 74 64 61 74 20 0a 09 09 09 09 20 20 28 testdat ..... (
4870: 6c 65 74 20 28 28 74 6d 20 28 72 6d 74 3a 74 65 let ((tm (rmt:te
4880: 73 74 6d 65 74 61 2d 67 65 74 2d 72 65 63 6f 72 stmeta-get-recor
4890: 64 20 74 65 73 74 6e 61 6d 65 29 29 29 0a 09 09 d testname)))...
48a0: 09 09 20 20 20 20 28 69 66 20 74 6d 20 74 6d 20 .. (if tm tm
48b0: 28 6d 61 6b 65 2d 64 62 3a 74 65 73 74 6d 65 74 (make-db:testmet
48c0: 61 29 29 29 0a 09 09 09 09 20 20 28 6d 61 6b 65 a)))..... (make
48d0: 2d 64 62 3a 74 65 73 74 6d 65 74 61 29 29 29 0a -db:testmeta))).
48e0: 0a 09 20 20 20 20 20 20 20 28 6b 65 79 73 74 72 .. (keystr
48f0: 69 6e 67 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 ing (string-int
4900: 65 72 73 70 65 72 73 65 20 0a 09 09 09 20 20 20 ersperse ....
4910: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 6b (map (lambda (k
4920: 65 79 76 61 6c 29 0a 09 09 09 09 20 20 20 3b 3b eyval)..... ;;
4930: 20 28 63 6f 6e 63 20 22 3a 22 20 28 63 61 72 20 (conc ":" (car
4940: 6b 65 79 76 61 6c 29 20 22 20 22 20 28 63 61 64 keyval) " " (cad
4950: 72 20 6b 65 79 76 61 6c 29 29 29 0a 09 09 09 09 r keyval))).....
4960: 20 20 20 28 63 61 64 72 20 6b 65 79 76 61 6c 29 (cadr keyval)
4970: 29 0a 09 09 09 09 20 6b 65 79 64 61 74 29 0a 09 )..... keydat)..
4980: 09 09 20 20 20 20 22 2f 22 29 29 0a 09 20 20 20 .. "/"))..
4990: 20 20 20 20 28 69 74 65 6d 2d 70 61 74 68 20 20 (item-path
49a0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 (db:test-get-ite
49b0: 6d 2d 70 61 74 68 20 74 65 73 74 64 61 74 29 29 m-path testdat))
49c0: 0a 09 20 20 20 20 20 20 20 3b 3b 20 74 68 69 73 .. ;; this
49d0: 20 6e 65 78 74 20 62 6c 6f 63 6b 20 77 61 73 20 next block was
49e0: 61 64 64 65 64 20 74 6f 20 66 69 78 20 61 20 62 added to fix a b
49f0: 75 67 20 77 68 65 72 65 20 76 61 72 69 61 62 6c ug where variabl
4a00: 65 73 20 77 65 72 65 0a 20 20 20 20 20 20 20 20 es were.
4a10: 20 20 20 20 20 20 20 3b 3b 20 6e 65 65 64 65 64 ;; needed
4a20: 2e 20 52 65 76 69 73 69 74 20 74 68 69 73 2e 0a . Revisit this..
4a30: 09 20 20 20 20 20 20 20 28 72 75 6e 63 6f 6e 66 . (runconf
4a40: 69 67 20 20 28 6c 65 74 20 28 28 72 75 6e 63 6f ig (let ((runco
4a50: 6e 66 69 67 66 20 28 63 6f 6e 63 20 20 2a 74 6f nfigf (conc *to
4a60: 70 70 61 74 68 2a 20 22 2f 72 75 6e 63 6f 6e 66 ppath* "/runconf
4a70: 69 67 73 2e 63 6f 6e 66 69 67 22 29 29 29 0a 09 igs.config")))..
4a80: 20 09 09 20 20 20 20 20 28 69 66 20 28 66 69 6c .. (if (fil
4a90: 65 2d 65 78 69 73 74 73 3f 20 72 75 6e 63 6f 6e e-exists? runcon
4aa0: 66 69 67 66 29 0a 09 20 09 09 09 20 28 68 61 6e figf).. ... (han
4ab0: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 dle-exceptions.
4ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ae0: 20 20 65 78 6e 0a 20 20 20 20 20 20 20 20 20 20 exn.
4af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b00: 20 20 20 20 20 20 20 20 20 23 66 20 20 3b 3b 20 #f ;;
4b10: 64 6f 20 6e 6f 74 68 69 6e 67 2c 20 6a 75 73 74 do nothing, just
4b20: 20 6b 65 65 70 20 6f 6e 20 74 72 75 63 6b 69 6e keep on truckin
4b30: 67 20 2e 2e 2e 2e 0a 20 20 20 20 20 20 20 20 20 g .....
4b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b50: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 75 70 (setup
4b60: 2d 65 6e 76 2d 64 65 66 61 75 6c 74 73 20 72 75 -env-defaults ru
4b70: 6e 63 6f 6e 66 69 67 66 20 72 75 6e 2d 69 64 20 nconfigf run-id
4b80: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
4b90: 29 20 6b 65 79 64 61 74 20 65 6e 76 69 72 6f 6e ) keydat environ
4ba0: 2d 70 61 74 74 3a 20 6b 65 79 73 74 72 69 6e 67 -patt: keystring
4bb0: 29 29 0a 09 20 09 09 09 20 28 6d 61 6b 65 2d 68 )).. ... (make-h
4bc0: 61 73 68 2d 74 61 62 6c 65 29 29 29 29 0a 09 20 ash-table))))..
4bd0: 20 20 20 20 20 20 28 74 65 73 74 63 6f 6e 66 69 (testconfi
4be0: 67 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 g (begin.....
4bf0: 3b 3b 20 28 72 75 6e 73 3a 73 65 74 2d 6d 65 67 ;; (runs:set-meg
4c00: 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 72 atest-env-vars r
4c10: 75 6e 2d 69 64 20 69 6e 72 75 6e 6e 61 6d 65 3a un-id inrunname:
4c20: 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 6e 61 6d runname testnam
4c30: 65 3a 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 e: test-name ite
4c40: 6d 70 61 74 68 3a 20 69 74 65 6d 2d 70 61 74 68 mpath: item-path
4c50: 29 0a 09 09 09 09 28 72 75 6e 73 3a 73 65 74 2d ).....(runs:set-
4c60: 6d 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 megatest-env-var
4c70: 73 20 72 75 6e 2d 69 64 20 69 6e 6b 65 79 76 61 s run-id inkeyva
4c80: 6c 73 3a 20 6b 65 79 64 61 74 20 69 6e 72 75 6e ls: keydat inrun
4c90: 6e 61 6d 65 3a 20 72 75 6e 6e 61 6d 65 20 69 6e name: runname in
4ca0: 74 61 72 67 65 74 3a 20 6b 65 79 73 74 72 69 6e target: keystrin
4cb0: 67 20 74 65 73 74 6e 61 6d 65 3a 20 74 65 73 74 g testname: test
4cc0: 6e 61 6d 65 20 69 74 65 6d 70 61 74 68 3a 20 69 name itempath: i
4cd0: 74 65 6d 2d 70 61 74 68 29 20 3b 3b 20 74 68 65 tem-path) ;; the
4ce0: 73 65 20 6d 61 79 20 62 65 20 6e 65 65 64 65 64 se may be needed
4cf0: 20 62 79 20 74 68 65 20 6c 61 75 6e 63 68 69 6e by the launchin
4d00: 67 20 70 72 6f 63 65 73 73 0a 09 09 09 09 28 68 g process.....(h
4d10: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
4d20: 0a 09 09 09 09 20 65 78 6e 0a 09 09 09 09 20 28 ..... exn..... (
4d30: 74 65 73 74 73 3a 67 65 74 2d 74 65 73 74 63 6f tests:get-testco
4d40: 6e 66 69 67 20 28 64 62 3a 74 65 73 74 2d 67 65 nfig (db:test-ge
4d50: 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 64 t-testname testd
4d60: 61 74 29 20 74 65 73 74 2d 72 65 67 69 73 74 72 at) test-registr
4d70: 79 20 23 66 29 0a 09 09 09 09 20 28 74 65 73 74 y #f)..... (test
4d80: 73 3a 67 65 74 2d 74 65 73 74 63 6f 6e 66 69 67 s:get-testconfig
4d90: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 (db:test-get-te
4da0: 73 74 6e 61 6d 65 20 74 65 73 74 64 61 74 29 20 stname testdat)
4db0: 74 65 73 74 2d 72 65 67 69 73 74 72 79 20 23 74 test-registry #t
4dc0: 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 76 69 )))).. (vi
4dd0: 65 77 6c 6f 67 20 20 20 20 28 6c 61 6d 62 64 61 ewlog (lambda
4de0: 20 28 78 29 0a 09 09 09 20 20 20 20 20 28 69 66 (x).... (if
4df0: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c (file-exists? l
4e00: 6f 67 66 69 6c 65 29 0a 09 09 09 09 09 3b 28 73 ogfile)......;(s
4e10: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 66 69 72 ystem (conc "fir
4e20: 65 66 6f 78 20 22 20 6c 6f 67 66 69 6c 65 20 22 efox " logfile "
4e30: 26 22 29 29 0a 09 09 09 09 20 28 64 61 73 68 62 &"))..... (dashb
4e40: 6f 61 72 64 2d 74 65 73 74 73 3a 72 75 6e 2d 68 oard-tests:run-h
4e50: 74 6d 6c 2d 76 69 65 77 65 72 20 6c 6f 67 66 69 tml-viewer logfi
4e60: 6c 65 29 0a 09 09 09 09 20 28 6d 65 73 73 61 67 le)..... (messag
4e70: 65 2d 77 69 6e 64 6f 77 20 28 63 6f 6e 63 20 22 e-window (conc "
4e80: 46 69 6c 65 20 22 20 6c 6f 67 66 69 6c 65 20 22 File " logfile "
4e90: 20 6e 6f 74 20 66 6f 75 6e 64 22 29 29 29 29 29 not found")))))
4ea0: 0a 09 20 20 20 20 20 20 20 28 76 69 65 77 2d 61 .. (view-a
4eb0: 2d 6c 6f 67 20 28 6c 61 6d 62 64 61 20 28 6c 66 -log (lambda (lf
4ec0: 69 6c 65 29 20 0a 09 09 09 20 20 20 20 20 28 6c ile) .... (l
4ed0: 65 74 20 28 28 6c 66 69 6c 65 6e 61 6d 65 20 28 et ((lfilename (
4ee0: 63 6f 6e 63 20 72 75 6e 64 69 72 20 22 2f 22 20 conc rundir "/"
4ef0: 6c 66 69 6c 65 29 29 29 0a 09 09 09 20 20 20 20 lfile)))....
4f00: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 6c 66 ;; (print "lf
4f10: 69 6c 65 6e 61 6d 65 3a 20 22 20 6c 66 69 6c 65 ilename: " lfile
4f20: 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 20 20 name)....
4f30: 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 (if (file-exists
4f40: 3f 20 6c 66 69 6c 65 6e 61 6d 65 29 0a 09 09 09 ? lfilename)....
4f50: 09 09 3b 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 ..;(system (conc
4f60: 20 22 66 69 72 65 66 6f 78 20 22 20 6c 6f 67 66 "firefox " logf
4f70: 69 6c 65 20 22 26 22 29 29 0a 09 09 09 09 20 20 ile "&")).....
4f80: 20 28 64 61 73 68 62 6f 61 72 64 2d 74 65 73 74 (dashboard-test
4f90: 73 3a 72 75 6e 2d 68 74 6d 6c 2d 76 69 65 77 65 s:run-html-viewe
4fa0: 72 20 6c 66 69 6c 65 6e 61 6d 65 29 0a 09 09 09 r lfilename)....
4fb0: 09 20 20 20 28 6d 65 73 73 61 67 65 2d 77 69 6e . (message-win
4fc0: 64 6f 77 20 28 63 6f 6e 63 20 22 46 69 6c 65 20 dow (conc "File
4fd0: 22 20 6c 66 69 6c 65 6e 61 6d 65 20 22 20 6e 6f " lfilename " no
4fe0: 74 20 66 6f 75 6e 64 22 29 29 29 29 29 29 0a 09 t found"))))))..
4ff0: 20 20 20 20 20 20 20 28 78 74 65 72 6d 20 20 20 (xterm
5000: 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 (lambda (x)..
5010: 09 09 20 20 20 20 20 28 69 66 20 28 64 69 72 65 .. (if (dire
5020: 63 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 72 75 ctory-exists? ru
5030: 6e 64 69 72 29 0a 09 09 09 09 20 28 6c 65 74 20 ndir)..... (let
5040: 28 28 73 68 65 6c 6c 20 28 69 66 20 28 67 65 74 ((shell (if (get
5050: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
5060: 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 20 0a iable "SHELL") .
5070: 09 09 09 09 09 09 20 20 28 63 6f 6e 63 20 22 2d ...... (conc "-
5080: 65 20 22 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e e " (get-environ
5090: 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 53 ment-variable "S
50a0: 48 45 4c 4c 22 29 29 0a 09 09 09 09 09 09 20 20 HELL")).......
50b0: 22 22 29 29 29 0a 09 09 09 09 20 20 20 28 63 6f "")))..... (co
50c0: 6d 6d 6f 6e 3a 77 69 74 68 6f 75 74 2d 76 61 72 mmon:without-var
50d0: 73 0a 09 09 09 09 20 20 20 20 28 63 6f 6e 63 20 s..... (conc
50e0: 22 63 64 20 22 20 72 75 6e 64 69 72 20 0a 09 09 "cd " rundir ...
50f0: 09 09 09 20 20 22 3b 6d 74 5f 78 74 65 72 6d 20 ... ";mt_xterm
5100: 2d 54 20 5c 22 22 20 28 73 74 72 69 6e 67 2d 74 -T \"" (string-t
5110: 72 61 6e 73 6c 61 74 65 20 74 65 73 74 66 75 6c ranslate testful
5120: 6c 6e 61 6d 65 20 22 28 29 22 20 22 20 20 22 29 lname "()" " ")
5130: 20 22 5c 22 20 22 20 73 68 65 6c 6c 20 22 26 22 "\" " shell "&"
5140: 29 0a 09 09 09 09 20 20 20 20 22 4d 54 5f 2e 2a )..... "MT_.*
5150: 22 29 29 0a 09 09 09 09 20 28 6d 65 73 73 61 67 "))..... (messag
5160: 65 2d 77 69 6e 64 6f 77 20 20 28 63 6f 6e 63 20 e-window (conc
5170: 22 44 69 72 65 63 74 6f 72 79 20 22 20 72 75 6e "Directory " run
5180: 64 69 72 20 22 20 6e 6f 74 20 66 6f 75 6e 64 22 dir " not found"
5190: 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 77 ))))).. (w
51a0: 69 64 67 65 74 73 20 20 20 20 28 6d 61 6b 65 2d idgets (make-
51b0: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 hash-table))..
51c0: 20 20 20 20 20 28 72 65 66 72 65 73 68 64 61 74 (refreshdat
51d0: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 (lambda ()....
51e0: 20 20 20 20 28 6c 65 74 2a 20 28 28 63 75 72 72 (let* ((curr
51f0: 2d 6d 6f 64 2d 74 69 6d 65 20 28 66 69 6c 65 2d -mod-time (file-
5200: 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d modification-tim
5210: 65 20 64 62 2d 70 61 74 68 29 29 0a 09 09 09 09 e db-path)).....
5220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5230: 20 20 20 3b 3b 20 20 20 20 20 28 6d 61 78 20 2e ;; (max .
5240: 2e 2e 2e 2e 20 28 69 66 20 28 66 69 6c 65 2d 65 .... (if (file-e
5250: 78 69 73 74 73 3f 20 74 65 73 74 64 61 74 2d 70 xists? testdat-p
5260: 61 74 68 29 0a 09 09 09 09 09 09 20 20 20 3b 3b ath)....... ;;
5270: 20 20 20 20 20 20 09 20 20 20 20 20 20 28 66 69 . (fi
5280: 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d le-modification-
5290: 74 69 6d 65 20 74 65 73 74 64 61 74 2d 70 61 74 time testdat-pat
52a0: 68 29 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 h)....... ;;
52b0: 20 20 20 20 09 20 20 20 20 20 20 28 62 65 67 69 . (begi
52c0: 6e 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 n....... ;;
52d0: 20 20 20 09 09 28 73 65 74 21 20 74 65 73 74 64 ..(set! testd
52e0: 61 74 2d 70 61 74 68 20 28 63 6f 6e 63 20 72 75 at-path (conc ru
52f0: 6e 64 69 72 20 22 2f 74 65 73 74 64 61 74 2e 64 ndir "/testdat.d
5300: 62 22 29 29 0a 09 09 09 09 09 09 20 20 20 3b 3b b"))....... ;;
5310: 20 20 20 20 20 20 09 09 30 29 29 29 29 0a 09 09 ..0))))...
5320: 09 09 20 20 20 20 28 6e 65 65 64 2d 75 70 64 61 .. (need-upda
5330: 74 65 20 20 20 28 6f 72 20 28 61 6e 64 20 28 3e te (or (and (>
5340: 3d 20 63 75 72 72 2d 6d 6f 64 2d 74 69 6d 65 20 = curr-mod-time
5350: 64 62 2d 6d 6f 64 2d 74 69 6d 65 29 0a 09 09 09 db-mod-time)....
5360: 09 09 09 09 20 20 20 20 28 3e 20 28 63 75 72 72 .... (> (curr
5370: 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 ent-milliseconds
5380: 29 28 2b 20 6c 61 73 74 2d 75 70 64 61 74 65 20 )(+ last-update
5390: 32 35 30 29 29 29 20 3b 3b 20 65 76 65 72 79 20 250))) ;; every
53a0: 68 61 6c 66 20 73 65 63 6f 6e 64 73 20 69 66 20 half seconds if
53b0: 64 62 20 74 6f 75 63 68 65 64 0a 09 09 09 09 09 db touched......
53c0: 09 20 20 20 20 20 20 20 28 3e 20 28 63 75 72 72 . (> (curr
53d0: 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 ent-milliseconds
53e0: 29 28 2b 20 6c 61 73 74 2d 75 70 64 61 74 65 20 )(+ last-update
53f0: 31 30 30 30 30 29 29 20 20 20 20 20 3b 3b 20 66 10000)) ;; f
5400: 6f 72 63 65 20 75 70 64 61 74 65 20 65 76 65 6e orce update even
5410: 20 31 30 20 73 65 63 6f 6e 64 73 0a 09 09 09 09 10 seconds.....
5420: 09 09 20 20 20 20 20 20 20 72 65 71 75 65 73 74 .. request
5430: 2d 75 70 64 61 74 65 29 29 0a 09 09 09 09 20 20 -update)).....
5440: 20 20 28 6e 65 77 74 65 73 74 64 61 74 20 28 69 (newtestdat (i
5450: 66 20 6e 65 65 64 2d 75 70 64 61 74 65 20 0a 09 f need-update ..
5460: 09 09 09 09 09 20 20 20 20 3b 3b 20 4e 4f 54 45 ..... ;; NOTE
5470: 3a 20 42 55 47 20 48 49 44 45 52 2c 20 74 72 79 : BUG HIDER, try
5480: 20 74 6f 20 65 6c 69 6d 69 6e 61 74 65 20 74 68 to eliminate th
5490: 69 73 20 65 78 63 65 70 74 69 6f 6e 20 68 61 6e is exception han
54a0: 64 6c 65 72 0a 09 09 09 09 09 09 20 20 20 20 28 dler....... (
54b0: 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e handle-exception
54c0: 73 0a 09 09 09 09 09 09 20 20 20 20 20 65 78 6e s....... exn
54d0: 20 0a 09 09 09 09 09 09 20 20 20 20 20 28 64 65 ....... (de
54e0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
54f0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
5500: 72 74 2a 20 22 74 65 73 74 20 64 62 20 61 63 63 rt* "test db acc
5510: 65 73 73 20 69 73 73 75 65 20 69 6e 20 65 78 61 ess issue in exa
5520: 6d 69 6e 65 20 74 65 73 74 20 66 6f 72 20 72 75 mine test for ru
5530: 6e 2d 69 64 20 22 20 72 75 6e 2d 69 64 20 22 2c n-id " run-id ",
5540: 20 74 65 73 74 2d 69 64 20 22 20 74 65 73 74 2d test-id " test-
5550: 69 64 20 22 3a 20 22 20 28 28 63 6f 6e 64 69 74 id ": " ((condit
5560: 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
5570: 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
5580: 61 67 65 29 20 65 78 6e 29 29 0a 09 09 09 09 09 age) exn))......
5590: 09 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 . (rmt:get-t
55a0: 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 72 est-info-by-id r
55b0: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 29 29 un-id test-id ))
55c0: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 3b 3b ))).... ;;
55d0: 20 28 70 72 69 6e 74 20 22 49 4e 46 4f 3a 20 6e (print "INFO: n
55e0: 65 65 64 2d 75 70 64 61 74 65 3d 20 22 20 6e 65 eed-update= " ne
55f0: 65 64 2d 75 70 64 61 74 65 20 22 20 63 75 72 72 ed-update " curr
5600: 2d 6d 6f 64 2d 74 69 6d 65 20 3d 20 22 20 63 75 -mod-time = " cu
5610: 72 72 2d 6d 6f 64 2d 74 69 6d 65 29 0a 09 09 09 rr-mod-time)....
5620: 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 09 09 09 (cond....
5630: 09 28 28 61 6e 64 20 6e 65 65 64 2d 75 70 64 61 .((and need-upda
5640: 74 65 20 6e 65 77 74 65 73 74 64 61 74 29 0a 09 te newtestdat)..
5650: 09 09 09 20 28 73 65 74 21 20 74 65 73 74 64 61 ... (set! testda
5660: 74 20 6e 65 77 74 65 73 74 64 61 74 29 0a 09 09 t newtestdat)...
5670: 09 09 20 28 73 65 74 21 20 74 65 73 74 73 74 65 .. (set! testste
5680: 70 73 20 20 20 20 28 74 65 73 74 73 3a 67 65 74 ps (tests:get
5690: 2d 63 6f 6d 70 72 65 73 73 65 64 2d 73 74 65 70 -compressed-step
56a0: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 s run-id test-id
56b0: 29 29 0a 09 09 09 09 20 28 73 65 74 21 20 6c 6f ))..... (set! lo
56c0: 67 66 69 6c 65 20 20 20 20 20 20 28 63 6f 6e 63 gfile (conc
56d0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru
56e0: 6e 64 69 72 20 74 65 73 74 64 61 74 29 20 22 2f ndir testdat) "/
56f0: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 " (db:test-get-f
5700: 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 74 64 61 inal_logf testda
5710: 74 29 29 29 0a 09 09 09 09 20 28 73 65 74 21 20 t)))..... (set!
5720: 72 75 6e 64 69 72 20 20 20 20 20 20 20 3b 3b 20 rundir ;;
5730: 28 66 69 6c 65 64 62 3a 67 65 74 2d 70 61 74 68 (filedb:get-path
5740: 20 2a 66 64 62 2a 20 0a 09 09 09 09 20 20 20 20 *fdb* .....
5750: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
5760: 72 75 6e 64 69 72 20 74 65 73 74 64 61 74 29 29 rundir testdat))
5770: 20 3b 3b 20 29 0a 09 09 09 09 20 28 73 65 74 21 ;; )..... (set!
5780: 20 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 28 64 testfullname (d
5790: 62 3a 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e b:test-get-fulln
57a0: 61 6d 65 20 74 65 73 74 64 61 74 29 29 0a 09 09 ame testdat))...
57b0: 09 09 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 .. ;; (debug:pri
57c0: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
57d0: 67 2d 70 6f 72 74 2a 20 22 49 4e 46 4f 3a 20 74 g-port* "INFO: t
57e0: 65 73 74 73 74 65 70 73 3d 22 20 28 69 6e 74 65 eststeps=" (inte
57f0: 72 73 70 65 72 73 65 20 74 65 73 74 73 74 65 70 rsperse teststep
5800: 73 20 22 5c 6e 20 20 20 20 22 29 29 0a 09 09 09 s "\n "))....
5810: 09 20 0a 09 09 09 09 20 3b 3b 20 49 20 64 6f 6e . ..... ;; I don
5820: 27 74 20 73 65 65 20 77 68 79 20 74 68 69 73 20 't see why this
5830: 77 61 73 20 69 6d 70 6c 65 6d 65 6e 74 65 64 20 was implemented
5840: 74 68 69 73 20 77 61 79 2e 20 50 6c 65 61 73 65 this way. Please
5850: 20 63 6f 6d 6d 65 6e 74 20 69 74 20 2e 2e 2e 0a comment it ....
5860: 09 09 09 09 20 3b 3b 20 28 69 66 20 28 65 71 3f .... ;; (if (eq?
5870: 20 63 75 72 72 2d 6d 6f 64 2d 74 69 6d 65 20 64 curr-mod-time d
5880: 62 2d 6d 6f 64 2d 74 69 6d 65 29 20 3b 3b 20 64 b-mod-time) ;; d
5890: 6f 20 6f 6e 6c 79 20 6f 6e 63 65 20 69 66 20 73 o only once if s
58a0: 61 6d 65 0a 09 09 09 09 20 3b 3b 20 20 20 20 20 ame..... ;;
58b0: 28 73 65 74 21 20 64 62 2d 6d 6f 64 2d 74 69 6d (set! db-mod-tim
58c0: 65 20 28 2b 20 63 75 72 72 2d 6d 6f 64 2d 74 69 e (+ curr-mod-ti
58d0: 6d 65 20 31 29 29 0a 09 09 09 09 20 3b 3b 20 20 me 1))..... ;;
58e0: 20 20 20 28 73 65 74 21 20 64 62 2d 6d 6f 64 2d (set! db-mod-
58f0: 74 69 6d 65 20 63 75 72 72 2d 6d 6f 64 2d 74 69 time curr-mod-ti
5900: 6d 65 29 29 0a 0a 09 09 09 09 20 28 69 66 20 28 me))...... (if (
5910: 6e 6f 74 20 28 65 71 3f 20 63 75 72 72 2d 6d 6f not (eq? curr-mo
5920: 64 2d 74 69 6d 65 20 64 62 2d 6d 6f 64 2d 74 69 d-time db-mod-ti
5930: 6d 65 29 29 0a 09 09 09 09 20 20 20 20 20 28 73 me))..... (s
5940: 65 74 21 20 64 62 2d 6d 6f 64 2d 74 69 6d 65 20 et! db-mod-time
5950: 63 75 72 72 2d 6d 6f 64 2d 74 69 6d 65 29 29 0a curr-mod-time)).
5960: 09 09 09 09 20 28 73 65 74 21 20 6c 61 73 74 2d .... (set! last-
5970: 75 70 64 61 74 65 20 28 63 75 72 72 65 6e 74 2d update (current-
5980: 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a 09 milliseconds))..
5990: 09 09 09 20 28 73 65 74 21 20 72 65 71 75 65 73 ... (set! reques
59a0: 74 2d 75 70 64 61 74 65 20 23 66 29 20 3b 3b 20 t-update #f) ;;
59b0: 6d 65 74 20 74 68 65 20 6e 65 65 64 20 2e 2e 2e met the need ...
59c0: 0a 09 09 09 09 20 29 0a 09 09 09 09 28 6e 65 65 ..... ).....(nee
59d0: 64 2d 75 70 64 61 74 65 20 3b 3b 20 69 66 20 74 d-update ;; if t
59e0: 68 69 73 20 77 61 73 20 74 72 75 65 20 61 6e 64 his was true and
59f0: 20 79 65 74 20 74 68 65 72 65 20 69 73 20 6e 6f yet there is no
5a00: 20 64 61 74 61 20 2e 2e 2e 2e 0a 09 09 09 09 20 data .........
5a10: 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 74 65 73 (db:test-set-tes
5a20: 74 6e 61 6d 65 21 20 74 65 73 74 64 61 74 20 22 tname! testdat "
5a30: 44 45 41 44 20 4f 52 20 44 45 4c 45 54 45 44 20 DEAD OR DELETED
5a40: 54 45 53 54 22 29 29 29 0a 09 09 09 20 20 20 20 TEST")))....
5a50: 20 20 20 28 69 66 20 6e 65 65 64 2d 75 70 64 61 (if need-upda
5a60: 74 65 0a 09 09 09 09 20 20 20 28 62 65 67 69 6e te..... (begin
5a70: 0a 09 09 09 09 20 20 20 20 20 3b 3b 20 75 70 64 ..... ;; upd
5a80: 61 74 65 20 74 68 65 20 67 75 69 20 65 6c 65 6d ate the gui elem
5a90: 65 6e 74 73 20 68 65 72 65 0a 09 09 09 09 20 20 ents here.....
5aa0: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 (for-each ...
5ab0: 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
5ac0: 28 6b 65 79 29 0a 09 09 09 09 09 3b 3b 20 28 70 (key)......;; (p
5ad0: 72 69 6e 74 20 22 55 70 64 61 74 69 6e 67 20 22 rint "Updating "
5ae0: 20 6b 65 79 29 0a 09 09 09 09 09 28 28 68 61 73 key)......((has
5af0: 68 2d 74 61 62 6c 65 2d 72 65 66 20 77 69 64 67 h-table-ref widg
5b00: 65 74 73 20 6b 65 79 29 20 74 65 73 74 64 61 74 ets key) testdat
5b10: 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 68 61 ))..... (ha
5b20: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 77 69 sh-table-keys wi
5b30: 64 67 65 74 73 29 29 0a 09 09 09 09 20 20 20 20 dgets)).....
5b40: 20 28 75 70 64 61 74 65 2d 73 74 61 74 65 2d 73 (update-state-s
5b50: 74 61 74 75 73 2d 62 75 74 74 6f 6e 73 20 74 65 tatus-buttons te
5b60: 73 74 64 61 74 29 29 29 0a 09 09 09 20 20 20 20 stdat)))....
5b70: 20 20 20 3b 3b 20 28 69 75 70 3a 72 65 66 72 65 ;; (iup:refre
5b80: 73 68 20 73 65 6c 66 29 0a 09 09 09 20 20 20 20 sh self)....
5b90: 20 20 20 29 29 29 0a 09 20 20 20 20 20 20 20 28 ))).. (
5ba0: 6d 65 74 61 2d 77 69 64 67 65 74 73 20 28 6d 61 meta-widgets (ma
5bb0: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
5bc0: 09 20 20 20 20 20 20 20 28 73 65 6c 66 20 20 20 . (self
5bd0: 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 #f)..
5be0: 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 20 (store-label
5bf0: 28 6c 61 6d 62 64 61 20 28 6e 61 6d 65 20 6c 62 (lambda (name lb
5c00: 6c 20 63 6d 64 29 0a 09 09 09 20 20 20 20 20 20 l cmd)....
5c10: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
5c20: 21 20 77 69 64 67 65 74 73 20 6e 61 6d 65 20 0a ! widgets name .
5c30: 09 09 09 09 09 09 28 6c 61 6d 62 64 61 20 28 74 ......(lambda (t
5c40: 65 73 74 64 61 74 29 0a 09 09 09 09 09 09 20 20 estdat).......
5c50: 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 28 63 (let ((newval (c
5c60: 6d 64 20 74 65 73 74 64 61 74 29 29 0a 09 09 09 md testdat))....
5c70: 09 09 09 09 28 6f 6c 64 76 61 6c 20 28 69 75 70 ....(oldval (iup
5c80: 3a 61 74 74 72 69 62 75 74 65 20 6c 62 6c 20 22 :attribute lbl "
5c90: 54 49 54 4c 45 22 29 29 29 0a 09 09 09 09 09 09 TITLE"))).......
5ca0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 (if (not (eq
5cb0: 75 61 6c 3f 20 6e 65 77 76 61 6c 20 6f 6c 64 76 ual? newval oldv
5cc0: 61 6c 29 29 0a 09 09 09 09 09 09 09 28 62 65 67 al))........(beg
5cd0: 69 6e 0a 09 09 09 09 09 3b 28 6d 75 74 65 78 2d in......;(mutex-
5ce0: 6c 6f 63 6b 21 20 6d 78 31 29 0a 09 09 09 09 09 lock! mx1)......
5cf0: 09 09 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 .. (iup:attribu
5d00: 74 65 2d 73 65 74 21 20 6c 62 6c 20 22 54 49 54 te-set! lbl "TIT
5d10: 4c 45 22 20 6e 65 77 76 61 6c 29 0a 09 09 09 09 LE" newval).....
5d20: 09 3b 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 .;(mutex-unlock!
5d30: 20 6d 78 31 29 0a 09 09 09 09 09 09 09 20 20 29 mx1)........ )
5d40: 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 6c )))).... l
5d50: 62 6c 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 bl)).. (st
5d60: 6f 72 65 2d 6d 65 74 61 20 20 28 6c 61 6d 62 64 ore-meta (lambd
5d70: 61 20 28 6e 61 6d 65 20 6c 62 6c 20 63 6d 64 29 a (name lbl cmd)
5d80: 0a 09 09 09 20 20 20 20 20 20 28 68 61 73 68 2d .... (hash-
5d90: 74 61 62 6c 65 2d 73 65 74 21 20 6d 65 74 61 2d table-set! meta-
5da0: 77 69 64 67 65 74 73 20 6e 61 6d 65 20 0a 09 09 widgets name ...
5db0: 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 ... (lambd
5dc0: 61 20 28 74 65 73 74 6d 65 74 61 29 0a 09 09 09 a (testmeta)....
5dd0: 09 09 09 20 28 6c 65 74 20 28 28 6e 65 77 76 61 ... (let ((newva
5de0: 6c 20 28 63 6d 64 20 74 65 73 74 6d 65 74 61 29 l (cmd testmeta)
5df0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 )....... (
5e00: 6f 6c 64 76 61 6c 20 28 69 75 70 3a 61 74 74 72 oldval (iup:attr
5e10: 69 62 75 74 65 20 6c 62 6c 20 22 54 49 54 4c 45 ibute lbl "TITLE
5e20: 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 28 69 ")))....... (i
5e30: 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e f (not (equal? n
5e40: 65 77 76 61 6c 20 6f 6c 64 76 61 6c 29 29 0a 09 ewval oldval))..
5e50: 09 09 09 09 09 20 20 20 20 20 20 20 28 62 65 67 ..... (beg
5e60: 69 6e 0a 09 09 09 09 09 3b 28 6d 75 74 65 78 2d in......;(mutex-
5e70: 6c 6f 63 6b 21 20 6d 78 31 29 0a 09 09 09 09 09 lock! mx1)......
5e80: 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 .. (iup:attribut
5e90: 65 2d 73 65 74 21 20 6c 62 6c 20 22 54 49 54 4c e-set! lbl "TITL
5ea0: 45 22 20 6e 65 77 76 61 6c 29 0a 09 09 09 09 09 E" newval)......
5eb0: 3b 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 ;(mutex-unlock!
5ec0: 6d 78 31 29 0a 09 09 09 09 09 09 09 20 29 29 29 mx1)........ )))
5ed0: 29 29 0a 09 09 09 20 20 20 20 20 20 6c 62 6c 29 )).... lbl)
5ee0: 29 0a 09 20 20 20 20 20 20 20 28 73 74 6f 72 65 ).. (store
5ef0: 2d 62 75 74 74 6f 6e 20 73 74 6f 72 65 2d 6c 61 -button store-la
5f00: 62 65 6c 29 0a 09 20 20 20 20 20 20 20 28 63 6f bel).. (co
5f10: 6d 6d 61 6e 64 2d 70 72 6f 63 20 28 6c 61 6d 62 mmand-proc (lamb
5f20: 64 61 20 28 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 da (command-text
5f30: 2d 62 6f 78 29 0a 09 09 09 20 20 20 20 20 20 20 -box)....
5f40: 28 6c 65 74 2a 20 28 28 63 6d 64 20 20 20 20 20 (let* ((cmd
5f50: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 63 (iup:attribute c
5f60: 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 6f 78 20 ommand-text-box
5f70: 22 56 41 4c 55 45 22 29 29 29 0a 09 09 09 09 20 "VALUE"))).....
5f80: 28 63 6f 6d 6d 6f 6e 3a 72 75 6e 2d 61 2d 63 6f (common:run-a-co
5f90: 6d 6d 61 6e 64 20 63 6d 64 29 29 29 29 0a 09 20 mmand cmd))))..
5fa0: 20 20 20 20 20 20 28 63 6f 6d 6d 61 6e 64 2d 74 (command-t
5fb0: 65 78 74 2d 62 6f 78 20 28 69 75 70 3a 74 65 78 ext-box (iup:tex
5fc0: 74 62 6f 78 0a 09 09 09 09 20 20 23 3a 65 78 70 tbox..... #:exp
5fd0: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
5fe0: 0a 09 09 09 09 20 20 23 3a 66 6f 6e 74 20 22 43 ..... #:font "C
5ff0: 6f 75 72 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 ourier New, -10"
6000: 0a 09 09 09 09 20 20 23 3a 61 63 74 69 6f 6e 20 ..... #:action
6010: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 63 6e 75 (lambda (obj cnu
6020: 6d 20 76 61 6c 29 0a 09 09 09 09 09 20 20 20 20 m val)......
6030: 20 3b 3b 20 28 70 72 69 6e 74 20 22 63 6e 75 6d ;; (print "cnum
6040: 3d 22 20 63 6e 75 6d 29 0a 09 09 09 09 09 20 20 =" cnum)......
6050: 20 20 20 28 69 66 20 28 65 71 3f 20 63 6e 75 6d (if (eq? cnum
6060: 20 31 33 29 0a 09 09 09 09 09 09 20 28 63 6f 6d 13)....... (com
6070: 6d 61 6e 64 2d 70 72 6f 78 20 6f 62 6a 29 29 29 mand-prox obj)))
6080: 0a 09 09 09 09 20 20 29 29 0a 09 20 20 20 20 20 ..... ))..
6090: 20 20 28 63 6f 6d 6d 61 6e 64 2d 6c 61 75 6e 63 (command-launc
60a0: 68 2d 62 75 74 74 6f 6e 20 28 69 75 70 3a 62 75 h-button (iup:bu
60b0: 74 74 6f 6e 20 22 45 78 65 63 75 74 65 21 22 20 tton "Execute!"
60c0: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda
60d0: 20 28 78 29 0a 09 09 09 09 09 09 09 09 09 28 63 (x)..........(c
60e0: 6f 6d 6d 61 6e 64 2d 70 72 6f 63 20 63 6f 6d 6d ommand-proc comm
60f0: 61 6e 64 2d 74 65 78 74 2d 62 6f 78 29 29 29 29 and-text-box))))
6100: 0a 09 3b 3b 20 28 6c 61 6d 62 64 61 20 28 78 29 ..;; (lambda (x)
6110: 0a 09 3b 3b 20 09 09 09 09 09 09 09 09 28 6c 65 ..;; ........(le
6120: 74 2a 20 28 28 63 6d 64 20 20 20 20 20 28 69 75 t* ((cmd (iu
6130: 70 3a 61 74 74 72 69 62 75 74 65 20 63 6f 6d 6d p:attribute comm
6140: 61 6e 64 2d 74 65 78 74 2d 62 6f 78 20 22 56 41 and-text-box "VA
6150: 4c 55 45 22 29 29 0a 09 3b 3b 20 09 09 09 09 09 LUE"))..;; .....
6160: 09 09 09 20 20 20 20 20 20 20 28 66 75 6c 6c 63 ... (fullc
6170: 6d 64 20 28 63 6f 6e 63 20 28 64 74 65 73 74 73 md (conc (dtests
6180: 3a 67 65 74 2d 70 72 65 2d 63 6f 6d 6d 61 6e 64 :get-pre-command
6190: 29 0a 09 3b 3b 20 09 09 09 09 09 09 09 09 09 09 )..;; ..........
61a0: 20 20 20 20 20 20 63 6d 64 20 0a 09 3b 3b 20 09 cmd ..;; .
61b0: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 ......... (
61c0: 64 74 65 73 74 73 3a 67 65 74 2d 70 6f 73 74 2d dtests:get-post-
61d0: 63 6f 6d 6d 61 6e 64 29 29 29 29 0a 09 3b 3b 20 command))))..;;
61e0: 09 09 09 09 09 09 09 09 20 20 28 64 65 62 75 67 ........ (debug
61f0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 32 20 2a :print-info 02 *
6200: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
6210: 2a 20 22 52 75 6e 6e 69 6e 67 20 63 6f 6d 6d 61 * "Running comma
6220: 6e 64 3a 20 22 20 66 75 6c 6c 63 6d 64 29 0a 09 nd: " fullcmd)..
6230: 3b 3b 20 09 09 09 09 09 09 09 09 20 20 28 63 6f ;; ........ (co
6240: 6d 6d 6f 6e 3a 77 69 74 68 6f 75 74 2d 76 61 72 mmon:without-var
6250: 73 20 66 75 6c 6c 63 6d 64 20 22 4d 54 5f 2e 2a s fullcmd "MT_.*
6260: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 "))))).. (
6270: 6b 69 6c 6c 2d 6a 6f 62 73 20 28 6c 61 6d 62 64 kill-jobs (lambd
6280: 61 20 28 78 29 0a 09 09 09 20 20 20 20 28 69 75 a (x).... (iu
6290: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
62a0: 20 0a 09 09 09 20 20 20 20 20 63 6f 6d 6d 61 6e .... comman
62b0: 64 2d 74 65 78 74 2d 62 6f 78 20 22 56 41 4c 55 d-text-box "VALU
62c0: 45 22 0a 09 09 09 20 20 20 20 20 28 63 6f 6e 63 E".... (conc
62d0: 20 22 6d 65 67 61 74 65 73 74 20 2d 74 61 72 67 "megatest -targ
62e0: 65 74 20 22 20 6b 65 79 73 74 72 69 6e 67 20 22 et " keystring "
62f0: 20 2d 72 75 6e 6e 61 6d 65 20 22 20 20 72 75 6e -runname " run
6300: 6e 61 6d 65 20 0a 09 09 09 09 20 20 20 22 20 2d name ..... " -
6310: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
6320: 20 4b 49 4c 4c 52 45 51 2c 6e 2f 61 20 2d 74 65 KILLREQ,n/a -te
6330: 73 74 70 61 74 74 20 25 2f 25 20 22 0a 09 09 09 stpatt %/% "....
6340: 09 20 20 20 22 20 2d 73 74 61 74 65 20 52 55 4e . " -state RUN
6350: 4e 49 4e 47 2c 52 45 4d 4f 54 45 48 4f 53 54 53 NING,REMOTEHOSTS
6360: 54 41 52 54 2c 4c 41 55 4e 43 48 45 44 22 29 29 TART,LAUNCHED"))
6370: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
6380: 74 65 73 74 20 20 28 6c 61 6d 62 64 61 20 28 78 test (lambda (x
6390: 29 0a 09 09 09 20 20 20 20 28 69 75 70 3a 61 74 ).... (iup:at
63a0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 0a 09 09 tribute-set! ...
63b0: 09 20 20 20 20 20 63 6f 6d 6d 61 6e 64 2d 74 65 . command-te
63c0: 78 74 2d 62 6f 78 20 22 56 41 4c 55 45 22 0a 09 xt-box "VALUE"..
63d0: 09 09 20 20 20 20 20 28 63 6f 6e 63 20 22 6d 65 .. (conc "me
63e0: 67 61 74 65 73 74 20 2d 74 61 72 67 65 74 20 22 gatest -target "
63f0: 20 6b 65 79 73 74 72 69 6e 67 20 22 20 2d 72 75 keystring " -ru
6400: 6e 6e 61 6d 65 20 22 20 72 75 6e 6e 61 6d 65 20 nname " runname
6410: 0a 09 09 09 09 20 20 20 22 20 2d 72 75 6e 20 2d ..... " -run -
6420: 74 65 73 74 70 61 74 74 20 22 20 28 63 6f 6e 63 testpatt " (conc
6430: 20 74 65 73 74 6e 61 6d 65 20 22 2f 22 20 28 69 testname "/" (i
6440: 66 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 f (equal? item-p
6450: 61 74 68 20 22 22 29 0a 09 09 09 09 09 09 09 09 ath "").........
6460: 09 22 25 22 20 0a 09 09 09 09 09 09 09 09 09 69 ."%" ..........i
6470: 74 65 6d 2d 70 61 74 68 29 29 0a 09 09 09 09 20 tem-path)).....
6480: 20 20 22 20 2d 63 6c 65 61 6e 2d 63 61 63 68 65 " -clean-cache
6490: 22 0a 09 09 09 09 20 20 20 29 29 29 29 0a 09 20 "..... ))))..
64a0: 20 20 20 20 20 20 28 72 65 6d 6f 76 65 2d 74 65 (remove-te
64b0: 73 74 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 st (lambda (x)..
64c0: 09 09 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 .. (iup:att
64d0: 72 69 62 75 74 65 2d 73 65 74 21 0a 09 09 09 20 ribute-set!....
64e0: 20 20 20 20 20 20 63 6f 6d 6d 61 6e 64 2d 74 65 command-te
64f0: 78 74 2d 62 6f 78 20 22 56 41 4c 55 45 22 0a 09 xt-box "VALUE"..
6500: 09 09 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 .. (conc "
6510: 6d 65 67 61 74 65 73 74 20 2d 72 65 6d 6f 76 65 megatest -remove
6520: 2d 72 75 6e 73 20 2d 74 61 72 67 65 74 20 22 20 -runs -target "
6530: 6b 65 79 73 74 72 69 6e 67 20 22 20 2d 72 75 6e keystring " -run
6540: 6e 61 6d 65 20 22 20 72 75 6e 6e 61 6d 65 0a 09 name " runname..
6550: 09 09 09 20 20 20 20 20 22 20 2d 74 65 73 74 70 ... " -testp
6560: 61 74 74 20 22 20 28 63 6f 6e 63 20 74 65 73 74 att " (conc test
6570: 6e 61 6d 65 20 22 2f 22 20 28 69 66 20 28 65 71 name "/" (if (eq
6580: 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 ual? item-path "
6590: 22 29 0a 09 09 09 09 09 09 09 09 09 20 20 22 25 ").......... "%
65a0: 22 0a 09 09 09 09 09 09 09 09 09 20 20 69 74 65 ".......... ite
65b0: 6d 2d 70 61 74 68 29 29 0a 09 09 09 09 20 20 20 m-path)).....
65c0: 20 20 22 20 2d 76 22 29 29 29 29 0a 09 20 20 20 " -v"))))..
65d0: 20 20 20 20 28 63 6c 65 61 6e 2d 72 75 6e 2d 65 (clean-run-e
65e0: 78 65 63 75 74 65 20 20 28 6c 61 6d 62 64 61 20 xecute (lambda
65f0: 28 78 29 0a 09 09 09 09 20 20 20 20 20 28 6c 65 (x)..... (le
6600: 74 20 28 28 63 6d 64 20 28 63 6f 6e 63 20 22 6d t ((cmd (conc "m
6610: 65 67 61 74 65 73 74 20 2d 72 65 6d 6f 76 65 2d egatest -remove-
6620: 72 75 6e 73 20 2d 74 61 72 67 65 74 20 22 20 6b runs -target " k
6630: 65 79 73 74 72 69 6e 67 20 22 20 2d 72 75 6e 6e eystring " -runn
6640: 61 6d 65 20 22 20 72 75 6e 6e 61 6d 65 0a 09 09 ame " runname...
6650: 09 09 09 09 20 20 20 20 20 20 22 20 2d 74 65 73 .... " -tes
6660: 74 70 61 74 74 20 22 20 28 63 6f 6e 63 20 74 65 tpatt " (conc te
6670: 73 74 6e 61 6d 65 20 22 2f 22 20 28 69 66 20 28 stname "/" (if (
6680: 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 equal? item-path
6690: 20 22 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 "").......
66a0: 20 20 09 09 09 09 09 20 20 20 22 25 22 0a 09 09 ..... "%"...
66b0: 09 09 09 09 20 20 20 20 20 20 20 09 09 09 09 09 .... .....
66c0: 20 20 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 item-path))..
66d0: 09 09 09 09 09 20 20 20 20 20 20 22 3b 6d 65 67 ..... ";meg
66e0: 61 74 65 73 74 20 2d 74 61 72 67 65 74 20 22 20 atest -target "
66f0: 6b 65 79 73 74 72 69 6e 67 20 22 20 2d 72 75 6e keystring " -run
6700: 6e 61 6d 65 20 22 20 72 75 6e 6e 61 6d 65 20 0a name " runname .
6710: 09 09 09 09 09 09 20 20 20 20 20 20 22 20 2d 72 ...... " -r
6720: 75 6e 20 2d 70 72 65 63 6c 65 61 6e 20 2d 74 65 un -preclean -te
6730: 73 74 70 61 74 74 20 22 20 28 63 6f 6e 63 20 74 stpatt " (conc t
6740: 65 73 74 6e 61 6d 65 20 22 2f 22 20 28 69 66 20 estname "/" (if
6750: 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 (equal? item-pat
6760: 68 20 22 22 29 0a 09 09 09 09 09 09 09 09 09 09 h "")...........
6770: 09 20 20 20 22 25 22 20 0a 09 09 09 09 09 09 09 . "%" ........
6780: 09 09 09 09 20 20 20 69 74 65 6d 2d 70 61 74 68 .... item-path
6790: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 22 ))....... "
67a0: 20 2d 63 6c 65 61 6e 2d 63 61 63 68 65 22 0a 09 -clean-cache"..
67b0: 09 09 09 09 09 20 20 20 20 20 20 29 29 29 0a 20 ..... ))).
67c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
67d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
67e0: 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 (thread-st
67f0: 61 72 74 21 20 28 6d 61 6b 65 2d 74 68 72 65 61 art! (make-threa
6800: 64 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 d (lambda ().
6810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6850: 20 20 28 63 6f 6d 6d 6f 6e 3a 72 75 6e 2d 61 2d (common:run-a-
6860: 63 6f 6d 6d 61 6e 64 20 63 6d 64 29 29 0a 20 20 command cmd)).
6870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
68a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
68b0: 20 22 63 6c 65 61 6e 2d 72 75 6e 2d 65 78 65 63 "clean-run-exec
68c0: 75 74 65 22 29 29 29 29 29 0a 09 20 20 20 20 20 ute")))))..
68d0: 20 20 28 72 65 6d 6f 76 65 2d 74 65 73 74 20 28 (remove-test (
68e0: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 20 lambda (x)....
68f0: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
6900: 74 65 2d 73 65 74 21 0a 09 09 09 20 20 20 20 20 te-set!....
6910: 20 20 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 command-text-b
6920: 6f 78 20 22 56 41 4c 55 45 22 0a 09 09 09 20 20 ox "VALUE"....
6930: 20 20 20 20 20 28 63 6f 6e 63 20 22 6d 65 67 61 (conc "mega
6940: 74 65 73 74 20 2d 72 65 6d 6f 76 65 2d 72 75 6e test -remove-run
6950: 73 20 2d 74 61 72 67 65 74 20 22 20 6b 65 79 73 s -target " keys
6960: 74 72 69 6e 67 20 22 20 2d 72 75 6e 6e 61 6d 65 tring " -runname
6970: 20 22 20 72 75 6e 6e 61 6d 65 0a 09 09 09 09 20 " runname.....
6980: 20 20 20 20 22 20 2d 74 65 73 74 70 61 74 74 20 " -testpatt
6990: 22 20 28 63 6f 6e 63 20 74 65 73 74 6e 61 6d 65 " (conc testname
69a0: 20 22 2f 22 20 28 69 66 20 28 65 71 75 61 6c 3f "/" (if (equal?
69b0: 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 0a 09 item-path "")..
69c0: 09 09 09 09 09 09 09 09 20 20 22 25 22 0a 09 09 ........ "%"...
69d0: 09 09 09 09 09 09 09 20 20 69 74 65 6d 2d 70 61 ....... item-pa
69e0: 74 68 29 29 0a 09 09 09 09 20 20 20 20 20 22 20 th))..... "
69f0: 2d 76 22 29 29 29 29 0a 09 20 20 20 20 20 20 20 -v"))))..
6a00: 28 61 72 63 68 69 76 65 2d 74 65 73 74 20 20 28 (archive-test (
6a10: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 28 lambda (x).....(
6a20: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
6a30: 74 21 20 0a 09 09 09 09 20 63 6f 6d 6d 61 6e 64 t! ..... command
6a40: 2d 74 65 78 74 2d 62 6f 78 20 22 56 41 4c 55 45 -text-box "VALUE
6a50: 22 0a 09 09 09 09 20 28 63 6f 6e 63 20 22 6d 65 "..... (conc "me
6a60: 67 61 74 65 73 74 20 2d 74 61 72 67 65 74 20 22 gatest -target "
6a70: 20 6b 65 79 73 74 72 69 6e 67 20 22 20 2d 72 75 keystring " -ru
6a80: 6e 6e 61 6d 65 20 22 20 72 75 6e 6e 61 6d 65 20 nname " runname
6a90: 0a 09 09 09 09 20 20 20 20 20 20 20 22 20 2d 61 ..... " -a
6aa0: 72 63 68 69 76 65 20 73 61 76 65 2d 72 65 6d 6f rchive save-remo
6ab0: 76 65 20 2d 74 65 73 74 70 61 74 74 20 22 20 28 ve -testpatt " (
6ac0: 63 6f 6e 63 20 74 65 73 74 6e 61 6d 65 20 22 2f conc testname "/
6ad0: 22 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 74 " (if (equal? it
6ae0: 65 6d 2d 70 61 74 68 20 22 22 29 0a 09 09 09 09 em-path "").....
6af0: 09 09 09 09 09 09 09 09 20 22 25 22 20 0a 09 09 ........ "%" ...
6b00: 09 09 09 09 09 09 09 09 09 09 20 69 74 65 6d 2d .......... item-
6b10: 70 61 74 68 29 29 0a 09 09 09 09 20 20 20 20 20 path)).....
6b20: 20 20 29 29 29 29 29 0a 09 20 20 28 63 6f 6e 64 ))))).. (cond
6b30: 0a 09 20 20 20 28 28 6e 6f 74 20 74 65 73 74 64 .. ((not testd
6b40: 61 74 29 28 62 65 67 69 6e 20 28 70 72 69 6e 74 at)(begin (print
6b50: 20 22 45 52 52 4f 52 3a 20 62 61 64 20 74 65 73 "ERROR: bad tes
6b60: 74 20 69 6e 66 6f 20 66 6f 72 20 22 20 74 65 73 t info for " tes
6b70: 74 2d 69 64 29 28 65 78 69 74 20 31 29 29 29 0a t-id)(exit 1))).
6b80: 09 20 20 20 28 28 6e 6f 74 20 72 75 6e 64 61 74 . ((not rundat
6b90: 29 28 62 65 67 69 6e 20 28 70 72 69 6e 74 20 22 )(begin (print "
6ba0: 45 52 52 4f 52 3a 20 66 6f 75 6e 64 20 74 65 73 ERROR: found tes
6bb0: 74 20 69 6e 66 6f 20 62 75 74 20 74 68 65 72 65 t info but there
6bc0: 20 69 73 20 61 20 70 72 6f 62 6c 65 6d 20 77 69 is a problem wi
6bd0: 74 68 20 74 68 65 20 72 75 6e 20 69 6e 66 6f 20 th the run info
6be0: 66 6f 72 20 22 20 72 75 6e 2d 69 64 29 28 65 78 for " run-id)(ex
6bf0: 69 74 20 31 29 29 29 0a 09 20 20 20 28 65 6c 73 it 1))).. (els
6c00: 65 0a 09 20 20 20 20 3b 3b 20 20 28 74 65 73 74 e.. ;; (test
6c10: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 -set-status! db
6c20: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
6c30: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 69 74 state status it
6c40: 65 6d 64 61 74 29 0a 09 20 20 20 20 28 73 65 74 emdat).. (set
6c50: 21 20 73 65 6c 66 20 3b 20 0a 09 09 20 20 28 69 ! self ; ... (i
6c60: 75 70 3a 64 69 61 6c 6f 67 20 23 3a 63 6c 6f 73 up:dialog #:clos
6c70: 65 5f 63 62 20 28 6c 61 6d 62 64 61 20 28 61 29 e_cb (lambda (a)
6c80: 28 65 78 69 74 29 29 20 3b 20 23 3a 65 78 70 61 (exit)) ; #:expa
6c90: 6e 64 20 22 59 45 53 22 0a 09 09 09 20 20 20 20 nd "YES"....
6ca0: 20 20 23 3a 74 69 74 6c 65 20 74 65 73 74 66 75 #:title testfu
6cb0: 6c 6c 6e 61 6d 65 0a 09 09 09 20 20 20 20 20 20 llname....
6cc0: 28 69 75 70 3a 76 62 6f 78 20 3b 20 23 3a 65 78 (iup:vbox ; #:ex
6cd0: 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 20 20 pand "YES"....
6ce0: 20 20 20 20 20 3b 3b 20 54 68 65 20 72 75 6e 20 ;; The run
6cf0: 61 6e 64 20 74 65 73 74 20 69 6e 66 6f 0a 09 09 and test info...
6d00: 09 20 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f . (iup:hbo
6d10: 78 20 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 x ; #:expand "Y
6d20: 45 53 22 0a 09 09 09 09 28 72 75 6e 2d 69 6e 66 ES".....(run-inf
6d30: 6f 2d 70 61 6e 65 6c 20 64 62 73 74 72 75 63 74 o-panel dbstruct
6d40: 20 6b 65 79 64 61 74 20 74 65 73 74 64 61 74 20 keydat testdat
6d50: 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 28 74 65 runname).....(te
6d60: 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 6c 20 74 65 st-info-panel te
6d70: 73 74 64 61 74 20 73 74 6f 72 65 2d 6c 61 62 65 stdat store-labe
6d80: 6c 20 77 69 64 67 65 74 73 29 0a 09 09 09 09 28 l widgets).....(
6d90: 74 65 73 74 2d 6d 65 74 61 2d 70 61 6e 65 6c 20 test-meta-panel
6da0: 74 65 73 74 6d 65 74 61 20 73 74 6f 72 65 2d 6d testmeta store-m
6db0: 65 74 61 29 29 0a 09 09 09 20 20 20 20 20 20 20 eta))....
6dc0: 28 69 75 70 3a 68 62 6f 78 0a 09 09 09 09 28 68 (iup:hbox.....(h
6dd0: 6f 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 6c 20 74 ost-info-panel t
6de0: 65 73 74 64 61 74 20 73 74 6f 72 65 2d 6c 61 62 estdat store-lab
6df0: 65 6c 29 0a 09 09 09 09 28 73 75 62 6d 65 67 61 el).....(submega
6e00: 74 65 73 74 2d 70 61 6e 65 6c 20 64 62 73 74 72 test-panel dbstr
6e10: 75 63 74 20 6b 65 79 64 61 74 20 74 65 73 74 64 uct keydat testd
6e20: 61 74 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 63 at runname testc
6e30: 6f 6e 66 69 67 29 29 0a 09 09 09 20 20 20 20 20 onfig))....
6e40: 20 20 3b 3b 20 54 68 65 20 63 6f 6e 74 72 6f 6c ;; The control
6e50: 73 0a 09 09 09 20 20 20 20 20 20 20 28 69 75 70 s.... (iup
6e60: 3a 66 72 61 6d 65 20 23 3a 74 69 74 6c 65 20 22 :frame #:title "
6e70: 41 63 74 69 6f 6e 73 22 20 0a 09 09 09 09 09 20 Actions" ......
6e80: 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 09 09 09 (iup:vbox......
6e90: 20 20 20 28 69 75 70 3a 68 62 6f 78 20 0a 09 09 (iup:hbox ...
6ea0: 09 09 09 20 20 20 20 28 69 75 70 3a 62 75 74 74 ... (iup:butt
6eb0: 6f 6e 20 22 56 69 65 77 20 4c 6f 67 22 20 20 20 on "View Log"
6ec0: 20 20 20 23 3a 61 63 74 69 6f 6e 20 76 69 65 77 #:action view
6ed0: 6c 6f 67 20 20 20 20 20 20 23 3a 73 69 7a 65 20 log #:size
6ee0: 22 38 30 78 22 29 0a 09 09 09 09 09 20 20 20 20 "80x")......
6ef0: 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 53 74 61 (iup:button "Sta
6f00: 72 74 20 58 74 65 72 6d 22 20 20 20 23 3a 61 63 rt Xterm" #:ac
6f10: 74 69 6f 6e 20 78 74 65 72 6d 20 20 20 20 20 20 tion xterm
6f20: 20 20 23 3a 73 69 7a 65 20 22 38 30 78 22 29 0a #:size "80x").
6f30: 09 09 09 09 09 20 20 20 20 28 69 75 70 3a 62 75 ..... (iup:bu
6f40: 74 74 6f 6e 20 22 52 75 6e 20 54 65 73 74 22 20 tton "Run Test"
6f50: 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 72 75 #:action ru
6f60: 6e 2d 74 65 73 74 20 20 20 20 20 23 3a 73 69 7a n-test #:siz
6f70: 65 20 22 38 30 78 22 29 0a 09 09 09 09 09 20 20 e "80x")......
6f80: 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 43 (iup:button "C
6f90: 6c 65 61 6e 20 54 65 73 74 22 20 20 20 20 23 3a lean Test" #:
6fa0: 61 63 74 69 6f 6e 20 72 65 6d 6f 76 65 2d 74 65 action remove-te
6fb0: 73 74 20 20 23 3a 73 69 7a 65 20 22 38 30 78 22 st #:size "80x"
6fc0: 29 0a 09 09 09 09 09 20 20 20 20 28 69 75 70 3a )...... (iup:
6fd0: 62 75 74 74 6f 6e 20 22 43 6c 65 61 6e 52 75 6e button "CleanRun
6fe0: 45 78 65 63 75 74 65 21 22 20 20 20 20 23 3a 61 Execute!" #:a
6ff0: 63 74 69 6f 6e 20 63 6c 65 61 6e 2d 72 75 6e 2d ction clean-run-
7000: 65 78 65 63 75 74 65 20 23 3a 73 69 7a 65 20 22 execute #:size "
7010: 38 30 78 22 29 0a 09 09 09 09 09 20 20 20 20 28 80x")...... (
7020: 69 75 70 3a 62 75 74 74 6f 6e 20 22 4b 69 6c 6c iup:button "Kill
7030: 20 41 6c 6c 20 4a 6f 62 73 22 20 23 3a 61 63 74 All Jobs" #:act
7040: 69 6f 6e 20 6b 69 6c 6c 2d 6a 6f 62 73 20 20 20 ion kill-jobs
7050: 20 23 3a 73 69 7a 65 20 22 38 30 78 22 29 0a 09 #:size "80x")..
7060: 09 09 09 09 20 20 20 20 28 69 75 70 3a 62 75 74 .... (iup:but
7070: 74 6f 6e 20 22 41 72 63 68 69 76 65 20 54 65 73 ton "Archive Tes
7080: 74 22 20 20 23 3a 61 63 74 69 6f 6e 20 61 72 63 t" #:action arc
7090: 68 69 76 65 2d 74 65 73 74 20 23 3a 73 69 7a 65 hive-test #:size
70a0: 20 22 38 30 78 22 29 0a 09 09 09 09 09 20 20 20 "80x")......
70b0: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 43 6c (iup:button "Cl
70c0: 6f 73 65 22 20 20 20 20 20 20 20 20 20 23 3a 61 ose" #:a
70d0: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 78 ction (lambda (x
70e0: 29 28 65 78 69 74 29 29 20 23 3a 73 69 7a 65 20 )(exit)) #:size
70f0: 22 38 30 78 22 29 29 0a 09 09 09 09 09 20 20 20 "80x"))......
7100: 28 61 70 70 6c 79 20 0a 09 09 09 09 09 20 20 20 (apply ......
7110: 20 69 75 70 3a 68 62 6f 78 0a 09 09 09 09 09 20 iup:hbox......
7120: 20 20 20 28 6c 69 73 74 20 63 6f 6d 6d 61 6e 64 (list command
7130: 2d 74 65 78 74 2d 62 6f 78 20 63 6f 6d 6d 61 6e -text-box comman
7140: 64 2d 6c 61 75 6e 63 68 2d 62 75 74 74 6f 6e 29 d-launch-button)
7150: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 ))).... (s
7160: 65 74 2d 66 69 65 6c 64 73 2d 70 61 6e 65 6c 20 et-fields-panel
7170: 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 dbstruct run-id
7180: 74 65 73 74 2d 69 64 20 74 65 73 74 64 61 74 29 test-id testdat)
7190: 0a 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 .... (let
71a0: 28 28 74 61 62 73 20 0a 09 09 09 09 20 20 20 20 ((tabs .....
71b0: 20 20 28 69 75 70 3a 74 61 62 73 0a 09 09 09 09 (iup:tabs.....
71c0: 20 20 20 20 20 20 20 3b 3b 20 52 65 70 6c 61 63 ;; Replac
71d0: 65 20 68 65 72 65 20 77 69 74 68 20 6d 61 74 72 e here with matr
71e0: 69 78 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c ix..... (l
71f0: 65 74 20 28 28 73 74 65 70 73 2d 6d 61 74 72 69 et ((steps-matri
7200: 78 20 28 69 75 70 3a 6d 61 74 72 69 78 0a 09 09 x (iup:matrix...
7210: 09 09 09 09 09 20 20 20 20 23 3a 66 6f 6e 74 20 ..... #:font
7220: 20 20 22 43 6f 75 72 69 65 72 20 4e 65 77 2c 20 "Courier New,
7230: 2d 38 22 0a 09 09 09 09 09 09 09 20 20 20 20 23 -8"........ #
7240: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 :expand "YES"...
7250: 09 09 09 09 09 20 20 20 20 23 3a 73 63 72 6f 6c ..... #:scrol
7260: 6c 62 61 72 20 22 59 45 53 22 0a 09 09 09 09 09 lbar "YES"......
7270: 09 09 20 20 20 20 23 3a 6e 75 6d 63 6f 6c 20 37 .. #:numcol 7
7280: 0a 09 09 09 09 09 09 09 20 20 20 20 23 3a 6e 75 ........ #:nu
7290: 6d 6c 69 6e 20 31 30 30 0a 09 09 09 09 09 09 09 mlin 100........
72a0: 20 20 20 20 23 3a 6e 75 6d 63 6f 6c 2d 76 69 73 #:numcol-vis
72b0: 69 62 6c 65 20 37 0a 09 09 09 09 09 09 09 20 20 ible 7........
72c0: 20 20 23 3a 6e 75 6d 6c 69 6e 2d 76 69 73 69 62 #:numlin-visib
72d0: 6c 65 20 35 0a 09 09 09 09 09 09 09 20 20 20 20 le 5........
72e0: 23 3a 63 6c 69 63 6b 2d 63 62 20 28 6c 61 6d 62 #:click-cb (lamb
72f0: 64 61 20 28 6f 62 6a 20 6c 69 6e 20 63 6f 6c 20 da (obj lin col
7300: 73 74 61 74 75 73 29 0a 09 09 09 09 09 09 09 09 status).........
7310: 09 20 3b 3b 20 28 69 66 20 28 65 71 75 61 6c 3f . ;; (if (equal?
7320: 20 63 6f 6c 20 36 29 0a 09 09 09 09 09 09 09 09 col 6).........
7330: 09 20 28 6c 65 74 2a 20 28 28 6d 74 72 78 2d 72 . (let* ((mtrx-r
7340: 63 20 28 63 6f 6e 63 20 6c 69 6e 20 22 3a 22 20 c (conc lin ":"
7350: 36 29 29 0a 09 09 09 09 09 09 09 09 09 09 28 66 6))...........(f
7360: 6e 61 6d 65 20 20 20 28 69 75 70 3a 61 74 74 72 name (iup:attr
7370: 69 62 75 74 65 20 6f 62 6a 20 6d 74 72 78 2d 72 ibute obj mtrx-r
7380: 63 29 29 29 20 3b 3b 20 63 6f 6c 29 29 29 29 0a c))) ;; col)))).
7390: 09 09 09 09 09 09 09 09 09 20 20 20 28 69 66 20 ......... (if
73a0: 28 65 71 3f 20 63 6f 6c 20 36 29 0a 09 09 09 09 (eq? col 6).....
73b0: 09 09 09 09 09 20 20 20 20 20 20 20 28 76 69 65 ..... (vie
73c0: 77 2d 61 2d 6c 6f 67 20 66 6e 61 6d 65 29 0a 09 w-a-log fname)..
73d0: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
73e0: 69 75 70 3a 73 68 6f 77 0a 09 09 09 09 09 09 09 iup:show........
73f0: 09 09 09 28 64 61 73 68 62 6f 61 72 64 2d 74 65 ...(dashboard-te
7400: 73 74 73 3a 73 74 65 70 2d 72 75 6e 2d 63 6f 6e sts:step-run-con
7410: 74 72 6f 6c 20 0a 09 09 09 09 09 09 09 09 09 09 trol ...........
7420: 20 74 65 73 74 64 61 74 0a 09 09 09 09 09 09 09 testdat........
7430: 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 ... (iup:attribu
7440: 74 65 20 6f 62 6a 20 28 63 6f 6e 63 20 6c 69 6e te obj (conc lin
7450: 20 22 3a 22 20 31 29 29 20 0a 09 09 09 09 09 09 ":" 1)) .......
7460: 09 09 09 09 20 74 65 73 74 73 74 65 70 73 29 29 .... teststeps))
7470: 29 29 29 29 29 29 0a 09 09 09 09 09 20 3b 3b 20 ))))))...... ;;
7480: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 63 6f 75 6e (let loop ((coun
7490: 74 20 30 29 29 0a 09 09 09 09 09 20 3b 3b 20 20 t 0))...... ;;
74a0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
74b0: 73 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 set! steps-matri
74c0: 78 20 22 46 49 54 54 4f 54 45 58 54 22 20 28 63 x "FITTOTEXT" (c
74d0: 6f 6e 63 20 22 4c 22 20 63 6f 75 6e 74 29 29 0a onc "L" count)).
74e0: 09 09 09 09 09 20 3b 3b 20 20 20 28 69 66 20 28 ..... ;; (if (
74f0: 3c 20 63 6f 75 6e 74 20 33 30 29 0a 09 09 09 09 < count 30).....
7500: 09 20 3b 3b 20 20 20 20 20 20 20 28 6c 6f 6f 70 . ;; (loop
7510: 20 28 2b 20 63 6f 75 6e 74 20 31 29 29 29 29 0a (+ count 1)))).
7520: 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 ..... (iup:attri
7530: 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d bute-set! steps-
7540: 6d 61 74 72 69 78 20 22 30 3a 31 22 20 22 53 74 matrix "0:1" "St
7550: 65 70 20 4e 61 6d 65 22 29 0a 09 09 09 09 09 20 ep Name")......
7560: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
7570: 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 et! steps-matrix
7580: 20 22 30 3a 32 22 20 22 53 74 61 72 74 22 29 0a "0:2" "Start").
7590: 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 ..... (iup:attri
75a0: 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d bute-set! steps-
75b0: 6d 61 74 72 69 78 20 22 30 3a 33 22 20 22 45 6e matrix "0:3" "En
75c0: 64 22 29 0a 09 09 09 09 09 20 28 69 75 70 3a 61 d")...... (iup:a
75d0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 ttribute-set! st
75e0: 65 70 73 2d 6d 61 74 72 69 78 20 22 57 49 44 54 eps-matrix "WIDT
75f0: 48 33 22 20 22 35 30 22 29 0a 09 09 09 09 09 20 H3" "50")......
7600: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
7610: 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 et! steps-matrix
7620: 20 22 30 3a 34 22 20 22 53 74 61 74 75 73 22 29 "0:4" "Status")
7630: 0a 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 ...... (iup:attr
7640: 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 ibute-set! steps
7650: 2d 6d 61 74 72 69 78 20 22 57 49 44 54 48 34 22 -matrix "WIDTH4"
7660: 20 22 35 30 22 29 0a 09 09 09 09 09 20 28 69 75 "50")...... (iu
7670: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
7680: 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 22 30 steps-matrix "0
7690: 3a 35 22 20 22 44 75 72 61 74 69 6f 6e 22 29 0a :5" "Duration").
76a0: 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 ..... (iup:attri
76b0: 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d bute-set! steps-
76c0: 6d 61 74 72 69 78 20 22 30 3a 36 22 20 22 4c 6f matrix "0:6" "Lo
76d0: 67 20 46 69 6c 65 22 29 0a 09 09 09 09 09 20 28 g File")...... (
76e0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
76f0: 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 t! steps-matrix
7700: 22 30 3a 37 22 20 22 43 6f 6d 6d 65 6e 74 22 29 "0:7" "Comment")
7710: 0a 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 ...... (iup:attr
7720: 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 ibute-set! steps
7730: 2d 6d 61 74 72 69 78 20 22 41 4c 49 47 4e 4d 45 -matrix "ALIGNME
7740: 4e 54 31 22 20 22 41 4c 45 46 54 22 29 0a 09 09 NT1" "ALEFT")...
7750: 09 09 09 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 ... ;; (iup:attr
7760: 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 ibute-set! steps
7770: 2d 6d 61 74 72 69 78 20 22 46 49 58 54 4f 54 45 -matrix "FIXTOTE
7780: 58 54 22 20 22 43 31 22 29 0a 09 09 09 09 09 20 XT" "C1")......
7790: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
77a0: 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 et! steps-matrix
77b0: 20 22 52 45 53 49 5a 45 4d 41 54 52 49 58 22 20 "RESIZEMATRIX"
77c0: 22 59 45 53 22 29 0a 09 09 09 09 09 20 28 6c 65 "YES")...... (le
77d0: 74 20 28 28 70 72 6f 63 0a 09 09 09 09 09 09 28 t ((proc.......(
77e0: 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 lambda (testdat)
77f0: 0a 09 09 09 09 09 09 20 20 28 64 63 6f 6d 6d 6f ....... (dcommo
7800: 6e 3a 70 6f 70 75 6c 61 74 65 2d 73 74 65 70 73 n:populate-steps
7810: 20 74 65 73 74 73 74 65 70 73 20 73 74 65 70 73 teststeps steps
7820: 2d 6d 61 74 72 69 78 29 29 29 29 0a 09 09 09 09 -matrix)))).....
7830: 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d . (hash-table-
7840: 73 65 74 21 20 77 69 64 67 65 74 73 20 22 53 74 set! widgets "St
7850: 65 70 73 4d 61 74 72 69 78 22 20 70 72 6f 63 29 epsMatrix" proc)
7860: 0a 09 09 09 09 09 20 20 20 28 70 72 6f 63 20 74 ...... (proc t
7870: 65 73 74 64 61 74 29 29 0a 09 09 09 09 09 20 73 estdat))...... s
7880: 74 65 70 73 2d 6d 61 74 72 69 78 29 0a 09 09 09 teps-matrix)....
7890: 09 20 20 20 20 20 20 20 3b 3b 20 70 6f 70 75 6c . ;; popul
78a0: 61 74 65 20 74 68 65 20 54 65 73 74 20 44 61 74 ate the Test Dat
78b0: 61 20 70 61 6e 65 6c 0a 09 09 09 09 20 20 20 20 a panel.....
78c0: 20 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 09 09 (iup:frame...
78d0: 09 09 09 23 3a 74 69 74 6c 65 20 22 54 65 73 74 ...#:title "Test
78e0: 20 44 61 74 61 22 0a 09 09 09 09 09 28 6c 65 74 Data"......(let
78f0: 20 28 28 74 65 73 74 2d 64 61 74 61 0a 09 09 09 ((test-data....
7900: 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 74 65 .. (iup:te
7910: 78 74 62 6f 78 20 20 3b 3b 20 23 3a 61 63 74 69 xtbox ;; #:acti
7920: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 on (lambda (obj
7930: 63 68 61 72 20 76 61 6c 29 0a 09 09 09 09 09 09 char val).......
7940: 3b 3b 20 20 20 09 23 66 29 0a 09 09 09 09 09 09 ;; .#f).......
7950: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 #:expand "YES"..
7960: 09 09 09 09 09 23 3a 6d 75 6c 74 69 6c 69 6e 65 .....#:multiline
7970: 20 22 59 45 53 22 0a 09 09 09 09 09 09 23 3a 66 "YES".......#:f
7980: 6f 6e 74 20 22 43 6f 75 72 69 65 72 20 4e 65 77 ont "Courier New
7990: 2c 20 2d 31 30 22 0a 09 09 09 09 09 09 23 3a 73 , -10".......#:s
79a0: 69 7a 65 20 22 31 30 30 78 31 30 30 22 29 29 29 ize "100x100")))
79b0: 0a 09 09 09 09 09 20 20 28 68 61 73 68 2d 74 61 ...... (hash-ta
79c0: 62 6c 65 2d 73 65 74 21 20 77 69 64 67 65 74 73 ble-set! widgets
79d0: 20 22 54 65 73 74 20 44 61 74 61 22 0a 09 09 09 "Test Data"....
79e0: 09 09 09 09 20 20 20 28 6c 61 6d 62 64 61 20 28 .... (lambda (
79f0: 74 65 73 74 64 61 74 29 20 3b 3b 20 0a 09 09 09 testdat) ;; ....
7a00: 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 .... (let* (
7a10: 28 63 75 72 72 76 61 6c 20 28 69 75 70 3a 61 74 (currval (iup:at
7a20: 74 72 69 62 75 74 65 20 74 65 73 74 2d 64 61 74 tribute test-dat
7a30: 61 20 22 56 41 4c 55 45 22 29 29 20 3b 3b 20 22 a "VALUE")) ;; "
7a40: 54 49 54 4c 45 22 29 29 0a 09 09 09 09 09 09 09 TITLE"))........
7a50: 09 20 20 20 20 28 66 6d 74 73 74 72 20 20 22 7e . (fmtstr "~
7a60: 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 7e 10a~10a~10a~10a~
7a70: 37 61 7e 37 61 7e 36 61 7e 37 61 7e 61 22 29 20 7a~7a~6a~7a~a")
7a80: 3b 3b 20 63 61 74 65 67 6f 72 79 2c 76 61 72 69 ;; category,vari
7a90: 61 62 6c 65 2c 76 61 6c 75 65 2c 65 78 70 65 63 able,value,expec
7aa0: 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 73 2c 74 79 ted,tol,units,ty
7ab0: 70 65 2c 63 6f 6d 6d 65 6e 74 0a 09 09 09 09 09 pe,comment......
7ac0: 09 09 09 20 20 20 20 28 6e 65 77 76 61 6c 20 20 ... (newval
7ad0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
7ae0: 72 73 65 20 0a 09 09 09 09 09 09 09 09 09 20 20 rse ..........
7af0: 20 20 20 20 28 61 70 70 65 6e 64 0a 09 09 09 09 (append.....
7b00: 09 09 09 09 09 20 20 20 20 20 20 20 28 6c 69 73 ..... (lis
7b10: 74 20 0a 09 09 09 09 09 09 09 09 09 09 28 66 6f t ...........(fo
7b20: 72 6d 61 74 20 23 66 20 66 6d 74 73 74 72 20 22 rmat #f fmtstr "
7b30: 43 61 74 65 67 6f 72 79 22 20 22 56 61 72 69 61 Category" "Varia
7b40: 62 6c 65 22 20 22 56 61 6c 75 65 22 20 22 45 78 ble" "Value" "Ex
7b50: 70 65 63 74 65 64 22 20 22 54 6f 6c 22 20 22 53 pected" "Tol" "S
7b60: 74 61 74 75 73 22 20 22 55 6e 69 74 73 22 20 22 tatus" "Units" "
7b70: 54 79 70 65 22 20 22 43 6f 6d 6d 65 6e 74 22 29 Type" "Comment")
7b80: 0a 09 09 09 09 09 09 09 09 09 09 28 66 6f 72 6d ...........(form
7b90: 61 74 20 23 66 20 66 6d 74 73 74 72 20 22 3d 3d at #f fmtstr "==
7ba0: 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d ======" "=======
7bb0: 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d =" "=====" "====
7bc0: 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 20 22 3d 3d 3d ====" "===" "===
7bd0: 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d ===" "=====" "==
7be0: 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 22 29 29 0a ==" "=======")).
7bf0: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
7c00: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 (map (lambda (x)
7c10: 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 ...........
7c20: 20 28 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 (format #f fmts
7c30: 74 72 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 tr............
7c40: 20 20 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 (db:test-dat
7c50: 61 2d 67 65 74 2d 63 61 74 65 67 6f 72 79 20 78 a-get-category x
7c60: 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 )............
7c70: 20 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 (db:test-data
7c80: 2d 67 65 74 2d 76 61 72 69 61 62 6c 65 20 78 29 -get-variable x)
7c90: 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 ............
7ca0: 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d (db:test-data-
7cb0: 67 65 74 2d 76 61 6c 75 65 20 20 20 20 78 29 0a get-value x).
7cc0: 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 ...........
7cd0: 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 (db:test-data-g
7ce0: 65 74 2d 65 78 70 65 63 74 65 64 20 78 29 0a 09 et-expected x)..
7cf0: 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
7d00: 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 (db:test-data-ge
7d10: 74 2d 74 6f 6c 20 20 20 20 20 20 78 29 0a 09 09 t-tol x)...
7d20: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 ......... (
7d30: 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 db:test-data-get
7d40: 2d 73 74 61 74 75 73 20 20 20 78 29 0a 09 09 09 -status x)....
7d50: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 64 ........ (d
7d60: 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d b:test-data-get-
7d70: 75 6e 69 74 73 20 20 20 20 78 29 0a 09 09 09 09 units x).....
7d80: 09 09 09 09 09 09 09 20 20 20 20 20 20 28 64 62 ....... (db
7d90: 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 74 :test-data-get-t
7da0: 79 70 65 20 20 20 20 20 78 29 0a 09 09 09 09 09 ype x)......
7db0: 09 09 09 09 09 09 20 20 20 20 20 20 28 64 62 3a ...... (db:
7dc0: 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 63 6f test-data-get-co
7dd0: 6d 6d 65 6e 74 20 20 78 29 29 29 0a 09 09 09 09 mment x))).....
7de0: 09 09 09 09 09 09 20 20 20 20 28 72 6d 74 3a 72 ...... (rmt:r
7df0: 65 61 64 2d 74 65 73 74 2d 64 61 74 61 20 72 75 ead-test-data ru
7e00: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 22 25 22 n-id test-id "%"
7e10: 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 )))..........
7e20: 20 20 20 22 5c 6e 22 29 29 29 0a 09 09 09 09 09 "\n")))......
7e30: 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f .. (if (no
7e40: 74 20 28 65 71 75 61 6c 3f 20 63 75 72 72 76 61 t (equal? currva
7e50: 6c 20 6e 65 77 76 61 6c 29 29 0a 09 09 09 09 09 l newval))......
7e60: 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 72 69 ... (iup:attri
7e70: 62 75 74 65 2d 73 65 74 21 20 74 65 73 74 2d 64 bute-set! test-d
7e80: 61 74 61 20 22 56 41 4c 55 45 22 20 6e 65 77 76 ata "VALUE" newv
7e90: 61 6c 20 29 29 29 29 29 20 3b 3b 20 22 54 49 54 al ))))) ;; "TIT
7ea0: 4c 45 22 20 6e 65 77 76 61 6c 29 29 29 29 29 0a LE" newval))))).
7eb0: 09 09 09 09 09 20 20 74 65 73 74 2d 64 61 74 61 ..... test-data
7ec0: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b ))..... ;;
7ed0: 28 64 61 73 68 62 6f 61 72 64 3a 72 75 6e 2d 63 (dashboard:run-c
7ee0: 6f 6e 74 72 6f 6c 73 29 0a 09 09 09 09 20 20 20 ontrols).....
7ef0: 20 20 20 20 29 29 29 0a 09 09 09 09 20 28 69 75 )))..... (iu
7f00: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
7f10: 20 74 61 62 73 20 22 54 41 42 54 49 54 4c 45 30 tabs "TABTITLE0
7f20: 22 20 22 53 74 65 70 73 22 29 0a 09 09 09 09 20 " "Steps").....
7f30: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
7f40: 65 74 21 20 74 61 62 73 20 22 54 41 42 54 49 54 et! tabs "TABTIT
7f50: 4c 45 31 22 20 22 54 65 73 74 20 44 61 74 61 22 LE1" "Test Data"
7f60: 29 0a 09 09 09 09 20 74 61 62 73 29 29 29 29 0a )..... tabs)))).
7f70: 09 20 20 20 20 28 69 75 70 3a 73 68 6f 77 20 73 . (iup:show s
7f80: 65 6c 66 29 0a 09 20 20 20 20 28 69 75 70 3a 63 elf).. (iup:c
7f90: 61 6c 6c 62 61 63 6b 2d 73 65 74 21 20 2a 74 69 allback-set! *ti
7fa0: 6d 2a 20 22 41 43 54 49 4f 4e 5f 43 42 22 0a 09 m* "ACTION_CB"..
7fb0: 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda
7fc0: 20 28 78 29 0a 09 09 09 09 20 3b 3b 20 4e 6f 77 (x)..... ;; Now
7fd0: 20 73 74 61 72 74 20 6b 65 65 70 69 6e 67 20 74 start keeping t
7fe0: 68 65 20 67 75 69 20 75 70 64 61 74 65 64 20 66 he gui updated f
7ff0: 72 6f 6d 20 74 68 65 20 64 62 0a 09 09 09 09 20 rom the db.....
8000: 28 72 65 66 72 65 73 68 64 61 74 29 20 3b 3b 20 (refreshdat) ;;
8010: 75 70 64 61 74 65 20 66 72 6f 6d 20 74 68 65 20 update from the
8020: 64 62 20 68 65 72 65 0a 09 09 09 09 09 3b 28 74 db here......;(t
8030: 68 72 65 61 64 2d 73 75 73 70 65 6e 64 21 20 6f hread-suspend! o
8040: 74 68 65 72 2d 74 68 72 65 61 64 29 0a 09 09 09 ther-thread)....
8050: 09 20 28 69 66 20 2a 65 78 69 74 2d 73 74 61 72 . (if *exit-star
8060: 74 65 64 2a 0a 09 09 09 09 20 20 20 20 20 28 73 ted*..... (s
8070: 65 74 21 20 2a 65 78 69 74 2d 73 74 61 72 74 65 et! *exit-starte
8080: 64 2a 20 27 6f 6b 29 29 29 29 29 29 29 29 29 29 d* 'ok))))))))))
8090: 0a 0a ..