Artifact
bce95a595dde877e66ea0a1a2e0fe30bbd0ac2de:
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d ==========..;;==
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 20 69 6e 66 ====.;; Test inf
0230: 6f 20 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d o panel.;;======
0240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0280: 0a 0a 28 75 73 65 20 66 6f 72 6d 61 74 20 66 6d ..(use format fm
0290: 74 29 0a 28 72 65 71 75 69 72 65 2d 6c 69 62 72 t).(require-libr
02a0: 61 72 79 20 69 75 70 29 0a 28 69 6d 70 6f 72 74 ary iup).(import
02b0: 20 28 70 72 65 66 69 78 20 69 75 70 20 69 75 70 (prefix iup iup
02c0: 3a 29 29 0a 0a 28 75 73 65 20 63 61 6e 76 61 73 :))..(use canvas
02d0: 2d 64 72 61 77 29 0a 0a 28 75 73 65 20 73 71 6c -draw)..(use sql
02e0: 69 74 65 33 20 73 72 66 69 2d 31 20 70 6f 73 69 ite3 srfi-1 posi
02f0: 78 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 61 x regex regex-ca
0300: 73 65 20 73 72 66 69 2d 36 39 29 0a 28 69 6d 70 se srfi-69).(imp
0310: 6f 72 74 20 28 70 72 65 66 69 78 20 73 71 6c 69 ort (prefix sqli
0320: 74 65 33 20 73 71 6c 69 74 65 33 3a 29 29 0a 0a te3 sqlite3:))..
0330: 28 64 65 63 6c 61 72 65 20 28 75 6e 69 74 20 64 (declare (unit d
0340: 61 73 68 62 6f 61 72 64 2d 74 65 73 74 73 29 29 ashboard-tests))
0350: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0360: 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 common)).(declar
0370: 65 20 28 75 73 65 73 20 64 62 29 29 0a 28 64 65 e (uses db)).(de
0380: 63 6c 61 72 65 20 28 75 73 65 73 20 67 75 74 69 clare (uses guti
0390: 6c 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 ls)).(declare (u
03a0: 73 65 73 20 72 6d 74 29 29 0a 28 64 65 63 6c 61 ses rmt)).(decla
03b0: 72 65 20 28 75 73 65 73 20 65 7a 73 74 65 70 73 re (uses ezsteps
03c0: 29 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 )).;; (declare (
03d0: 75 73 65 73 20 73 64 62 29 29 0a 3b 3b 20 28 64 uses sdb)).;; (d
03e0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 66 69 6c eclare (uses fil
03f0: 65 64 62 29 29 0a 0a 28 69 6e 63 6c 75 64 65 20 edb))..(include
0400: 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e "common_records.
0410: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
0420: 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 db_records.scm")
0430: 0a 28 69 6e 63 6c 75 64 65 20 22 72 75 6e 5f 72 .(include "run_r
0440: 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a 3b 3b ecords.scm")..;;
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 3d 3d 3d 3d 3d ================
0490: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 20 4f 20 4d 20 ======.;; C O M
04a0: 4d 20 4f 20 4e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d M O N.;;========
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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
04f0: 28 64 65 66 69 6e 65 20 2a 64 61 73 68 62 6f 61 (define *dashboa
0500: 72 64 2d 63 6f 6d 6d 65 6e 74 2d 73 68 61 72 65 rd-comment-share
0510: 2d 73 6c 6f 74 2a 20 23 66 29 0a 0a 28 64 65 66 -slot* #f)..(def
0520: 69 6e 65 20 28 64 74 65 73 74 73 3a 67 65 74 2d ine (dtests:get-
0530: 70 72 65 2d 63 6f 6d 6d 61 6e 64 20 23 21 6b 65 pre-command #!ke
0540: 79 20 28 64 65 66 61 75 6c 74 2d 6f 76 65 72 72 y (default-overr
0550: 69 64 65 20 23 66 29 29 0a 20 20 28 6c 65 74 20 ide #f)). (let
0560: 28 28 63 66 67 2d 6f 76 72 64 20 28 63 6f 6e 66 ((cfg-ovrd (conf
0570: 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 igf:lookup *conf
0580: 69 67 64 61 74 2a 20 22 64 61 73 68 62 6f 61 72 igdat* "dashboar
0590: 64 22 20 22 70 72 65 2d 63 6f 6d 6d 61 6e 64 22 d" "pre-command"
05a0: 29 29 29 0a 20 20 20 20 28 6f 72 20 63 66 67 2d ))). (or cfg-
05b0: 6f 76 72 64 20 64 65 66 61 75 6c 74 2d 6f 76 65 ovrd default-ove
05c0: 72 72 69 64 65 20 22 78 74 65 72 6d 20 2d 67 65 rride "xterm -ge
05d0: 6f 6d 65 74 72 79 20 31 38 30 78 32 30 20 2d 65 ometry 180x20 -e
05e0: 20 5c 22 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 \"")))..(define
05f0: 20 28 64 74 65 73 74 73 3a 67 65 74 2d 70 6f 73 (dtests:get-pos
0600: 74 2d 63 6f 6d 6d 61 6e 64 20 23 21 6b 65 79 20 t-command #!key
0610: 28 64 65 66 61 75 6c 74 2d 6f 76 65 72 72 69 64 (default-overrid
0620: 65 20 23 66 29 29 0a 20 20 28 6c 65 74 20 28 28 e #f)). (let ((
0630: 63 66 67 2d 6f 76 72 64 20 28 63 6f 6e 66 69 67 cfg-ovrd (config
0640: 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
0650: 64 61 74 2a 20 22 64 61 73 68 62 6f 61 72 64 22 dat* "dashboard"
0660: 20 22 70 6f 73 74 2d 63 6f 6d 6d 61 6e 64 22 29 "post-command")
0670: 29 29 0a 20 20 20 20 28 6f 72 20 63 66 67 2d 6f )). (or cfg-o
0680: 76 72 64 20 64 65 66 61 75 6c 74 2d 6f 76 65 72 vrd default-over
0690: 72 69 64 65 20 22 3b 65 63 68 6f 20 50 72 65 73 ride ";echo Pres
06a0: 73 20 61 6e 79 20 6b 65 79 20 74 6f 20 63 6f 6e s any key to con
06b0: 74 69 6e 75 65 3b 62 61 73 68 20 2d 63 20 27 72 tinue;bash -c 'r
06c0: 65 61 64 20 2d 6e 20 31 20 2d 73 27 5c 22 20 26 ead -n 1 -s'\" &
06d0: 22 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 ")))...(define (
06e0: 74 65 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 6c 20 test-info-panel
06f0: 74 65 73 74 64 61 74 20 73 74 6f 72 65 2d 6c 61 testdat store-la
0700: 62 65 6c 20 77 69 64 67 65 74 73 29 0a 20 20 28 bel widgets). (
0710: 69 75 70 3a 66 72 61 6d 65 20 0a 20 20 20 23 3a iup:frame . #:
0720: 74 69 74 6c 65 20 22 54 65 73 74 20 49 6e 66 6f title "Test Info
0730: 22 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 " ; #:expand "YE
0740: 53 22 0a 20 20 20 28 69 75 70 3a 68 62 6f 78 20 S". (iup:hbox
0750: 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 ; #:expand "YES"
0760: 0a 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a . (apply iup:
0770: 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 vbox ; #:expand
0780: 22 59 45 53 22 0a 09 20 20 20 28 61 70 70 65 6e "YES".. (appen
0790: 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 d (map (lambda (
07a0: 76 61 6c 29 0a 09 09 09 20 20 28 69 75 70 3a 6c val).... (iup:l
07b0: 61 62 65 6c 20 76 61 6c 20 3b 20 23 3a 65 78 70 abel val ; #:exp
07c0: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
07d0: 0a 09 09 09 09 20 20 20 20 20 29 29 0a 09 09 09 ..... ))....
07e0: 28 6c 69 73 74 20 22 54 65 73 74 6e 61 6d 65 3a (list "Testname:
07f0: 20 22 0a 09 09 09 20 20 20 20 20 20 22 49 74 65 ".... "Ite
0800: 6d 20 70 61 74 68 3a 20 22 0a 09 09 09 20 20 20 m path: "....
0810: 20 20 20 22 43 75 72 72 65 6e 74 20 73 74 61 74 "Current stat
0820: 65 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 43 e: ".... "C
0830: 75 72 72 65 6e 74 20 73 74 61 74 75 73 3a 20 22 urrent status: "
0840: 0a 09 09 09 20 20 20 20 20 20 22 54 65 73 74 20 .... "Test
0850: 63 6f 6d 6d 65 6e 74 3a 20 22 0a 09 09 09 20 20 comment: "....
0860: 20 20 20 20 22 54 65 73 74 20 69 64 3a 20 22 0a "Test id: ".
0870: 09 09 09 20 20 20 20 20 20 22 54 65 73 74 20 64 ... "Test d
0880: 61 74 65 3a 20 22 29 29 0a 09 09 20 20 20 28 6c ate: "))... (l
0890: 69 73 74 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 ist (iup:label "
08a0: 22 20 23 3a 65 78 70 61 6e 64 20 22 56 45 52 54 " #:expand "VERT
08b0: 49 43 41 4c 22 29 29 29 29 0a 20 20 20 20 28 61 ICAL")))). (a
08c0: 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 20 3b pply iup:vbox ;
08d0: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
08e0: 09 20 20 20 28 6c 69 73 74 20 0a 09 20 20 20 20 . (list ..
08f0: 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 74 65 (store-label "te
0900: 73 74 6e 61 6d 65 22 0a 09 09 09 20 28 69 75 70 stname".... (iup
0910: 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 74 2d :label (db:test-
0920: 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 74 65 get-testname te
0930: 73 74 64 61 74 29 20 23 3a 65 78 70 61 6e 64 20 stdat) #:expand
0940: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 "HORIZONTAL")...
0950: 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 . (lambda (testd
0960: 61 74 29 28 64 62 3a 74 65 73 74 2d 67 65 74 2d at)(db:test-get-
0970: 74 65 73 74 6e 61 6d 65 20 74 65 73 74 64 61 74 testname testdat
0980: 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d ))).. (store-
0990: 6c 61 62 65 6c 20 22 69 74 65 6d 2d 70 61 74 68 label "item-path
09a0: 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c ".... (iup:label
09b0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 (db:test-get-it
09c0: 65 6d 2d 70 61 74 68 20 74 65 73 74 64 61 74 29 em-path testdat)
09d0: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ
09e0: 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d ONTAL").... (lam
09f0: 62 64 61 20 28 74 65 73 74 64 61 74 29 28 64 62 bda (testdat)(db
0a00: 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 :test-get-item-p
0a10: 61 74 68 20 74 65 73 74 64 61 74 29 29 29 0a 09 ath testdat)))..
0a20: 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c (store-label
0a30: 20 22 74 65 73 74 73 74 61 74 65 22 20 0a 09 09 "teststate" ...
0a40: 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 62 . (iup:label (db
0a50: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
0a60: 74 65 73 74 64 61 74 29 20 23 3a 65 78 70 61 6e testdat) #:expan
0a70: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a d "HORIZONTAL").
0a80: 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 ... (lambda (tes
0a90: 74 64 61 74 29 0a 09 09 09 20 20 20 28 64 62 3a tdat).... (db:
0aa0: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
0ab0: 65 73 74 64 61 74 29 29 29 0a 09 20 20 20 20 28 estdat))).. (
0ac0: 6c 65 74 20 28 28 6c 62 6c 20 20 20 28 69 75 70 let ((lbl (iup
0ad0: 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 74 2d :label (db:test-
0ae0: 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 64 get-status testd
0af0: 61 74 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f at) #:expand "HO
0b00: 52 49 5a 4f 4e 54 41 4c 22 29 29 29 0a 09 20 20 RIZONTAL")))..
0b10: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
0b20: 73 65 74 21 20 77 69 64 67 65 74 73 20 22 74 65 set! widgets "te
0b30: 73 74 73 74 61 74 75 73 22 0a 09 09 09 20 20 20 ststatus"....
0b40: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 (lambda (tes
0b50: 74 64 61 74 29 0a 09 09 09 09 20 28 6c 65 74 20 tdat)..... (let
0b60: 28 28 6e 65 77 73 74 61 74 75 73 20 28 64 62 3a ((newstatus (db:
0b70: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 test-get-status
0b80: 74 65 73 74 64 61 74 29 29 0a 09 09 09 09 20 20 testdat)).....
0b90: 20 20 20 20 20 28 6f 6c 64 73 74 61 74 75 73 20 (oldstatus
0ba0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c (iup:attribute l
0bb0: 62 6c 20 22 54 49 54 4c 45 22 29 29 29 0a 09 09 bl "TITLE")))...
0bc0: 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 .. (if (not (e
0bd0: 71 75 61 6c 3f 20 6f 6c 64 73 74 61 74 75 73 20 qual? oldstatus
0be0: 6e 65 77 73 74 61 74 75 73 29 29 0a 09 09 09 09 newstatus)).....
0bf0: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 (begin...
0c00: 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 ... (iup:attribu
0c10: 74 65 2d 73 65 74 21 20 6c 62 6c 20 22 46 47 43 te-set! lbl "FGC
0c20: 4f 4c 4f 52 22 20 28 63 61 72 20 28 67 75 74 69 OLOR" (car (guti
0c30: 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 ls:get-color-for
0c40: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 28 64 -state-status (d
0c50: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
0c60: 20 74 65 73 74 64 61 74 29 0a 09 09 09 09 09 09 testdat).......
0c70: 09 09 09 09 09 09 09 09 20 20 20 28 64 62 3a 74 ........ (db:t
0c80: 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 est-get-status t
0c90: 65 73 74 64 61 74 29 29 29 29 0a 09 09 09 09 09 estdat))))......
0ca0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
0cb0: 73 65 74 21 20 6c 62 6c 20 22 54 49 54 4c 45 22 set! lbl "TITLE"
0cc0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st
0cd0: 61 74 75 73 20 74 65 73 74 64 61 74 29 29 29 29 atus testdat))))
0ce0: 29 29 29 0a 09 20 20 20 20 20 20 6c 62 6c 29 0a ))).. lbl).
0cf0: 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 . (store-labe
0d00: 6c 20 22 74 65 73 74 63 6f 6d 6d 65 6e 74 22 0a l "testcomment".
0d10: 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 ... (iup:label "
0d20: 54 65 73 74 43 6f 6d 6d 65 6e 74 20 20 20 20 20 TestComment
0d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d40: 20 20 20 20 20 20 20 20 22 0a 09 09 09 09 20 20 ".....
0d50: 20 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 #:expand "HORI
0d60: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la
0d70: 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 0a 09 mbda (testdat)..
0d80: 09 09 20 20 20 28 6c 65 74 20 28 28 6e 65 77 63 .. (let ((newc
0d90: 6f 6d 6d 65 6e 74 20 28 64 62 3a 74 65 73 74 2d omment (db:test-
0da0: 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 74 65 73 74 get-comment test
0db0: 64 61 74 29 29 29 0a 09 09 09 20 20 20 20 20 28 dat))).... (
0dc0: 69 66 20 2a 64 61 73 68 62 6f 61 72 64 2d 63 6f if *dashboard-co
0dd0: 6d 6d 65 6e 74 2d 73 68 61 72 65 2d 73 6c 6f 74 mment-share-slot
0de0: 2a 0a 09 09 09 09 20 28 69 66 20 28 6e 6f 74 20 *..... (if (not
0df0: 28 65 71 75 61 6c 3f 20 28 69 75 70 3a 61 74 74 (equal? (iup:att
0e00: 72 69 62 75 74 65 20 2a 64 61 73 68 62 6f 61 72 ribute *dashboar
0e10: 64 2d 63 6f 6d 6d 65 6e 74 2d 73 68 61 72 65 2d d-comment-share-
0e20: 73 6c 6f 74 2a 20 22 56 41 4c 55 45 22 29 0a 09 slot* "VALUE")..
0e30: 09 09 09 09 09 20 20 6e 65 77 63 6f 6d 6d 65 6e ..... newcommen
0e40: 74 29 29 0a 09 09 09 09 20 20 20 20 20 28 69 75 t))..... (iu
0e50: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
0e60: 20 2a 64 61 73 68 62 6f 61 72 64 2d 63 6f 6d 6d *dashboard-comm
0e70: 65 6e 74 2d 73 6c 6f 74 2a 0a 09 09 09 09 09 09 ent-slot*.......
0e80: 09 20 22 56 41 4c 55 45 22 0a 09 09 09 09 09 09 . "VALUE".......
0e90: 09 20 6e 65 77 63 6f 6d 6d 65 6e 74 29 29 29 0a . newcomment))).
0ea0: 09 09 09 20 20 20 20 20 6e 65 77 63 6f 6d 6d 65 ... newcomme
0eb0: 6e 74 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 nt))).. (stor
0ec0: 65 2d 6c 61 62 65 6c 20 22 74 65 73 74 69 64 22 e-label "testid"
0ed0: 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 .... (iup:label
0ee0: 22 54 65 73 74 49 64 20 20 20 20 20 20 20 20 20 "TestId
0ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f00: 20 20 20 20 22 0a 09 09 09 09 20 20 20 20 23 3a "..... #:
0f10: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT
0f20: 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 AL").... (lambda
0f30: 20 28 74 65 73 74 64 61 74 29 0a 09 09 09 20 20 (testdat)....
0f40: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 (db:test-get-id
0f50: 20 74 65 73 74 64 61 74 29 29 29 0a 09 20 20 20 testdat)))..
0f60: 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 74 (store-label "t
0f70: 65 73 74 64 61 74 65 22 20 0a 09 09 09 20 28 69 estdate" .... (i
0f80: 75 70 3a 6c 61 62 65 6c 20 22 54 65 73 74 44 61 up:label "TestDa
0f90: 74 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 te
0fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 0a 09 "..
0fb0: 09 09 09 20 20 20 20 23 3a 65 78 70 61 6e 64 20 ... #:expand
0fc0: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 "HORIZONTAL")...
0fd0: 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 . (lambda (testd
0fe0: 61 74 29 0a 09 09 09 20 20 20 28 73 65 63 6f 6e at).... (secon
0ff0: 64 73 2d 3e 77 6f 72 6b 2d 77 65 65 6b 2f 64 61 ds->work-week/da
1000: 79 2d 74 69 6d 65 20 28 64 62 3a 74 65 73 74 2d y-time (db:test-
1010: 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 get-event_time t
1020: 65 73 74 64 61 74 29 29 29 29 0a 09 20 20 20 20 estdat))))..
1030: 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d )))))..;;=======
1040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1050: 3d 3d 3d 3d 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 0a ===============.
1080: 3b 3b 20 54 65 73 74 20 6d 65 74 61 20 70 61 6e ;; Test meta pan
1090: 65 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d el.;;===========
10a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 64 65 ===========..(de
10e0: 66 69 6e 65 20 28 74 65 73 74 2d 6d 65 74 61 2d fine (test-meta-
10f0: 70 61 6e 65 6c 2d 67 65 74 2d 64 65 73 63 72 69 panel-get-descri
1100: 70 74 69 6f 6e 20 74 65 73 74 6d 65 74 61 29 0a ption testmeta).
1110: 20 20 28 66 6d 74 20 23 66 20 28 77 69 74 68 2d (fmt #f (with-
1120: 77 69 64 74 68 20 34 30 20 28 77 72 61 70 2d 6c width 40 (wrap-l
1130: 69 6e 65 73 20 28 64 62 3a 74 65 73 74 6d 65 74 ines (db:testmet
1140: 61 2d 67 65 74 2d 64 65 73 63 72 69 70 74 69 6f a-get-descriptio
1150: 6e 20 74 65 73 74 6d 65 74 61 29 29 29 29 29 0a n testmeta))))).
1160: 0a 28 64 65 66 69 6e 65 20 28 74 65 73 74 2d 6d .(define (test-m
1170: 65 74 61 2d 70 61 6e 65 6c 20 74 65 73 74 6d 65 eta-panel testme
1180: 74 61 20 73 74 6f 72 65 2d 6d 65 74 61 29 0a 20 ta store-meta).
1190: 20 28 69 75 70 3a 66 72 61 6d 65 20 0a 20 20 20 (iup:frame .
11a0: 23 3a 74 69 74 6c 65 20 22 54 65 73 74 20 4d 65 #:title "Test Me
11b0: 74 61 20 44 61 74 61 22 20 3b 20 23 3a 65 78 70 ta Data" ; #:exp
11c0: 61 6e 64 20 22 59 45 53 22 0a 20 20 20 28 69 75 and "YES". (iu
11d0: 70 3a 68 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e p:hbox ; #:expan
11e0: 64 20 22 59 45 53 22 0a 20 20 20 20 28 61 70 70 d "YES". (app
11f0: 6c 79 20 69 75 70 3a 76 62 6f 78 20 3b 20 23 3a ly iup:vbox ; #:
1200: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 20 20 expand "YES"..
1210: 20 28 61 70 70 65 6e 64 20 28 6d 61 70 20 28 6c (append (map (l
1220: 61 6d 62 64 61 20 28 76 61 6c 29 0a 09 09 09 20 ambda (val)....
1230: 20 28 69 75 70 3a 6c 61 62 65 6c 20 76 61 6c 20 (iup:label val
1240: 3b 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ; #:expand "HORI
1250: 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 20 20 20 20 ZONTAL".....
1260: 20 29 29 0a 09 09 09 28 6c 69 73 74 20 22 41 75 ))....(list "Au
1270: 74 68 6f 72 3a 20 22 0a 09 09 09 20 20 20 20 20 thor: "....
1280: 20 22 4f 77 6e 65 72 3a 20 22 0a 09 09 09 20 20 "Owner: "....
1290: 20 20 20 20 22 52 65 76 69 65 77 65 64 3a 20 22 "Reviewed: "
12a0: 0a 09 09 09 20 20 20 20 20 20 22 54 61 67 73 3a .... "Tags:
12b0: 20 22 0a 09 09 09 20 20 20 20 20 20 22 44 65 73 ".... "Des
12c0: 63 72 69 70 74 69 6f 6e 3a 20 22 29 29 0a 09 09 cription: "))...
12d0: 20 20 20 28 6c 69 73 74 20 28 69 75 70 3a 6c 61 (list (iup:la
12e0: 62 65 6c 20 22 22 20 23 3a 65 78 70 61 6e 64 20 bel "" #:expand
12f0: 22 56 45 52 54 49 43 41 4c 22 29 29 29 29 0a 20 "VERTICAL")))).
1300: 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 (apply iup:vb
1310: 6f 78 20 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 ox ; #:expand "
1320: 59 45 53 22 0a 09 20 20 20 28 6c 69 73 74 20 0a YES".. (list .
1330: 09 20 20 20 20 28 73 74 6f 72 65 2d 6d 65 74 61 . (store-meta
1340: 20 22 61 75 74 68 6f 72 22 0a 09 09 09 20 28 69 "author".... (i
1350: 75 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 up:label (db:tes
1360: 74 6d 65 74 61 2d 67 65 74 2d 61 75 74 68 6f 72 tmeta-get-author
1370: 20 74 65 73 74 6d 65 74 61 29 20 23 3a 65 78 70 testmeta) #:exp
1380: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
1390: 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 ).... (lambda (t
13a0: 65 73 74 6d 65 74 61 29 28 64 62 3a 74 65 73 74 estmeta)(db:test
13b0: 6d 65 74 61 2d 67 65 74 2d 61 75 74 68 6f 72 20 meta-get-author
13c0: 74 65 73 74 6d 65 74 61 29 29 29 0a 09 20 20 20 testmeta)))..
13d0: 20 28 73 74 6f 72 65 2d 6d 65 74 61 20 22 6f 77 (store-meta "ow
13e0: 6e 65 72 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 ner".... (iup:la
13f0: 62 65 6c 20 28 64 62 3a 74 65 73 74 6d 65 74 61 bel (db:testmeta
1400: 2d 67 65 74 2d 6f 77 6e 65 72 20 74 65 73 74 6d -get-owner testm
1410: 65 74 61 29 20 23 3a 65 78 70 61 6e 64 20 22 48 eta) #:expand "H
1420: 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 ORIZONTAL")....
1430: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 6d 65 74 (lambda (testmet
1440: 61 29 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 a)(db:testmeta-g
1450: 65 74 2d 6f 77 6e 65 72 20 74 65 73 74 6d 65 74 et-owner testmet
1460: 61 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 a))).. (store
1470: 2d 6d 65 74 61 20 22 72 65 76 69 65 77 65 64 22 -meta "reviewed"
1480: 20 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c .... (iup:label
1490: 20 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 (db:testmeta-ge
14a0: 74 2d 72 65 76 69 65 77 65 64 20 74 65 73 74 6d t-reviewed testm
14b0: 65 74 61 29 20 23 3a 65 78 70 61 6e 64 20 22 48 eta) #:expand "H
14c0: 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 ORIZONTAL")....
14d0: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 6d 65 74 (lambda (testmet
14e0: 61 29 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 a)(db:testmeta-g
14f0: 65 74 2d 72 65 76 69 65 77 65 64 20 74 65 73 74 et-reviewed test
1500: 6d 65 74 61 29 29 29 0a 09 20 20 20 20 28 73 74 meta))).. (st
1510: 6f 72 65 2d 6d 65 74 61 20 22 74 61 67 73 22 20 ore-meta "tags"
1520: 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 .... (iup:label
1530: 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 (db:testmeta-get
1540: 2d 74 61 67 73 20 74 65 73 74 6d 65 74 61 29 20 -tags testmeta)
1550: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
1560: 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 NTAL").... (lamb
1570: 64 61 20 28 74 65 73 74 6d 65 74 61 29 28 64 62 da (testmeta)(db
1580: 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 74 61 :testmeta-get-ta
1590: 67 73 20 74 65 73 74 6d 65 74 61 29 29 29 0a 09 gs testmeta)))..
15a0: 20 20 20 20 28 73 74 6f 72 65 2d 6d 65 74 61 20 (store-meta
15b0: 22 64 65 73 63 72 69 70 74 69 6f 6e 22 20 0a 09 "description" ..
15c0: 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 74 .. (iup:label (t
15d0: 65 73 74 2d 6d 65 74 61 2d 70 61 6e 65 6c 2d 67 est-meta-panel-g
15e0: 65 74 2d 64 65 73 63 72 69 70 74 69 6f 6e 20 74 et-description t
15f0: 65 73 74 6d 65 74 61 29 20 23 3a 73 69 7a 65 20 estmeta) #:size
1600: 22 78 35 30 22 29 3b 20 23 3a 65 78 70 61 6e 64 "x50"); #:expand
1610: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 "HORIZONTAL")..
1620: 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 .. (lambda (test
1630: 6d 65 74 61 29 0a 09 09 09 20 20 20 28 74 65 73 meta).... (tes
1640: 74 2d 6d 65 74 61 2d 70 61 6e 65 6c 2d 67 65 74 t-meta-panel-get
1650: 2d 64 65 73 63 72 69 70 74 69 6f 6e 20 74 65 73 -description tes
1660: 74 6d 65 74 61 29 29 29 0a 09 20 20 20 20 29 29 tmeta))).. ))
1670: 29 29 29 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d )))...;;========
1680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b ==============.;
16c0: 3b 20 52 75 6e 20 69 6e 66 6f 20 70 61 6e 65 6c ; Run info panel
16d0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
16e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 28 64 65 66 69 6e =========.(defin
1720: 65 20 28 72 75 6e 2d 69 6e 66 6f 2d 70 61 6e 65 e (run-info-pane
1730: 6c 20 64 62 20 6b 65 79 64 61 74 20 74 65 73 74 l db keydat test
1740: 64 61 74 20 72 75 6e 6e 61 6d 65 29 0a 20 20 28 dat runname). (
1750: 6c 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 20 20 let* ((run-id
1760: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 (db:test-get-r
1770: 75 6e 5f 69 64 20 74 65 73 74 64 61 74 29 29 0a un_id testdat)).
1780: 09 20 28 72 75 6e 64 61 74 20 20 20 20 20 28 64 . (rundat (d
1790: 62 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 64 b:get-run-info d
17a0: 62 20 72 75 6e 2d 69 64 29 29 0a 09 20 28 68 65 b run-id)).. (he
17b0: 61 64 65 72 20 20 20 20 20 28 64 62 3a 67 65 74 ader (db:get
17c0: 2d 68 65 61 64 65 72 20 72 75 6e 64 61 74 29 29 -header rundat))
17d0: 0a 09 20 28 65 76 65 6e 74 5f 74 69 6d 65 20 28 .. (event_time (
17e0: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
17f0: 68 65 61 64 65 72 20 28 64 62 3a 67 65 74 2d 72 header (db:get-r
1800: 6f 77 73 20 72 75 6e 64 61 74 29 0a 09 09 09 09 ows rundat).....
1810: 09 20 20 20 20 20 28 64 62 3a 67 65 74 2d 68 65 . (db:get-he
1820: 61 64 65 72 20 72 75 6e 64 61 74 29 0a 09 09 09 ader rundat)....
1830: 09 09 20 20 20 20 20 22 65 76 65 6e 74 5f 74 69 .. "event_ti
1840: 6d 65 22 29 29 29 0a 20 20 20 20 28 69 75 70 3a me"))). (iup:
1850: 66 72 61 6d 65 20 0a 20 20 20 20 20 23 3a 74 69 frame . #:ti
1860: 74 6c 65 20 22 4d 65 67 61 74 65 73 74 20 52 75 tle "Megatest Ru
1870: 6e 20 49 6e 66 6f 22 20 3b 20 23 3a 65 78 70 61 n Info" ; #:expa
1880: 6e 64 20 22 59 45 53 22 0a 20 20 20 20 20 28 69 nd "YES". (i
1890: 75 70 3a 68 62 6f 78 20 3b 20 23 3a 65 78 70 61 up:hbox ; #:expa
18a0: 6e 64 20 22 59 45 53 22 0a 20 20 20 20 20 20 28 nd "YES". (
18b0: 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 3b apply iup:vbox ;
18c0: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
18d0: 09 20 20 20 20 20 28 61 70 70 65 6e 64 20 28 6d . (append (m
18e0: 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 76 ap (lambda (keyv
18f0: 61 6c 29 0a 09 09 09 20 20 20 20 28 69 75 70 3a al).... (iup:
1900: 6c 61 62 65 6c 20 28 63 6f 6e 63 20 28 63 61 72 label (conc (car
1910: 20 6b 65 79 76 61 6c 29 20 22 20 22 29 29 29 0a keyval) " "))).
1920: 09 09 09 20 20 6b 65 79 64 61 74 29 0a 09 09 20 ... keydat)...
1930: 20 20 20 20 28 6c 69 73 74 20 28 69 75 70 3a 6c (list (iup:l
1940: 61 62 65 6c 20 22 72 75 6e 6e 61 6d 65 20 22 29 abel "runname ")
1950: 0a 09 09 09 20 20 20 28 69 75 70 3a 6c 61 62 65 .... (iup:labe
1960: 6c 20 22 72 75 6e 2d 69 64 22 29 0a 09 09 09 20 l "run-id")....
1970: 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 72 75 (iup:label "ru
1980: 6e 2d 64 61 74 65 22 29 29 29 29 0a 20 20 20 20 n-date")))).
1990: 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f (apply iup:vbo
19a0: 78 0a 09 20 20 20 20 20 28 61 70 70 65 6e 64 20 x.. (append
19b0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 (map (lambda (ke
19c0: 79 76 61 6c 29 0a 09 09 09 20 20 20 20 28 69 75 yval).... (iu
19d0: 70 3a 6c 61 62 65 6c 20 28 63 61 64 72 20 6b 65 p:label (cadr ke
19e0: 79 76 61 6c 29 20 23 3a 65 78 70 61 6e 64 20 22 yval) #:expand "
19f0: 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 29 0a 09 09 HORIZONTAL"))...
1a00: 09 20 20 6b 65 79 64 61 74 29 0a 09 09 20 20 20 . keydat)...
1a10: 20 20 28 6c 69 73 74 20 28 69 75 70 3a 6c 61 62 (list (iup:lab
1a20: 65 6c 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 20 el runname)....
1a30: 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f (iup:label (co
1a40: 6e 63 20 72 75 6e 2d 69 64 29 29 0a 09 09 09 20 nc run-id))....
1a50: 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 73 65 (iup:label (se
1a60: 63 6f 6e 64 73 2d 3e 79 65 61 72 2d 77 6f 72 6b conds->year-work
1a70: 2d 77 65 65 6b 2f 64 61 79 2d 74 69 6d 65 20 65 -week/day-time e
1a80: 76 65 6e 74 5f 74 69 6d 65 29 29 0a 09 09 09 20 vent_time))....
1a90: 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 22 20 (iup:label ""
1aa0: 23 3a 65 78 70 61 6e 64 20 22 56 45 52 54 49 43 #:expand "VERTIC
1ab0: 41 4c 22 29 29 29 29 29 29 29 29 0a 20 20 0a 3b AL")))))))). .;
1ac0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
1ad0: 3d 3d 3d 3d 3d 3d 3d 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 0a 3b 3b 20 48 6f 73 74 20 =======.;; Host
1b10: 69 6e 66 6f 20 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d info panel.;;===
1b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1b30: 3d 3d 3d 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 0a 28 64 65 66 69 6e 65 20 28 68 6f 73 ===.(define (hos
1b70: 74 2d 69 6e 66 6f 2d 70 61 6e 65 6c 20 74 65 73 t-info-panel tes
1b80: 74 64 61 74 20 73 74 6f 72 65 2d 6c 61 62 65 6c tdat store-label
1b90: 29 0a 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 ). (iup:frame.
1ba0: 20 20 23 3a 74 69 74 6c 65 20 22 52 65 6d 6f 74 #:title "Remot
1bb0: 65 20 68 6f 73 74 20 61 6e 64 20 54 65 73 74 20 e host and Test
1bc0: 52 75 6e 20 49 6e 66 6f 22 20 3b 20 23 3a 65 78 Run Info" ; #:ex
1bd0: 70 61 6e 64 20 22 59 45 53 22 0a 20 20 20 28 69 pand "YES". (i
1be0: 75 70 3a 68 62 6f 78 20 3b 20 23 3a 65 78 70 61 up:hbox ; #:expa
1bf0: 6e 64 20 22 59 45 53 22 0a 20 20 20 20 28 61 70 nd "YES". (ap
1c00: 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 3b 20 23 ply iup:vbox ; #
1c10: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 20 3b 3b :expand "YES" ;;
1c20: 20 54 68 65 20 68 65 61 64 69 6e 67 20 6c 61 62 The heading lab
1c30: 65 6c 73 0a 09 20 20 20 28 61 70 70 65 6e 64 20 els.. (append
1c40: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 76 61 (map (lambda (va
1c50: 6c 29 0a 09 09 09 20 20 28 69 75 70 3a 6c 61 62 l).... (iup:lab
1c60: 65 6c 20 76 61 6c 20 3b 20 23 3a 65 78 70 61 6e el val ; #:expan
1c70: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 d "HORIZONTAL"..
1c80: 09 09 09 20 20 20 20 20 29 29 0a 09 09 09 28 6c ... ))....(l
1c90: 69 73 74 20 22 48 6f 73 74 6e 61 6d 65 3a 20 22 ist "Hostname: "
1ca0: 0a 09 09 09 20 20 20 20 20 20 22 55 6e 61 6d 65 .... "Uname
1cb0: 20 2d 61 3a 20 22 0a 09 09 09 20 20 20 20 20 20 -a: "....
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 29 29 process id: "))
1d30: 0a 09 09 20 20 20 28 69 75 70 3a 6c 61 62 65 6c ... (iup:label
1d40: 20 22 22 20 23 3a 65 78 70 61 6e 64 20 22 56 45 "" #:expand "VE
1d50: 52 54 49 43 41 4c 22 29 29 29 0a 20 20 20 20 28 RTICAL"))). (
1d60: 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 3b apply iup:vbox ;
1d70: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
1d80: 09 20 20 20 28 6c 69 73 74 0a 09 20 20 20 20 3b . (list.. ;
1d90: 3b 20 4e 4f 54 45 3a 20 59 65 73 2c 20 74 68 65 ; NOTE: Yes, the
1da0: 20 68 6f 73 74 20 63 61 6e 20 63 68 61 6e 67 65 host can change
1db0: 21 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 !.. (store-la
1dc0: 62 65 6c 20 22 48 6f 73 74 4e 61 6d 65 22 0a 09 bel "HostName"..
1dd0: 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 3b 3b .. (iup:label ;;
1de0: 20 28 73 64 62 3a 71 72 79 20 27 67 65 74 73 74 (sdb:qry 'getst
1df0: 72 20 0a 09 09 09 20 20 28 64 62 3a 74 65 73 74 r .... (db:test
1e00: 2d 67 65 74 2d 68 6f 73 74 20 74 65 73 74 64 61 -get-host testda
1e10: 74 29 20 3b 3b 20 29 0a 09 09 09 20 20 23 3a 65 t) ;; ).... #:e
1e20: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
1e30: 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 L").... (lambda
1e40: 28 74 65 73 74 64 61 74 29 28 64 62 3a 74 65 73 (testdat)(db:tes
1e50: 74 2d 67 65 74 2d 68 6f 73 74 20 74 65 73 74 64 t-get-host testd
1e60: 61 74 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 at))).. (stor
1e70: 65 2d 6c 61 62 65 6c 20 22 55 6e 61 6d 65 22 0a e-label "Uname".
1e80: 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 ... (iup:label "
1e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ec0: 20 20 20 22 20 23 3a 65 78 70 61 6e 64 20 22 48 " #:expand "H
1ed0: 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 ORIZONTAL")....
1ee0: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 (lambda (testdat
1ef0: 29 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 67 ) ;; (sdb:qry 'g
1f00: 65 74 73 74 72 20 0a 09 09 09 20 20 20 28 64 62 etstr .... (db
1f10: 3a 74 65 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 :test-get-uname
1f20: 74 65 73 74 64 61 74 29 29 29 20 3b 3b 20 29 0a testdat))) ;; ).
1f30: 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 . (store-labe
1f40: 6c 20 22 44 69 73 6b 46 72 65 65 22 0a 09 09 09 l "DiskFree"....
1f50: 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e (iup:label (con
1f60: 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 64 c (db:test-get-d
1f70: 69 73 6b 66 72 65 65 20 74 65 73 74 64 61 74 29 iskfree testdat)
1f80: 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ) #:expand "HORI
1f90: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la
1fa0: 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 28 63 mbda (testdat)(c
1fb0: 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 onc (db:test-get
1fc0: 2d 64 69 73 6b 66 72 65 65 20 74 65 73 74 64 61 -diskfree testda
1fd0: 74 29 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 t)))).. (stor
1fe0: 65 2d 6c 61 62 65 6c 20 22 43 50 55 4c 6f 61 64 e-label "CPULoad
1ff0: 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c ".... (iup:label
2000: 20 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d (conc (db:test-
2010: 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 73 74 get-cpuload test
2020: 64 61 74 29 29 20 23 3a 65 78 70 61 6e 64 20 22 dat)) #:expand "
2030: 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 HORIZONTAL")....
2040: 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 (lambda (testda
2050: 74 29 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 t)(conc (db:test
2060: 2d 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 73 -get-cpuload tes
2070: 74 64 61 74 29 29 29 29 0a 09 20 20 20 20 28 73 tdat)))).. (s
2080: 74 6f 72 65 2d 6c 61 62 65 6c 20 22 52 75 6e 44 tore-label "RunD
2090: 75 72 61 74 69 6f 6e 22 0a 09 09 09 20 28 69 75 uration".... (iu
20a0: 70 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 20 28 73 p:label (conc (s
20b0: 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e 2d 73 econds->hr-min-s
20c0: 65 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ec (db:test-get-
20d0: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 run_duration tes
20e0: 74 64 61 74 29 29 29 20 23 3a 65 78 70 61 6e 64 tdat))) #:expand
20f0: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 "HORIZONTAL")..
2100: 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 .. (lambda (test
2110: 64 61 74 29 28 63 6f 6e 63 20 28 73 65 63 6f 6e dat)(conc (secon
2120: 64 73 2d 3e 68 72 2d 6d 69 6e 2d 73 65 63 20 28 ds->hr-min-sec (
2130: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f db:test-get-run_
2140: 64 75 72 61 74 69 6f 6e 20 74 65 73 74 64 61 74 duration testdat
2150: 29 29 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 ))))).. (stor
2160: 65 2d 6c 61 62 65 6c 20 22 4c 6f 67 46 69 6c 65 e-label "LogFile
2170: 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c ".... (iup:label
2180: 20 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d (conc (db:test-
2190: 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 get-final_logf t
21a0: 65 73 74 64 61 74 29 29 20 23 3a 65 78 70 61 6e estdat)) #:expan
21b0: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a d "HORIZONTAL").
21c0: 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 ... (lambda (tes
21d0: 74 64 61 74 29 28 63 6f 6e 63 20 28 64 62 3a 74 tdat)(conc (db:t
21e0: 65 73 74 2d 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f est-get-final_lo
21f0: 67 66 20 74 65 73 74 64 61 74 29 29 29 29 0a 09 gf testdat))))..
2200: 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c (store-label
2210: 20 22 50 72 6f 63 65 73 73 49 64 22 0a 09 09 09 "ProcessId"....
2220: 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e (iup:label (con
2230: 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 c (db:test-get-p
2240: 72 6f 63 65 73 73 5f 69 64 20 74 65 73 74 64 61 rocess_id testda
2250: 74 29 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f t)) #:expand "HO
2260: 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 RIZONTAL").... (
2270: 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 lambda (testdat)
2280: 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 (conc (db:test-g
2290: 65 74 2d 70 72 6f 63 65 73 73 5f 69 64 20 74 65 et-process_id te
22a0: 73 74 64 61 74 29 29 29 29 0a 09 20 20 20 20 29 stdat)))).. )
22b0: 29 29 29 29 0a 0a 3b 3b 20 75 73 65 20 61 20 67 ))))..;; use a g
22c0: 6c 6f 62 61 6c 20 66 6f 72 20 73 65 74 74 69 6e lobal for settin
22d0: 67 20 74 68 65 20 62 75 74 74 6f 6e 73 20 63 6f g the buttons co
22e0: 6c 6f 72 73 0a 3b 3b 20 20 20 20 20 20 20 20 20 lors.;;
22f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2300: 20 20 73 74 61 74 65 20 73 74 61 74 75 73 20 74 state status t
2310: 65 73 74 73 74 65 70 73 0a 28 64 65 66 69 6e 65 eststeps.(define
2320: 20 2a 73 74 61 74 65 2d 73 74 61 74 75 73 2a 20 *state-status*
2330: 28 76 65 63 74 6f 72 20 23 66 20 23 66 20 23 66 (vector #f #f #f
2340: 29 29 0a 28 64 65 66 69 6e 65 20 28 75 70 64 61 )).(define (upda
2350: 74 65 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d te-state-status-
2360: 62 75 74 74 6f 6e 73 20 74 65 73 74 64 61 74 29 buttons testdat)
2370: 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 61 74 65 . (let* ((state
2380: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 (db:test-get-s
2390: 74 61 74 65 20 20 74 65 73 74 64 61 74 29 29 0a tate testdat)).
23a0: 09 20 28 73 74 61 74 75 73 20 28 64 62 3a 74 65 . (status (db:te
23b0: 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 st-get-status te
23c0: 73 74 64 61 74 29 29 0a 09 20 28 63 6f 6c 6f 72 stdat)).. (color
23d0: 20 20 28 63 61 72 20 28 67 75 74 69 6c 73 3a 67 (car (gutils:g
23e0: 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 et-color-for-sta
23f0: 74 65 2d 73 74 61 74 75 73 20 73 74 61 74 65 20 te-status state
2400: 73 74 61 74 75 73 29 29 29 29 0a 20 20 20 20 28 status)))). (
2410: 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 73 74 61 (vector-ref *sta
2420: 74 65 2d 73 74 61 74 75 73 2a 20 30 29 20 73 74 te-status* 0) st
2430: 61 74 65 20 63 6f 6c 6f 72 29 0a 20 20 20 20 28 ate color). (
2440: 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 73 74 61 (vector-ref *sta
2450: 74 65 2d 73 74 61 74 75 73 2a 20 31 29 20 73 74 te-status* 1) st
2460: 61 74 75 73 20 63 6f 6c 6f 72 29 29 29 0a 0a 28 atus color)))..(
2470: 64 65 66 69 6e 65 20 2a 64 61 73 68 62 6f 61 72 define *dashboar
2480: 64 2d 74 65 73 74 2d 64 62 2a 20 23 74 29 0a 28 d-test-db* #t).(
2490: 64 65 66 69 6e 65 20 2a 64 61 73 68 62 6f 61 72 define *dashboar
24a0: 64 2d 63 6f 6d 6d 65 6e 74 2d 73 68 61 72 65 2d d-comment-share-
24b0: 73 6c 6f 74 2a 20 23 66 29 0a 0a 3b 3b 3d 3d 3d slot* #f)..;;===
24c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2500: 3d 3d 3d 0a 3b 3b 20 53 65 74 20 66 69 65 6c 64 ===.;; Set field
2510: 73 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s .;;===========
2520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 66 ===========.(def
2560: 69 6e 65 20 28 73 65 74 2d 66 69 65 6c 64 73 2d ine (set-fields-
2570: 70 61 6e 65 6c 20 64 62 73 74 72 75 63 74 20 72 panel dbstruct r
2580: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 un-id test-id te
2590: 73 74 64 61 74 20 23 21 6b 65 79 20 28 64 62 20 stdat #!key (db
25a0: 23 66 29 29 0a 20 20 28 6c 65 74 20 28 28 6e 65 #f)). (let ((ne
25b0: 77 63 6f 6d 6d 65 6e 74 20 23 66 29 0a 09 28 6e wcomment #f)..(n
25c0: 65 77 73 74 61 74 75 73 20 20 23 66 29 0a 09 28 ewstatus #f)..(
25d0: 6e 65 77 73 74 61 74 65 20 20 20 23 66 29 0a 09 newstate #f)..
25e0: 28 77 74 78 74 62 6f 78 20 20 20 20 23 66 29 29 (wtxtbox #f))
25f0: 0a 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 0a . (iup:frame.
2600: 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 53 65 #:title "Se
2610: 74 20 66 69 65 6c 64 73 22 0a 20 20 20 20 20 28 t fields". (
2620: 69 75 70 3a 76 62 6f 78 0a 20 20 20 20 20 20 28 iup:vbox. (
2630: 69 75 70 3a 68 62 6f 78 20 28 69 75 70 3a 6c 61 iup:hbox (iup:la
2640: 62 65 6c 20 22 43 6f 6d 6d 65 6e 74 3a 22 29 0a bel "Comment:").
2650: 09 09 28 6c 65 74 20 28 28 74 78 74 62 6f 78 20 ..(let ((txtbox
2660: 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 61 (iup:textbox #:a
2670: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 76 ction (lambda (v
2680: 61 6c 20 61 20 62 29 0a 09 09 09 09 09 09 20 20 al a b).......
2690: 20 20 20 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 (rmt:test-se
26a0: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 t-state-status-b
26b0: 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 y-id run-id test
26c0: 2d 69 64 20 23 66 20 23 66 20 62 29 0a 09 09 09 -id #f #f b)....
26d0: 09 09 09 20 20 20 20 20 20 3b 3b 20 49 44 45 41 ... ;; IDEA
26e0: 3a 20 4a 75 73 74 20 73 65 74 20 61 20 76 61 72 : Just set a var
26f0: 69 61 62 6c 65 20 77 69 74 68 20 74 68 65 20 70 iable with the p
2700: 72 6f 63 20 74 6f 20 63 61 6c 6c 3f 0a 09 09 09 roc to call?....
2710: 09 09 09 20 20 20 20 20 20 28 72 6d 74 3a 74 65 ... (rmt:te
2720: 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 st-set-state-sta
2730: 74 75 73 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 tus-by-id run-id
2740: 20 74 65 73 74 2d 69 64 20 23 66 20 23 66 20 62 test-id #f #f b
2750: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 73 )....... (s
2760: 65 74 21 20 6e 65 77 63 6f 6d 6d 65 6e 74 20 62 et! newcomment b
2770: 29 29 0a 09 09 09 09 09 20 20 20 23 3a 76 61 6c ))...... #:val
2780: 75 65 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ue (db:test-get-
2790: 63 6f 6d 6d 65 6e 74 20 74 65 73 74 64 61 74 29 comment testdat)
27a0: 0a 09 09 09 09 09 20 20 20 23 3a 65 78 70 61 6e ...... #:expan
27b0: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 29 d "HORIZONTAL"))
27c0: 29 0a 09 09 20 20 28 73 65 74 21 20 77 74 78 74 )... (set! wtxt
27d0: 62 6f 78 20 74 78 74 62 6f 78 29 0a 09 09 20 20 box txtbox)...
27e0: 74 78 74 62 6f 78 29 29 0a 09 09 20 20 0a 20 20 txtbox))... .
27f0: 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 68 (apply iup:h
2800: 62 6f 78 0a 09 20 20 20 20 20 28 69 75 70 3a 6c box.. (iup:l
2810: 61 62 65 6c 20 22 53 54 41 54 45 3a 22 20 23 3a abel "STATE:" #:
2820: 73 69 7a 65 20 22 33 30 78 22 29 0a 09 20 20 20 size "30x")..
2830: 20 20 28 6c 65 74 2a 20 28 28 62 74 6e 73 20 20 (let* ((btns
2840: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 73 74 (map (lambda (st
2850: 61 74 65 29 0a 09 09 09 09 20 20 28 6c 65 74 20 ate)..... (let
2860: 28 28 62 74 6e 20 28 69 75 70 3a 62 75 74 74 6f ((btn (iup:butto
2870: 6e 20 73 74 61 74 65 0a 09 09 09 09 09 09 09 20 n state........
2880: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
2890: 4e 54 41 4c 22 20 23 3a 73 69 7a 65 20 22 35 30 NTAL" #:size "50
28a0: 78 22 20 23 3a 66 6f 6e 74 20 22 43 6f 75 72 69 x" #:font "Couri
28b0: 65 72 20 4e 65 77 2c 20 2d 31 30 22 0a 09 09 09 er New, -10"....
28c0: 09 09 09 09 20 23 3a 61 63 74 69 6f 6e 20 28 6c .... #:action (l
28d0: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 ambda (x).......
28e0: 09 09 20 20 20 20 28 72 6d 74 3a 74 65 73 74 2d .. (rmt:test-
28f0: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
2900: 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 -by-id run-id te
2910: 73 74 2d 69 64 20 73 74 61 74 65 20 23 66 20 23 st-id state #f #
2920: 66 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 28 f)......... (
2930: 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 db:test-set-stat
2940: 65 21 20 74 65 73 74 64 61 74 20 73 74 61 74 65 e! testdat state
2950: 29 29 29 29 29 0a 09 09 09 09 20 20 20 20 62 74 )))))..... bt
2960: 6e 29 29 0a 09 09 09 09 28 6d 61 70 20 63 61 64 n)).....(map cad
2970: 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 64 2d 73 74 r *common:std-st
2980: 61 74 65 73 2a 29 29 29 29 20 3b 3b 20 28 6c 69 ates*)))) ;; (li
2990: 73 74 20 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 st "COMPLETED" "
29a0: 4e 4f 54 5f 53 54 41 52 54 45 44 22 20 22 52 55 NOT_STARTED" "RU
29b0: 4e 4e 49 4e 47 22 20 22 52 45 4d 4f 54 45 48 4f NNING" "REMOTEHO
29c0: 53 54 53 54 41 52 54 22 20 22 4c 41 55 4e 43 48 STSTART" "LAUNCH
29d0: 45 44 22 20 22 4b 49 4c 4c 45 44 22 20 22 4b 49 ED" "KILLED" "KI
29e0: 4c 4c 52 45 51 22 29 29 29 29 0a 09 20 20 20 20 LLREQ"))))..
29f0: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
2a00: 2a 73 74 61 74 65 2d 73 74 61 74 75 73 2a 20 30 *state-status* 0
2a10: 0a 09 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 .... (lambda
2a20: 28 73 74 61 74 65 20 63 6f 6c 6f 72 29 0a 09 09 (state color)...
2a30: 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 . (for-each
2a40: 20 0a 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d .... (lam
2a50: 62 64 61 20 28 62 74 6e 29 0a 09 09 09 09 20 28 bda (btn)..... (
2a60: 6c 65 74 2a 20 28 28 6e 61 6d 65 20 20 20 20 20 let* ((name
2a70: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 62 (iup:attribute b
2a80: 74 6e 20 22 54 49 54 4c 45 22 29 29 0a 09 09 09 tn "TITLE"))....
2a90: 09 09 28 6e 65 77 63 6f 6c 6f 72 20 28 69 66 20 ..(newcolor (if
2aa0: 28 65 71 75 61 6c 3f 20 6e 61 6d 65 20 73 74 61 (equal? name sta
2ab0: 74 65 29 20 63 6f 6c 6f 72 20 22 31 39 32 20 31 te) color "192 1
2ac0: 39 32 20 31 39 32 22 29 29 29 0a 09 09 09 09 20 92 192"))).....
2ad0: 20 20 28 69 66 20 28 6e 6f 74 20 28 63 6f 6c 6f (if (not (colo
2ae0: 72 73 2d 73 69 6d 69 6c 61 72 3f 20 6e 65 77 63 rs-similar? newc
2af0: 6f 6c 6f 72 20 28 69 75 70 3a 61 74 74 72 69 62 olor (iup:attrib
2b00: 75 74 65 20 62 74 6e 20 22 42 47 43 4f 4c 4f 52 ute btn "BGCOLOR
2b10: 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 "))).....
2b20: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
2b30: 65 74 21 20 62 74 6e 20 22 42 47 43 4f 4c 4f 52 et! btn "BGCOLOR
2b40: 22 20 6e 65 77 63 6f 6c 6f 72 29 29 29 29 0a 09 " newcolor))))..
2b50: 09 09 20 20 20 20 20 20 20 62 74 6e 73 29 29 29 .. btns)))
2b60: 0a 09 20 20 20 20 20 20 20 62 74 6e 73 29 29 0a .. btns)).
2b70: 20 20 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 (apply iup
2b80: 3a 68 62 6f 78 0a 09 20 20 20 20 20 28 69 75 70 :hbox.. (iup
2b90: 3a 6c 61 62 65 6c 20 22 53 54 41 54 55 53 3a 22 :label "STATUS:"
2ba0: 20 23 3a 73 69 7a 65 20 22 33 30 78 22 29 0a 09 #:size "30x")..
2bb0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 62 74 6e (let* ((btn
2bc0: 73 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 s (map (lambda
2bd0: 28 73 74 61 74 75 73 29 0a 09 09 09 09 20 20 28 (status)..... (
2be0: 6c 65 74 20 28 28 62 74 6e 20 28 69 75 70 3a 62 let ((btn (iup:b
2bf0: 75 74 74 6f 6e 20 73 74 61 74 75 73 0a 09 09 09 utton status....
2c00: 09 09 09 09 20 23 3a 65 78 70 61 6e 64 20 22 48 .... #:expand "H
2c10: 4f 52 49 5a 4f 4e 54 41 4c 22 20 23 3a 73 69 7a ORIZONTAL" #:siz
2c20: 65 20 22 35 30 78 22 20 23 3a 66 6f 6e 74 20 22 e "50x" #:font "
2c30: 43 6f 75 72 69 65 72 20 4e 65 77 2c 20 2d 31 30 Courier New, -10
2c40: 22 0a 09 09 09 09 09 09 09 20 23 3a 61 63 74 69 "........ #:acti
2c50: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 on (lambda (x)..
2c60: 09 09 09 09 09 09 09 20 20 20 20 28 6c 65 74 20 ....... (let
2c70: 28 28 74 20 28 69 75 70 3a 61 74 74 72 69 62 75 ((t (iup:attribu
2c80: 74 65 20 78 20 22 54 49 54 4c 45 22 29 29 29 0a te x "TITLE"))).
2c90: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 69 ........ (i
2ca0: 66 20 28 65 71 75 61 6c 3f 20 74 20 22 57 41 49 f (equal? t "WAI
2cb0: 56 45 44 22 29 0a 09 09 09 09 09 09 09 09 09 20 VED")..........
2cc0: 20 28 69 75 70 3a 73 68 6f 77 20 28 64 61 73 68 (iup:show (dash
2cd0: 62 6f 61 72 64 2d 74 65 73 74 73 3a 77 61 69 76 board-tests:waiv
2ce0: 65 72 20 72 75 6e 2d 69 64 20 74 65 73 74 64 61 er run-id testda
2cf0: 74 20 0a 09 09 09 09 09 09 09 09 09 09 09 09 09 t ..............
2d00: 20 20 20 20 28 69 66 20 77 74 78 74 62 6f 78 20 (if wtxtbox
2d10: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 77 (iup:attribute w
2d20: 74 78 74 62 6f 78 20 22 56 41 4c 55 45 22 29 20 txtbox "VALUE")
2d30: 23 66 29 0a 09 09 09 09 09 09 09 09 09 09 09 09 #f).............
2d40: 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 29 . (lambda (c)
2d50: 0a 09 09 09 09 09 09 09 09 09 09 09 09 09 20 20 ..............
2d60: 20 20 20 20 28 73 65 74 21 20 6e 65 77 63 6f 6d (set! newcom
2d70: 6d 65 6e 74 20 63 29 0a 09 09 09 09 09 09 09 09 ment c).........
2d80: 09 09 09 09 09 20 20 20 20 20 20 28 69 66 20 77 ..... (if w
2d90: 74 78 74 62 6f 78 20 0a 09 09 09 09 09 09 09 09 txtbox .........
2da0: 09 09 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 ...... (begin..
2db0: 09 09 09 09 09 09 09 09 09 09 09 09 09 20 20 20 .............
2dc0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
2dd0: 73 65 74 21 20 77 74 78 74 62 6f 78 20 22 56 41 set! wtxtbox "VA
2de0: 4c 55 45 22 20 63 29 0a 09 09 09 09 09 09 09 09 LUE" c).........
2df0: 09 09 09 09 09 09 20 20 20 20 28 69 66 20 28 6e ...... (if (n
2e00: 6f 74 20 2a 64 61 73 68 62 6f 61 72 64 2d 63 6f ot *dashboard-co
2e10: 6d 6d 65 6e 74 2d 73 68 61 72 65 2d 73 6c 6f 74 mment-share-slot
2e20: 2a 29 0a 09 09 09 09 09 09 09 09 09 09 09 09 09 *)..............
2e30: 09 09 28 73 65 74 21 20 2a 64 61 73 68 62 6f 61 ..(set! *dashboa
2e40: 72 64 2d 63 6f 6d 6d 65 6e 74 2d 73 68 61 72 65 rd-comment-share
2e50: 2d 73 6c 6f 74 2a 20 77 74 78 74 62 6f 78 29 29 -slot* wtxtbox))
2e60: 29 0a 09 09 09 09 09 09 09 09 09 09 09 09 09 09 )...............
2e70: 20 20 29 29 29 29 0a 09 09 09 09 09 09 09 09 09 ))))..........
2e80: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 (begin........
2e90: 09 09 20 20 20 20 28 72 6d 74 3a 74 65 73 74 2d .. (rmt:test-
2ea0: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
2eb0: 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 -by-id run-id te
2ec0: 73 74 2d 69 64 20 23 66 20 73 74 61 74 75 73 20 st-id #f status
2ed0: 23 66 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 #f)..........
2ee0: 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 (db:test-set-st
2ef0: 61 74 75 73 21 20 74 65 73 74 64 61 74 20 73 74 atus! testdat st
2f00: 61 74 75 73 29 29 29 29 29 29 29 29 0a 09 09 09 atus))))))))....
2f10: 09 20 20 20 20 62 74 6e 29 29 0a 09 09 09 09 28 . btn)).....(
2f20: 6d 61 70 20 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e map cadr *common
2f30: 3a 73 74 64 2d 73 74 61 74 75 73 65 73 2a 29 29 :std-statuses*))
2f40: 29 29 20 3b 3b 20 28 6c 69 73 74 20 20 22 50 41 )) ;; (list "PA
2f50: 53 53 22 20 22 57 41 52 4e 22 20 22 46 41 49 4c SS" "WARN" "FAIL
2f60: 22 20 22 43 48 45 43 4b 22 20 22 6e 2f 61 22 20 " "CHECK" "n/a"
2f70: 22 57 41 49 56 45 44 22 20 22 53 4b 49 50 22 29 "WAIVED" "SKIP")
2f80: 29 29 29 0a 09 20 20 20 20 20 20 20 28 76 65 63 ))).. (vec
2f90: 74 6f 72 2d 73 65 74 21 20 2a 73 74 61 74 65 2d tor-set! *state-
2fa0: 73 74 61 74 75 73 2a 20 31 0a 09 09 09 20 20 20 status* 1....
2fb0: 20 28 6c 61 6d 62 64 61 20 28 73 74 61 74 75 73 (lambda (status
2fc0: 20 63 6f 6c 6f 72 29 0a 09 09 09 20 20 20 20 20 color)....
2fd0: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 (for-each ....
2fe0: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 62 (lambda (b
2ff0: 74 6e 29 0a 09 09 09 09 20 28 6c 65 74 2a 20 28 tn)..... (let* (
3000: 28 6e 61 6d 65 20 20 20 20 20 28 69 75 70 3a 61 (name (iup:a
3010: 74 74 72 69 62 75 74 65 20 62 74 6e 20 22 54 49 ttribute btn "TI
3020: 54 4c 45 22 29 29 0a 09 09 09 09 09 28 6e 65 77 TLE"))......(new
3030: 63 6f 6c 6f 72 20 28 69 66 20 28 65 71 75 61 6c color (if (equal
3040: 3f 20 6e 61 6d 65 20 73 74 61 74 75 73 29 20 63 ? name status) c
3050: 6f 6c 6f 72 20 22 31 39 32 20 31 39 32 20 31 39 olor "192 192 19
3060: 32 22 29 29 29 0a 09 09 09 09 20 20 20 28 69 66 2")))..... (if
3070: 20 28 6e 6f 74 20 28 63 6f 6c 6f 72 73 2d 73 69 (not (colors-si
3080: 6d 69 6c 61 72 3f 20 6e 65 77 63 6f 6c 6f 72 20 milar? newcolor
3090: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 62 (iup:attribute b
30a0: 74 6e 20 22 42 47 43 4f 4c 4f 52 22 29 29 29 0a tn "BGCOLOR"))).
30b0: 09 09 09 09 20 20 20 20 20 20 20 28 69 75 70 3a .... (iup:
30c0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 62 attribute-set! b
30d0: 74 6e 20 22 42 47 43 4f 4c 4f 52 22 20 6e 65 77 tn "BGCOLOR" new
30e0: 63 6f 6c 6f 72 29 29 29 29 0a 09 09 09 20 20 20 color))))....
30f0: 20 20 20 20 62 74 6e 73 29 29 29 0a 09 20 20 20 btns)))..
3100: 20 20 20 20 62 74 6e 73 29 29 29 29 29 29 0a 0a btns))))))..
3110: 28 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 (define (dashboa
3120: 72 64 2d 74 65 73 74 73 3a 72 75 6e 2d 68 74 6d rd-tests:run-htm
3130: 6c 2d 76 69 65 77 65 72 20 6c 66 69 6c 65 6e 61 l-viewer lfilena
3140: 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 68 74 6d me). (let ((htm
3150: 6c 76 69 65 77 65 72 63 6d 64 20 28 63 6f 6e 66 lviewercmd (conf
3160: 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 igf:lookup *conf
3170: 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 igdat* "setup" "
3180: 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 22 29 29 htmlviewercmd"))
3190: 29 0a 20 20 20 20 28 69 66 20 68 74 6d 6c 76 69 ). (if htmlvi
31a0: 65 77 65 72 63 6d 64 0a 09 28 73 79 73 74 65 6d ewercmd..(system
31b0: 20 28 63 6f 6e 63 20 22 28 22 20 68 74 6d 6c 76 (conc "(" htmlv
31c0: 69 65 77 65 72 63 6d 64 20 22 20 22 20 6c 66 69 iewercmd " " lfi
31d0: 6c 65 6e 61 6d 65 20 22 20 29 20 26 22 29 29 20 lename " ) &"))
31e0: 0a 09 28 69 75 70 3a 73 65 6e 64 2d 75 72 6c 20 ..(iup:send-url
31f0: 6c 66 69 6c 65 6e 61 6d 65 29 29 29 29 0a 0a 28 lfilename))))..(
3200: 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 define (dashboar
3210: 64 2d 74 65 73 74 73 3a 72 75 6e 2d 61 2d 73 74 d-tests:run-a-st
3220: 65 70 20 69 6e 66 6f 29 0a 20 20 23 74 29 0a 0a ep info). #t)..
3230: 28 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 (define (dashboa
3240: 72 64 2d 74 65 73 74 73 3a 73 74 65 70 2d 72 75 rd-tests:step-ru
3250: 6e 2d 63 6f 6e 74 72 6f 6c 20 74 65 73 74 64 61 n-control testda
3260: 74 20 73 74 65 70 6e 61 6d 65 20 74 65 73 74 63 t stepname testc
3270: 6f 6e 66 69 67 29 0a 20 20 28 69 75 70 3a 64 69 onfig). (iup:di
3280: 61 6c 6f 67 20 3b 3b 20 23 3a 63 6c 6f 73 65 5f alog ;; #:close_
3290: 63 62 20 28 6c 61 6d 62 64 61 20 28 61 29 28 65 cb (lambda (a)(e
32a0: 78 69 74 29 29 20 3b 20 23 3a 65 78 70 61 6e 64 xit)) ; #:expand
32b0: 20 22 59 45 53 22 0a 20 20 20 23 3a 74 69 74 6c "YES". #:titl
32c0: 65 20 73 74 65 70 6e 61 6d 65 0a 20 20 20 28 69 e stepname. (i
32d0: 75 70 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 up:vbox ; #:expa
32e0: 6e 64 20 22 59 45 53 22 0a 20 20 20 20 28 69 75 nd "YES". (iu
32f0: 70 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 20 22 53 p:label (conc "S
3300: 74 65 70 3a 20 22 20 73 74 65 70 6e 61 6d 65 20 tep: " stepname
3310: 22 5c 6e 4e 42 2f 2f 20 54 68 65 73 65 20 62 75 "\nNB// These bu
3320: 74 74 6f 6e 73 20 6f 6e 6c 79 20 72 75 6e 20 74 ttons only run t
3330: 68 65 20 74 65 73 74 20 73 74 65 70 5c 6e 66 6f he test step\nfo
3340: 72 20 74 68 65 20 70 75 72 70 6f 73 65 20 6f 66 r the purpose of
3350: 20 64 65 62 75 67 67 69 6e 67 2e 5c 6e 4e 6f 74 debugging.\nNot
3360: 20 61 6c 6c 20 64 61 74 61 62 61 73 65 20 75 70 all database up
3370: 64 61 74 65 73 20 61 72 65 20 64 6f 6e 65 2e 22 dates are done."
3380: 29 29 0a 20 20 20 20 28 69 75 70 3a 62 75 74 74 )). (iup:butt
3390: 6f 6e 20 22 52 65 2d 72 75 6e 22 20 20 20 20 20 on "Re-run"
33a0: 20 20 20 20 20 20 20 0a 09 09 23 3a 65 78 70 61 ...#:expa
33b0: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 20 nd "HORIZONTAL"
33c0: 0a 09 09 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d ...#:action (lam
33d0: 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 20 20 20 bda (obj)....
33e0: 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 0a (thread-start! .
33f0: 09 09 09 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 ... (make-thr
3400: 65 61 64 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 ead (lambda ()..
3410: 09 09 09 09 20 20 20 28 65 7a 73 74 65 70 73 3a .... (ezsteps:
3420: 72 75 6e 2d 66 72 6f 6d 20 74 65 73 74 64 61 74 run-from testdat
3430: 20 73 74 65 70 6e 61 6d 65 20 23 74 29 29 0a 09 stepname #t))..
3440: 09 09 09 09 20 28 63 6f 6e 63 20 22 65 7a 73 74 .... (conc "ezst
3450: 65 70 20 72 75 6e 20 73 69 6e 67 6c 65 20 73 74 ep run single st
3460: 65 70 20 22 20 73 74 65 70 6e 61 6d 65 29 29 29 ep " stepname)))
3470: 29 29 0a 20 20 20 20 28 69 75 70 3a 62 75 74 74 )). (iup:butt
3480: 6f 6e 20 22 52 65 2d 72 75 6e 20 61 6e 64 20 63 on "Re-run and c
3490: 6f 6e 74 69 6e 75 65 22 20 20 20 20 20 20 20 20 ontinue"
34a0: 20 0a 09 09 23 3a 65 78 70 61 6e 64 20 22 48 4f ...#:expand "HO
34b0: 52 49 5a 4f 4e 54 41 4c 22 20 0a 09 09 23 3a 61 RIZONTAL" ...#:a
34c0: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
34d0: 62 6a 29 0a 09 09 09 20 20 20 28 74 68 72 65 61 bj).... (threa
34e0: 64 2d 73 74 61 72 74 21 0a 09 09 09 20 20 20 20 d-start!....
34f0: 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 (make-thread (la
3500: 6d 62 64 61 20 28 29 0a 09 09 09 09 09 20 20 20 mbda ()......
3510: 28 65 7a 73 74 65 70 73 3a 72 75 6e 2d 66 72 6f (ezsteps:run-fro
3520: 6d 20 74 65 73 74 64 61 74 20 73 74 65 70 6e 61 m testdat stepna
3530: 6d 65 20 23 66 29 29 0a 09 09 09 09 09 20 28 63 me #f))...... (c
3540: 6f 6e 63 20 22 65 7a 73 74 65 70 20 72 75 6e 20 onc "ezstep run
3550: 66 72 6f 6d 20 73 74 65 70 20 22 20 73 74 65 70 from step " step
3560: 6e 61 6d 65 29 29 29 29 29 0a 20 20 20 20 3b 3b name))))). ;;
3570: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 65 (iup:button "Re
3580: 66 72 65 73 68 20 74 65 73 74 20 64 61 74 61 22 fresh test data"
3590: 0a 20 20 20 20 3b 3b 20 20 20 20 20 09 23 3a 65 . ;; .#:e
35a0: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
35b0: 4c 22 0a 20 20 20 20 3b 3b 20 20 20 20 20 09 23 L". ;; .#
35c0: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda
35d0: 28 6f 62 6a 29 0a 20 20 20 20 3b 3b 20 20 20 20 (obj). ;;
35e0: 20 09 09 20 20 20 28 70 72 69 6e 74 20 22 52 65 .. (print "Re
35f0: 66 72 65 73 68 20 74 65 73 74 20 64 61 74 61 20 fresh test data
3600: 22 20 73 74 65 70 6e 61 6d 65 29 29 0a 20 20 20 " stepname)).
3610: 20 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 )))..(define (d
3620: 61 73 68 62 6f 61 72 64 2d 74 65 73 74 73 3a 77 ashboard-tests:w
3630: 61 69 76 65 72 20 72 75 6e 2d 69 64 20 74 65 73 aiver run-id tes
3640: 74 64 61 74 20 6f 76 72 64 76 61 6c 20 63 6d 74 tdat ovrdval cmt
3650: 63 6d 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 77 cmd). (let* ((w
3660: 70 61 74 74 20 28 63 6f 6e 66 69 67 66 3a 6c 6f patt (configf:lo
3670: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
3680: 20 22 73 65 74 75 70 22 20 22 77 61 69 76 65 72 "setup" "waiver
3690: 63 6f 6d 6d 65 6e 74 70 61 74 74 22 29 29 0a 09 commentpatt"))..
36a0: 20 28 77 72 65 67 78 20 28 69 66 20 28 73 74 72 (wregx (if (str
36b0: 69 6e 67 3f 20 77 70 61 74 74 29 28 72 65 67 65 ing? wpatt)(rege
36c0: 78 70 20 77 70 61 74 74 29 20 23 66 29 29 0a 09 xp wpatt) #f))..
36d0: 20 28 77 6d 65 73 67 20 28 69 75 70 3a 6c 61 62 (wmesg (iup:lab
36e0: 65 6c 20 28 69 66 20 77 70 61 74 74 20 28 63 6f el (if wpatt (co
36f0: 6e 63 20 22 43 6f 6d 6d 65 6e 74 20 6d 75 73 74 nc "Comment must
3700: 20 6d 61 74 63 68 20 70 61 74 74 65 72 6e 20 22 match pattern "
3710: 20 77 70 61 74 74 29 20 22 22 29 29 29 0a 09 20 wpatt) "")))..
3720: 28 63 6f 6d 6e 74 20 28 69 75 70 3a 74 65 78 74 (comnt (iup:text
3730: 62 6f 78 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 box #:action (la
3740: 6d 62 64 61 20 28 76 61 6c 20 61 20 62 29 0a 09 mbda (val a b)..
3750: 09 09 09 09 28 69 66 20 77 70 61 74 74 0a 09 09 ....(if wpatt...
3760: 09 09 09 20 20 20 20 28 69 66 20 28 73 74 72 69 ... (if (stri
3770: 6e 67 2d 6d 61 74 63 68 20 77 72 65 67 78 20 62 ng-match wregx b
3780: 29 0a 09 09 09 09 09 09 28 69 75 70 3a 61 74 74 ).......(iup:att
3790: 72 69 62 75 74 65 2d 73 65 74 21 20 77 6d 65 73 ribute-set! wmes
37a0: 67 20 22 54 49 54 4c 45 22 20 28 63 6f 6e 63 20 g "TITLE" (conc
37b0: 22 43 6f 6d 6d 65 6e 74 20 6d 61 74 63 68 65 73 "Comment matches
37c0: 20 22 20 77 70 61 74 74 29 29 0a 09 09 09 09 09 " wpatt))......
37d0: 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d .(iup:attribute-
37e0: 73 65 74 21 20 77 6d 65 73 67 20 22 54 49 54 4c set! wmesg "TITL
37f0: 45 22 20 28 63 6f 6e 63 20 22 43 6f 6d 6d 65 6e E" (conc "Commen
3800: 74 20 64 6f 65 73 20 6e 6f 74 20 6d 61 74 63 68 t does not match
3810: 20 22 20 77 70 61 74 74 29 29 0a 09 09 09 09 09 " wpatt))......
3820: 09 29 29 29 0a 09 09 09 20 20 20 20 20 23 3a 76 .))).... #:v
3830: 61 6c 75 65 20 28 69 66 20 6f 76 72 64 76 61 6c alue (if ovrdval
3840: 20 6f 76 72 64 76 61 6c 20 28 64 62 3a 74 65 73 ovrdval (db:tes
3850: 74 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 74 65 t-get-comment te
3860: 73 74 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 stdat))....
3870: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
3880: 4e 54 41 4c 22 29 29 0a 09 20 28 64 6c 6f 67 20 NTAL")).. (dlog
3890: 20 23 66 29 29 0a 20 20 20 20 28 73 65 74 21 20 #f)). (set!
38a0: 64 6c 6f 67 20 28 69 75 70 3a 64 69 61 6c 6f 67 dlog (iup:dialog
38b0: 20 3b 3b 20 23 3a 63 6c 6f 73 65 5f 63 62 20 28 ;; #:close_cb (
38c0: 6c 61 6d 62 64 61 20 28 61 29 28 65 78 69 74 29 lambda (a)(exit)
38d0: 29 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 ) ; #:expand "YE
38e0: 53 22 0a 09 09 23 3a 74 69 74 6c 65 20 22 53 45 S"...#:title "SE
38f0: 54 20 57 41 49 56 45 52 22 0a 09 09 28 69 75 70 T WAIVER"...(iup
3900: 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 :vbox ; #:expand
3910: 20 22 59 45 53 22 0a 09 09 20 28 69 75 70 3a 6c "YES"... (iup:l
3920: 61 62 65 6c 20 28 63 6f 6e 63 20 22 45 6e 74 65 abel (conc "Ente
3930: 72 20 6a 75 73 74 69 66 69 63 61 74 69 6f 6e 20 r justification
3940: 66 6f 72 20 77 61 69 76 69 6e 67 20 74 65 73 74 for waiving test
3950: 20 22 0a 09 09 09 09 20 20 28 64 62 3a 74 65 73 "..... (db:tes
3960: 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 t-get-testname t
3970: 65 73 74 64 61 74 29 0a 09 09 09 09 20 20 28 69 estdat)..... (i
3980: 66 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 f (equal? (db:te
3990: 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 st-get-item-path
39a0: 20 74 65 73 74 64 61 74 29 20 22 22 29 20 0a 09 testdat) "") ..
39b0: 09 09 09 20 20 20 20 20 20 22 22 0a 09 09 09 09 ... "".....
39c0: 20 20 20 20 20 20 28 63 6f 6e 63 20 22 2f 22 20 (conc "/"
39d0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 (db:test-get-ite
39e0: 6d 2d 70 61 74 68 20 74 65 73 74 64 61 74 29 29 m-path testdat))
39f0: 29 29 29 0a 09 09 20 77 6d 65 73 67 20 3b 3b 20 )))... wmesg ;;
3a00: 74 68 65 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 61 the informationa
3a10: 6c 20 6d 73 67 20 6f 6e 20 77 68 65 74 68 65 72 l msg on whether
3a20: 20 69 74 20 6d 61 74 63 68 65 73 0a 09 09 20 63 it matches... c
3a30: 6f 6d 6e 74 0a 09 09 20 28 69 75 70 3a 68 62 6f omnt... (iup:hbo
3a40: 78 0a 09 09 20 20 28 69 75 70 3a 62 75 74 74 6f x... (iup:butto
3a50: 6e 20 22 41 70 70 6c 79 20 61 6e 64 20 43 6c 6f n "Apply and Clo
3a60: 73 65 20 22 0a 09 09 09 20 20 20 20 20 20 23 3a se ".... #:
3a70: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT
3a80: 41 4c 22 0a 09 09 09 20 20 20 20 20 20 23 3a 61 AL".... #:a
3a90: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
3aa0: 62 6a 29 0a 09 09 09 09 09 20 28 6c 65 74 20 28 bj)...... (let (
3ab0: 28 63 6f 6d 6d 65 6e 74 20 28 69 75 70 3a 61 74 (comment (iup:at
3ac0: 74 72 69 62 75 74 65 20 63 6f 6d 6e 74 20 22 56 tribute comnt "V
3ad0: 41 4c 55 45 22 29 29 0a 09 09 09 09 09 20 20 20 ALUE"))......
3ae0: 20 20 20 20 28 74 65 73 74 2d 69 64 20 28 64 62 (test-id (db
3af0: 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 :test-get-id tes
3b00: 74 64 61 74 29 29 29 0a 09 09 09 09 09 20 20 20 tdat)))......
3b10: 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 77 70 61 (if (or (not wpa
3b20: 74 74 29 0a 09 09 09 09 09 09 20 20 20 28 73 74 tt)....... (st
3b30: 72 69 6e 67 2d 6d 61 74 63 68 20 77 72 65 67 78 ring-match wregx
3b40: 20 63 6f 6d 6d 65 6e 74 29 29 0a 09 09 09 09 09 comment))......
3b50: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 (begin...
3b60: 09 09 09 09 20 28 72 6d 74 3a 74 65 73 74 2d 73 .... (rmt:test-s
3b70: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
3b80: 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 by-id run-id tes
3b90: 74 2d 69 64 20 23 66 20 22 57 41 49 56 45 44 22 t-id #f "WAIVED"
3ba0: 20 63 6f 6d 6d 65 6e 74 29 0a 09 09 09 09 09 09 comment).......
3bb0: 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 (db:test-set-st
3bc0: 61 74 75 73 21 20 74 65 73 74 64 61 74 20 22 57 atus! testdat "W
3bd0: 41 49 56 45 44 22 29 0a 09 09 09 09 09 09 20 28 AIVED")....... (
3be0: 63 6d 74 63 6d 64 20 63 6f 6d 6d 65 6e 74 29 0a cmtcmd comment).
3bf0: 09 09 09 09 09 09 20 28 69 75 70 3a 64 65 73 74 ...... (iup:dest
3c00: 72 6f 79 21 20 64 6c 6f 67 29 29 29 29 29 29 0a roy! dlog)))))).
3c10: 09 09 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 .. (iup:button
3c20: 22 43 61 6e 63 65 6c 22 0a 09 09 09 20 20 20 20 "Cancel"....
3c30: 20 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 #:expand "HORI
3c40: 5a 4f 4e 54 41 4c 22 20 0a 09 09 09 20 20 20 20 ZONTAL" ....
3c50: 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 #:action (lamb
3c60: 64 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 20 28 da (obj)...... (
3c70: 69 75 70 3a 64 65 73 74 72 6f 79 21 20 64 6c 6f iup:destroy! dlo
3c80: 67 29 29 29 29 29 29 29 0a 20 20 20 20 64 6c 6f g))))))). dlo
3c90: 67 29 29 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d g))...;;========
3ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
3ce0: 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;.;;============
3cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 66 69 ==========.(defi
3d30: 6e 65 20 28 65 78 61 6d 69 6e 65 2d 74 65 73 74 ne (examine-test
3d40: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
3d50: 20 3b 3b 20 72 75 6e 2d 69 64 20 72 75 6e 2d 6b ;; run-id run-k
3d60: 65 79 20 6f 72 69 67 74 65 73 74 29 0a 20 20 28 ey origtest). (
3d70: 6c 65 74 2a 20 28 28 64 62 2d 70 61 74 68 20 20 let* ((db-path
3d80: 20 20 20 20 20 28 64 62 3a 64 62 66 69 6c 65 2d (db:dbfile-
3d90: 70 61 74 68 20 72 75 6e 2d 69 64 29 29 20 3b 3b path run-id)) ;;
3da0: 20 28 63 6f 6e 63 20 28 63 6f 6e 66 69 67 66 3a (conc (configf:
3db0: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
3dc0: 74 2a 20 22 73 65 74 75 70 22 20 22 6c 69 6e 6b t* "setup" "link
3dd0: 74 72 65 65 22 29 20 22 2f 64 62 2f 22 20 72 75 tree") "/db/" ru
3de0: 6e 2d 69 64 20 22 2e 64 62 22 29 29 0a 09 20 28 n-id ".db")).. (
3df0: 64 62 73 74 72 75 63 74 20 20 20 20 20 20 28 6d dbstruct (m
3e00: 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 ake-dbr:dbstruct
3e10: 20 70 61 74 68 3a 20 28 63 6f 6e 66 69 67 66 3a path: (configf:
3e20: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
3e30: 74 2a 20 22 73 65 74 75 70 22 20 22 6c 69 6e 6b t* "setup" "link
3e40: 74 72 65 65 22 29 20 6c 6f 63 61 6c 3a 20 23 74 tree") local: #t
3e50: 29 29 0a 09 20 28 74 65 73 74 64 61 74 20 20 20 )).. (testdat
3e60: 20 20 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 (db:get-test
3e70: 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 73 74 -info-by-id dbst
3e80: 72 75 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 ruct run-id test
3e90: 2d 69 64 29 29 0a 09 20 28 64 62 2d 6d 6f 64 2d -id)).. (db-mod-
3ea0: 74 69 6d 65 20 20 20 30 29 20 3b 3b 20 28 66 69 time 0) ;; (fi
3eb0: 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d le-modification-
3ec0: 74 69 6d 65 20 64 62 2d 70 61 74 68 29 29 0a 09 time db-path))..
3ed0: 20 28 6c 61 73 74 2d 75 70 64 61 74 65 20 20 20 (last-update
3ee0: 30 29 20 3b 3b 20 28 63 75 72 72 65 6e 74 2d 73 0) ;; (current-s
3ef0: 65 63 6f 6e 64 73 29 29 0a 09 20 28 72 65 71 75 econds)).. (requ
3f00: 65 73 74 2d 75 70 64 61 74 65 20 23 74 29 29 0a est-update #t)).
3f10: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 74 65 73 (if (not tes
3f20: 74 64 61 74 29 0a 09 28 62 65 67 69 6e 0a 09 20 tdat)..(begin..
3f30: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
3f40: 22 45 52 52 4f 52 3a 20 4e 6f 20 74 65 73 74 20 "ERROR: No test
3f50: 64 61 74 61 20 66 6f 75 6e 64 20 66 6f 72 20 74 data found for t
3f60: 65 73 74 20 22 20 74 65 73 74 2d 69 64 20 22 2c est " test-id ",
3f70: 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 28 65 exiting").. (e
3f80: 78 69 74 20 31 29 29 0a 09 28 6c 65 74 2a 20 28 xit 1))..(let* (
3f90: 3b 3b 20 28 72 75 6e 2d 69 64 20 20 20 20 20 20 ;; (run-id
3fa0: 20 20 28 69 66 20 74 65 73 74 64 61 74 20 28 64 (if testdat (d
3fb0: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 69 b:test-get-run_i
3fc0: 64 20 74 65 73 74 64 61 74 29 20 23 66 29 29 0a d testdat) #f)).
3fd0: 09 20 20 20 20 20 20 20 28 6b 65 79 64 61 74 20 . (keydat
3fe0: 20 20 20 20 20 20 20 28 69 66 20 74 65 73 74 64 (if testd
3ff0: 61 74 20 28 64 62 3a 67 65 74 2d 6b 65 79 2d 76 at (db:get-key-v
4000: 61 6c 2d 70 61 69 72 73 20 64 62 73 74 72 75 63 al-pairs dbstruc
4010: 74 20 72 75 6e 2d 69 64 29 20 23 66 29 29 0a 09 t run-id) #f))..
4020: 20 20 20 20 20 20 20 28 72 75 6e 64 61 74 20 20 (rundat
4030: 20 20 20 20 20 20 28 69 66 20 74 65 73 74 64 61 (if testda
4040: 74 20 28 64 62 3a 67 65 74 2d 72 75 6e 2d 69 6e t (db:get-run-in
4050: 66 6f 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d fo dbstruct run-
4060: 69 64 29 20 23 66 29 29 0a 09 20 20 20 20 20 20 id) #f))..
4070: 20 28 72 75 6e 6e 61 6d 65 20 20 20 20 20 20 20 (runname
4080: 28 69 66 20 74 65 73 74 64 61 74 20 28 64 62 3a (if testdat (db:
4090: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
40a0: 64 65 72 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 der (db:get-rows
40b0: 20 72 75 6e 64 61 74 29 0a 09 09 09 09 09 09 09 rundat)........
40c0: 09 20 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 . (db:get-heade
40d0: 72 20 72 75 6e 64 61 74 29 0a 09 09 09 09 09 09 r rundat).......
40e0: 09 09 20 20 22 72 75 6e 6e 61 6d 65 22 29 20 23 .. "runname") #
40f0: 66 29 29 0a 09 20 20 20 20 20 20 20 28 74 64 62 f)).. (tdb
4100: 20 20 20 20 20 20 20 20 20 20 20 28 74 64 62 3a (tdb:
4110: 6f 70 65 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d open-test-db-by-
4120: 74 65 73 74 2d 69 64 2d 6c 6f 63 61 6c 20 64 62 test-id-local db
4130: 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 74 65 struct run-id te
4140: 73 74 2d 69 64 29 29 0a 09 20 20 20 20 20 20 20 st-id))..
4150: 3b 3b 20 54 68 65 73 65 20 6e 65 78 74 20 74 77 ;; These next tw
4160: 6f 20 61 72 65 20 69 6e 74 65 6e 74 69 6f 6e 61 o are intentiona
4170: 6c 20 62 61 64 20 76 61 6c 75 65 73 20 74 6f 20 l bad values to
4180: 65 6e 73 75 72 65 20 65 72 72 6f 72 73 20 69 66 ensure errors if
4190: 20 74 68 65 79 20 73 68 6f 75 6c 64 20 6e 6f 74 they should not
41a0: 0a 09 20 20 20 20 20 20 20 3b 3b 20 67 65 74 20 .. ;; get
41b0: 66 69 6c 6c 65 64 20 69 6e 20 70 72 6f 70 65 72 filled in proper
41c0: 6c 79 2e 0a 09 20 20 20 20 20 20 20 28 6c 6f 67 ly... (log
41d0: 66 69 6c 65 20 20 20 20 20 20 20 22 2f 74 68 69 file "/thi
41e0: 73 2f 64 69 72 2f 62 65 74 74 65 72 2f 6e 6f 74 s/dir/better/not
41f0: 2f 65 78 69 73 74 22 29 0a 09 20 20 20 20 20 20 /exist")..
4200: 20 28 72 75 6e 64 69 72 20 20 20 20 20 20 20 20 (rundir
4210: 28 69 66 20 74 65 73 74 64 61 74 20 0a 09 09 09 (if testdat ....
4220: 09 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d . (db:test-get-
4230: 72 75 6e 64 69 72 20 74 65 73 74 64 61 74 29 0a rundir testdat).
4240: 09 09 09 09 20 20 6c 6f 67 66 69 6c 65 29 29 0a .... logfile)).
4250: 09 20 20 20 20 20 20 20 28 74 65 73 74 64 61 74 . (testdat
4260: 2d 70 61 74 68 20 20 28 63 6f 6e 63 20 72 75 6e -path (conc run
4270: 64 69 72 20 22 2f 74 65 73 74 64 61 74 2e 64 62 dir "/testdat.db
4280: 22 29 29 20 3b 3b 20 74 68 69 73 20 67 65 74 73 ")) ;; this gets
4290: 20 72 65 63 61 6c 63 75 6c 61 74 65 64 20 75 6e recalculated un
42a0: 74 69 6c 20 66 6f 75 6e 64 20 0a 09 20 20 20 20 til found ..
42b0: 20 20 20 28 74 65 73 74 73 74 65 70 73 20 20 20 (teststeps
42c0: 20 20 28 69 66 20 74 65 73 74 64 61 74 20 28 74 (if testdat (t
42d0: 65 73 74 73 3a 67 65 74 2d 63 6f 6d 70 72 65 73 ests:get-compres
42e0: 73 65 64 2d 73 74 65 70 73 20 64 62 73 74 72 75 sed-steps dbstru
42f0: 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 ct run-id test-i
4300: 64 29 20 27 28 29 29 29 0a 09 20 20 20 20 20 20 d) '()))..
4310: 20 28 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 20 (testfullname
4320: 28 69 66 20 74 65 73 74 64 61 74 20 28 64 62 3a (if testdat (db:
4330: 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d test-get-fullnam
4340: 65 20 74 65 73 74 64 61 74 29 20 22 47 61 74 68 e testdat) "Gath
4350: 65 72 69 6e 67 20 64 61 74 61 20 2e 2e 2e 22 29 ering data ...")
4360: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 6e ).. (testn
4370: 61 6d 65 20 20 20 20 20 20 28 69 66 20 74 65 73 ame (if tes
4380: 74 64 61 74 20 28 64 62 3a 74 65 73 74 2d 67 65 tdat (db:test-ge
4390: 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 64 t-testname testd
43a0: 61 74 29 20 22 6e 2f 61 22 29 29 0a 09 20 20 20 at) "n/a"))..
43b0: 20 20 20 20 28 74 65 73 74 6d 65 74 61 20 20 20 (testmeta
43c0: 20 20 20 28 69 66 20 74 65 73 74 64 61 74 20 0a (if testdat .
43d0: 09 09 09 09 20 20 28 6c 65 74 20 28 28 74 6d 20 .... (let ((tm
43e0: 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 (db:testmeta-get
43f0: 2d 72 65 63 6f 72 64 20 64 62 73 74 72 75 63 74 -record dbstruct
4400: 20 74 65 73 74 6e 61 6d 65 29 29 29 0a 09 09 09 testname)))....
4410: 09 20 20 20 20 28 69 66 20 74 6d 20 74 6d 20 28 . (if tm tm (
4420: 6d 61 6b 65 2d 64 62 3a 74 65 73 74 6d 65 74 61 make-db:testmeta
4430: 29 29 29 0a 09 09 09 09 20 20 28 6d 61 6b 65 2d )))..... (make-
4440: 64 62 3a 74 65 73 74 6d 65 74 61 29 29 29 0a 0a db:testmeta)))..
4450: 09 20 20 20 20 20 20 20 28 6b 65 79 73 74 72 69 . (keystri
4460: 6e 67 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 ng (string-inte
4470: 72 73 70 65 72 73 65 20 0a 09 09 09 20 20 20 20 rsperse ....
4480: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 (map (lambda (ke
4490: 79 76 61 6c 29 0a 09 09 09 09 20 20 20 3b 3b 20 yval)..... ;;
44a0: 28 63 6f 6e 63 20 22 3a 22 20 28 63 61 72 20 6b (conc ":" (car k
44b0: 65 79 76 61 6c 29 20 22 20 22 20 28 63 61 64 72 eyval) " " (cadr
44c0: 20 6b 65 79 76 61 6c 29 29 29 0a 09 09 09 09 20 keyval))).....
44d0: 20 20 28 63 61 64 72 20 6b 65 79 76 61 6c 29 29 (cadr keyval))
44e0: 0a 09 09 09 09 20 6b 65 79 64 61 74 29 0a 09 09 ..... keydat)...
44f0: 09 20 20 20 20 22 2f 22 29 29 0a 09 20 20 20 20 . "/"))..
4500: 20 20 20 28 69 74 65 6d 2d 70 61 74 68 20 20 28 (item-path (
4510: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d db:test-get-item
4520: 2d 70 61 74 68 20 74 65 73 74 64 61 74 29 29 0a -path testdat)).
4530: 09 20 20 20 20 20 20 20 28 76 69 65 77 6c 6f 67 . (viewlog
4540: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a (lambda (x).
4550: 09 09 09 20 20 20 20 20 28 69 66 20 28 66 69 6c ... (if (fil
4560: 65 2d 65 78 69 73 74 73 3f 20 6c 6f 67 66 69 6c e-exists? logfil
4570: 65 29 0a 09 09 09 09 09 3b 28 73 79 73 74 65 6d e)......;(system
4580: 20 28 63 6f 6e 63 20 22 66 69 72 65 66 6f 78 20 (conc "firefox
4590: 22 20 6c 6f 67 66 69 6c 65 20 22 26 22 29 29 0a " logfile "&")).
45a0: 09 09 09 09 20 28 64 61 73 68 62 6f 61 72 64 2d .... (dashboard-
45b0: 74 65 73 74 73 3a 72 75 6e 2d 68 74 6d 6c 2d 76 tests:run-html-v
45c0: 69 65 77 65 72 20 6c 6f 67 66 69 6c 65 29 0a 09 iewer logfile)..
45d0: 09 09 09 20 28 6d 65 73 73 61 67 65 2d 77 69 6e ... (message-win
45e0: 64 6f 77 20 28 63 6f 6e 63 20 22 46 69 6c 65 20 dow (conc "File
45f0: 22 20 6c 6f 67 66 69 6c 65 20 22 20 6e 6f 74 20 " logfile " not
4600: 66 6f 75 6e 64 22 29 29 29 29 29 0a 09 20 20 20 found")))))..
4610: 20 20 20 20 28 76 69 65 77 2d 61 2d 6c 6f 67 20 (view-a-log
4620: 28 6c 61 6d 62 64 61 20 28 6c 66 69 6c 65 29 20 (lambda (lfile)
4630: 0a 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 .... (let ((
4640: 6c 66 69 6c 65 6e 61 6d 65 20 28 63 6f 6e 63 20 lfilename (conc
4650: 72 75 6e 64 69 72 20 22 2f 22 20 6c 66 69 6c 65 rundir "/" lfile
4660: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 3b 3b ))).... ;;
4670: 20 28 70 72 69 6e 74 20 22 6c 66 69 6c 65 6e 61 (print "lfilena
4680: 6d 65 3a 20 22 20 6c 66 69 6c 65 6e 61 6d 65 29 me: " lfilename)
4690: 0a 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 .... (if (
46a0: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 66 69 file-exists? lfi
46b0: 6c 65 6e 61 6d 65 29 0a 09 09 09 09 09 3b 28 73 lename)......;(s
46c0: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 66 69 72 ystem (conc "fir
46d0: 65 66 6f 78 20 22 20 6c 6f 67 66 69 6c 65 20 22 efox " logfile "
46e0: 26 22 29 29 0a 09 09 09 09 20 20 20 28 64 61 73 &"))..... (das
46f0: 68 62 6f 61 72 64 2d 74 65 73 74 73 3a 72 75 6e hboard-tests:run
4700: 2d 68 74 6d 6c 2d 76 69 65 77 65 72 20 6c 66 69 -html-viewer lfi
4710: 6c 65 6e 61 6d 65 29 0a 09 09 09 09 20 20 20 28 lename)..... (
4720: 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 20 28 message-window (
4730: 63 6f 6e 63 20 22 46 69 6c 65 20 22 20 6c 66 69 conc "File " lfi
4740: 6c 65 6e 61 6d 65 20 22 20 6e 6f 74 20 66 6f 75 lename " not fou
4750: 6e 64 22 29 29 29 29 29 29 0a 09 20 20 20 20 20 nd"))))))..
4760: 20 20 28 78 74 65 72 6d 20 20 20 20 20 20 28 6c (xterm (l
4770: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 20 20 ambda (x)....
4780: 20 20 28 69 66 20 28 64 69 72 65 63 74 6f 72 79 (if (directory
4790: 2d 65 78 69 73 74 73 3f 20 72 75 6e 64 69 72 29 -exists? rundir)
47a0: 0a 09 09 09 09 20 28 6c 65 74 20 28 28 73 68 65 ..... (let ((she
47b0: 6c 6c 20 28 69 66 20 28 67 65 74 2d 65 6e 76 69 ll (if (get-envi
47c0: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
47d0: 20 22 53 48 45 4c 4c 22 29 20 0a 09 09 09 09 09 "SHELL") ......
47e0: 09 20 20 28 63 6f 6e 63 20 22 2d 65 20 22 20 28 . (conc "-e " (
47f0: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
4800: 76 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 variable "SHELL"
4810: 29 29 0a 09 09 09 09 09 09 20 20 22 22 29 29 29 ))....... "")))
4820: 0a 09 09 09 09 20 20 20 28 73 79 73 74 65 6d 20 ..... (system
4830: 28 63 6f 6e 63 20 22 63 64 20 22 20 72 75 6e 64 (conc "cd " rund
4840: 69 72 20 0a 09 09 09 09 09 09 20 22 3b 6d 74 5f ir ....... ";mt_
4850: 78 74 65 72 6d 20 2d 54 20 5c 22 22 20 28 73 74 xterm -T \"" (st
4860: 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 74 ring-translate t
4870: 65 73 74 66 75 6c 6c 6e 61 6d 65 20 22 28 29 22 estfullname "()"
4880: 20 22 20 20 22 29 20 22 5c 22 20 22 20 73 68 65 " ") "\" " she
4890: 6c 6c 20 22 26 22 29 29 29 0a 09 09 09 09 20 28 ll "&")))..... (
48a0: 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 20 20 message-window
48b0: 28 63 6f 6e 63 20 22 44 69 72 65 63 74 6f 72 79 (conc "Directory
48c0: 20 22 20 72 75 6e 64 69 72 20 22 20 6e 6f 74 20 " rundir " not
48d0: 66 6f 75 6e 64 22 29 29 29 29 29 0a 09 20 20 20 found")))))..
48e0: 20 20 20 20 28 77 69 64 67 65 74 73 20 20 20 20 (widgets
48f0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
4900: 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 66 72 )).. (refr
4910: 65 73 68 64 61 74 20 28 6c 61 6d 62 64 61 20 28 eshdat (lambda (
4920: 29 0a 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 ).... (let*
4930: 28 28 63 75 72 72 2d 6d 6f 64 2d 74 69 6d 65 20 ((curr-mod-time
4940: 28 6d 61 78 20 28 66 69 6c 65 2d 6d 6f 64 69 66 (max (file-modif
4950: 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 64 62 2d ication-time db-
4960: 70 61 74 68 29 0a 09 09 09 09 09 09 09 28 69 66 path)........(if
4970: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 74 (file-exists? t
4980: 65 73 74 64 61 74 2d 70 61 74 68 29 0a 09 09 09 estdat-path)....
4990: 09 09 09 09 20 20 20 20 28 66 69 6c 65 2d 6d 6f .... (file-mo
49a0: 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 dification-time
49b0: 74 65 73 74 64 61 74 2d 70 61 74 68 29 0a 09 09 testdat-path)...
49c0: 09 09 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a ..... (begin.
49d0: 09 09 09 09 09 09 09 20 20 20 20 20 20 28 73 65 ....... (se
49e0: 74 21 20 74 65 73 74 64 61 74 2d 70 61 74 68 20 t! testdat-path
49f0: 28 63 6f 6e 63 20 72 75 6e 64 69 72 20 22 2f 74 (conc rundir "/t
4a00: 65 73 74 64 61 74 2e 64 62 22 29 29 0a 09 09 09 estdat.db"))....
4a10: 09 09 09 09 20 20 20 20 20 20 30 29 29 29 29 0a .... 0)))).
4a20: 09 09 09 09 20 20 20 20 28 6e 65 65 64 2d 75 70 .... (need-up
4a30: 64 61 74 65 20 20 20 28 6f 72 20 28 61 6e 64 20 date (or (and
4a40: 28 3e 3d 20 63 75 72 72 2d 6d 6f 64 2d 74 69 6d (>= curr-mod-tim
4a50: 65 20 64 62 2d 6d 6f 64 2d 74 69 6d 65 29 0a 09 e db-mod-time)..
4a60: 09 09 09 09 09 09 20 20 20 20 28 3e 20 28 63 75 ...... (> (cu
4a70: 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e rrent-millisecon
4a80: 64 73 29 28 2b 20 6c 61 73 74 2d 75 70 64 61 74 ds)(+ last-updat
4a90: 65 20 32 35 30 29 29 29 20 3b 3b 20 65 76 65 72 e 250))) ;; ever
4aa0: 79 20 68 61 6c 66 20 73 65 63 6f 6e 64 73 20 69 y half seconds i
4ab0: 66 20 64 62 20 74 6f 75 63 68 65 64 0a 09 09 09 f db touched....
4ac0: 09 09 09 20 20 20 20 20 20 20 28 3e 20 28 63 75 ... (> (cu
4ad0: 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e rrent-millisecon
4ae0: 64 73 29 28 2b 20 6c 61 73 74 2d 75 70 64 61 74 ds)(+ last-updat
4af0: 65 20 31 30 30 30 30 29 29 20 20 20 20 20 3b 3b e 10000)) ;;
4b00: 20 66 6f 72 63 65 20 75 70 64 61 74 65 20 65 76 force update ev
4b10: 65 6e 20 31 30 20 73 65 63 6f 6e 64 73 0a 09 09 en 10 seconds...
4b20: 09 09 09 09 20 20 20 20 20 20 20 72 65 71 75 65 .... reque
4b30: 73 74 2d 75 70 64 61 74 65 29 29 0a 09 09 09 09 st-update)).....
4b40: 20 20 20 20 28 6e 65 77 74 65 73 74 64 61 74 20 (newtestdat
4b50: 28 69 66 20 6e 65 65 64 2d 75 70 64 61 74 65 20 (if need-update
4b60: 0a 09 09 09 09 09 09 20 20 20 20 3b 3b 20 4e 4f ....... ;; NO
4b70: 54 45 3a 20 42 55 47 20 48 49 44 45 52 2c 20 74 TE: BUG HIDER, t
4b80: 72 79 20 74 6f 20 65 6c 69 6d 69 6e 61 74 65 20 ry to eliminate
4b90: 74 68 69 73 20 65 78 63 65 70 74 69 6f 6e 20 68 this exception h
4ba0: 61 6e 64 6c 65 72 0a 09 09 09 09 09 09 20 20 20 andler.......
4bb0: 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 (handle-excepti
4bc0: 6f 6e 73 0a 09 09 09 09 09 09 20 20 20 20 20 65 ons....... e
4bd0: 78 6e 20 0a 09 09 09 09 09 09 20 20 20 20 20 28 xn ....... (
4be0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
4bf0: 20 30 20 22 74 65 73 74 20 64 62 20 61 63 63 65 0 "test db acce
4c00: 73 73 20 69 73 73 75 65 20 69 6e 20 65 78 61 6d ss issue in exam
4c10: 69 6e 65 20 74 65 73 74 20 66 6f 72 20 72 75 6e ine test for run
4c20: 2d 69 64 20 22 20 72 75 6e 2d 69 64 20 22 2c 20 -id " run-id ",
4c30: 74 65 73 74 2d 69 64 20 22 20 74 65 73 74 2d 69 test-id " test-i
4c40: 64 20 22 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 d ": " ((conditi
4c50: 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 on-property-acce
4c60: 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 ssor 'exn 'messa
4c70: 67 65 29 20 65 78 6e 29 29 0a 09 09 09 09 09 09 ge) exn)).......
4c80: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 74 65 73 (db:get-tes
4c90: 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 73 t-info-by-id dbs
4ca0: 74 72 75 63 74 20 72 75 6e 2d 69 64 20 74 65 73 truct run-id tes
4cb0: 74 2d 69 64 20 29 29 29 29 29 0a 09 09 09 20 20 t-id )))))....
4cc0: 20 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 ;; (debug:p
4cd0: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 6e 65 65 rint-info 0 "nee
4ce0: 64 2d 75 70 64 61 74 65 3d 20 22 20 6e 65 65 64 d-update= " need
4cf0: 2d 75 70 64 61 74 65 20 22 20 63 75 72 72 2d 6d -update " curr-m
4d00: 6f 64 2d 74 69 6d 65 20 3d 20 22 20 63 75 72 72 od-time = " curr
4d10: 2d 6d 6f 64 2d 74 69 6d 65 29 0a 09 09 09 20 20 -mod-time)....
4d20: 20 20 20 20 20 28 63 6f 6e 64 0a 09 09 09 09 28 (cond.....(
4d30: 28 61 6e 64 20 6e 65 65 64 2d 75 70 64 61 74 65 (and need-update
4d40: 20 6e 65 77 74 65 73 74 64 61 74 29 0a 09 09 09 newtestdat)....
4d50: 09 20 28 73 65 74 21 20 74 65 73 74 64 61 74 20 . (set! testdat
4d60: 6e 65 77 74 65 73 74 64 61 74 29 0a 09 09 09 09 newtestdat).....
4d70: 20 28 73 65 74 21 20 74 65 73 74 73 74 65 70 73 (set! teststeps
4d80: 20 20 20 20 28 74 65 73 74 73 3a 67 65 74 2d 63 (tests:get-c
4d90: 6f 6d 70 72 65 73 73 65 64 2d 73 74 65 70 73 20 ompressed-steps
4da0: 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 dbstruct run-id
4db0: 74 65 73 74 2d 69 64 29 29 0a 09 09 09 09 20 28 test-id))..... (
4dc0: 73 65 74 21 20 6c 6f 67 66 69 6c 65 20 20 20 20 set! logfile
4dd0: 20 20 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 (conc (db:test
4de0: 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 -get-rundir test
4df0: 64 61 74 29 20 22 2f 22 20 28 64 62 3a 74 65 73 dat) "/" (db:tes
4e00: 74 2d 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 t-get-final_logf
4e10: 20 74 65 73 74 64 61 74 29 29 29 0a 09 09 09 09 testdat))).....
4e20: 20 28 73 65 74 21 20 72 75 6e 64 69 72 20 20 20 (set! rundir
4e30: 20 20 20 20 3b 3b 20 28 66 69 6c 65 64 62 3a 67 ;; (filedb:g
4e40: 65 74 2d 70 61 74 68 20 2a 66 64 62 2a 20 0a 09 et-path *fdb* ..
4e50: 09 09 09 20 20 20 20 20 20 20 28 64 62 3a 74 65 ... (db:te
4e60: 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 st-get-rundir te
4e70: 73 74 64 61 74 29 29 20 3b 3b 20 29 0a 09 09 09 stdat)) ;; )....
4e80: 09 20 28 73 65 74 21 20 74 65 73 74 66 75 6c 6c . (set! testfull
4e90: 6e 61 6d 65 20 28 64 62 3a 74 65 73 74 2d 67 65 name (db:test-ge
4ea0: 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 64 t-fullname testd
4eb0: 61 74 29 29 0a 09 09 09 09 20 3b 3b 20 28 64 65 at))..... ;; (de
4ec0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 49 4e 46 bug:print 0 "INF
4ed0: 4f 3a 20 74 65 73 74 73 74 65 70 73 3d 22 20 28 O: teststeps=" (
4ee0: 69 6e 74 65 72 73 70 65 72 73 65 20 74 65 73 74 intersperse test
4ef0: 73 74 65 70 73 20 22 5c 6e 20 20 20 20 22 29 29 steps "\n "))
4f00: 0a 09 09 09 09 20 0a 09 09 09 09 20 3b 3b 20 49 ..... ..... ;; I
4f10: 20 64 6f 6e 27 74 20 73 65 65 20 77 68 79 20 74 don't see why t
4f20: 68 69 73 20 77 61 73 20 69 6d 70 6c 65 6d 65 6e his was implemen
4f30: 74 65 64 20 74 68 69 73 20 77 61 79 2e 20 50 6c ted this way. Pl
4f40: 65 61 73 65 20 63 6f 6d 6d 65 6e 74 20 69 74 20 ease comment it
4f50: 2e 2e 2e 0a 09 09 09 09 20 3b 3b 20 28 69 66 20 ........ ;; (if
4f60: 28 65 71 3f 20 63 75 72 72 2d 6d 6f 64 2d 74 69 (eq? curr-mod-ti
4f70: 6d 65 20 64 62 2d 6d 6f 64 2d 74 69 6d 65 29 20 me db-mod-time)
4f80: 3b 3b 20 64 6f 20 6f 6e 6c 79 20 6f 6e 63 65 20 ;; do only once
4f90: 69 66 20 73 61 6d 65 0a 09 09 09 09 20 3b 3b 20 if same..... ;;
4fa0: 20 20 20 20 28 73 65 74 21 20 64 62 2d 6d 6f 64 (set! db-mod
4fb0: 2d 74 69 6d 65 20 28 2b 20 63 75 72 72 2d 6d 6f -time (+ curr-mo
4fc0: 64 2d 74 69 6d 65 20 31 29 29 0a 09 09 09 09 20 d-time 1)).....
4fd0: 3b 3b 20 20 20 20 20 28 73 65 74 21 20 64 62 2d ;; (set! db-
4fe0: 6d 6f 64 2d 74 69 6d 65 20 63 75 72 72 2d 6d 6f mod-time curr-mo
4ff0: 64 2d 74 69 6d 65 29 29 0a 0a 09 09 09 09 20 28 d-time))...... (
5000: 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 63 75 72 if (not (eq? cur
5010: 72 2d 6d 6f 64 2d 74 69 6d 65 20 64 62 2d 6d 6f r-mod-time db-mo
5020: 64 2d 74 69 6d 65 29 29 0a 09 09 09 09 20 20 20 d-time)).....
5030: 20 20 28 73 65 74 21 20 64 62 2d 6d 6f 64 2d 74 (set! db-mod-t
5040: 69 6d 65 20 63 75 72 72 2d 6d 6f 64 2d 74 69 6d ime curr-mod-tim
5050: 65 29 29 0a 09 09 09 09 20 28 73 65 74 21 20 6c e))..... (set! l
5060: 61 73 74 2d 75 70 64 61 74 65 20 28 63 75 72 72 ast-update (curr
5070: 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 ent-milliseconds
5080: 29 29 0a 09 09 09 09 20 28 73 65 74 21 20 72 65 ))..... (set! re
5090: 71 75 65 73 74 2d 75 70 64 61 74 65 20 23 66 29 quest-update #f)
50a0: 20 3b 3b 20 6d 65 74 20 74 68 65 20 6e 65 65 64 ;; met the need
50b0: 20 2e 2e 2e 0a 09 09 09 09 20 29 0a 09 09 09 09 ........ ).....
50c0: 28 6e 65 65 64 2d 75 70 64 61 74 65 20 3b 3b 20 (need-update ;;
50d0: 69 66 20 74 68 69 73 20 77 61 73 20 74 72 75 65 if this was true
50e0: 20 61 6e 64 20 79 65 74 20 74 68 65 72 65 20 69 and yet there i
50f0: 73 20 6e 6f 20 64 61 74 61 20 2e 2e 2e 2e 0a 09 s no data ......
5100: 09 09 09 20 28 64 62 3a 74 65 73 74 2d 73 65 74 ... (db:test-set
5110: 2d 74 65 73 74 6e 61 6d 65 21 20 74 65 73 74 64 -testname! testd
5120: 61 74 20 22 44 45 41 44 20 4f 52 20 44 45 4c 45 at "DEAD OR DELE
5130: 54 45 44 20 54 45 53 54 22 29 29 29 0a 09 09 09 TED TEST")))....
5140: 20 20 20 20 20 20 20 28 69 66 20 6e 65 65 64 2d (if need-
5150: 75 70 64 61 74 65 0a 09 09 09 09 20 20 20 28 62 update..... (b
5160: 65 67 69 6e 0a 09 09 09 09 20 20 20 20 20 3b 3b egin..... ;;
5170: 20 75 70 64 61 74 65 20 74 68 65 20 67 75 69 20 update the gui
5180: 65 6c 65 6d 65 6e 74 73 20 68 65 72 65 0a 09 09 elements here...
5190: 09 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 .. (for-each
51a0: 20 0a 09 09 09 09 20 20 20 20 20 20 28 6c 61 6d ..... (lam
51b0: 62 64 61 20 28 6b 65 79 29 0a 09 09 09 09 09 3b bda (key)......;
51c0: 3b 20 28 70 72 69 6e 74 20 22 55 70 64 61 74 69 ; (print "Updati
51d0: 6e 67 20 22 20 6b 65 79 29 0a 09 09 09 09 09 28 ng " key)......(
51e0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 (hash-table-ref
51f0: 77 69 64 67 65 74 73 20 6b 65 79 29 20 74 65 73 widgets key) tes
5200: 74 64 61 74 29 29 0a 09 09 09 09 20 20 20 20 20 tdat)).....
5210: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 (hash-table-key
5220: 73 20 77 69 64 67 65 74 73 29 29 0a 09 09 09 09 s widgets)).....
5230: 20 20 20 20 20 28 75 70 64 61 74 65 2d 73 74 61 (update-sta
5240: 74 65 2d 73 74 61 74 75 73 2d 62 75 74 74 6f 6e te-status-button
5250: 73 20 74 65 73 74 64 61 74 29 29 29 0a 09 09 09 s testdat)))....
5260: 20 20 20 20 20 20 20 3b 3b 20 28 69 75 70 3a 72 ;; (iup:r
5270: 65 66 72 65 73 68 20 73 65 6c 66 29 0a 09 09 09 efresh self)....
5280: 20 20 20 20 20 20 20 29 29 29 0a 09 20 20 20 20 )))..
5290: 20 20 20 28 6d 65 74 61 2d 77 69 64 67 65 74 73 (meta-widgets
52a0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
52b0: 65 29 29 0a 09 20 20 20 20 20 20 20 28 73 65 6c e)).. (sel
52c0: 66 20 20 20 20 20 20 20 20 20 23 66 29 0a 09 20 f #f)..
52d0: 20 20 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 (store-lab
52e0: 65 6c 20 20 28 6c 61 6d 62 64 61 20 28 6e 61 6d el (lambda (nam
52f0: 65 20 6c 62 6c 20 63 6d 64 29 0a 09 09 09 20 20 e lbl cmd)....
5300: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
5310: 2d 73 65 74 21 20 77 69 64 67 65 74 73 20 6e 61 -set! widgets na
5320: 6d 65 20 0a 09 09 09 09 09 09 28 6c 61 6d 62 64 me .......(lambd
5330: 61 20 28 74 65 73 74 64 61 74 29 0a 09 09 09 09 a (testdat).....
5340: 09 09 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 .. (let ((newva
5350: 6c 20 28 63 6d 64 20 74 65 73 74 64 61 74 29 29 l (cmd testdat))
5360: 0a 09 09 09 09 09 09 09 28 6f 6c 64 76 61 6c 20 ........(oldval
5370: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c (iup:attribute l
5380: 62 6c 20 22 54 49 54 4c 45 22 29 29 29 0a 09 09 bl "TITLE")))...
5390: 09 09 09 09 20 20 20 20 28 69 66 20 28 6e 6f 74 .... (if (not
53a0: 20 28 65 71 75 61 6c 3f 20 6e 65 77 76 61 6c 20 (equal? newval
53b0: 6f 6c 64 76 61 6c 29 29 0a 09 09 09 09 09 09 09 oldval))........
53c0: 28 62 65 67 69 6e 0a 09 09 09 09 09 3b 28 6d 75 (begin......;(mu
53d0: 74 65 78 2d 6c 6f 63 6b 21 20 6d 78 31 29 0a 09 tex-lock! mx1)..
53e0: 09 09 09 09 09 09 20 20 28 69 75 70 3a 61 74 74 ...... (iup:att
53f0: 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 6c 20 ribute-set! lbl
5400: 22 54 49 54 4c 45 22 20 6e 65 77 76 61 6c 29 0a "TITLE" newval).
5410: 09 09 09 09 09 3b 28 6d 75 74 65 78 2d 75 6e 6c .....;(mutex-unl
5420: 6f 63 6b 21 20 6d 78 31 29 0a 09 09 09 09 09 09 ock! mx1).......
5430: 09 20 20 29 29 29 29 29 0a 09 09 09 20 20 20 20 . )))))....
5440: 20 20 20 6c 62 6c 29 29 0a 09 20 20 20 20 20 20 lbl))..
5450: 20 28 73 74 6f 72 65 2d 6d 65 74 61 20 20 28 6c (store-meta (l
5460: 61 6d 62 64 61 20 28 6e 61 6d 65 20 6c 62 6c 20 ambda (name lbl
5470: 63 6d 64 29 0a 09 09 09 20 20 20 20 20 20 28 68 cmd).... (h
5480: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 6d ash-table-set! m
5490: 65 74 61 2d 77 69 64 67 65 74 73 20 6e 61 6d 65 eta-widgets name
54a0: 20 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 6c ...... (l
54b0: 61 6d 62 64 61 20 28 74 65 73 74 6d 65 74 61 29 ambda (testmeta)
54c0: 0a 09 09 09 09 09 09 20 28 6c 65 74 20 28 28 6e ....... (let ((n
54d0: 65 77 76 61 6c 20 28 63 6d 64 20 74 65 73 74 6d ewval (cmd testm
54e0: 65 74 61 29 29 0a 09 09 09 09 09 09 20 20 20 20 eta)).......
54f0: 20 20 20 28 6f 6c 64 76 61 6c 20 28 69 75 70 3a (oldval (iup:
5500: 61 74 74 72 69 62 75 74 65 20 6c 62 6c 20 22 54 attribute lbl "T
5510: 49 54 4c 45 22 29 29 29 0a 09 09 09 09 09 09 20 ITLE"))).......
5520: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 (if (not (equa
5530: 6c 3f 20 6e 65 77 76 61 6c 20 6f 6c 64 76 61 6c l? newval oldval
5540: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
5550: 28 62 65 67 69 6e 0a 09 09 09 09 09 3b 28 6d 75 (begin......;(mu
5560: 74 65 78 2d 6c 6f 63 6b 21 20 6d 78 31 29 0a 09 tex-lock! mx1)..
5570: 09 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 ...... (iup:attr
5580: 69 62 75 74 65 2d 73 65 74 21 20 6c 62 6c 20 22 ibute-set! lbl "
5590: 54 49 54 4c 45 22 20 6e 65 77 76 61 6c 29 0a 09 TITLE" newval)..
55a0: 09 09 09 09 3b 28 6d 75 74 65 78 2d 75 6e 6c 6f ....;(mutex-unlo
55b0: 63 6b 21 20 6d 78 31 29 0a 09 09 09 09 09 09 09 ck! mx1)........
55c0: 20 29 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 )))))....
55d0: 6c 62 6c 29 29 0a 09 20 20 20 20 20 20 20 28 73 lbl)).. (s
55e0: 74 6f 72 65 2d 62 75 74 74 6f 6e 20 73 74 6f 72 tore-button stor
55f0: 65 2d 6c 61 62 65 6c 29 0a 09 20 20 20 20 20 20 e-label)..
5600: 20 28 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 (command-text-b
5610: 6f 78 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 ox (iup:textbox
5620: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
5630: 4e 54 41 4c 22 20 23 3a 66 6f 6e 74 20 22 43 6f NTAL" #:font "Co
5640: 75 72 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 29 urier New, -10")
5650: 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6d 6d 61 ).. (comma
5660: 6e 64 2d 6c 61 75 6e 63 68 2d 62 75 74 74 6f 6e nd-launch-button
5670: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 45 78 (iup:button "Ex
5680: 65 63 75 74 65 21 22 20 23 3a 61 63 74 69 6f 6e ecute!" #:action
5690: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x)....
56a0: 09 09 09 09 09 09 28 6c 65 74 2a 20 28 28 63 6d ......(let* ((cm
56b0: 64 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 d (iup:attri
56c0: 62 75 74 65 20 63 6f 6d 6d 61 6e 64 2d 74 65 78 bute command-tex
56d0: 74 2d 62 6f 78 20 22 56 41 4c 55 45 22 29 29 0a t-box "VALUE")).
56e0: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
56f0: 28 66 75 6c 6c 63 6d 64 20 28 63 6f 6e 63 20 28 (fullcmd (conc (
5700: 64 74 65 73 74 73 3a 67 65 74 2d 70 72 65 2d 63 dtests:get-pre-c
5710: 6f 6d 6d 61 6e 64 29 0a 09 09 09 09 09 09 09 09 ommand).........
5720: 09 09 09 20 20 20 20 20 20 63 6d 64 20 0a 09 09 ... cmd ...
5730: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 ......... (
5740: 64 74 65 73 74 73 3a 67 65 74 2d 70 6f 73 74 2d dtests:get-post-
5750: 63 6f 6d 6d 61 6e 64 29 29 29 29 0a 09 09 09 09 command)))).....
5760: 09 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 ..... (debug:pr
5770: 69 6e 74 2d 69 6e 66 6f 20 30 32 20 22 52 75 6e int-info 02 "Run
5780: 6e 69 6e 67 20 63 6f 6d 6d 61 6e 64 3a 20 22 20 ning command: "
5790: 66 75 6c 6c 63 6d 64 29 0a 09 09 09 09 09 09 09 fullcmd)........
57a0: 09 09 20 20 28 73 79 73 74 65 6d 20 66 75 6c 6c .. (system full
57b0: 63 6d 64 29 29 29 29 29 0a 09 20 20 20 20 20 20 cmd)))))..
57c0: 20 28 6b 69 6c 6c 2d 6a 6f 62 73 20 28 6c 61 6d (kill-jobs (lam
57d0: 62 64 61 20 28 78 29 0a 09 09 09 20 20 20 20 28 bda (x).... (
57e0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
57f0: 74 21 20 0a 09 09 09 20 20 20 20 20 63 6f 6d 6d t! .... comm
5800: 61 6e 64 2d 74 65 78 74 2d 62 6f 78 20 22 56 41 and-text-box "VA
5810: 4c 55 45 22 0a 09 09 09 20 20 20 20 20 28 63 6f LUE".... (co
5820: 6e 63 20 22 6d 65 67 61 74 65 73 74 20 2d 74 61 nc "megatest -ta
5830: 72 67 65 74 20 22 20 6b 65 79 73 74 72 69 6e 67 rget " keystring
5840: 20 22 20 2d 72 75 6e 6e 61 6d 65 20 22 20 20 72 " -runname " r
5850: 75 6e 6e 61 6d 65 20 0a 09 09 09 09 20 20 20 22 unname ..... "
5860: 20 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 -set-state-stat
5870: 75 73 20 4b 49 4c 4c 52 45 51 2c 6e 2f 61 20 2d us KILLREQ,n/a -
5880: 74 65 73 74 70 61 74 74 20 25 2f 25 20 22 0a 09 testpatt %/% "..
5890: 09 09 09 20 20 20 22 20 2d 73 74 61 74 65 20 52 ... " -state R
58a0: 55 4e 4e 49 4e 47 22 29 29 29 29 0a 09 20 20 20 UNNING"))))..
58b0: 20 20 20 20 28 72 75 6e 2d 74 65 73 74 20 20 28 (run-test (
58c0: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 20 lambda (x)....
58d0: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute
58e0: 2d 73 65 74 21 20 0a 09 09 09 20 20 20 20 20 63 -set! .... c
58f0: 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 6f 78 20 ommand-text-box
5900: 22 56 41 4c 55 45 22 0a 09 09 09 20 20 20 20 20 "VALUE"....
5910: 28 63 6f 6e 63 20 22 6d 65 67 61 74 65 73 74 20 (conc "megatest
5920: 2d 74 61 72 67 65 74 20 22 20 6b 65 79 73 74 72 -target " keystr
5930: 69 6e 67 20 22 20 2d 72 75 6e 6e 61 6d 65 20 22 ing " -runname "
5940: 20 72 75 6e 6e 61 6d 65 20 0a 09 09 09 09 20 20 runname .....
5950: 20 22 20 2d 72 75 6e 74 65 73 74 73 20 22 20 28 " -runtests " (
5960: 63 6f 6e 63 20 74 65 73 74 6e 61 6d 65 20 22 2f conc testname "/
5970: 22 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 74 " (if (equal? it
5980: 65 6d 2d 70 61 74 68 20 22 22 29 0a 09 09 09 09 em-path "").....
5990: 09 09 09 09 09 22 25 22 20 0a 09 09 09 09 09 09 ....."%" .......
59a0: 09 09 09 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 ...item-path))..
59b0: 09 09 09 20 20 20 29 29 29 29 0a 09 20 20 20 20 ... ))))..
59c0: 20 20 20 28 72 65 6d 6f 76 65 2d 74 65 73 74 20 (remove-test
59d0: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 20 (lambda (x)....
59e0: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
59f0: 75 74 65 2d 73 65 74 21 0a 09 09 09 20 20 20 20 ute-set!....
5a00: 20 20 20 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d command-text-
5a10: 62 6f 78 20 22 56 41 4c 55 45 22 0a 09 09 09 20 box "VALUE"....
5a20: 20 20 20 20 20 20 28 63 6f 6e 63 20 22 6d 65 67 (conc "meg
5a30: 61 74 65 73 74 20 2d 72 65 6d 6f 76 65 2d 72 75 atest -remove-ru
5a40: 6e 73 20 2d 74 61 72 67 65 74 20 22 20 6b 65 79 ns -target " key
5a50: 73 74 72 69 6e 67 20 22 20 2d 72 75 6e 6e 61 6d string " -runnam
5a60: 65 20 22 20 72 75 6e 6e 61 6d 65 0a 09 09 09 09 e " runname.....
5a70: 20 20 20 20 20 22 20 2d 74 65 73 74 70 61 74 74 " -testpatt
5a80: 20 22 20 28 63 6f 6e 63 20 74 65 73 74 6e 61 6d " (conc testnam
5a90: 65 20 22 2f 22 20 28 69 66 20 28 65 71 75 61 6c e "/" (if (equal
5aa0: 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 0a ? item-path "").
5ab0: 09 09 09 09 09 09 09 09 09 20 20 22 25 22 0a 09 ......... "%"..
5ac0: 09 09 09 09 09 09 09 09 20 20 69 74 65 6d 2d 70 ........ item-p
5ad0: 61 74 68 29 29 0a 09 09 09 09 20 20 20 20 20 22 ath))..... "
5ae0: 20 2d 76 22 29 29 29 29 0a 09 20 20 20 20 20 20 -v"))))..
5af0: 20 28 63 6c 65 61 6e 2d 72 75 6e 2d 65 78 65 63 (clean-run-exec
5b00: 75 74 65 20 20 28 6c 61 6d 62 64 61 20 28 78 29 ute (lambda (x)
5b10: 0a 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 ..... (let (
5b20: 28 63 6d 64 20 28 63 6f 6e 63 20 22 6d 65 67 61 (cmd (conc "mega
5b30: 74 65 73 74 20 2d 72 65 6d 6f 76 65 2d 72 75 6e test -remove-run
5b40: 73 20 2d 74 61 72 67 65 74 20 22 20 6b 65 79 73 s -target " keys
5b50: 74 72 69 6e 67 20 22 20 2d 72 75 6e 6e 61 6d 65 tring " -runname
5b60: 20 22 20 72 75 6e 6e 61 6d 65 0a 09 09 09 09 09 " runname......
5b70: 09 20 20 20 20 20 20 22 20 2d 74 65 73 74 70 61 . " -testpa
5b80: 74 74 20 22 20 28 63 6f 6e 63 20 74 65 73 74 6e tt " (conc testn
5b90: 61 6d 65 20 22 2f 22 20 28 69 66 20 28 65 71 75 ame "/" (if (equ
5ba0: 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 al? item-path ""
5bb0: 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 )............
5bc0: 22 25 22 0a 09 09 09 09 09 09 09 09 09 09 09 20 "%"............
5bd0: 20 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 09 item-path))...
5be0: 09 09 09 09 20 20 20 20 20 20 22 3b 6d 65 67 61 .... ";mega
5bf0: 74 65 73 74 20 2d 74 61 72 67 65 74 20 22 20 6b test -target " k
5c00: 65 79 73 74 72 69 6e 67 20 22 20 2d 72 75 6e 6e eystring " -runn
5c10: 61 6d 65 20 22 20 72 75 6e 6e 61 6d 65 20 0a 09 ame " runname ..
5c20: 09 09 09 09 09 20 20 20 20 20 20 22 20 2d 72 75 ..... " -ru
5c30: 6e 74 65 73 74 73 20 22 20 28 63 6f 6e 63 20 74 ntests " (conc t
5c40: 65 73 74 6e 61 6d 65 20 22 2f 22 20 28 69 66 20 estname "/" (if
5c50: 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 (equal? item-pat
5c60: 68 20 22 22 29 0a 09 09 09 09 09 09 09 09 09 09 h "")...........
5c70: 09 20 20 20 22 25 22 20 0a 09 09 09 09 09 09 09 . "%" ........
5c80: 09 09 09 09 20 20 20 69 74 65 6d 2d 70 61 74 68 .... item-path
5c90: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 29 ))....... )
5ca0: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 73 ))..... (s
5cb0: 79 73 74 65 6d 20 28 63 6f 6e 63 20 28 64 74 65 ystem (conc (dte
5cc0: 73 74 73 3a 67 65 74 2d 70 72 65 2d 63 6f 6d 6d sts:get-pre-comm
5cd0: 61 6e 64 29 0a 09 09 09 09 09 09 20 20 20 20 20 and).......
5ce0: 63 6d 64 20 0a 09 09 09 09 09 09 20 20 20 20 20 cmd .......
5cf0: 28 64 74 65 73 74 73 3a 67 65 74 2d 70 6f 73 74 (dtests:get-post
5d00: 2d 63 6f 6d 6d 61 6e 64 29 29 29 29 29 29 0a 09 -command))))))..
5d10: 20 20 20 20 20 20 20 28 72 65 6d 6f 76 65 2d 74 (remove-t
5d20: 65 73 74 20 28 6c 61 6d 62 64 61 20 28 78 29 0a est (lambda (x).
5d30: 09 09 09 20 20 20 20 20 20 28 69 75 70 3a 61 74 ... (iup:at
5d40: 74 72 69 62 75 74 65 2d 73 65 74 21 0a 09 09 09 tribute-set!....
5d50: 20 20 20 20 20 20 20 63 6f 6d 6d 61 6e 64 2d 74 command-t
5d60: 65 78 74 2d 62 6f 78 20 22 56 41 4c 55 45 22 0a ext-box "VALUE".
5d70: 09 09 09 20 20 20 20 20 20 20 28 63 6f 6e 63 20 ... (conc
5d80: 22 6d 65 67 61 74 65 73 74 20 2d 72 65 6d 6f 76 "megatest -remov
5d90: 65 2d 72 75 6e 73 20 2d 74 61 72 67 65 74 20 22 e-runs -target "
5da0: 20 6b 65 79 73 74 72 69 6e 67 20 22 20 2d 72 75 keystring " -ru
5db0: 6e 6e 61 6d 65 20 22 20 72 75 6e 6e 61 6d 65 0a nname " runname.
5dc0: 09 09 09 09 20 20 20 20 20 22 20 2d 74 65 73 74 .... " -test
5dd0: 70 61 74 74 20 22 20 28 63 6f 6e 63 20 74 65 73 patt " (conc tes
5de0: 74 6e 61 6d 65 20 22 2f 22 20 28 69 66 20 28 65 tname "/" (if (e
5df0: 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 qual? item-path
5e00: 22 22 29 0a 09 09 09 09 09 09 09 09 09 20 20 22 "").......... "
5e10: 25 22 0a 09 09 09 09 09 09 09 09 09 20 20 69 74 %".......... it
5e20: 65 6d 2d 70 61 74 68 29 29 0a 09 09 09 09 20 20 em-path)).....
5e30: 20 20 20 22 20 2d 76 22 29 29 0a 09 09 09 20 20 " -v"))....
5e40: 20 20 20 20 29 29 29 0a 09 20 20 28 63 6f 6e 64 ))).. (cond
5e50: 0a 09 20 20 20 28 28 6e 6f 74 20 74 65 73 74 64 .. ((not testd
5e60: 61 74 29 28 62 65 67 69 6e 20 28 70 72 69 6e 74 at)(begin (print
5e70: 20 22 45 52 52 4f 52 3a 20 62 61 64 20 74 65 73 "ERROR: bad tes
5e80: 74 20 69 6e 66 6f 20 66 6f 72 20 22 20 74 65 73 t info for " tes
5e90: 74 2d 69 64 29 28 65 78 69 74 20 31 29 29 29 0a t-id)(exit 1))).
5ea0: 09 20 20 20 28 28 6e 6f 74 20 72 75 6e 64 61 74 . ((not rundat
5eb0: 29 28 62 65 67 69 6e 20 28 70 72 69 6e 74 20 22 )(begin (print "
5ec0: 45 52 52 4f 52 3a 20 66 6f 75 6e 64 20 74 65 73 ERROR: found tes
5ed0: 74 20 69 6e 66 6f 20 62 75 74 20 74 68 65 72 65 t info but there
5ee0: 20 69 73 20 61 20 70 72 6f 62 6c 65 6d 20 77 69 is a problem wi
5ef0: 74 68 20 74 68 65 20 72 75 6e 20 69 6e 66 6f 20 th the run info
5f00: 66 6f 72 20 22 20 72 75 6e 2d 69 64 29 28 65 78 for " run-id)(ex
5f10: 69 74 20 31 29 29 29 0a 09 20 20 20 28 65 6c 73 it 1))).. (els
5f20: 65 0a 09 20 20 20 20 3b 3b 20 20 28 74 65 73 74 e.. ;; (test
5f30: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 -set-status! db
5f40: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
5f50: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 69 74 state status it
5f60: 65 6d 64 61 74 29 0a 09 20 20 20 20 28 73 65 74 emdat).. (set
5f70: 21 20 73 65 6c 66 20 3b 20 0a 09 09 20 20 28 69 ! self ; ... (i
5f80: 75 70 3a 64 69 61 6c 6f 67 20 23 3a 63 6c 6f 73 up:dialog #:clos
5f90: 65 5f 63 62 20 28 6c 61 6d 62 64 61 20 28 61 29 e_cb (lambda (a)
5fa0: 28 65 78 69 74 29 29 20 3b 20 23 3a 65 78 70 61 (exit)) ; #:expa
5fb0: 6e 64 20 22 59 45 53 22 0a 09 09 09 20 20 20 20 nd "YES"....
5fc0: 20 20 23 3a 74 69 74 6c 65 20 74 65 73 74 66 75 #:title testfu
5fd0: 6c 6c 6e 61 6d 65 0a 09 09 09 20 20 20 20 20 20 llname....
5fe0: 28 69 75 70 3a 76 62 6f 78 20 3b 20 23 3a 65 78 (iup:vbox ; #:ex
5ff0: 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 20 20 pand "YES"....
6000: 20 20 20 20 20 3b 3b 20 54 68 65 20 72 75 6e 20 ;; The run
6010: 61 6e 64 20 74 65 73 74 20 69 6e 66 6f 0a 09 09 and test info...
6020: 09 20 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f . (iup:hbo
6030: 78 20 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 x ; #:expand "Y
6040: 45 53 22 0a 09 09 09 09 28 72 75 6e 2d 69 6e 66 ES".....(run-inf
6050: 6f 2d 70 61 6e 65 6c 20 64 62 73 74 72 75 63 74 o-panel dbstruct
6060: 20 6b 65 79 64 61 74 20 74 65 73 74 64 61 74 20 keydat testdat
6070: 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 28 74 65 runname).....(te
6080: 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 6c 20 74 65 st-info-panel te
6090: 73 74 64 61 74 20 73 74 6f 72 65 2d 6c 61 62 65 stdat store-labe
60a0: 6c 20 77 69 64 67 65 74 73 29 0a 09 09 09 09 28 l widgets).....(
60b0: 74 65 73 74 2d 6d 65 74 61 2d 70 61 6e 65 6c 20 test-meta-panel
60c0: 74 65 73 74 6d 65 74 61 20 73 74 6f 72 65 2d 6d testmeta store-m
60d0: 65 74 61 29 29 0a 09 09 09 20 20 20 20 20 20 20 eta))....
60e0: 28 68 6f 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 6c (host-info-panel
60f0: 20 74 65 73 74 64 61 74 20 73 74 6f 72 65 2d 6c testdat store-l
6100: 61 62 65 6c 29 0a 09 09 09 20 20 20 20 20 20 20 abel)....
6110: 3b 3b 20 54 68 65 20 63 6f 6e 74 72 6f 6c 73 0a ;; The controls.
6120: 09 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 66 ... (iup:f
6130: 72 61 6d 65 20 23 3a 74 69 74 6c 65 20 22 41 63 rame #:title "Ac
6140: 74 69 6f 6e 73 22 20 0a 09 09 09 09 09 20 20 28 tions" ...... (
6150: 69 75 70 3a 76 62 6f 78 0a 09 09 09 09 09 20 20 iup:vbox......
6160: 20 28 69 75 70 3a 68 62 6f 78 20 0a 09 09 09 09 (iup:hbox .....
6170: 09 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e . (iup:button
6180: 20 22 56 69 65 77 20 4c 6f 67 22 20 20 20 20 20 "View Log"
6190: 20 23 3a 61 63 74 69 6f 6e 20 76 69 65 77 6c 6f #:action viewlo
61a0: 67 20 20 20 20 20 23 3a 73 69 7a 65 20 22 38 30 g #:size "80
61b0: 78 22 29 0a 09 09 09 09 09 20 20 20 20 28 69 75 x")...... (iu
61c0: 70 3a 62 75 74 74 6f 6e 20 22 53 74 61 72 74 20 p:button "Start
61d0: 58 74 65 72 6d 22 20 20 20 23 3a 61 63 74 69 6f Xterm" #:actio
61e0: 6e 20 78 74 65 72 6d 20 20 20 20 20 20 20 23 3a n xterm #:
61f0: 73 69 7a 65 20 22 38 30 78 22 29 0a 09 09 09 09 size "80x").....
6200: 09 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e . (iup:button
6210: 20 22 52 75 6e 20 54 65 73 74 22 20 20 20 20 20 "Run Test"
6220: 20 23 3a 61 63 74 69 6f 6e 20 72 75 6e 2d 74 65 #:action run-te
6230: 73 74 20 20 20 20 23 3a 73 69 7a 65 20 22 38 30 st #:size "80
6240: 78 22 29 0a 09 09 09 09 09 20 20 20 20 28 69 75 x")...... (iu
6250: 70 3a 62 75 74 74 6f 6e 20 22 43 6c 65 61 6e 20 p:button "Clean
6260: 54 65 73 74 22 20 20 20 20 23 3a 61 63 74 69 6f Test" #:actio
6270: 6e 20 72 65 6d 6f 76 65 2d 74 65 73 74 20 23 3a n remove-test #:
6280: 73 69 7a 65 20 22 38 30 78 22 29 0a 09 09 09 09 size "80x").....
6290: 09 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e . (iup:button
62a0: 20 22 43 6c 65 61 6e 52 75 6e 45 78 65 63 75 74 "CleanRunExecut
62b0: 65 21 22 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 e!" #:action
62c0: 63 6c 65 61 6e 2d 72 75 6e 2d 65 78 65 63 75 74 clean-run-execut
62d0: 65 20 23 3a 73 69 7a 65 20 22 38 30 78 22 29 0a e #:size "80x").
62e0: 09 09 09 09 09 20 20 20 20 28 69 75 70 3a 62 75 ..... (iup:bu
62f0: 74 74 6f 6e 20 22 4b 69 6c 6c 20 41 6c 6c 20 4a tton "Kill All J
6300: 6f 62 73 22 20 23 3a 61 63 74 69 6f 6e 20 6b 69 obs" #:action ki
6310: 6c 6c 2d 6a 6f 62 73 20 20 20 23 3a 73 69 7a 65 ll-jobs #:size
6320: 20 22 38 30 78 22 29 0a 09 09 09 09 09 20 20 20 "80x")......
6330: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 43 6c (iup:button "Cl
6340: 6f 73 65 22 20 20 20 20 20 20 20 20 20 23 3a 61 ose" #:a
6350: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 78 ction (lambda (x
6360: 29 28 65 78 69 74 29 29 20 23 3a 73 69 7a 65 20 )(exit)) #:size
6370: 22 38 30 78 22 29 29 0a 09 09 09 09 09 20 20 20 "80x"))......
6380: 28 61 70 70 6c 79 20 0a 09 09 09 09 09 20 20 20 (apply ......
6390: 20 69 75 70 3a 68 62 6f 78 0a 09 09 09 09 09 20 iup:hbox......
63a0: 20 20 20 28 6c 69 73 74 20 63 6f 6d 6d 61 6e 64 (list command
63b0: 2d 74 65 78 74 2d 62 6f 78 20 63 6f 6d 6d 61 6e -text-box comman
63c0: 64 2d 6c 61 75 6e 63 68 2d 62 75 74 74 6f 6e 29 d-launch-button)
63d0: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 ))).... (s
63e0: 65 74 2d 66 69 65 6c 64 73 2d 70 61 6e 65 6c 20 et-fields-panel
63f0: 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 dbstruct run-id
6400: 74 65 73 74 2d 69 64 20 74 65 73 74 64 61 74 29 test-id testdat)
6410: 0a 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 .... (let
6420: 28 28 74 61 62 73 20 0a 09 09 09 09 20 20 20 20 ((tabs .....
6430: 20 20 28 69 75 70 3a 74 61 62 73 0a 09 09 09 09 (iup:tabs.....
6440: 20 20 20 20 20 20 20 3b 3b 20 52 65 70 6c 61 63 ;; Replac
6450: 65 20 68 65 72 65 20 77 69 74 68 20 6d 61 74 72 e here with matr
6460: 69 78 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c ix..... (l
6470: 65 74 20 28 28 73 74 65 70 73 2d 6d 61 74 72 69 et ((steps-matri
6480: 78 20 28 69 75 70 3a 6d 61 74 72 69 78 0a 09 09 x (iup:matrix...
6490: 09 09 09 09 09 20 20 20 20 23 3a 66 6f 6e 74 20 ..... #:font
64a0: 20 20 22 43 6f 75 72 69 65 72 20 4e 65 77 2c 20 "Courier New,
64b0: 2d 38 22 0a 09 09 09 09 09 09 09 20 20 20 20 23 -8"........ #
64c0: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 :expand "YES"...
64d0: 09 09 09 09 09 20 20 20 20 23 3a 73 63 72 6f 6c ..... #:scrol
64e0: 6c 62 61 72 20 22 59 45 53 22 0a 09 09 09 09 09 lbar "YES"......
64f0: 09 09 20 20 20 20 23 3a 6e 75 6d 63 6f 6c 20 36 .. #:numcol 6
6500: 0a 09 09 09 09 09 09 09 20 20 20 20 23 3a 6e 75 ........ #:nu
6510: 6d 6c 69 6e 20 33 30 0a 09 09 09 09 09 09 09 20 mlin 30........
6520: 20 20 20 23 3a 6e 75 6d 63 6f 6c 2d 76 69 73 69 #:numcol-visi
6530: 62 6c 65 20 36 0a 09 09 09 09 09 09 09 20 20 20 ble 6........
6540: 20 23 3a 6e 75 6d 6c 69 6e 2d 76 69 73 69 62 6c #:numlin-visibl
6550: 65 20 35 0a 09 09 09 09 09 09 09 20 20 20 20 23 e 5........ #
6560: 3a 63 6c 69 63 6b 2d 63 62 20 28 6c 61 6d 62 64 :click-cb (lambd
6570: 61 20 28 6f 62 6a 20 6c 69 6e 20 63 6f 6c 20 73 a (obj lin col s
6580: 74 61 74 75 73 29 0a 09 09 09 09 09 09 09 09 09 tatus)..........
6590: 20 3b 3b 20 28 69 66 20 28 65 71 75 61 6c 3f 20 ;; (if (equal?
65a0: 63 6f 6c 20 36 29 0a 09 09 09 09 09 09 09 09 09 col 6)..........
65b0: 20 28 6c 65 74 2a 20 28 28 6d 74 72 78 2d 72 63 (let* ((mtrx-rc
65c0: 20 28 63 6f 6e 63 20 6c 69 6e 20 22 3a 22 20 36 (conc lin ":" 6
65d0: 29 29 0a 09 09 09 09 09 09 09 09 09 09 28 66 6e ))...........(fn
65e0: 61 6d 65 20 20 20 28 69 75 70 3a 61 74 74 72 69 ame (iup:attri
65f0: 62 75 74 65 20 6f 62 6a 20 6d 74 72 78 2d 72 63 bute obj mtrx-rc
6600: 29 29 29 20 3b 3b 20 63 6f 6c 29 29 29 29 0a 09 ))) ;; col))))..
6610: 09 09 09 09 09 09 09 09 20 20 20 28 69 66 20 28 ........ (if (
6620: 65 71 3f 20 63 6f 6c 20 36 29 0a 09 09 09 09 09 eq? col 6)......
6630: 09 09 09 09 20 20 20 20 20 20 20 28 76 69 65 77 .... (view
6640: 2d 61 2d 6c 6f 67 20 66 6e 61 6d 65 29 0a 09 09 -a-log fname)...
6650: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 69 ....... (i
6660: 75 70 3a 73 68 6f 77 0a 09 09 09 09 09 09 09 09 up:show.........
6670: 09 09 28 64 61 73 68 62 6f 61 72 64 2d 74 65 73 ..(dashboard-tes
6680: 74 73 3a 73 74 65 70 2d 72 75 6e 2d 63 6f 6e 74 ts:step-run-cont
6690: 72 6f 6c 20 0a 09 09 09 09 09 09 09 09 09 09 20 rol ...........
66a0: 74 65 73 74 64 61 74 0a 09 09 09 09 09 09 09 09 testdat.........
66b0: 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 .. (iup:attribut
66c0: 65 20 6f 62 6a 20 28 63 6f 6e 63 20 6c 69 6e 20 e obj (conc lin
66d0: 22 3a 22 20 31 29 29 20 0a 09 09 09 09 09 09 09 ":" 1)) ........
66e0: 09 09 09 20 74 65 73 74 73 74 65 70 73 29 29 29 ... teststeps)))
66f0: 29 29 29 29 29 0a 09 09 09 09 09 20 3b 3b 20 28 )))))...... ;; (
6700: 6c 65 74 20 6c 6f 6f 70 20 28 28 63 6f 75 6e 74 let loop ((count
6710: 20 30 29 29 0a 09 09 09 09 09 20 3b 3b 20 20 20 0))...... ;;
6720: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
6730: 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 et! steps-matrix
6740: 20 22 46 49 54 54 4f 54 45 58 54 22 20 28 63 6f "FITTOTEXT" (co
6750: 6e 63 20 22 4c 22 20 63 6f 75 6e 74 29 29 0a 09 nc "L" count))..
6760: 09 09 09 09 20 3b 3b 20 20 20 28 69 66 20 28 3c .... ;; (if (<
6770: 20 63 6f 75 6e 74 20 33 30 29 0a 09 09 09 09 09 count 30)......
6780: 20 3b 3b 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 ;; (loop
6790: 28 2b 20 63 6f 75 6e 74 20 31 29 29 29 29 0a 09 (+ count 1))))..
67a0: 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 .... (iup:attrib
67b0: 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d 6d ute-set! steps-m
67c0: 61 74 72 69 78 20 22 30 3a 31 22 20 22 53 74 65 atrix "0:1" "Ste
67d0: 70 20 4e 61 6d 65 22 29 0a 09 09 09 09 09 20 28 p Name")...... (
67e0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
67f0: 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 t! steps-matrix
6800: 22 30 3a 32 22 20 22 53 74 61 72 74 22 29 0a 09 "0:2" "Start")..
6810: 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 .... (iup:attrib
6820: 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d 6d ute-set! steps-m
6830: 61 74 72 69 78 20 22 30 3a 33 22 20 22 45 6e 64 atrix "0:3" "End
6840: 22 29 0a 09 09 09 09 09 20 28 69 75 70 3a 61 74 ")...... (iup:at
6850: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 tribute-set! ste
6860: 70 73 2d 6d 61 74 72 69 78 20 22 57 49 44 54 48 ps-matrix "WIDTH
6870: 33 22 20 22 35 30 22 29 0a 09 09 09 09 09 20 28 3" "50")...... (
6880: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
6890: 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 t! steps-matrix
68a0: 22 30 3a 34 22 20 22 53 74 61 74 75 73 22 29 0a "0:4" "Status").
68b0: 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 ..... (iup:attri
68c0: 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d bute-set! steps-
68d0: 6d 61 74 72 69 78 20 22 57 49 44 54 48 34 22 20 matrix "WIDTH4"
68e0: 22 35 30 22 29 0a 09 09 09 09 09 20 28 69 75 70 "50")...... (iup
68f0: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
6900: 73 74 65 70 73 2d 6d 61 74 72 69 78 20 22 30 3a steps-matrix "0:
6910: 35 22 20 22 44 75 72 61 74 69 6f 6e 22 29 0a 09 5" "Duration")..
6920: 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 .... (iup:attrib
6930: 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d 6d ute-set! steps-m
6940: 61 74 72 69 78 20 22 30 3a 36 22 20 22 4c 6f 67 atrix "0:6" "Log
6950: 20 46 69 6c 65 22 29 0a 09 09 09 09 09 20 28 69 File")...... (i
6960: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
6970: 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 22 ! steps-matrix "
6980: 41 4c 49 47 4e 4d 45 4e 54 31 22 20 22 41 4c 45 ALIGNMENT1" "ALE
6990: 46 54 22 29 0a 09 09 09 09 09 20 3b 3b 20 28 69 FT")...... ;; (i
69a0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
69b0: 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 22 ! steps-matrix "
69c0: 46 49 58 54 4f 54 45 58 54 22 20 22 43 31 22 29 FIXTOTEXT" "C1")
69d0: 0a 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 ...... (iup:attr
69e0: 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 ibute-set! steps
69f0: 2d 6d 61 74 72 69 78 20 22 52 45 53 49 5a 45 4d -matrix "RESIZEM
6a00: 41 54 52 49 58 22 20 22 59 45 53 22 29 0a 09 09 ATRIX" "YES")...
6a10: 09 09 09 20 28 6c 65 74 20 28 28 70 72 6f 63 0a ... (let ((proc.
6a20: 09 09 09 09 09 09 28 6c 61 6d 62 64 61 20 28 74 ......(lambda (t
6a30: 65 73 74 64 61 74 29 0a 09 09 09 09 09 09 20 20 estdat).......
6a40: 28 64 63 6f 6d 6d 6f 6e 3a 70 6f 70 75 6c 61 74 (dcommon:populat
6a50: 65 2d 73 74 65 70 73 20 74 65 73 74 73 74 65 70 e-steps teststep
6a60: 73 20 73 74 65 70 73 2d 6d 61 74 72 69 78 29 29 s steps-matrix))
6a70: 29 29 0a 09 09 09 09 09 20 20 20 28 68 61 73 68 ))...... (hash
6a80: 2d 74 61 62 6c 65 2d 73 65 74 21 20 77 69 64 67 -table-set! widg
6a90: 65 74 73 20 22 53 74 65 70 73 4d 61 74 72 69 78 ets "StepsMatrix
6aa0: 22 20 70 72 6f 63 29 0a 09 09 09 09 09 20 20 20 " proc)......
6ab0: 28 70 72 6f 63 20 74 65 73 74 64 61 74 29 29 0a (proc testdat)).
6ac0: 09 09 09 09 09 20 73 74 65 70 73 2d 6d 61 74 72 ..... steps-matr
6ad0: 69 78 29 0a 09 09 09 09 20 20 20 20 20 20 20 3b ix)..... ;
6ae0: 3b 20 70 6f 70 75 6c 61 74 65 20 74 68 65 20 54 ; populate the T
6af0: 65 73 74 20 44 61 74 61 20 70 61 6e 65 6c 0a 09 est Data panel..
6b00: 09 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 66 ... (iup:f
6b10: 72 61 6d 65 0a 09 09 09 09 09 23 3a 74 69 74 6c rame......#:titl
6b20: 65 20 22 54 65 73 74 20 44 61 74 61 22 0a 09 09 e "Test Data"...
6b30: 09 09 09 28 6c 65 74 20 28 28 74 65 73 74 2d 64 ...(let ((test-d
6b40: 61 74 61 0a 09 09 09 09 09 20 20 20 20 20 20 20 ata......
6b50: 28 69 75 70 3a 74 65 78 74 62 6f 78 20 20 3b 3b (iup:textbox ;;
6b60: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
6b70: 61 20 28 6f 62 6a 20 63 68 61 72 20 76 61 6c 29 a (obj char val)
6b80: 0a 09 09 09 09 09 09 3b 3b 20 20 20 09 23 66 29 .......;; .#f)
6b90: 0a 09 09 09 09 09 09 23 3a 65 78 70 61 6e 64 20 .......#:expand
6ba0: 22 59 45 53 22 0a 09 09 09 09 09 09 23 3a 6d 75 "YES".......#:mu
6bb0: 6c 74 69 6c 69 6e 65 20 22 59 45 53 22 0a 09 09 ltiline "YES"...
6bc0: 09 09 09 09 23 3a 66 6f 6e 74 20 22 43 6f 75 72 ....#:font "Cour
6bd0: 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 0a 09 09 ier New, -10"...
6be0: 09 09 09 09 23 3a 73 69 7a 65 20 22 31 30 30 78 ....#:size "100x
6bf0: 31 30 30 22 29 29 29 0a 09 09 09 09 09 20 20 28 100")))...... (
6c00: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
6c10: 77 69 64 67 65 74 73 20 22 54 65 73 74 20 44 61 widgets "Test Da
6c20: 74 61 22 0a 09 09 09 09 09 09 09 20 20 20 28 6c ta"........ (l
6c30: 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 20 ambda (testdat)
6c40: 3b 3b 20 0a 09 09 09 09 09 09 09 20 20 20 20 20 ;; ........
6c50: 28 6c 65 74 2a 20 28 28 63 75 72 72 76 61 6c 20 (let* ((currval
6c60: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 74 (iup:attribute t
6c70: 65 73 74 2d 64 61 74 61 20 22 56 41 4c 55 45 22 est-data "VALUE"
6c80: 29 29 20 3b 3b 20 22 54 49 54 4c 45 22 29 29 0a )) ;; "TITLE")).
6c90: 09 09 09 09 09 09 09 09 20 20 20 20 28 66 6d 74 ........ (fmt
6ca0: 73 74 72 20 20 22 7e 31 30 61 7e 31 30 61 7e 31 str "~10a~10a~1
6cb0: 30 61 7e 31 30 61 7e 37 61 7e 37 61 7e 36 61 7e 0a~10a~7a~7a~6a~
6cc0: 36 61 7e 61 22 29 20 3b 3b 20 63 61 74 65 67 6f 6a~a") ;; catego
6cd0: 72 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 6c 75 ry,variable,valu
6ce0: 65 2c 65 78 70 65 63 74 65 64 2c 74 6f 6c 2c 75 e,expected,tol,u
6cf0: 6e 69 74 73 2c 74 79 70 65 2c 63 6f 6d 6d 65 6e nits,type,commen
6d00: 74 0a 09 09 09 09 09 09 09 09 20 20 20 20 28 6e t......... (n
6d10: 65 77 76 61 6c 20 20 28 73 74 72 69 6e 67 2d 69 ewval (string-i
6d20: 6e 74 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 ntersperse .....
6d30: 09 09 09 09 09 20 20 20 20 20 20 28 61 70 70 65 ..... (appe
6d40: 6e 64 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 nd..........
6d50: 20 20 20 28 6c 69 73 74 20 0a 09 09 09 09 09 09 (list .......
6d60: 09 09 09 09 28 66 6f 72 6d 61 74 20 23 66 20 66 ....(format #f f
6d70: 6d 74 73 74 72 20 22 43 61 74 65 67 6f 72 79 22 mtstr "Category"
6d80: 20 22 56 61 72 69 61 62 6c 65 22 20 22 56 61 6c "Variable" "Val
6d90: 75 65 22 20 22 45 78 70 65 63 74 65 64 22 20 22 ue" "Expected" "
6da0: 54 6f 6c 22 20 22 53 74 61 74 75 73 22 20 22 55 Tol" "Status" "U
6db0: 6e 69 74 73 22 20 22 54 79 70 65 22 20 22 43 6f nits" "Type" "Co
6dc0: 6d 6d 65 6e 74 22 29 0a 09 09 09 09 09 09 09 09 mment").........
6dd0: 09 09 28 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 ..(format #f fmt
6de0: 73 74 72 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 str "========" "
6df0: 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d ========" "=====
6e00: 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d " "========" "==
6e10: 3d 22 20 22 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d =" "======" "===
6e20: 3d 3d 22 20 22 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d ==" "====" "====
6e30: 3d 3d 3d 22 29 29 0a 09 09 09 09 09 09 09 09 09 ==="))..........
6e40: 20 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d (map (lam
6e50: 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 09 bda (x).........
6e60: 09 09 20 20 20 20 20 20 28 66 6f 72 6d 61 74 20 .. (format
6e70: 23 66 20 66 6d 74 73 74 72 0a 09 09 09 09 09 09 #f fmtstr.......
6e80: 09 09 09 09 09 20 20 20 20 20 20 28 64 62 3a 74 ..... (db:t
6e90: 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 63 61 74 est-data-get-cat
6ea0: 65 67 6f 72 79 20 78 29 0a 09 09 09 09 09 09 09 egory x)........
6eb0: 09 09 09 09 20 20 20 20 20 20 28 64 62 3a 74 65 .... (db:te
6ec0: 73 74 2d 64 61 74 61 2d 67 65 74 2d 76 61 72 69 st-data-get-vari
6ed0: 61 62 6c 65 20 78 29 0a 09 09 09 09 09 09 09 09 able x).........
6ee0: 09 09 09 20 20 20 20 20 20 28 64 62 3a 74 65 73 ... (db:tes
6ef0: 74 2d 64 61 74 61 2d 67 65 74 2d 76 61 6c 75 65 t-data-get-value
6f00: 20 20 20 20 78 29 0a 09 09 09 09 09 09 09 09 09 x)..........
6f10: 09 09 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 .. (db:test
6f20: 2d 64 61 74 61 2d 67 65 74 2d 65 78 70 65 63 74 -data-get-expect
6f30: 65 64 20 78 29 0a 09 09 09 09 09 09 09 09 09 09 ed x)...........
6f40: 09 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d . (db:test-
6f50: 64 61 74 61 2d 67 65 74 2d 74 6f 6c 20 20 20 20 data-get-tol
6f60: 20 20 78 29 0a 09 09 09 09 09 09 09 09 09 09 09 x)............
6f70: 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 64 (db:test-d
6f80: 61 74 61 2d 67 65 74 2d 73 74 61 74 75 73 20 20 ata-get-status
6f90: 20 78 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 x)............
6fa0: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 64 61 (db:test-da
6fb0: 74 61 2d 67 65 74 2d 75 6e 69 74 73 20 20 20 20 ta-get-units
6fc0: 78 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 x)............
6fd0: 20 20 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 (db:test-dat
6fe0: 61 2d 67 65 74 2d 74 79 70 65 20 20 20 20 20 78 a-get-type x
6ff0: 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 )............
7000: 20 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 (db:test-data
7010: 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 20 78 29 -get-comment x)
7020: 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 ))...........
7030: 20 28 74 64 62 3a 6f 70 65 6e 2d 72 75 6e 2d 63 (tdb:open-run-c
7040: 6c 6f 73 65 2d 64 62 2d 62 79 2d 74 65 73 74 2d lose-db-by-test-
7050: 69 64 2d 6c 6f 63 61 6c 20 64 62 73 74 72 75 63 id-local dbstruc
7060: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 t run-id test-id
7070: 20 23 66 20 74 64 62 3a 72 65 61 64 2d 74 65 73 #f tdb:read-tes
7080: 74 2d 64 61 74 61 20 74 65 73 74 2d 69 64 20 22 t-data test-id "
7090: 25 22 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 %")))..........
70a0: 20 20 20 20 20 22 5c 6e 22 29 29 29 0a 09 09 09 "\n")))....
70b0: 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 .... (if (
70c0: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 63 75 72 72 not (equal? curr
70d0: 76 61 6c 20 6e 65 77 76 61 6c 29 29 0a 09 09 09 val newval))....
70e0: 09 09 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 ..... (iup:att
70f0: 72 69 62 75 74 65 2d 73 65 74 21 20 74 65 73 74 ribute-set! test
7100: 2d 64 61 74 61 20 22 56 41 4c 55 45 22 20 6e 65 -data "VALUE" ne
7110: 77 76 61 6c 20 29 29 29 29 29 20 3b 3b 20 22 54 wval ))))) ;; "T
7120: 49 54 4c 45 22 20 6e 65 77 76 61 6c 29 29 29 29 ITLE" newval))))
7130: 29 0a 09 09 09 09 09 20 20 74 65 73 74 2d 64 61 )...... test-da
7140: 74 61 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 ta)).....
7150: 3b 3b 28 64 61 73 68 62 6f 61 72 64 3a 72 75 6e ;;(dashboard:run
7160: 2d 63 6f 6e 74 72 6f 6c 73 29 0a 09 09 09 09 20 -controls).....
7170: 20 20 20 20 20 20 29 29 29 0a 09 09 09 09 20 28 )))..... (
7180: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
7190: 74 21 20 74 61 62 73 20 22 54 41 42 54 49 54 4c t! tabs "TABTITL
71a0: 45 30 22 20 22 53 74 65 70 73 22 29 0a 09 09 09 E0" "Steps")....
71b0: 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 . (iup:attribute
71c0: 2d 73 65 74 21 20 74 61 62 73 20 22 54 41 42 54 -set! tabs "TABT
71d0: 49 54 4c 45 31 22 20 22 54 65 73 74 20 44 61 74 ITLE1" "Test Dat
71e0: 61 22 29 0a 09 09 09 09 20 74 61 62 73 29 29 29 a")..... tabs)))
71f0: 29 0a 09 20 20 20 20 28 69 75 70 3a 73 68 6f 77 ).. (iup:show
7200: 20 73 65 6c 66 29 0a 09 20 20 20 20 28 69 75 70 self).. (iup
7210: 3a 63 61 6c 6c 62 61 63 6b 2d 73 65 74 21 20 2a :callback-set! *
7220: 74 69 6d 2a 20 22 41 43 54 49 4f 4e 5f 43 42 22 tim* "ACTION_CB"
7230: 0a 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 .... (lamb
7240: 64 61 20 28 78 29 0a 09 09 09 09 20 3b 3b 20 4e da (x)..... ;; N
7250: 6f 77 20 73 74 61 72 74 20 6b 65 65 70 69 6e 67 ow start keeping
7260: 20 74 68 65 20 67 75 69 20 75 70 64 61 74 65 64 the gui updated
7270: 20 66 72 6f 6d 20 74 68 65 20 64 62 0a 09 09 09 from the db....
7280: 09 20 28 72 65 66 72 65 73 68 64 61 74 29 20 3b . (refreshdat) ;
7290: 3b 20 75 70 64 61 74 65 20 66 72 6f 6d 20 74 68 ; update from th
72a0: 65 20 64 62 20 68 65 72 65 0a 09 09 09 09 09 3b e db here......;
72b0: 28 74 68 72 65 61 64 2d 73 75 73 70 65 6e 64 21 (thread-suspend!
72c0: 20 6f 74 68 65 72 2d 74 68 72 65 61 64 29 0a 09 other-thread)..
72d0: 09 09 09 20 28 69 66 20 2a 65 78 69 74 2d 73 74 ... (if *exit-st
72e0: 61 72 74 65 64 2a 0a 09 09 09 09 20 20 20 20 20 arted*.....
72f0: 28 73 65 74 21 20 2a 65 78 69 74 2d 73 74 61 72 (set! *exit-star
7300: 74 65 64 2a 20 27 6f 6b 29 29 29 29 29 29 29 29 ted* 'ok))))))))
7310: 29 29 0a 0a ))..