Artifact
bebf3dddffb6f0b1cf2dc5bb307d8d6f9feb2ebe:
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 54 68 69 73 20 66 69 ..;; .;; This fi
0080: 6c 65 20 69 73 20 70 61 72 74 20 6f 66 20 4d 65 le is part of Me
0090: 67 61 74 65 73 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 gatest..;; .;;
00a0: 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 20 66 Megatest is f
00b0: 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f ree software: yo
00c0: 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 u can redistribu
00d0: 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 te it and/or mod
00e0: 69 66 79 0a 3b 3b 20 20 20 20 20 69 74 20 75 6e ify.;; it un
00f0: 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 der the terms of
0100: 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c the GNU General
0110: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0120: 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 79 0a as published by.
0130: 3b 3b 20 20 20 20 20 74 68 65 20 46 72 65 65 20 ;; the Free
0140: 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 Software Foundat
0150: 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 ion, either vers
0160: 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 ion 3 of the Lic
0170: 65 6e 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 20 20 ense, or.;;
0180: 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 (at your option)
0190: 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69 any later versi
01a0: 6f 6e 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d on..;; .;; M
01b0: 65 67 61 74 65 73 74 20 69 73 20 64 69 73 74 72 egatest is distr
01c0: 69 62 75 74 65 64 20 69 6e 20 74 68 65 20 68 6f ibuted in the ho
01d0: 70 65 20 74 68 61 74 20 69 74 20 77 69 6c 6c 20 pe that it will
01e0: 62 65 20 75 73 65 66 75 6c 2c 0a 3b 3b 20 20 20 be useful,.;;
01f0: 20 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e but WITHOUT AN
0200: 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 Y WARRANTY; with
0210: 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 out even the imp
0220: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0230: 0a 3b 3b 20 20 20 20 20 4d 45 52 43 48 41 4e 54 .;; MERCHANT
0240: 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 ABILITY or FITNE
0250: 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 SS FOR A PARTICU
0260: 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65 LAR PURPOSE. Se
0270: 65 20 74 68 65 0a 3b 3b 20 20 20 20 20 47 4e 55 e the.;; GNU
0280: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
0290: 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 License for more
02a0: 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b details..;; .;;
02b0: 20 20 20 20 20 59 6f 75 20 73 68 6f 75 6c 64 20 You should
02c0: 68 61 76 65 20 72 65 63 65 69 76 65 64 20 61 20 have received a
02d0: 63 6f 70 79 20 6f 66 20 74 68 65 20 47 4e 55 20 copy of the GNU
02e0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
02f0: 69 63 65 6e 73 65 0a 3b 3b 20 20 20 20 20 61 6c icense.;; al
0300: 6f 6e 67 20 77 69 74 68 20 4d 65 67 61 74 65 73 ong with Megates
0310: 74 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 20 t. If not, see
0320: 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e <http://www.gnu.
0330: 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a org/licenses/>..
0340: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
0350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d 3d =========..;;===
0390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03d0: 3d 3d 3d 0a 3b 3b 20 54 65 73 74 20 69 6e 66 6f ===.;; Test info
03e0: 20 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d panel.;;=======
03f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
0430: 0a 28 64 65 63 6c 61 72 65 20 28 75 6e 69 74 20 .(declare (unit
0440: 64 61 73 68 62 6f 61 72 64 2d 74 65 73 74 73 29 dashboard-tests)
0450: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0460: 20 63 6f 6d 6d 6f 6e 6d 6f 64 29 29 0a 28 64 65 commonmod)).(de
0470: 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 6d 6f clare (uses dbmo
0480: 64 29 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 d)).;; (declare
0490: 28 75 73 65 73 20 67 75 74 69 6c 73 29 29 0a 28 (uses gutils)).(
04a0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 72 6d declare (uses rm
04b0: 74 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72 65 20 tmod)).(declare
04c0: 28 75 73 65 73 20 65 7a 73 74 65 70 73 6d 6f 64 (uses ezstepsmod
04d0: 29 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 )).;; (declare (
04e0: 75 73 65 73 20 73 64 62 29 29 0a 3b 3b 20 28 64 uses sdb)).;; (d
04f0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 66 69 6c eclare (uses fil
0500: 65 64 62 29 29 0a 28 64 65 63 6c 61 72 65 20 28 edb)).(declare (
0510: 75 73 65 73 20 73 75 62 72 75 6e 6d 6f 64 29 29 uses subrunmod))
0520: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0530: 64 65 62 75 67 70 72 69 6e 74 29 29 0a 28 64 65 debugprint)).(de
0540: 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f 6e 66 clare (uses conf
0550: 69 67 66 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72 igfmod)).(declar
0560: 65 20 28 75 73 65 73 20 74 65 73 74 73 6d 6f 64 e (uses testsmod
0570: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
0580: 73 20 6d 74 6d 6f 64 29 29 0a 28 64 65 63 6c 61 s mtmod)).(decla
0590: 72 65 20 28 75 73 65 73 20 64 63 6f 6d 6d 6f 6e re (uses dcommon
05a0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
05b0: 73 20 6c 61 75 6e 63 68 6d 6f 64 29 29 0a 0a 28 s launchmod))..(
05c0: 6d 6f 64 75 6c 65 20 64 61 73 68 62 6f 61 72 64 module dashboard
05d0: 2d 74 65 73 74 73 0a 09 20 20 28 0a 6d 65 73 73 -tests.. (.mess
05e0: 61 67 65 2d 77 69 6e 64 6f 77 0a 74 65 73 74 2d age-window.test-
05f0: 69 6e 66 6f 2d 70 61 6e 65 6c 0a 74 65 73 74 2d info-panel.test-
0600: 6d 65 74 61 2d 70 61 6e 65 6c 2d 67 65 74 2d 64 meta-panel-get-d
0610: 65 73 63 72 69 70 74 69 6f 6e 0a 74 65 73 74 2d escription.test-
0620: 6d 65 74 61 2d 70 61 6e 65 6c 0a 72 75 6e 2d 69 meta-panel.run-i
0630: 6e 66 6f 2d 70 61 6e 65 6c 0a 68 6f 73 74 2d 69 nfo-panel.host-i
0640: 6e 66 6f 2d 70 61 6e 65 6c 0a 73 75 62 6d 65 67 nfo-panel.submeg
0650: 61 74 65 73 74 2d 70 61 6e 65 6c 0a 75 70 64 61 atest-panel.upda
0660: 74 65 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d te-state-status-
0670: 62 75 74 74 6f 6e 73 0a 73 65 74 2d 66 69 65 6c buttons.set-fiel
0680: 64 73 2d 70 61 6e 65 6c 0a 64 61 73 68 62 6f 61 ds-panel.dashboa
0690: 72 64 2d 74 65 73 74 73 3a 72 75 6e 2d 61 2d 73 rd-tests:run-a-s
06a0: 74 65 70 0a 64 61 73 68 62 6f 61 72 64 2d 74 65 tep.dashboard-te
06b0: 73 74 73 3a 77 61 69 76 65 72 0a 64 61 73 68 62 sts:waiver.dashb
06c0: 6f 61 72 64 2d 74 65 73 74 73 3a 65 78 61 6d 69 oard-tests:exami
06d0: 6e 65 2d 74 65 73 74 0a 63 6f 6c 6f 72 73 2d 73 ne-test.colors-s
06e0: 69 6d 69 6c 61 72 3f 0a 64 61 73 68 62 6f 61 72 imilar?.dashboar
06f0: 64 3a 64 72 61 77 2d 74 65 73 74 73 0a 64 62 6f d:draw-tests.dbo
0700: 61 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d ard:tabdat-test-
0710: 70 61 74 74 73 2d 75 73 65 0a 64 61 73 68 62 6f patts-use.dashbo
0720: 61 72 64 3a 75 70 64 61 74 65 2d 72 75 6e 2d 63 ard:update-run-c
0730: 6f 6d 6d 61 6e 64 0a 69 75 70 6c 69 73 74 62 6f ommand.iuplistbo
0740: 78 2d 66 69 6c 6c 2d 6c 69 73 74 0a 2a 74 69 6d x-fill-list.*tim
0750: 2a 0a 2a 64 61 73 68 62 6f 61 72 64 2d 63 6f 6d *.*dashboard-com
0760: 6d 65 6e 74 2d 73 68 61 72 65 2d 73 6c 6f 74 2a ment-share-slot*
0770: 0a 2a 73 74 61 74 65 2d 73 74 61 74 75 73 2a 0a .*state-status*.
0780: 2a 64 61 73 68 62 6f 61 72 64 2d 74 65 73 74 2d *dashboard-test-
0790: 64 62 2a 0a 2a 64 61 73 68 62 6f 61 72 64 2d 63 db*.*dashboard-c
07a0: 6f 6d 6d 65 6e 74 2d 73 68 61 72 65 2d 73 6c 6f omment-share-slo
07b0: 74 2a 0a 29 0a 0a 0a 28 69 6d 70 6f 72 74 20 73 t*.)...(import s
07c0: 63 68 65 6d 65 0a 09 63 68 69 63 6b 65 6e 2e 66 cheme..chicken.f
07d0: 69 6c 65 2e 70 6f 73 69 78 0a 09 63 68 69 63 6b ile.posix..chick
07e0: 65 6e 2e 62 61 73 65 0a 09 63 68 69 63 6b 65 6e en.base..chicken
07f0: 2e 73 74 72 69 6e 67 0a 09 63 68 69 63 6b 65 6e .string..chicken
0800: 2e 63 6f 6e 64 69 74 69 6f 6e 0a 09 63 68 69 63 .condition..chic
0810: 6b 65 6e 2e 66 69 6c 65 0a 09 63 68 69 63 6b 65 ken.file..chicke
0820: 6e 2e 70 72 6f 63 65 73 73 2d 63 6f 6e 74 65 78 n.process-contex
0830: 74 0a 09 63 68 69 63 6b 65 6e 2e 74 69 6d 65 0a t..chicken.time.
0840: 09 0a 09 66 6f 72 6d 61 74 0a 09 66 6d 74 0a 09 ...format..fmt..
0850: 28 70 72 65 66 69 78 20 69 75 70 20 69 75 70 3a (prefix iup iup:
0860: 29 0a 09 63 61 6e 76 61 73 2d 64 72 61 77 0a 09 )..canvas-draw..
0870: 73 72 66 69 2d 31 0a 09 73 72 66 69 2d 31 38 0a srfi-1..srfi-18.
0880: 09 72 65 67 65 78 20 72 65 67 65 78 2d 63 61 73 .regex regex-cas
0890: 65 20 73 72 66 69 2d 36 39 0a 09 28 70 72 65 66 e srfi-69..(pref
08a0: 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 ix sqlite3 sqlit
08b0: 65 33 3a 29 29 0a 0a 3b 3b 20 28 69 6e 63 6c 75 e3:))..;; (inclu
08c0: 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 de "common_recor
08d0: 64 73 2e 73 63 6d 22 29 0a 3b 3b 20 28 69 6e 63 ds.scm").;; (inc
08e0: 6c 75 64 65 20 22 64 62 5f 72 65 63 6f 72 64 73 lude "db_records
08f0: 2e 73 63 6d 22 29 0a 3b 3b 20 28 69 6e 63 6c 75 .scm").;; (inclu
0900: 64 65 20 22 72 75 6e 5f 72 65 63 6f 72 64 73 2e de "run_records.
0910: 73 63 6d 22 29 0a 0a 28 69 6d 70 6f 72 74 20 63 scm")..(import c
0920: 6f 6d 6d 6f 6e 6d 6f 64 0a 09 64 63 6f 6d 6d 6f ommonmod..dcommo
0930: 6e 0a 09 64 62 6d 6f 64 0a 09 72 6d 74 6d 6f 64 n..dbmod..rmtmod
0940: 0a 09 65 7a 73 74 65 70 73 6d 6f 64 0a 09 73 75 ..ezstepsmod..su
0950: 62 72 75 6e 6d 6f 64 0a 09 64 65 62 75 67 70 72 brunmod..debugpr
0960: 69 6e 74 0a 3b 3b 09 67 75 74 69 6c 73 0a 09 63 int.;;.gutils..c
0970: 6f 6e 66 69 67 66 6d 6f 64 0a 09 74 65 73 74 73 onfigfmod..tests
0980: 6d 6f 64 0a 09 6d 74 6d 6f 64 0a 09 6c 61 75 6e mod..mtmod..laun
0990: 63 68 6d 6f 64 0a 09 29 0a 0a 3b 3b 3d 3d 3d 3d chmod..)..;;====
09a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09e0: 3d 3d 0a 3b 3b 20 43 20 4f 20 4d 20 4d 20 4f 20 ==.;; C O M M O
09f0: 4e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d N.;;============
0a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 66 69 ==========.(defi
0a40: 6e 65 20 2a 74 69 6d 2a 20 28 69 75 70 3a 74 69 ne *tim* (iup:ti
0a50: 6d 65 72 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a mer))..(define *
0a60: 64 61 73 68 62 6f 61 72 64 2d 63 6f 6d 6d 65 6e dashboard-commen
0a70: 74 2d 73 68 61 72 65 2d 73 6c 6f 74 2a 20 23 66 t-share-slot* #f
0a80: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 65 73 73 )..(define (mess
0a90: 61 67 65 2d 77 69 6e 64 6f 77 20 6d 73 67 29 0a age-window msg).
0aa0: 20 20 28 69 75 70 3a 73 68 6f 77 0a 20 20 20 28 (iup:show. (
0ab0: 69 75 70 3a 64 69 61 6c 6f 67 0a 20 20 20 20 28 iup:dialog. (
0ac0: 69 75 70 3a 76 62 6f 78 20 0a 20 20 20 20 20 28 iup:vbox . (
0ad0: 69 75 70 3a 6c 61 62 65 6c 20 6d 73 67 20 23 3a iup:label msg #:
0ae0: 6d 61 72 67 69 6e 20 22 34 30 78 34 30 22 29 29 margin "40x40"))
0af0: 29 29 29 0a 0a 3b 3b 20 28 64 65 66 69 6e 65 20 )))..;; (define
0b00: 28 64 74 65 73 74 73 3a 67 65 74 2d 70 72 65 2d (dtests:get-pre-
0b10: 63 6f 6d 6d 61 6e 64 20 23 21 6b 65 79 20 28 64 command #!key (d
0b20: 65 66 61 75 6c 74 2d 6f 76 65 72 72 69 64 65 20 efault-override
0b30: 23 66 29 29 0a 3b 3b 20 20 20 28 6c 65 74 2a 20 #f)).;; (let*
0b40: 28 28 6f 72 69 67 2d 70 72 65 2d 63 6f 6d 6d 61 ((orig-pre-comma
0b50: 6e 64 20 22 65 78 70 6f 72 74 20 43 4d 44 3d 27 nd "export CMD='
0b60: 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 28 ").;; (
0b70: 76 69 65 77 73 63 72 65 65 6e 2d 70 72 65 2d 63 viewscreen-pre-c
0b80: 6f 6d 6d 61 6e 64 20 20 22 76 69 65 77 73 63 72 ommand "viewscr
0b90: 65 65 6e 20 22 29 0a 3b 3b 20 20 20 20 20 20 20 een ").;;
0ba0: 20 20 20 28 75 73 65 2d 76 69 65 77 73 63 72 65 (use-viewscre
0bb0: 65 6e 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b en (configf:look
0bc0: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
0bd0: 64 61 73 68 62 6f 61 72 64 22 20 22 75 73 65 2d dashboard" "use-
0be0: 76 69 65 77 73 63 72 65 65 6e 22 29 29 0a 3b 3b viewscreen")).;;
0bf0: 20 20 20 20 20 20 20 20 20 20 28 64 65 66 61 75 (defau
0c00: 6c 74 2d 70 72 65 2d 63 6f 6d 6d 61 6e 64 20 28 lt-pre-command (
0c10: 69 66 20 75 73 65 2d 76 69 65 77 73 63 72 65 65 if use-viewscree
0c20: 6e 20 76 69 65 77 73 63 72 65 65 6e 2d 70 72 65 n viewscreen-pre
0c30: 2d 63 6f 6d 6d 61 6e 64 20 6f 72 69 67 2d 70 72 -command orig-pr
0c40: 65 2d 63 6f 6d 6d 61 6e 64 29 29 0a 3b 3b 20 20 e-command)).;;
0c50: 20 20 20 20 20 20 20 20 28 63 66 67 2d 6f 76 72 (cfg-ovr
0c60: 64 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 d (configf:looku
0c70: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 64 p *configdat* "d
0c80: 61 73 68 62 6f 61 72 64 22 20 22 70 72 65 2d 63 ashboard" "pre-c
0c90: 6f 6d 6d 61 6e 64 22 29 29 29 0a 3b 3b 20 20 20 ommand"))).;;
0ca0: 20 20 28 6f 72 20 63 66 67 2d 6f 76 72 64 20 64 (or cfg-ovrd d
0cb0: 65 66 61 75 6c 74 2d 6f 76 65 72 72 69 64 65 20 efault-override
0cc0: 64 65 66 61 75 6c 74 2d 70 72 65 2d 63 6f 6d 6d default-pre-comm
0cd0: 61 6e 64 29 29 29 20 3b 3b 20 22 78 74 65 72 6d and))) ;; "xterm
0ce0: 20 2d 67 65 6f 6d 65 74 72 79 20 31 38 30 78 32 -geometry 180x2
0cf0: 30 20 2d 65 20 5c 22 22 29 29 0a 3b 3b 20 0a 3b 0 -e \"")).;; .;
0d00: 3b 20 20 20 0a 3b 3b 20 28 64 65 66 69 6e 65 20 ; .;; (define
0d10: 28 64 74 65 73 74 73 3a 67 65 74 2d 70 6f 73 74 (dtests:get-post
0d20: 2d 63 6f 6d 6d 61 6e 64 20 23 21 6b 65 79 20 28 -command #!key (
0d30: 64 65 66 61 75 6c 74 2d 6f 76 65 72 72 69 64 65 default-override
0d40: 20 23 66 29 29 0a 3b 3b 20 20 20 28 6c 65 74 2a #f)).;; (let*
0d50: 20 28 28 6f 72 69 67 2d 70 6f 73 74 2d 63 6f 6d ((orig-post-com
0d60: 6d 61 6e 64 20 28 63 6f 6e 63 20 22 27 3b 78 74 mand (conc "';xt
0d70: 65 72 6d 20 2d 67 65 6f 6d 65 74 72 79 20 31 38 erm -geometry 18
0d80: 30 78 32 30 20 2d 65 20 5c 22 28 65 63 68 6f 3b 0x20 -e \"(echo;
0d90: 20 65 63 68 6f 20 2d 6e 20 53 54 41 52 54 3a 3b echo -n START:;
0da0: 64 61 74 65 20 2b 77 77 25 55 2e 25 77 2d 24 48 date +ww%U.%w-$H
0db0: 3a 25 4d 3a 25 53 3b 65 63 68 6f 3b 65 63 68 6f :%M:%S;echo;echo
0dc0: 20 24 43 4d 44 3b 65 63 68 6f 3b 24 43 4d 44 29 $CMD;echo;$CMD)
0dd0: 7c 26 22 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 |&".;;
0de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0df0: 20 20 20 20 20 20 20 20 22 74 65 65 20 2d 61 20 "tee -a
0e00: 72 75 6e 6c 6f 67 2d 60 64 61 74 65 20 2b 77 77 runlog-`date +ww
0e10: 25 55 2e 25 77 2d 25 48 3a 25 4d 60 2e 6c 6f 67 %U.%w-%H:%M`.log
0e20: 3b 65 63 68 6f 20 50 72 65 73 73 20 61 6e 79 20 ;echo Press any
0e30: 6b 65 79 20 74 6f 20 63 6f 6e 74 69 6e 75 65 3b key to continue;
0e40: 62 61 73 68 20 2d 63 20 27 72 65 61 64 20 2d 6e bash -c 'read -n
0e50: 20 31 20 2d 73 27 5c 22 20 26 22 29 29 0a 3b 3b 1 -s'\" &")).;;
0e60: 20 20 20 20 20 20 20 20 20 20 28 76 69 65 77 73 (views
0e70: 63 72 65 65 6e 2d 70 6f 73 74 2d 63 6f 6d 6d 61 creen-post-comma
0e80: 6e 64 20 20 22 22 29 0a 3b 3b 20 20 20 20 20 20 nd "").;;
0e90: 20 20 20 20 28 75 73 65 2d 76 69 65 77 73 63 72 (use-viewscr
0ea0: 65 65 6e 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f een (configf:loo
0eb0: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
0ec0: 22 64 61 73 68 62 6f 61 72 64 22 20 22 75 73 65 "dashboard" "use
0ed0: 2d 76 69 65 77 73 63 72 65 65 6e 22 29 29 0a 3b -viewscreen")).;
0ee0: 3b 20 20 20 20 20 20 20 20 20 20 28 64 65 66 61 ; (defa
0ef0: 75 6c 74 2d 70 6f 73 74 2d 63 6f 6d 6d 61 6e 64 ult-post-command
0f00: 20 28 69 66 20 75 73 65 2d 76 69 65 77 73 63 72 (if use-viewscr
0f10: 65 65 6e 20 76 69 65 77 73 63 72 65 65 6e 2d 70 een viewscreen-p
0f20: 6f 73 74 2d 63 6f 6d 6d 61 6e 64 20 6f 72 69 67 ost-command orig
0f30: 2d 70 6f 73 74 2d 63 6f 6d 6d 61 6e 64 29 29 0a -post-command)).
0f40: 3b 3b 20 20 20 20 20 20 20 20 20 20 28 63 66 67 ;; (cfg
0f50: 2d 6f 76 72 64 20 28 63 6f 6e 66 69 67 66 3a 6c -ovrd (configf:l
0f60: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
0f70: 2a 20 22 64 61 73 68 62 6f 61 72 64 22 20 22 70 * "dashboard" "p
0f80: 6f 73 74 2d 63 6f 6d 6d 61 6e 64 22 29 29 29 0a ost-command"))).
0f90: 3b 3b 20 20 20 20 20 28 6f 72 20 63 66 67 2d 6f ;; (or cfg-o
0fa0: 76 72 64 20 64 65 66 61 75 6c 74 2d 6f 76 65 72 vrd default-over
0fb0: 72 69 64 65 20 64 65 66 61 75 6c 74 2d 70 6f 73 ride default-pos
0fc0: 74 2d 63 6f 6d 6d 61 6e 64 29 29 29 20 3b 3b 20 t-command))) ;;
0fd0: 22 3b 65 63 68 6f 20 50 72 65 73 73 20 61 6e 79 ";echo Press any
0fe0: 20 6b 65 79 20 74 6f 20 63 6f 6e 74 69 6e 75 65 key to continue
0ff0: 3b 62 61 73 68 20 2d 63 20 27 72 65 61 64 20 2d ;bash -c 'read -
1000: 6e 20 31 20 2d 73 27 5c 22 20 26 22 29 29 29 0a n 1 -s'\" &"))).
1010: 3b 3b 20 0a 3b 3b 20 0a 28 64 65 66 69 6e 65 20 ;; .;; .(define
1020: 28 74 65 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 6c (test-info-panel
1030: 20 74 65 73 74 64 61 74 20 73 74 6f 72 65 2d 6c testdat store-l
1040: 61 62 65 6c 20 77 69 64 67 65 74 73 29 0a 20 20 abel widgets).
1050: 28 69 75 70 3a 66 72 61 6d 65 20 0a 20 20 20 23 (iup:frame . #
1060: 3a 74 69 74 6c 65 20 22 54 65 73 74 20 49 6e 66 :title "Test Inf
1070: 6f 22 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 o" ; #:expand "Y
1080: 45 53 22 0a 20 20 20 28 69 75 70 3a 68 62 6f 78 ES". (iup:hbox
1090: 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 ; #:expand "YES
10a0: 22 0a 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 ". (apply iup
10b0: 3a 76 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 :vbox ; #:expand
10c0: 20 22 59 45 53 22 0a 09 20 20 20 28 61 70 70 65 "YES".. (appe
10d0: 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 nd (map (lambda
10e0: 28 76 61 6c 29 0a 09 09 09 20 20 28 69 75 70 3a (val).... (iup:
10f0: 6c 61 62 65 6c 20 76 61 6c 20 3b 20 23 3a 65 78 label val ; #:ex
1100: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL
1110: 22 0a 09 09 09 09 20 20 20 20 20 29 29 0a 09 09 "..... ))...
1120: 09 28 6c 69 73 74 20 22 54 65 73 74 6e 61 6d 65 .(list "Testname
1130: 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 49 74 : ".... "It
1140: 65 6d 20 70 61 74 68 3a 20 22 0a 09 09 09 20 20 em path: "....
1150: 20 20 20 20 22 43 75 72 72 65 6e 74 20 73 74 61 "Current sta
1160: 74 65 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 te: ".... "
1170: 43 75 72 72 65 6e 74 20 73 74 61 74 75 73 3a 20 Current status:
1180: 22 0a 09 09 09 20 20 20 20 20 20 22 54 65 73 74 ".... "Test
1190: 20 63 6f 6d 6d 65 6e 74 3a 20 22 0a 09 09 09 20 comment: "....
11a0: 20 20 20 20 20 22 54 65 73 74 20 69 64 3a 20 22 "Test id: "
11b0: 0a 09 09 09 20 20 20 20 20 20 22 54 65 73 74 20 .... "Test
11c0: 64 61 74 65 3a 20 22 29 29 0a 09 09 20 20 20 28 date: "))... (
11d0: 6c 69 73 74 20 28 69 75 70 3a 6c 61 62 65 6c 20 list (iup:label
11e0: 22 22 20 23 3a 65 78 70 61 6e 64 20 22 56 45 52 "" #:expand "VER
11f0: 54 49 43 41 4c 22 29 29 29 29 0a 20 20 20 20 28 TICAL")))). (
1200: 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 20 apply iup:vbox
1210: 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 ; #:expand "YES"
1220: 0a 09 20 20 20 28 6c 69 73 74 20 0a 09 20 20 20 .. (list ..
1230: 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 74 (store-label "t
1240: 65 73 74 6e 61 6d 65 22 0a 09 09 09 20 28 69 75 estname".... (iu
1250: 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 74 p:label (db:test
1260: 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 74 -get-testname t
1270: 65 73 74 64 61 74 29 20 23 3a 65 78 70 61 6e 64 estdat) #:expand
1280: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 "HORIZONTAL")..
1290: 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 .. (lambda (test
12a0: 64 61 74 29 28 64 62 3a 74 65 73 74 2d 67 65 74 dat)(db:test-get
12b0: 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 64 61 -testname testda
12c0: 74 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 t))).. (store
12d0: 2d 6c 61 62 65 6c 20 22 69 74 65 6d 2d 70 61 74 -label "item-pat
12e0: 68 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 h".... (iup:labe
12f0: 6c 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 l (db:test-get-i
1300: 74 65 6d 2d 70 61 74 68 20 74 65 73 74 64 61 74 tem-path testdat
1310: 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ) #:expand "HORI
1320: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la
1330: 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 28 64 mbda (testdat)(d
1340: 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d b:test-get-item-
1350: 70 61 74 68 20 74 65 73 74 64 61 74 29 29 29 0a path testdat))).
1360: 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 . (store-labe
1370: 6c 20 22 74 65 73 74 73 74 61 74 65 22 20 0a 09 l "teststate" ..
1380: 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 .. (iup:label (d
1390: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
13a0: 20 74 65 73 74 64 61 74 29 20 23 3a 65 78 70 61 testdat) #:expa
13b0: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 nd "HORIZONTAL")
13c0: 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 .... (lambda (te
13d0: 73 74 64 61 74 29 0a 09 09 09 20 20 20 28 64 62 stdat).... (db
13e0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
13f0: 74 65 73 74 64 61 74 29 29 29 0a 09 20 20 20 20 testdat)))..
1400: 28 6c 65 74 20 28 28 6c 62 6c 20 20 20 28 69 75 (let ((lbl (iu
1410: 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 74 p:label (db:test
1420: 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 -get-status test
1430: 64 61 74 29 20 23 3a 65 78 70 61 6e 64 20 22 48 dat) #:expand "H
1440: 4f 52 49 5a 4f 4e 54 41 4c 22 29 29 29 0a 09 20 ORIZONTAL")))..
1450: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
1460: 2d 73 65 74 21 20 77 69 64 67 65 74 73 20 22 74 -set! widgets "t
1470: 65 73 74 73 74 61 74 75 73 22 0a 09 09 09 20 20 eststatus"....
1480: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 (lambda (te
1490: 73 74 64 61 74 29 0a 09 09 09 09 20 28 6c 65 74 stdat)..... (let
14a0: 20 28 28 6e 65 77 73 74 61 74 75 73 20 28 64 62 ((newstatus (db
14b0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
14c0: 20 74 65 73 74 64 61 74 29 29 0a 09 09 09 09 20 testdat)).....
14d0: 20 20 20 20 20 20 28 6f 6c 64 73 74 61 74 75 73 (oldstatus
14e0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute
14f0: 6c 62 6c 20 22 54 49 54 4c 45 22 29 29 29 0a 09 lbl "TITLE")))..
1500: 09 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ... (if (not (
1510: 65 71 75 61 6c 3f 20 6f 6c 64 73 74 61 74 75 73 equal? oldstatus
1520: 20 6e 65 77 73 74 61 74 75 73 29 29 0a 09 09 09 newstatus))....
1530: 09 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 . (begin..
1540: 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 .... (iup:attrib
1550: 75 74 65 2d 73 65 74 21 20 6c 62 6c 20 22 46 47 ute-set! lbl "FG
1560: 43 4f 4c 4f 52 22 20 28 63 61 72 20 28 67 75 74 COLOR" (car (gut
1570: 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f ils:get-color-fo
1580: 72 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 28 r-state-status (
1590: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
15a0: 65 20 74 65 73 74 64 61 74 29 0a 09 09 09 09 09 e testdat)......
15b0: 09 09 09 09 09 09 09 09 09 20 20 20 28 64 62 3a ......... (db:
15c0: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 test-get-status
15d0: 74 65 73 74 64 61 74 29 29 29 29 0a 09 09 09 09 testdat)))).....
15e0: 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 . (iup:attribute
15f0: 2d 73 65 74 21 20 6c 62 6c 20 22 54 49 54 4c 45 -set! lbl "TITLE
1600: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 " (db:test-get-s
1610: 74 61 74 75 73 20 74 65 73 74 64 61 74 29 29 29 tatus testdat)))
1620: 29 29 29 29 0a 09 20 20 20 20 20 20 6c 62 6c 29 )))).. lbl)
1630: 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 .. (store-lab
1640: 65 6c 20 22 74 65 73 74 63 6f 6d 6d 65 6e 74 22 el "testcomment"
1650: 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 .... (iup:label
1660: 22 54 65 73 74 43 6f 6d 6d 65 6e 74 20 20 20 20 "TestComment
1670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1680: 20 20 20 20 20 20 20 20 20 22 0a 09 09 09 09 20 ".....
1690: 20 20 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 #:expand "HOR
16a0: 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c IZONTAL").... (l
16b0: 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 0a ambda (testdat).
16c0: 09 09 09 20 20 20 28 6c 65 74 20 28 28 6e 65 77 ... (let ((new
16d0: 63 6f 6d 6d 65 6e 74 20 28 64 62 3a 74 65 73 74 comment (db:test
16e0: 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 74 65 73 -get-comment tes
16f0: 74 64 61 74 29 29 29 0a 09 09 09 20 20 20 20 20 tdat)))....
1700: 28 69 66 20 2a 64 61 73 68 62 6f 61 72 64 2d 63 (if *dashboard-c
1710: 6f 6d 6d 65 6e 74 2d 73 68 61 72 65 2d 73 6c 6f omment-share-slo
1720: 74 2a 0a 09 09 09 09 20 28 69 66 20 28 6e 6f 74 t*..... (if (not
1730: 20 28 65 71 75 61 6c 3f 20 28 69 75 70 3a 61 74 (equal? (iup:at
1740: 74 72 69 62 75 74 65 20 2a 64 61 73 68 62 6f 61 tribute *dashboa
1750: 72 64 2d 63 6f 6d 6d 65 6e 74 2d 73 68 61 72 65 rd-comment-share
1760: 2d 73 6c 6f 74 2a 20 22 56 41 4c 55 45 22 29 0a -slot* "VALUE").
1770: 09 09 09 09 09 09 20 20 6e 65 77 63 6f 6d 6d 65 ...... newcomme
1780: 6e 74 29 29 0a 09 09 09 09 20 20 20 20 20 28 69 nt))..... (i
1790: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
17a0: 21 20 2a 64 61 73 68 62 6f 61 72 64 2d 63 6f 6d ! *dashboard-com
17b0: 6d 65 6e 74 2d 73 68 61 72 65 2d 73 6c 6f 74 2a ment-share-slot*
17c0: 0a 09 09 09 09 09 09 09 20 22 56 41 4c 55 45 22 ........ "VALUE"
17d0: 0a 09 09 09 09 09 09 09 20 6e 65 77 63 6f 6d 6d ........ newcomm
17e0: 65 6e 74 29 29 29 0a 09 09 09 20 20 20 20 20 6e ent))).... n
17f0: 65 77 63 6f 6d 6d 65 6e 74 29 29 29 0a 09 20 20 ewcomment)))..
1800: 20 20 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 (store-label "
1810: 74 65 73 74 69 64 22 0a 09 09 09 20 28 69 75 70 testid".... (iup
1820: 3a 6c 61 62 65 6c 20 22 54 65 73 74 49 64 20 20 :label "TestId
1830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1840: 20 20 20 20 20 20 20 20 20 20 20 22 0a 09 09 09 "....
1850: 09 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 48 . #:expand "H
1860: 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 ORIZONTAL")....
1870: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 (lambda (testdat
1880: 29 0a 09 09 09 20 20 20 28 64 62 3a 74 65 73 74 ).... (db:test
1890: 2d 67 65 74 2d 69 64 20 74 65 73 74 64 61 74 29 -get-id testdat)
18a0: 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c )).. (store-l
18b0: 61 62 65 6c 20 22 74 65 73 74 64 61 74 65 22 20 abel "testdate"
18c0: 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 .... (iup:label
18d0: 22 54 65 73 74 44 61 74 65 20 20 20 20 20 20 20 "TestDate
18e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18f0: 20 20 20 20 22 0a 09 09 09 09 20 20 20 20 23 3a "..... #:
1900: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT
1910: 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 AL").... (lambda
1920: 20 28 74 65 73 74 64 61 74 29 0a 09 09 09 20 20 (testdat)....
1930: 20 28 73 65 63 6f 6e 64 73 2d 3e 77 6f 72 6b 2d (seconds->work-
1940: 77 65 65 6b 2f 64 61 79 2d 74 69 6d 65 20 28 64 week/day-time (d
1950: 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 b:test-get-event
1960: 5f 74 69 6d 65 20 74 65 73 74 64 61 74 29 29 29 _time testdat)))
1970: 29 0a 09 20 20 20 20 29 29 29 29 29 0a 0a 3b 3b ).. )))))..;;
1980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
19a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
19b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
19c0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 20 6d ======.;; Test m
19d0: 65 74 61 20 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d 3d eta panel.;;====
19e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
19f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1a20: 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 ==..(define (tes
1a30: 74 2d 6d 65 74 61 2d 70 61 6e 65 6c 2d 67 65 74 t-meta-panel-get
1a40: 2d 64 65 73 63 72 69 70 74 69 6f 6e 20 74 65 73 -description tes
1a50: 74 6d 65 74 61 29 0a 20 20 28 66 6d 74 20 23 66 tmeta). (fmt #f
1a60: 20 28 77 69 74 68 2d 77 69 64 74 68 20 34 30 20 (with-width 40
1a70: 28 77 72 61 70 2d 6c 69 6e 65 73 20 28 64 62 3a (wrap-lines (db:
1a80: 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 64 65 73 testmeta-get-des
1a90: 63 72 69 70 74 69 6f 6e 20 74 65 73 74 6d 65 74 cription testmet
1aa0: 61 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 a)))))..(define
1ab0: 28 74 65 73 74 2d 6d 65 74 61 2d 70 61 6e 65 6c (test-meta-panel
1ac0: 20 74 65 73 74 6d 65 74 61 20 73 74 6f 72 65 2d testmeta store-
1ad0: 6d 65 74 61 29 0a 20 20 28 69 75 70 3a 66 72 61 meta). (iup:fra
1ae0: 6d 65 20 0a 20 20 20 23 3a 74 69 74 6c 65 20 22 me . #:title "
1af0: 54 65 73 74 20 4d 65 74 61 20 44 61 74 61 22 20 Test Meta Data"
1b00: 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 ; #:expand "YES"
1b10: 0a 20 20 20 28 69 75 70 3a 68 62 6f 78 20 3b 20 . (iup:hbox ;
1b20: 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 #:expand "YES".
1b30: 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 (apply iup:vb
1b40: 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 ox ; #:expand "Y
1b50: 45 53 22 0a 09 20 20 20 28 61 70 70 65 6e 64 20 ES".. (append
1b60: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 76 61 (map (lambda (va
1b70: 6c 29 0a 09 09 09 20 20 28 69 75 70 3a 6c 61 62 l).... (iup:lab
1b80: 65 6c 20 76 61 6c 20 3b 20 23 3a 65 78 70 61 6e el val ; #:expan
1b90: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 d "HORIZONTAL"..
1ba0: 09 09 09 20 20 20 20 20 29 29 0a 09 09 09 28 6c ... ))....(l
1bb0: 69 73 74 20 22 41 75 74 68 6f 72 3a 20 22 0a 09 ist "Author: "..
1bc0: 09 09 20 20 20 20 20 20 22 4f 77 6e 65 72 3a 20 .. "Owner:
1bd0: 22 0a 09 09 09 20 20 20 20 20 20 22 52 65 76 69 ".... "Revi
1be0: 65 77 65 64 3a 20 22 0a 09 09 09 20 20 20 20 20 ewed: "....
1bf0: 20 22 54 61 67 73 3a 20 22 0a 09 09 09 20 20 20 "Tags: "....
1c00: 20 20 20 22 44 65 73 63 72 69 70 74 69 6f 6e 3a "Description:
1c10: 20 22 29 29 0a 09 09 20 20 20 28 6c 69 73 74 20 "))... (list
1c20: 28 69 75 70 3a 6c 61 62 65 6c 20 22 22 20 23 3a (iup:label "" #:
1c30: 65 78 70 61 6e 64 20 22 56 45 52 54 49 43 41 4c expand "VERTICAL
1c40: 22 29 29 29 29 0a 20 20 20 20 28 61 70 70 6c 79 ")))). (apply
1c50: 20 69 75 70 3a 76 62 6f 78 20 20 3b 20 23 3a 65 iup:vbox ; #:e
1c60: 78 70 61 6e 64 20 22 59 45 53 22 0a 09 20 20 20 xpand "YES"..
1c70: 28 6c 69 73 74 20 0a 09 20 20 20 20 28 73 74 6f (list .. (sto
1c80: 72 65 2d 6d 65 74 61 20 22 61 75 74 68 6f 72 22 re-meta "author"
1c90: 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 .... (iup:label
1ca0: 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 (db:testmeta-get
1cb0: 2d 61 75 74 68 6f 72 20 74 65 73 74 6d 65 74 61 -author testmeta
1cc0: 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 ) #:expand "HORI
1cd0: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la
1ce0: 6d 62 64 61 20 28 74 65 73 74 6d 65 74 61 29 28 mbda (testmeta)(
1cf0: 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d db:testmeta-get-
1d00: 61 75 74 68 6f 72 20 74 65 73 74 6d 65 74 61 29 author testmeta)
1d10: 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6d )).. (store-m
1d20: 65 74 61 20 22 6f 77 6e 65 72 22 0a 09 09 09 20 eta "owner"....
1d30: 28 69 75 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 (iup:label (db:t
1d40: 65 73 74 6d 65 74 61 2d 67 65 74 2d 6f 77 6e 65 estmeta-get-owne
1d50: 72 20 74 65 73 74 6d 65 74 61 29 20 23 3a 65 78 r testmeta) #:ex
1d60: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL
1d70: 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 ").... (lambda (
1d80: 74 65 73 74 6d 65 74 61 29 28 64 62 3a 74 65 73 testmeta)(db:tes
1d90: 74 6d 65 74 61 2d 67 65 74 2d 6f 77 6e 65 72 20 tmeta-get-owner
1da0: 74 65 73 74 6d 65 74 61 29 29 29 0a 09 20 20 20 testmeta)))..
1db0: 20 28 73 74 6f 72 65 2d 6d 65 74 61 20 22 72 65 (store-meta "re
1dc0: 76 69 65 77 65 64 22 20 0a 09 09 09 20 28 69 75 viewed" .... (iu
1dd0: 70 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 74 p:label (db:test
1de0: 6d 65 74 61 2d 67 65 74 2d 72 65 76 69 65 77 65 meta-get-reviewe
1df0: 64 20 74 65 73 74 6d 65 74 61 29 20 23 3a 65 78 d testmeta) #:ex
1e00: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL
1e10: 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 ").... (lambda (
1e20: 74 65 73 74 6d 65 74 61 29 28 64 62 3a 74 65 73 testmeta)(db:tes
1e30: 74 6d 65 74 61 2d 67 65 74 2d 72 65 76 69 65 77 tmeta-get-review
1e40: 65 64 20 74 65 73 74 6d 65 74 61 29 29 29 0a 09 ed testmeta)))..
1e50: 20 20 20 20 28 73 74 6f 72 65 2d 6d 65 74 61 20 (store-meta
1e60: 22 74 61 67 73 22 20 0a 09 09 09 20 28 69 75 70 "tags" .... (iup
1e70: 3a 6c 61 62 65 6c 20 28 64 62 3a 74 65 73 74 6d :label (db:testm
1e80: 65 74 61 2d 67 65 74 2d 74 61 67 73 20 74 65 73 eta-get-tags tes
1e90: 74 6d 65 74 61 29 20 23 3a 65 78 70 61 6e 64 20 tmeta) #:expand
1ea0: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 "HORIZONTAL")...
1eb0: 09 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 6d . (lambda (testm
1ec0: 65 74 61 29 28 64 62 3a 74 65 73 74 6d 65 74 61 eta)(db:testmeta
1ed0: 2d 67 65 74 2d 74 61 67 73 20 74 65 73 74 6d 65 -get-tags testme
1ee0: 74 61 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 ta))).. (stor
1ef0: 65 2d 6d 65 74 61 20 22 64 65 73 63 72 69 70 74 e-meta "descript
1f00: 69 6f 6e 22 20 0a 09 09 09 20 28 69 75 70 3a 6c ion" .... (iup:l
1f10: 61 62 65 6c 20 28 74 65 73 74 2d 6d 65 74 61 2d abel (test-meta-
1f20: 70 61 6e 65 6c 2d 67 65 74 2d 64 65 73 63 72 69 panel-get-descri
1f30: 70 74 69 6f 6e 20 74 65 73 74 6d 65 74 61 29 20 ption testmeta)
1f40: 23 3a 73 69 7a 65 20 22 78 35 30 22 29 3b 20 23 #:size "x50"); #
1f50: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON
1f60: 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 TAL").... (lambd
1f70: 61 20 28 74 65 73 74 6d 65 74 61 29 0a 09 09 09 a (testmeta)....
1f80: 20 20 20 28 74 65 73 74 2d 6d 65 74 61 2d 70 61 (test-meta-pa
1f90: 6e 65 6c 2d 67 65 74 2d 64 65 73 63 72 69 70 74 nel-get-descript
1fa0: 69 6f 6e 20 74 65 73 74 6d 65 74 61 29 29 29 0a ion testmeta))).
1fb0: 09 20 20 20 20 29 29 29 29 29 0a 0a 0a 3b 3b 3d . )))))...;;=
1fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2000: 3d 3d 3d 3d 3d 0a 3b 3b 20 52 75 6e 20 69 6e 66 =====.;; Run inf
2010: 6f 20 70 61 6e 65 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d o panel.;;======
2020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2060: 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 69 6e .(define (run-in
2070: 66 6f 2d 70 61 6e 65 6c 20 64 62 20 6b 65 79 64 fo-panel db keyd
2080: 61 74 20 74 65 73 74 64 61 74 20 72 75 6e 6e 61 at testdat runna
2090: 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 me). (let* ((ru
20a0: 6e 2d 69 64 20 20 20 20 20 28 64 62 3a 74 65 73 n-id (db:tes
20b0: 74 2d 67 65 74 2d 72 75 6e 5f 69 64 20 74 65 73 t-get-run_id tes
20c0: 74 64 61 74 29 29 0a 09 20 28 72 75 6e 64 61 74 tdat)).. (rundat
20d0: 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 72 75 (rmt:get-ru
20e0: 6e 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 29 29 0a n-info run-id)).
20f0: 09 20 28 68 65 61 64 65 72 20 20 20 20 20 28 64 . (header (d
2100: 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e b:get-header run
2110: 64 61 74 29 29 0a 09 20 28 65 76 65 6e 74 5f 74 dat)).. (event_t
2120: 69 6d 65 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 ime (db:get-valu
2130: 65 2d 62 79 2d 68 65 61 64 65 72 20 28 64 62 3a e-by-header (db:
2140: 67 65 74 2d 72 6f 77 73 20 72 75 6e 64 61 74 29 get-rows rundat)
2150: 0a 09 09 09 09 09 20 20 20 20 20 28 64 62 3a 67 ...... (db:g
2160: 65 74 2d 68 65 61 64 65 72 20 72 75 6e 64 61 74 et-header rundat
2170: 29 0a 09 09 09 09 09 20 20 20 20 20 22 65 76 65 )...... "eve
2180: 6e 74 5f 74 69 6d 65 22 29 29 29 0a 20 20 20 20 nt_time"))).
2190: 28 69 75 70 3a 66 72 61 6d 65 20 0a 20 20 20 20 (iup:frame .
21a0: 20 23 3a 74 69 74 6c 65 20 22 4d 65 67 61 74 65 #:title "Megate
21b0: 73 74 20 52 75 6e 20 49 6e 66 6f 22 20 3b 20 23 st Run Info" ; #
21c0: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 20 :expand "YES".
21d0: 20 20 20 28 69 75 70 3a 68 62 6f 78 20 3b 20 23 (iup:hbox ; #
21e0: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 20 :expand "YES".
21f0: 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 (apply iup:v
2200: 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 box ; #:expand "
2210: 59 45 53 22 0a 09 20 20 20 20 20 28 61 70 70 65 YES".. (appe
2220: 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 nd (map (lambda
2230: 28 6b 65 79 76 61 6c 29 0a 09 09 09 20 20 20 20 (keyval)....
2240: 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 (iup:label (conc
2250: 20 28 63 61 72 20 6b 65 79 76 61 6c 29 20 22 20 (car keyval) "
2260: 22 29 29 29 0a 09 09 09 20 20 6b 65 79 64 61 74 "))).... keydat
2270: 29 0a 09 09 20 20 20 20 20 28 6c 69 73 74 20 28 )... (list (
2280: 69 75 70 3a 6c 61 62 65 6c 20 22 72 75 6e 6e 61 iup:label "runna
2290: 6d 65 20 22 29 0a 09 09 09 20 20 20 28 69 75 70 me ").... (iup
22a0: 3a 6c 61 62 65 6c 20 22 72 75 6e 2d 69 64 22 29 :label "run-id")
22b0: 0a 09 09 09 20 20 20 28 69 75 70 3a 6c 61 62 65 .... (iup:labe
22c0: 6c 20 22 72 75 6e 2d 64 61 74 65 22 29 29 29 29 l "run-date"))))
22d0: 0a 20 20 20 20 20 20 28 61 70 70 6c 79 20 69 75 . (apply iu
22e0: 70 3a 76 62 6f 78 0a 09 20 20 20 20 20 28 61 70 p:vbox.. (ap
22f0: 70 65 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 pend (map (lambd
2300: 61 20 28 6b 65 79 76 61 6c 29 0a 09 09 09 20 20 a (keyval)....
2310: 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 61 (iup:label (ca
2320: 64 72 20 6b 65 79 76 61 6c 29 20 23 3a 65 78 70 dr keyval) #:exp
2330: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
2340: 29 29 0a 09 09 09 20 20 6b 65 79 64 61 74 29 0a )).... keydat).
2350: 09 09 20 20 20 20 20 28 6c 69 73 74 20 28 69 75 .. (list (iu
2360: 70 3a 6c 61 62 65 6c 20 72 75 6e 6e 61 6d 65 29 p:label runname)
2370: 0a 09 09 09 20 20 20 28 69 75 70 3a 6c 61 62 65 .... (iup:labe
2380: 6c 20 28 63 6f 6e 63 20 72 75 6e 2d 69 64 29 29 l (conc run-id))
2390: 0a 09 09 09 20 20 20 28 69 75 70 3a 6c 61 62 65 .... (iup:labe
23a0: 6c 20 28 73 65 63 6f 6e 64 73 2d 3e 79 65 61 72 l (seconds->year
23b0: 2d 77 6f 72 6b 2d 77 65 65 6b 2f 64 61 79 2d 74 -work-week/day-t
23c0: 69 6d 65 20 65 76 65 6e 74 5f 74 69 6d 65 29 29 ime event_time))
23d0: 0a 09 09 09 20 20 20 28 69 75 70 3a 6c 61 62 65 .... (iup:labe
23e0: 6c 20 22 22 20 23 3a 65 78 70 61 6e 64 20 22 56 l "" #:expand "V
23f0: 45 52 54 49 43 41 4c 22 29 29 29 29 29 29 29 29 ERTICAL"))))))))
2400: 0a 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d . .;;==========
2410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
2450: 48 6f 73 74 20 69 6e 66 6f 20 70 61 6e 65 6c 0a Host info panel.
2460: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
2470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24a0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 66 69 6e 65 ========.(define
24b0: 20 28 68 6f 73 74 2d 69 6e 66 6f 2d 70 61 6e 65 (host-info-pane
24c0: 6c 20 74 65 73 74 64 61 74 20 73 74 6f 72 65 2d l testdat store-
24d0: 6c 61 62 65 6c 29 0a 20 20 28 69 75 70 3a 66 72 label). (iup:fr
24e0: 61 6d 65 0a 20 20 20 23 3a 74 69 74 6c 65 20 22 ame. #:title "
24f0: 52 65 6d 6f 74 65 20 68 6f 73 74 20 61 6e 64 20 Remote host and
2500: 54 65 73 74 20 52 75 6e 20 49 6e 66 6f 22 20 3b Test Run Info" ;
2510: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
2520: 20 20 20 28 69 75 70 3a 68 62 6f 78 20 3b 20 23 (iup:hbox ; #
2530: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 20 :expand "YES".
2540: 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f (apply iup:vbo
2550: 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 x ; #:expand "YE
2560: 53 22 20 3b 3b 20 54 68 65 20 68 65 61 64 69 6e S" ;; The headin
2570: 67 20 6c 61 62 65 6c 73 0a 09 20 20 20 28 61 70 g labels.. (ap
2580: 70 65 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 pend (map (lambd
2590: 61 20 28 76 61 6c 29 0a 09 09 09 20 20 28 69 75 a (val).... (iu
25a0: 70 3a 6c 61 62 65 6c 20 76 61 6c 20 3b 20 23 3a p:label val ; #:
25b0: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT
25c0: 41 4c 22 0a 09 09 09 09 20 20 20 20 20 29 29 0a AL"..... )).
25d0: 09 09 09 28 6c 69 73 74 20 22 48 6f 73 74 6e 61 ...(list "Hostna
25e0: 6d 65 3a 20 22 0a 09 09 09 20 20 20 20 20 20 22 me: ".... "
25f0: 44 69 73 6b 20 66 72 65 65 3a 20 22 0a 09 09 09 Disk free: "....
2600: 20 20 20 20 20 20 22 43 50 55 20 4c 6f 61 64 3a "CPU Load:
2610: 20 22 0a 09 09 09 20 20 20 20 20 20 22 52 75 6e ".... "Run
2620: 20 64 75 72 61 74 69 6f 6e 3a 20 22 0a 09 09 09 duration: "....
2630: 20 20 20 20 20 20 22 4c 6f 67 66 69 6c 65 3a 20 "Logfile:
2640: 22 0a 09 09 09 20 20 20 20 20 20 22 54 6f 70 20 ".... "Top
2650: 70 72 6f 63 65 73 73 20 69 64 3a 20 22 0a 09 09 process id: "...
2660: 09 20 20 20 20 20 20 22 55 6e 61 6d 65 20 2d 61 . "Uname -a
2670: 3a 20 22 29 29 0a 09 09 20 20 20 28 69 75 70 3a : "))... (iup:
2680: 6c 61 62 65 6c 20 22 22 20 23 3a 65 78 70 61 6e label "" #:expan
2690: 64 20 22 56 45 52 54 49 43 41 4c 22 29 29 29 0a d "VERTICAL"))).
26a0: 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a 76 (apply iup:v
26b0: 62 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 box ; #:expand "
26c0: 59 45 53 22 0a 09 20 20 20 28 6c 69 73 74 0a 09 YES".. (list..
26d0: 20 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 59 65 73 ;; NOTE: Yes
26e0: 2c 20 74 68 65 20 68 6f 73 74 20 63 61 6e 20 63 , the host can c
26f0: 68 61 6e 67 65 21 0a 09 20 20 20 20 28 73 74 6f hange!.. (sto
2700: 72 65 2d 6c 61 62 65 6c 20 22 48 6f 73 74 4e 61 re-label "HostNa
2710: 6d 65 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 me".... (iup:lab
2720: 65 6c 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 el ;; (sdb:qry '
2730: 67 65 74 73 74 72 20 0a 09 09 09 20 20 28 64 62 getstr .... (db
2740: 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 20 74 :test-get-host t
2750: 65 73 74 64 61 74 29 20 3b 3b 20 29 0a 09 09 09 estdat) ;; )....
2760: 20 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 #:expand "HORI
2770: 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 ZONTAL").... (la
2780: 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 28 64 mbda (testdat)(d
2790: 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 20 b:test-get-host
27a0: 74 65 73 74 64 61 74 29 29 29 0a 09 20 20 20 20 testdat)))..
27b0: 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 44 69 (store-label "Di
27c0: 73 6b 46 72 65 65 22 0a 09 09 09 20 28 69 75 70 skFree".... (iup
27d0: 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 20 28 64 62 :label (conc (db
27e0: 3a 74 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 :test-get-diskfr
27f0: 65 65 20 74 65 73 74 64 61 74 29 29 20 23 3a 65 ee testdat)) #:e
2800: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
2810: 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 L").... (lambda
2820: 28 74 65 73 74 64 61 74 29 28 63 6f 6e 63 20 28 (testdat)(conc (
2830: 64 62 3a 74 65 73 74 2d 67 65 74 2d 64 69 73 6b db:test-get-disk
2840: 66 72 65 65 20 74 65 73 74 64 61 74 29 29 29 29 free testdat))))
2850: 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 .. (store-lab
2860: 65 6c 20 22 43 50 55 4c 6f 61 64 22 0a 09 09 09 el "CPULoad"....
2870: 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e (iup:label (con
2880: 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 c (db:test-get-c
2890: 70 75 6c 6f 61 64 20 74 65 73 74 64 61 74 29 29 puload testdat))
28a0: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ
28b0: 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d ONTAL").... (lam
28c0: 62 64 61 20 28 74 65 73 74 64 61 74 29 28 63 6f bda (testdat)(co
28d0: 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d nc (db:test-get-
28e0: 63 70 75 6c 6f 61 64 20 74 65 73 74 64 61 74 29 cpuload testdat)
28f0: 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 2d ))).. (store-
2900: 6c 61 62 65 6c 20 22 52 75 6e 44 75 72 61 74 69 label "RunDurati
2910: 6f 6e 22 0a 09 09 09 20 28 69 75 70 3a 6c 61 62 on".... (iup:lab
2920: 65 6c 20 28 63 6f 6e 63 20 28 73 65 63 6f 6e 64 el (conc (second
2930: 73 2d 3e 68 72 2d 6d 69 6e 2d 73 65 63 20 28 64 s->hr-min-sec (d
2940: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 b:test-get-run_d
2950: 75 72 61 74 69 6f 6e 20 74 65 73 74 64 61 74 29 uration testdat)
2960: 29 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 )) #:expand "HOR
2970: 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 6c IZONTAL").... (l
2980: 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 28 ambda (testdat)(
2990: 63 6f 6e 63 20 28 73 65 63 6f 6e 64 73 2d 3e 68 conc (seconds->h
29a0: 72 2d 6d 69 6e 2d 73 65 63 20 28 64 62 3a 74 65 r-min-sec (db:te
29b0: 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 st-get-run_durat
29c0: 69 6f 6e 20 74 65 73 74 64 61 74 29 29 29 29 29 ion testdat)))))
29d0: 0a 09 20 20 20 20 28 73 74 6f 72 65 2d 6c 61 62 .. (store-lab
29e0: 65 6c 20 22 4c 6f 67 46 69 6c 65 22 0a 09 09 09 el "LogFile"....
29f0: 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e (iup:label (con
2a00: 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 c (db:test-get-f
2a10: 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 74 64 61 inal_logf testda
2a20: 74 29 29 20 23 3a 65 78 70 61 6e 64 20 22 48 4f t)) #:expand "HO
2a30: 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 20 28 RIZONTAL").... (
2a40: 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 lambda (testdat)
2a50: 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 (conc (db:test-g
2a60: 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 et-final_logf te
2a70: 73 74 64 61 74 29 29 29 29 0a 09 20 20 20 20 28 stdat)))).. (
2a80: 73 74 6f 72 65 2d 6c 61 62 65 6c 20 22 50 72 6f store-label "Pro
2a90: 63 65 73 73 49 64 22 0a 09 09 09 20 28 69 75 70 cessId".... (iup
2aa0: 3a 6c 61 62 65 6c 20 28 63 6f 6e 63 20 28 64 62 :label (conc (db
2ab0: 3a 74 65 73 74 2d 67 65 74 2d 70 72 6f 63 65 73 :test-get-proces
2ac0: 73 5f 69 64 20 74 65 73 74 64 61 74 29 29 20 23 s_id testdat)) #
2ad0: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON
2ae0: 54 41 4c 22 29 0a 09 09 09 20 28 6c 61 6d 62 64 TAL").... (lambd
2af0: 61 20 28 74 65 73 74 64 61 74 29 28 63 6f 6e 63 a (testdat)(conc
2b00: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 72 (db:test-get-pr
2b10: 6f 63 65 73 73 5f 69 64 20 74 65 73 74 64 61 74 ocess_id testdat
2b20: 29 29 29 29 0a 09 20 20 20 20 28 73 74 6f 72 65 )))).. (store
2b30: 2d 6c 61 62 65 6c 20 22 55 6e 61 6d 65 22 0a 09 -label "Uname"..
2b40: 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 20 .. (iup:label "
2b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b80: 20 20 22 20 23 3a 65 78 70 61 6e 64 20 22 48 4f " #:expand "HO
2b90: 52 49 5a 4f 4e 54 41 4c 22 29 20 3b 3b 20 20 23 RIZONTAL") ;; #
2ba0: 3a 77 6f 72 64 77 72 61 70 20 22 59 45 53 22 29 :wordwrap "YES")
2bb0: 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 74 65 .... (lambda (te
2bc0: 73 74 64 61 74 29 20 3b 3b 20 28 73 64 62 3a 71 stdat) ;; (sdb:q
2bd0: 72 79 20 27 67 65 74 73 74 72 20 0a 09 09 09 20 ry 'getstr ....
2be0: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 75 (db:test-get-u
2bf0: 6e 61 6d 65 20 74 65 73 74 64 61 74 29 29 29 20 name testdat)))
2c00: 3b 3b 20 29 0a 09 20 20 20 20 29 29 29 29 29 0a ;; ).. ))))).
2c10: 0a 3b 3b 20 69 66 20 74 68 65 72 65 20 69 73 20 .;; if there is
2c20: 61 20 73 75 62 6d 65 67 61 74 65 73 74 20 63 72 a submegatest cr
2c30: 65 61 74 65 20 61 20 62 75 74 74 6f 6e 20 74 6f eate a button to
2c40: 20 6c 61 75 6e 63 68 20 64 61 73 68 62 6f 61 72 launch dashboar
2c50: 64 20 69 6e 20 74 68 61 74 20 61 72 65 61 0a 3b d in that area.;
2c60: 3b 0a 28 64 65 66 69 6e 65 20 28 73 75 62 6d 65 ;.(define (subme
2c70: 67 61 74 65 73 74 2d 70 61 6e 65 6c 20 64 62 73 gatest-panel dbs
2c80: 74 72 75 63 74 20 6b 65 79 64 61 74 20 74 65 73 truct keydat tes
2c90: 74 64 61 74 20 72 75 6e 6e 61 6d 65 20 74 65 73 tdat runname tes
2ca0: 74 63 6f 6e 66 69 67 29 0a 20 20 28 6c 65 74 2a tconfig). (let*
2cb0: 20 28 28 74 65 73 74 2d 72 75 6e 2d 64 69 72 20 ((test-run-dir
2cc0: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 (db:test-ge
2cd0: 74 2d 72 75 6e 64 69 72 20 74 65 73 74 64 61 74 t-rundir testdat
2ce0: 29 29 0a 09 20 28 73 75 62 61 72 65 61 20 20 20 )).. (subarea
2cf0: 20 20 20 20 20 20 20 20 28 73 75 62 72 75 6e 3a (subrun:
2d00: 67 65 74 2d 72 75 6e 61 72 65 61 20 74 65 73 74 get-runarea test
2d10: 2d 72 75 6e 2d 64 69 72 29 29 0a 09 20 28 61 72 -run-dir)).. (ar
2d20: 65 61 2d 65 78 69 73 74 73 20 20 20 20 20 20 20 ea-exists
2d30: 28 61 6e 64 20 73 75 62 61 72 65 61 20 28 63 6f (and subarea (co
2d40: 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 mmon:file-exists
2d50: 3f 20 73 75 62 61 72 65 61 20 73 69 6c 65 6e 74 ? subarea silent
2d60: 3a 20 23 74 29 29 29 29 0a 20 20 20 20 28 69 66 : #t)))). (if
2d70: 20 73 75 62 61 72 65 61 0a 09 28 69 75 70 3a 66 subarea..(iup:f
2d80: 72 61 6d 65 20 0a 09 20 23 3a 74 69 74 6c 65 20 rame .. #:title
2d90: 22 4d 65 67 61 74 65 73 74 20 52 75 6e 20 49 6e "Megatest Run In
2da0: 66 6f 22 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 fo" ; #:expand "
2db0: 59 45 53 22 0a 09 20 28 69 75 70 3a 62 75 74 74 YES".. (iup:butt
2dc0: 6f 6e 0a 09 20 20 22 4c 61 75 6e 63 68 20 44 61 on.. "Launch Da
2dd0: 73 68 62 6f 61 72 64 22 0a 09 20 20 23 3a 61 63 shboard".. #:ac
2de0: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 tion (lambda (ob
2df0: 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 j).
2e00: 20 20 20 20 20 20 20 20 28 73 75 62 72 75 6e 3a (subrun:
2e10: 6c 61 75 6e 63 68 2d 64 61 73 68 62 6f 61 72 64 launch-dashboard
2e20: 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 29 29 29 test-run-dir)))
2e30: 29 0a 09 28 69 75 70 3a 76 62 6f 78 29 29 29 29 )..(iup:vbox))))
2e40: 0a 0a 3b 3b 20 75 73 65 20 61 20 67 6c 6f 62 61 ..;; use a globa
2e50: 6c 20 66 6f 72 20 73 65 74 74 69 6e 67 20 74 68 l for setting th
2e60: 65 20 62 75 74 74 6f 6e 73 20 63 6f 6c 6f 72 73 e buttons colors
2e70: 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
2e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 st
2e90: 61 74 65 20 73 74 61 74 75 73 20 74 65 73 74 73 ate status tests
2ea0: 74 65 70 73 0a 28 64 65 66 69 6e 65 20 2a 73 74 teps.(define *st
2eb0: 61 74 65 2d 73 74 61 74 75 73 2a 20 28 76 65 63 ate-status* (vec
2ec0: 74 6f 72 20 23 66 20 23 66 20 23 66 29 29 0a 28 tor #f #f #f)).(
2ed0: 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 73 define (update-s
2ee0: 74 61 74 65 2d 73 74 61 74 75 73 2d 62 75 74 74 tate-status-butt
2ef0: 6f 6e 73 20 74 65 73 74 64 61 74 29 0a 20 20 28 ons testdat). (
2f00: 6c 65 74 2a 20 28 28 73 74 61 74 65 20 20 28 64 let* ((state (d
2f10: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
2f20: 20 20 74 65 73 74 64 61 74 29 29 0a 09 20 28 73 testdat)).. (s
2f30: 74 61 74 75 73 20 28 64 62 3a 74 65 73 74 2d 67 tatus (db:test-g
2f40: 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 64 61 et-status testda
2f50: 74 29 29 0a 09 20 28 63 6f 6c 6f 72 20 20 28 63 t)).. (color (c
2f60: 61 72 20 28 67 75 74 69 6c 73 3a 67 65 74 2d 63 ar (gutils:get-c
2f70: 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73 olor-for-state-s
2f80: 74 61 74 75 73 20 73 74 61 74 65 20 73 74 61 74 tatus state stat
2f90: 75 73 29 29 29 29 0a 20 20 20 20 28 28 76 65 63 us)))). ((vec
2fa0: 74 6f 72 2d 72 65 66 20 2a 73 74 61 74 65 2d 73 tor-ref *state-s
2fb0: 74 61 74 75 73 2a 20 30 29 20 73 74 61 74 65 20 tatus* 0) state
2fc0: 63 6f 6c 6f 72 29 0a 20 20 20 20 28 28 76 65 63 color). ((vec
2fd0: 74 6f 72 2d 72 65 66 20 2a 73 74 61 74 65 2d 73 tor-ref *state-s
2fe0: 74 61 74 75 73 2a 20 31 29 20 73 74 61 74 75 73 tatus* 1) status
2ff0: 20 63 6f 6c 6f 72 29 29 29 0a 0a 28 64 65 66 69 color)))..(defi
3000: 6e 65 20 2a 64 61 73 68 62 6f 61 72 64 2d 74 65 ne *dashboard-te
3010: 73 74 2d 64 62 2a 20 23 74 29 0a 28 64 65 66 69 st-db* #t).(defi
3020: 6e 65 20 2a 64 61 73 68 62 6f 61 72 64 2d 63 6f ne *dashboard-co
3030: 6d 6d 65 6e 74 2d 73 68 61 72 65 2d 73 6c 6f 74 mment-share-slot
3040: 2a 20 23 66 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d * #f)..;;=======
3050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
3090: 3b 3b 20 53 65 74 20 66 69 65 6c 64 73 20 0a 3b ;; Set fields .;
30a0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
30b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30e0: 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 66 69 6e 65 20 =======.(define
30f0: 28 73 65 74 2d 66 69 65 6c 64 73 2d 70 61 6e 65 (set-fields-pane
3100: 6c 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 l dbstruct run-i
3110: 64 20 74 65 73 74 2d 69 64 20 74 65 73 74 64 61 d test-id testda
3120: 74 20 23 21 6b 65 79 20 28 64 62 20 23 66 29 29 t #!key (db #f))
3130: 0a 20 20 28 6c 65 74 20 28 28 6e 65 77 63 6f 6d . (let ((newcom
3140: 6d 65 6e 74 20 23 66 29 0a 09 28 6e 65 77 73 74 ment #f)..(newst
3150: 61 74 75 73 20 20 23 66 29 0a 09 28 6e 65 77 73 atus #f)..(news
3160: 74 61 74 65 20 20 20 23 66 29 0a 09 28 77 74 78 tate #f)..(wtx
3170: 74 62 6f 78 20 20 20 20 23 66 29 29 0a 20 20 20 tbox #f)).
3180: 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 20 20 20 (iup:frame.
3190: 20 23 3a 74 69 74 6c 65 20 22 53 65 74 20 66 69 #:title "Set fi
31a0: 65 6c 64 73 22 0a 20 20 20 20 20 28 69 75 70 3a elds". (iup:
31b0: 76 62 6f 78 0a 20 20 20 20 20 20 28 69 75 70 3a vbox. (iup:
31c0: 68 62 6f 78 20 28 69 75 70 3a 6c 61 62 65 6c 20 hbox (iup:label
31d0: 22 43 6f 6d 6d 65 6e 74 3a 22 29 0a 09 09 28 6c "Comment:")...(l
31e0: 65 74 20 28 28 74 78 74 62 6f 78 20 28 69 75 70 et ((txtbox (iup
31f0: 3a 74 65 78 74 62 6f 78 20 23 3a 61 63 74 69 6f :textbox #:actio
3200: 6e 20 28 6c 61 6d 62 64 61 20 28 76 61 6c 20 61 n (lambda (val a
3210: 20 62 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 b).......
3220: 3b 3b 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 ;; (rmt:test-set
3230: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 -state-status-by
3240: 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d -id run-id test-
3250: 69 64 20 23 66 20 23 66 20 62 29 0a 09 09 09 09 id #f #f b).....
3260: 09 09 20 20 20 20 20 20 28 72 6d 74 3a 74 65 73 .. (rmt:tes
3270: 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 t-set-state-stat
3280: 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 us run-id test-i
3290: 64 20 23 66 20 23 66 20 62 29 0a 09 09 09 09 09 d #f #f b)......
32a0: 09 20 20 20 20 20 20 3b 3b 20 49 44 45 41 3a 20 . ;; IDEA:
32b0: 4a 75 73 74 20 73 65 74 20 61 20 76 61 72 69 61 Just set a varia
32c0: 62 6c 65 20 77 69 74 68 20 74 68 65 20 70 72 6f ble with the pro
32d0: 63 20 74 6f 20 63 61 6c 6c 3f 0a 09 09 09 09 09 c to call?......
32e0: 09 20 20 20 20 20 20 3b 3b 20 28 72 6d 74 3a 74 . ;; (rmt:t
32f0: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
3300: 61 74 75 73 2d 62 79 2d 69 64 20 72 75 6e 2d 69 atus-by-id run-i
3310: 64 20 74 65 73 74 2d 69 64 20 23 66 20 23 66 20 d test-id #f #f
3320: 62 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 b)....... (
3330: 73 65 74 21 20 6e 65 77 63 6f 6d 6d 65 6e 74 20 set! newcomment
3340: 62 29 29 0a 09 09 09 09 09 20 20 20 23 3a 76 61 b))...... #:va
3350: 6c 75 65 20 28 64 62 3a 74 65 73 74 2d 67 65 74 lue (db:test-get
3360: 2d 63 6f 6d 6d 65 6e 74 20 74 65 73 74 64 61 74 -comment testdat
3370: 29 0a 09 09 09 09 09 20 20 20 23 3a 65 78 70 61 )...... #:expa
3380: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 nd "HORIZONTAL")
3390: 29 29 0a 09 09 20 20 28 73 65 74 21 20 77 74 78 ))... (set! wtx
33a0: 74 62 6f 78 20 74 78 74 62 6f 78 29 0a 09 09 20 tbox txtbox)...
33b0: 20 74 78 74 62 6f 78 29 29 0a 09 09 20 20 0a 20 txtbox))... .
33c0: 20 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a (apply iup:
33d0: 68 62 6f 78 0a 09 20 20 20 20 20 28 69 75 70 3a hbox.. (iup:
33e0: 6c 61 62 65 6c 20 22 53 54 41 54 45 3a 22 20 23 label "STATE:" #
33f0: 3a 73 69 7a 65 20 22 33 30 78 22 29 0a 09 20 20 :size "30x")..
3400: 20 20 20 28 6c 65 74 2a 20 28 28 62 74 6e 73 20 (let* ((btns
3410: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 73 (map (lambda (s
3420: 74 61 74 65 29 0a 09 09 09 09 20 20 28 6c 65 74 tate)..... (let
3430: 20 28 28 62 74 6e 20 28 69 75 70 3a 62 75 74 74 ((btn (iup:butt
3440: 6f 6e 20 73 74 61 74 65 0a 09 09 09 09 09 09 09 on state........
3450: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ
3460: 4f 4e 54 41 4c 22 20 23 3a 73 69 7a 65 20 22 35 ONTAL" #:size "5
3470: 30 78 22 20 23 3a 66 6f 6e 74 20 22 43 6f 75 72 0x" #:font "Cour
3480: 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 0a 09 09 ier New, -10"...
3490: 09 09 09 09 09 20 23 3a 61 63 74 69 6f 6e 20 28 ..... #:action (
34a0: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 lambda (x)......
34b0: 09 09 09 20 20 20 20 3b 3b 20 28 72 6d 74 3a 74 ... ;; (rmt:t
34c0: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
34d0: 61 74 75 73 2d 62 79 2d 69 64 20 72 75 6e 2d 69 atus-by-id run-i
34e0: 64 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 d test-id state
34f0: 23 66 20 23 66 29 0a 09 09 09 09 09 09 09 09 20 #f #f).........
3500: 20 20 20 28 72 6d 74 3a 73 65 74 2d 73 74 61 74 (rmt:set-stat
3510: 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c e-status-and-rol
3520: 6c 2d 75 70 2d 69 74 65 6d 73 20 72 75 6e 2d 69 l-up-items run-i
3530: 64 20 74 65 73 74 2d 69 64 20 23 66 20 73 74 61 d test-id #f sta
3540: 74 65 20 23 66 20 23 66 29 20 3b 3b 20 74 65 73 te #f #f) ;; tes
3550: 74 2d 6e 61 6d 65 20 70 61 73 73 65 64 20 69 6e t-name passed in
3560: 20 61 73 20 74 65 73 74 2d 69 64 20 69 73 20 72 as test-id is r
3570: 65 73 70 65 63 74 65 64 0a 09 09 09 09 09 09 09 espected........
3580: 09 20 20 20 20 28 64 62 3a 74 65 73 74 2d 73 65 . (db:test-se
3590: 74 2d 73 74 61 74 65 21 20 74 65 73 74 64 61 74 t-state! testdat
35a0: 20 73 74 61 74 65 29 29 29 29 29 0a 09 09 09 09 state))))).....
35b0: 20 20 20 20 62 74 6e 29 29 0a 09 09 09 09 28 6d btn)).....(m
35c0: 61 70 20 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e 3a ap cadr *common:
35d0: 73 74 64 2d 73 74 61 74 65 73 2a 29 29 29 29 20 std-states*))))
35e0: 3b 3b 20 28 6c 69 73 74 20 22 43 4f 4d 50 4c 45 ;; (list "COMPLE
35f0: 54 45 44 22 20 22 4e 4f 54 5f 53 54 41 52 54 45 TED" "NOT_STARTE
3600: 44 22 20 22 52 55 4e 4e 49 4e 47 22 20 22 52 45 D" "RUNNING" "RE
3610: 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 20 22 MOTEHOSTSTART" "
3620: 4c 41 55 4e 43 48 45 44 22 20 22 4b 49 4c 4c 45 LAUNCHED" "KILLE
3630: 44 22 20 22 4b 49 4c 4c 52 45 51 22 29 29 29 29 D" "KILLREQ"))))
3640: 0a 09 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 .. (vector
3650: 2d 73 65 74 21 20 2a 73 74 61 74 65 2d 73 74 61 -set! *state-sta
3660: 74 75 73 2a 20 30 0a 09 09 09 20 20 20 20 28 6c tus* 0.... (l
3670: 61 6d 62 64 61 20 28 73 74 61 74 65 20 63 6f 6c ambda (state col
3680: 6f 72 29 0a 09 09 09 20 20 20 20 20 20 28 66 6f or).... (fo
3690: 72 2d 65 61 63 68 20 0a 09 09 09 20 20 20 20 20 r-each ....
36a0: 20 20 28 6c 61 6d 62 64 61 20 28 62 74 6e 29 0a (lambda (btn).
36b0: 09 09 09 09 20 28 6c 65 74 2a 20 28 28 6e 61 6d .... (let* ((nam
36c0: 65 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 e (iup:attri
36d0: 62 75 74 65 20 62 74 6e 20 22 54 49 54 4c 45 22 bute btn "TITLE"
36e0: 29 29 0a 09 09 09 09 09 28 6e 65 77 63 6f 6c 6f ))......(newcolo
36f0: 72 20 28 69 66 20 28 65 71 75 61 6c 3f 20 6e 61 r (if (equal? na
3700: 6d 65 20 73 74 61 74 65 29 20 63 6f 6c 6f 72 20 me state) color
3710: 22 31 39 32 20 31 39 32 20 31 39 32 22 29 29 29 "192 192 192")))
3720: 0a 09 09 09 09 20 20 20 28 69 66 20 28 6e 6f 74 ..... (if (not
3730: 20 28 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c 61 72 (colors-similar
3740: 3f 20 6e 65 77 63 6f 6c 6f 72 20 28 69 75 70 3a ? newcolor (iup:
3750: 61 74 74 72 69 62 75 74 65 20 62 74 6e 20 22 42 attribute btn "B
3760: 47 43 4f 4c 4f 52 22 29 29 29 0a 09 09 09 09 20 GCOLOR"))).....
3770: 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 (iup:attri
3780: 62 75 74 65 2d 73 65 74 21 20 62 74 6e 20 22 42 bute-set! btn "B
3790: 47 43 4f 4c 4f 52 22 20 6e 65 77 63 6f 6c 6f 72 GCOLOR" newcolor
37a0: 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 62 )))).... b
37b0: 74 6e 73 29 29 29 0a 09 20 20 20 20 20 20 20 62 tns))).. b
37c0: 74 6e 73 29 29 0a 20 20 20 20 20 20 28 61 70 70 tns)). (app
37d0: 6c 79 20 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 ly iup:hbox..
37e0: 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 53 54 (iup:label "ST
37f0: 41 54 55 53 3a 22 20 23 3a 73 69 7a 65 20 22 33 ATUS:" #:size "3
3800: 30 78 22 29 0a 09 20 20 20 20 20 28 6c 65 74 2a 0x").. (let*
3810: 20 28 28 62 74 6e 73 20 20 28 6d 61 70 20 28 6c ((btns (map (l
3820: 61 6d 62 64 61 20 28 73 74 61 74 75 73 29 0a 09 ambda (status)..
3830: 09 09 09 20 20 28 6c 65 74 20 28 28 62 74 6e 20 ... (let ((btn
3840: 28 69 75 70 3a 62 75 74 74 6f 6e 20 73 74 61 74 (iup:button stat
3850: 75 73 0a 09 09 09 09 09 09 09 20 23 3a 65 78 70 us........ #:exp
3860: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
3870: 20 23 3a 73 69 7a 65 20 22 35 30 78 22 20 23 3a #:size "50x" #:
3880: 66 6f 6e 74 20 22 43 6f 75 72 69 65 72 20 4e 65 font "Courier Ne
3890: 77 2c 20 2d 31 30 22 0a 09 09 09 09 09 09 09 20 w, -10"........
38a0: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda
38b0: 20 28 78 29 0a 09 09 09 09 09 09 09 09 20 20 20 (x).........
38c0: 20 28 6c 65 74 20 28 28 74 20 28 69 75 70 3a 61 (let ((t (iup:a
38d0: 74 74 72 69 62 75 74 65 20 78 20 22 54 49 54 4c ttribute x "TITL
38e0: 45 22 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 E"))).........
38f0: 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 (if (equal?
3900: 74 20 22 57 41 49 56 45 44 22 29 0a 09 09 09 09 t "WAIVED").....
3910: 09 09 09 09 09 20 20 28 69 75 70 3a 73 68 6f 77 ..... (iup:show
3920: 20 28 64 61 73 68 62 6f 61 72 64 2d 74 65 73 74 (dashboard-test
3930: 73 3a 77 61 69 76 65 72 20 72 75 6e 2d 69 64 20 s:waiver run-id
3940: 74 65 73 74 64 61 74 20 0a 09 09 09 09 09 09 09 testdat ........
3950: 09 09 09 09 09 09 20 20 20 20 28 69 66 20 77 74 ...... (if wt
3960: 78 74 62 6f 78 20 28 69 75 70 3a 61 74 74 72 69 xtbox (iup:attri
3970: 62 75 74 65 20 77 74 78 74 62 6f 78 20 22 56 41 bute wtxtbox "VA
3980: 4c 55 45 22 29 20 23 66 29 0a 09 09 09 09 09 09 LUE") #f).......
3990: 09 09 09 09 09 09 09 20 20 20 20 28 6c 61 6d 62 ....... (lamb
39a0: 64 61 20 28 63 29 0a 09 09 09 09 09 09 09 09 09 da (c)..........
39b0: 09 09 09 09 20 20 20 20 20 20 28 73 65 74 21 20 .... (set!
39c0: 6e 65 77 63 6f 6d 6d 65 6e 74 20 63 29 0a 09 09 newcomment c)...
39d0: 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 ...........
39e0: 20 28 69 66 20 77 74 78 74 62 6f 78 20 0a 09 09 (if wtxtbox ...
39f0: 09 09 09 09 09 09 09 09 09 09 09 09 20 20 28 62 ............ (b
3a00: 65 67 69 6e 0a 09 09 09 09 09 09 09 09 09 09 09 egin............
3a10: 09 09 09 20 20 20 20 28 69 75 70 3a 61 74 74 72 ... (iup:attr
3a20: 69 62 75 74 65 2d 73 65 74 21 20 77 74 78 74 62 ibute-set! wtxtb
3a30: 6f 78 20 22 56 41 4c 55 45 22 20 63 29 0a 09 09 ox "VALUE" c)...
3a40: 09 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 ............
3a50: 28 69 66 20 28 6e 6f 74 20 2a 64 61 73 68 62 6f (if (not *dashbo
3a60: 61 72 64 2d 63 6f 6d 6d 65 6e 74 2d 73 68 61 72 ard-comment-shar
3a70: 65 2d 73 6c 6f 74 2a 29 0a 09 09 09 09 09 09 09 e-slot*)........
3a80: 09 09 09 09 09 09 09 09 28 73 65 74 21 20 2a 64 ........(set! *d
3a90: 61 73 68 62 6f 61 72 64 2d 63 6f 6d 6d 65 6e 74 ashboard-comment
3aa0: 2d 73 68 61 72 65 2d 73 6c 6f 74 2a 20 77 74 78 -share-slot* wtx
3ab0: 74 62 6f 78 29 29 29 0a 09 09 09 09 09 09 09 09 tbox))).........
3ac0: 09 09 09 09 09 09 20 20 29 29 29 29 0a 09 09 09 ...... ))))....
3ad0: 09 09 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 ...... (begin..
3ae0: 09 09 09 09 09 09 09 09 20 20 20 20 3b 3b 20 28 ........ ;; (
3af0: 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 rmt:test-set-sta
3b00: 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 20 te-status-by-id
3b10: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 23 run-id test-id #
3b20: 66 20 73 74 61 74 75 73 20 23 66 29 0a 09 09 09 f status #f)....
3b30: 09 09 09 09 09 09 20 20 20 20 28 72 6d 74 3a 73 ...... (rmt:s
3b40: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
3b50: 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d and-roll-up-item
3b60: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 s run-id test-id
3b70: 20 23 66 20 23 66 20 73 74 61 74 75 73 20 23 66 #f #f status #f
3b80: 29 20 3b 3b 20 74 65 73 74 2d 6e 61 6d 65 20 70 ) ;; test-name p
3b90: 61 73 73 65 64 20 69 6e 20 61 73 20 74 65 73 74 assed in as test
3ba0: 2d 69 64 20 69 73 20 72 65 73 70 65 63 74 65 64 -id is respected
3bb0: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 28 64 .......... (d
3bc0: 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 b:test-set-statu
3bd0: 73 21 20 74 65 73 74 64 61 74 20 73 74 61 74 75 s! testdat statu
3be0: 73 29 29 29 29 29 29 29 29 0a 09 09 09 09 20 20 s)))))))).....
3bf0: 20 20 62 74 6e 29 29 0a 09 09 09 09 28 6d 61 70 btn)).....(map
3c00: 20 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 cadr *common:st
3c10: 64 2d 73 74 61 74 75 73 65 73 2a 29 29 29 29 20 d-statuses*))))
3c20: 3b 3b 20 28 6c 69 73 74 20 20 22 50 41 53 53 22 ;; (list "PASS"
3c30: 20 22 57 41 52 4e 22 20 22 46 41 49 4c 22 20 22 "WARN" "FAIL" "
3c40: 43 48 45 43 4b 22 20 22 6e 2f 61 22 20 22 57 41 CHECK" "n/a" "WA
3c50: 49 56 45 44 22 20 22 53 4b 49 50 22 29 29 29 29 IVED" "SKIP"))))
3c60: 0a 09 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 .. (vector
3c70: 2d 73 65 74 21 20 2a 73 74 61 74 65 2d 73 74 61 -set! *state-sta
3c80: 74 75 73 2a 20 31 0a 09 09 09 20 20 20 20 28 6c tus* 1.... (l
3c90: 61 6d 62 64 61 20 28 73 74 61 74 75 73 20 63 6f ambda (status co
3ca0: 6c 6f 72 29 0a 09 09 09 20 20 20 20 20 20 28 66 lor).... (f
3cb0: 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 20 20 20 or-each ....
3cc0: 20 20 20 28 6c 61 6d 62 64 61 20 28 62 74 6e 29 (lambda (btn)
3cd0: 0a 09 09 09 09 20 28 6c 65 74 2a 20 28 28 6e 61 ..... (let* ((na
3ce0: 6d 65 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 me (iup:attr
3cf0: 69 62 75 74 65 20 62 74 6e 20 22 54 49 54 4c 45 ibute btn "TITLE
3d00: 22 29 29 0a 09 09 09 09 09 28 6e 65 77 63 6f 6c "))......(newcol
3d10: 6f 72 20 28 69 66 20 28 65 71 75 61 6c 3f 20 6e or (if (equal? n
3d20: 61 6d 65 20 73 74 61 74 75 73 29 20 63 6f 6c 6f ame status) colo
3d30: 72 20 22 31 39 32 20 31 39 32 20 31 39 32 22 29 r "192 192 192")
3d40: 29 29 0a 09 09 09 09 20 20 20 28 69 66 20 28 6e ))..... (if (n
3d50: 6f 74 20 28 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c ot (colors-simil
3d60: 61 72 3f 20 6e 65 77 63 6f 6c 6f 72 20 28 69 75 ar? newcolor (iu
3d70: 70 3a 61 74 74 72 69 62 75 74 65 20 62 74 6e 20 p:attribute btn
3d80: 22 42 47 43 4f 4c 4f 52 22 29 29 29 0a 09 09 09 "BGCOLOR")))....
3d90: 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 . (iup:att
3da0: 72 69 62 75 74 65 2d 73 65 74 21 20 62 74 6e 20 ribute-set! btn
3db0: 22 42 47 43 4f 4c 4f 52 22 20 6e 65 77 63 6f 6c "BGCOLOR" newcol
3dc0: 6f 72 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 or))))....
3dd0: 20 62 74 6e 73 29 29 29 0a 09 20 20 20 20 20 20 btns)))..
3de0: 20 62 74 6e 73 29 29 29 29 29 29 0a 0a 28 64 65 btns))))))..(de
3df0: 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 64 2d fine (dashboard-
3e00: 74 65 73 74 73 3a 72 75 6e 2d 61 2d 73 74 65 70 tests:run-a-step
3e10: 20 69 6e 66 6f 29 0a 20 20 23 74 29 0a 0a 3b 3b info). #t)..;;
3e20: 20 28 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f (define (dashbo
3e30: 61 72 64 2d 74 65 73 74 73 3a 73 74 65 70 2d 72 ard-tests:step-r
3e40: 75 6e 2d 63 6f 6e 74 72 6f 6c 20 74 65 73 74 64 un-control testd
3e50: 61 74 20 73 74 65 70 6e 61 6d 65 20 74 65 73 74 at stepname test
3e60: 63 6f 6e 66 69 67 29 0a 3b 3b 20 20 20 28 6c 65 config).;; (le
3e70: 74 2a 20 28 28 6d 75 74 65 78 20 28 6d 61 6b 65 t* ((mutex (make
3e80: 2d 6d 75 74 65 78 29 29 29 0a 3b 3b 20 20 20 20 -mutex))).;;
3e90: 20 28 6c 65 74 72 65 63 20 28 28 64 6c 67 0a 3b (letrec ((dlg.;
3ea0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
3eb0: 28 69 75 70 3a 64 69 61 6c 6f 67 20 3b 3b 20 23 (iup:dialog ;; #
3ec0: 3a 63 6c 6f 73 65 5f 63 62 20 28 6c 61 6d 62 64 :close_cb (lambd
3ed0: 61 20 28 61 29 28 65 78 69 74 29 29 20 3b 20 23 a (a)(exit)) ; #
3ee0: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 3b 3b :expand "YES".;;
3ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f00: 23 3a 74 69 74 6c 65 20 73 74 65 70 6e 61 6d 65 #:title stepname
3f10: 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
3f20: 20 20 20 28 69 75 70 3a 76 62 6f 78 20 3b 20 23 (iup:vbox ; #
3f30: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 3b 3b :expand "YES".;;
3f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f50: 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 63 6f 6e (iup:label (con
3f60: 63 20 22 53 74 65 70 3a 20 22 20 73 74 65 70 6e c "Step: " stepn
3f70: 61 6d 65 20 22 5c 6e 4e 42 2f 2f 20 54 68 65 73 ame "\nNB// Thes
3f80: 65 20 62 75 74 74 6f 6e 73 20 6f 6e 6c 79 20 72 e buttons only r
3f90: 75 6e 20 74 68 65 20 74 65 73 74 20 73 74 65 70 un the test step
3fa0: 5c 6e 66 6f 72 20 74 68 65 20 70 75 72 70 6f 73 \nfor the purpos
3fb0: 65 20 6f 66 20 64 65 62 75 67 67 69 6e 67 2e 5c e of debugging.\
3fc0: 6e 4e 6f 74 20 61 6c 6c 20 64 61 74 61 62 61 73 nNot all databas
3fd0: 65 20 75 70 64 61 74 65 73 20 61 72 65 20 64 6f e updates are do
3fe0: 6e 65 2e 22 29 29 0a 3b 3b 20 20 20 20 20 20 20 ne.")).;;
3ff0: 20 20 20 20 20 20 20 20 20 20 28 69 75 70 3a 62 (iup:b
4000: 75 74 74 6f 6e 20 22 52 65 2d 72 75 6e 22 20 20 utton "Re-run"
4010: 20 20 20 20 20 20 20 20 20 20 0a 3b 3b 20 09 09 .;; ..
4020: 20 20 20 20 20 20 20 20 20 20 20 20 23 3a 65 78 #:ex
4030: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL
4040: 22 20 0a 3b 3b 20 09 09 20 20 20 20 20 20 20 20 " .;; ..
4050: 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 #:action (la
4060: 6d 62 64 61 20 28 6f 62 6a 29 0a 3b 3b 20 20 20 mbda (obj).;;
4070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4090: 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
40a0: 3a 63 61 74 63 68 2d 61 6e 64 2d 64 75 6d 70 20 :catch-and-dump
40b0: 28 6c 61 6d 62 64 61 20 28 29 0a 3b 3b 20 09 09 (lambda ().;; ..
40c0: 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
40d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 68 (th
40f0: 72 65 61 64 2d 73 74 61 72 74 21 20 0a 3b 3b 20 read-start! .;;
4100: 09 09 09 20 20 20 20 20 20 20 20 20 20 20 20 20 ...
4110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4130: 28 6d 61 6b 65 2d 74 68 72 65 61 64 0a 3b 3b 20 (make-thread.;;
4140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4180: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 (lambda ()
4190: 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
41a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 69 (pri
41e0: 6e 74 20 22 42 42 3e 20 73 74 61 72 74 65 64 20 nt "BB> started
41f0: 65 7a 73 74 65 70 73 3a 72 75 6e 2d 66 72 6f 6d ezsteps:run-from
4200: 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ").;;
4210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 (d
4250: 65 62 75 67 3a 63 61 74 63 68 2d 61 6e 64 2d 64 ebug:catch-and-d
4260: 75 6d 70 20 0a 3b 3b 20 20 20 20 20 20 20 20 20 ump .;;
4270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42b0: 20 28 6c 61 6d 62 64 61 20 28 29 0a 3b 3b 20 09 (lambda ().;; .
42c0: 09 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
42d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42f0: 20 20 20 20 20 28 65 7a 73 74 65 70 73 3a 72 75 (ezsteps:ru
4300: 6e 2d 66 72 6f 6d 20 74 65 73 74 64 61 74 20 73 n-from testdat s
4310: 74 65 70 6e 61 6d 65 20 23 74 29 29 0a 3b 3b 20 tepname #t)).;;
4320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4360: 20 20 20 20 20 20 20 20 20 22 64 61 73 68 62 6f "dashbo
4370: 61 72 64 2d 74 65 73 74 73 3a 73 74 65 70 2d 72 ard-tests:step-r
4380: 75 6e 2d 63 6f 6e 74 72 6f 6c 20 2d 3e 20 65 7a un-control -> ez
4390: 73 74 65 70 3a 72 75 6e 2d 66 72 6f 6d 20 28 31 step:run-from (1
43a0: 29 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 )").;;
43b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
43f0: 70 72 69 6e 74 20 22 42 42 3e 20 64 6f 6e 65 20 print "BB> done
4400: 65 7a 73 74 65 70 73 3a 72 75 6e 2d 66 72 6f 6d ezsteps:run-from
4410: 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ").;;
4420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 66 'f
4460: 6f 6f 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 oo).;;
4470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
44b0: 6e 63 20 22 65 7a 73 74 65 70 20 72 75 6e 20 73 nc "ezstep run s
44c0: 69 6e 67 6c 65 20 73 74 65 70 20 22 20 73 74 65 ingle step " ste
44d0: 70 6e 61 6d 65 29 29 29 0a 3b 3b 20 20 20 20 20 pname))).;;
44e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4520: 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ).;;
4530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4560: 20 20 20 20 20 20 20 22 73 74 65 70 2d 72 75 6e "step-run
4570: 2d 63 6f 6e 74 72 6f 6c 20 61 63 74 69 6f 6e 22 -control action"
4580: 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 ))).;;
4590: 20 20 20 20 20 20 20 28 69 75 70 3a 62 75 74 74 (iup:butt
45a0: 6f 6e 20 22 52 65 2d 72 75 6e 20 61 6e 64 20 63 on "Re-run and c
45b0: 6f 6e 74 69 6e 75 65 22 20 20 20 20 20 20 20 20 ontinue"
45c0: 20 0a 3b 3b 20 09 09 20 20 20 20 20 20 20 20 20 .;; ..
45d0: 20 20 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 #:expand "HOR
45e0: 49 5a 4f 4e 54 41 4c 22 20 0a 3b 3b 20 09 09 20 IZONTAL" .;; ..
45f0: 20 20 20 20 20 20 20 20 20 20 20 23 3a 61 63 74 #:act
4600: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
4610: 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ).;;
4620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4630: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 (deb
4640: 75 67 3a 63 61 74 63 68 2d 61 6e 64 2d 64 75 6d ug:catch-and-dum
4650: 70 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 p.;;
4660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4670: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
4680: 6d 62 64 61 20 28 29 0a 3b 3b 20 09 09 09 20 20 mbda ().;; ...
4690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46a0: 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 0a 3b (thread-start!.;
46b0: 3b 20 09 09 09 20 20 20 20 20 20 20 20 20 20 20 ; ...
46c0: 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 (make-th
46d0: 72 65 61 64 20 28 6c 61 6d 62 64 61 20 28 29 0a read (lambda ().
46e0: 3b 3b 20 09 09 09 09 09 20 20 20 20 20 20 20 20 ;; .....
46f0: 20 20 20 20 20 20 20 20 20 20 28 65 7a 73 74 65 (ezste
4700: 70 73 3a 72 75 6e 2d 66 72 6f 6d 20 74 65 73 74 ps:run-from test
4710: 64 61 74 20 73 74 65 70 6e 61 6d 65 20 23 66 29 dat stepname #f)
4720: 29 0a 3b 3b 20 09 09 09 09 09 20 20 20 20 20 20 ).;; .....
4730: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20 (conc
4740: 22 65 7a 73 74 65 70 20 72 75 6e 20 66 72 6f 6d "ezstep run from
4750: 20 73 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 step " stepname
4760: 29 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 )))).;;
4770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4790: 22 64 61 73 68 62 6f 61 72 64 2d 74 65 73 74 73 "dashboard-tests
47a0: 3a 73 74 65 70 2d 72 75 6e 2d 63 6f 6e 74 72 6f :step-run-contro
47b0: 6c 20 2d 3e 20 65 7a 73 74 65 70 3a 72 75 6e 2d l -> ezstep:run-
47c0: 66 72 6f 6d 20 28 32 29 22 29 29 29 0a 3b 3b 20 from (2)"))).;;
47d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47e0: 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 43 6c 6f (iup:button "Clo
47f0: 73 65 22 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 se".;;
4800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4810: 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d #:action (lam
4820: 62 64 61 20 28 6f 62 6a 29 0a 3b 3b 20 20 20 20 bda (obj).;;
4830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4850: 20 20 20 20 28 69 75 70 3a 64 65 73 74 72 6f 79 (iup:destroy
4860: 21 20 64 6c 67 29 29 29 0a 3b 3b 20 20 20 20 20 ! dlg))).;;
4870: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 ;; (
4880: 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 65 66 72 iup:button "Refr
4890: 65 73 68 20 74 65 73 74 20 64 61 74 61 22 0a 3b esh test data".;
48a0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
48b0: 20 20 3b 3b 20 20 20 20 20 09 23 3a 65 78 70 61 ;; .#:expa
48c0: 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a nd "HORIZONTAL".
48d0: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
48e0: 20 20 20 3b 3b 20 20 20 20 20 09 23 3a 61 63 74 ;; .#:act
48f0: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
4900: 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ).;;
4910: 20 20 20 20 20 3b 3b 20 20 20 20 20 09 09 20 20 ;; ..
4920: 20 28 70 72 69 6e 74 20 22 52 65 66 72 65 73 68 (print "Refresh
4930: 20 74 65 73 74 20 64 61 74 61 20 22 20 73 74 65 test data " ste
4940: 70 6e 61 6d 65 29 29 0a 3b 3b 20 20 20 20 20 20 pname)).;;
4950: 20 20 20 20 20 20 20 20 20 20 20 29 29 29 29 0a )))).
4960: 3b 3b 20 20 20 20 20 20 20 64 6c 67 29 29 29 0a ;; dlg))).
4970: 0a 28 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f .(define (dashbo
4980: 61 72 64 2d 74 65 73 74 73 3a 77 61 69 76 65 72 ard-tests:waiver
4990: 20 72 75 6e 2d 69 64 20 74 65 73 74 64 61 74 20 run-id testdat
49a0: 6f 76 72 64 76 61 6c 20 63 6d 74 63 6d 64 29 0a ovrdval cmtcmd).
49b0: 20 20 28 6c 65 74 2a 20 28 28 77 70 61 74 74 20 (let* ((wpatt
49c0: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
49d0: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 *configdat* "set
49e0: 75 70 22 20 22 77 61 69 76 65 72 63 6f 6d 6d 65 up" "waivercomme
49f0: 6e 74 70 61 74 74 22 29 29 0a 09 20 28 77 72 65 ntpatt")).. (wre
4a00: 67 78 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 gx (if (string?
4a10: 77 70 61 74 74 29 28 72 65 67 65 78 70 20 77 70 wpatt)(regexp wp
4a20: 61 74 74 29 20 23 66 29 29 0a 09 20 28 77 6d 65 att) #f)).. (wme
4a30: 73 67 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 69 sg (iup:label (i
4a40: 66 20 77 70 61 74 74 20 28 63 6f 6e 63 20 22 43 f wpatt (conc "C
4a50: 6f 6d 6d 65 6e 74 20 6d 75 73 74 20 6d 61 74 63 omment must matc
4a60: 68 20 70 61 74 74 65 72 6e 20 22 20 77 70 61 74 h pattern " wpat
4a70: 74 29 20 22 22 29 29 29 0a 09 20 28 63 6f 6d 6e t) ""))).. (comn
4a80: 74 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 t (iup:textbox #
4a90: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda
4aa0: 28 76 61 6c 20 61 20 62 29 0a 09 09 09 09 09 28 (val a b)......(
4ab0: 69 66 20 77 70 61 74 74 0a 09 09 09 09 09 20 20 if wpatt......
4ac0: 20 20 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 (if (string-ma
4ad0: 74 63 68 20 77 72 65 67 78 20 62 29 0a 09 09 09 tch wregx b)....
4ae0: 09 09 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 ...(iup:attribut
4af0: 65 2d 73 65 74 21 20 77 6d 65 73 67 20 22 54 49 e-set! wmesg "TI
4b00: 54 4c 45 22 20 28 63 6f 6e 63 20 22 43 6f 6d 6d TLE" (conc "Comm
4b10: 65 6e 74 20 6d 61 74 63 68 65 73 20 22 20 77 70 ent matches " wp
4b20: 61 74 74 29 29 0a 09 09 09 09 09 09 28 69 75 70 att)).......(iup
4b30: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
4b40: 77 6d 65 73 67 20 22 54 49 54 4c 45 22 20 28 63 wmesg "TITLE" (c
4b50: 6f 6e 63 20 22 43 6f 6d 6d 65 6e 74 20 64 6f 65 onc "Comment doe
4b60: 73 20 6e 6f 74 20 6d 61 74 63 68 20 22 20 77 70 s not match " wp
4b70: 61 74 74 29 29 0a 09 09 09 09 09 09 29 29 29 0a att)).......))).
4b80: 09 09 09 20 20 20 20 20 23 3a 76 61 6c 75 65 20 ... #:value
4b90: 28 69 66 20 6f 76 72 64 76 61 6c 20 6f 76 72 64 (if ovrdval ovrd
4ba0: 76 61 6c 20 28 64 62 3a 74 65 73 74 2d 67 65 74 val (db:test-get
4bb0: 2d 63 6f 6d 6d 65 6e 74 20 74 65 73 74 64 61 74 -comment testdat
4bc0: 29 29 0a 09 09 09 20 20 20 20 20 23 3a 65 78 70 )).... #:exp
4bd0: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
4be0: 29 29 0a 09 20 28 64 6c 6f 67 20 20 23 66 29 29 )).. (dlog #f))
4bf0: 0a 20 20 20 20 28 73 65 74 21 20 64 6c 6f 67 20 . (set! dlog
4c00: 28 69 75 70 3a 64 69 61 6c 6f 67 20 3b 3b 20 23 (iup:dialog ;; #
4c10: 3a 63 6c 6f 73 65 5f 63 62 20 28 6c 61 6d 62 64 :close_cb (lambd
4c20: 61 20 28 61 29 28 65 78 69 74 29 29 20 3b 20 23 a (a)(exit)) ; #
4c30: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 :expand "YES"...
4c40: 23 3a 74 69 74 6c 65 20 22 53 45 54 20 57 41 49 #:title "SET WAI
4c50: 56 45 52 22 0a 09 09 28 69 75 70 3a 76 62 6f 78 VER"...(iup:vbox
4c60: 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 ; #:expand "YES
4c70: 22 0a 09 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 "... (iup:label
4c80: 28 63 6f 6e 63 20 22 45 6e 74 65 72 20 6a 75 73 (conc "Enter jus
4c90: 74 69 66 69 63 61 74 69 6f 6e 20 66 6f 72 20 77 tification for w
4ca0: 61 69 76 69 6e 67 20 74 65 73 74 20 22 0a 09 09 aiving test "...
4cb0: 09 09 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 .. (db:test-get
4cc0: 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 64 61 -testname testda
4cd0: 74 29 0a 09 09 09 09 20 20 28 69 66 20 28 65 71 t)..... (if (eq
4ce0: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
4cf0: 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 t-item-path test
4d00: 64 61 74 29 20 22 22 29 20 0a 09 09 09 09 20 20 dat) "") .....
4d10: 20 20 20 20 22 22 0a 09 09 09 09 20 20 20 20 20 "".....
4d20: 20 28 63 6f 6e 63 20 22 2f 22 20 28 64 62 3a 74 (conc "/" (db:t
4d30: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
4d40: 68 20 74 65 73 74 64 61 74 29 29 29 29 29 0a 09 h testdat)))))..
4d50: 09 20 77 6d 65 73 67 20 3b 3b 20 74 68 65 20 69 . wmesg ;; the i
4d60: 6e 66 6f 72 6d 61 74 69 6f 6e 61 6c 20 6d 73 67 nformational msg
4d70: 20 6f 6e 20 77 68 65 74 68 65 72 20 69 74 20 6d on whether it m
4d80: 61 74 63 68 65 73 0a 09 09 20 63 6f 6d 6e 74 0a atches... comnt.
4d90: 09 09 20 28 69 75 70 3a 68 62 6f 78 0a 09 09 20 .. (iup:hbox...
4da0: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 41 70 (iup:button "Ap
4db0: 70 6c 79 20 61 6e 64 20 43 6c 6f 73 65 20 22 0a ply and Close ".
4dc0: 09 09 09 20 20 20 20 20 20 23 3a 65 78 70 61 6e ... #:expan
4dd0: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 d "HORIZONTAL"..
4de0: 09 09 20 20 20 20 20 20 23 3a 61 63 74 69 6f 6e .. #:action
4df0: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 (lambda (obj)..
4e00: 09 09 09 09 20 28 6c 65 74 20 28 28 63 6f 6d 6d .... (let ((comm
4e10: 65 6e 74 20 28 69 75 70 3a 61 74 74 72 69 62 75 ent (iup:attribu
4e20: 74 65 20 63 6f 6d 6e 74 20 22 56 41 4c 55 45 22 te comnt "VALUE"
4e30: 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 ))...... (
4e40: 74 65 73 74 2d 69 64 20 28 64 62 3a 74 65 73 74 test-id (db:test
4e50: 2d 67 65 74 2d 69 64 20 74 65 73 74 64 61 74 29 -get-id testdat)
4e60: 29 29 0a 09 09 09 09 09 20 20 20 28 69 66 20 28 ))...... (if (
4e70: 6f 72 20 28 6e 6f 74 20 77 70 61 74 74 29 0a 09 or (not wpatt)..
4e80: 09 09 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d ..... (string-
4e90: 6d 61 74 63 68 20 77 72 65 67 78 20 63 6f 6d 6d match wregx comm
4ea0: 65 6e 74 29 29 0a 09 09 09 09 09 20 20 20 20 20 ent))......
4eb0: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 20 (begin.......
4ec0: 3b 3b 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 ;; (rmt:test-set
4ed0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 -state-status-by
4ee0: 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d -id run-id test-
4ef0: 69 64 20 23 66 20 22 57 41 49 56 45 44 22 20 63 id #f "WAIVED" c
4f00: 6f 6d 6d 65 6e 74 29 0a 09 09 09 09 09 09 20 28 omment)....... (
4f10: 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 rmt:test-set-sta
4f20: 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 te-status run-id
4f30: 20 74 65 73 74 2d 69 64 20 23 66 20 22 57 41 49 test-id #f "WAI
4f40: 56 45 44 22 20 63 6f 6d 6d 65 6e 74 29 0a 09 09 VED" comment)...
4f50: 09 09 09 09 20 28 64 62 3a 74 65 73 74 2d 73 65 .... (db:test-se
4f60: 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 64 61 t-status! testda
4f70: 74 20 22 57 41 49 56 45 44 22 29 0a 09 09 09 09 t "WAIVED").....
4f80: 09 09 20 28 63 6d 74 63 6d 64 20 63 6f 6d 6d 65 .. (cmtcmd comme
4f90: 6e 74 29 0a 09 09 09 09 09 09 20 28 69 75 70 3a nt)....... (iup:
4fa0: 64 65 73 74 72 6f 79 21 20 64 6c 6f 67 29 29 29 destroy! dlog)))
4fb0: 29 29 29 0a 09 09 20 20 28 69 75 70 3a 62 75 74 )))... (iup:but
4fc0: 74 6f 6e 20 22 43 61 6e 63 65 6c 22 0a 09 09 09 ton "Cancel"....
4fd0: 20 20 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 #:expand "
4fe0: 48 4f 52 49 5a 4f 4e 54 41 4c 22 20 0a 09 09 09 HORIZONTAL" ....
4ff0: 20 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 #:action (
5000: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 lambda (obj)....
5010: 09 09 20 28 69 75 70 3a 64 65 73 74 72 6f 79 21 .. (iup:destroy!
5020: 20 64 6c 6f 67 29 29 29 29 29 29 29 0a 20 20 20 dlog))))))).
5030: 20 64 6c 6f 67 29 29 0a 0a 0a 3b 3b 3d 3d 3d 3d dlog))...;;====
5040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5080: 3d 3d 0a 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ==.;;.;;========
5090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
50a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
50b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
50c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 ==============.(
50d0: 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 define (dashboar
50e0: 64 2d 74 65 73 74 73 3a 65 78 61 6d 69 6e 65 2d d-tests:examine-
50f0: 74 65 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 test run-id test
5100: 2d 69 64 29 20 3b 3b 20 72 75 6e 2d 69 64 20 72 -id) ;; run-id r
5110: 75 6e 2d 6b 65 79 20 6f 72 69 67 74 65 73 74 29 un-key origtest)
5120: 0a 20 20 28 6c 65 74 2a 20 28 28 64 62 2d 70 61 . (let* ((db-pa
5130: 74 68 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e th (common
5140: 3a 67 65 74 2d 64 62 2d 74 6d 70 2d 61 72 65 61 :get-db-tmp-area
5150: 29 29 20 3b 3b 20 28 63 6f 6e 63 20 28 63 6f 6e )) ;; (conc (con
5160: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e figf:lookup *con
5170: 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 figdat* "setup"
5180: 22 6c 69 6e 6b 74 72 65 65 22 29 20 22 2f 64 62 "linktree") "/db
5190: 2f 22 20 72 75 6e 2d 69 64 20 22 2e 64 62 22 29 /" run-id ".db")
51a0: 29 0a 09 20 28 64 62 73 74 72 75 63 74 20 20 20 ).. (dbstruct
51b0: 20 20 20 23 66 29 20 3b 3b 20 4e 4f 54 20 41 43 #f) ;; NOT AC
51c0: 54 55 41 4c 4c 59 20 55 53 45 44 20 28 64 62 3a TUALLY USED (db:
51d0: 73 65 74 75 70 29 29 20 3b 3b 20 28 6d 61 6b 65 setup)) ;; (make
51e0: 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 -dbr:dbstruct pa
51f0: 74 68 3a 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 th: (common:get
5200: 2d 64 62 2d 74 6d 70 2d 61 72 65 61 20 23 66 29 -db-tmp-area #f)
5210: 20 3b 3b 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f ;; (configf:loo
5220: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
5230: 22 73 65 74 75 70 22 20 22 6c 69 6e 6b 74 72 65 "setup" "linktre
5240: 65 22 29 20 0a 09 09 09 20 20 20 20 3b 3b 09 09 e") .... ;;..
5250: 20 20 20 6c 6f 63 61 6c 3a 20 23 74 29 29 0a 09 local: #t))..
5260: 20 28 74 65 73 74 64 61 74 20 20 20 20 20 20 20 (testdat
5270: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d 69 (rmt:get-test-i
5280: 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 nfo-by-id run-id
5290: 20 74 65 73 74 2d 69 64 29 29 20 3b 3b 20 28 64 test-id)) ;; (d
52a0: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d b:get-test-info-
52b0: 62 79 2d 69 64 20 64 62 73 74 72 75 63 74 20 72 by-id dbstruct r
52c0: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a un-id test-id)).
52d0: 09 20 28 64 62 2d 6d 6f 64 2d 74 69 6d 65 20 20 . (db-mod-time
52e0: 20 30 29 20 3b 3b 20 28 66 69 6c 65 2d 6d 6f 64 0) ;; (file-mod
52f0: 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 64 ification-time d
5300: 62 2d 70 61 74 68 29 29 0a 09 20 28 6c 61 73 74 b-path)).. (last
5310: 2d 75 70 64 61 74 65 20 20 20 30 29 20 3b 3b 20 -update 0) ;;
5320: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
5330: 29 29 0a 09 20 28 72 65 71 75 65 73 74 2d 75 70 )).. (request-up
5340: 64 61 74 65 20 23 74 29 29 0a 20 20 20 20 28 69 date #t)). (i
5350: 66 20 28 6e 6f 74 20 74 65 73 74 64 61 74 29 0a f (not testdat).
5360: 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 .(begin.. (debu
5370: 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 75 g:print 2 *defau
5380: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 lt-log-port* "ER
5390: 52 4f 52 3a 20 4e 6f 20 74 65 73 74 20 64 61 74 ROR: No test dat
53a0: 61 20 66 6f 75 6e 64 20 66 6f 72 20 74 65 73 74 a found for test
53b0: 20 22 20 74 65 73 74 2d 69 64 20 22 2c 20 65 78 " test-id ", ex
53c0: 69 74 69 6e 67 22 29 0a 09 20 20 28 65 78 69 74 iting").. (exit
53d0: 20 31 29 29 0a 09 28 6c 65 74 2a 20 28 3b 3b 20 1))..(let* (;;
53e0: 28 72 75 6e 2d 69 64 20 20 20 20 20 20 20 20 28 (run-id (
53f0: 69 66 20 74 65 73 74 64 61 74 20 28 64 62 3a 74 if testdat (db:t
5400: 65 73 74 2d 67 65 74 2d 72 75 6e 5f 69 64 20 74 est-get-run_id t
5410: 65 73 74 64 61 74 29 20 23 66 29 29 0a 09 20 20 estdat) #f))..
5420: 20 20 20 20 20 28 74 65 73 74 2d 72 65 67 69 73 (test-regis
5430: 74 72 79 20 28 74 65 73 74 73 3a 67 65 74 2d 61 try (tests:get-a
5440: 6c 6c 29 29 0a 09 20 20 20 20 20 20 20 28 6b 65 ll)).. (ke
5450: 79 64 61 74 20 20 20 20 20 20 20 20 28 69 66 20 ydat (if
5460: 74 65 73 74 64 61 74 20 28 72 6d 74 3a 67 65 74 testdat (rmt:get
5470: 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 72 -key-val-pairs r
5480: 75 6e 2d 69 64 29 20 23 66 29 29 0a 09 20 20 20 un-id) #f))..
5490: 20 20 20 20 28 72 75 6e 64 61 74 20 20 20 20 20 (rundat
54a0: 20 20 20 28 69 66 20 74 65 73 74 64 61 74 20 28 (if testdat (
54b0: 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 6f rmt:get-run-info
54c0: 20 72 75 6e 2d 69 64 29 20 23 66 29 29 0a 09 20 run-id) #f))..
54d0: 20 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 (runname
54e0: 20 20 20 20 20 28 69 66 20 74 65 73 74 64 61 74 (if testdat
54f0: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
5500: 79 2d 68 65 61 64 65 72 20 28 64 62 3a 67 65 74 y-header (db:get
5510: 2d 72 6f 77 73 20 72 75 6e 64 61 74 29 0a 09 09 -rows rundat)...
5520: 09 09 09 09 09 09 20 20 28 64 62 3a 67 65 74 2d ...... (db:get-
5530: 68 65 61 64 65 72 20 72 75 6e 64 61 74 29 0a 09 header rundat)..
5540: 09 09 09 09 09 09 09 20 20 22 72 75 6e 6e 61 6d ....... "runnam
5550: 65 22 29 20 23 66 29 29 0a 09 20 20 20 20 20 20 e") #f))..
5560: 20 3b 3b 20 28 74 64 62 20 20 20 20 20 20 20 20 ;; (tdb
5570: 20 20 20 28 74 64 62 3a 6f 70 65 6e 2d 74 65 73 (tdb:open-tes
5580: 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 2d t-db-by-test-id-
5590: 6c 6f 63 61 6c 20 64 62 73 74 72 75 63 74 20 72 local dbstruct r
55a0: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a un-id test-id)).
55b0: 09 20 20 20 20 20 20 20 3b 3b 20 54 68 65 73 65 . ;; These
55c0: 20 6e 65 78 74 20 74 77 6f 20 61 72 65 20 69 6e next two are in
55d0: 74 65 6e 74 69 6f 6e 61 6c 20 62 61 64 20 76 61 tentional bad va
55e0: 6c 75 65 73 20 74 6f 20 65 6e 73 75 72 65 20 65 lues to ensure e
55f0: 72 72 6f 72 73 20 69 66 20 74 68 65 79 20 73 68 rrors if they sh
5600: 6f 75 6c 64 20 6e 6f 74 0a 09 20 20 20 20 20 20 ould not..
5610: 20 3b 3b 20 67 65 74 20 66 69 6c 6c 65 64 20 69 ;; get filled i
5620: 6e 20 70 72 6f 70 65 72 6c 79 2e 0a 09 20 20 20 n properly...
5630: 20 20 20 20 28 6c 6f 67 66 69 6c 65 20 20 20 20 (logfile
5640: 20 20 20 22 2f 74 68 69 73 2f 64 69 72 2f 62 65 "/this/dir/be
5650: 74 74 65 72 2f 6e 6f 74 2f 65 78 69 73 74 22 29 tter/not/exist")
5660: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 64 69 72 .. (rundir
5670: 20 20 20 20 20 20 20 20 28 69 66 20 74 65 73 74 (if test
5680: 64 61 74 20 0a 09 09 09 09 20 20 28 64 62 3a 74 dat ..... (db:t
5690: 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 est-get-rundir t
56a0: 65 73 74 64 61 74 29 0a 09 09 09 09 20 20 6c 6f estdat)..... lo
56b0: 67 66 69 6c 65 29 29 0a 09 20 20 20 20 20 20 20 gfile))..
56c0: 3b 3b 20 28 74 65 73 74 64 61 74 2d 70 61 74 68 ;; (testdat-path
56d0: 20 20 28 63 6f 6e 63 20 72 75 6e 64 69 72 20 22 (conc rundir "
56e0: 2f 74 65 73 74 64 61 74 2e 64 62 22 29 29 20 3b /testdat.db")) ;
56f0: 3b 20 74 68 69 73 20 67 65 74 73 20 72 65 63 61 ; this gets reca
5700: 6c 63 75 6c 61 74 65 64 20 75 6e 74 69 6c 20 66 lculated until f
5710: 6f 75 6e 64 20 0a 20 20 20 20 20 20 20 20 20 20 ound .
5720: 20 20 20 20 20 28 61 75 67 6d 65 6e 74 2d 74 65 (augment-te
5730: 73 74 73 74 65 70 73 20 28 6c 61 6d 62 64 61 20 ststeps (lambda
5740: 28 69 6e 6c 6f 76 29 0a 20 20 20 20 20 20 20 20 (inlov).
5750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5760: 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 70 (map
5770: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5790: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 (lambda (i
57a0: 6e 76 65 63 29 0a 20 20 20 20 20 20 20 20 20 20 nvec).
57b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 (li
57d0: 73 74 2d 3e 76 65 63 74 6f 72 0a 20 20 20 20 20 st->vector.
57e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5800: 20 20 20 60 28 0a 20 20 20 20 20 20 20 20 20 20 `(.
5810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5830: 2c 40 28 72 65 76 65 72 73 65 20 28 63 64 72 20 ,@(reverse (cdr
5840: 28 72 65 76 65 72 73 65 20 28 76 65 63 74 6f 72 (reverse (vector
5850: 2d 3e 6c 69 73 74 20 69 6e 76 65 63 29 29 29 29 ->list invec))))
5860: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5880: 20 20 20 20 20 20 20 20 20 20 20 22 72 65 72 75 "reru
5890: 6e 20 74 68 69 73 20 73 74 65 70 22 20 22 72 65 n this step" "re
58a0: 73 74 61 72 74 20 66 72 6f 6d 20 68 65 72 65 22 start from here"
58b0: 20 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ))).
58c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58d0: 20 20 20 20 20 20 20 20 20 20 69 6e 6c 6f 76 29 inlov)
58e0: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
58f0: 73 74 65 70 73 20 20 20 20 20 28 69 66 20 74 65 steps (if te
5900: 73 74 64 61 74 20 28 61 75 67 6d 65 6e 74 2d 74 stdat (augment-t
5910: 65 73 74 73 74 65 70 73 20 28 74 65 73 74 73 3a eststeps (tests:
5920: 67 65 74 2d 63 6f 6d 70 72 65 73 73 65 64 2d 73 get-compressed-s
5930: 74 65 70 73 20 72 75 6e 2d 69 64 20 74 65 73 74 teps run-id test
5940: 2d 69 64 29 29 20 27 28 29 29 29 0a 09 20 20 20 -id)) '()))..
5950: 20 20 20 20 28 74 65 73 74 66 75 6c 6c 6e 61 6d (testfullnam
5960: 65 20 20 28 69 66 20 74 65 73 74 64 61 74 20 28 e (if testdat (
5970: 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c db:test-get-full
5980: 6e 61 6d 65 20 74 65 73 74 64 61 74 29 20 22 47 name testdat) "G
5990: 61 74 68 65 72 69 6e 67 20 64 61 74 61 20 2e 2e athering data ..
59a0: 2e 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 .")).. (te
59b0: 73 74 6e 61 6d 65 20 20 20 20 20 20 28 69 66 20 stname (if
59c0: 74 65 73 74 64 61 74 20 28 64 62 3a 74 65 73 74 testdat (db:test
59d0: 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 -get-testname te
59e0: 73 74 64 61 74 29 20 22 6e 2f 61 22 29 29 0a 09 stdat) "n/a"))..
59f0: 20 20 20 20 20 20 20 3b 3b 20 28 74 65 73 74 73 ;; (tests
5a00: 3a 67 65 74 2d 74 65 73 74 63 6f 6e 66 69 67 20 :get-testconfig
5a10: 74 65 73 74 64 61 74 20 74 65 73 74 6e 61 6d 65 testdat testname
5a20: 20 27 72 65 74 75 72 6e 2d 70 72 6f 63 73 29 29 'return-procs))
5a30: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 6d 65 .. (testme
5a40: 74 61 20 20 20 20 20 20 28 69 66 20 74 65 73 74 ta (if test
5a50: 64 61 74 20 0a 09 09 09 09 20 20 28 6c 65 74 20 dat ..... (let
5a60: 28 28 74 6d 20 28 72 6d 74 3a 74 65 73 74 6d 65 ((tm (rmt:testme
5a70: 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 20 74 65 ta-get-record te
5a80: 73 74 6e 61 6d 65 29 29 29 0a 09 09 09 09 20 20 stname))).....
5a90: 20 20 28 69 66 20 74 6d 20 74 6d 20 28 6d 61 6b (if tm tm (mak
5aa0: 65 2d 64 62 3a 74 65 73 74 6d 65 74 61 29 29 29 e-db:testmeta)))
5ab0: 0a 09 09 09 09 20 20 28 6d 61 6b 65 2d 64 62 3a ..... (make-db:
5ac0: 74 65 73 74 6d 65 74 61 29 29 29 0a 0a 09 20 20 testmeta)))...
5ad0: 20 20 20 20 20 28 6b 65 79 73 74 72 69 6e 67 20 (keystring
5ae0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
5af0: 65 72 73 65 20 0a 09 09 09 20 20 20 20 28 6d 61 erse .... (ma
5b00: 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 76 61 p (lambda (keyva
5b10: 6c 29 0a 09 09 09 09 20 20 20 3b 3b 20 28 63 6f l)..... ;; (co
5b20: 6e 63 20 22 3a 22 20 28 63 61 72 20 6b 65 79 76 nc ":" (car keyv
5b30: 61 6c 29 20 22 20 22 20 28 63 61 64 72 20 6b 65 al) " " (cadr ke
5b40: 79 76 61 6c 29 29 29 0a 09 09 09 09 20 20 20 28 yval)))..... (
5b50: 63 61 64 72 20 6b 65 79 76 61 6c 29 29 0a 09 09 cadr keyval))...
5b60: 09 09 20 6b 65 79 64 61 74 29 0a 09 09 09 20 20 .. keydat)....
5b70: 20 20 22 2f 22 29 29 0a 09 20 20 20 20 20 20 20 "/"))..
5b80: 28 69 74 65 6d 2d 70 61 74 68 20 20 28 64 62 3a (item-path (db:
5b90: 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 test-get-item-pa
5ba0: 74 68 20 74 65 73 74 64 61 74 29 29 0a 09 20 20 th testdat))..
5bb0: 20 20 20 20 20 3b 3b 20 74 68 69 73 20 6e 65 78 ;; this nex
5bc0: 74 20 62 6c 6f 63 6b 20 77 61 73 20 61 64 64 65 t block was adde
5bd0: 64 20 74 6f 20 66 69 78 20 61 20 62 75 67 20 77 d to fix a bug w
5be0: 68 65 72 65 20 76 61 72 69 61 62 6c 65 73 20 77 here variables w
5bf0: 65 72 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ere.
5c00: 20 20 20 3b 3b 20 6e 65 65 64 65 64 2e 20 52 65 ;; needed. Re
5c10: 76 69 73 69 74 20 74 68 69 73 2e 0a 09 20 20 20 visit this...
5c20: 20 20 20 20 28 72 75 6e 63 6f 6e 66 69 67 20 20 (runconfig
5c30: 28 6c 65 74 20 28 28 72 75 6e 63 6f 6e 66 69 67 (let ((runconfig
5c40: 66 20 28 63 6f 6e 63 20 20 2a 74 6f 70 70 61 74 f (conc *toppat
5c50: 68 2a 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e h* "/runconfigs.
5c60: 63 6f 6e 66 69 67 22 29 29 29 20 3b 3b 20 6e 6f config"))) ;; no
5c70: 20 72 75 73 68 20 62 75 74 20 69 74 20 77 6f 75 rush but it wou
5c80: 6c 64 20 62 65 20 67 6f 6f 64 20 74 6f 20 63 6f ld be good to co
5c90: 6e 76 65 72 74 20 74 68 69 73 20 63 61 6c 6c 20 nvert this call
5ca0: 74 6f 20 75 73 65 20 72 75 6e 63 6f 6e 66 69 67 to use runconfig
5cb0: 3a 72 65 61 64 0a 09 20 09 09 20 20 20 20 20 28 :read.. .. (
5cc0: 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d if (common:file-
5cd0: 65 78 69 73 74 73 3f 20 72 75 6e 63 6f 6e 66 69 exists? runconfi
5ce0: 67 66 29 0a 09 20 09 09 09 20 28 68 61 6e 64 6c gf).. ... (handl
5cf0: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 e-exceptions.
5d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d20: 20 20 65 78 6e 0a 09 09 09 09 20 20 20 28 62 65 exn..... (be
5d30: 67 69 6e 0a 09 09 09 09 20 20 20 20 20 28 64 65 gin..... (de
5d40: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
5d50: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
5d60: 66 61 69 6c 65 64 20 74 6f 20 73 65 74 20 75 70 failed to set up
5d70: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 66 6f 72 environment for
5d80: 20 22 20 72 75 6e 63 6f 6e 66 69 67 66 20 22 2c " runconfigf ",
5d90: 20 65 78 6e 3d 22 20 65 78 6e 29 0a 20 20 20 20 exn=" exn).
5da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5dc0: 20 23 66 29 20 20 3b 3b 20 64 6f 20 6e 6f 74 68 #f) ;; do noth
5dd0: 69 6e 67 2c 20 6a 75 73 74 20 6b 65 65 70 20 6f ing, just keep o
5de0: 6e 20 74 72 75 63 6b 69 6e 67 20 2e 2e 2e 2e 0a n trucking .....
5df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e10: 20 20 20 28 73 65 74 75 70 2d 65 6e 76 2d 64 65 (setup-env-de
5e20: 66 61 75 6c 74 73 20 72 75 6e 63 6f 6e 66 69 67 faults runconfig
5e30: 66 20 72 75 6e 2d 69 64 20 28 6d 61 6b 65 2d 68 f run-id (make-h
5e40: 61 73 68 2d 74 61 62 6c 65 29 20 6b 65 79 64 61 ash-table) keyda
5e50: 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 t environ-patt:
5e60: 6b 65 79 73 74 72 69 6e 67 29 29 0a 09 20 09 09 keystring)).. ..
5e70: 09 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 . (make-hash-tab
5e80: 6c 65 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 le)))).. (
5e90: 74 65 73 74 63 6f 6e 66 69 67 20 20 20 20 28 62 testconfig (b
5ea0: 65 67 69 6e 0a 09 09 09 09 3b 3b 20 28 72 75 6e egin.....;; (run
5eb0: 73 3a 73 65 74 2d 6d 65 67 61 74 65 73 74 2d 65 s:set-megatest-e
5ec0: 6e 76 2d 76 61 72 73 20 72 75 6e 2d 69 64 20 69 nv-vars run-id i
5ed0: 6e 72 75 6e 6e 61 6d 65 3a 20 72 75 6e 6e 61 6d nrunname: runnam
5ee0: 65 20 74 65 73 74 6e 61 6d 65 3a 20 74 65 73 74 e testname: test
5ef0: 2d 6e 61 6d 65 20 69 74 65 6d 70 61 74 68 3a 20 -name itempath:
5f00: 69 74 65 6d 2d 70 61 74 68 29 0a 09 09 09 09 28 item-path).....(
5f10: 72 75 6e 73 3a 73 65 74 2d 6d 65 67 61 74 65 73 runs:set-megates
5f20: 74 2d 65 6e 76 2d 76 61 72 73 20 72 75 6e 2d 69 t-env-vars run-i
5f30: 64 20 69 6e 6b 65 79 76 61 6c 73 3a 20 6b 65 79 d inkeyvals: key
5f40: 64 61 74 20 69 6e 72 75 6e 6e 61 6d 65 3a 20 72 dat inrunname: r
5f50: 75 6e 6e 61 6d 65 20 69 6e 74 61 72 67 65 74 3a unname intarget:
5f60: 20 6b 65 79 73 74 72 69 6e 67 20 74 65 73 74 6e keystring testn
5f70: 61 6d 65 3a 20 74 65 73 74 6e 61 6d 65 20 69 74 ame: testname it
5f80: 65 6d 70 61 74 68 3a 20 69 74 65 6d 2d 70 61 74 empath: item-pat
5f90: 68 29 20 3b 3b 20 74 68 65 73 65 20 6d 61 79 20 h) ;; these may
5fa0: 62 65 20 6e 65 65 64 65 64 20 62 79 20 74 68 65 be needed by the
5fb0: 20 6c 61 75 6e 63 68 69 6e 67 20 70 72 6f 63 65 launching proce
5fc0: 73 73 0a 09 09 09 09 28 68 61 6e 64 6c 65 2d 65 ss.....(handle-e
5fd0: 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 09 20 20 xceptions.....
5fe0: 20 20 65 78 6e 20 20 3b 3b 20 4e 4f 54 45 3a 20 exn ;; NOTE:
5ff0: 49 27 76 65 20 6e 6f 20 69 64 65 61 20 77 68 79 I've no idea why
6000: 20 74 68 69 73 20 77 61 73 20 77 72 69 74 74 65 this was writte
6010: 6e 20 74 68 69 73 20 77 61 79 2e 20 52 65 73 65 n this way. Rese
6020: 61 72 63 68 2c 20 73 74 75 64 79 20 61 6e 64 20 arch, study and
6030: 66 69 78 20 6e 65 65 64 65 64 21 0a 09 09 09 09 fix needed!.....
6040: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 20 (begin.....
6050: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
6060: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
6070: 74 2a 20 22 74 65 73 74 63 6f 6e 66 69 67 20 6c t* "testconfig l
6080: 6f 61 64 20 75 73 69 6e 67 20 22 20 69 74 65 6d oad using " item
6090: 2d 70 61 74 68 20 22 20 66 61 69 6c 65 64 2c 20 -path " failed,
60a0: 74 72 79 69 6e 67 20 22 20 28 64 62 3a 74 65 73 trying " (db:tes
60b0: 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 t-get-item-path
60c0: 74 65 73 74 64 61 74 29 20 22 2c 20 65 78 6e 3d testdat) ", exn=
60d0: 22 20 65 78 6e 29 0a 09 09 09 09 20 20 20 20 28 " exn)..... (
60e0: 74 65 73 74 73 3a 67 65 74 2d 74 65 73 74 63 6f tests:get-testco
60f0: 6e 66 69 67 20 28 64 62 3a 74 65 73 74 2d 67 65 nfig (db:test-ge
6100: 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 64 t-testname testd
6110: 61 74 29 20 28 64 62 3a 74 65 73 74 2d 67 65 74 at) (db:test-get
6120: 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 64 -item-path testd
6130: 61 74 29 20 74 65 73 74 2d 72 65 67 69 73 74 72 at) test-registr
6140: 79 20 23 66 20 61 6c 6c 6f 77 2d 77 72 69 74 65 y #f allow-write
6150: 2d 63 61 63 68 65 3a 20 23 66 29 29 0a 09 09 09 -cache: #f))....
6160: 09 20 20 28 74 65 73 74 73 3a 67 65 74 2d 74 65 . (tests:get-te
6170: 73 74 63 6f 6e 66 69 67 20 28 64 62 3a 74 65 73 stconfig (db:tes
6180: 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 t-get-testname t
6190: 65 73 74 64 61 74 29 20 69 74 65 6d 2d 70 61 74 estdat) item-pat
61a0: 68 20 74 65 73 74 2d 72 65 67 69 73 74 72 79 20 h test-registry
61b0: 23 74 20 61 6c 6c 6f 77 2d 77 72 69 74 65 2d 63 #t allow-write-c
61c0: 61 63 68 65 3a 20 23 66 29 29 29 29 0a 09 20 20 ache: #f))))..
61d0: 20 20 20 20 20 28 76 69 65 77 6c 6f 67 20 20 20 (viewlog
61e0: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x)....
61f0: 20 20 20 20 20 28 69 66 20 28 63 6f 6d 6d 6f 6e (if (common
6200: 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6f :file-exists? lo
6210: 67 66 69 6c 65 29 0a 09 09 09 09 09 3b 28 73 79 gfile)......;(sy
6220: 73 74 65 6d 20 28 63 6f 6e 63 20 22 66 69 72 65 stem (conc "fire
6230: 66 6f 78 20 22 20 6c 6f 67 66 69 6c 65 20 22 26 fox " logfile "&
6240: 22 29 29 0a 09 09 09 09 20 28 64 63 6f 6d 6d 6f "))..... (dcommo
6250: 6e 3a 72 75 6e 2d 68 74 6d 6c 2d 76 69 65 77 65 n:run-html-viewe
6260: 72 20 6c 6f 67 66 69 6c 65 29 0a 09 09 09 09 20 r logfile).....
6270: 28 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 20 (message-window
6280: 28 63 6f 6e 63 20 22 46 69 6c 65 20 22 20 6c 6f (conc "File " lo
6290: 67 66 69 6c 65 20 22 20 6e 6f 74 20 66 6f 75 6e gfile " not foun
62a0: 64 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 d")))))..
62b0: 28 76 69 65 77 2d 61 2d 6c 6f 67 20 28 6c 61 6d (view-a-log (lam
62c0: 62 64 61 20 28 6c 66 69 6c 65 29 20 0a 09 09 09 bda (lfile) ....
62d0: 20 20 20 20 20 28 6c 65 74 20 28 28 6c 66 69 6c (let ((lfil
62e0: 65 6e 61 6d 65 20 28 63 6f 6e 63 20 72 75 6e 64 ename (conc rund
62f0: 69 72 20 22 2f 22 20 6c 66 69 6c 65 29 29 29 0a ir "/" lfile))).
6300: 09 09 09 20 20 20 20 20 20 20 3b 3b 20 28 70 72 ... ;; (pr
6310: 69 6e 74 20 22 6c 66 69 6c 65 6e 61 6d 65 3a 20 int "lfilename:
6320: 22 20 6c 66 69 6c 65 6e 61 6d 65 29 0a 09 09 09 " lfilename)....
6330: 20 20 20 20 20 20 20 28 69 66 20 28 63 6f 6d 6d (if (comm
6340: 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
6350: 6c 66 69 6c 65 6e 61 6d 65 29 0a 09 09 09 09 09 lfilename)......
6360: 3b 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 ;(system (conc "
6370: 66 69 72 65 66 6f 78 20 22 20 6c 6f 67 66 69 6c firefox " logfil
6380: 65 20 22 26 22 29 29 0a 09 09 09 09 20 20 20 28 e "&"))..... (
6390: 64 63 6f 6d 6d 6f 6e 3a 72 75 6e 2d 68 74 6d 6c dcommon:run-html
63a0: 2d 76 69 65 77 65 72 20 6c 66 69 6c 65 6e 61 6d -viewer lfilenam
63b0: 65 29 0a 09 09 09 09 20 20 20 28 6d 65 73 73 61 e)..... (messa
63c0: 67 65 2d 77 69 6e 64 6f 77 20 28 63 6f 6e 63 20 ge-window (conc
63d0: 22 46 69 6c 65 20 22 20 6c 66 69 6c 65 6e 61 6d "File " lfilenam
63e0: 65 20 22 20 6e 6f 74 20 66 6f 75 6e 64 22 29 29 e " not found"))
63f0: 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 78 74 )))).. (xt
6400: 65 72 6d 20 20 20 20 20 20 28 6c 61 6d 62 64 61 erm (lambda
6410: 20 28 78 29 0a 09 09 09 20 20 20 20 20 28 69 66 (x).... (if
6420: 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 (directory-exis
6430: 74 73 3f 20 72 75 6e 64 69 72 29 0a 09 09 09 09 ts? rundir).....
6440: 20 28 6c 65 74 20 28 28 73 68 65 6c 6c 20 28 69 (let ((shell (i
6450: 66 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 f (get-environme
6460: 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 53 48 45 nt-variable "SHE
6470: 4c 4c 22 29 20 0a 09 09 09 09 09 09 20 20 28 63 LL") ....... (c
6480: 6f 6e 63 20 22 2d 65 20 22 20 28 67 65 74 2d 65 onc "-e " (get-e
6490: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
64a0: 62 6c 65 20 22 53 48 45 4c 4c 22 29 29 0a 09 09 ble "SHELL"))...
64b0: 09 09 09 09 20 20 22 22 29 29 29 0a 09 09 09 09 .... ""))).....
64c0: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 77 69 74 68 6f (common:witho
64d0: 75 74 2d 76 61 72 73 0a 09 09 09 09 20 20 20 20 ut-vars.....
64e0: 28 63 6f 6e 63 20 22 63 64 20 22 20 72 75 6e 64 (conc "cd " rund
64f0: 69 72 20 0a 09 09 09 09 09 20 20 22 3b 6d 74 5f ir ...... ";mt_
6500: 78 74 65 72 6d 20 2d 54 20 5c 22 22 20 28 73 74 xterm -T \"" (st
6510: 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 74 ring-translate t
6520: 65 73 74 66 75 6c 6c 6e 61 6d 65 20 22 28 29 22 estfullname "()"
6530: 20 22 20 20 22 29 20 22 5c 22 20 22 20 73 68 65 " ") "\" " she
6540: 6c 6c 20 22 26 22 29 0a 09 09 09 09 20 20 20 20 ll "&").....
6550: 22 4d 54 5f 2e 2a 22 29 29 0a 09 09 09 09 20 28 "MT_.*"))..... (
6560: 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 20 20 message-window
6570: 28 63 6f 6e 63 20 22 44 69 72 65 63 74 6f 72 79 (conc "Directory
6580: 20 22 20 72 75 6e 64 69 72 20 22 20 6e 6f 74 20 " rundir " not
6590: 66 6f 75 6e 64 22 29 29 29 29 29 0a 09 20 20 20 found")))))..
65a0: 20 20 20 20 28 77 69 64 67 65 74 73 20 20 20 20 (widgets
65b0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
65c0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 66 72 )).. (refr
65d0: 65 73 68 64 61 74 20 28 6c 61 6d 62 64 61 20 28 eshdat (lambda (
65e0: 29 0a 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 ).... (let*
65f0: 28 28 63 75 72 72 2d 6d 6f 64 2d 74 69 6d 65 20 ((curr-mod-time
6600: 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 (file-modificati
6610: 6f 6e 2d 74 69 6d 65 20 64 62 2d 70 61 74 68 29 on-time db-path)
6620: 29 0a 09 09 09 09 20 20 20 20 20 20 20 20 20 20 ).....
6630: 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 ;;
6640: 28 6d 61 78 20 2e 2e 2e 2e 2e 20 28 69 66 20 28 (max ..... (if (
6650: 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 common:file-exis
6660: 74 73 3f 20 74 65 73 74 64 61 74 2d 70 61 74 68 ts? testdat-path
6670: 29 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 )....... ;;
6680: 20 20 20 09 20 20 20 20 20 20 28 66 69 6c 65 2d . (file-
6690: 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d modification-tim
66a0: 65 20 74 65 73 74 64 61 74 2d 70 61 74 68 29 0a e testdat-path).
66b0: 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 ...... ;;
66c0: 20 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 . (begin..
66d0: 09 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 20 ..... ;;
66e0: 09 09 28 73 65 74 21 20 74 65 73 74 64 61 74 2d ..(set! testdat-
66f0: 70 61 74 68 20 28 63 6f 6e 63 20 72 75 6e 64 69 path (conc rundi
6700: 72 20 22 2f 74 65 73 74 64 61 74 2e 64 62 22 29 r "/testdat.db")
6710: 29 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 )....... ;;
6720: 20 20 20 09 09 30 29 29 29 29 0a 09 09 09 09 20 ..0)))).....
6730: 20 20 20 28 6e 65 65 64 2d 75 70 64 61 74 65 20 (need-update
6740: 20 20 28 6f 72 20 28 61 6e 64 20 28 3e 3d 20 63 (or (and (>= c
6750: 75 72 72 2d 6d 6f 64 2d 74 69 6d 65 20 64 62 2d urr-mod-time db-
6760: 6d 6f 64 2d 74 69 6d 65 29 0a 09 09 09 09 09 09 mod-time).......
6770: 09 20 20 20 20 28 3e 20 28 63 75 72 72 65 6e 74 . (> (current
6780: 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 28 2b -milliseconds)(+
6790: 20 6c 61 73 74 2d 75 70 64 61 74 65 20 32 35 30 last-update 250
67a0: 29 29 29 20 3b 3b 20 65 76 65 72 79 20 68 61 6c ))) ;; every hal
67b0: 66 20 73 65 63 6f 6e 64 73 20 69 66 20 64 62 20 f seconds if db
67c0: 74 6f 75 63 68 65 64 0a 09 09 09 09 09 09 20 20 touched.......
67d0: 20 20 20 20 20 28 3e 20 28 63 75 72 72 65 6e 74 (> (current
67e0: 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 28 2b -milliseconds)(+
67f0: 20 6c 61 73 74 2d 75 70 64 61 74 65 20 31 30 30 last-update 100
6800: 30 30 29 29 20 20 20 20 20 3b 3b 20 66 6f 72 63 00)) ;; forc
6810: 65 20 75 70 64 61 74 65 20 65 76 65 6e 20 31 30 e update even 10
6820: 20 73 65 63 6f 6e 64 73 0a 09 09 09 09 09 09 20 seconds.......
6830: 20 20 20 20 20 20 72 65 71 75 65 73 74 2d 75 70 request-up
6840: 64 61 74 65 29 29 0a 09 09 09 09 20 20 20 20 28 date))..... (
6850: 6e 65 77 74 65 73 74 64 61 74 20 28 69 66 20 6e newtestdat (if n
6860: 65 65 64 2d 75 70 64 61 74 65 20 0a 09 09 09 09 eed-update .....
6870: 09 09 20 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 42 .. ;; NOTE: B
6880: 55 47 20 48 49 44 45 52 2c 20 74 72 79 20 74 6f UG HIDER, try to
6890: 20 65 6c 69 6d 69 6e 61 74 65 20 74 68 69 73 20 eliminate this
68a0: 65 78 63 65 70 74 69 6f 6e 20 68 61 6e 64 6c 65 exception handle
68b0: 72 0a 09 09 09 09 09 09 20 20 20 20 28 68 61 6e r....... (han
68c0: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
68d0: 09 09 09 09 09 09 65 78 6e 0a 09 09 09 09 09 09 ......exn.......
68e0: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 (begin....
68f0: 09 09 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 ....(debug:print
6900: 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
6910: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 74 65 73 74 -log-port* "test
6920: 20 64 62 20 61 63 63 65 73 73 20 69 73 73 75 65 db access issue
6930: 20 69 6e 20 65 78 61 6d 69 6e 65 20 74 65 73 74 in examine test
6940: 20 66 6f 72 20 72 75 6e 2d 69 64 20 22 20 72 75 for run-id " ru
6950: 6e 2d 69 64 0a 09 09 09 09 09 09 09 09 09 20 20 n-id..........
6960: 22 2c 20 74 65 73 74 2d 69 64 20 22 20 74 65 73 ", test-id " tes
6970: 74 2d 69 64 20 22 3a 20 22 20 28 28 63 6f 6e 64 t-id ": " ((cond
6980: 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 ition-property-a
6990: 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 ccessor 'exn 'me
69a0: 73 73 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 ssage) exn) ", e
69b0: 78 6e 3d 22 20 65 78 6e 29 0a 09 09 09 09 09 09 xn=" exn).......
69c0: 09 23 66 29 0a 09 09 09 09 09 09 20 20 20 20 20 .#f).......
69d0: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d 69 (rmt:get-test-i
69e0: 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 nfo-by-id run-id
69f0: 20 74 65 73 74 2d 69 64 29 29 29 29 29 0a 09 09 test-id)))))...
6a00: 09 20 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e . ;; (prin
6a10: 74 20 22 49 4e 46 4f 3a 20 6e 65 65 64 2d 75 70 t "INFO: need-up
6a20: 64 61 74 65 3d 20 22 20 6e 65 65 64 2d 75 70 64 date= " need-upd
6a30: 61 74 65 20 22 20 63 75 72 72 2d 6d 6f 64 2d 74 ate " curr-mod-t
6a40: 69 6d 65 20 3d 20 22 20 63 75 72 72 2d 6d 6f 64 ime = " curr-mod
6a50: 2d 74 69 6d 65 29 0a 09 09 09 20 20 20 20 20 20 -time)....
6a60: 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 61 6e 64 (cond.....((and
6a70: 20 6e 65 65 64 2d 75 70 64 61 74 65 20 6e 65 77 need-update new
6a80: 74 65 73 74 64 61 74 29 0a 09 09 09 09 20 28 73 testdat)..... (s
6a90: 65 74 21 20 74 65 73 74 64 61 74 20 6e 65 77 74 et! testdat newt
6aa0: 65 73 74 64 61 74 29 0a 09 09 09 09 20 28 73 65 estdat)..... (se
6ab0: 74 21 20 74 65 73 74 73 74 65 70 73 20 20 20 20 t! teststeps
6ac0: 28 61 75 67 6d 65 6e 74 2d 74 65 73 74 73 74 65 (augment-testste
6ad0: 70 73 20 28 74 65 73 74 73 3a 67 65 74 2d 63 6f ps (tests:get-co
6ae0: 6d 70 72 65 73 73 65 64 2d 73 74 65 70 73 20 72 mpressed-steps r
6af0: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 29 un-id test-id)))
6b00: 0a 09 09 09 09 20 28 73 65 74 21 20 6c 6f 67 66 ..... (set! logf
6b10: 69 6c 65 20 20 20 20 20 20 28 63 6f 6e 63 20 28 ile (conc (
6b20: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 db:test-get-rund
6b30: 69 72 20 74 65 73 74 64 61 74 29 20 22 2f 22 20 ir testdat) "/"
6b40: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 69 6e (db:test-get-fin
6b50: 61 6c 5f 6c 6f 67 66 20 74 65 73 74 64 61 74 29 al_logf testdat)
6b60: 29 29 0a 09 09 09 09 20 28 73 65 74 21 20 72 75 ))..... (set! ru
6b70: 6e 64 69 72 20 20 20 20 20 20 20 3b 3b 20 28 66 ndir ;; (f
6b80: 69 6c 65 64 62 3a 67 65 74 2d 70 61 74 68 20 2a iledb:get-path *
6b90: 66 64 62 2a 20 0a 09 09 09 09 20 20 20 20 20 20 fdb* .....
6ba0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru
6bb0: 6e 64 69 72 20 74 65 73 74 64 61 74 29 29 20 3b ndir testdat)) ;
6bc0: 3b 20 29 0a 09 09 09 09 20 28 73 65 74 21 20 74 ; )..... (set! t
6bd0: 65 73 74 66 75 6c 6c 6e 61 6d 65 20 28 64 62 3a estfullname (db:
6be0: 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d test-get-fullnam
6bf0: 65 20 74 65 73 74 64 61 74 29 29 0a 09 09 09 09 e testdat)).....
6c00: 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ;; (debug:print
6c10: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
6c20: 70 6f 72 74 2a 20 22 49 4e 46 4f 3a 20 74 65 73 port* "INFO: tes
6c30: 74 73 74 65 70 73 3d 22 20 28 69 6e 74 65 72 73 tsteps=" (inters
6c40: 70 65 72 73 65 20 74 65 73 74 73 74 65 70 73 20 perse teststeps
6c50: 22 5c 6e 20 20 20 20 22 29 29 0a 09 09 09 09 20 "\n ")).....
6c60: 0a 09 09 09 09 20 3b 3b 20 49 20 64 6f 6e 27 74 ..... ;; I don't
6c70: 20 73 65 65 20 77 68 79 20 74 68 69 73 20 77 61 see why this wa
6c80: 73 20 69 6d 70 6c 65 6d 65 6e 74 65 64 20 74 68 s implemented th
6c90: 69 73 20 77 61 79 2e 20 50 6c 65 61 73 65 20 63 is way. Please c
6ca0: 6f 6d 6d 65 6e 74 20 69 74 20 2e 2e 2e 0a 09 09 omment it ......
6cb0: 09 09 20 3b 3b 20 28 69 66 20 28 65 71 3f 20 63 .. ;; (if (eq? c
6cc0: 75 72 72 2d 6d 6f 64 2d 74 69 6d 65 20 64 62 2d urr-mod-time db-
6cd0: 6d 6f 64 2d 74 69 6d 65 29 20 3b 3b 20 64 6f 20 mod-time) ;; do
6ce0: 6f 6e 6c 79 20 6f 6e 63 65 20 69 66 20 73 61 6d only once if sam
6cf0: 65 0a 09 09 09 09 20 3b 3b 20 20 20 20 20 28 73 e..... ;; (s
6d00: 65 74 21 20 64 62 2d 6d 6f 64 2d 74 69 6d 65 20 et! db-mod-time
6d10: 28 2b 20 63 75 72 72 2d 6d 6f 64 2d 74 69 6d 65 (+ curr-mod-time
6d20: 20 31 29 29 0a 09 09 09 09 20 3b 3b 20 20 20 20 1))..... ;;
6d30: 20 28 73 65 74 21 20 64 62 2d 6d 6f 64 2d 74 69 (set! db-mod-ti
6d40: 6d 65 20 63 75 72 72 2d 6d 6f 64 2d 74 69 6d 65 me curr-mod-time
6d50: 29 29 0a 0a 09 09 09 09 20 28 69 66 20 28 6e 6f ))...... (if (no
6d60: 74 20 28 65 71 3f 20 63 75 72 72 2d 6d 6f 64 2d t (eq? curr-mod-
6d70: 74 69 6d 65 20 64 62 2d 6d 6f 64 2d 74 69 6d 65 time db-mod-time
6d80: 29 29 0a 09 09 09 09 20 20 20 20 20 28 73 65 74 ))..... (set
6d90: 21 20 64 62 2d 6d 6f 64 2d 74 69 6d 65 20 63 75 ! db-mod-time cu
6da0: 72 72 2d 6d 6f 64 2d 74 69 6d 65 29 29 0a 09 09 rr-mod-time))...
6db0: 09 09 20 28 73 65 74 21 20 6c 61 73 74 2d 75 70 .. (set! last-up
6dc0: 64 61 74 65 20 28 63 75 72 72 65 6e 74 2d 6d 69 date (current-mi
6dd0: 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a 09 09 09 lliseconds))....
6de0: 09 20 28 73 65 74 21 20 72 65 71 75 65 73 74 2d . (set! request-
6df0: 75 70 64 61 74 65 20 23 66 29 20 3b 3b 20 6d 65 update #f) ;; me
6e00: 74 20 74 68 65 20 6e 65 65 64 20 2e 2e 2e 0a 09 t the need .....
6e10: 09 09 09 20 29 0a 09 09 09 09 28 6e 65 65 64 2d ... ).....(need-
6e20: 75 70 64 61 74 65 20 3b 3b 20 69 66 20 74 68 69 update ;; if thi
6e30: 73 20 77 61 73 20 74 72 75 65 20 61 6e 64 20 79 s was true and y
6e40: 65 74 20 74 68 65 72 65 20 69 73 20 6e 6f 20 64 et there is no d
6e50: 61 74 61 20 2e 2e 2e 2e 0a 09 09 09 09 20 28 64 ata ......... (d
6e60: 62 3a 74 65 73 74 2d 73 65 74 2d 74 65 73 74 6e b:test-set-testn
6e70: 61 6d 65 21 20 74 65 73 74 64 61 74 20 22 44 45 ame! testdat "DE
6e80: 41 44 20 4f 52 20 44 45 4c 45 54 45 44 20 54 45 AD OR DELETED TE
6e90: 53 54 22 29 29 29 0a 09 09 09 20 20 20 20 20 20 ST")))....
6ea0: 20 28 69 66 20 6e 65 65 64 2d 75 70 64 61 74 65 (if need-update
6eb0: 0a 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 ..... (begin..
6ec0: 09 09 09 20 20 20 20 20 3b 3b 20 75 70 64 61 74 ... ;; updat
6ed0: 65 20 74 68 65 20 67 75 69 20 65 6c 65 6d 65 6e e the gui elemen
6ee0: 74 73 20 68 65 72 65 0a 09 09 09 09 20 20 20 20 ts here.....
6ef0: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 (for-each .....
6f00: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6b (lambda (k
6f10: 65 79 29 0a 09 09 09 09 09 3b 3b 20 28 70 72 69 ey)......;; (pri
6f20: 6e 74 20 22 55 70 64 61 74 69 6e 67 20 22 20 6b nt "Updating " k
6f30: 65 79 29 0a 09 09 09 09 09 28 28 68 61 73 68 2d ey)......((hash-
6f40: 74 61 62 6c 65 2d 72 65 66 20 77 69 64 67 65 74 table-ref widget
6f50: 73 20 6b 65 79 29 20 74 65 73 74 64 61 74 29 29 s key) testdat))
6f60: 0a 09 09 09 09 20 20 20 20 20 20 28 68 61 73 68 ..... (hash
6f70: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 77 69 64 67 -table-keys widg
6f80: 65 74 73 29 29 0a 09 09 09 09 20 20 20 20 20 28 ets))..... (
6f90: 75 70 64 61 74 65 2d 73 74 61 74 65 2d 73 74 61 update-state-sta
6fa0: 74 75 73 2d 62 75 74 74 6f 6e 73 20 74 65 73 74 tus-buttons test
6fb0: 64 61 74 29 29 29 0a 09 09 09 20 20 20 20 20 20 dat)))....
6fc0: 20 3b 3b 20 28 69 75 70 3a 72 65 66 72 65 73 68 ;; (iup:refresh
6fd0: 20 73 65 6c 66 29 0a 09 09 09 20 20 20 20 20 20 self)....
6fe0: 20 29 29 29 0a 09 20 20 20 20 20 20 20 28 6d 65 ))).. (me
6ff0: 74 61 2d 77 69 64 67 65 74 73 20 28 6d 61 6b 65 ta-widgets (make
7000: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 -hash-table))..
7010: 20 20 20 20 20 20 28 73 65 6c 66 20 20 20 20 20 (self
7020: 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 #f)..
7030: 28 73 74 6f 72 65 2d 6c 61 62 65 6c 20 20 28 6c (store-label (l
7040: 61 6d 62 64 61 20 28 6e 61 6d 65 20 6c 62 6c 20 ambda (name lbl
7050: 63 6d 64 29 0a 09 09 09 20 20 20 20 20 20 20 28 cmd).... (
7060: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
7070: 77 69 64 67 65 74 73 20 6e 61 6d 65 20 0a 09 09 widgets name ...
7080: 09 09 09 09 28 6c 61 6d 62 64 61 20 28 74 65 73 ....(lambda (tes
7090: 74 64 61 74 29 0a 09 09 09 09 09 09 20 20 28 6c tdat)....... (l
70a0: 65 74 20 28 28 6e 65 77 76 61 6c 20 28 63 6d 64 et ((newval (cmd
70b0: 20 74 65 73 74 64 61 74 29 29 0a 09 09 09 09 09 testdat))......
70c0: 09 09 28 6f 6c 64 76 61 6c 20 28 69 75 70 3a 61 ..(oldval (iup:a
70d0: 74 74 72 69 62 75 74 65 20 6c 62 6c 20 22 54 49 ttribute lbl "TI
70e0: 54 4c 45 22 29 29 29 0a 09 09 09 09 09 09 20 20 TLE"))).......
70f0: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 (if (not (equa
7100: 6c 3f 20 6e 65 77 76 61 6c 20 6f 6c 64 76 61 6c l? newval oldval
7110: 29 29 0a 09 09 09 09 09 09 09 28 62 65 67 69 6e ))........(begin
7120: 0a 09 09 09 09 09 3b 28 6d 75 74 65 78 2d 6c 6f ......;(mutex-lo
7130: 63 6b 21 20 6d 78 31 29 0a 09 09 09 09 09 09 09 ck! mx1)........
7140: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute
7150: 2d 73 65 74 21 20 6c 62 6c 20 22 54 49 54 4c 45 -set! lbl "TITLE
7160: 22 20 6e 65 77 76 61 6c 29 0a 09 09 09 09 09 3b " newval)......;
7170: 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d (mutex-unlock! m
7180: 78 31 29 0a 09 09 09 09 09 09 09 20 20 29 29 29 x1)........ )))
7190: 29 29 0a 09 09 09 20 20 20 20 20 20 20 6c 62 6c )).... lbl
71a0: 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 6f 72 )).. (stor
71b0: 65 2d 6d 65 74 61 20 20 28 6c 61 6d 62 64 61 20 e-meta (lambda
71c0: 28 6e 61 6d 65 20 6c 62 6c 20 63 6d 64 29 0a 09 (name lbl cmd)..
71d0: 09 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 .. (hash-ta
71e0: 62 6c 65 2d 73 65 74 21 20 6d 65 74 61 2d 77 69 ble-set! meta-wi
71f0: 64 67 65 74 73 20 6e 61 6d 65 20 0a 09 09 09 09 dgets name .....
7200: 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 . (lambda
7210: 28 74 65 73 74 6d 65 74 61 29 0a 09 09 09 09 09 (testmeta)......
7220: 09 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 . (let ((newval
7230: 28 63 6d 64 20 74 65 73 74 6d 65 74 61 29 29 0a (cmd testmeta)).
7240: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 6f 6c ...... (ol
7250: 64 76 61 6c 20 28 69 75 70 3a 61 74 74 72 69 62 dval (iup:attrib
7260: 75 74 65 20 6c 62 6c 20 22 54 49 54 4c 45 22 29 ute lbl "TITLE")
7270: 29 29 0a 09 09 09 09 09 09 20 20 20 28 69 66 20 ))....... (if
7280: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 77 (not (equal? new
7290: 76 61 6c 20 6f 6c 64 76 61 6c 29 29 0a 09 09 09 val oldval))....
72a0: 09 09 09 20 20 20 20 20 20 20 28 62 65 67 69 6e ... (begin
72b0: 0a 09 09 09 09 09 3b 28 6d 75 74 65 78 2d 6c 6f ......;(mutex-lo
72c0: 63 6b 21 20 6d 78 31 29 0a 09 09 09 09 09 09 09 ck! mx1)........
72d0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
72e0: 73 65 74 21 20 6c 62 6c 20 22 54 49 54 4c 45 22 set! lbl "TITLE"
72f0: 20 6e 65 77 76 61 6c 29 0a 09 09 09 09 09 3b 28 newval)......;(
7300: 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 78 mutex-unlock! mx
7310: 31 29 0a 09 09 09 09 09 09 09 20 29 29 29 29 29 1)........ )))))
7320: 0a 09 09 09 20 20 20 20 20 20 6c 62 6c 29 29 0a .... lbl)).
7330: 09 20 20 20 20 20 20 20 28 73 74 6f 72 65 2d 62 . (store-b
7340: 75 74 74 6f 6e 20 73 74 6f 72 65 2d 6c 61 62 65 utton store-labe
7350: 6c 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6d 6d l).. (comm
7360: 61 6e 64 2d 70 72 6f 63 20 28 6c 61 6d 62 64 61 and-proc (lambda
7370: 20 28 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 (command-text-b
7380: 6f 78 29 0a 09 09 09 20 20 20 20 20 20 20 28 6c ox).... (l
7390: 65 74 2a 20 28 28 63 6d 64 20 20 20 20 20 28 69 et* ((cmd (i
73a0: 75 70 3a 61 74 74 72 69 62 75 74 65 20 63 6f 6d up:attribute com
73b0: 6d 61 6e 64 2d 74 65 78 74 2d 62 6f 78 20 22 56 mand-text-box "V
73c0: 41 4c 55 45 22 29 29 29 0a 09 09 09 09 20 28 63 ALUE")))..... (c
73d0: 6f 6d 6d 6f 6e 3a 72 75 6e 2d 61 2d 63 6f 6d 6d ommon:run-a-comm
73e0: 61 6e 64 20 63 6d 64 20 77 69 74 68 2d 6f 72 69 and cmd with-ori
73f0: 67 2d 65 6e 76 3a 20 23 74 29 29 29 29 0a 09 20 g-env: #t))))..
7400: 20 20 20 20 20 20 28 63 6f 6d 6d 61 6e 64 2d 74 (command-t
7410: 65 78 74 2d 62 6f 78 20 28 69 75 70 3a 74 65 78 ext-box (iup:tex
7420: 74 62 6f 78 0a 09 09 09 09 20 20 23 3a 65 78 70 tbox..... #:exp
7430: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
7440: 0a 09 09 09 09 20 20 23 3a 66 6f 6e 74 20 22 43 ..... #:font "C
7450: 6f 75 72 69 65 72 20 4e 65 77 2c 20 2d 31 30 22 ourier New, -10"
7460: 0a 09 09 09 09 20 20 23 3a 61 63 74 69 6f 6e 20 ..... #:action
7470: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 63 6e 75 (lambda (obj cnu
7480: 6d 20 76 61 6c 29 0a 09 09 09 09 09 20 20 20 20 m val)......
7490: 20 3b 3b 20 28 70 72 69 6e 74 20 22 63 6e 75 6d ;; (print "cnum
74a0: 3d 22 20 63 6e 75 6d 29 0a 09 09 09 09 09 20 20 =" cnum)......
74b0: 20 20 20 28 69 66 20 28 65 71 3f 20 63 6e 75 6d (if (eq? cnum
74c0: 20 31 33 29 0a 09 09 09 09 09 09 20 28 63 6f 6d 13)....... (com
74d0: 6d 61 6e 64 2d 70 72 6f 63 20 6f 62 6a 29 29 29 mand-proc obj)))
74e0: 0a 09 09 09 09 20 20 29 29 0a 09 20 20 20 20 20 ..... ))..
74f0: 20 20 28 63 6f 6d 6d 61 6e 64 2d 6c 61 75 6e 63 (command-launc
7500: 68 2d 62 75 74 74 6f 6e 20 28 69 75 70 3a 62 75 h-button (iup:bu
7510: 74 74 6f 6e 20 22 45 78 65 63 75 74 65 21 22 20 tton "Execute!"
7520: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda
7530: 20 28 78 29 0a 09 09 09 09 09 09 09 09 09 28 63 (x)..........(c
7540: 6f 6d 6d 61 6e 64 2d 70 72 6f 63 20 63 6f 6d 6d ommand-proc comm
7550: 61 6e 64 2d 74 65 78 74 2d 62 6f 78 29 29 29 29 and-text-box))))
7560: 0a 09 3b 3b 20 28 6c 61 6d 62 64 61 20 28 78 29 ..;; (lambda (x)
7570: 0a 09 3b 3b 20 09 09 09 09 09 09 09 09 28 6c 65 ..;; ........(le
7580: 74 2a 20 28 28 63 6d 64 20 20 20 20 20 28 69 75 t* ((cmd (iu
7590: 70 3a 61 74 74 72 69 62 75 74 65 20 63 6f 6d 6d p:attribute comm
75a0: 61 6e 64 2d 74 65 78 74 2d 62 6f 78 20 22 56 41 and-text-box "VA
75b0: 4c 55 45 22 29 29 0a 09 3b 3b 20 09 09 09 09 09 LUE"))..;; .....
75c0: 09 09 09 20 20 20 20 20 20 20 28 66 75 6c 6c 63 ... (fullc
75d0: 6d 64 20 28 63 6f 6e 63 20 28 64 74 65 73 74 73 md (conc (dtests
75e0: 3a 67 65 74 2d 70 72 65 2d 63 6f 6d 6d 61 6e 64 :get-pre-command
75f0: 29 0a 09 3b 3b 20 09 09 09 09 09 09 09 09 09 09 )..;; ..........
7600: 20 20 20 20 20 20 63 6d 64 20 0a 09 3b 3b 20 09 cmd ..;; .
7610: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 ......... (
7620: 64 74 65 73 74 73 3a 67 65 74 2d 70 6f 73 74 2d dtests:get-post-
7630: 63 6f 6d 6d 61 6e 64 29 29 29 29 0a 09 3b 3b 20 command))))..;;
7640: 09 09 09 09 09 09 09 09 20 20 28 64 65 62 75 67 ........ (debug
7650: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 32 20 2a :print-info 02 *
7660: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
7670: 2a 20 22 52 75 6e 6e 69 6e 67 20 63 6f 6d 6d 61 * "Running comma
7680: 6e 64 3a 20 22 20 66 75 6c 6c 63 6d 64 29 0a 09 nd: " fullcmd)..
7690: 3b 3b 20 09 09 09 09 09 09 09 09 20 20 28 63 6f ;; ........ (co
76a0: 6d 6d 6f 6e 3a 77 69 74 68 6f 75 74 2d 76 61 72 mmon:without-var
76b0: 73 20 66 75 6c 6c 63 6d 64 20 22 4d 54 5f 2e 2a s fullcmd "MT_.*
76c0: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 "))))).. (
76d0: 6b 69 6c 6c 2d 6a 6f 62 73 20 28 6c 61 6d 62 64 kill-jobs (lambd
76e0: 61 20 28 78 29 0a 09 09 09 20 20 20 20 28 69 75 a (x).... (iu
76f0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
7700: 20 0a 09 09 09 20 20 20 20 20 63 6f 6d 6d 61 6e .... comman
7710: 64 2d 74 65 78 74 2d 62 6f 78 20 22 56 41 4c 55 d-text-box "VALU
7720: 45 22 0a 09 09 09 20 20 20 20 20 28 63 6f 6e 63 E".... (conc
7730: 20 22 6d 65 67 61 74 65 73 74 20 2d 74 61 72 67 "megatest -targ
7740: 65 74 20 22 20 6b 65 79 73 74 72 69 6e 67 20 22 et " keystring "
7750: 20 2d 72 75 6e 6e 61 6d 65 20 22 20 20 72 75 6e -runname " run
7760: 6e 61 6d 65 20 0a 09 09 09 09 20 20 20 22 20 2d name ..... " -
7770: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
7780: 20 4b 49 4c 4c 52 45 51 2c 6e 2f 61 20 2d 74 65 KILLREQ,n/a -te
7790: 73 74 70 61 74 74 20 25 2f 25 20 22 0a 09 09 09 stpatt %/% "....
77a0: 09 20 20 20 22 20 2d 73 74 61 74 65 20 52 55 4e . " -state RUN
77b0: 4e 49 4e 47 2c 52 45 4d 4f 54 45 48 4f 53 54 53 NING,REMOTEHOSTS
77c0: 54 41 52 54 2c 4c 41 55 4e 43 48 45 44 22 29 29 TART,LAUNCHED"))
77d0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
77e0: 74 65 73 74 20 20 28 6c 61 6d 62 64 61 20 28 78 test (lambda (x
77f0: 29 0a 09 09 09 20 20 20 20 28 69 75 70 3a 61 74 ).... (iup:at
7800: 74 72 69 62 75 74 65 2d 73 65 74 21 20 0a 09 09 tribute-set! ...
7810: 09 20 20 20 20 20 63 6f 6d 6d 61 6e 64 2d 74 65 . command-te
7820: 78 74 2d 62 6f 78 20 22 56 41 4c 55 45 22 0a 09 xt-box "VALUE"..
7830: 09 09 20 20 20 20 20 28 63 6f 6e 63 20 22 6d 65 .. (conc "me
7840: 67 61 74 65 73 74 20 2d 74 61 72 67 65 74 20 22 gatest -target "
7850: 20 6b 65 79 73 74 72 69 6e 67 20 22 20 2d 72 75 keystring " -ru
7860: 6e 6e 61 6d 65 20 22 20 72 75 6e 6e 61 6d 65 20 nname " runname
7870: 0a 09 09 09 09 20 20 20 22 20 2d 72 75 6e 20 2d ..... " -run -
7880: 74 65 73 74 70 61 74 74 20 22 20 28 63 6f 6e 63 testpatt " (conc
7890: 20 74 65 73 74 6e 61 6d 65 20 22 2f 22 20 28 69 testname "/" (i
78a0: 66 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 f (equal? item-p
78b0: 61 74 68 20 22 22 29 0a 09 09 09 09 09 09 09 09 ath "").........
78c0: 09 22 25 22 20 0a 09 09 09 09 09 09 09 09 09 69 ."%" ..........i
78d0: 74 65 6d 2d 70 61 74 68 29 29 0a 09 09 09 09 20 tem-path)).....
78e0: 20 20 22 20 2d 63 6c 65 61 6e 2d 63 61 63 68 65 " -clean-cache
78f0: 22 0a 09 09 09 09 20 20 20 29 29 29 29 0a 09 20 "..... ))))..
7900: 20 20 20 20 20 20 28 72 65 6d 6f 76 65 2d 74 65 (remove-te
7910: 73 74 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 st (lambda (x)..
7920: 09 09 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 .. (iup:att
7930: 72 69 62 75 74 65 2d 73 65 74 21 0a 09 09 09 20 ribute-set!....
7940: 20 20 20 20 20 20 63 6f 6d 6d 61 6e 64 2d 74 65 command-te
7950: 78 74 2d 62 6f 78 20 22 56 41 4c 55 45 22 0a 09 xt-box "VALUE"..
7960: 09 09 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 .. (conc "
7970: 6d 65 67 61 74 65 73 74 20 2d 72 65 6d 6f 76 65 megatest -remove
7980: 2d 72 75 6e 73 20 2d 74 61 72 67 65 74 20 22 20 -runs -target "
7990: 6b 65 79 73 74 72 69 6e 67 20 22 20 2d 72 75 6e keystring " -run
79a0: 6e 61 6d 65 20 22 20 72 75 6e 6e 61 6d 65 0a 09 name " runname..
79b0: 09 09 09 20 20 20 20 20 22 20 2d 74 65 73 74 70 ... " -testp
79c0: 61 74 74 20 22 20 28 63 6f 6e 63 20 74 65 73 74 att " (conc test
79d0: 6e 61 6d 65 20 22 2f 22 20 28 69 66 20 28 65 71 name "/" (if (eq
79e0: 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 ual? item-path "
79f0: 22 29 0a 09 09 09 09 09 09 09 09 09 20 20 22 25 ").......... "%
7a00: 22 0a 09 09 09 09 09 09 09 09 09 20 20 69 74 65 ".......... ite
7a10: 6d 2d 70 61 74 68 29 29 0a 09 09 09 09 20 20 20 m-path)).....
7a20: 20 20 22 20 2d 76 22 29 29 29 29 0a 09 20 20 20 " -v"))))..
7a30: 20 20 20 20 28 63 6c 65 61 6e 2d 72 75 6e 2d 65 (clean-run-e
7a40: 78 65 63 75 74 65 20 20 28 6c 61 6d 62 64 61 20 xecute (lambda
7a50: 28 78 29 0a 09 09 09 09 20 20 20 20 20 28 6c 65 (x)..... (le
7a60: 74 20 28 28 63 6d 64 20 28 63 6f 6e 63 20 3b 3b t ((cmd (conc ;;
7a70: 20 22 6d 65 67 61 74 65 73 74 20 2d 72 65 6d 6f "megatest -remo
7a80: 76 65 2d 72 75 6e 73 20 2d 74 61 72 67 65 74 20 ve-runs -target
7a90: 22 20 6b 65 79 73 74 72 69 6e 67 20 22 20 2d 72 " keystring " -r
7aa0: 75 6e 6e 61 6d 65 20 22 20 72 75 6e 6e 61 6d 65 unname " runname
7ab0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ae0: 20 20 22 6d 65 67 61 74 65 73 74 20 2d 73 65 74 "megatest -set
7af0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 4e 4f -state-status NO
7b00: 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 20 2d 74 T_STARTED,n/a -t
7b10: 61 72 67 65 74 20 22 20 6b 65 79 73 74 72 69 6e arget " keystrin
7b20: 67 20 22 20 2d 72 75 6e 6e 61 6d 65 20 22 20 72 g " -runname " r
7b30: 75 6e 6e 61 6d 65 0a 09 09 09 09 09 09 20 20 20 unname.......
7b40: 20 20 20 22 20 2d 74 65 73 74 70 61 74 74 20 22 " -testpatt "
7b50: 20 28 63 6f 6e 63 20 74 65 73 74 6e 61 6d 65 20 (conc testname
7b60: 22 2f 22 20 28 69 66 20 28 65 71 75 61 6c 3f 20 "/" (if (equal?
7b70: 69 74 65 6d 2d 70 61 74 68 20 22 22 29 0a 09 09 item-path "")...
7b80: 09 09 09 09 20 20 20 20 20 20 20 09 09 09 09 09 .... .....
7b90: 20 20 20 22 25 22 0a 09 09 09 09 09 09 20 20 20 "%".......
7ba0: 20 20 20 20 09 09 09 09 09 20 20 20 69 74 65 6d ..... item
7bb0: 2d 70 61 74 68 29 29 0a 20 20 20 20 20 20 20 20 -path)).
7bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 3b ";
7bf0: 6d 65 67 61 74 65 73 74 20 2d 74 61 72 67 65 74 megatest -target
7c00: 20 22 20 6b 65 79 73 74 72 69 6e 67 20 22 20 2d " keystring " -
7c10: 72 75 6e 6e 61 6d 65 20 22 20 72 75 6e 6e 61 6d runname " runnam
7c20: 65 20 0a 09 09 09 09 09 09 20 20 20 20 20 20 22 e ....... "
7c30: 20 2d 72 75 6e 20 2d 70 72 65 63 6c 65 61 6e 20 -run -preclean
7c40: 2d 74 65 73 74 70 61 74 74 20 22 20 28 63 6f 6e -testpatt " (con
7c50: 63 20 74 65 73 74 6e 61 6d 65 20 22 2f 22 20 28 c testname "/" (
7c60: 69 66 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d if (equal? item-
7c70: 70 61 74 68 20 22 22 29 0a 09 09 09 09 09 09 09 path "")........
7c80: 09 09 09 09 20 20 20 22 25 22 20 0a 09 09 09 09 .... "%" .....
7c90: 09 09 09 09 09 09 09 20 20 20 69 74 65 6d 2d 70 ....... item-p
7ca0: 61 74 68 29 29 0a 09 09 09 09 09 09 20 20 20 20 ath)).......
7cb0: 20 20 22 20 2d 63 6c 65 61 6e 2d 63 61 63 68 65 " -clean-cache
7cc0: 22 0a 09 09 09 09 09 09 20 20 20 20 20 20 29 29 "....... ))
7cd0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
7ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7cf0: 20 20 20 20 20 20 20 20 20 28 74 68 72 65 61 64 (thread
7d00: 2d 73 74 61 72 74 21 20 28 6d 61 6b 65 2d 74 68 -start! (make-th
7d10: 72 65 61 64 20 28 6c 61 6d 62 64 61 20 28 29 0a read (lambda ().
7d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d60: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 75 6e (common:run
7d70: 2d 61 2d 63 6f 6d 6d 61 6e 64 20 63 6d 64 29 29 -a-command cmd))
7d80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7dc0: 20 20 20 20 22 63 6c 65 61 6e 2d 72 75 6e 2d 65 "clean-run-e
7dd0: 78 65 63 75 74 65 22 29 29 29 29 29 0a 09 20 20 xecute")))))..
7de0: 20 20 20 20 20 28 72 65 6d 6f 76 65 2d 74 65 73 (remove-tes
7df0: 74 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 t (lambda (x)...
7e00: 09 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 . (iup:attr
7e10: 69 62 75 74 65 2d 73 65 74 21 0a 09 09 09 20 20 ibute-set!....
7e20: 20 20 20 20 20 63 6f 6d 6d 61 6e 64 2d 74 65 78 command-tex
7e30: 74 2d 62 6f 78 20 22 56 41 4c 55 45 22 0a 09 09 t-box "VALUE"...
7e40: 09 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 6d . (conc "m
7e50: 65 67 61 74 65 73 74 20 2d 72 65 6d 6f 76 65 2d egatest -remove-
7e60: 72 75 6e 73 20 2d 74 61 72 67 65 74 20 22 20 6b runs -target " k
7e70: 65 79 73 74 72 69 6e 67 20 22 20 2d 72 75 6e 6e eystring " -runn
7e80: 61 6d 65 20 22 20 72 75 6e 6e 61 6d 65 0a 09 09 ame " runname...
7e90: 09 09 20 20 20 20 20 22 20 2d 74 65 73 74 70 61 .. " -testpa
7ea0: 74 74 20 22 20 28 63 6f 6e 63 20 74 65 73 74 6e tt " (conc testn
7eb0: 61 6d 65 20 22 2f 22 20 28 69 66 20 28 65 71 75 ame "/" (if (equ
7ec0: 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 al? item-path ""
7ed0: 29 0a 09 09 09 09 09 09 09 09 09 20 20 22 25 22 ).......... "%"
7ee0: 0a 09 09 09 09 09 09 09 09 09 20 20 69 74 65 6d .......... item
7ef0: 2d 70 61 74 68 29 29 0a 09 09 09 09 20 20 20 20 -path)).....
7f00: 20 22 20 2d 76 22 29 29 29 29 0a 09 20 20 20 20 " -v"))))..
7f10: 20 20 20 28 61 72 63 68 69 76 65 2d 74 65 73 74 (archive-test
7f20: 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 (lambda (x)...
7f30: 09 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ..(iup:attribute
7f40: 2d 73 65 74 21 20 0a 09 09 09 09 20 63 6f 6d 6d -set! ..... comm
7f50: 61 6e 64 2d 74 65 78 74 2d 62 6f 78 20 22 56 41 and-text-box "VA
7f60: 4c 55 45 22 0a 09 09 09 09 20 28 63 6f 6e 63 20 LUE"..... (conc
7f70: 22 6d 65 67 61 74 65 73 74 20 2d 74 61 72 67 65 "megatest -targe
7f80: 74 20 22 20 6b 65 79 73 74 72 69 6e 67 20 22 20 t " keystring "
7f90: 2d 72 75 6e 6e 61 6d 65 20 22 20 72 75 6e 6e 61 -runname " runna
7fa0: 6d 65 20 0a 09 09 09 09 20 20 20 20 20 20 20 22 me ..... "
7fb0: 20 2d 61 72 63 68 69 76 65 20 73 61 76 65 2d 72 -archive save-r
7fc0: 65 6d 6f 76 65 20 2d 74 65 73 74 70 61 74 74 20 emove -testpatt
7fd0: 22 20 28 63 6f 6e 63 20 74 65 73 74 6e 61 6d 65 " (conc testname
7fe0: 20 22 2f 22 20 28 69 66 20 28 65 71 75 61 6c 3f "/" (if (equal?
7ff0: 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 0a 09 item-path "")..
8000: 09 09 09 09 09 09 09 09 09 09 09 20 22 25 22 20 ........... "%"
8010: 0a 09 09 09 09 09 09 09 09 09 09 09 09 20 69 74 ............. it
8020: 65 6d 2d 70 61 74 68 29 29 0a 09 09 09 09 20 20 em-path)).....
8030: 20 20 20 20 20 29 29 29 29 29 0a 09 20 20 28 63 ))))).. (c
8040: 6f 6e 64 0a 09 20 20 20 28 28 6e 6f 74 20 74 65 ond.. ((not te
8050: 73 74 64 61 74 29 28 62 65 67 69 6e 20 28 64 65 stdat)(begin (de
8060: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
8070: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
8080: 45 52 52 4f 52 3a 20 62 61 64 20 74 65 73 74 20 ERROR: bad test
8090: 69 6e 66 6f 20 66 6f 72 20 22 20 74 65 73 74 2d info for " test-
80a0: 69 64 29 28 65 78 69 74 20 31 29 29 29 0a 09 20 id)(exit 1)))..
80b0: 20 20 28 28 6e 6f 74 20 72 75 6e 64 61 74 29 28 ((not rundat)(
80c0: 62 65 67 69 6e 20 28 64 65 62 75 67 3a 70 72 69 begin (debug:pri
80d0: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
80e0: 67 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 g-port* "ERROR:
80f0: 66 6f 75 6e 64 20 74 65 73 74 20 69 6e 66 6f 20 found test info
8100: 62 75 74 20 74 68 65 72 65 20 69 73 20 61 20 70 but there is a p
8110: 72 6f 62 6c 65 6d 20 77 69 74 68 20 74 68 65 20 roblem with the
8120: 72 75 6e 20 69 6e 66 6f 20 66 6f 72 20 22 20 72 run info for " r
8130: 75 6e 2d 69 64 29 28 65 78 69 74 20 31 29 29 29 un-id)(exit 1)))
8140: 0a 09 20 20 20 28 65 6c 73 65 0a 09 20 20 20 20 .. (else..
8150: 3b 3b 20 20 28 74 65 73 74 2d 73 65 74 2d 73 74 ;; (test-set-st
8160: 61 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 atus! db run-id
8170: 74 65 73 74 2d 6e 61 6d 65 20 73 74 61 74 65 20 test-name state
8180: 73 74 61 74 75 73 20 69 74 65 6d 64 61 74 29 0a status itemdat).
8190: 09 20 20 20 20 28 73 65 74 21 20 73 65 6c 66 20 . (set! self
81a0: 3b 20 0a 09 09 20 20 28 69 75 70 3a 64 69 61 6c ; ... (iup:dial
81b0: 6f 67 20 23 3a 63 6c 6f 73 65 5f 63 62 20 28 6c og #:close_cb (l
81c0: 61 6d 62 64 61 20 28 61 29 28 65 78 69 74 29 29 ambda (a)(exit))
81d0: 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 ; #:expand "YES
81e0: 22 0a 09 09 09 20 20 20 20 20 20 23 3a 74 69 74 ".... #:tit
81f0: 6c 65 20 74 65 73 74 66 75 6c 6c 6e 61 6d 65 0a le testfullname.
8200: 09 09 09 20 20 20 20 20 20 28 69 75 70 3a 76 62 ... (iup:vb
8210: 6f 78 20 3b 20 23 3a 65 78 70 61 6e 64 20 22 59 ox ; #:expand "Y
8220: 45 53 22 0a 09 09 09 20 20 20 20 20 20 20 3b 3b ES".... ;;
8230: 20 54 68 65 20 72 75 6e 20 61 6e 64 20 74 65 73 The run and tes
8240: 74 20 69 6e 66 6f 0a 09 09 09 20 20 20 20 20 20 t info....
8250: 20 28 69 75 70 3a 68 62 6f 78 20 20 3b 20 23 3a (iup:hbox ; #:
8260: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 expand "YES"....
8270: 09 28 72 75 6e 2d 69 6e 66 6f 2d 70 61 6e 65 6c .(run-info-panel
8280: 20 64 62 73 74 72 75 63 74 20 6b 65 79 64 61 74 dbstruct keydat
8290: 20 74 65 73 74 64 61 74 20 72 75 6e 6e 61 6d 65 testdat runname
82a0: 29 0a 09 09 09 09 28 74 65 73 74 2d 69 6e 66 6f ).....(test-info
82b0: 2d 70 61 6e 65 6c 20 74 65 73 74 64 61 74 20 73 -panel testdat s
82c0: 74 6f 72 65 2d 6c 61 62 65 6c 20 77 69 64 67 65 tore-label widge
82d0: 74 73 29 0a 09 09 09 09 28 74 65 73 74 2d 6d 65 ts).....(test-me
82e0: 74 61 2d 70 61 6e 65 6c 20 74 65 73 74 6d 65 74 ta-panel testmet
82f0: 61 20 73 74 6f 72 65 2d 6d 65 74 61 29 29 0a 09 a store-meta))..
8300: 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 68 62 .. (iup:hb
8310: 6f 78 0a 09 09 09 09 28 68 6f 73 74 2d 69 6e 66 ox.....(host-inf
8320: 6f 2d 70 61 6e 65 6c 20 74 65 73 74 64 61 74 20 o-panel testdat
8330: 73 74 6f 72 65 2d 6c 61 62 65 6c 29 0a 09 09 09 store-label)....
8340: 09 28 73 75 62 6d 65 67 61 74 65 73 74 2d 70 61 .(submegatest-pa
8350: 6e 65 6c 20 64 62 73 74 72 75 63 74 20 6b 65 79 nel dbstruct key
8360: 64 61 74 20 74 65 73 74 64 61 74 20 72 75 6e 6e dat testdat runn
8370: 61 6d 65 20 74 65 73 74 63 6f 6e 66 69 67 29 29 ame testconfig))
8380: 0a 09 09 09 20 20 20 20 20 20 20 3b 3b 20 54 68 .... ;; Th
8390: 65 20 63 6f 6e 74 72 6f 6c 73 0a 09 09 09 20 20 e controls....
83a0: 20 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 20 (iup:frame
83b0: 23 3a 74 69 74 6c 65 20 22 41 63 74 69 6f 6e 73 #:title "Actions
83c0: 22 20 0a 09 09 09 09 09 20 20 28 69 75 70 3a 76 " ...... (iup:v
83d0: 62 6f 78 0a 09 09 09 09 09 20 20 20 28 69 75 70 box...... (iup
83e0: 3a 68 62 6f 78 20 0a 09 09 09 09 09 20 20 20 20 :hbox ......
83f0: 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 56 69 65 (iup:button "Vie
8400: 77 20 4c 6f 67 22 20 20 20 20 20 20 23 3a 61 63 w Log" #:ac
8410: 74 69 6f 6e 20 76 69 65 77 6c 6f 67 20 20 20 20 tion viewlog
8420: 20 20 23 3a 73 69 7a 65 20 22 38 30 78 22 29 0a #:size "80x").
8430: 09 09 09 09 09 20 20 20 20 28 69 75 70 3a 62 75 ..... (iup:bu
8440: 74 74 6f 6e 20 22 53 74 61 72 74 20 58 74 65 72 tton "Start Xter
8450: 6d 22 20 20 20 23 3a 61 63 74 69 6f 6e 20 78 74 m" #:action xt
8460: 65 72 6d 20 20 20 20 20 20 20 20 23 3a 73 69 7a erm #:siz
8470: 65 20 22 38 30 78 22 29 0a 09 09 09 09 09 20 20 e "80x")......
8480: 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 (iup:button "R
8490: 75 6e 20 54 65 73 74 22 20 20 20 20 20 20 23 3a un Test" #:
84a0: 61 63 74 69 6f 6e 20 72 75 6e 2d 74 65 73 74 20 action run-test
84b0: 20 20 20 20 23 3a 73 69 7a 65 20 22 38 30 78 22 #:size "80x"
84c0: 29 0a 09 09 09 09 09 20 20 20 20 28 69 75 70 3a )...... (iup:
84d0: 62 75 74 74 6f 6e 20 22 43 6c 65 61 6e 20 54 65 button "Clean Te
84e0: 73 74 22 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 st" #:action
84f0: 72 65 6d 6f 76 65 2d 74 65 73 74 20 20 23 3a 73 remove-test #:s
8500: 69 7a 65 20 22 38 30 78 22 29 0a 09 09 09 09 09 ize "80x")......
8510: 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 (iup:button
8520: 22 43 6c 65 61 6e 52 75 6e 45 78 65 63 75 74 65 "CleanRunExecute
8530: 21 22 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 63 !" #:action c
8540: 6c 65 61 6e 2d 72 75 6e 2d 65 78 65 63 75 74 65 lean-run-execute
8550: 20 23 3a 73 69 7a 65 20 22 38 30 78 22 29 0a 09 #:size "80x")..
8560: 09 09 09 09 20 20 20 20 28 69 75 70 3a 62 75 74 .... (iup:but
8570: 74 6f 6e 20 22 4b 69 6c 6c 20 41 6c 6c 20 4a 6f ton "Kill All Jo
8580: 62 73 22 20 23 3a 61 63 74 69 6f 6e 20 6b 69 6c bs" #:action kil
8590: 6c 2d 6a 6f 62 73 20 20 20 20 23 3a 73 69 7a 65 l-jobs #:size
85a0: 20 22 38 30 78 22 29 0a 09 09 09 09 09 20 20 20 "80x")......
85b0: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 41 72 (iup:button "Ar
85c0: 63 68 69 76 65 20 54 65 73 74 22 20 20 23 3a 61 chive Test" #:a
85d0: 63 74 69 6f 6e 20 61 72 63 68 69 76 65 2d 74 65 ction archive-te
85e0: 73 74 20 23 3a 73 69 7a 65 20 22 38 30 78 22 29 st #:size "80x")
85f0: 0a 09 09 09 09 09 20 20 20 20 28 69 75 70 3a 62 ...... (iup:b
8600: 75 74 74 6f 6e 20 22 43 6c 6f 73 65 22 20 20 20 utton "Close"
8610: 20 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 #:action (
8620: 6c 61 6d 62 64 61 20 28 78 29 28 65 78 69 74 29 lambda (x)(exit)
8630: 29 20 23 3a 73 69 7a 65 20 22 38 30 78 22 29 29 ) #:size "80x"))
8640: 0a 09 09 09 09 09 20 20 20 28 61 70 70 6c 79 20 ...... (apply
8650: 0a 09 09 09 09 09 20 20 20 20 69 75 70 3a 68 62 ...... iup:hb
8660: 6f 78 0a 09 09 09 09 09 20 20 20 20 28 6c 69 73 ox...... (lis
8670: 74 20 63 6f 6d 6d 61 6e 64 2d 74 65 78 74 2d 62 t command-text-b
8680: 6f 78 20 63 6f 6d 6d 61 6e 64 2d 6c 61 75 6e 63 ox command-launc
8690: 68 2d 62 75 74 74 6f 6e 29 29 29 29 0a 09 09 09 h-button))))....
86a0: 20 20 20 20 20 20 20 28 73 65 74 2d 66 69 65 6c (set-fiel
86b0: 64 73 2d 70 61 6e 65 6c 20 64 62 73 74 72 75 63 ds-panel dbstruc
86c0: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 t run-id test-id
86d0: 20 74 65 73 74 64 61 74 29 0a 09 09 09 20 20 20 testdat)....
86e0: 20 20 20 20 28 6c 65 74 20 28 28 74 61 62 73 20 (let ((tabs
86f0: 0a 09 09 09 09 20 20 20 20 20 20 28 69 75 70 3a ..... (iup:
8700: 74 61 62 73 0a 09 09 09 09 20 20 20 20 20 20 20 tabs.....
8710: 3b 3b 20 52 65 70 6c 61 63 65 20 68 65 72 65 20 ;; Replace here
8720: 77 69 74 68 20 6d 61 74 72 69 78 0a 09 09 09 09 with matrix.....
8730: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 (let ((st
8740: 65 70 73 2d 6d 61 74 72 69 78 20 28 69 75 70 3a eps-matrix (iup:
8750: 6d 61 74 72 69 78 0a 09 09 09 09 09 09 09 20 20 matrix........
8760: 20 20 23 3a 66 6f 6e 74 20 20 20 22 43 6f 75 72 #:font "Cour
8770: 69 65 72 20 4e 65 77 2c 20 2d 38 22 0a 09 09 09 ier New, -8"....
8780: 09 09 09 09 20 20 20 20 23 3a 65 78 70 61 6e 64 .... #:expand
8790: 20 22 59 45 53 22 0a 09 09 09 09 09 09 09 20 20 "YES"........
87a0: 20 20 23 3a 73 63 72 6f 6c 6c 62 61 72 20 22 59 #:scrollbar "Y
87b0: 45 53 22 0a 09 09 09 09 09 09 09 20 20 20 20 23 ES"........ #
87c0: 3a 6e 75 6d 63 6f 6c 20 39 0a 09 09 09 09 09 09 :numcol 9.......
87d0: 09 20 20 20 20 23 3a 6e 75 6d 6c 69 6e 20 31 30 . #:numlin 10
87e0: 30 0a 09 09 09 09 09 09 09 20 20 20 20 23 3a 6e 0........ #:n
87f0: 75 6d 63 6f 6c 2d 76 69 73 69 62 6c 65 20 39 0a umcol-visible 9.
8800: 09 09 09 09 09 09 09 20 20 20 20 23 3a 6e 75 6d ....... #:num
8810: 6c 69 6e 2d 76 69 73 69 62 6c 65 20 35 0a 09 09 lin-visible 5...
8820: 09 09 09 09 09 20 20 20 20 23 3a 63 6c 69 63 6b ..... #:click
8830: 2d 63 62 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a -cb (lambda (obj
8840: 20 6c 69 6e 20 63 6f 6c 20 73 74 61 74 75 73 29 lin col status)
8850: 0a 09 09 09 09 09 09 09 09 09 20 3b 3b 20 28 69 .......... ;; (i
8860: 66 20 28 65 71 75 61 6c 3f 20 63 6f 6c 20 36 29 f (equal? col 6)
8870: 0a 09 09 09 09 09 09 09 09 09 20 28 6c 65 74 2a .......... (let*
8880: 20 28 28 6d 74 72 78 2d 72 63 20 20 28 63 6f 6e ((mtrx-rc (con
8890: 63 20 6c 69 6e 20 22 3a 22 20 36 29 29 0a 09 09 c lin ":" 6))...
88a0: 09 09 09 09 09 09 09 09 28 66 6e 61 6d 65 20 20 ........(fname
88b0: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute
88c0: 20 6f 62 6a 20 6d 74 72 78 2d 72 63 29 29 0a 20 obj mtrx-rc)).
88d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
88e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
88f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
8920: 73 74 65 70 6e 61 6d 65 20 28 69 75 70 3a 61 74 stepname (iup:at
8930: 74 72 69 62 75 74 65 20 6f 62 6a 20 28 63 6f 6e tribute obj (con
8940: 63 20 6c 69 6e 20 22 3a 22 20 31 29 29 29 20 20 c lin ":" 1)))
8950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
89a0: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 65 (comme
89b0: 6e 74 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 nt (iup:attribu
89c0: 74 65 20 6f 62 6a 20 28 63 6f 6e 63 20 6c 69 6e te obj (conc lin
89d0: 20 22 3a 22 20 37 29 29 29 29 0a 20 20 20 20 20 ":" 7)))).
89e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
89f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a20: 20 20 20 20 20 20 28 63 61 73 65 20 63 6f 6c 0a (case col.
8a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 .
8a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ac0: 20 20 20 20 20 20 20 20 20 20 20 28 28 37 29 20 ((7)
8ad0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
8ae0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
8af0: 2a 20 22 43 6f 6d 6d 65 6e 74 20 66 72 6f 6d 20 * "Comment from
8b00: 73 74 65 70 20 22 73 74 65 70 6e 61 6d 65 22 3a step "stepname":
8b10: 20 22 63 6f 6d 6d 65 6e 74 29 29 0a 20 20 20 20 "comment)).
8b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b60: 20 20 20 20 20 20 20 20 20 28 28 38 29 20 28 65 ((8) (e
8b70: 7a 73 74 65 70 73 3a 73 70 61 77 6e 2d 72 75 6e zsteps:spawn-run
8b80: 2d 66 72 6f 6d 20 74 65 73 74 64 61 74 20 73 74 -from testdat st
8b90: 65 70 6e 61 6d 65 20 23 74 29 29 0a 20 20 20 20 epname #t)).
8ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8be0: 20 20 20 20 20 20 20 20 20 28 28 39 29 20 28 65 ((9) (e
8bf0: 7a 73 74 65 70 73 3a 73 70 61 77 6e 2d 72 75 6e zsteps:spawn-run
8c00: 2d 66 72 6f 6d 20 74 65 73 74 64 61 74 20 73 74 -from testdat st
8c10: 65 70 6e 61 6d 65 20 23 66 29 29 0a 20 20 20 20 epname #f)).
8c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c60: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 (else (
8c70: 76 69 65 77 2d 61 2d 6c 6f 67 20 66 6e 61 6d 65 view-a-log fname
8c80: 29 29 29 29 29 29 29 29 0a 09 09 09 09 09 20 3b ))))))))...... ;
8c90: 3b 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 63 6f ; (let loop ((co
8ca0: 75 6e 74 20 30 29 29 0a 09 09 09 09 09 20 3b 3b unt 0))...... ;;
8cb0: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
8cc0: 65 2d 73 65 74 21 20 73 74 65 70 73 2d 6d 61 74 e-set! steps-mat
8cd0: 72 69 78 20 22 46 49 54 54 4f 54 45 58 54 22 20 rix "FITTOTEXT"
8ce0: 28 63 6f 6e 63 20 22 4c 22 20 63 6f 75 6e 74 29 (conc "L" count)
8cf0: 29 0a 09 09 09 09 09 20 3b 3b 20 20 20 28 69 66 )...... ;; (if
8d00: 20 28 3c 20 63 6f 75 6e 74 20 33 30 29 0a 09 09 (< count 30)...
8d10: 09 09 09 20 3b 3b 20 20 20 20 20 20 20 28 6c 6f ... ;; (lo
8d20: 6f 70 20 28 2b 20 63 6f 75 6e 74 20 31 29 29 29 op (+ count 1)))
8d30: 29 0a 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 )...... (iup:att
8d40: 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 ribute-set! step
8d50: 73 2d 6d 61 74 72 69 78 20 22 30 3a 31 22 20 22 s-matrix "0:1" "
8d60: 53 74 65 70 20 4e 61 6d 65 22 29 0a 09 09 09 09 Step Name").....
8d70: 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 . (iup:attribute
8d80: 2d 73 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 -set! steps-matr
8d90: 69 78 20 22 30 3a 32 22 20 22 53 74 61 72 74 22 ix "0:2" "Start"
8da0: 29 0a 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 )...... (iup:att
8db0: 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 ribute-set! step
8dc0: 73 2d 6d 61 74 72 69 78 20 22 30 3a 33 22 20 22 s-matrix "0:3" "
8dd0: 45 6e 64 22 29 0a 09 09 09 09 09 20 28 69 75 70 End")...... (iup
8de0: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
8df0: 73 74 65 70 73 2d 6d 61 74 72 69 78 20 22 57 49 steps-matrix "WI
8e00: 44 54 48 33 22 20 22 35 30 22 29 0a 09 09 09 09 DTH3" "50").....
8e10: 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 . (iup:attribute
8e20: 2d 73 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 -set! steps-matr
8e30: 69 78 20 22 30 3a 34 22 20 22 53 74 61 74 75 73 ix "0:4" "Status
8e40: 22 29 0a 09 09 09 09 09 20 28 69 75 70 3a 61 74 ")...... (iup:at
8e50: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 tribute-set! ste
8e60: 70 73 2d 6d 61 74 72 69 78 20 22 57 49 44 54 48 ps-matrix "WIDTH
8e70: 34 22 20 22 35 30 22 29 0a 09 09 09 09 09 20 28 4" "50")...... (
8e80: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
8e90: 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 t! steps-matrix
8ea0: 22 30 3a 35 22 20 22 44 75 72 61 74 69 6f 6e 22 "0:5" "Duration"
8eb0: 29 0a 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 )...... (iup:att
8ec0: 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 ribute-set! step
8ed0: 73 2d 6d 61 74 72 69 78 20 22 30 3a 36 22 20 22 s-matrix "0:6" "
8ee0: 4c 6f 67 20 46 69 6c 65 22 29 0a 09 09 09 09 09 Log File")......
8ef0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
8f00: 73 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 set! steps-matri
8f10: 78 20 22 30 3a 37 22 20 22 43 6f 6d 6d 65 6e 74 x "0:7" "Comment
8f20: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
8f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f40: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 75 70 (iup
8f50: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
8f60: 73 74 65 70 73 2d 6d 61 74 72 69 78 20 22 30 3a steps-matrix "0:
8f70: 38 22 20 22 72 65 72 75 6e 20 6f 6e 6c 79 22 29 8" "rerun only")
8f80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8fa0: 20 20 20 20 20 20 20 20 20 20 28 69 75 70 3a 61 (iup:a
8fb0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 ttribute-set! st
8fc0: 65 70 73 2d 6d 61 74 72 69 78 20 22 42 47 43 4f eps-matrix "BGCO
8fd0: 4c 4f 52 30 3a 39 22 20 22 31 34 39 20 32 30 38 LOR0:9" "149 208
8fe0: 20 32 35 32 22 29 0a 20 20 20 20 20 20 20 20 20 252").
8ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9010: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
9020: 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 et! steps-matrix
9030: 20 22 42 47 43 4f 4c 4f 52 30 3a 38 22 20 22 31 "BGCOLOR0:8" "1
9040: 34 39 20 32 30 38 20 32 35 32 22 29 0a 20 20 20 49 208 252").
9050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9070: 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 (iup:attri
9080: 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d bute-set! steps-
9090: 6d 61 74 72 69 78 20 22 42 47 43 4f 4c 4f 52 30 matrix "BGCOLOR0
90a0: 3a 37 22 20 22 31 34 39 20 32 30 38 20 32 35 32 :7" "149 208 252
90b0: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
90c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
90d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 75 70 (iup
90e0: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
90f0: 73 74 65 70 73 2d 6d 61 74 72 69 78 20 22 30 3a steps-matrix "0:
9100: 39 22 20 22 72 65 72 75 6e 20 26 20 63 6f 6e 74 9" "rerun & cont
9110: 69 6e 75 65 22 29 0a 09 09 09 09 09 20 28 69 75 inue")...... (iu
9120: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
9130: 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 22 41 steps-matrix "A
9140: 4c 49 47 4e 4d 45 4e 54 31 22 20 22 41 4c 45 46 LIGNMENT1" "ALEF
9150: 54 22 29 0a 09 09 09 09 09 20 3b 3b 20 28 69 75 T")...... ;; (iu
9160: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
9170: 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 22 46 steps-matrix "F
9180: 49 58 54 4f 54 45 58 54 22 20 22 43 31 22 29 0a IXTOTEXT" "C1").
9190: 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 ..... (iup:attri
91a0: 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d bute-set! steps-
91b0: 6d 61 74 72 69 78 20 22 52 45 53 49 5a 45 4d 41 matrix "RESIZEMA
91c0: 54 52 49 58 22 20 22 59 45 53 22 29 0a 09 09 09 TRIX" "YES")....
91d0: 09 09 20 28 6c 65 74 20 28 28 70 72 6f 63 0a 09 .. (let ((proc..
91e0: 09 09 09 09 09 28 6c 61 6d 62 64 61 20 28 74 65 .....(lambda (te
91f0: 73 74 64 61 74 29 0a 09 09 09 09 09 09 20 20 28 stdat)....... (
9200: 64 63 6f 6d 6d 6f 6e 3a 70 6f 70 75 6c 61 74 65 dcommon:populate
9210: 2d 73 74 65 70 73 20 74 65 73 74 73 74 65 70 73 -steps teststeps
9220: 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 72 75 steps-matrix ru
9230: 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 29 29 n-id test-id))))
9240: 0a 09 09 09 09 09 20 20 20 28 68 61 73 68 2d 74 ...... (hash-t
9250: 61 62 6c 65 2d 73 65 74 21 20 77 69 64 67 65 74 able-set! widget
9260: 73 20 22 53 74 65 70 73 4d 61 74 72 69 78 22 20 s "StepsMatrix"
9270: 70 72 6f 63 29 0a 09 09 09 09 09 20 20 20 28 70 proc)...... (p
9280: 72 6f 63 20 74 65 73 74 64 61 74 29 29 0a 09 09 roc testdat))...
9290: 09 09 09 20 73 74 65 70 73 2d 6d 61 74 72 69 78 ... steps-matrix
92a0: 29 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 )..... ;;
92b0: 70 6f 70 75 6c 61 74 65 20 74 68 65 20 54 65 73 populate the Tes
92c0: 74 20 44 61 74 61 20 70 61 6e 65 6c 0a 09 09 09 t Data panel....
92d0: 09 20 20 20 20 20 20 20 28 69 75 70 3a 66 72 61 . (iup:fra
92e0: 6d 65 0a 09 09 09 09 09 23 3a 74 69 74 6c 65 20 me......#:title
92f0: 22 54 65 73 74 20 44 61 74 61 22 0a 09 09 09 09 "Test Data".....
9300: 09 28 6c 65 74 20 28 28 74 65 73 74 2d 64 61 74 .(let ((test-dat
9310: 61 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 69 a...... (i
9320: 75 70 3a 74 65 78 74 62 6f 78 20 20 3b 3b 20 23 up:textbox ;; #
9330: 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 :action (lambda
9340: 28 6f 62 6a 20 63 68 61 72 20 76 61 6c 29 0a 09 (obj char val)..
9350: 09 09 09 09 09 3b 3b 20 20 20 09 23 66 29 0a 09 .....;; .#f)..
9360: 09 09 09 09 09 23 3a 65 78 70 61 6e 64 20 22 59 .....#:expand "Y
9370: 45 53 22 0a 09 09 09 09 09 09 23 3a 6d 75 6c 74 ES".......#:mult
9380: 69 6c 69 6e 65 20 22 59 45 53 22 0a 09 09 09 09 iline "YES".....
9390: 09 09 23 3a 66 6f 6e 74 20 22 43 6f 75 72 69 65 ..#:font "Courie
93a0: 72 20 4e 65 77 2c 20 2d 31 30 22 0a 09 09 09 09 r New, -10".....
93b0: 09 09 23 3a 73 69 7a 65 20 22 31 30 30 78 31 30 ..#:size "100x10
93c0: 30 22 29 29 29 0a 09 09 09 09 09 20 20 28 68 61 0")))...... (ha
93d0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 77 69 sh-table-set! wi
93e0: 64 67 65 74 73 20 22 54 65 73 74 20 44 61 74 61 dgets "Test Data
93f0: 22 0a 09 09 09 09 09 09 09 20 20 20 28 6c 61 6d "........ (lam
9400: 62 64 61 20 28 74 65 73 74 64 61 74 29 20 3b 3b bda (testdat) ;;
9410: 20 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 6c ........ (l
9420: 65 74 2a 20 28 28 63 75 72 72 76 61 6c 20 28 69 et* ((currval (i
9430: 75 70 3a 61 74 74 72 69 62 75 74 65 20 74 65 73 up:attribute tes
9440: 74 2d 64 61 74 61 20 22 56 41 4c 55 45 22 29 29 t-data "VALUE"))
9450: 20 3b 3b 20 22 54 49 54 4c 45 22 29 29 0a 09 09 ;; "TITLE"))...
9460: 09 09 09 09 09 09 20 20 20 20 28 66 6d 74 73 74 ...... (fmtst
9470: 72 20 20 22 7e 31 30 61 7e 31 30 61 7e 31 30 61 r "~10a~10a~10a
9480: 7e 31 30 61 7e 37 61 7e 37 61 7e 36 61 7e 37 61 ~10a~7a~7a~6a~7a
9490: 7e 61 22 29 20 3b 3b 20 63 61 74 65 67 6f 72 79 ~a") ;; category
94a0: 2c 76 61 72 69 61 62 6c 65 2c 76 61 6c 75 65 2c ,variable,value,
94b0: 65 78 70 65 63 74 65 64 2c 74 6f 6c 2c 75 6e 69 expected,tol,uni
94c0: 74 73 2c 74 79 70 65 2c 63 6f 6d 6d 65 6e 74 0a ts,type,comment.
94d0: 09 09 09 09 09 09 09 09 20 20 20 20 28 6e 65 77 ........ (new
94e0: 76 61 6c 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 val (string-int
94f0: 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 09 09 ersperse .......
9500: 09 09 09 20 20 20 20 20 20 28 61 70 70 65 6e 64 ... (append
9510: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
9520: 20 28 6c 69 73 74 20 0a 09 09 09 09 09 09 09 09 (list .........
9530: 09 09 28 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 ..(format #f fmt
9540: 73 74 72 20 22 43 61 74 65 67 6f 72 79 22 20 22 str "Category" "
9550: 56 61 72 69 61 62 6c 65 22 20 22 56 61 6c 75 65 Variable" "Value
9560: 22 20 22 45 78 70 65 63 74 65 64 22 20 22 54 6f " "Expected" "To
9570: 6c 22 20 22 53 74 61 74 75 73 22 20 22 55 6e 69 l" "Status" "Uni
9580: 74 73 22 20 22 54 79 70 65 22 20 22 43 6f 6d 6d ts" "Type" "Comm
9590: 65 6e 74 22 29 0a 09 09 09 09 09 09 09 09 09 09 ent")...........
95a0: 28 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 74 (format #f fmtst
95b0: 72 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d r "========" "==
95c0: 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 ======" "====="
95d0: 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 "========" "==="
95e0: 20 22 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d "======" "=====
95f0: 22 20 22 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d " "====" "======
9600: 3d 22 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 ="))..........
9610: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd
9620: 61 20 28 78 29 0a 09 09 09 09 09 09 09 09 09 09 a (x)...........
9630: 20 20 20 20 20 20 28 66 6f 72 6d 61 74 20 23 66 (format #f
9640: 20 66 6d 74 73 74 72 0a 09 09 09 09 09 09 09 09 fmtstr.........
9650: 09 09 09 20 20 20 20 20 20 28 64 62 3a 74 65 73 ... (db:tes
9660: 74 2d 64 61 74 61 2d 67 65 74 2d 63 61 74 65 67 t-data-get-categ
9670: 6f 72 79 20 78 29 0a 09 09 09 09 09 09 09 09 09 ory x)..........
9680: 09 09 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 .. (db:test
9690: 2d 64 61 74 61 2d 67 65 74 2d 76 61 72 69 61 62 -data-get-variab
96a0: 6c 65 20 78 29 0a 09 09 09 09 09 09 09 09 09 09 le x)...........
96b0: 09 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d . (db:test-
96c0: 64 61 74 61 2d 67 65 74 2d 76 61 6c 75 65 20 20 data-get-value
96d0: 20 20 78 29 0a 09 09 09 09 09 09 09 09 09 09 09 x)............
96e0: 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 64 (db:test-d
96f0: 61 74 61 2d 67 65 74 2d 65 78 70 65 63 74 65 64 ata-get-expected
9700: 20 78 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 x)............
9710: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 64 61 (db:test-da
9720: 74 61 2d 67 65 74 2d 74 6f 6c 20 20 20 20 20 20 ta-get-tol
9730: 78 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 x)............
9740: 20 20 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 (db:test-dat
9750: 61 2d 67 65 74 2d 73 74 61 74 75 73 20 20 20 78 a-get-status x
9760: 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 )............
9770: 20 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 (db:test-data
9780: 2d 67 65 74 2d 75 6e 69 74 73 20 20 20 20 78 29 -get-units x)
9790: 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 ............
97a0: 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d (db:test-data-
97b0: 67 65 74 2d 74 79 70 65 20 20 20 20 20 78 29 0a get-type x).
97c0: 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 ...........
97d0: 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 (db:test-data-g
97e0: 65 74 2d 63 6f 6d 6d 65 6e 74 20 20 78 29 29 29 et-comment x)))
97f0: 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 20 28 ........... (
9800: 72 6d 74 3a 72 65 61 64 2d 74 65 73 74 2d 64 61 rmt:read-test-da
9810: 74 61 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 ta run-id test-i
9820: 64 20 22 25 22 29 29 29 0a 09 09 09 09 09 09 09 d "%")))........
9830: 09 09 20 20 20 20 20 20 22 5c 6e 22 29 29 29 0a .. "\n"))).
9840: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 69 ....... (i
9850: 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 63 f (not (equal? c
9860: 75 72 72 76 61 6c 20 6e 65 77 76 61 6c 29 29 0a urrval newval)).
9870: 09 09 09 09 09 09 09 09 20 20 20 28 69 75 70 3a ........ (iup:
9880: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 74 attribute-set! t
9890: 65 73 74 2d 64 61 74 61 20 22 56 41 4c 55 45 22 est-data "VALUE"
98a0: 20 6e 65 77 76 61 6c 20 29 29 29 29 29 20 3b 3b newval ))))) ;;
98b0: 20 22 54 49 54 4c 45 22 20 6e 65 77 76 61 6c 29 "TITLE" newval)
98c0: 29 29 29 29 0a 09 09 09 09 09 20 20 74 65 73 74 ))))...... test
98d0: 2d 64 61 74 61 29 29 0a 09 09 09 09 20 20 20 20 -data)).....
98e0: 20 20 20 3b 3b 28 64 61 73 68 62 6f 61 72 64 3a ;;(dashboard:
98f0: 72 75 6e 2d 63 6f 6e 74 72 6f 6c 73 29 0a 09 09 run-controls)...
9900: 09 09 20 20 20 20 20 20 20 29 29 29 0a 09 09 09 .. )))....
9910: 09 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 . (iup:attribute
9920: 2d 73 65 74 21 20 74 61 62 73 20 22 54 41 42 54 -set! tabs "TABT
9930: 49 54 4c 45 30 22 20 22 53 74 65 70 73 22 29 0a ITLE0" "Steps").
9940: 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 .... (iup:attrib
9950: 75 74 65 2d 73 65 74 21 20 74 61 62 73 20 22 54 ute-set! tabs "T
9960: 41 42 54 49 54 4c 45 31 22 20 22 54 65 73 74 20 ABTITLE1" "Test
9970: 44 61 74 61 22 29 0a 09 09 09 09 20 74 61 62 73 Data")..... tabs
9980: 29 29 29 29 0a 09 20 20 20 20 28 69 75 70 3a 73 )))).. (iup:s
9990: 68 6f 77 20 73 65 6c 66 29 0a 09 20 20 20 20 28 how self).. (
99a0: 69 75 70 3a 63 61 6c 6c 62 61 63 6b 2d 73 65 74 iup:callback-set
99b0: 21 20 2a 74 69 6d 2a 20 22 41 43 54 49 4f 4e 5f ! *tim* "ACTION_
99c0: 43 42 22 0a 09 09 09 20 20 20 20 20 20 20 28 6c CB".... (l
99d0: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 20 3b ambda (x)..... ;
99e0: 3b 20 4e 6f 77 20 73 74 61 72 74 20 6b 65 65 70 ; Now start keep
99f0: 69 6e 67 20 74 68 65 20 67 75 69 20 75 70 64 61 ing the gui upda
9a00: 74 65 64 20 66 72 6f 6d 20 74 68 65 20 64 62 0a ted from the db.
9a10: 09 09 09 09 20 28 72 65 66 72 65 73 68 64 61 74 .... (refreshdat
9a20: 29 20 3b 3b 20 75 70 64 61 74 65 20 66 72 6f 6d ) ;; update from
9a30: 20 74 68 65 20 64 62 20 68 65 72 65 0a 09 09 09 the db here....
9a40: 09 09 3b 28 74 68 72 65 61 64 2d 73 75 73 70 65 ..;(thread-suspe
9a50: 6e 64 21 20 6f 74 68 65 72 2d 74 68 72 65 61 64 nd! other-thread
9a60: 29 0a 09 09 09 09 20 28 69 66 20 2a 65 78 69 74 )..... (if *exit
9a70: 2d 73 74 61 72 74 65 64 2a 0a 09 09 09 09 20 20 -started*.....
9a80: 20 20 20 28 73 65 74 21 20 2a 65 78 69 74 2d 73 (set! *exit-s
9a90: 74 61 72 74 65 64 2a 20 27 6f 6b 29 29 29 29 29 tarted* 'ok)))))
9aa0: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
9ab0: 63 6f 6c 6f 72 73 2d 73 69 6d 69 6c 61 72 3f 20 colors-similar?
9ac0: 63 6f 6c 6f 72 31 20 63 6f 6c 6f 72 32 29 0a 20 color1 color2).
9ad0: 20 28 6c 65 74 2a 20 28 28 63 31 20 20 20 20 28 (let* ((c1 (
9ae0: 6d 61 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 map string->numb
9af0: 65 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 er (string-split
9b00: 20 63 6f 6c 6f 72 31 29 29 29 0a 09 20 28 63 32 color1))).. (c2
9b10: 20 20 20 20 28 6d 61 70 20 73 74 72 69 6e 67 2d (map string-
9b20: 3e 6e 75 6d 62 65 72 20 28 73 74 72 69 6e 67 2d >number (string-
9b30: 73 70 6c 69 74 20 63 6f 6c 6f 72 32 29 29 29 0a split color2))).
9b40: 09 20 28 64 65 6c 74 61 20 28 6d 61 70 20 28 6c . (delta (map (l
9b50: 61 6d 62 64 61 20 28 61 20 62 29 28 61 62 73 20 ambda (a b)(abs
9b60: 28 2d 20 61 20 62 29 29 29 20 63 31 20 63 32 29 (- a b))) c1 c2)
9b70: 29 29 0a 20 20 20 20 28 6e 75 6c 6c 3f 20 28 66 )). (null? (f
9b80: 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 ilter (lambda (x
9b90: 29 28 3e 20 78 20 33 29 29 20 64 65 6c 74 61 29 )(> x 3)) delta)
9ba0: 29 29 29 0a 0a 3b 3b 20 44 69 73 70 6c 61 79 20 )))..;; Display
9bb0: 74 68 65 20 74 65 73 74 73 20 61 73 20 72 6f 77 the tests as row
9bc0: 73 20 6f 66 20 62 6f 78 65 73 20 6f 6e 20 74 68 s of boxes on th
9bd0: 65 20 74 65 73 74 2f 74 61 73 6b 20 70 61 6e 65 e test/task pane
9be0: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 61 73 .;;.(define (das
9bf0: 68 62 6f 61 72 64 3a 64 72 61 77 2d 74 65 73 74 hboard:draw-test
9c00: 73 20 63 6e 76 20 78 61 64 6a 20 79 61 64 6a 20 s cnv xadj yadj
9c10: 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 tests-draw-state
9c20: 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 sorted-testname
9c30: 73 20 74 65 73 74 2d 72 65 63 6f 72 64 73 29 0a s test-records).
9c40: 20 20 28 63 61 6e 76 61 73 2d 63 6c 65 61 72 21 (canvas-clear!
9c50: 20 63 6e 76 29 0a 20 20 28 63 61 6e 76 61 73 2d cnv). (canvas-
9c60: 66 6f 6e 74 2d 73 65 74 21 20 63 6e 76 20 22 48 font-set! cnv "H
9c70: 65 6c 76 65 74 69 63 61 2c 20 2d 31 30 22 29 0a elvetica, -10").
9c80: 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 (let-values ((
9c90: 28 73 69 7a 65 78 20 73 69 7a 65 79 20 73 69 7a (sizex sizey siz
9ca0: 65 78 6d 6d 20 73 69 7a 65 79 6d 6d 29 20 28 63 exmm sizeymm) (c
9cb0: 61 6e 76 61 73 2d 73 69 7a 65 20 63 6e 76 29 29 anvas-size cnv))
9cc0: 0a 09 20 20 20 20 20 20 20 28 28 6f 72 69 67 69 .. ((origi
9cd0: 6e 78 20 6f 72 69 67 69 6e 79 29 20 20 20 20 20 nx originy)
9ce0: 20 20 20 20 20 20 20 20 28 63 61 6e 76 61 73 2d (canvas-
9cf0: 6f 72 69 67 69 6e 20 63 6e 76 29 29 29 0a 20 20 origin cnv))).
9d00: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 6f 72 69 ;; (print "ori
9d10: 67 69 6e 78 3a 20 22 20 6f 72 69 67 69 6e 78 20 ginx: " originx
9d20: 22 20 6f 72 69 67 69 6e 79 3a 20 22 20 6f 72 69 " originy: " ori
9d30: 67 69 6e 79 29 0a 20 20 20 20 3b 3b 20 28 63 61 giny). ;; (ca
9d40: 6e 76 61 73 2d 6f 72 69 67 69 6e 2d 73 65 74 21 nvas-origin-set!
9d50: 20 63 6e 76 20 30 20 28 2d 20 28 2f 20 73 69 7a cnv 0 (- (/ siz
9d60: 65 79 20 32 29 29 29 0a 20 20 20 20 28 69 66 20 ey 2))). (if
9d70: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
9d80: 64 65 66 61 75 6c 74 20 74 65 73 74 73 2d 64 72 default tests-dr
9d90: 61 77 2d 73 74 61 74 65 20 27 66 69 72 73 74 2d aw-state 'first-
9da0: 74 69 6d 65 20 23 74 29 0a 09 28 62 65 67 69 6e time #t)..(begin
9db0: 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d .. (hash-table-
9dc0: 73 65 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d set! tests-draw-
9dd0: 73 74 61 74 65 20 27 66 69 72 73 74 2d 74 69 6d state 'first-tim
9de0: 65 20 23 66 29 0a 09 20 20 28 68 61 73 68 2d 74 e #f).. (hash-t
9df0: 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d able-set! tests-
9e00: 64 72 61 77 2d 73 74 61 74 65 20 27 73 63 61 6c draw-state 'scal
9e10: 65 66 20 31 29 0a 09 20 20 28 68 61 73 68 2d 74 ef 1).. (hash-t
9e20: 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d able-set! tests-
9e30: 64 72 61 77 2d 73 74 61 74 65 20 27 74 65 73 74 draw-state 'test
9e40: 73 2d 69 6e 66 6f 20 28 6d 61 6b 65 2d 68 61 73 s-info (make-has
9e50: 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 28 68 61 h-table)).. (ha
9e60: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 sh-table-set! te
9e70: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 sts-draw-state '
9e80: 73 65 6c 65 63 74 65 64 2d 74 65 73 74 73 20 28 selected-tests (
9e90: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
9ea0: 29 0a 09 20 20 3b 3b 20 73 65 74 20 74 68 65 73 ).. ;; set thes
9eb0: 65 20 0a 09 20 20 28 64 63 6f 6d 6d 6f 6e 3a 69 e .. (dcommon:i
9ec0: 6e 69 74 69 61 6c 2d 64 72 61 77 2d 74 65 73 74 nitial-draw-test
9ed0: 73 20 63 6e 76 20 78 61 64 6a 20 79 61 64 6a 20 s cnv xadj yadj
9ee0: 73 69 7a 65 78 20 73 69 7a 65 79 20 73 69 7a 65 sizex sizey size
9ef0: 78 6d 6d 20 73 69 7a 65 79 6d 6d 20 6f 72 69 67 xmm sizeymm orig
9f00: 69 6e 78 20 6f 72 69 67 69 6e 79 20 74 65 73 74 inx originy test
9f10: 73 2d 64 72 61 77 2d 73 74 61 74 65 20 73 6f 72 s-draw-state sor
9f20: 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 20 74 65 ted-testnames te
9f30: 73 74 2d 72 65 63 6f 72 64 73 29 29 0a 09 28 64 st-records))..(d
9f40: 63 6f 6d 6d 6f 6e 3a 72 65 64 72 61 77 2d 74 65 common:redraw-te
9f50: 73 74 73 20 63 6e 76 20 78 61 64 6a 20 79 61 64 sts cnv xadj yad
9f60: 6a 20 73 69 7a 65 78 20 73 69 7a 65 79 20 73 69 j sizex sizey si
9f70: 7a 65 78 6d 6d 20 73 69 7a 65 79 6d 6d 20 6f 72 zexmm sizeymm or
9f80: 69 67 69 6e 78 20 6f 72 69 67 69 6e 79 20 74 65 iginx originy te
9f90: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 73 sts-draw-state s
9fa0: 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 20 orted-testnames
9fb0: 74 65 73 74 2d 72 65 63 6f 72 64 73 29 29 0a 20 test-records)).
9fc0: 20 20 20 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ))..(define (
9fd0: 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 74 65 dboard:tabdat-te
9fe0: 73 74 2d 70 61 74 74 73 2d 75 73 65 20 76 65 63 st-patts-use vec
9ff0: 29 20 20 20 20 0a 20 20 28 6c 65 74 20 28 28 76 ) . (let ((v
a000: 61 6c 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 al (dboard:tabda
a010: 74 2d 74 65 73 74 2d 70 61 74 74 73 20 76 65 63 t-test-patts vec
a020: 29 29 29 28 69 66 20 76 61 6c 20 76 61 6c 20 22 )))(if val val "
a030: 22 29 29 29 20 3b 3b 52 41 44 54 20 3d 3e 20 57 "))) ;;RADT => W
a040: 68 61 74 20 69 73 20 74 68 65 20 69 66 20 66 6f hat is the if fo
a050: 72 3f 0a 0a 3b 3b 20 3b 3b 20 61 64 64 69 74 69 r?..;; ;; additi
a060: 6f 6e 61 6c 20 73 65 74 74 65 72 73 20 66 6f 72 onal setters for
a070: 20 64 62 6f 61 72 64 3a 64 61 74 61 0a 3b 3b 20 dboard:data.;;
a080: 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a (define (dboard:
a090: 74 61 62 64 61 74 2d 74 65 73 74 2d 70 61 74 74 tabdat-test-patt
a0a0: 73 2d 73 65 74 21 2d 75 73 65 20 20 20 20 76 65 s-set!-use ve
a0b0: 63 20 76 61 6c 29 0a 3b 3b 20 20 20 28 64 62 6f c val).;; (dbo
a0c0: 61 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d ard:tabdat-test-
a0d0: 70 61 74 74 73 2d 73 65 74 21 20 76 65 63 20 28 patts-set! vec (
a0e0: 69 66 20 28 65 71 75 61 6c 3f 20 76 61 6c 20 22 if (equal? val "
a0f0: 22 29 20 23 66 20 76 61 6c 29 29 29 0a 0a 3b 3b ") #f val)))..;;
a100: 20 45 78 74 72 61 63 74 20 74 68 65 20 76 61 72 Extract the var
a110: 69 6f 75 73 20 62 69 74 73 20 6f 66 20 64 61 74 ious bits of dat
a120: 61 20 66 72 6f 6d 20 74 61 62 64 61 74 20 61 6e a from tabdat an
a130: 64 20 63 72 65 61 74 65 20 74 68 65 20 63 6f 6d d create the com
a140: 6d 61 6e 64 20 6c 69 6e 65 20 65 71 75 69 76 61 mand line equiva
a150: 6c 65 6e 74 20 74 68 61 74 20 77 69 6c 6c 20 62 lent that will b
a160: 65 20 64 69 73 70 6c 61 79 65 64 0a 3b 3b 0a 28 e displayed.;;.(
a170: 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 define (dashboar
a180: 64 3a 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d d:update-run-com
a190: 6d 61 6e 64 20 74 61 62 64 61 74 29 0a 20 20 28 mand tabdat). (
a1a0: 6c 65 74 2a 20 28 28 63 6d 64 2d 74 62 20 20 20 let* ((cmd-tb
a1b0: 20 20 20 20 28 64 62 6f 61 72 64 3a 74 61 62 64 (dboard:tabd
a1c0: 61 74 2d 63 6f 6d 6d 61 6e 64 2d 74 62 20 74 61 at-command-tb ta
a1d0: 62 64 61 74 29 29 0a 09 20 28 63 6d 64 20 20 20 bdat)).. (cmd
a1e0: 20 20 20 20 20 20 20 28 64 62 6f 61 72 64 3a 74 (dboard:t
a1f0: 61 62 64 61 74 2d 63 6f 6d 6d 61 6e 64 20 20 20 abdat-command
a200: 20 74 61 62 64 61 74 29 29 0a 09 20 28 74 65 73 tabdat)).. (tes
a210: 74 2d 70 61 74 74 20 20 20 20 28 6c 65 74 20 28 t-patt (let (
a220: 28 74 70 20 28 64 62 6f 61 72 64 3a 74 61 62 64 (tp (dboard:tabd
a230: 61 74 2d 74 65 73 74 2d 70 61 74 74 73 20 74 61 at-test-patts ta
a240: 62 64 61 74 29 29 29 0a 09 09 09 20 28 69 66 20 bdat))).... (if
a250: 28 6f 72 20 28 6e 6f 74 20 74 70 29 0a 20 20 20 (or (not tp).
a260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
a280: 71 75 61 6c 3f 20 74 70 20 22 22 29 29 0a 20 20 qual? tp "")).
a290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a2a0: 20 20 20 20 20 20 20 20 20 20 20 22 25 22 0a 20 "%".
a2b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a2c0: 20 20 20 20 20 20 20 20 20 20 20 20 74 70 29 29 tp))
a2d0: 29 0a 09 20 28 73 74 61 74 65 73 20 20 20 20 20 ).. (states
a2e0: 20 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 (dboard:tabdat
a2f0: 2d 73 74 61 74 65 73 20 20 20 20 20 74 61 62 64 -states tabd
a300: 61 74 29 29 0a 09 20 28 73 74 61 74 75 73 65 73 at)).. (statuses
a310: 20 20 20 20 20 28 64 62 6f 61 72 64 3a 74 61 62 (dboard:tab
a320: 64 61 74 2d 73 74 61 74 75 73 65 73 20 20 20 74 dat-statuses t
a330: 61 62 64 61 74 29 29 0a 09 20 28 74 61 72 67 65 abdat)).. (targe
a340: 74 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 t (let ((t
a350: 61 72 67 2d 6c 69 73 74 20 28 64 62 6f 61 72 64 arg-list (dboard
a360: 3a 74 61 62 64 61 74 2d 74 61 72 67 65 74 20 20 :tabdat-target
a370: 20 20 20 74 61 62 64 61 74 29 29 29 0a 09 09 09 tabdat)))....
a380: 20 28 69 66 20 74 61 72 67 2d 6c 69 73 74 20 28 (if targ-list (
a390: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
a3a0: 73 65 20 74 61 72 67 2d 6c 69 73 74 20 22 2f 22 se targ-list "/"
a3b0: 29 20 22 6e 6f 2d 74 61 72 67 65 74 2d 73 65 6c ) "no-target-sel
a3c0: 65 63 74 65 64 22 29 29 29 0a 09 20 28 72 75 6e ected"))).. (run
a3d0: 2d 6e 61 6d 65 20 20 20 20 20 28 64 62 6f 61 72 -name (dboar
a3e0: 64 3a 74 61 62 64 61 74 2d 72 75 6e 2d 6e 61 6d d:tabdat-run-nam
a3f0: 65 20 20 20 74 61 62 64 61 74 29 29 0a 09 20 28 e tabdat)).. (
a400: 73 74 61 74 65 73 2d 73 74 72 20 20 20 28 69 66 states-str (if
a410: 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 65 73 (or (not states
a420: 29 0a 09 09 09 20 20 20 20 20 20 20 28 6e 75 6c ).... (nul
a430: 6c 3f 20 73 74 61 74 65 73 29 29 0a 09 09 09 20 l? states))....
a440: 20 20 22 22 0a 09 09 09 20 20 20 28 63 6f 6e 63 "".... (conc
a450: 20 22 20 2d 73 74 61 74 65 20 22 20 20 28 73 74 " -state " (st
a460: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
a470: 20 73 74 61 74 65 73 20 22 2c 22 29 29 29 29 0a states ",")))).
a480: 09 20 28 73 74 61 74 75 73 65 73 2d 73 74 72 20 . (statuses-str
a490: 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 (if (or (not sta
a4a0: 74 75 73 65 73 29 0a 09 09 09 20 20 20 20 20 20 tuses)....
a4b0: 20 28 6e 75 6c 6c 3f 20 73 74 61 74 75 73 65 73 (null? statuses
a4c0: 29 29 0a 09 09 09 20 20 20 22 22 0a 09 09 09 20 )).... ""....
a4d0: 20 20 28 63 6f 6e 63 20 22 20 2d 73 74 61 74 75 (conc " -statu
a4e0: 73 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 s " (string-inte
a4f0: 72 73 70 65 72 73 65 20 73 74 61 74 75 73 65 73 rsperse statuses
a500: 20 22 2c 22 29 29 29 29 0a 09 20 28 66 75 6c 6c ",")))).. (full
a510: 2d 63 6d 64 20 20 22 6d 65 67 61 74 65 73 74 22 -cmd "megatest"
a520: 29 29 0a 20 20 20 20 28 63 61 73 65 20 28 73 74 )). (case (st
a530: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 63 6d 64 ring->symbol cmd
a540: 29 0a 20 20 20 20 20 20 28 28 72 75 6e 29 0a 20 ). ((run).
a550: 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c (set! full
a560: 2d 63 6d 64 20 28 63 6f 6e 63 20 66 75 6c 6c 2d -cmd (conc full-
a570: 63 6d 64 20 0a 09 09 09 20 20 20 20 22 20 2d 72 cmd .... " -r
a580: 75 6e 22 0a 09 09 09 20 20 20 20 22 20 2d 74 65 un".... " -te
a590: 73 74 70 61 74 74 20 22 0a 09 09 09 20 20 20 20 stpatt "....
a5a0: 74 65 73 74 2d 70 61 74 74 0a 09 09 09 20 20 20 test-patt....
a5b0: 20 22 20 2d 74 61 72 67 65 74 20 22 0a 09 09 09 " -target "....
a5c0: 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 target....
a5d0: 20 20 22 20 2d 72 75 6e 6e 61 6d 65 20 22 0a 09 " -runname "..
a5e0: 09 09 20 20 20 20 72 75 6e 2d 6e 61 6d 65 0a 09 .. run-name..
a5f0: 09 09 20 20 20 20 22 20 2d 63 6c 65 61 6e 2d 63 .. " -clean-c
a600: 61 63 68 65 22 0a 09 09 09 20 20 20 20 29 29 29 ache".... )))
a610: 0a 20 20 20 20 20 20 28 28 72 65 6d 6f 76 65 2d . ((remove-
a620: 72 75 6e 73 29 0a 20 20 20 20 20 20 20 28 73 65 runs). (se
a630: 74 21 20 66 75 6c 6c 2d 63 6d 64 20 28 63 6f 6e t! full-cmd (con
a640: 63 20 66 75 6c 6c 2d 63 6d 64 0a 09 09 09 20 20 c full-cmd....
a650: 20 20 22 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 " -remove-runs
a660: 20 2d 72 75 6e 6e 61 6d 65 20 22 0a 09 09 09 20 -runname "....
a670: 20 20 20 72 75 6e 2d 6e 61 6d 65 0a 09 09 09 20 run-name....
a680: 20 20 20 22 20 2d 74 61 72 67 65 74 20 22 20 0a " -target " .
a690: 09 09 09 20 20 20 20 74 61 72 67 65 74 0a 09 09 ... target...
a6a0: 09 20 20 20 20 22 20 2d 74 65 73 74 70 61 74 74 . " -testpatt
a6b0: 20 22 0a 09 09 09 20 20 20 20 74 65 73 74 2d 70 ".... test-p
a6c0: 61 74 74 0a 09 09 09 20 20 20 20 73 74 61 74 65 att.... state
a6d0: 73 2d 73 74 72 0a 09 09 09 20 20 20 20 73 74 61 s-str.... sta
a6e0: 74 75 73 65 73 2d 73 74 72 0a 09 09 09 20 20 20 tuses-str....
a6f0: 20 29 29 29 0a 20 20 20 20 20 20 28 65 6c 73 65 ))). (else
a700: 20 28 73 65 74 21 20 66 75 6c 6c 2d 63 6d 64 20 (set! full-cmd
a710: 22 20 6e 6f 20 76 61 6c 69 64 20 63 6f 6d 6d 61 " no valid comma
a720: 6e 64 20 22 29 29 29 0a 20 20 20 20 28 69 75 70 nd "))). (iup
a730: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
a740: 63 6d 64 2d 74 62 20 22 56 41 4c 55 45 22 20 66 cmd-tb "VALUE" f
a750: 75 6c 6c 2d 63 6d 64 29 29 29 0a 0a 28 64 65 66 ull-cmd)))..(def
a760: 69 6e 65 20 28 69 75 70 6c 69 73 74 62 6f 78 2d ine (iuplistbox-
a770: 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 20 69 74 65 fill-list lb ite
a780: 6d 73 20 23 21 6b 65 79 20 28 73 65 6c 65 63 74 ms #!key (select
a790: 65 64 2d 69 74 65 6d 20 23 66 29 29 0a 20 20 28 ed-item #f)). (
a7a0: 6c 65 74 20 28 28 69 20 31 29 29 0a 20 20 20 20 let ((i 1)).
a7b0: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
a7c0: 61 20 28 69 74 65 6d 29 0a 09 09 28 69 75 70 3a a (item)...(iup:
a7d0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c attribute-set! l
a7e0: 62 20 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e b (number->strin
a7f0: 67 20 69 29 20 69 74 65 6d 29 0a 09 09 28 69 66 g i) item)...(if
a800: 20 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 0a 09 selected-item..
a810: 09 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f . (if (equal?
a820: 20 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 69 selected-item i
a830: 74 65 6d 29 0a 09 09 09 28 69 75 70 3a 61 74 74 tem)....(iup:att
a840: 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 20 22 ribute-set! lb "
a850: 56 41 4c 55 45 22 20 69 29 29 29 20 3b 3b 20 28 VALUE" i))) ;; (
a860: 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 69 number->string i
a870: 29 29 29 29 0a 09 09 28 73 65 74 21 20 69 20 28 ))))...(set! i (
a880: 2b 20 69 20 31 29 29 29 0a 09 20 20 20 20 20 20 + i 1)))..
a890: 69 74 65 6d 73 29 0a 20 20 20 20 3b 3b 20 28 69 items). ;; (i
a8a0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
a8b0: 21 20 6c 62 20 22 56 41 4c 55 45 22 20 28 69 66 ! lb "VALUE" (if
a8c0: 20 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 73 selected-item s
a8d0: 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 22 22 29 elected-item "")
a8e0: 29 0a 20 20 20 20 69 29 29 0a 0a 29 0a ). i))..).