0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 20 6-2012, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 made available
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 .;; greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 ng file COPYING
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 for details..;;
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 .;; This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c ven the.;; impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 ied warranty of
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 PARTICULAR.;;
0140: 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 20 28 69 6e PURPOSE...;; (in
0150: 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 2e 73 63 clude "common.sc
0160: 6d 22 29 0a 3b 3b 20 28 69 6e 63 6c 75 64 65 20 m").;; (include
0170: 22 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f "megatest-versio
0180: 6e 2e 73 63 6d 22 29 0a 0a 3b 3b 20 66 61 6b 65 n.scm")..;; fake
0190: 20 6f 75 74 20 72 65 61 64 6c 69 6e 65 20 75 73 out readline us
01a0: 61 67 65 20 6f 66 20 74 6f 70 6c 65 76 65 6c 2d age of toplevel-
01b0: 63 6f 6d 6d 61 6e 64 0a 28 64 65 66 69 6e 65 20 command.(define
01c0: 28 74 6f 70 6c 65 76 65 6c 2d 63 6f 6d 6d 61 6e (toplevel-comman
01d0: 64 20 2e 20 61 29 20 23 66 29 0a 0a 28 75 73 65 d . a) #f)..(use
01e0: 20 73 71 6c 69 74 65 33 20 73 72 66 69 2d 31 20 sqlite3 srfi-1
01f0: 70 6f 73 69 78 20 72 65 67 65 78 20 72 65 67 65 posix regex rege
0200: 78 2d 63 61 73 65 20 73 72 66 69 2d 36 39 20 62 x-case srfi-69 b
0210: 61 73 65 36 34 20 72 65 61 64 6c 69 6e 65 20 61 ase64 readline a
0220: 70 72 6f 70 6f 73 20 6a 73 6f 6e 20 68 74 74 70 propos json http
0230: 2d 63 6c 69 65 6e 74 20 64 69 72 65 63 74 6f 72 -client director
0240: 79 2d 75 74 69 6c 73 20 72 70 63 20 74 79 70 65 y-utils rpc type
0250: 64 2d 72 65 63 6f 72 64 73 3b 3b 20 28 73 72 66 d-records;; (srf
0260: 69 20 31 38 29 20 65 78 74 72 61 73 29 0a 20 20 i 18) extras).
0270: 20 20 20 68 74 74 70 2d 63 6c 69 65 6e 74 20 73 http-client s
0280: 72 66 69 2d 31 38 20 65 78 74 72 61 73 20 66 6f rfi-18 extras fo
0290: 72 6d 61 74 29 20 3b 3b 20 20 7a 6d 71 20 65 78 rmat) ;; zmq ex
02a0: 74 72 61 73 29 0a 0a 3b 3b 20 41 64 64 65 64 20 tras)..;; Added
02b0: 66 6f 72 20 63 73 76 20 73 74 75 66 66 20 2d 20 for csv stuff -
02c0: 77 69 6c 6c 20 62 65 20 72 65 6d 6f 76 65 64 0a will be removed.
02d0: 3b 3b 0a 28 75 73 65 20 73 70 61 72 73 65 2d 76 ;;.(use sparse-v
02e0: 65 63 74 6f 72 73 29 0a 0a 28 69 6d 70 6f 72 74 ectors)..(import
02f0: 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 (prefix sqlite3
0300: 20 73 71 6c 69 74 65 33 3a 29 29 0a 28 69 6d 70 sqlite3:)).(imp
0310: 6f 72 74 20 28 70 72 65 66 69 78 20 62 61 73 65 ort (prefix base
0320: 36 34 20 62 61 73 65 36 34 3a 29 29 0a 28 69 6d 64 base64:)).(im
0330: 70 6f 72 74 20 28 70 72 65 66 69 78 20 72 70 63 port (prefix rpc
0340: 20 72 70 63 3a 29 29 0a 28 72 65 71 75 69 72 65 rpc:)).(require
0350: 2d 6c 69 62 72 61 72 79 20 6d 75 74 69 6c 73 29 -library mutils)
0360: 0a 0a 3b 3b 20 28 75 73 65 20 7a 6d 71 29 0a 0a ..;; (use zmq)..
0370: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 (declare (uses c
0380: 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 ommon)).(declare
0390: 20 28 75 73 65 73 20 6d 65 67 61 74 65 73 74 2d (uses megatest-
03a0: 76 65 72 73 69 6f 6e 29 29 0a 28 64 65 63 6c 61 version)).(decla
03b0: 72 65 20 28 75 73 65 73 20 6d 61 72 67 73 29 29 re (uses margs))
03c0: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
03d0: 72 75 6e 73 29 29 0a 28 64 65 63 6c 61 72 65 20 runs)).(declare
03e0: 28 75 73 65 73 20 6c 61 75 6e 63 68 29 29 0a 28 (uses launch)).(
03f0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 73 65 declare (uses se
0400: 72 76 65 72 29 29 0a 28 64 65 63 6c 61 72 65 20 rver)).(declare
0410: 28 75 73 65 73 20 63 6c 69 65 6e 74 29 29 0a 28 (uses client)).(
0420: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 74 65 declare (uses te
0430: 73 74 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 sts)).(declare (
0440: 75 73 65 73 20 67 65 6e 65 78 61 6d 70 6c 65 29 uses genexample)
0450: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0460: 20 64 61 65 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 daemon)).(decla
0470: 72 65 20 28 75 73 65 73 20 64 62 29 29 0a 3b 3b re (uses db)).;;
0480: 20 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 (declare (uses
0490: 64 63 6f 6d 6d 6f 6e 29 29 0a 0a 28 64 65 63 6c dcommon))..(decl
04a0: 61 72 65 20 28 75 73 65 73 20 74 64 62 29 29 0a are (uses tdb)).
04b0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
04c0: 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 t)).(declare (us
04d0: 65 73 20 61 70 69 29 29 0a 28 64 65 63 6c 61 72 es api)).(declar
04e0: 65 20 28 75 73 65 73 20 74 61 73 6b 73 29 29 20 e (uses tasks))
04f0: 3b 3b 20 6f 6e 6c 79 20 75 73 65 64 20 66 6f 72 ;; only used for
0500: 20 64 65 62 75 67 67 69 6e 67 2e 0a 28 64 65 63 debugging..(dec
0510: 6c 61 72 65 20 28 75 73 65 73 20 65 6e 76 29 29 lare (uses env))
0520: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0530: 64 69 66 66 2d 72 65 70 6f 72 74 29 29 0a 0a 28 diff-report))..(
0540: 64 65 66 69 6e 65 20 2a 64 62 2a 20 23 66 29 20 define *db* #f)
0550: 3b 3b 20 74 68 69 73 20 69 73 20 6f 6e 6c 79 20 ;; this is only
0560: 66 6f 72 20 74 68 65 20 72 65 70 6c 2c 20 64 6f for the repl, do
0570: 20 6e 6f 74 20 75 73 65 20 69 6e 20 67 65 6e 65 not use in gene
0580: 72 61 6c 21 21 21 21 0a 0a 28 69 6e 63 6c 75 64 ral!!!!..(includ
0590: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
05a0: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
05b0: 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 "key_records.sc
05c0: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 m").(include "db
05d0: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 _records.scm").(
05e0: 69 6e 63 6c 75 64 65 20 22 72 75 6e 5f 72 65 63 include "run_rec
05f0: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl
0600: 75 64 65 20 22 6d 65 67 61 74 65 73 74 2d 66 6f ude "megatest-fo
0610: 73 73 69 6c 2d 68 61 73 68 2e 73 63 6d 22 29 0a ssil-hash.scm").
0620: 0a 28 6c 65 74 20 28 28 64 65 62 75 67 63 6f 6e .(let ((debugcon
0630: 74 72 6f 6c 66 20 28 63 6f 6e 63 20 28 67 65 74 trolf (conc (get
0640: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
0650: 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2f iable "HOME") "/
0660: 2e 6d 65 67 61 74 65 73 74 72 63 22 29 29 29 0a .megatestrc"))).
0670: 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 (if (file-exis
0680: 74 73 3f 20 64 65 62 75 67 63 6f 6e 74 72 6f 6c ts? debugcontrol
0690: 66 29 0a 20 20 20 20 20 20 28 6c 6f 61 64 20 64 f). (load d
06a0: 65 62 75 67 63 6f 6e 74 72 6f 6c 66 29 29 29 0a ebugcontrolf))).
06b0: 0a 3b 3b 20 44 69 73 61 62 6c 65 64 20 68 65 6c .;; Disabled hel
06c0: 70 20 69 74 65 6d 73 0a 3b 3b 20 20 2d 72 6f 6c p items.;; -rol
06d0: 6c 75 70 20 20 20 20 20 20 20 20 20 20 20 20 20 lup
06e0: 20 20 20 20 3a 20 28 63 75 72 72 65 6e 74 6c 79 : (currently
06f0: 20 64 69 73 61 62 6c 65 64 29 20 66 69 6c 6c 20 disabled) fill
0700: 72 75 6e 20 28 73 65 74 20 62 79 20 3a 72 75 6e run (set by :run
0710: 6e 61 6d 65 29 20 20 77 69 74 68 20 6c 61 74 65 name) with late
0720: 73 74 20 74 65 73 74 28 73 29 0a 3b 3b 20 20 20 st test(s).;;
0730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0740: 20 20 20 20 20 20 20 20 20 66 72 6f 6d 20 70 72 from pr
0750: 69 6f 72 20 72 75 6e 73 20 77 69 74 68 20 73 61 ior runs with sa
0760: 6d 65 20 6b 65 79 73 0a 0a 28 64 65 66 69 6e 65 me keys..(define
0770: 20 68 65 6c 70 20 28 63 6f 6e 63 20 22 0a 4d 65 help (conc ".Me
0780: 67 61 74 65 73 74 2c 20 64 6f 63 75 6d 65 6e 74 gatest, document
0790: 61 74 69 6f 6e 20 61 74 20 68 74 74 70 3a 2f 2f ation at http://
07a0: 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 www.kiatoa.com/f
07b0: 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 0a ossils/megatest.
07c0: 20 20 76 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 version " mega
07d0: 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 0a 20 test-version ".
07e0: 20 6c 69 63 65 6e 73 65 20 47 50 4c 2c 20 43 6f license GPL, Co
07f0: 70 79 72 69 67 68 74 20 4d 61 74 74 20 57 65 6c pyright Matt Wel
0800: 6c 61 6e 64 20 32 30 30 36 2d 32 30 31 35 0a 0a land 2006-2015..
0810: 55 73 61 67 65 3a 20 6d 65 67 61 74 65 73 74 20 Usage: megatest
0820: 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 2d 68 20 20 [options]. -h
0830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0840: 20 20 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a : this help.
0850: 20 20 2d 6d 61 6e 75 61 6c 20 20 20 20 20 20 20 -manual
0860: 20 20 20 20 20 20 20 20 20 20 3a 20 73 68 6f 77 : show
0870: 20 74 68 65 20 4d 65 67 61 74 65 73 74 20 75 73 the Megatest us
0880: 65 72 20 6d 61 6e 75 61 6c 0a 20 20 2d 76 65 72 er manual. -ver
0890: 73 69 6f 6e 20 20 20 20 20 20 20 20 20 20 20 20 sion
08a0: 20 20 20 20 3a 20 70 72 69 6e 74 20 6d 65 67 61 : print mega
08b0: 74 65 73 74 20 76 65 72 73 69 6f 6e 20 28 63 75 test version (cu
08c0: 72 72 65 6e 74 6c 79 20 22 20 6d 65 67 61 74 65 rrently " megate
08d0: 73 74 2d 76 65 72 73 69 6f 6e 20 22 29 0a 0a 4c st-version ")..L
08e0: 61 75 6e 63 68 69 6e 67 20 61 6e 64 20 6d 61 6e aunching and man
08f0: 61 67 69 6e 67 20 72 75 6e 73 0a 20 20 2d 72 75 aging runs. -ru
0900: 6e 61 6c 6c 20 20 20 20 20 20 20 20 20 20 20 20 nall
0910: 20 20 20 20 20 3a 20 72 75 6e 20 61 6c 6c 20 74 : run all t
0920: 65 73 74 73 20 6f 72 20 61 73 20 73 70 65 63 69 ests or as speci
0930: 66 69 65 64 20 62 79 20 2d 74 65 73 74 70 61 74 fied by -testpat
0940: 74 0a 20 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 t. -remove-runs
0950: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 : re
0960: 6d 6f 76 65 20 74 68 65 20 64 61 74 61 20 66 6f move the data fo
0970: 72 20 61 20 72 75 6e 2c 20 72 65 71 75 69 72 65 r a run, require
0980: 73 20 2d 72 75 6e 6e 61 6d 65 20 61 6e 64 20 2d s -runname and -
0990: 74 65 73 74 70 61 74 74 0a 20 20 20 20 20 20 20 testpatt.
09a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09b0: 20 20 20 20 20 4f 70 74 69 6f 6e 61 6c 6c 79 20 Optionally
09c0: 75 73 65 20 3a 73 74 61 74 65 20 61 6e 64 20 3a use :state and :
09d0: 73 74 61 74 75 73 0a 20 20 2d 73 65 74 2d 73 74 status. -set-st
09e0: 61 74 65 2d 73 74 61 74 75 73 20 58 2c 59 20 20 ate-status X,Y
09f0: 20 3a 20 73 65 74 20 73 74 61 74 65 20 74 6f 20 : set state to
0a00: 58 20 61 6e 64 20 73 74 61 74 75 73 20 74 6f 20 X and status to
0a10: 59 2c 20 72 65 71 75 69 72 65 73 20 63 6f 6e 74 Y, requires cont
0a20: 72 6f 6c 73 20 70 65 72 20 2d 72 65 6d 6f 76 65 rols per -remove
0a30: 2d 72 75 6e 73 0a 20 20 2d 72 65 72 75 6e 20 46 -runs. -rerun F
0a40: 41 49 4c 2c 57 41 52 4e 2e 2e 2e 20 20 20 20 20 AIL,WARN...
0a50: 3a 20 66 6f 72 63 65 20 72 65 2d 72 75 6e 20 66 : force re-run f
0a60: 6f 72 20 74 65 73 74 73 20 77 69 74 68 20 73 70 or tests with sp
0a70: 65 63 69 66 69 63 65 64 20 73 74 61 74 75 73 28 ecificed status(
0a80: 73 29 0a 20 20 2d 72 65 72 75 6e 2d 63 6c 65 61 s). -rerun-clea
0a90: 6e 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 n : s
0aa0: 65 74 20 61 6c 6c 20 74 65 73 74 73 20 6e 6f 74 et all tests not
0ab0: 20 43 4f 4d 50 4c 45 54 45 44 2b 50 41 53 53 2c COMPLETED+PASS,
0ac0: 57 41 52 4e 2c 57 41 49 56 45 44 20 74 6f 20 4e WARN,WAIVED to N
0ad0: 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 0a 20 OT_STARTED,n/a.
0ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0af0: 20 20 20 20 20 20 20 20 20 20 20 61 6e 64 20 74 and t
0b00: 68 65 6e 20 72 75 6e 20 74 68 65 20 73 70 65 63 hen run the spec
0b10: 69 66 69 65 64 20 74 65 73 74 70 61 74 74 20 77 ified testpatt w
0b20: 69 74 68 20 2d 70 72 65 63 6c 65 61 6e 0a 20 20 ith -preclean.
0b30: 2d 72 65 72 75 6e 2d 61 6c 6c 20 20 20 20 20 20 -rerun-all
0b40: 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 61 6c : set al
0b50: 6c 20 74 65 73 74 73 20 74 6f 20 4e 4f 54 5f 53 l tests to NOT_S
0b60: 54 41 52 54 45 44 2c 6e 2f 61 20 61 6e 64 20 72 TARTED,n/a and r
0b70: 75 6e 20 77 69 74 68 20 2d 70 72 65 63 6c 65 61 un with -preclea
0b80: 6e 0a 20 20 2d 6c 6f 63 6b 20 20 20 20 20 20 20 n. -lock
0b90: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 6f : lo
0ba0: 63 6b 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 ck run specified
0bb0: 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 by target and r
0bc0: 75 6e 6e 61 6d 65 0a 20 20 2d 75 6e 6c 6f 63 6b unname. -unlock
0bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0be0: 20 3a 20 75 6e 6c 6f 63 6b 20 72 75 6e 20 73 70 : unlock run sp
0bf0: 65 63 69 66 69 65 64 20 62 79 20 74 61 72 67 65 ecified by targe
0c00: 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 20 t and runname.
0c10: 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 -set-run-status
0c20: 73 74 61 74 75 73 20 20 3a 20 73 65 74 73 20 73 status : sets s
0c30: 74 61 74 75 73 20 66 6f 72 20 72 75 6e 20 74 6f tatus for run to
0c40: 20 73 74 61 74 75 73 2c 20 72 65 71 75 69 72 65 status, require
0c50: 73 20 2d 74 61 72 67 65 74 20 61 6e 64 20 2d 72 s -target and -r
0c60: 75 6e 6e 61 6d 65 0a 20 20 2d 67 65 74 2d 72 75 unname. -get-ru
0c70: 6e 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 20 n-status
0c80: 20 3a 20 67 65 74 73 20 73 74 61 74 75 73 20 66 : gets status f
0c90: 6f 72 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 or run specified
0ca0: 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 by target and r
0cb0: 75 6e 6e 61 6d 65 0a 20 20 2d 72 75 6e 2d 77 61 unname. -run-wa
0cc0: 69 74 20 20 20 20 20 20 20 20 20 20 20 20 20 20 it
0cd0: 20 3a 20 77 61 69 74 20 6f 6e 20 72 75 6e 20 73 : wait on run s
0ce0: 70 65 63 69 66 69 65 64 20 62 79 20 74 61 72 67 pecified by targ
0cf0: 65 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 et and runname.
0d00: 20 2d 70 72 65 63 6c 65 61 6e 20 20 20 20 20 20 -preclean
0d10: 20 20 20 20 20 20 20 20 20 3a 20 72 65 6d 6f 76 : remov
0d20: 65 20 74 68 65 20 65 78 69 73 74 69 6e 67 20 74 e the existing t
0d30: 65 73 74 20 64 69 72 65 63 74 6f 72 79 20 62 65 est directory be
0d40: 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 74 68 65 fore running the
0d50: 20 74 65 73 74 0a 20 20 2d 63 6c 65 61 6e 2d 63 test. -clean-c
0d60: 61 63 68 65 20 20 20 20 20 20 20 20 20 20 20 20 ache
0d70: 3a 20 72 65 6d 6f 76 65 20 74 68 65 20 63 61 63 : remove the cac
0d80: 68 65 64 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e hed megatest.con
0d90: 66 69 67 20 61 6e 64 20 72 75 6e 63 6f 6e 66 69 fig and runconfi
0da0: 67 2e 63 6f 6e 66 69 67 20 66 69 6c 65 73 0a 0a g.config files..
0db0: 53 65 6c 65 63 74 6f 72 73 20 28 65 2e 67 2e 20 Selectors (e.g.
0dc0: 75 73 65 20 66 6f 72 20 2d 72 75 6e 74 65 73 74 use for -runtest
0dd0: 73 2c 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 2c s, -remove-runs,
0de0: 20 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 -set-state-stat
0df0: 75 73 2c 20 2d 6c 69 73 74 2d 72 75 6e 73 20 65 us, -list-runs e
0e00: 74 63 2e 29 0a 20 20 2d 74 61 72 67 65 74 20 6b tc.). -target k
0e10: 65 79 31 2f 6b 65 79 32 2f 2e 2e 2e 20 20 20 3a ey1/key2/... :
0e20: 20 72 75 6e 20 66 6f 72 20 6b 65 79 31 2c 20 6b run for key1, k
0e30: 65 79 32 2c 20 65 74 63 2e 0a 20 20 2d 72 65 71 ey2, etc.. -req
0e40: 74 61 72 67 20 6b 65 79 31 2f 6b 65 79 32 2f 2e targ key1/key2/.
0e50: 2e 2e 20 20 3a 20 72 75 6e 20 66 6f 72 20 6b 65 .. : run for ke
0e60: 79 31 2c 20 6b 65 79 32 2c 20 65 74 63 2e 20 62 y1, key2, etc. b
0e70: 75 74 20 6b 65 79 31 2f 6b 65 79 32 20 6d 75 73 ut key1/key2 mus
0e80: 74 20 62 65 20 69 6e 20 72 75 6e 63 6f 6e 66 69 t be in runconfi
0e90: 67 0a 20 20 2d 74 65 73 74 70 61 74 74 20 70 61 g. -testpatt pa
0ea0: 74 74 31 2f 70 61 74 74 32 2c 70 61 74 74 33 2f tt1/patt2,patt3/
0eb0: 2e 2e 2e 20 20 3a 20 25 20 69 73 20 77 69 6c 64 ... : % is wild
0ec0: 63 61 72 64 0a 20 20 2d 72 75 6e 6e 61 6d 65 20 card. -runname
0ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0ee0: 20 72 65 71 75 69 72 65 64 2c 20 6e 61 6d 65 20 required, name
0ef0: 66 6f 72 20 74 68 69 73 20 70 61 72 74 69 63 75 for this particu
0f00: 6c 61 72 20 74 65 73 74 20 72 75 6e 0a 20 20 2d lar test run. -
0f10: 73 74 61 74 65 20 20 20 20 20 20 20 20 20 20 20 state
0f20: 20 20 20 20 20 20 20 3a 20 41 70 70 6c 69 65 73 : Applies
0f30: 20 74 6f 20 72 75 6e 73 2c 20 74 65 73 74 73 20 to runs, tests
0f40: 6f 72 20 73 74 65 70 73 20 64 65 70 65 6e 64 69 or steps dependi
0f50: 6e 67 20 6f 6e 20 63 6f 6e 74 65 78 74 0a 20 20 ng on context.
0f60: 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 20 20 -status
0f70: 20 20 20 20 20 20 20 20 3a 20 41 70 70 6c 69 65 : Applie
0f80: 73 20 74 6f 20 72 75 6e 73 2c 20 74 65 73 74 73 s to runs, tests
0f90: 20 6f 72 20 73 74 65 70 73 20 64 65 70 65 6e 64 or steps depend
0fa0: 69 6e 67 20 6f 6e 20 63 6f 6e 74 65 78 74 0a 20 ing on context.
0fb0: 20 2d 2d 6d 6f 64 65 70 61 74 74 20 6b 65 79 20 --modepatt key
0fc0: 20 20 20 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 : load
0fd0: 74 65 73 74 70 61 74 74 20 66 72 6f 6d 20 3c 6b testpatt from <k
0fe0: 65 79 3e 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 ey> in runconfig
0ff0: 73 20 69 6e 73 74 65 61 64 20 6f 66 20 64 65 66 s instead of def
1000: 61 75 6c 74 20 54 45 53 54 50 41 54 54 20 69 66 ault TESTPATT if
1010: 20 2d 74 65 73 74 70 61 74 74 20 61 6e 64 20 2d -testpatt and -
1020: 74 61 67 65 78 70 72 20 61 72 65 20 6e 6f 74 20 tagexpr are not
1030: 73 70 65 63 69 66 69 65 64 0a 20 20 2d 74 61 67 specified. -tag
1040: 65 78 70 72 20 74 61 67 31 2c 74 61 67 32 25 2c expr tag1,tag2%,
1050: 2e 2e 20 20 3a 20 73 65 6c 65 63 74 20 74 65 73 .. : select tes
1060: 74 73 20 77 69 74 68 20 74 61 67 73 20 6d 61 74 ts with tags mat
1070: 63 68 69 6e 67 20 65 78 70 72 65 73 73 69 6f 6e ching expression
1080: 0a 0a 54 65 73 74 20 68 65 6c 70 65 72 73 20 28 ..Test helpers (
1090: 66 6f 72 20 75 73 65 20 69 6e 73 69 64 65 20 74 for use inside t
10a0: 65 73 74 73 29 0a 20 20 2d 73 74 65 70 20 73 74 ests). -step st
10b0: 65 70 6e 61 6d 65 0a 20 20 2d 74 65 73 74 2d 73 epname. -test-s
10c0: 74 61 74 75 73 20 20 20 20 20 20 20 20 20 20 20 tatus
10d0: 20 3a 20 73 65 74 20 74 68 65 20 73 74 61 74 65 : set the state
10e0: 20 61 6e 64 20 73 74 61 74 75 73 20 6f 66 20 61 and status of a
10f0: 20 74 65 73 74 20 28 75 73 65 20 3a 73 74 61 74 test (use :stat
1100: 65 20 61 6e 64 20 3a 73 74 61 74 75 73 29 0a 20 e and :status).
1110: 20 2d 73 65 74 6c 6f 67 20 6c 6f 67 66 6e 61 6d -setlog logfnam
1120: 65 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 e : set t
1130: 68 65 20 70 61 74 68 2f 66 69 6c 65 6e 61 6d 65 he path/filename
1140: 20 74 6f 20 74 68 65 20 66 69 6e 61 6c 20 6c 6f to the final lo
1150: 67 20 72 65 6c 61 74 69 76 65 20 74 6f 20 74 68 g relative to th
1160: 65 20 74 65 73 74 0a 20 20 20 20 20 20 20 20 20 e test.
1170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1180: 20 20 20 64 69 72 65 63 74 6f 72 79 2e 20 6d 61 directory. ma
1190: 79 20 62 65 20 75 73 65 64 20 77 69 74 68 20 2d y be used with -
11a0: 74 65 73 74 2d 73 74 61 74 75 73 0a 20 20 2d 73 test-status. -s
11b0: 65 74 2d 74 6f 70 6c 6f 67 20 6c 6f 67 66 6e 61 et-toplog logfna
11c0: 6d 65 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 me : set the
11d0: 6f 76 65 72 61 6c 6c 20 6c 6f 67 20 66 6f 72 20 overall log for
11e0: 61 20 73 75 69 74 65 20 6f 66 20 73 75 62 2d 74 a suite of sub-t
11f0: 65 73 74 73 0a 20 20 2d 73 75 6d 6d 61 72 69 7a ests. -summariz
1200: 65 2d 69 74 65 6d 73 20 20 20 20 20 20 20 20 3a e-items :
1210: 20 66 6f 72 20 61 6e 20 69 74 65 6d 69 7a 65 64 for an itemized
1220: 20 74 65 73 74 20 63 72 65 61 74 65 20 61 20 73 test create a s
1230: 75 6d 6d 61 72 79 20 68 74 6d 6c 20 0a 20 20 2d ummary html . -
1240: 6d 20 63 6f 6d 6d 65 6e 74 20 20 20 20 20 20 20 m comment
1250: 20 20 20 20 20 20 20 3a 20 69 6e 73 65 72 74 20 : insert
1260: 61 20 63 6f 6d 6d 65 6e 74 20 66 6f 72 20 74 68 a comment for th
1270: 69 73 20 74 65 73 74 0a 0a 54 65 73 74 20 64 61 is test..Test da
1280: 74 61 20 63 61 70 74 75 72 65 0a 20 20 2d 73 65 ta capture. -se
1290: 74 2d 76 61 6c 75 65 73 20 20 20 20 20 20 20 20 t-values
12a0: 20 20 20 20 20 3a 20 75 70 64 61 74 65 20 6f 72 : update or
12b0: 20 73 65 74 20 76 61 6c 75 65 73 20 69 6e 20 74 set values in t
12c0: 68 65 20 74 65 73 74 64 61 74 61 20 74 61 62 6c he testdata tabl
12d0: 65 0a 20 20 3a 63 61 74 65 67 6f 72 79 20 20 20 e. :category
12e0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 : se
12f0: 74 20 74 68 65 20 63 61 74 65 67 6f 72 79 20 66 t the category f
1300: 69 65 6c 64 20 28 6f 70 74 69 6f 6e 61 6c 29 0a ield (optional).
1310: 20 20 3a 76 61 72 69 61 62 6c 65 20 20 20 20 20 :variable
1320: 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 : set
1330: 74 68 65 20 76 61 72 69 61 62 6c 65 20 6e 61 6d the variable nam
1340: 65 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a e (optional). :
1350: 76 61 6c 75 65 20 20 20 20 20 20 20 20 20 20 20 value
1360: 20 20 20 20 20 20 20 3a 20 76 61 6c 75 65 20 6d : value m
1370: 65 61 73 75 72 65 64 20 28 72 65 71 75 69 72 65 easured (require
1380: 64 29 0a 20 20 3a 65 78 70 65 63 74 65 64 20 20 d). :expected
1390: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 76 : v
13a0: 61 6c 75 65 20 65 78 70 65 63 74 65 64 20 28 72 alue expected (r
13b0: 65 71 75 69 72 65 64 29 0a 20 20 3a 74 6f 6c 20 equired). :tol
13c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13d0: 20 20 20 3a 20 7c 76 61 6c 75 65 2d 65 78 70 65 : |value-expe
13e0: 63 74 7c 20 3c 3d 20 74 6f 6c 20 28 72 65 71 75 ct| <= tol (requ
13f0: 69 72 65 64 2c 20 63 61 6e 20 62 65 20 3c 2c 20 ired, can be <,
1400: 3e 2c 20 3e 3d 2c 20 3c 3d 20 6f 72 20 6e 75 6d >, >=, <= or num
1410: 62 65 72 29 0a 20 20 3a 75 6e 69 74 73 20 20 20 ber). :units
1420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
1430: 20 6e 61 6d 65 20 6f 66 20 74 68 65 20 75 6e 69 name of the uni
1440: 74 73 20 66 6f 72 20 76 61 6c 75 65 2c 20 65 78 ts for value, ex
1450: 70 65 63 74 65 64 5f 76 61 6c 75 65 20 65 74 63 pected_value etc
1460: 2e 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 2d . (optional). -
1470: 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 20 20 load-test-data
1480: 20 20 20 20 20 20 20 3a 20 72 65 61 64 20 74 65 : read te
1490: 73 74 20 73 70 65 63 69 66 69 63 20 64 61 74 61 st specific data
14a0: 20 66 6f 72 20 73 74 6f 72 61 67 65 20 69 6e 20 for storage in
14b0: 74 68 65 20 74 65 73 74 5f 64 61 74 61 20 74 61 the test_data ta
14c0: 62 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ble.
14d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14e0: 66 72 6f 6d 20 73 74 61 6e 64 61 72 64 20 69 6e from standard in
14f0: 2e 20 45 61 63 68 20 6c 69 6e 65 20 69 73 20 63 . Each line is c
1500: 6f 6d 6d 61 20 64 65 6c 69 6d 69 74 65 64 20 77 omma delimited w
1510: 69 74 68 20 66 6f 75 72 0a 20 20 20 20 20 20 20 ith four.
1520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1530: 20 20 20 20 20 66 69 65 6c 64 73 20 63 61 74 65 fields cate
1540: 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 gory,variable,va
1550: 6c 75 65 2c 63 6f 6d 6d 65 6e 74 0a 0a 51 75 65 lue,comment..Que
1560: 72 69 65 73 0a 20 20 2d 6c 69 73 74 2d 72 75 6e ries. -list-run
1570: 73 20 70 61 74 74 20 20 20 20 20 20 20 20 20 3a s patt :
1580: 20 6c 69 73 74 20 72 75 6e 73 20 6d 61 74 63 68 list runs match
1590: 69 6e 67 20 70 61 74 74 65 72 6e 20 5c 22 70 61 ing pattern \"pa
15a0: 74 74 5c 22 2c 20 25 20 69 73 20 74 68 65 20 77 tt\", % is the w
15b0: 69 6c 64 63 61 72 64 0a 20 20 2d 73 68 6f 77 2d ildcard. -show-
15c0: 6b 65 79 73 20 20 20 20 20 20 20 20 20 20 20 20 keys
15d0: 20 20 3a 20 73 68 6f 77 20 74 68 65 20 6b 65 79 : show the key
15e0: 73 20 75 73 65 64 20 69 6e 20 74 68 69 73 20 6d s used in this m
15f0: 65 67 61 74 65 73 74 20 73 65 74 75 70 0a 20 20 egatest setup.
1600: 2d 74 65 73 74 2d 66 69 6c 65 73 20 74 61 72 67 -test-files targ
1610: 70 61 74 74 20 20 20 20 3a 20 67 65 74 20 74 68 patt : get th
1620: 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 20 74 65 e most recent te
1630: 73 74 20 70 61 74 68 2f 66 69 6c 65 20 6d 61 74 st path/file mat
1640: 63 68 69 6e 67 20 74 61 72 67 70 61 74 74 20 65 ching targpatt e
1650: 2e 67 2e 20 25 2f 25 20 6f 72 20 27 2a 2e 6c 6f .g. %/% or '*.lo
1660: 67 27 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 g'.
1670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
1680: 65 74 75 72 6e 73 20 6c 69 73 74 20 73 6f 72 74 eturns list sort
1690: 65 64 20 62 79 20 61 67 65 20 61 73 63 65 6e 64 ed by age ascend
16a0: 69 6e 67 2c 20 73 65 65 20 65 78 61 6d 70 6c 65 ing, see example
16b0: 73 20 62 65 6c 6f 77 0a 20 20 2d 74 65 73 74 2d s below. -test-
16c0: 70 61 74 68 73 20 20 20 20 20 20 20 20 20 20 20 paths
16d0: 20 20 3a 20 67 65 74 20 74 68 65 20 74 65 73 74 : get the test
16e0: 20 70 61 74 68 73 20 6d 61 74 63 68 69 6e 67 20 paths matching
16f0: 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c target, runname,
1700: 20 69 74 65 6d 20 61 6e 64 20 74 65 73 74 0a 20 item and test.
1710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1720: 20 20 20 20 20 20 20 20 20 20 20 70 61 74 74 65 patte
1730: 72 6e 73 2e 0a 20 20 2d 6c 69 73 74 2d 64 69 73 rns.. -list-dis
1740: 6b 73 20 20 20 20 20 20 20 20 20 20 20 20 20 3a ks :
1750: 20 6c 69 73 74 20 74 68 65 20 64 69 73 6b 73 20 list the disks
1760: 61 76 61 69 6c 61 62 6c 65 20 66 6f 72 20 73 74 available for st
1770: 6f 72 69 6e 67 20 72 75 6e 73 0a 20 20 2d 6c 69 oring runs. -li
1780: 73 74 2d 74 61 72 67 65 74 73 20 20 20 20 20 20 st-targets
1790: 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 65 20 : list the
17a0: 74 61 72 67 65 74 73 20 69 6e 20 72 75 6e 63 6f targets in runco
17b0: 6e 66 69 67 73 2e 63 6f 6e 66 69 67 0a 20 20 2d nfigs.config. -
17c0: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 20 list-db-targets
17d0: 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 : list th
17e0: 65 20 74 61 72 67 65 74 20 63 6f 6d 62 69 6e 61 e target combina
17f0: 74 69 6f 6e 73 20 75 73 65 64 20 69 6e 20 74 68 tions used in th
1800: 65 20 64 62 0a 20 20 2d 73 68 6f 77 2d 63 6f 6e e db. -show-con
1810: 66 69 67 20 20 20 20 20 20 20 20 20 20 20 20 3a fig :
1820: 20 64 75 6d 70 20 74 68 65 20 69 6e 74 65 72 6e dump the intern
1830: 61 6c 20 72 65 70 72 65 73 65 6e 74 61 74 69 6f al representatio
1840: 6e 20 6f 66 20 74 68 65 20 6d 65 67 61 74 65 73 n of the megates
1850: 74 2e 63 6f 6e 66 69 67 20 66 69 6c 65 0a 20 20 t.config file.
1860: 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 20 -show-runconfig
1870: 20 20 20 20 20 20 20 20 3a 20 64 75 6d 70 20 74 : dump t
1880: 68 65 20 69 6e 74 65 72 6e 61 6c 20 72 65 70 72 he internal repr
1890: 65 73 65 6e 74 61 74 69 6f 6e 20 6f 66 20 74 68 esentation of th
18a0: 65 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e e runconfigs.con
18b0: 66 69 67 20 66 69 6c 65 0a 20 20 2d 64 75 6d 70 fig file. -dump
18c0: 6d 6f 64 65 20 4d 4f 44 45 20 20 20 20 20 20 20 mode MODE
18d0: 20 20 20 3a 20 64 75 6d 70 20 69 6e 20 4d 4f 44 : dump in MOD
18e0: 45 20 66 6f 72 6d 61 74 20 69 6e 73 74 65 61 64 E format instead
18f0: 20 6f 66 20 73 65 78 70 72 2c 20 4d 4f 44 45 3d of sexpr, MODE=
1900: 6a 73 6f 6e 2c 69 6e 69 2c 73 65 78 70 20 65 74 json,ini,sexp et
1910: 63 2e 0a 20 20 2d 73 68 6f 77 2d 63 6d 64 69 6e c.. -show-cmdin
1920: 66 6f 20 20 20 20 20 20 20 20 20 20 20 3a 20 64 fo : d
1930: 75 6d 70 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 ump the command
1940: 69 6e 66 6f 20 66 6f 72 20 61 20 74 65 73 74 20 info for a test
1950: 28 72 75 6e 20 69 6e 20 74 65 73 74 20 65 6e 76 (run in test env
1960: 69 72 6f 6e 6d 65 6e 74 29 0a 20 20 2d 73 65 63 ironment). -sec
1970: 74 69 6f 6e 20 73 65 63 74 69 6f 6e 4e 61 6d 65 tion sectionName
1980: 0a 20 20 2d 76 61 72 20 76 61 72 4e 61 6d 65 20 . -var varName
1990: 20 20 20 20 20 20 20 20 20 20 20 3a 20 66 6f 72 : for
19a0: 20 63 6f 6e 66 69 67 20 61 6e 64 20 72 75 6e 63 config and runc
19b0: 6f 6e 66 69 67 20 6c 6f 6f 6b 75 70 20 76 61 6c onfig lookup val
19c0: 75 65 20 66 6f 72 20 73 65 63 74 69 6f 6e 4e 61 ue for sectionNa
19d0: 6d 65 20 76 61 72 4e 61 6d 65 0a 20 20 2d 73 69 me varName. -si
19e0: 6e 63 65 20 4e 20 20 20 20 20 20 20 20 20 20 20 nce N
19f0: 20 20 20 20 20 3a 20 67 65 74 20 6c 69 73 74 20 : get list
1a00: 6f 66 20 72 75 6e 73 20 63 68 61 6e 67 65 64 20 of runs changed
1a10: 73 69 6e 63 65 20 74 69 6d 65 20 4e 20 28 55 6e since time N (Un
1a20: 69 78 20 73 65 63 6f 6e 64 73 29 0a 20 20 2d 66 ix seconds). -f
1a30: 69 65 6c 64 73 20 66 69 65 6c 64 73 70 65 63 20 ields fieldspec
1a40: 20 20 20 20 20 20 3a 20 66 69 65 6c 64 73 20 74 : fields t
1a50: 6f 20 69 6e 63 6c 75 64 65 20 69 6e 20 6a 73 6f o include in jso
1a60: 6e 20 64 75 6d 70 3b 20 72 75 6e 73 3a 69 64 2c n dump; runs:id,
1a70: 72 75 6e 61 6d 65 2b 74 65 73 74 73 3a 74 65 73 runame+tests:tes
1a80: 74 6e 61 6d 65 2b 73 74 65 70 73 0a 20 20 2d 73 tname+steps. -s
1a90: 6f 72 74 20 66 69 65 6c 64 6e 61 6d 65 20 20 20 ort fieldname
1aa0: 20 20 20 20 20 20 3a 20 69 6e 20 2d 6c 69 73 74 : in -list
1ab0: 2d 72 75 6e 73 20 73 6f 72 74 20 74 65 73 74 73 -runs sort tests
1ac0: 20 62 79 20 74 68 69 73 20 66 69 65 6c 64 0a 0a by this field..
1ad0: 4d 69 73 63 20 0a 20 20 2d 73 74 61 72 74 2d 64 Misc . -start-d
1ae0: 69 72 20 70 61 74 68 20 20 20 20 20 20 20 20 20 ir path
1af0: 3a 20 73 77 69 74 63 68 20 74 6f 20 74 68 69 73 : switch to this
1b00: 20 64 69 72 65 63 74 6f 72 79 20 62 65 66 6f 72 directory befor
1b10: 65 20 72 75 6e 6e 69 6e 67 20 6d 65 67 61 74 65 e running megate
1b20: 73 74 0a 20 20 2d 72 65 62 75 69 6c 64 2d 64 62 st. -rebuild-db
1b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 62 : b
1b40: 72 69 6e 67 20 74 68 65 20 64 61 74 61 62 61 73 ring the databas
1b50: 65 20 73 63 68 65 6d 61 20 75 70 20 74 6f 20 64 e schema up to d
1b60: 61 74 65 0a 20 20 2d 63 6c 65 61 6e 75 70 2d 64 ate. -cleanup-d
1b70: 62 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 b :
1b80: 72 65 6d 6f 76 65 20 61 6e 79 20 6f 72 70 68 61 remove any orpha
1b90: 6e 20 72 65 63 6f 72 64 73 2c 20 76 61 63 75 75 n records, vacuu
1ba0: 6d 20 74 68 65 20 64 62 0a 20 20 2d 69 6d 70 6f m the db. -impo
1bb0: 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 20 20 rt-megatest.db
1bc0: 20 20 20 3a 20 6d 69 67 72 61 74 65 20 61 20 64 : migrate a d
1bd0: 61 74 61 62 61 73 65 20 66 72 6f 6d 20 76 31 2e atabase from v1.
1be0: 35 35 20 73 65 72 69 65 73 20 74 6f 20 76 31 2e 55 series to v1.
1bf0: 36 30 20 73 65 72 69 65 73 0a 20 20 2d 73 79 6e 60 series. -syn
1c00: 63 2d 74 6f 2d 6d 65 67 61 74 65 73 74 2e 64 62 c-to-megatest.db
1c10: 20 20 20 20 3a 20 6d 69 67 72 61 74 65 20 64 61 : migrate da
1c20: 74 61 20 62 61 63 6b 20 74 6f 20 6d 65 67 61 74 ta back to megat
1c30: 65 73 74 2e 64 62 0a 20 20 2d 75 73 65 2d 64 62 est.db. -use-db
1c40: 2d 63 61 63 68 65 20 20 20 20 20 20 20 20 20 20 -cache
1c50: 20 3a 20 75 73 65 20 63 61 63 68 65 64 20 61 63 : use cached ac
1c60: 63 65 73 73 20 74 6f 20 64 62 20 74 6f 20 72 65 cess to db to re
1c70: 64 75 63 65 20 6c 6f 61 64 0a 20 20 2d 75 70 64 duce load. -upd
1c80: 61 74 65 2d 6d 65 74 61 20 20 20 20 20 20 20 20 ate-meta
1c90: 20 20 20 20 3a 20 75 70 64 61 74 65 20 74 68 65 : update the
1ca0: 20 74 65 73 74 73 20 6d 65 74 61 64 61 74 61 20 tests metadata
1cb0: 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 0a 20 20 for all tests.
1cc0: 2d 73 65 74 76 61 72 73 20 56 41 52 31 3d 76 61 -setvars VAR1=va
1cd0: 6c 31 2c 56 41 52 32 3d 76 61 6c 32 20 3a 20 41 l1,VAR2=val2 : A
1ce0: 64 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 dd environment v
1cf0: 61 72 69 61 62 6c 65 73 20 74 6f 20 61 20 72 75 ariables to a ru
1d00: 6e 20 4e 42 2f 2f 20 74 68 65 73 65 20 61 72 65 n NB// these are
1d10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d30: 20 20 6f 76 65 72 77 72 69 74 74 65 6e 20 62 79 overwritten by
1d40: 20 76 61 6c 75 65 73 20 73 65 74 20 69 6e 20 63 values set in c
1d50: 6f 6e 66 69 67 20 66 69 6c 65 73 2e 0a 20 20 2d onfig files.. -
1d60: 73 65 72 76 65 72 20 2d 7c 68 6f 73 74 6e 61 6d server -|hostnam
1d70: 65 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 74 e : start t
1d80: 68 65 20 73 65 72 76 65 72 20 28 72 65 64 75 63 he server (reduc
1d90: 65 73 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 6f 6e es contention on
1da0: 20 6d 65 67 61 74 65 73 74 2e 64 62 29 2c 20 75 megatest.db), u
1db0: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
1dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d -
1dd0: 20 74 6f 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c to automaticall
1de0: 79 20 66 69 67 75 72 65 20 6f 75 74 20 68 6f 73 y figure out hos
1df0: 74 6e 61 6d 65 0a 20 20 2d 74 72 61 6e 73 70 6f tname. -transpo
1e00: 72 74 20 68 74 74 70 7c 72 70 63 20 20 20 20 20 rt http|rpc
1e10: 3a 20 75 73 65 20 68 74 74 70 20 6f 72 20 72 70 : use http or rp
1e20: 63 20 66 6f 72 20 74 72 61 6e 73 70 6f 72 74 20 c for transport
1e30: 28 64 65 66 61 75 6c 74 20 69 73 20 68 74 74 70 (default is http
1e40: 29 20 0a 20 20 2d 64 61 65 6d 6f 6e 69 7a 65 20 ) . -daemonize
1e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 66 : f
1e60: 6f 72 6b 20 69 6e 74 6f 20 62 61 63 6b 67 72 6f ork into backgro
1e70: 75 6e 64 20 61 6e 64 20 64 69 73 63 6f 6e 6e 65 und and disconne
1e80: 63 74 20 66 72 6f 6d 20 73 74 64 69 6e 2f 6f 75 ct from stdin/ou
1e90: 74 0a 20 20 2d 6c 6f 67 20 6c 6f 67 66 69 6c 65 t. -log logfile
1ea0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 : se
1eb0: 6e 64 20 73 74 64 6f 75 74 20 61 6e 64 20 73 74 nd stdout and st
1ec0: 64 65 72 72 20 74 6f 20 6c 6f 67 66 69 6c 65 0a derr to logfile.
1ed0: 20 20 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 20 -list-servers
1ee0: 20 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 : list
1ef0: 20 74 68 65 20 73 65 72 76 65 72 73 20 0a 20 20 the servers .
1f00: 2d 73 74 6f 70 2d 73 65 72 76 65 72 20 69 64 20 -stop-server id
1f10: 20 20 20 20 20 20 20 20 3a 20 73 74 6f 70 20 73 : stop s
1f20: 65 72 76 65 72 20 73 70 65 63 69 66 69 65 64 20 erver specified
1f30: 62 79 20 69 64 20 28 73 65 65 20 6f 75 74 70 75 by id (see outpu
1f40: 74 20 6f 66 20 2d 6c 69 73 74 2d 73 65 72 76 65 t of -list-serve
1f50: 72 73 29 2c 20 75 73 65 0a 20 20 20 20 20 20 20 rs), use.
1f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f70: 20 20 20 20 20 30 20 74 6f 20 6b 69 6c 6c 20 61 0 to kill a
1f80: 6c 6c 0a 20 20 2d 72 65 70 6c 20 20 20 20 20 20 ll. -repl
1f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 : s
1fa0: 74 61 72 74 20 61 20 72 65 70 6c 20 28 75 73 65 tart a repl (use
1fb0: 66 75 6c 20 66 6f 72 20 65 78 74 65 6e 64 69 6e ful for extendin
1fc0: 67 20 6d 65 67 61 74 65 73 74 29 0a 20 20 2d 6c g megatest). -l
1fd0: 6f 61 64 20 66 69 6c 65 2e 73 63 6d 20 20 20 20 oad file.scm
1fe0: 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 61 6e 64 : load and
1ff0: 20 72 75 6e 20 66 69 6c 65 2e 73 63 6d 0a 20 20 run file.scm.
2000: 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 -mark-incomplete
2010: 73 20 20 20 20 20 20 20 3a 20 66 69 6e 64 20 61 s : find a
2020: 6e 64 20 6d 61 72 6b 20 69 6e 63 6f 6d 70 6c 65 nd mark incomple
2030: 74 65 20 74 65 73 74 73 0a 20 20 2d 70 69 6e 67 te tests. -ping
2040: 20 72 75 6e 2d 69 64 7c 68 6f 73 74 3a 70 6f 72 run-id|host:por
2050: 74 20 20 3a 20 70 69 6e 67 20 73 65 72 76 65 72 t : ping server
2060: 2c 20 65 78 69 74 20 77 69 74 68 20 30 20 69 66 , exit with 0 if
2070: 20 66 6f 75 6e 64 0a 20 20 2d 64 65 62 75 67 20 found. -debug
2080: 4e 7c 4e 2c 4d 2c 4f 2e 2e 2e 20 20 20 20 20 20 N|N,M,O...
2090: 20 3a 20 65 6e 61 62 6c 65 20 64 65 62 75 67 20 : enable debug
20a0: 30 2d 4e 20 6f 72 20 4e 20 61 6e 64 20 4d 20 61 0-N or N and M a
20b0: 6e 64 20 4f 20 2e 2e 2e 0a 0a 55 74 69 6c 69 74 nd O .....Utilit
20c0: 69 65 73 0a 20 20 2d 65 6e 76 32 66 69 6c 65 20 ies. -env2file
20d0: 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 3a 20 fname :
20e0: 77 72 69 74 65 20 74 68 65 20 65 6e 76 69 72 6f write the enviro
20f0: 6e 6d 65 6e 74 20 74 6f 20 66 6e 61 6d 65 2e 63 nment to fname.c
2100: 73 68 20 61 6e 64 20 66 6e 61 6d 65 2e 73 68 0a sh and fname.sh.
2110: 20 20 2d 65 6e 76 63 61 70 20 66 6e 61 6d 65 3d -envcap fname=
2120: 63 6f 6e 74 65 78 74 20 20 20 3a 20 73 61 76 65 context : save
2130: 20 63 75 72 72 65 6e 74 20 76 61 72 69 61 62 6c current variabl
2140: 65 73 20 6c 61 62 65 6c 65 64 20 61 73 20 63 6f es labeled as co
2150: 6e 74 65 78 74 20 69 6e 20 66 69 6c 65 20 66 6e ntext in file fn
2160: 61 6d 65 0a 20 20 2d 72 65 66 64 62 32 64 61 74 ame. -refdb2dat
2170: 20 72 65 66 64 62 20 20 20 20 20 20 20 20 3a 20 refdb :
2180: 63 6f 6e 76 65 72 74 20 72 65 66 64 62 20 74 6f convert refdb to
2190: 20 73 65 78 70 20 6f 72 20 74 6f 20 66 6f 72 6d sexp or to form
21a0: 61 74 20 73 70 65 63 69 66 69 65 64 20 62 79 20 at specified by
21b0: 2d 64 75 6d 70 6d 6f 64 65 0a 20 20 20 20 20 20 -dumpmode.
21c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21d0: 20 20 20 20 20 20 66 6f 72 6d 61 74 73 3a 20 70 formats: p
21e0: 65 72 6c 2c 20 72 75 62 79 2c 20 73 71 6c 69 74 erl, ruby, sqlit
21f0: 65 33 2c 20 63 73 76 20 28 66 6f 72 20 63 73 76 e3, csv (for csv
2200: 20 74 68 65 20 2d 6f 20 70 61 72 61 6d 0a 20 20 the -o param.
2210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2220: 20 20 20 20 20 20 20 20 20 20 77 69 6c 6c 20 73 will s
2230: 75 62 73 74 69 74 75 74 65 20 25 73 20 66 6f 72 ubstitute %s for
2240: 20 74 68 65 20 73 68 65 65 74 20 6e 61 6d 65 20 the sheet name
2250: 69 6e 20 67 65 6e 65 72 61 74 69 6e 67 20 0a 20 in generating .
2260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2270: 20 20 20 20 20 20 20 20 20 20 20 6d 75 6c 74 69 multi
2280: 70 6c 65 20 73 68 65 65 74 73 29 0a 20 20 2d 6f ple sheets). -o
2290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22a0: 20 20 20 20 20 20 3a 20 6f 75 74 70 75 74 20 66 : output f
22b0: 69 6c 65 20 66 6f 72 20 72 65 66 64 62 32 64 61 ile for refdb2da
22c0: 74 20 28 64 65 66 61 75 6c 74 73 20 74 6f 20 73 t (defaults to s
22d0: 74 64 6f 75 74 29 0a 20 20 2d 61 72 63 68 69 76 tdout). -archiv
22e0: 65 20 63 6d 64 20 20 20 20 20 20 20 20 20 20 20 e cmd
22f0: 20 3a 20 61 72 63 68 69 76 65 20 72 75 6e 73 20 : archive runs
2300: 73 70 65 63 69 66 69 65 64 20 62 79 20 73 65 6c specified by sel
2310: 65 63 74 6f 72 73 20 74 6f 20 6f 6e 65 20 6f 66 ectors to one of
2320: 20 64 69 73 6b 73 20 73 70 65 63 69 66 69 65 64 disks specified
2330: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2340: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 6e 20 in
2350: 74 68 65 20 5b 61 72 63 68 69 76 65 2d 64 69 73 the [archive-dis
2360: 6b 73 5d 20 73 65 63 74 69 6f 6e 2e 0a 20 20 20 ks] section..
2370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2380: 20 20 20 20 20 20 20 20 20 63 6d 64 3a 20 6b 65 cmd: ke
2390: 65 70 2d 68 74 6d 6c 2c 20 72 65 73 74 6f 72 65 ep-html, restore
23a0: 2c 20 73 61 76 65 2c 20 73 61 76 65 2d 72 65 6d , save, save-rem
23b0: 6f 76 65 0a 20 20 2d 67 65 6e 65 72 61 74 65 2d ove. -generate-
23c0: 68 74 6d 6c 20 20 20 20 20 20 20 20 20 20 3a 20 html :
23d0: 63 72 65 61 74 65 20 61 20 73 69 6d 70 6c 65 20 create a simple
23e0: 68 74 6d 6c 20 74 72 65 65 20 66 6f 72 20 62 72 html tree for br
23f0: 6f 77 73 69 6e 67 20 79 6f 75 72 20 72 75 6e 73 owsing your runs
2400: 0a 0a 44 69 66 66 20 72 65 70 6f 72 74 0a 20 20 ..Diff report.
2410: 2d 64 69 66 66 2d 72 65 70 20 20 20 20 20 20 20 -diff-rep
2420: 20 20 20 20 20 20 20 20 3a 20 67 65 6e 65 72 61 : genera
2430: 74 65 20 64 69 66 66 20 72 65 70 6f 72 74 20 28 te diff report (
2440: 6d 75 73 74 20 69 6e 63 6c 75 64 65 20 2d 73 72 must include -sr
2450: 63 2d 74 61 72 67 65 74 2c 20 2d 73 72 63 2d 72 c-target, -src-r
2460: 75 6e 6e 61 6d 65 2c 20 2d 74 61 72 67 65 74 2c unname, -target,
2470: 20 2d 72 75 6e 6e 61 6d 65 0a 20 20 20 20 20 20 -runname.
2480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24a0: 20 20 20 20 20 20 20 20 20 20 20 20 61 6e 64 20 and
24b0: 65 69 74 68 65 72 20 2d 64 69 66 66 2d 65 6d 61 either -diff-ema
24c0: 69 6c 20 6f 72 20 2d 64 69 66 66 2d 68 74 6d 6c il or -diff-html
24d0: 29 0a 20 20 2d 73 72 63 2d 74 61 72 67 65 74 20 ). -src-target
24e0: 3c 74 61 72 67 65 74 3e 0a 20 20 2d 73 72 63 2d <target>. -src-
24f0: 72 75 6e 6e 61 6d 65 20 3c 74 61 72 67 65 74 3e runname <target>
2500: 0a 20 20 2d 64 69 66 66 2d 65 6d 61 69 6c 20 3c . -diff-email <
2510: 65 6d 61 69 6c 73 3e 20 20 20 20 3a 20 63 6f 6d emails> : com
2520: 6d 61 20 73 65 70 61 72 61 74 65 64 20 6c 69 73 ma separated lis
2530: 74 20 6f 66 20 65 6d 61 69 6c 20 61 64 64 72 65 t of email addre
2540: 73 73 65 73 20 74 6f 20 73 65 6e 64 20 64 69 66 sses to send dif
2550: 66 20 72 65 70 6f 72 74 0a 20 20 2d 64 69 66 66 f report. -diff
2560: 2d 68 74 6d 6c 20 20 3c 72 65 70 2e 68 74 6d 6c -html <rep.html
2570: 3e 20 20 3a 20 70 61 74 68 20 74 6f 20 68 74 6d > : path to htm
2580: 6c 20 66 69 6c 65 20 74 6f 20 67 65 6e 65 72 61 l file to genera
2590: 74 65 0a 0a 53 70 72 65 61 64 73 68 65 65 74 20 te..Spreadsheet
25a0: 67 65 6e 65 72 61 74 69 6f 6e 0a 20 20 2d 65 78 generation. -ex
25b0: 74 72 61 63 74 2d 6f 64 73 20 66 6e 61 6d 65 2e tract-ods fname.
25c0: 6f 64 73 20 20 3a 20 65 78 74 72 61 63 74 20 61 ods : extract a
25d0: 6e 20 6f 70 65 6e 20 64 6f 63 75 6d 65 6e 74 20 n open document
25e0: 73 70 72 65 61 64 73 68 65 65 74 20 66 72 6f 6d spreadsheet from
25f0: 20 74 68 65 20 64 61 74 61 62 61 73 65 0a 20 20 the database.
2600: 2d 70 61 74 68 6d 6f 64 20 70 61 74 68 20 20 20 -pathmod path
2610: 20 20 20 20 20 20 20 20 3a 20 69 6e 73 65 72 74 : insert
2620: 20 70 61 74 68 2c 20 69 2e 65 2e 20 70 61 74 68 path, i.e. path
2630: 2f 72 75 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 /runame/itempath
2640: 2f 6c 6f 67 66 69 6c 65 2e 68 74 6d 6c 0a 20 20 /logfile.html.
2650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2660: 20 20 20 20 20 20 20 20 20 20 77 69 6c 6c 20 63 will c
2670: 6c 65 61 72 20 74 68 65 20 66 69 65 6c 64 20 69 lear the field i
2680: 66 20 6e 6f 20 72 75 6e 64 69 72 2f 74 65 73 74 f no rundir/test
2690: 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f name/itempath/lo
26a0: 67 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 gfile.
26b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26c0: 20 20 69 66 20 69 74 20 63 6f 6e 74 61 69 6e 73 if it contains
26d0: 20 66 6f 72 77 61 72 64 20 73 6c 61 73 68 65 73 forward slashes
26e0: 20 74 68 65 20 70 61 74 68 20 77 69 6c 6c 20 62 the path will b
26f0: 65 20 63 6f 6e 76 65 72 74 65 64 0a 20 20 20 20 e converted.
2700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2710: 20 20 20 20 20 20 20 20 74 6f 20 77 69 6e 64 6f to windo
2720: 77 73 20 73 74 79 6c 65 0a 47 65 74 74 69 6e 67 ws style.Getting
2730: 20 73 74 61 72 74 65 64 0a 20 20 2d 63 72 65 61 started. -crea
2740: 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 te-megatest-area
2750: 20 20 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 : create
2760: 61 20 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 a skeleton megat
2770: 65 73 74 20 61 72 65 61 2e 20 59 6f 75 20 77 69 est area. You wi
2780: 6c 6c 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 ll be prompted f
2790: 6f 72 20 70 61 74 68 73 0a 20 20 2d 63 72 65 61 or paths. -crea
27a0: 74 65 2d 74 65 73 74 20 74 65 73 74 6e 61 6d 65 te-test testname
27b0: 20 20 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 : create
27c0: 61 20 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 a skeleton megat
27d0: 65 73 74 20 74 65 73 74 2e 20 59 6f 75 20 77 69 est test. You wi
27e0: 6c 6c 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 ll be prompted f
27f0: 6f 72 20 69 6e 66 6f 0a 0a 45 78 61 6d 70 6c 65 or info..Example
2800: 73 0a 0a 23 20 47 65 74 20 74 65 73 74 20 70 61 s..# Get test pa
2810: 74 68 2c 20 75 73 65 20 27 2e 27 20 74 6f 20 67 th, use '.' to g
2820: 65 74 20 61 20 73 69 6e 67 6c 65 20 70 61 74 68 et a single path
2830: 20 6f 72 20 61 20 73 70 65 63 69 66 69 63 20 70 or a specific p
2840: 61 74 68 2f 66 69 6c 65 20 70 61 74 74 65 72 6e ath/file pattern
2850: 0a 6d 65 67 61 74 65 73 74 20 2d 74 65 73 74 2d .megatest -test-
2860: 66 69 6c 65 73 20 27 6c 6f 67 73 2f 2a 2e 6c 6f files 'logs/*.lo
2870: 67 27 20 2d 74 61 72 67 65 74 20 75 62 75 6e 74 g' -target ubunt
2880: 75 2f 6e 25 2f 6e 6f 25 20 2d 72 75 6e 6e 61 6d u/n%/no% -runnam
2890: 65 20 77 34 39 25 20 2d 74 65 73 74 70 61 74 74 e w49% -testpatt
28a0: 20 74 65 73 74 5f 6d 74 25 0a 0a 43 61 6c 6c 65 test_mt%..Calle
28b0: 64 20 61 73 20 22 20 28 73 74 72 69 6e 67 2d 69 d as " (string-i
28c0: 6e 74 65 72 73 70 65 72 73 65 20 28 61 72 67 76 ntersperse (argv
28d0: 29 20 22 20 22 29 20 22 0a 56 65 72 73 69 6f 6e ) " ") ".Version
28e0: 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 " megatest-vers
28f0: 69 6f 6e 20 22 2c 20 62 75 69 6c 74 20 66 72 6f ion ", built fro
2900: 6d 20 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 m " megatest-fos
2910: 73 69 6c 2d 68 61 73 68 20 29 29 0a 0a 3b 3b 20 sil-hash ))..;;
2920: 20 2d 67 75 69 20 20 20 20 20 20 20 20 20 20 20 -gui
2930: 20 20 20 20 20 20 20 20 20 3a 20 73 74 61 72 74 : start
2940: 20 61 20 67 75 69 20 69 6e 74 65 72 66 61 63 65 a gui interface
2950: 0a 3b 3b 20 20 2d 63 6f 6e 66 69 67 20 66 6e 61 .;; -config fna
2960: 6d 65 20 20 20 20 20 20 20 20 20 20 20 3a 20 6f me : o
2970: 76 65 72 72 69 64 65 20 74 68 65 20 72 75 6e 63 verride the runc
2980: 6f 6e 66 69 67 20 66 69 6c 65 20 77 69 74 68 20 onfig file with
2990: 66 6e 61 6d 65 0a 0a 3b 3b 20 70 72 6f 63 65 73 fname..;; proces
29a0: 73 20 61 72 67 73 0a 28 64 65 66 69 6e 65 20 72 s args.(define r
29b0: 65 6d 61 72 67 73 20 28 61 72 67 73 3a 67 65 74 emargs (args:get
29c0: 2d 61 72 67 73 20 0a 09 09 20 28 61 72 67 76 29 -args ... (argv)
29d0: 0a 09 09 20 28 6c 69 73 74 20 20 22 2d 72 75 6e ... (list "-run
29e0: 74 65 73 74 73 22 20 20 3b 3b 20 72 75 6e 20 61 tests" ;; run a
29f0: 20 73 70 65 63 69 66 69 63 20 74 65 73 74 0a 09 specific test..
2a00: 09 09 22 2d 63 6f 6e 66 69 67 22 20 20 20 20 3b .."-config" ;
2a10: 3b 20 6f 76 65 72 72 69 64 65 20 74 68 65 20 63 ; override the c
2a20: 6f 6e 66 69 67 20 66 69 6c 65 20 6e 61 6d 65 0a onfig file name.
2a30: 09 09 09 22 2d 65 78 65 63 75 74 65 22 20 20 20 ..."-execute"
2a40: 3b 3b 20 72 75 6e 20 74 68 65 20 63 6f 6d 6d 61 ;; run the comma
2a50: 6e 64 20 65 6e 63 6f 64 65 64 20 69 6e 20 74 68 nd encoded in th
2a60: 65 20 62 61 73 65 36 34 20 70 61 72 61 6d 65 74 e base64 paramet
2a70: 65 72 0a 09 09 09 22 2d 73 74 65 70 22 0a 09 09 er...."-step"...
2a80: 09 22 2d 74 61 72 67 65 74 22 0a 09 09 09 22 2d ."-target"...."-
2a90: 72 65 71 74 61 72 67 22 0a 09 09 09 22 3a 72 75 reqtarg"....":ru
2aa0: 6e 6e 61 6d 65 22 0a 09 09 09 22 2d 72 75 6e 6e nname"...."-runn
2ab0: 61 6d 65 22 0a 09 09 09 22 3a 73 74 61 74 65 22 ame"....":state"
2ac0: 20 20 0a 09 09 09 22 2d 73 74 61 74 65 22 0a 09 ...."-state"..
2ad0: 09 09 22 3a 73 74 61 74 75 73 22 0a 09 09 09 22 ..":status"...."
2ae0: 2d 73 74 61 74 75 73 22 0a 09 09 09 22 2d 6c 69 -status"...."-li
2af0: 73 74 2d 72 75 6e 73 22 0a 09 09 09 22 2d 74 65 st-runs"...."-te
2b00: 73 74 70 61 74 74 22 0a 20 20 20 20 20 20 20 20 stpatt".
2b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b20: 22 2d 2d 6d 6f 64 65 70 61 74 74 22 0a 20 20 20 "--modepatt".
2b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b40: 20 20 20 20 20 22 2d 74 61 67 65 78 70 72 22 0a "-tagexpr".
2b50: 09 09 09 22 2d 69 74 65 6d 70 61 74 74 22 0a 09 ..."-itempatt"..
2b60: 09 09 22 2d 73 65 74 6c 6f 67 22 0a 09 09 09 22 .."-setlog"...."
2b70: 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 0a 09 09 09 -set-toplog"....
2b80: 22 2d 72 75 6e 73 74 65 70 22 0a 09 09 09 22 2d "-runstep"...."-
2b90: 6c 6f 67 70 72 6f 22 0a 09 09 09 22 2d 6d 22 0a logpro"...."-m".
2ba0: 09 09 09 22 2d 72 65 72 75 6e 22 0a 09 09 09 22 ..."-rerun"...."
2bb0: 2d 64 61 79 73 22 0a 09 09 09 22 2d 72 65 6e 61 -days"...."-rena
2bc0: 6d 65 2d 72 75 6e 22 0a 09 09 09 22 2d 74 6f 22 me-run"...."-to"
2bd0: 0a 09 09 09 3b 3b 20 76 61 6c 75 65 73 20 61 6e ....;; values an
2be0: 64 20 6d 65 73 73 61 67 65 73 0a 09 09 09 22 3a d messages....":
2bf0: 63 61 74 65 67 6f 72 79 22 0a 09 09 09 22 3a 76 category"....":v
2c00: 61 72 69 61 62 6c 65 22 0a 09 09 09 22 3a 76 61 ariable"....":va
2c10: 6c 75 65 22 0a 09 09 09 22 3a 65 78 70 65 63 74 lue"....":expect
2c20: 65 64 22 0a 09 09 09 22 3a 74 6f 6c 22 0a 09 09 ed"....":tol"...
2c30: 09 22 3a 75 6e 69 74 73 22 0a 09 09 09 3b 3b 20 .":units"....;;
2c40: 6d 69 73 63 0a 09 09 09 22 2d 73 74 61 72 74 2d misc...."-start-
2c50: 64 69 72 22 0a 09 09 09 22 2d 73 65 72 76 65 72 dir"...."-server
2c60: 22 0a 09 09 09 22 2d 73 74 6f 70 2d 73 65 72 76 "...."-stop-serv
2c70: 65 72 22 0a 09 09 09 22 2d 74 72 61 6e 73 70 6f er"...."-transpo
2c80: 72 74 22 0a 09 09 09 22 2d 6b 69 6c 6c 2d 73 65 rt"...."-kill-se
2c90: 72 76 65 72 22 0a 09 09 09 22 2d 70 6f 72 74 22 rver"...."-port"
2ca0: 0a 09 09 09 22 2d 65 78 74 72 61 63 74 2d 6f 64 ...."-extract-od
2cb0: 73 22 0a 09 09 09 22 2d 70 61 74 68 6d 6f 64 22 s"...."-pathmod"
2cc0: 0a 09 09 09 22 2d 65 6e 76 32 66 69 6c 65 22 0a ...."-env2file".
2cd0: 09 09 09 22 2d 65 6e 76 63 61 70 22 0a 09 09 09 ..."-envcap"....
2ce0: 22 2d 65 6e 76 64 65 6c 74 61 22 0a 09 09 09 22 "-envdelta"...."
2cf0: 2d 73 65 74 76 61 72 73 22 0a 09 09 09 22 2d 73 -setvars"...."-s
2d00: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 et-state-status"
2d10: 0a 09 09 09 22 2d 73 65 74 2d 72 75 6e 2d 73 74 ...."-set-run-st
2d20: 61 74 75 73 22 0a 09 09 09 22 2d 64 65 62 75 67 atus"...."-debug
2d30: 22 20 3b 3b 20 66 6f 72 20 2a 76 65 72 62 6f 73 " ;; for *verbos
2d40: 69 74 79 2a 20 3e 20 32 0a 09 09 09 22 2d 63 72 ity* > 2...."-cr
2d50: 65 61 74 65 2d 74 65 73 74 22 0a 09 09 09 22 2d eate-test"...."-
2d60: 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 74 override-timeout
2d70: 22 0a 09 09 09 22 2d 74 65 73 74 2d 66 69 6c 65 "...."-test-file
2d80: 73 22 20 20 3b 3b 20 2d 74 65 73 74 2d 70 61 74 s" ;; -test-pat
2d90: 68 73 20 69 73 20 66 6f 72 20 6c 69 73 74 69 6e hs is for listin
2da0: 67 20 61 6c 6c 0a 09 09 09 22 2d 6c 6f 61 64 22 g all...."-load"
2db0: 20 20 20 20 20 20 20 20 3b 3b 20 6c 6f 61 64 20 ;; load
2dc0: 61 6e 64 20 65 78 65 63 74 75 74 65 20 61 20 73 and exectute a s
2dd0: 63 68 65 6d 65 20 66 69 6c 65 0a 09 09 09 22 2d cheme file...."-
2de0: 73 65 63 74 69 6f 6e 22 0a 09 09 09 22 2d 76 61 section"...."-va
2df0: 72 22 0a 09 09 09 22 2d 64 75 6d 70 6d 6f 64 65 r"...."-dumpmode
2e00: 22 0a 09 09 09 22 2d 72 75 6e 2d 69 64 22 0a 09 "...."-run-id"..
2e10: 09 09 22 2d 70 69 6e 67 22 0a 09 09 09 22 2d 72 .."-ping"...."-r
2e20: 65 66 64 62 32 64 61 74 22 0a 09 09 09 22 2d 6f efdb2dat"...."-o
2e30: 22 0a 09 09 09 22 2d 6c 6f 67 22 0a 09 09 09 22 "...."-log"...."
2e40: 2d 61 72 63 68 69 76 65 22 0a 09 09 09 22 2d 73 -archive"...."-s
2e50: 69 6e 63 65 22 0a 09 09 09 22 2d 66 69 65 6c 64 ince"...."-field
2e60: 73 22 0a 09 09 09 22 2d 72 65 63 6f 76 65 72 2d s"...."-recover-
2e70: 74 65 73 74 22 20 3b 3b 20 72 75 6e 2d 69 64 2c test" ;; run-id,
2e80: 74 65 73 74 2d 69 64 20 2d 20 75 73 65 64 20 69 test-id - used i
2e90: 6e 74 65 72 6e 61 6c 6c 79 20 74 6f 20 72 65 63 nternally to rec
2ea0: 6f 76 65 72 20 61 20 74 65 73 74 20 73 74 75 63 over a test stuc
2eb0: 6b 20 69 6e 20 52 55 4e 4e 49 4e 47 20 73 74 61 k in RUNNING sta
2ec0: 74 65 0a 09 09 09 22 2d 73 6f 72 74 22 0a 09 09 te...."-sort"...
2ed0: 09 22 2d 74 61 72 67 65 74 2d 64 62 22 0a 09 09 ."-target-db"...
2ee0: 09 22 2d 73 6f 75 72 63 65 2d 64 62 22 0a 0a 20 ."-source-db"..
2ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f00: 20 20 20 20 20 20 20 22 2d 73 72 63 2d 74 61 72 "-src-tar
2f10: 67 65 74 22 0a 20 20 20 20 20 20 20 20 20 20 20 get".
2f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 2d 73 "-s
2f30: 72 63 2d 72 75 6e 6e 61 6d 65 22 0a 20 20 20 20 rc-runname".
2f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f50: 20 20 20 20 22 2d 64 69 66 66 2d 65 6d 61 69 6c "-diff-email
2f60: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ".
2f70: 20 20 20 20 20 20 20 20 20 20 22 2d 64 69 66 66 "-diff
2f80: 2d 68 74 6d 6c 22 0a 09 09 09 29 0a 20 09 09 20 -html"....). ..
2f90: 28 6c 69 73 74 20 20 22 2d 68 22 20 22 2d 68 65 (list "-h" "-he
2fa0: 6c 70 22 20 22 2d 2d 68 65 6c 70 22 0a 09 09 09 lp" "--help"....
2fb0: 22 2d 6d 61 6e 75 61 6c 22 0a 09 09 09 22 2d 76 "-manual"...."-v
2fc0: 65 72 73 69 6f 6e 22 0a 09 09 20 20 20 20 20 20 ersion"...
2fd0: 20 20 22 2d 66 6f 72 63 65 22 0a 09 09 20 20 20 "-force"...
2fe0: 20 20 20 20 20 22 2d 78 74 65 72 6d 22 0a 09 09 "-xterm"...
2ff0: 20 20 20 20 20 20 20 20 22 2d 73 68 6f 77 6b 65 "-showke
3000: 79 73 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d ys"... "-
3010: 73 68 6f 77 2d 6b 65 79 73 22 0a 09 09 20 20 20 show-keys"...
3020: 20 20 20 20 20 22 2d 74 65 73 74 2d 73 74 61 74 "-test-stat
3030: 75 73 22 0a 09 09 09 22 2d 73 65 74 2d 76 61 6c us"...."-set-val
3040: 75 65 73 22 0a 09 09 09 22 2d 6c 6f 61 64 2d 74 ues"...."-load-t
3050: 65 73 74 2d 64 61 74 61 22 0a 09 09 09 22 2d 73 est-data"...."-s
3060: 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 0a ummarize-items".
3070: 09 09 20 20 20 20 20 20 20 20 22 2d 67 75 69 22 .. "-gui"
3080: 0a 09 09 09 22 2d 64 61 65 6d 6f 6e 69 7a 65 22 ...."-daemonize"
3090: 0a 09 09 09 22 2d 70 72 65 63 6c 65 61 6e 22 0a ...."-preclean".
30a0: 09 09 09 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e ..."-rerun-clean
30b0: 22 0a 09 09 09 22 2d 72 65 72 75 6e 2d 61 6c 6c "...."-rerun-all
30c0: 22 0a 09 09 09 22 2d 63 6c 65 61 6e 2d 63 61 63 "...."-clean-cac
30d0: 68 65 22 0a 09 09 09 22 2d 63 61 63 68 65 2d 64 he"...."-cache-d
30e0: 62 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 b".
30f0: 20 20 20 20 20 20 20 20 20 20 20 22 2d 75 73 65 "-use
3100: 2d 64 62 2d 63 61 63 68 65 22 0a 09 09 09 3b 3b -db-cache"....;;
3110: 20 6d 69 73 63 0a 09 09 09 22 2d 72 65 70 6c 22 misc...."-repl"
3120: 0a 09 09 09 22 2d 6c 6f 63 6b 22 0a 09 09 09 22 ...."-lock"...."
3130: 2d 75 6e 6c 6f 63 6b 22 0a 09 09 09 22 2d 6c 69 -unlock"...."-li
3140: 73 74 2d 73 65 72 76 65 72 73 22 0a 20 20 20 20 st-servers".
3150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3160: 20 20 20 20 22 2d 72 75 6e 2d 77 61 69 74 22 20 "-run-wait"
3170: 20 20 20 20 20 3b 3b 20 77 61 69 74 20 6f 6e 20 ;; wait on
3180: 61 20 72 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 a run to complet
3190: 65 20 28 69 2e 65 2e 20 6e 6f 20 52 55 4e 4e 49 e (i.e. no RUNNI
31a0: 4e 47 29 0a 09 09 09 22 2d 6c 6f 63 61 6c 22 20 NG)...."-local"
31b0: 20 20 20 20 20 20 20 20 3b 3b 20 72 75 6e 20 73 ;; run s
31c0: 6f 6d 65 20 63 6f 6d 6d 61 6e 64 73 20 75 73 69 ome commands usi
31d0: 6e 67 20 6c 6f 63 61 6c 20 64 62 20 61 63 63 65 ng local db acce
31e0: 73 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ss.
31f0: 20 20 20 20 20 20 20 20 20 20 20 22 2d 67 65 6e "-gen
3200: 65 72 61 74 65 2d 68 74 6d 6c 22 0a 0a 09 09 09 erate-html".....
3210: 3b 3b 20 6d 69 73 63 20 71 75 65 72 69 65 73 0a ;; misc queries.
3220: 09 09 09 22 2d 6c 69 73 74 2d 64 69 73 6b 73 22 ..."-list-disks"
3230: 0a 09 09 09 22 2d 6c 69 73 74 2d 74 61 72 67 65 ...."-list-targe
3240: 74 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d 64 62 ts"...."-list-db
3250: 2d 74 61 72 67 65 74 73 22 0a 09 09 09 22 2d 73 -targets"...."-s
3260: 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 22 0a 09 how-runconfig"..
3270: 09 09 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 22 .."-show-config"
3280: 0a 09 09 09 22 2d 73 68 6f 77 2d 63 6d 64 69 6e ...."-show-cmdin
3290: 66 6f 22 0a 09 09 09 22 2d 67 65 74 2d 72 75 6e fo"...."-get-run
32a0: 2d 73 74 61 74 75 73 22 0a 0a 09 09 09 3b 3b 20 -status".....;;
32b0: 71 75 65 72 69 65 73 0a 09 09 09 22 2d 74 65 73 queries...."-tes
32c0: 74 2d 70 61 74 68 73 22 20 3b 3b 20 67 65 74 20 t-paths" ;; get
32d0: 70 61 74 68 28 73 29 20 74 6f 20 61 20 74 65 73 path(s) to a tes
32e0: 74 2c 20 6f 72 64 65 72 65 64 20 62 79 20 79 6f t, ordered by yo
32f0: 75 6e 67 65 73 74 20 66 69 72 73 74 0a 0a 09 09 ungest first....
3300: 09 22 2d 72 75 6e 61 6c 6c 22 20 20 20 20 3b 3b ."-runall" ;;
3310: 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 2c 20 run all tests,
3320: 72 65 73 70 65 63 74 73 20 2d 74 65 73 74 70 61 respects -testpa
3330: 74 74 2c 20 64 65 66 61 75 6c 74 73 20 74 6f 20 tt, defaults to
3340: 25 0a 09 09 09 22 2d 72 75 6e 22 20 20 20 20 20 %...."-run"
3350: 20 20 3b 3b 20 61 6c 69 61 73 20 66 6f 72 20 2d ;; alias for -
3360: 72 75 6e 61 6c 6c 0a 09 09 09 22 2d 72 65 6d 6f runall...."-remo
3370: 76 65 2d 72 75 6e 73 22 0a 09 09 09 22 2d 72 65 ve-runs"...."-re
3380: 62 75 69 6c 64 2d 64 62 22 0a 09 09 09 22 2d 63 build-db"...."-c
3390: 6c 65 61 6e 75 70 2d 64 62 22 0a 09 09 09 22 2d leanup-db"...."-
33a0: 72 6f 6c 6c 75 70 22 0a 09 09 09 22 2d 75 70 64 rollup"...."-upd
33b0: 61 74 65 2d 6d 65 74 61 22 0a 09 09 09 22 2d 63 ate-meta"...."-c
33c0: 72 65 61 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 reate-megatest-a
33d0: 72 65 61 22 0a 09 09 09 22 2d 6d 61 72 6b 2d 69 rea"...."-mark-i
33e0: 6e 63 6f 6d 70 6c 65 74 65 73 22 0a 0a 09 09 09 ncompletes".....
33f0: 22 2d 63 6f 6e 76 65 72 74 2d 74 6f 2d 6e 6f 72 "-convert-to-nor
3400: 6d 22 0a 09 09 09 22 2d 63 6f 6e 76 65 72 74 2d m"...."-convert-
3410: 74 6f 2d 6f 6c 64 22 0a 09 09 09 22 2d 69 6d 70 to-old"...."-imp
3420: 6f 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 ort-megatest.db"
3430: 0a 09 09 09 22 2d 73 79 6e 63 2d 74 6f 2d 6d 65 ...."-sync-to-me
3440: 67 61 74 65 73 74 2e 64 62 22 0a 0a 09 09 09 22 gatest.db"....."
3450: 2d 6c 6f 67 67 69 6e 67 22 0a 09 09 09 22 2d 76 -logging"...."-v
3460: 22 20 3b 3b 20 76 65 72 62 6f 73 65 20 32 2c 20 " ;; verbose 2,
3470: 6d 6f 72 65 20 74 68 61 6e 20 6e 6f 72 6d 61 6c more than normal
3480: 20 28 6e 6f 72 6d 61 6c 20 69 73 20 31 29 0a 09 (normal is 1)..
3490: 09 09 22 2d 71 22 20 3b 3b 20 71 75 69 65 74 20 .."-q" ;; quiet
34a0: 30 2c 20 65 72 72 6f 72 73 2f 77 61 72 6e 69 6e 0, errors/warnin
34b0: 67 73 20 6f 6e 6c 79 0a 0a 20 20 20 20 20 20 20 gs only..
34c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34d0: 20 22 2d 64 69 66 66 2d 72 65 70 22 0a 20 20 20 "-diff-rep".
34e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34f0: 20 20 20 20 20 29 0a 09 09 20 61 72 67 73 3a 61 )... args:a
3500: 72 67 2d 68 61 73 68 0a 09 09 20 30 29 29 0a 0a rg-hash... 0))..
3510: 3b 3b 20 41 64 64 20 61 72 67 73 20 74 68 61 74 ;; Add args that
3520: 20 75 73 65 20 72 65 6d 61 72 67 73 20 68 65 72 use remargs her
3530: 65 0a 3b 3b 0a 28 69 66 20 28 61 6e 64 20 28 6e e.;;.(if (and (n
3540: 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 ot (null? remarg
3550: 73 29 29 0a 09 20 28 6e 6f 74 20 28 6f 72 0a 09 s)).. (not (or..
3560: 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 (args:get
3570: 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 -arg "-runstep")
3580: 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 .. (args:g
3590: 65 74 2d 61 72 67 20 22 2d 65 6e 76 63 61 70 22 et-arg "-envcap"
35a0: 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 3a ).. (args:
35b0: 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 64 65 6c get-arg "-envdel
35c0: 74 61 22 29 0a 09 20 20 20 20 20 20 20 29 0a 09 ta").. )..
35d0: 20 20 20 20 20 20 29 29 0a 20 20 20 20 28 64 65 )). (de
35e0: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
35f0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
3600: 6f 72 74 2a 20 22 55 6e 72 65 63 6f 67 6e 69 73 ort* "Unrecognis
3610: 65 64 20 61 72 67 75 6d 65 6e 74 73 3a 20 22 20 ed arguments: "
3620: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
3630: 72 73 65 20 28 69 66 20 28 6c 69 73 74 3f 20 72 rse (if (list? r
3640: 65 6d 61 72 67 73 29 20 72 65 6d 61 72 67 73 20 emargs) remargs
3650: 28 61 72 67 76 29 29 20 20 22 20 22 29 29 29 0a (argv)) " "))).
3660: 0a 3b 3b 20 69 6d 6d 65 64 69 61 74 65 6c 79 20 .;; immediately
3670: 73 65 74 20 4d 54 5f 54 41 52 47 45 54 20 69 66 set MT_TARGET if
3680: 20 2d 72 65 71 74 61 72 67 20 6f 72 20 2d 74 61 -reqtarg or -ta
3690: 72 67 65 74 20 61 72 65 20 61 76 61 69 6c 61 62 rget are availab
36a0: 6c 65 0a 3b 3b 0a 28 6c 65 74 20 28 28 74 61 72 le.;;.(let ((tar
36b0: 67 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d g (or (args:get-
36c0: 61 72 67 20 22 2d 72 65 71 74 61 72 67 22 29 28 arg "-reqtarg")(
36d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
36e0: 61 72 67 65 74 22 29 29 29 29 0a 20 20 28 69 66 arget")))). (if
36f0: 20 74 61 72 67 20 28 73 65 74 65 6e 76 20 22 4d targ (setenv "M
3700: 54 5f 54 41 52 47 45 54 22 20 74 61 72 67 29 29 T_TARGET" targ))
3710: 29 0a 0a 3b 3b 20 54 68 65 20 77 61 74 63 68 64 )..;; The watchd
3720: 6f 67 20 69 73 20 74 6f 20 6b 65 65 70 20 61 6e og is to keep an
3730: 20 65 79 65 20 6f 6e 20 74 68 69 6e 67 73 20 6c eye on things l
3740: 69 6b 65 20 64 62 20 73 79 6e 63 20 65 74 63 2e ike db sync etc.
3750: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 2a 77 61 74 .;;.(define *wat
3760: 63 68 64 6f 67 2a 20 28 6d 61 6b 65 2d 74 68 72 chdog* (make-thr
3770: 65 61 64 20 63 6f 6d 6d 6f 6e 3a 77 61 74 63 68 ead common:watch
3780: 64 6f 67 20 22 57 61 74 63 68 64 6f 67 20 74 68 dog "Watchdog th
3790: 72 65 61 64 22 29 29 0a 0a 28 69 66 20 28 6e 6f read"))..(if (no
37a0: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
37b0: 22 2d 73 65 72 76 65 72 22 29 29 0a 20 20 20 20 "-server")).
37c0: 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 2a (thread-start! *
37d0: 77 61 74 63 68 64 6f 67 2a 29 29 20 3b 3b 20 69 watchdog*)) ;; i
37e0: 66 20 73 74 61 72 74 69 6e 67 20 61 20 73 65 72 f starting a ser
37f0: 76 65 72 3b 20 77 61 69 74 20 74 69 6c 6c 20 77 ver; wait till w
3800: 65 20 67 65 74 20 74 6f 20 72 75 6e 6e 69 6e 67 e get to running
3810: 20 73 74 61 74 65 20 62 65 66 6f 72 65 20 6b 69 state before ki
3820: 63 6b 69 6e 67 20 6f 66 66 20 77 61 74 63 68 64 cking off watchd
3830: 6f 67 0a 3b 3b 28 42 42 3e 20 22 74 68 72 65 61 og.;;(BB> "threa
3840: 64 2d 73 74 61 72 74 21 20 77 61 74 63 68 64 6f d-start! watchdo
3850: 67 22 29 0a 0a 3b 3b 20 62 72 61 63 6b 65 74 20 g")..;; bracket
3860: 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 open-output-file
3870: 20 77 69 74 68 20 63 6f 64 65 20 74 6f 20 6d 61 with code to ma
3880: 6b 65 20 6c 65 61 64 69 6e 67 20 64 69 72 65 63 ke leading direc
3890: 74 6f 72 79 20 69 66 20 69 74 20 64 6f 65 73 20 tory if it does
38a0: 6e 6f 74 20 65 78 69 73 74 20 61 6e 64 20 68 61 not exist and ha
38b0: 6e 64 6c 65 20 65 78 63 65 70 74 69 6f 6e 73 0a ndle exceptions.
38c0: 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 6c 6f (define (open-lo
38d0: 67 66 69 6c 65 20 6c 6f 67 70 61 74 68 29 0a 20 gfile logpath).
38e0: 20 28 63 6f 6e 64 69 74 69 6f 6e 2d 63 61 73 65 (condition-case
38f0: 0a 20 20 20 28 6c 65 74 2a 20 28 28 6c 6f 67 2d . (let* ((log-
3900: 64 69 72 20 28 6f 72 20 28 70 61 74 68 6e 61 6d dir (or (pathnam
3910: 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 6f 67 70 e-directory logp
3920: 61 74 68 29 20 22 2e 22 29 29 29 0a 20 20 20 20 ath) "."))).
3930: 20 28 69 66 20 28 6e 6f 74 20 28 64 69 72 65 63 (if (not (direc
3940: 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 6c 6f 67 tory-exists? log
3950: 2d 64 69 72 29 29 0a 20 20 20 20 20 20 20 20 20 -dir)).
3960: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d (system (conc "m
3970: 6b 64 69 72 20 2d 70 20 22 20 6c 6f 67 2d 64 69 kdir -p " log-di
3980: 72 29 29 29 0a 20 20 20 20 20 28 6f 70 65 6e 2d r))). (open-
3990: 6f 75 74 70 75 74 2d 66 69 6c 65 20 6c 6f 67 70 output-file logp
39a0: 61 74 68 29 29 0a 20 20 20 28 65 78 6e 20 28 29 ath)). (exn ()
39b0: 0a 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a . (debug:
39c0: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
39d0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
39e0: 20 22 43 6f 75 6c 64 20 6e 6f 74 20 6f 70 65 6e "Could not open
39f0: 20 6c 6f 67 20 66 69 6c 65 20 66 6f 72 20 77 72 log file for wr
3a00: 69 74 65 3a 20 22 6c 6f 67 70 61 74 68 29 0a 20 ite: "logpath).
3a10: 20 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 2a (define *
3a20: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
3a30: 29 20 20 0a 20 20 20 20 20 20 20 20 28 65 78 69 ) . (exi
3a40: 74 20 31 29 29 29 29 0a 0a 28 69 66 20 28 61 72 t 1))))..(if (ar
3a50: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 gs:get-arg "-log
3a60: 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 6f 75 "). (let ((ou
3a70: 70 20 28 6f 70 65 6e 2d 6c 6f 67 66 69 6c 65 20 p (open-logfile
3a80: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3a90: 6c 6f 67 22 29 29 29 29 0a 20 20 20 20 20 20 28 log")))). (
3aa0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
3ab0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
3ac0: 70 6f 72 74 2a 20 22 53 65 6e 64 69 6e 67 20 6c port* "Sending l
3ad0: 6f 67 20 6f 75 74 70 75 74 20 74 6f 20 22 20 28 og output to " (
3ae0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
3af0: 6f 67 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 og")). (set
3b00: 21 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 ! *default-log-p
3b10: 6f 72 74 2a 20 6f 75 70 29 29 29 0a 0a 28 69 66 ort* oup)))..(if
3b20: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
3b30: 72 67 20 22 2d 68 22 29 0a 09 28 61 72 67 73 3a rg "-h")..(args:
3b40: 67 65 74 2d 61 72 67 20 22 2d 68 65 6c 70 22 29 get-arg "-help")
3b50: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
3b60: 22 2d 2d 68 65 6c 70 22 29 29 0a 20 20 20 20 28 "--help")). (
3b70: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 69 begin. (pri
3b80: 6e 74 20 68 65 6c 70 29 0a 20 20 20 20 20 20 28 nt help). (
3b90: 65 78 69 74 29 29 29 0a 0a 28 69 66 20 28 61 72 exit)))..(if (ar
3ba0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 61 6e gs:get-arg "-man
3bb0: 75 61 6c 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 ual"). (let*
3bc0: 28 28 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 ((htmlviewercmd
3bd0: 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (or (configf:loo
3be0: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
3bf0: 22 73 65 74 75 70 22 20 22 68 74 6d 6c 76 69 65 "setup" "htmlvie
3c00: 77 65 72 63 6d 64 22 29 0a 09 09 09 20 20 20 20 wercmd")....
3c10: 20 20 28 63 6f 6d 6d 6f 6e 3a 77 68 69 63 68 20 (common:which
3c20: 27 28 22 66 69 72 65 66 6f 78 22 20 22 61 72 6f '("firefox" "aro
3c30: 72 61 22 29 29 29 29 0a 09 20 20 20 28 69 6e 73 ra")))).. (ins
3c40: 74 61 6c 6c 2d 68 6f 6d 65 20 20 28 63 6f 6d 6d tall-home (comm
3c50: 6f 6e 3a 67 65 74 2d 69 6e 73 74 61 6c 6c 2d 61 on:get-install-a
3c60: 72 65 61 29 29 0a 09 20 20 20 28 6d 61 6e 75 61 rea)).. (manua
3c70: 6c 2d 68 74 6d 6c 20 20 20 28 63 6f 6e 63 20 69 l-html (conc i
3c80: 6e 73 74 61 6c 6c 2d 68 6f 6d 65 20 22 2f 73 68 nstall-home "/sh
3c90: 61 72 65 2f 64 6f 63 73 2f 6d 65 67 61 74 65 73 are/docs/megates
3ca0: 74 5f 6d 61 6e 75 61 6c 2e 68 74 6d 6c 22 29 29 t_manual.html"))
3cb0: 29 0a 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 ). (if (and
3cc0: 20 69 6e 73 74 61 6c 6c 2d 68 6f 6d 65 0a 09 20 install-home..
3cd0: 20 20 20 20 20 20 28 66 69 6c 65 2d 65 78 69 73 (file-exis
3ce0: 74 73 3f 20 6d 61 6e 75 61 6c 2d 68 74 6d 6c 29 ts? manual-html)
3cf0: 29 0a 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f ).. (system (co
3d00: 6e 63 20 22 28 22 20 68 74 6d 6c 76 69 65 77 65 nc "(" htmlviewe
3d10: 72 63 6d 64 20 22 20 22 20 6d 61 6e 75 61 6c 2d rcmd " " manual-
3d20: 68 74 6d 6c 20 22 20 29 20 26 22 29 29 0a 09 20 html " ) &"))..
3d30: 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
3d40: 28 22 20 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 (" htmlviewercmd
3d50: 20 22 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 " http://www.ki
3d60: 61 74 6f 61 2e 63 6f 6d 2f 63 67 69 2d 62 69 6e atoa.com/cgi-bin
3d70: 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 /fossils/megates
3d80: 74 2f 64 6f 63 2f 74 69 70 2f 64 6f 63 73 2f 6d t/doc/tip/docs/m
3d90: 61 6e 75 61 6c 2f 6d 65 67 61 74 65 73 74 5f 6d anual/megatest_m
3da0: 61 6e 75 61 6c 2e 68 74 6d 6c 20 29 20 26 22 29 anual.html ) &")
3db0: 29 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 )). (exit))
3dc0: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
3dd0: 2d 61 72 67 20 22 2d 73 74 61 72 74 2d 64 69 72 -arg "-start-dir
3de0: 22 29 0a 20 20 20 20 28 69 66 20 28 66 69 6c 65 "). (if (file
3df0: 2d 65 78 69 73 74 73 3f 20 28 61 72 67 73 3a 67 -exists? (args:g
3e00: 65 74 2d 61 72 67 20 22 2d 73 74 61 72 74 2d 64 et-arg "-start-d
3e10: 69 72 22 29 29 0a 09 28 63 68 61 6e 67 65 2d 64 ir"))..(change-d
3e20: 69 72 65 63 74 6f 72 79 20 28 61 72 67 73 3a 67 irectory (args:g
3e30: 65 74 2d 61 72 67 20 22 2d 73 74 61 72 74 2d 64 et-arg "-start-d
3e40: 69 72 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 ir"))..(begin..
3e50: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
3e60: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
3e70: 6f 67 2d 70 6f 72 74 2a 20 22 6e 6f 6e 2d 65 78 og-port* "non-ex
3e80: 69 73 74 61 6e 74 20 73 74 61 72 74 20 64 69 72 istant start dir
3e90: 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 " (args:get-arg
3ea0: 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 20 22 "-start-dir") "
3eb0: 20 73 70 65 63 69 66 69 65 64 2c 20 65 78 69 74 specified, exit
3ec0: 69 6e 67 2e 22 29 0a 09 20 20 28 65 78 69 74 20 ing.").. (exit
3ed0: 31 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 1))))..(if (args
3ee0: 3a 67 65 74 2d 61 72 67 20 22 2d 76 65 72 73 69 :get-arg "-versi
3ef0: 6f 6e 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a on"). (begin.
3f00: 20 20 20 20 20 20 28 70 72 69 6e 74 20 28 63 6f (print (co
3f10: 6d 6d 6f 6e 3a 76 65 72 73 69 6f 6e 2d 73 69 67 mmon:version-sig
3f20: 6e 61 74 75 72 65 29 29 20 3b 3b 20 28 70 72 69 nature)) ;; (pri
3f30: 6e 74 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 nt megatest-vers
3f40: 69 6f 6e 29 0a 20 20 20 20 20 20 28 65 78 69 74 ion). (exit
3f50: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 69 )))..(define *di
3f60: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 66 29 0a dsomething* #f).
3f70: 0a 3b 3b 20 4f 76 65 72 61 6c 6c 20 65 78 69 74 .;; Overall exit
3f80: 20 68 61 6e 64 6c 69 6e 67 20 73 65 74 75 70 20 handling setup
3f90: 69 6d 6d 65 64 69 61 74 65 6c 79 0a 3b 3b 0a 28 immediately.;;.(
3fa0: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
3fb0: 2d 61 72 67 20 22 2d 70 72 6f 63 65 73 73 2d 72 -arg "-process-r
3fc0: 65 61 70 22 29 29 0a 20 20 20 20 20 20 20 20 3b eap")). ;
3fd0: 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ; (args:get-arg
3fe0: 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 3b 3b "-runtests")..;;
3ff0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4000: 2d 65 78 65 63 75 74 65 22 29 0a 09 3b 3b 20 28 -execute")..;; (
4010: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
4020: 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a 09 3b 3b emove-runs")..;;
4030: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4040: 2d 72 75 6e 73 74 65 70 22 29 29 0a 20 20 20 20 -runstep")).
4050: 28 6c 65 74 20 28 28 6f 72 69 67 69 6e 61 6c 2d (let ((original-
4060: 65 78 69 74 20 28 65 78 69 74 2d 68 61 6e 64 6c exit (exit-handl
4070: 65 72 29 29 29 0a 20 20 20 20 20 20 28 65 78 69 er))). (exi
4080: 74 2d 68 61 6e 64 6c 65 72 20 28 6c 61 6d 62 64 t-handler (lambd
4090: 61 20 28 23 21 6f 70 74 69 6f 6e 61 6c 20 28 65 a (#!optional (e
40a0: 78 69 74 2d 63 6f 64 65 20 30 29 29 0a 09 09 20 xit-code 0))...
40b0: 20 20 20 20 20 28 70 72 69 6e 74 66 20 22 50 72 (printf "Pr
40c0: 65 70 61 72 69 6e 67 20 74 6f 20 65 78 69 74 20 eparing to exit
40d0: 77 69 74 68 20 65 78 69 74 20 63 6f 64 65 20 7e with exit code ~
40e0: 41 20 2e 2e 2e 5c 6e 22 20 65 78 69 74 2d 63 6f A ...\n" exit-co
40f0: 64 65 29 0a 09 09 20 20 20 20 20 20 28 66 6f 72 de)... (for
4100: 2d 65 61 63 68 20 0a 09 09 20 20 20 20 20 20 20 -each ...
4110: 28 6c 61 6d 62 64 61 20 28 70 69 64 29 0a 09 09 (lambda (pid)...
4120: 09 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 . (handle-except
4130: 69 6f 6e 73 0a 09 09 09 20 20 65 78 6e 0a 09 09 ions.... exn...
4140: 09 20 20 23 74 0a 09 09 09 20 20 28 6c 65 74 2d . #t.... (let-
4150: 76 61 6c 75 65 73 20 28 28 28 70 69 64 2d 76 61 values (((pid-va
4160: 6c 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 l exit-status ex
4170: 69 74 2d 63 6f 64 65 29 20 28 70 72 6f 63 65 73 it-code) (proces
4180: 73 2d 77 61 69 74 20 70 69 64 20 23 74 29 29 29 s-wait pid #t)))
4190: 0a 09 09 09 09 20 20 20 20 20 20 28 69 66 20 28 ..... (if (
41a0: 6f 72 20 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 or (eq? pid-val
41b0: 70 69 64 29 0a 09 09 09 09 09 20 20 20 20 20 20 pid)......
41c0: 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 29 (eq? pid-val 0))
41d0: 0a 09 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 ...... (begin..
41e0: 09 09 09 09 20 20 20 20 28 70 72 69 6e 74 66 20 .... (printf
41f0: 22 53 65 6e 64 69 6e 67 20 73 69 67 6e 61 6c 2f "Sending signal/
4200: 74 65 72 6d 20 74 6f 20 7e 41 5c 6e 22 20 70 69 term to ~A\n" pi
4210: 64 29 0a 09 09 09 09 09 20 20 20 20 28 70 72 6f d)...... (pro
4220: 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 69 64 20 cess-signal pid
4230: 73 69 67 6e 61 6c 2f 74 65 72 6d 29 29 29 29 29 signal/term)))))
4240: 29 0a 09 09 20 20 20 20 20 20 20 28 70 72 6f 63 )... (proc
4250: 65 73 73 3a 63 68 69 6c 64 72 65 6e 20 23 66 29 ess:children #f)
4260: 29 0a 09 09 20 20 20 20 20 20 28 6f 72 69 67 69 )... (origi
4270: 6e 61 6c 2d 65 78 69 74 20 65 78 69 74 2d 63 6f nal-exit exit-co
4280: 64 65 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d de)))))..;;=====
4290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
42a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
42b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
42c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
42d0: 3d 0a 3b 3b 20 4d 69 73 63 20 73 65 74 75 70 20 =.;; Misc setup
42e0: 73 74 75 66 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d stuff.;;========
42f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
4330: 28 64 65 62 75 67 3a 73 65 74 75 70 29 0a 0a 28 (debug:setup)..(
4340: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
4350: 20 22 2d 6c 6f 67 67 69 6e 67 22 29 28 73 65 74 "-logging")(set
4360: 21 20 2a 6c 6f 67 67 69 6e 67 2a 20 23 74 29 29 ! *logging* #t))
4370: 0a 0a 28 69 66 20 28 64 65 62 75 67 3a 64 65 62 ..(if (debug:deb
4380: 75 67 2d 6d 6f 64 65 20 33 29 20 3b 3b 20 77 65 ug-mode 3) ;; we
4390: 20 61 72 65 20 6f 62 76 69 6f 75 73 6c 79 20 64 are obviously d
43a0: 65 62 75 67 67 69 6e 67 0a 20 20 20 20 28 73 65 ebugging. (se
43b0: 74 21 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 t! open-run-clos
43c0: 65 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 e open-run-close
43d0: 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 -no-exception-ha
43e0: 6e 64 6c 69 6e 67 29 29 0a 0a 28 69 66 20 28 61 ndling))..(if (a
43f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 rgs:get-arg "-it
4400: 65 6d 70 61 74 74 22 29 0a 20 20 20 20 28 6c 65 empatt"). (le
4410: 74 20 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e 63 t ((newval (conc
4420: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4430: 2d 74 65 73 74 70 61 74 74 22 29 20 22 2f 22 20 -testpatt") "/"
4440: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4450: 69 74 65 6d 70 61 74 74 22 29 29 29 29 0a 20 20 itempatt")))).
4460: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
4470: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
4480: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
4490: 2d 69 74 65 6d 70 61 74 74 20 68 61 73 20 62 65 -itempatt has be
44a0: 65 6e 20 64 65 70 72 65 63 61 74 65 64 2c 20 70 en deprecated, p
44b0: 6c 65 61 73 65 20 75 73 65 20 2d 74 65 73 74 70 lease use -testp
44c0: 61 74 74 20 74 65 73 74 70 61 74 74 2f 69 74 65 att testpatt/ite
44d0: 6d 70 61 74 74 20 6d 65 74 68 6f 64 2c 20 6e 65 mpatt method, ne
44e0: 77 20 74 65 73 74 70 61 74 74 20 69 73 20 22 6e w testpatt is "n
44f0: 65 77 76 61 6c 29 0a 20 20 20 20 20 20 28 68 61 ewval). (ha
4500: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 72 sh-table-set! ar
4510: 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 74 65 gs:arg-hash "-te
4520: 73 74 70 61 74 74 22 20 6e 65 77 76 61 6c 29 0a stpatt" newval).
4530: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
4540: 65 2d 64 65 6c 65 74 65 21 20 61 72 67 73 3a 61 e-delete! args:a
4550: 72 67 2d 68 61 73 68 20 22 2d 69 74 65 6d 70 61 rg-hash "-itempa
4560: 74 74 22 29 29 29 0a 0a 28 69 66 20 28 61 72 67 tt")))..(if (arg
4570: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 s:get-arg "-runt
4580: 65 73 74 73 22 29 0a 20 20 20 20 28 64 65 62 75 ests"). (debu
4590: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
45a0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 lt-log-port* "WA
45b0: 52 4e 49 4e 47 3a 20 5c 22 2d 72 75 6e 74 65 73 RNING: \"-runtes
45c0: 74 73 5c 22 20 69 73 20 64 65 70 72 65 63 61 74 ts\" is deprecat
45d0: 65 64 2e 20 55 73 65 20 5c 22 2d 72 75 6e 5c 22 ed. Use \"-run\"
45e0: 20 77 69 74 68 20 5c 22 2d 74 65 73 74 70 61 74 with \"-testpat
45f0: 74 5c 22 20 69 6e 73 74 65 61 64 22 29 29 0a 0a t\" instead"))..
4600: 28 6f 6e 2d 65 78 69 74 20 73 74 64 2d 65 78 69 (on-exit std-exi
4610: 74 2d 70 72 6f 63 65 64 75 72 65 29 0a 0a 3b 3b t-procedure)..;;
4620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4660: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 20 67 ======.;; Misc g
4670: 65 6e 65 72 61 6c 20 63 61 6c 6c 73 0a 3b 3b 3d eneral calls.;;=
4680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
46a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
46b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
46c0: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 6e 64 20 =====..(if (and
46d0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
46e0: 63 61 63 68 65 2d 64 62 22 29 0a 20 20 20 20 20 cache-db").
46f0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
4700: 67 20 22 2d 73 6f 75 72 63 65 2d 64 62 22 29 29 g "-source-db"))
4710: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 6d . (let* ((tem
4720: 70 2d 64 69 72 20 28 6f 72 20 28 61 72 67 73 3a p-dir (or (args:
4730: 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 get-arg "-target
4740: 2d 64 62 22 29 20 28 63 72 65 61 74 65 2d 64 69 -db") (create-di
4750: 72 65 63 74 6f 72 79 20 28 63 6f 6e 63 20 22 2f rectory (conc "/
4760: 74 6d 70 2f 22 20 28 67 65 74 65 6e 76 20 22 55 tmp/" (getenv "U
4770: 53 45 52 22 29 20 22 2f 22 20 28 73 74 72 69 6e SER") "/" (strin
4780: 67 2d 74 72 61 6e 73 6c 61 74 65 20 28 63 75 72 g-translate (cur
4790: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 20 rent-directory)
47a0: 22 2f 22 20 22 5f 22 29 29 29 29 29 0a 20 20 20 "/" "_"))))).
47b0: 20 20 20 20 20 20 20 20 28 74 61 72 67 65 74 2d (target-
47c0: 64 62 20 28 63 6f 6e 63 20 74 65 6d 70 2d 64 69 db (conc temp-di
47d0: 72 20 22 2f 63 61 63 68 65 64 2e 64 62 22 29 29 r "/cached.db"))
47e0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 73 6f 75 . (sou
47f0: 72 63 65 2d 64 62 20 28 61 72 67 73 3a 67 65 74 rce-db (args:get
4800: 2d 61 72 67 20 22 2d 73 6f 75 72 63 65 2d 64 62 -arg "-source-db
4810: 22 29 29 29 20 20 20 20 20 20 20 20 0a 20 20 20 "))) .
4820: 20 20 20 28 64 62 3a 63 61 63 68 65 2d 66 6f 72 (db:cache-for
4830: 2d 72 65 61 64 2d 6f 6e 6c 79 20 73 6f 75 72 63 -read-only sourc
4840: 65 2d 64 62 20 74 61 72 67 65 74 2d 64 62 29 0a e-db target-db).
4850: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
4860: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
4870: 0a 0a 3b 3b 20 68 61 6e 64 6c 65 20 61 20 63 6c ..;; handle a cl
4880: 65 61 6e 2d 63 61 63 68 65 20 72 65 71 75 65 73 ean-cache reques
4890: 74 20 61 73 20 65 61 72 6c 79 20 61 73 20 70 6f t as early as po
48a0: 73 73 69 62 6c 65 0a 3b 3b 0a 28 69 66 20 28 61 ssible.;;.(if (a
48b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6c rgs:get-arg "-cl
48c0: 65 61 6e 2d 63 61 63 68 65 22 29 0a 20 20 20 20 ean-cache").
48d0: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 73 65 (begin. (se
48e0: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
48f0: 2a 20 23 74 29 20 3b 3b 20 73 75 70 70 72 65 73 * #t) ;; suppres
4900: 73 20 74 68 65 20 68 65 6c 70 20 6f 75 74 70 75 s the help outpu
4910: 74 2e 0a 20 20 20 20 20 20 28 69 66 20 28 67 65 t.. (if (ge
4920: 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 tenv "MT_TARGET"
4930: 29 20 3b 3b 20 6e 6f 20 70 6f 69 6e 74 20 69 6e ) ;; no point in
4940: 20 74 72 79 69 6e 67 20 69 66 20 6e 6f 20 74 61 trying if no ta
4950: 72 67 65 74 0a 09 20 20 28 69 66 20 28 61 72 67 rget.. (if (arg
4960: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
4970: 61 6d 65 22 29 0a 09 20 20 20 20 20 20 28 6c 65 ame").. (le
4980: 74 2a 20 28 28 74 6f 70 70 61 74 68 20 20 28 6c t* ((toppath (l
4990: 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 09 aunch:setup))...
49a0: 20 20 20 20 20 28 6c 69 6e 6b 74 72 65 65 20 28 (linktree (
49b0: 69 66 20 74 6f 70 70 61 74 68 20 28 63 6f 6e 66 if toppath (conf
49c0: 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 igf:lookup *conf
49d0: 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 igdat* "setup" "
49e0: 6c 69 6e 6b 74 72 65 65 22 29 29 29 0a 09 09 20 linktree")))...
49f0: 20 20 20 20 28 72 75 6e 74 6f 70 20 20 20 28 63 (runtop (c
4a00: 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 22 2f 22 onc linktree "/"
4a10: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 (getenv "MT_TAR
4a20: 47 45 54 22 29 20 22 2f 22 20 28 61 72 67 73 3a GET") "/" (args:
4a30: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d get-arg "-runnam
4a40: 65 22 29 29 29 0a 09 09 20 20 20 20 20 28 66 69 e")))... (fi
4a50: 6c 65 73 20 20 20 20 28 69 66 20 28 66 69 6c 65 les (if (file
4a60: 2d 65 78 69 73 74 73 3f 20 72 75 6e 74 6f 70 29 -exists? runtop)
4a70: 0a 09 09 09 09 20 20 20 28 61 70 70 65 6e 64 20 ..... (append
4a80: 28 67 6c 6f 62 20 28 63 6f 6e 63 20 72 75 6e 74 (glob (conc runt
4a90: 6f 70 20 22 2f 2e 6d 65 67 61 74 65 73 74 2a 22 op "/.megatest*"
4aa0: 29 29 0a 09 09 09 09 09 20 20 20 28 67 6c 6f 62 ))...... (glob
4ab0: 20 28 63 6f 6e 63 20 72 75 6e 74 6f 70 20 22 2f (conc runtop "/
4ac0: 2e 72 75 6e 63 6f 6e 66 69 67 2a 22 29 29 29 0a .runconfig*"))).
4ad0: 09 09 09 09 20 20 20 27 28 29 29 29 29 0a 09 09 .... '())))...
4ae0: 28 69 66 20 28 6e 75 6c 6c 3f 20 66 69 6c 65 73 (if (null? files
4af0: 29 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 )... (debug:p
4b00: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
4b10: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4b20: 4e 6f 20 63 61 63 68 65 64 20 6d 65 67 61 74 65 No cached megate
4b30: 73 74 20 6f 72 20 72 75 6e 63 6f 6e 66 69 67 73 st or runconfigs
4b40: 20 66 69 6c 65 73 20 66 6f 75 6e 64 2e 20 4e 6f files found. No
4b50: 6e 65 20 72 65 6d 6f 76 65 64 2e 22 29 0a 09 09 ne removed.")...
4b60: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 (begin...
4b70: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
4b80: 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
4b90: 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 65 6d 6f 76 log-port* "Remov
4ba0: 69 6e 67 20 63 61 63 68 65 64 20 66 69 6c 65 73 ing cached files
4bb0: 3a 5c 6e 20 20 20 20 22 20 28 73 74 72 69 6e 67 :\n " (string
4bc0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 69 6c -intersperse fil
4bd0: 65 73 20 22 5c 6e 20 20 20 20 22 29 29 0a 09 09 es "\n "))...
4be0: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
4bf0: 0a 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 ... (lambd
4c00: 61 20 28 66 29 0a 09 09 09 20 28 68 61 6e 64 6c a (f).... (handl
4c10: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 e-exceptions....
4c20: 20 20 20 20 20 65 78 6e 0a 09 09 09 20 20 20 20 exn....
4c30: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
4c40: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
4c50: 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 46 61 69 t* "WARNING: Fai
4c60: 6c 65 64 20 74 6f 20 72 65 6d 6f 76 65 20 66 69 led to remove fi
4c70: 6c 65 20 22 20 66 29 0a 09 09 09 20 20 20 28 64 le " f).... (d
4c80: 65 6c 65 74 65 2d 66 69 6c 65 20 66 29 29 29 0a elete-file f))).
4c90: 09 09 20 20 20 20 20 20 20 66 69 6c 65 73 29 29 .. files))
4ca0: 29 29 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 )).. (debug
4cb0: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
4cc0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
4cd0: 2a 20 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 20 * "-clean-cache
4ce0: 72 65 71 75 69 72 65 73 20 2d 72 75 6e 6e 61 6d requires -runnam
4cf0: 65 2e 22 29 29 0a 09 20 20 28 64 65 62 75 67 3a e.")).. (debug:
4d00: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
4d10: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
4d20: 20 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 20 72 "-clean-cache r
4d30: 65 71 75 69 72 65 73 20 2d 74 61 72 67 65 74 20 equires -target
4d40: 6f 72 20 2d 72 65 71 74 61 72 67 22 29 29 29 29 or -reqtarg"))))
4d50: 0a 09 20 20 20 20 0a 09 20 20 0a 28 69 66 20 28 .. .. .(if (
4d60: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
4d70: 6e 76 32 66 69 6c 65 22 29 0a 20 20 20 20 28 62 nv2file"). (b
4d80: 65 67 69 6e 0a 20 20 20 20 20 20 28 73 61 76 65 egin. (save
4d90: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d -environment-as-
4da0: 66 69 6c 65 73 20 28 61 72 67 73 3a 67 65 74 2d files (args:get-
4db0: 61 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 29 arg "-env2file")
4dc0: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
4dd0: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
4de0: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
4df0: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 69 73 t-arg "-list-dis
4e00: 6b 73 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 ks"). (let ((
4e10: 74 6f 70 70 61 74 68 20 28 6c 61 75 6e 63 68 3a toppath (launch:
4e20: 73 65 74 75 70 29 29 29 0a 20 20 20 20 20 20 28 setup))). (
4e30: 70 72 69 6e 74 20 0a 20 20 20 20 20 20 20 28 73 print . (s
4e40: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
4e50: 65 20 0a 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 e ..(map (lambda
4e60: 20 28 78 29 0a 09 20 20 20 20 20 20 20 28 73 74 (x).. (st
4e70: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
4e80: 20 0a 09 09 78 0a 09 09 22 20 3d 3e 20 22 29 29 ...x..." => "))
4e90: 0a 09 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 .. (common:g
4ea0: 65 74 2d 64 69 73 6b 73 20 2a 63 6f 6e 66 69 67 et-disks *config
4eb0: 64 61 74 2a 29 29 0a 09 22 5c 6e 22 29 29 0a 20 dat*)).."\n")).
4ec0: 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
4ed0: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
4ee0: 0a 3b 3b 20 63 73 76 20 70 72 6f 63 65 73 73 69 .;; csv processi
4ef0: 6e 67 20 72 65 63 6f 72 64 0a 28 64 65 66 69 6e ng record.(defin
4f00: 65 20 28 6d 61 6b 65 2d 72 65 66 64 62 3a 63 73 e (make-refdb:cs
4f10: 76 29 0a 20 20 28 76 65 63 74 6f 72 20 0a 20 20 v). (vector .
4f20: 20 28 6d 61 6b 65 2d 73 70 61 72 73 65 2d 61 72 (make-sparse-ar
4f30: 72 61 79 29 0a 20 20 20 28 6d 61 6b 65 2d 68 61 ray). (make-ha
4f40: 73 68 2d 74 61 62 6c 65 29 0a 20 20 20 28 6d 61 sh-table). (ma
4f50: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 ke-hash-table).
4f60: 20 20 30 0a 20 20 20 30 29 29 0a 28 64 65 66 69 0. 0)).(defi
4f70: 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 ne-inline (refdb
4f80: 3a 63 73 76 2d 67 65 74 2d 73 76 65 63 20 20 20 :csv-get-svec
4f90: 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f vec) (vecto
4fa0: 72 2d 72 65 66 20 20 76 65 63 20 30 29 29 0a 28 r-ref vec 0)).(
4fb0: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 define-inline (r
4fc0: 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 72 6f 77 efdb:csv-get-row
4fd0: 73 20 20 20 20 20 76 65 63 29 20 20 20 20 28 76 s vec) (v
4fe0: 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 31 ector-ref vec 1
4ff0: 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e )).(define-inlin
5000: 65 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 e (refdb:csv-get
5010: 2d 63 6f 6c 73 20 20 20 20 20 76 65 63 29 20 20 -cols vec)
5020: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 (vector-ref v
5030: 65 63 20 32 29 29 0a 28 64 65 66 69 6e 65 2d 69 ec 2)).(define-i
5040: 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 nline (refdb:csv
5050: 2d 67 65 74 2d 6d 61 78 72 6f 77 20 20 20 76 65 -get-maxrow ve
5060: 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 c) (vector-re
5070: 66 20 20 76 65 63 20 33 29 29 0a 28 64 65 66 69 f vec 3)).(defi
5080: 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 ne-inline (refdb
5090: 3a 63 73 76 2d 67 65 74 2d 6d 61 78 63 6f 6c 20 :csv-get-maxcol
50a0: 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f vec) (vecto
50b0: 72 2d 72 65 66 20 20 76 65 63 20 34 29 29 0a 28 r-ref vec 4)).(
50c0: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 define-inline (r
50d0: 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 73 76 65 efdb:csv-set-sve
50e0: 63 21 20 20 20 20 76 65 63 20 76 61 6c 29 28 76 c! vec val)(v
50f0: 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 30 ector-set! vec 0
5100: 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 val)).(define-i
5110: 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 nline (refdb:csv
5120: 2d 73 65 74 2d 72 6f 77 73 21 20 20 20 20 76 65 -set-rows! ve
5130: 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 c val)(vector-se
5140: 74 21 20 76 65 63 20 31 20 76 61 6c 29 29 0a 28 t! vec 1 val)).(
5150: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 define-inline (r
5160: 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 63 6f 6c efdb:csv-set-col
5170: 73 21 20 20 20 20 76 65 63 20 76 61 6c 29 28 76 s! vec val)(v
5180: 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 32 ector-set! vec 2
5190: 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 val)).(define-i
51a0: 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 nline (refdb:csv
51b0: 2d 73 65 74 2d 6d 61 78 72 6f 77 21 20 20 76 65 -set-maxrow! ve
51c0: 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 c val)(vector-se
51d0: 74 21 20 76 65 63 20 33 20 76 61 6c 29 29 0a 28 t! vec 3 val)).(
51e0: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 define-inline (r
51f0: 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d 61 78 efdb:csv-set-max
5200: 63 6f 6c 21 20 20 76 65 63 20 76 61 6c 29 28 76 col! vec val)(v
5210: 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 34 ector-set! vec 4
5220: 20 76 61 6c 29 29 0a 0a 28 64 65 66 69 6e 65 20 val))..(define
5230: 28 67 65 74 2d 64 61 74 20 72 65 73 75 6c 74 73 (get-dat results
5240: 20 73 68 65 65 74 6e 61 6d 65 29 0a 20 20 28 6f sheetname). (o
5250: 72 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 r (hash-table-re
5260: 66 2f 64 65 66 61 75 6c 74 20 72 65 73 75 6c 74 f/default result
5270: 73 20 73 68 65 65 74 6e 61 6d 65 20 23 66 29 0a s sheetname #f).
5280: 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 6d 70 (let ((tmp
5290: 2d 76 65 63 20 20 28 6d 61 6b 65 2d 72 65 66 64 -vec (make-refd
52a0: 62 3a 63 73 76 29 29 29 0a 09 28 68 61 73 68 2d b:csv)))..(hash-
52b0: 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 75 6c table-set! resul
52c0: 74 73 20 73 68 65 65 74 6e 61 6d 65 20 74 6d 70 ts sheetname tmp
52d0: 2d 76 65 63 29 0a 09 74 6d 70 2d 76 65 63 29 29 -vec)..tmp-vec))
52e0: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
52f0: 2d 61 72 67 20 22 2d 72 65 66 64 62 32 64 61 74 -arg "-refdb2dat
5300: 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 69 "). (let* ((i
5310: 6e 70 75 74 2d 64 62 20 28 61 72 67 73 3a 67 65 nput-db (args:ge
5320: 74 2d 61 72 67 20 22 2d 72 65 66 64 62 32 64 61 t-arg "-refdb2da
5330: 74 22 29 29 0a 09 20 20 20 28 6f 75 74 2d 66 69 t")).. (out-fi
5340: 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 le (args:get-arg
5350: 20 22 2d 6f 22 29 29 0a 09 20 20 20 28 6f 75 74 "-o")).. (out
5360: 2d 66 6d 74 20 20 28 6f 72 20 28 61 72 67 73 3a -fmt (or (args:
5370: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
5380: 64 65 22 29 20 22 73 63 68 65 6d 65 22 29 29 0a de") "scheme")).
5390: 09 20 20 20 28 6f 75 74 2d 70 6f 72 74 20 28 69 . (out-port (i
53a0: 66 20 28 61 6e 64 20 6f 75 74 2d 66 69 6c 65 20 f (and out-file
53b0: 0a 09 09 09 20 20 20 20 20 20 28 6e 6f 74 20 28 .... (not (
53c0: 6d 65 6d 62 65 72 20 6f 75 74 2d 66 6d 74 20 27 member out-fmt '
53d0: 28 22 73 71 6c 69 74 65 33 22 20 22 63 73 76 22 ("sqlite3" "csv"
53e0: 29 29 29 29 0a 09 09 09 20 28 6f 70 65 6e 2d 6f )))).... (open-o
53f0: 75 74 70 75 74 2d 66 69 6c 65 20 6f 75 74 2d 66 utput-file out-f
5400: 69 6c 65 29 0a 09 09 09 20 28 63 75 72 72 65 6e ile).... (curren
5410: 74 2d 6f 75 74 70 75 74 2d 70 6f 72 74 29 29 29 t-output-port)))
5420: 0a 09 20 20 20 28 72 65 73 2d 64 61 74 61 20 28 .. (res-data (
5430: 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 72 65 66 configf:read-ref
5440: 64 62 20 69 6e 70 75 74 2d 64 62 29 29 0a 09 20 db input-db))..
5450: 20 20 28 64 61 74 61 20 20 20 20 20 28 63 61 72 (data (car
5460: 20 72 65 73 2d 64 61 74 61 29 29 0a 09 20 20 20 res-data))..
5470: 28 6d 73 67 20 20 20 20 20 20 28 63 61 64 72 20 (msg (cadr
5480: 72 65 73 2d 64 61 74 61 29 29 29 0a 20 20 20 20 res-data))).
5490: 20 20 28 69 66 20 28 6e 6f 74 20 64 61 74 61 29 (if (not data)
54a0: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
54b0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
54c0: 70 6f 72 74 2a 20 22 42 61 64 20 69 6e 70 75 74 port* "Bad input
54d0: 3f 20 64 61 74 61 3d 22 20 64 61 74 61 29 20 3b ? data=" data) ;
54e0: 3b 20 73 6f 6d 65 20 65 72 72 6f 72 20 6f 63 63 ; some error occ
54f0: 75 72 72 65 64 0a 09 20 20 28 77 69 74 68 2d 6f urred.. (with-o
5500: 75 74 70 75 74 2d 74 6f 2d 70 6f 72 74 20 6f 75 utput-to-port ou
5510: 74 2d 70 6f 72 74 0a 09 20 20 20 20 28 6c 61 6d t-port.. (lam
5520: 62 64 61 20 28 29 0a 09 20 20 20 20 20 20 28 63 bda ().. (c
5530: 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d ase (string->sym
5540: 62 6f 6c 20 6f 75 74 2d 66 6d 74 29 0a 09 09 28 bol out-fmt)...(
5550: 28 73 63 68 65 6d 65 29 28 70 70 20 64 61 74 61 (scheme)(pp data
5560: 29 29 0a 09 09 28 28 70 65 72 6c 29 0a 09 09 20 ))...((perl)...
5570: 3b 3b 20 28 70 72 69 6e 74 20 22 25 68 61 73 68 ;; (print "%hash
5580: 20 3d 20 28 22 29 0a 09 09 20 3b 3b 20 20 20 20 = (")... ;;
5590: 20 20 20 20 6b 65 79 31 20 3d 3e 20 27 76 61 6c key1 => 'val
55a0: 75 65 31 27 2c 0a 09 09 20 3b 3b 20 20 20 20 20 ue1',... ;;
55b0: 20 20 20 6b 65 79 32 20 3d 3e 20 27 76 61 6c 75 key2 => 'valu
55c0: 65 32 27 2c 0a 09 09 20 3b 3b 20 20 20 20 20 20 e2',... ;;
55d0: 20 20 6b 65 79 33 20 3d 3e 20 27 76 61 6c 75 65 key3 => 'value
55e0: 33 27 2c 0a 09 09 20 3b 3b 20 29 3b 0a 09 09 20 3',... ;; );...
55f0: 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c 6c (configf:map-all
5600: 2d 68 69 65 72 2d 61 6c 69 73 74 20 0a 09 09 20 -hier-alist ...
5610: 20 64 61 74 61 20 0a 09 09 20 20 28 6c 61 6d 62 data ... (lamb
5620: 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 65 da (sheetname se
5630: 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d ctionname varnam
5640: 65 20 76 61 6c 29 0a 09 09 20 20 20 20 28 70 72 e val)... (pr
5650: 69 6e 74 20 22 24 64 61 74 61 7b 5c 22 22 20 73 int "$data{\"" s
5660: 68 65 65 74 6e 61 6d 65 20 22 5c 22 7d 7b 5c 22 heetname "\"}{\"
5670: 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 5c " sectionname "\
5680: 22 7d 7b 5c 22 22 20 76 61 72 6e 61 6d 65 20 22 "}{\"" varname "
5690: 5c 22 7d 20 3d 20 5c 22 22 20 76 61 6c 20 22 5c \"} = \"" val "\
56a0: 22 3b 22 29 29 29 29 0a 09 09 28 28 70 79 74 68 ";"))))...((pyth
56b0: 6f 6e 20 72 75 62 79 29 0a 09 09 20 28 70 72 69 on ruby)... (pri
56c0: 6e 74 20 22 64 61 74 61 3d 7b 7d 22 29 0a 09 09 nt "data={}")...
56d0: 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c (configf:map-al
56e0: 6c 2d 68 69 65 72 2d 61 6c 69 73 74 0a 09 09 20 l-hier-alist...
56f0: 20 64 61 74 61 0a 09 09 20 20 28 6c 61 6d 62 64 data... (lambd
5700: 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 65 63 a (sheetname sec
5710: 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 tionname varname
5720: 20 76 61 6c 29 0a 09 09 20 20 20 20 28 70 72 69 val)... (pri
5730: 6e 74 20 22 64 61 74 61 5b 5c 22 22 20 73 68 65 nt "data[\"" she
5740: 65 74 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 22 20 etname "\"][\""
5750: 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 5c 22 5d sectionname "\"]
5760: 5b 5c 22 22 20 76 61 72 6e 61 6d 65 20 22 5c 22 [\"" varname "\"
5770: 5d 20 3d 20 5c 22 22 20 76 61 6c 20 22 5c 22 22 ] = \"" val "\""
5780: 29 29 0a 09 09 20 20 69 6e 69 74 70 72 6f 63 31 ))... initproc1
5790: 3a 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 28 73 :... (lambda (s
57a0: 68 65 65 74 6e 61 6d 65 29 0a 09 09 20 20 20 20 heetname)...
57b0: 28 70 72 69 6e 74 20 22 64 61 74 61 5b 5c 22 22 (print "data[\""
57c0: 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 5d 20 sheetname "\"]
57d0: 3d 20 7b 7d 22 29 29 0a 09 09 20 20 69 6e 69 74 = {}"))... init
57e0: 70 72 6f 63 32 3a 0a 09 09 20 20 28 6c 61 6d 62 proc2:... (lamb
57f0: 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 65 da (sheetname se
5800: 63 74 69 6f 6e 6e 61 6d 65 29 0a 09 09 20 20 20 ctionname)...
5810: 20 28 70 72 69 6e 74 20 22 64 61 74 61 5b 5c 22 (print "data[\"
5820: 22 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 5d " sheetname "\"]
5830: 5b 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 [\"" sectionname
5840: 20 22 5c 22 5d 20 3d 20 7b 7d 22 29 29 29 29 0a "\"] = {}")))).
5850: 09 09 28 28 63 73 76 29 0a 09 09 20 28 6c 65 74 ..((csv)... (let
5860: 2a 20 28 28 72 65 73 75 6c 74 73 20 20 28 6d 61 * ((results (ma
5870: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 ke-hash-table))
5880: 3b 3b 20 28 6d 61 6b 65 2d 73 70 61 72 73 65 2d ;; (make-sparse-
5890: 61 72 72 61 79 29 29 29 0a 09 09 09 28 72 6f 77 array)))....(row
58a0: 2d 63 6f 6c 73 20 28 6d 61 6b 65 2d 68 61 73 68 -cols (make-hash
58b0: 2d 74 61 62 6c 65 29 29 29 20 3b 3b 20 68 61 73 -table))) ;; has
58c0: 68 20 6f 66 20 68 61 73 68 65 73 20 77 68 65 72 h of hashes wher
58d0: 65 20 73 65 63 74 69 6f 6e 20 3d 3e 20 68 74 20 e section => ht
58e0: 7b 20 72 6f 77 2d 3c 6e 61 6d 65 3e 20 3d 3e 20 { row-<name> =>
58f0: 6e 75 6d 20 6f 72 20 63 6f 6c 2d 3c 6e 61 6d 65 num or col-<name
5900: 3e 20 3d 3e 20 6e 75 6d 0a 09 09 20 20 20 3b 3b > => num... ;;
5910: 20 28 70 72 69 6e 74 20 22 64 61 74 61 3d 22 29 (print "data=")
5920: 0a 09 09 20 20 20 3b 3b 20 28 70 70 20 64 61 74 ... ;; (pp dat
5930: 61 29 0a 09 09 20 20 20 28 63 6f 6e 66 69 67 66 a)... (configf
5940: 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c :map-all-hier-al
5950: 69 73 74 0a 09 09 20 20 20 20 64 61 74 61 0a 09 ist... data..
5960: 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 68 . (lambda (sh
5970: 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e eetname sectionn
5980: 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 ame varname val)
5990: 0a 09 09 20 20 20 20 20 20 3b 3b 20 28 70 72 69 ... ;; (pri
59a0: 6e 74 20 22 73 68 65 65 74 6e 61 6d 65 3a 20 22 nt "sheetname: "
59b0: 20 73 68 65 65 74 6e 61 6d 65 20 22 2c 20 73 65 sheetname ", se
59c0: 63 74 69 6f 6e 6e 61 6d 65 3a 20 22 20 73 65 63 ctionname: " sec
59d0: 74 69 6f 6e 6e 61 6d 65 20 22 2c 20 76 61 72 6e tionname ", varn
59e0: 61 6d 65 3a 20 22 20 76 61 72 6e 61 6d 65 20 22 ame: " varname "
59f0: 2c 20 76 61 6c 3a 20 22 20 76 61 6c 29 0a 09 09 , val: " val)...
5a00: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 64 61 (let* ((da
5a10: 74 20 20 20 20 20 20 28 67 65 74 2d 64 61 74 20 t (get-dat
5a20: 72 65 73 75 6c 74 73 20 73 68 65 65 74 6e 61 6d results sheetnam
5a30: 65 29 29 0a 09 09 09 20 20 20 20 20 28 76 65 63 e)).... (vec
5a40: 20 20 20 20 20 20 28 72 65 66 64 62 3a 63 73 76 (refdb:csv
5a50: 2d 67 65 74 2d 73 76 65 63 20 64 61 74 29 29 0a -get-svec dat)).
5a60: 09 09 09 20 20 20 20 20 28 72 6f 77 6e 61 6d 65 ... (rowname
5a70: 73 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 s (refdb:csv-get
5a80: 2d 72 6f 77 73 20 64 61 74 29 29 0a 09 09 09 20 -rows dat))....
5a90: 20 20 20 20 28 63 6f 6c 6e 61 6d 65 73 20 28 72 (colnames (r
5aa0: 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 63 6f 6c efdb:csv-get-col
5ab0: 73 20 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 s dat))....
5ac0: 28 63 75 72 72 72 6f 77 6e 20 28 68 61 73 68 2d (currrown (hash-
5ad0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
5ae0: 74 20 72 6f 77 6e 61 6d 65 73 20 76 61 72 6e 61 t rownames varna
5af0: 6d 65 20 23 66 29 29 0a 09 09 09 20 20 20 20 20 me #f))....
5b00: 28 63 75 72 72 63 6f 6c 6e 20 28 68 61 73 68 2d (currcoln (hash-
5b10: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
5b20: 74 20 63 6f 6c 6e 61 6d 65 73 20 73 65 63 74 69 t colnames secti
5b30: 6f 6e 6e 61 6d 65 20 23 66 29 29 0a 09 09 09 20 onname #f))....
5b40: 20 20 20 20 28 72 6f 77 6e 20 20 20 20 20 28 6f (rown (o
5b50: 72 20 63 75 72 72 72 6f 77 6e 20 0a 09 09 09 09 r currrown .....
5b60: 09 20 20 20 28 6c 65 74 2a 20 28 28 6c 61 73 74 . (let* ((last
5b70: 6e 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 n (refdb:csv-g
5b80: 65 74 2d 6d 61 78 72 6f 77 20 64 61 74 29 29 0a et-maxrow dat)).
5b90: 09 09 09 09 09 09 20 20 28 6e 65 77 72 6f 77 6e ...... (newrown
5ba0: 20 28 2b 20 6c 61 73 74 6e 20 31 29 29 29 0a 09 (+ lastn 1)))..
5bb0: 09 09 09 09 20 20 20 20 20 28 72 65 66 64 62 3a .... (refdb:
5bc0: 63 73 76 2d 73 65 74 2d 6d 61 78 72 6f 77 21 20 csv-set-maxrow!
5bd0: 64 61 74 20 6e 65 77 72 6f 77 6e 29 0a 09 09 09 dat newrown)....
5be0: 09 09 20 20 20 20 20 6e 65 77 72 6f 77 6e 29 29 .. newrown))
5bf0: 29 0a 09 09 09 20 20 20 20 20 28 63 6f 6c 6e 20 ).... (coln
5c00: 20 20 20 20 28 6f 72 20 63 75 72 72 63 6f 6c 6e (or currcoln
5c10: 20 0a 09 09 09 09 09 20 20 20 28 6c 65 74 2a 20 ...... (let*
5c20: 28 28 6c 61 73 74 6e 20 20 20 28 72 65 66 64 62 ((lastn (refdb
5c30: 3a 63 73 76 2d 67 65 74 2d 6d 61 78 63 6f 6c 20 :csv-get-maxcol
5c40: 64 61 74 29 29 0a 09 09 09 09 09 09 20 20 28 6e dat))....... (n
5c50: 65 77 63 6f 6c 6e 20 28 2b 20 6c 61 73 74 6e 20 ewcoln (+ lastn
5c60: 31 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 1)))...... (
5c70: 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d 61 refdb:csv-set-ma
5c80: 78 63 6f 6c 21 20 64 61 74 20 6e 65 77 63 6f 6c xcol! dat newcol
5c90: 6e 29 0a 09 09 09 09 09 20 20 20 20 20 6e 65 77 n)...... new
5ca0: 63 6f 6c 6e 29 29 29 29 0a 09 09 09 28 69 66 20 coln))))....(if
5cb0: 28 6e 6f 74 20 28 73 70 61 72 73 65 2d 61 72 72 (not (sparse-arr
5cc0: 61 79 2d 72 65 66 20 76 65 63 20 30 20 63 6f 6c ay-ref vec 0 col
5cd0: 6e 29 29 20 3b 3b 20 28 65 71 3f 20 72 6f 77 6e n)) ;; (eq? rown
5ce0: 20 30 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 0).... (begi
5cf0: 6e 0a 09 09 09 20 20 20 20 20 20 28 73 70 61 72 n.... (spar
5d00: 73 65 2d 61 72 72 61 79 2d 73 65 74 21 20 76 65 se-array-set! ve
5d10: 63 20 30 20 63 6f 6c 6e 20 73 65 63 74 69 6f 6e c 0 coln section
5d20: 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 20 3b name).... ;
5d30: 3b 20 28 70 72 69 6e 74 20 22 73 70 61 72 73 65 ; (print "sparse
5d40: 2d 61 72 72 61 79 2d 72 65 66 20 22 20 30 20 22 -array-ref " 0 "
5d50: 2c 22 20 63 6f 6c 6e 20 22 3d 22 20 28 73 70 61 ," coln "=" (spa
5d60: 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 76 65 rse-array-ref ve
5d70: 63 20 30 20 63 6f 6c 6e 29 29 0a 09 09 09 20 20 c 0 coln))....
5d80: 20 20 20 20 29 29 0a 09 09 09 28 69 66 20 28 6e ))....(if (n
5d90: 6f 74 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 ot (sparse-array
5da0: 2d 72 65 66 20 76 65 63 20 72 6f 77 6e 20 30 29 -ref vec rown 0)
5db0: 29 20 3b 3b 20 28 65 71 3f 20 63 6f 6c 6e 20 30 ) ;; (eq? coln 0
5dc0: 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a ).... (begin.
5dd0: 09 09 09 20 20 20 20 20 20 28 73 70 61 72 73 65 ... (sparse
5de0: 2d 61 72 72 61 79 2d 73 65 74 21 20 76 65 63 20 -array-set! vec
5df0: 72 6f 77 6e 20 30 20 76 61 72 6e 61 6d 65 29 0a rown 0 varname).
5e00: 09 09 09 20 20 20 20 20 20 3b 3b 20 28 70 72 69 ... ;; (pri
5e10: 6e 74 20 22 73 70 61 72 73 65 2d 61 72 72 61 79 nt "sparse-array
5e20: 2d 72 65 66 20 22 20 72 6f 77 6e 20 22 2c 22 20 -ref " rown ","
5e30: 30 20 22 3d 22 20 28 73 70 61 72 73 65 2d 61 72 0 "=" (sparse-ar
5e40: 72 61 79 2d 72 65 66 20 76 65 63 20 72 6f 77 6e ray-ref vec rown
5e50: 20 30 29 29 0a 09 09 09 20 20 20 20 20 20 29 29 0)).... ))
5e60: 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 63 75 72 ....(if (not cur
5e70: 72 72 6f 77 6e 29 28 68 61 73 68 2d 74 61 62 6c rrown)(hash-tabl
5e80: 65 2d 73 65 74 21 20 72 6f 77 6e 61 6d 65 73 20 e-set! rownames
5e90: 76 61 72 6e 61 6d 65 20 72 6f 77 6e 29 29 0a 09 varname rown))..
5ea0: 09 09 28 69 66 20 28 6e 6f 74 20 63 75 72 72 63 ..(if (not currc
5eb0: 6f 6c 6e 29 28 68 61 73 68 2d 74 61 62 6c 65 2d oln)(hash-table-
5ec0: 73 65 74 21 20 63 6f 6c 6e 61 6d 65 73 20 73 65 set! colnames se
5ed0: 63 74 69 6f 6e 6e 61 6d 65 20 63 6f 6c 6e 29 29 ctionname coln))
5ee0: 0a 09 09 09 3b 3b 20 28 70 72 69 6e 74 20 22 64 ....;; (print "d
5ef0: 61 74 3d 22 20 64 61 74 20 22 2c 20 72 6f 77 6e at=" dat ", rown
5f00: 3d 22 20 72 6f 77 6e 20 22 2c 20 63 6f 6c 6e 3d =" rown ", coln=
5f10: 22 20 63 6f 6c 6e 29 0a 09 09 09 28 73 70 61 72 " coln)....(spar
5f20: 73 65 2d 61 72 72 61 79 2d 73 65 74 21 20 76 65 se-array-set! ve
5f30: 63 20 72 6f 77 6e 20 63 6f 6c 6e 20 76 61 6c 29 c rown coln val)
5f40: 0a 09 09 09 3b 3b 20 28 70 72 69 6e 74 20 22 73 ....;; (print "s
5f50: 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 parse-array-ref
5f60: 22 20 72 6f 77 6e 20 22 2c 22 20 63 6f 6c 6e 20 " rown "," coln
5f70: 22 3d 22 20 28 73 70 61 72 73 65 2d 61 72 72 61 "=" (sparse-arra
5f80: 79 2d 72 65 66 20 76 65 63 20 72 6f 77 6e 20 63 y-ref vec rown c
5f90: 6f 6c 6e 29 29 0a 09 09 09 29 29 29 0a 09 09 20 oln))....)))...
5fa0: 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 (for-each...
5fb0: 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 65 74 (lambda (sheet
5fc0: 6e 61 6d 65 29 0a 09 09 20 20 20 20 20 20 28 6c name)... (l
5fd0: 65 74 2a 20 28 28 73 68 65 65 74 64 61 74 20 28 et* ((sheetdat (
5fe0: 67 65 74 2d 64 61 74 20 72 65 73 75 6c 74 73 20 get-dat results
5ff0: 73 68 65 65 74 6e 61 6d 65 29 29 0a 09 09 09 20 sheetname))....
6000: 20 20 20 20 28 73 76 65 63 20 20 20 20 20 28 72 (svec (r
6010: 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 73 76 65 efdb:csv-get-sve
6020: 63 20 73 68 65 65 74 64 61 74 29 29 0a 09 09 09 c sheetdat))....
6030: 20 20 20 20 20 28 6d 61 78 72 6f 77 20 20 20 28 (maxrow (
6040: 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 refdb:csv-get-ma
6050: 78 72 6f 77 20 73 68 65 65 74 64 61 74 29 29 0a xrow sheetdat)).
6060: 09 09 09 20 20 20 20 20 28 6d 61 78 63 6f 6c 20 ... (maxcol
6070: 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 (refdb:csv-get
6080: 2d 6d 61 78 63 6f 6c 20 73 68 65 65 74 64 61 74 -maxcol sheetdat
6090: 29 29 0a 09 09 09 20 20 20 20 20 28 66 6e 61 6d )).... (fnam
60a0: 65 20 20 20 20 28 69 66 20 6f 75 74 2d 66 69 6c e (if out-fil
60b0: 65 20 0a 09 09 09 09 09 20 20 20 28 73 74 72 69 e ...... (stri
60c0: 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 22 25 ng-substitute "%
60d0: 73 22 20 73 68 65 65 74 6e 61 6d 65 20 6f 75 74 s" sheetname out
60e0: 2d 66 69 6c 65 29 20 3b 3b 20 22 2f 66 6f 6f 2f -file) ;; "/foo/
60f0: 62 61 72 2f 25 73 2e 63 73 76 22 29 0a 09 09 09 bar/%s.csv")....
6100: 09 09 20 20 20 28 63 6f 6e 63 20 73 68 65 65 74 .. (conc sheet
6110: 6e 61 6d 65 20 22 2e 63 73 76 22 29 29 29 29 0a name ".csv")))).
6120: 09 09 09 28 77 69 74 68 2d 6f 75 74 70 75 74 2d ...(with-output-
6130: 74 6f 2d 66 69 6c 65 20 66 6e 61 6d 65 0a 09 09 to-file fname...
6140: 09 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 . (lambda ()...
6150: 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 . ;; (print "
6160: 53 68 65 65 74 6e 61 6d 65 3a 20 22 20 73 68 65 Sheetname: " she
6170: 65 74 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 28 etname).... (
6180: 6c 65 74 20 6c 6f 6f 70 20 28 28 72 6f 77 20 20 let loop ((row
6190: 20 20 20 20 20 30 29 0a 09 09 09 09 20 20 20 20 0).....
61a0: 20 20 20 28 63 6f 6c 20 20 20 20 20 20 20 30 29 (col 0)
61b0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 63 75 72 ..... (cur
61c0: 72 2d 72 6f 77 20 27 28 29 29 0a 09 09 09 09 20 r-row '()).....
61d0: 20 20 20 20 20 20 28 72 65 73 75 6c 74 20 20 20 (result
61e0: 27 28 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 '())).... (
61f0: 6c 65 74 2a 20 28 28 76 61 6c 20 28 73 70 61 72 let* ((val (spar
6200: 73 65 2d 61 72 72 61 79 2d 72 65 66 20 73 76 65 se-array-ref sve
6210: 63 20 72 6f 77 20 63 6f 6c 29 29 0a 09 09 09 09 c row col)).....
6220: 20 20 20 20 20 28 64 69 73 70 2d 76 61 6c 20 28 (disp-val (
6230: 69 66 20 76 61 6c 0a 09 09 09 09 09 09 20 20 20 if val.......
6240: 28 63 6f 6e 63 20 22 5c 22 22 20 76 61 6c 20 22 (conc "\"" val "
6250: 5c 22 22 29 0a 09 09 09 09 09 09 20 20 20 22 22 \"")....... ""
6260: 29 29 29 0a 09 09 09 09 28 69 66 20 28 3e 20 63 ))).....(if (> c
6270: 6f 6c 20 30 29 28 64 69 73 70 6c 61 79 20 22 2c ol 0)(display ",
6280: 22 29 29 0a 09 09 09 09 28 64 69 73 70 6c 61 79 ")).....(display
6290: 20 64 69 73 70 2d 76 61 6c 29 0a 09 09 09 09 28 disp-val).....(
62a0: 63 6f 6e 64 0a 09 09 09 09 20 28 28 3e 20 72 6f cond..... ((> ro
62b0: 77 20 6d 61 78 72 6f 77 29 28 64 69 73 70 6c 61 w maxrow)(displa
62c0: 79 20 22 5c 6e 22 29 20 72 65 73 75 6c 74 29 0a y "\n") result).
62d0: 09 09 09 09 20 28 28 3e 3d 20 63 6f 6c 20 6d 61 .... ((>= col ma
62e0: 78 63 6f 6c 29 0a 09 09 09 09 20 20 28 64 69 73 xcol)..... (dis
62f0: 70 6c 61 79 20 22 5c 6e 22 29 0a 09 09 09 09 20 play "\n").....
6300: 20 28 6c 6f 6f 70 20 28 2b 20 72 6f 77 20 31 29 (loop (+ row 1)
6310: 20 30 20 27 28 29 20 28 61 70 70 65 6e 64 20 72 0 '() (append r
6320: 65 73 75 6c 74 20 28 6c 69 73 74 20 63 75 72 72 esult (list curr
6330: 2d 72 6f 77 29 29 29 29 0a 09 09 09 09 20 28 65 -row))))..... (e
6340: 6c 73 65 0a 09 09 09 09 20 20 28 6c 6f 6f 70 20 lse..... (loop
6350: 72 6f 77 20 28 2b 20 63 6f 6c 20 31 29 20 28 61 row (+ col 1) (a
6360: 70 70 65 6e 64 20 63 75 72 72 2d 72 6f 77 20 28 ppend curr-row (
6370: 6c 69 73 74 20 76 61 6c 29 29 20 72 65 73 75 6c list val)) resul
6380: 74 29 29 29 29 29 29 29 29 29 0a 09 09 20 20 20 t)))))))))...
6390: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 (hash-table-key
63a0: 73 20 72 65 73 75 6c 74 73 29 29 29 29 0a 09 09 s results))))...
63b0: 28 28 73 71 6c 69 74 65 33 29 0a 09 09 20 28 6c ((sqlite3)... (l
63c0: 65 74 2a 20 28 28 64 62 2d 66 69 6c 65 20 20 20 et* ((db-file
63d0: 28 6f 72 20 6f 75 74 2d 66 69 6c 65 20 28 70 61 (or out-file (pa
63e0: 74 68 6e 61 6d 65 2d 66 69 6c 65 20 69 6e 70 75 thname-file inpu
63f0: 74 2d 64 62 29 29 29 0a 09 09 09 28 64 62 2d 65 t-db)))....(db-e
6400: 78 69 73 74 73 20 28 66 69 6c 65 2d 65 78 69 73 xists (file-exis
6410: 74 73 3f 20 64 62 2d 66 69 6c 65 29 29 0a 09 09 ts? db-file))...
6420: 09 28 64 62 20 20 20 20 20 20 20 20 28 73 71 6c .(db (sql
6430: 69 74 65 33 3a 6f 70 65 6e 2d 64 61 74 61 62 61 ite3:open-databa
6440: 73 65 20 64 62 2d 66 69 6c 65 29 29 29 0a 09 09 se db-file)))...
6450: 20 20 20 28 69 66 20 28 6e 6f 74 20 64 62 2d 65 (if (not db-e
6460: 78 69 73 74 73 29 28 73 71 6c 69 74 65 33 3a 65 xists)(sqlite3:e
6470: 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 xecute db "CREAT
6480: 45 20 54 41 42 4c 45 20 64 61 74 61 20 28 73 68 E TABLE data (sh
6490: 65 65 74 2c 73 65 63 74 69 6f 6e 2c 76 61 72 2c eet,section,var,
64a0: 76 61 6c 29 3b 22 29 29 0a 09 09 20 20 20 28 63 val);"))... (c
64b0: 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 onfigf:map-all-h
64c0: 69 65 72 2d 61 6c 69 73 74 0a 09 09 20 20 20 20 ier-alist...
64d0: 64 61 74 61 0a 09 09 20 20 20 20 28 6c 61 6d 62 data... (lamb
64e0: 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 65 da (sheetname se
64f0: 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d ctionname varnam
6500: 65 20 76 61 6c 29 0a 09 09 20 20 20 20 20 20 28 e val)... (
6510: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
6520: 64 62 0a 09 09 09 09 20 20 20 20 20 20 20 22 49 db..... "I
6530: 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 NSERT OR REPLACE
6540: 20 49 4e 54 4f 20 64 61 74 61 20 28 73 68 65 65 INTO data (shee
6550: 74 2c 73 65 63 74 69 6f 6e 2c 76 61 72 2c 76 61 t,section,var,va
6560: 6c 29 20 56 41 4c 55 45 53 20 28 3f 2c 3f 2c 3f l) VALUES (?,?,?
6570: 2c 3f 29 3b 22 0a 09 09 09 09 20 20 20 20 20 20 ,?);".....
6580: 20 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 sheetname secti
6590: 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 onname varname v
65a0: 61 6c 29 29 29 0a 09 09 20 20 20 28 73 71 6c 69 al)))... (sqli
65b0: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
65c0: 29 29 29 0a 09 09 28 65 6c 73 65 0a 09 09 20 28 )))...(else... (
65d0: 70 70 20 64 61 74 61 29 29 29 29 29 29 0a 20 20 pp data)))))).
65e0: 20 20 20 20 28 69 66 20 6f 75 74 2d 66 69 6c 65 (if out-file
65f0: 20 28 63 6c 6f 73 65 2d 6f 75 74 70 75 74 2d 70 (close-output-p
6600: 6f 72 74 20 6f 75 74 2d 70 6f 72 74 29 29 0a 20 ort out-port)).
6610: 20 20 20 20 20 28 65 78 69 74 29 20 3b 3b 20 79 (exit) ;; y
6620: 65 73 2c 20 62 65 6e 64 69 6e 67 20 74 68 65 20 es, bending the
6630: 72 75 6c 65 73 20 68 65 72 65 20 2d 20 6e 65 65 rules here - nee
6640: 64 20 74 6f 20 65 78 69 74 20 73 69 6e 63 65 20 d to exit since
6650: 74 68 69 73 20 69 73 20 61 20 75 74 69 6c 69 74 this is a utilit
6660: 79 0a 20 20 20 20 20 20 29 29 0a 0a 28 69 66 20 y. ))..(if
6670: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6680: 70 69 6e 67 22 29 0a 20 20 20 20 28 6c 65 74 2a ping"). (let*
6690: 20 28 28 73 65 72 76 65 72 2d 69 64 20 20 20 20 ((server-id
66a0: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
66b0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
66c0: 2d 70 69 6e 67 22 29 29 29 20 3b 3b 20 65 78 74 -ping"))) ;; ext
66d0: 72 61 63 74 20 72 75 6e 2d 69 64 20 28 69 2e 65 ract run-id (i.e
66e0: 2e 20 6e 6f 20 22 3a 22 0a 09 20 20 20 28 68 6f . no ":".. (ho
66f0: 73 74 3a 70 6f 72 74 20 20 20 20 20 28 61 72 67 st:port (arg
6700: 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 69 6e 67 s:get-arg "-ping
6710: 22 29 29 29 0a 20 20 20 20 20 20 28 73 65 72 76 "))). (serv
6720: 65 72 3a 70 69 6e 67 20 28 6f 72 20 73 65 72 76 er:ping (or serv
6730: 65 72 2d 69 64 20 68 6f 73 74 3a 70 6f 72 74 29 er-id host:port)
6740: 20 64 6f 2d 65 78 69 74 3a 20 23 74 29 29 29 0a do-exit: #t))).
6750: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
6760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 61 70 =========.;; Cap
67a0: 74 75 72 65 2c 20 73 61 76 65 20 61 6e 64 20 6d ture, save and m
67b0: 61 6e 69 70 75 6c 61 74 65 20 65 6e 76 69 72 6f anipulate enviro
67c0: 6e 6d 65 6e 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d nments.;;=======
67d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
6810: 0a 3b 3b 20 4e 4f 54 45 3a 20 4b 65 65 70 20 74 .;; NOTE: Keep t
6820: 68 65 73 65 20 61 62 6f 76 65 20 74 68 65 20 73 hese above the s
6830: 65 63 74 69 6f 6e 20 77 68 65 72 65 20 74 68 65 ection where the
6840: 20 73 65 72 76 65 72 20 6f 72 20 63 6c 69 65 6e server or clien
6850: 74 20 63 6f 64 65 20 69 73 20 73 65 74 75 70 0a t code is setup.
6860: 0a 28 6c 65 74 20 28 28 65 6e 76 63 61 70 20 28 .(let ((envcap (
6870: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
6880: 6e 76 63 61 70 22 29 29 29 0a 20 20 28 69 66 20 nvcap"))). (if
6890: 65 6e 76 63 61 70 0a 20 20 20 20 20 20 28 6c 65 envcap. (le
68a0: 74 2a 20 28 28 64 62 20 20 20 20 20 20 28 65 6e t* ((db (en
68b0: 76 3a 6f 70 65 6e 2d 64 62 20 28 69 66 20 28 6e v:open-db (if (n
68c0: 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 22 65 ull? remargs) "e
68d0: 6e 76 64 61 74 2e 64 62 22 20 28 63 61 72 20 72 nvdat.db" (car r
68e0: 65 6d 61 72 67 73 29 29 29 29 29 0a 09 28 65 6e emargs)))))..(en
68f0: 76 3a 73 61 76 65 2d 65 6e 76 2d 76 61 72 73 20 v:save-env-vars
6900: 64 62 20 65 6e 76 63 61 70 29 0a 09 28 65 6e 76 db envcap)..(env
6910: 3a 63 6c 6f 73 65 2d 64 61 74 61 62 61 73 65 20 :close-database
6920: 64 62 29 0a 09 28 73 65 74 21 20 2a 64 69 64 73 db)..(set! *dids
6930: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 omething* #t))))
6940: 0a 0a 3b 3b 20 64 65 6c 74 61 20 22 6c 61 6e 67 ..;; delta "lang
6950: 75 61 67 65 22 20 77 69 6c 6c 20 65 76 65 6e 74 uage" will event
6960: 75 61 6c 6c 79 20 62 65 20 72 65 73 3d 61 2b 62 ually be res=a+b
6970: 2d 63 20 62 75 74 20 66 6f 72 20 6e 6f 77 20 69 -c but for now i
6980: 74 20 69 73 20 6a 75 73 74 20 72 65 73 3d 61 2d t is just res=a-
6990: 62 20 0a 3b 3b 0a 28 6c 65 74 20 28 28 65 6e 76 b .;;.(let ((env
69a0: 64 65 6c 74 61 20 28 61 72 67 73 3a 67 65 74 2d delta (args:get-
69b0: 61 72 67 20 22 2d 65 6e 76 64 65 6c 74 61 22 29 arg "-envdelta")
69c0: 29 29 0a 20 20 28 69 66 20 65 6e 76 64 65 6c 74 )). (if envdelt
69d0: 61 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 6d a. (let ((m
69e0: 61 74 63 68 20 28 73 74 72 69 6e 67 2d 73 70 6c atch (string-spl
69f0: 69 74 20 65 6e 76 64 65 6c 74 61 20 22 2d 22 29 it envdelta "-")
6a00: 29 29 3b 3b 20 28 73 74 72 69 6e 67 2d 6d 61 74 ));; (string-mat
6a10: 63 68 20 22 28 5b 61 2d 7a 30 2d 39 5f 5d 2b 29 ch "([a-z0-9_]+)
6a20: 3d 28 5b 61 2d 7a 30 2d 39 5f 5c 5c 2d 2c 5d 2b =([a-z0-9_\\-,]+
6a30: 29 22 20 65 6e 76 64 65 6c 74 61 29 29 29 0a 09 )" envdelta)))..
6a40: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
6a50: 6d 61 74 63 68 29 29 0a 09 20 20 20 20 28 6c 65 match)).. (le
6a60: 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 20 28 t* ((db (
6a70: 65 6e 76 3a 6f 70 65 6e 2d 64 62 20 28 69 66 20 env:open-db (if
6a80: 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 (null? remargs)
6a90: 22 65 6e 76 64 61 74 2e 64 62 22 20 28 63 61 72 "envdat.db" (car
6aa0: 20 72 65 6d 61 72 67 73 29 29 29 29 0a 09 09 20 remargs))))...
6ab0: 20 20 3b 3b 20 28 72 65 73 63 74 78 20 20 20 20 ;; (resctx
6ac0: 28 63 61 64 72 20 6d 61 74 63 68 29 29 0a 09 09 (cadr match))...
6ad0: 20 20 20 3b 3b 20 28 65 71 75 6e 20 20 20 20 20 ;; (equn
6ae0: 20 28 63 61 64 64 72 20 6d 61 74 63 68 29 29 0a (caddr match)).
6af0: 09 09 20 20 20 28 70 61 72 74 73 20 20 20 20 20 .. (parts
6b00: 6d 61 74 63 68 29 20 3b 3b 20 28 73 74 72 69 6e match) ;; (strin
6b10: 67 2d 73 70 6c 69 74 20 65 71 75 6e 20 22 2d 22 g-split equn "-"
6b20: 29 29 0a 09 09 20 20 20 28 6d 69 6e 75 65 6e 64 ))... (minuend
6b30: 20 20 20 28 63 61 72 20 70 61 72 74 73 29 29 0a (car parts)).
6b40: 09 09 20 20 20 28 73 75 62 74 72 61 65 6e 64 20 .. (subtraend
6b50: 28 63 61 64 72 20 70 61 72 74 73 29 29 0a 09 09 (cadr parts))...
6b60: 20 20 20 28 61 64 64 65 64 20 20 20 20 20 28 65 (added (e
6b70: 6e 76 3a 67 65 74 2d 61 64 64 65 64 20 20 20 64 nv:get-added d
6b80: 62 20 6d 69 6e 75 65 6e 64 20 73 75 62 74 72 61 b minuend subtra
6b90: 65 6e 64 29 29 0a 09 09 20 20 20 28 72 65 6d 6f end))... (remo
6ba0: 76 65 64 20 20 20 28 65 6e 76 3a 67 65 74 2d 72 ved (env:get-r
6bb0: 65 6d 6f 76 65 64 20 64 62 20 6d 69 6e 75 65 6e emoved db minuen
6bc0: 64 20 73 75 62 74 72 61 65 6e 64 29 29 0a 09 09 d subtraend))...
6bd0: 20 20 20 28 63 68 61 6e 67 65 64 20 20 20 28 65 (changed (e
6be0: 6e 76 3a 67 65 74 2d 63 68 61 6e 67 65 64 20 64 nv:get-changed d
6bf0: 62 20 6d 69 6e 75 65 6e 64 20 73 75 62 74 72 61 b minuend subtra
6c00: 65 6e 64 29 29 29 0a 09 20 20 20 20 20 20 3b 3b end))).. ;;
6c10: 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 (pp (hash-table
6c20: 2d 3e 61 6c 69 73 74 20 61 64 64 65 64 29 29 0a ->alist added)).
6c30: 09 20 20 20 20 20 20 3b 3b 20 28 70 70 20 28 68 . ;; (pp (h
6c40: 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 ash-table->alist
6c50: 20 72 65 6d 6f 76 65 64 29 29 0a 09 20 20 20 20 removed))..
6c60: 20 20 3b 3b 20 28 70 70 20 28 68 61 73 68 2d 74 ;; (pp (hash-t
6c70: 61 62 6c 65 2d 3e 61 6c 69 73 74 20 63 68 61 6e able->alist chan
6c80: 67 65 64 29 29 0a 09 20 20 20 20 20 20 28 69 66 ged)).. (if
6c90: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6ca0: 2d 6f 22 29 0a 09 09 20 20 28 77 69 74 68 2d 6f -o")... (with-o
6cb0: 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 0a 09 09 utput-to-file...
6cc0: 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
6cd0: 61 72 67 20 22 2d 6f 22 29 0a 09 09 20 20 20 20 arg "-o")...
6ce0: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 20 20 (lambda ()...
6cf0: 20 20 20 28 65 6e 76 3a 70 72 69 6e 74 20 61 64 (env:print ad
6d00: 64 65 64 20 72 65 6d 6f 76 65 64 20 63 68 61 6e ded removed chan
6d10: 67 65 64 29 29 29 0a 09 09 20 20 28 65 6e 76 3a ged)))... (env:
6d20: 70 72 69 6e 74 20 61 64 64 65 64 20 72 65 6d 6f print added remo
6d30: 76 65 64 20 63 68 61 6e 67 65 64 29 29 0a 09 20 ved changed))..
6d40: 20 20 20 20 20 28 65 6e 76 3a 63 6c 6f 73 65 2d (env:close-
6d50: 64 61 74 61 62 61 73 65 20 64 62 29 0a 09 20 20 database db)..
6d60: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
6d70: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 0a 09 20 mething* #t))..
6d80: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
6d90: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
6da0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 50 61 72 61 -log-port* "Para
6db0: 6d 65 74 65 72 20 74 6f 20 2d 65 6e 76 64 65 6c meter to -envdel
6dc0: 74 61 20 73 68 6f 75 6c 64 20 62 65 20 6e 65 77 ta should be new
6dd0: 3d 73 74 61 72 2d 65 6e 64 22 29 29 29 29 29 0a =star-end"))))).
6de0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
6df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 =========.;; Sta
6e30: 72 74 20 74 68 65 20 73 65 72 76 65 72 20 2d 20 rt the server -
6e40: 63 61 6e 20 62 65 20 64 6f 6e 65 20 69 6e 20 63 can be done in c
6e50: 6f 6e 6a 75 6e 63 74 69 6f 6e 20 77 69 74 68 20 onjunction with
6e60: 2d 72 75 6e 61 6c 6c 20 6f 72 20 2d 72 75 6e 74 -runall or -runt
6e70: 65 73 74 73 20 28 6f 6e 65 20 64 61 79 2e 2e 2e ests (one day...
6e80: 29 0a 3b 3b 20 20 20 77 65 20 73 74 61 72 74 20 ).;; we start
6e90: 74 68 65 20 73 65 72 76 65 72 20 69 66 20 6e 6f the server if no
6ea0: 74 20 72 75 6e 6e 69 6e 67 20 65 6c 73 65 20 73 t running else s
6eb0: 74 61 72 74 20 74 68 65 20 63 6c 69 65 6e 74 20 tart the client
6ec0: 74 68 72 65 61 64 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d thread.;;=======
6ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
6f10: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
6f20: 72 67 20 22 2d 73 65 72 76 65 72 22 29 0a 0a 20 rg "-server")..
6f30: 20 20 20 3b 3b 20 53 65 72 76 65 72 3f 20 53 74 ;; Server? St
6f40: 61 72 74 20 75 70 20 68 65 72 65 2e 0a 20 20 20 art up here..
6f50: 20 3b 3b 0a 20 20 20 20 28 6c 65 74 20 28 28 74 ;;. (let ((t
6f60: 6c 20 20 20 20 20 20 20 20 28 6c 61 75 6e 63 68 l (launch
6f70: 3a 73 65 74 75 70 29 29 0a 09 3b 3b 20 28 72 75 :setup))..;; (ru
6f80: 6e 2d 69 64 20 20 20 20 28 61 6e 64 20 28 61 72 n-id (and (ar
6f90: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
6fa0: 2d 69 64 22 29 0a 09 3b 3b 20 09 09 20 20 28 73 -id")..;; .. (s
6fb0: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 tring->number (a
6fc0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
6fd0: 6e 2d 69 64 22 29 29 29 29 0a 20 20 20 20 20 20 n-id")))).
6fe0: 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 2d 74 (transport-t
6ff0: 79 70 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d ype (string->sym
7000: 62 6f 6c 20 28 6f 72 20 28 61 72 67 73 3a 67 65 bol (or (args:ge
7010: 74 2d 61 72 67 20 22 2d 74 72 61 6e 73 70 6f 72 t-arg "-transpor
7020: 74 22 29 20 22 68 74 74 70 22 29 29 29 29 0a 20 t") "http")))).
7030: 20 20 20 20 20 3b 3b 20 28 69 66 20 72 75 6e 2d ;; (if run-
7040: 69 64 0a 20 20 20 20 20 20 3b 3b 20 20 20 28 62 id. ;; (b
7050: 65 67 69 6e 0a 20 20 20 20 20 20 28 73 65 72 76 egin. (serv
7060: 65 72 3a 6c 61 75 6e 63 68 20 30 20 74 72 61 6e er:launch 0 tran
7070: 73 70 6f 72 74 2d 74 79 70 65 29 0a 20 20 20 20 sport-type).
7080: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
7090: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 3b 3b 20 thing* #t))).;;
70a0: 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 ;; (debug:pr
70b0: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
70c0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
70d0: 73 65 72 76 65 72 20 72 65 71 75 69 72 65 73 20 server requires
70e0: 72 75 6e 2d 69 64 20 62 65 20 73 70 65 63 69 66 run-id be specif
70f0: 69 65 64 20 77 69 74 68 20 2d 72 75 6e 2d 69 64 ied with -run-id
7100: 22 29 29 29 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 "))).;; .;;
7110: 3b 3b 20 4e 6f 74 20 61 20 73 65 72 76 65 72 3f ;; Not a server?
7120: 20 54 68 69 73 20 73 65 63 74 69 6f 6e 20 77 69 This section wi
7130: 6c 6c 20 64 65 63 69 64 65 20 68 6f 77 20 74 6f ll decide how to
7140: 20 63 6f 6d 6d 75 6e 69 63 61 74 65 0a 3b 3b 20 communicate.;;
7150: 20 20 20 20 3b 3b 0a 3b 3b 20 20 20 20 20 3b 3b ;;.;; ;;
7160: 20 20 53 65 74 75 70 20 63 6c 69 65 6e 74 20 66 Setup client f
7170: 6f 72 20 61 6c 6c 20 65 78 70 65 63 74 20 6c 69 or all expect li
7180: 73 74 65 64 20 68 65 72 65 0a 3b 3b 20 20 20 20 sted here.;;
7190: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 28 6c 73 65 (if (null? (lse
71a0: 74 2d 69 6e 74 65 72 73 65 63 74 69 6f 6e 20 0a t-intersection .
71b0: 3b 3b 20 09 09 65 71 75 61 6c 3f 0a 3b 3b 20 09 ;; ..equal?.;; .
71c0: 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 .(hash-table-key
71d0: 73 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 s args:arg-hash)
71e0: 0a 3b 3b 20 09 09 27 28 22 2d 6c 69 73 74 2d 73 .;; ..'("-list-s
71f0: 65 72 76 65 72 73 22 0a 3b 3b 20 09 09 20 20 22 ervers".;; .. "
7200: 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 0a 3b 3b -stop-server".;;
7210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7220: 20 20 20 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 "-kill-server
7230: 22 0a 3b 3b 20 09 09 20 20 22 2d 73 68 6f 77 2d ".;; .. "-show-
7240: 63 6d 64 69 6e 66 6f 22 0a 3b 3b 20 09 09 20 20 cmdinfo".;; ..
7250: 22 2d 6c 69 73 74 2d 72 75 6e 73 22 0a 3b 3b 20 "-list-runs".;;
7260: 09 09 20 20 22 2d 70 69 6e 67 22 29 29 29 0a 3b .. "-ping"))).;
7270: 3b 20 09 28 69 66 20 28 6c 61 75 6e 63 68 3a 73 ; .(if (launch:s
7280: 65 74 75 70 29 0a 3b 3b 20 09 20 20 20 20 28 6c etup).;; . (l
7290: 65 74 20 28 28 72 75 6e 2d 69 64 20 20 20 20 28 et ((run-id (
72a0: 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 and (args:get-ar
72b0: 67 20 22 2d 72 75 6e 2d 69 64 22 29 0a 3b 3b 20 g "-run-id").;;
72c0: 09 09 09 09 20 20 28 73 74 72 69 6e 67 2d 3e 6e .... (string->n
72d0: 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d umber (args:get-
72e0: 61 72 67 20 22 2d 72 75 6e 2d 69 64 22 29 29 29 arg "-run-id")))
72f0: 29 29 0a 3b 3b 20 09 20 20 20 20 20 20 3b 3b 20 )).;; . ;;
7300: 28 73 65 74 21 20 2a 66 64 62 2a 20 20 20 28 66 (set! *fdb* (f
7310: 69 6c 65 64 62 3a 6f 70 65 6e 2d 64 62 20 28 63 iledb:open-db (c
7320: 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f onc *toppath* "/
7330: 64 62 2f 70 61 74 68 73 2e 64 62 22 29 29 29 0a db/paths.db"))).
7340: 3b 3b 20 09 20 20 20 20 20 20 3b 3b 20 69 66 20 ;; . ;; if
7350: 6e 6f 74 20 6c 69 73 74 20 6f 72 20 6b 69 6c 6c not list or kill
7360: 20 74 68 65 6e 20 73 74 61 72 74 20 61 20 63 6c then start a cl
7370: 69 65 6e 74 20 28 69 66 20 61 70 70 72 6f 70 72 ient (if appropr
7380: 69 61 74 65 29 0a 3b 3b 20 09 20 20 20 20 20 20 iate).;; .
7390: 28 69 66 20 28 6f 72 20 28 61 72 67 73 2d 64 65 (if (or (args-de
73a0: 66 69 6e 65 64 3f 20 22 2d 68 22 20 22 2d 76 65 fined? "-h" "-ve
73b0: 72 73 69 6f 6e 22 20 22 2d 63 72 65 61 74 65 2d rsion" "-create-
73c0: 6d 65 67 61 74 65 73 74 2d 61 72 65 61 22 20 22 megatest-area" "
73d0: 2d 63 72 65 61 74 65 2d 74 65 73 74 22 29 0a 3b -create-test").;
73e0: 3b 20 09 09 20 20 20 20 20 20 28 65 71 3f 20 28 ; .. (eq? (
73f0: 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 length (hash-tab
7400: 6c 65 2d 6b 65 79 73 20 61 72 67 73 3a 61 72 67 le-keys args:arg
7410: 2d 68 61 73 68 29 29 20 30 29 29 0a 3b 3b 20 09 -hash)) 0)).;; .
7420: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
7430: 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d info 1 *default-
7440: 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 65 72 76 65 log-port* "Serve
7450: 72 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 6e 6f 74 r connection not
7460: 20 6e 65 65 64 65 64 22 29 0a 3b 3b 20 09 09 20 needed").;; ..
7470: 20 28 62 65 67 69 6e 0a 3b 3b 20 09 09 20 20 20 (begin.;; ..
7480: 20 3b 3b 20 28 69 66 20 72 75 6e 2d 69 64 20 0a ;; (if run-id .
7490: 3b 3b 20 09 09 20 20 20 20 3b 3b 20 20 20 20 20 ;; .. ;;
74a0: 28 63 6c 69 65 6e 74 3a 6c 61 75 6e 63 68 20 72 (client:launch r
74b0: 75 6e 2d 69 64 29 20 0a 3b 3b 20 09 09 20 20 20 un-id) .;; ..
74c0: 20 3b 3b 20 20 20 20 20 28 63 6c 69 65 6e 74 3a ;; (client:
74d0: 6c 61 75 6e 63 68 20 30 29 20 20 20 20 20 20 3b launch 0) ;
74e0: 3b 20 77 69 74 68 6f 75 74 20 72 75 6e 2d 69 64 ; without run-id
74f0: 20 77 65 27 6c 6c 20 73 74 61 72 74 20 61 20 73 we'll start a s
7500: 65 72 76 65 72 20 66 6f 72 20 22 30 22 0a 3b 3b erver for "0".;;
7510: 20 09 09 20 20 20 20 23 74 0a 3b 3b 20 09 09 20 .. #t.;; ..
7520: 20 20 20 29 29 29 29 29 29 0a 0a 28 69 66 20 28 ))))))..(if (
7530: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
7540: 20 22 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 "-list-servers"
7550: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
7560: 20 22 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 29 "-stop-server")
7570: 0a 20 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 . (args:g
7580: 65 74 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 et-arg "-kill-se
7590: 72 76 65 72 22 29 29 0a 20 20 20 20 28 6c 65 74 rver")). (let
75a0: 20 28 28 74 6c 20 28 6c 61 75 6e 63 68 3a 73 65 ((tl (launch:se
75b0: 74 75 70 29 29 29 0a 20 20 20 20 20 20 28 69 66 tup))). (if
75c0: 20 74 6c 20 0a 09 20 20 28 6c 65 74 2a 20 28 28 tl .. (let* ((
75d0: 74 64 62 64 61 74 20 20 28 74 61 73 6b 73 3a 6f tdbdat (tasks:o
75e0: 70 65 6e 2d 64 62 29 29 0a 09 09 20 28 73 65 72 pen-db))... (ser
75f0: 76 65 72 73 20 28 74 61 73 6b 73 3a 67 65 74 2d vers (tasks:get-
7600: 61 6c 6c 2d 73 65 72 76 65 72 73 20 28 64 62 3a all-servers (db:
7610: 64 65 6c 61 79 2d 69 66 2d 62 75 73 79 20 74 64 delay-if-busy td
7620: 62 64 61 74 29 29 29 0a 09 09 20 28 66 6d 74 73 bdat)))... (fmts
7630: 74 72 20 20 22 7e 35 61 7e 31 32 61 7e 38 61 7e tr "~5a~12a~8a~
7640: 32 30 61 7e 32 34 61 7e 31 30 61 7e 31 30 61 7e 20a~24a~10a~10a~
7650: 31 30 61 7e 31 30 61 5c 6e 22 29 0a 09 09 20 28 10a~10a\n")... (
7660: 73 65 72 76 65 72 73 2d 74 6f 2d 6b 69 6c 6c 20 servers-to-kill
7670: 27 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 '()).
7680: 20 20 20 20 20 20 28 6b 69 6c 6c 2d 73 77 69 74 (kill-swit
7690: 63 68 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 ch (if (args:ge
76a0: 74 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 72 t-arg "-kill-ser
76b0: 76 65 72 22 29 20 22 2d 39 22 20 22 22 29 29 0a ver") "-9" "")).
76c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76d0: 20 28 6b 69 6c 6c 69 6e 66 6f 20 20 20 28 6f 72 (killinfo (or
76e0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
76f0: 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 29 20 28 -stop-server") (
7700: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6b args:get-arg "-k
7710: 69 6c 6c 2d 73 65 72 76 65 72 22 29 20 29 29 0a ill-server") )).
7720: 09 09 20 28 6b 68 6f 73 74 2d 70 6f 72 74 20 28 .. (khost-port (
7730: 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 69 66 20 if killinfo (if
7740: 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 (substring-index
7750: 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f 29 28 73 ":" killinfo)(s
7760: 74 72 69 6e 67 2d 73 70 6c 69 74 20 22 3a 22 29 tring-split ":")
7770: 20 23 66 29 20 23 66 29 29 0a 09 09 20 28 73 69 #f) #f))... (si
7780: 64 20 20 20 20 20 20 20 20 28 69 66 20 6b 69 6c d (if kil
7790: 6c 69 6e 66 6f 20 28 69 66 20 28 73 75 62 73 74 linfo (if (subst
77a0: 72 69 6e 67 2d 69 6e 64 65 78 20 22 3a 22 20 6b ring-index ":" k
77b0: 69 6c 6c 69 6e 66 6f 29 20 23 66 20 28 73 74 72 illinfo) #f (str
77c0: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 6b 69 6c 6c ing->number kill
77d0: 69 6e 66 6f 29 29 20 23 66 29 29 29 0a 09 20 20 info)) #f)))..
77e0: 20 20 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 (format #t fmt
77f0: 73 74 72 20 22 49 64 22 20 22 4d 54 76 65 72 22 str "Id" "MTver"
7800: 20 22 50 69 64 22 20 22 48 6f 73 74 22 20 22 49 "Pid" "Host" "I
7810: 6e 74 65 72 66 61 63 65 3a 4f 75 74 50 6f 72 74 nterface:OutPort
7820: 22 20 22 49 6e 50 6f 72 74 22 20 22 4c 61 73 74 " "InPort" "Last
7830: 42 65 61 74 22 20 22 53 74 61 74 65 22 20 22 54 Beat" "State" "T
7840: 72 61 6e 73 70 6f 72 74 22 29 0a 09 20 20 20 20 ransport")..
7850: 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 74 (format #t fmtst
7860: 72 20 22 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 r "==" "=====" "
7870: 3d 3d 3d 22 20 22 3d 3d 3d 3d 22 20 22 3d 3d 3d ===" "====" "===
7880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 20 =============="
7890: 22 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d "======" "======
78a0: 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d ==" "=====" "===
78b0: 3d 3d 3d 3d 3d 3d 22 29 0a 09 20 20 20 20 28 66 ======").. (f
78c0: 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 28 or-each .. (
78d0: 6c 61 6d 62 64 61 20 28 73 65 72 76 65 72 29 0a lambda (server).
78e0: 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 . (let* ((
78f0: 69 64 20 20 20 20 20 20 20 20 20 28 76 65 63 74 id (vect
7900: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 30 29 or-ref server 0)
7910: 29 0a 09 09 20 20 20 20 20 20 28 70 69 64 20 20 )... (pid
7920: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re
7930: 66 20 73 65 72 76 65 72 20 31 29 29 0a 09 09 20 f server 1))...
7940: 20 20 20 20 20 28 68 6f 73 74 6e 61 6d 65 20 20 (hostname
7950: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
7960: 76 65 72 20 32 29 29 0a 09 09 20 20 20 20 20 20 ver 2))...
7970: 28 69 6e 74 65 72 66 61 63 65 20 20 28 76 65 63 (interface (vec
7980: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 33 tor-ref server 3
7990: 29 29 20 0a 09 09 20 20 20 20 20 20 28 70 75 6c )) ... (pul
79a0: 6c 70 6f 72 74 20 20 20 28 76 65 63 74 6f 72 2d lport (vector-
79b0: 72 65 66 20 73 65 72 76 65 72 20 34 29 29 0a 09 ref server 4))..
79c0: 09 20 20 20 20 20 20 28 70 75 62 70 6f 72 74 20 . (pubport
79d0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
79e0: 65 72 76 65 72 20 35 29 29 0a 09 09 20 20 20 20 erver 5))...
79f0: 20 20 28 73 74 61 72 74 2d 74 69 6d 65 20 28 76 (start-time (v
7a00: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
7a10: 20 36 29 29 0a 09 09 20 20 20 20 20 20 28 70 72 6))... (pr
7a20: 69 6f 72 69 74 79 20 20 20 28 76 65 63 74 6f 72 iority (vector
7a30: 2d 72 65 66 20 73 65 72 76 65 72 20 37 29 29 0a -ref server 7)).
7a40: 09 09 20 20 20 20 20 20 28 73 74 61 74 65 20 20 .. (state
7a50: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
7a60: 73 65 72 76 65 72 20 38 29 29 0a 09 09 20 20 20 server 8))...
7a70: 20 20 20 28 6d 74 2d 76 65 72 20 20 20 20 20 28 (mt-ver (
7a80: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
7a90: 72 20 39 29 29 0a 09 09 20 20 20 20 20 20 28 6c r 9))... (l
7aa0: 61 73 74 2d 75 70 64 61 74 65 20 28 76 65 63 74 ast-update (vect
7ab0: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 30 or-ref server 10
7ac0: 29 29 20 0a 09 09 20 20 20 20 20 20 28 74 72 61 )) ... (tra
7ad0: 6e 73 70 6f 72 74 20 20 28 76 65 63 74 6f 72 2d nsport (vector-
7ae0: 72 65 66 20 73 65 72 76 65 72 20 31 31 29 29 0a ref server 11)).
7af0: 09 09 20 20 20 20 20 20 28 6b 69 6c 6c 65 64 20 .. (killed
7b00: 20 20 20 20 23 66 29 0a 09 09 20 20 20 20 20 20 #f)...
7b10: 28 73 74 61 74 75 73 20 20 20 20 20 28 3c 20 6c (status (< l
7b20: 61 73 74 2d 75 70 64 61 74 65 20 32 30 29 29 29 ast-update 20)))
7b30: 0a 09 09 20 3b 3b 20 20 20 28 7a 6d 71 2d 73 6f ... ;; (zmq-so
7b40: 63 6b 65 74 73 20 28 69 66 20 73 74 61 74 75 73 ckets (if status
7b50: 20 28 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d (server:client-
7b60: 63 6f 6e 6e 65 63 74 20 68 6f 73 74 6e 61 6d 65 connect hostname
7b70: 20 70 6f 72 74 29 20 23 66 29 29 29 0a 09 09 20 port) #f)))...
7b80: 3b 3b 20 6e 6f 20 6e 65 65 64 20 74 6f 20 6c 6f ;; no need to lo
7b90: 67 69 6e 20 61 73 20 73 74 61 74 75 73 20 6f 66 gin as status of
7ba0: 20 23 74 20 69 6e 64 69 63 61 74 65 73 20 77 65 #t indicates we
7bb0: 20 61 72 65 20 63 6f 6e 6e 65 63 74 69 6e 67 20 are connecting
7bc0: 74 6f 20 63 6f 72 72 65 63 74 20 0a 09 09 20 3b to correct ... ;
7bd0: 3b 20 73 65 72 76 65 72 0a 09 09 20 28 69 66 20 ; server... (if
7be0: 28 65 71 75 61 6c 3f 20 73 74 61 74 65 20 22 64 (equal? state "d
7bf0: 65 61 64 22 29 0a 09 09 20 20 20 20 20 28 69 66 ead")... (if
7c00: 20 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 (> last-update
7c10: 28 2a 20 32 35 20 36 30 20 36 30 29 29 20 3b 3b (* 25 60 60)) ;;
7c20: 20 6b 65 65 70 20 72 65 63 6f 72 64 73 20 61 72 keep records ar
7c30: 6f 75 6e 64 20 66 6f 72 20 73 6c 69 67 68 6c 79 ound for slighly
7c40: 20 6f 76 65 72 20 61 20 64 61 79 2e 0a 09 09 09 over a day.....
7c50: 20 28 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 (tasks:server-d
7c60: 65 72 65 67 69 73 74 65 72 20 28 64 62 3a 64 65 eregister (db:de
7c70: 6c 61 79 2d 69 66 2d 62 75 73 79 20 74 64 62 64 lay-if-busy tdbd
7c80: 61 74 29 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c at) hostname pul
7c90: 6c 70 6f 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 lport: pullport
7ca0: 70 69 64 3a 20 70 69 64 20 61 63 74 69 6f 6e 3a pid: pid action:
7cb0: 20 27 64 65 6c 65 74 65 29 29 0a 09 09 20 20 20 'delete))...
7cc0: 20 20 28 69 66 20 28 3e 20 6c 61 73 74 2d 75 70 (if (> last-up
7cd0: 64 61 74 65 20 32 30 29 20 20 20 20 20 20 20 20 date 20)
7ce0: 3b 3b 20 4d 61 72 6b 20 61 73 20 64 65 61 64 20 ;; Mark as dead
7cf0: 69 66 20 6e 6f 74 20 75 70 64 61 74 65 64 20 69 if not updated i
7d00: 6e 20 6c 61 73 74 20 32 30 20 73 65 63 6f 6e 64 n last 20 second
7d10: 73 0a 09 09 09 20 28 74 61 73 6b 73 3a 73 65 72 s.... (tasks:ser
7d20: 76 65 72 2d 64 65 72 65 67 69 73 74 65 72 20 28 ver-deregister (
7d30: 64 62 3a 64 65 6c 61 79 2d 69 66 2d 62 75 73 79 db:delay-if-busy
7d40: 20 74 64 62 64 61 74 29 20 68 6f 73 74 6e 61 6d tdbdat) hostnam
7d50: 65 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 6c 6c e pullport: pull
7d60: 70 6f 72 74 20 70 69 64 3a 20 70 69 64 29 29 29 port pid: pid)))
7d70: 0a 09 09 20 28 66 6f 72 6d 61 74 20 23 74 20 66 ... (format #t f
7d80: 6d 74 73 74 72 20 69 64 20 6d 74 2d 76 65 72 20 mtstr id mt-ver
7d90: 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 28 63 6f pid hostname (co
7da0: 6e 63 20 69 6e 74 65 72 66 61 63 65 20 22 3a 22 nc interface ":"
7db0: 20 70 75 6c 6c 70 6f 72 74 29 20 70 75 62 70 6f pullport) pubpo
7dc0: 72 74 20 6c 61 73 74 2d 75 70 64 61 74 65 0a 09 rt last-update..
7dd0: 09 09 20 28 69 66 20 73 74 61 74 75 73 20 22 61 .. (if status "a
7de0: 6c 69 76 65 22 20 22 64 65 61 64 22 29 20 74 72 live" "dead") tr
7df0: 61 6e 73 70 6f 72 74 29 0a 09 09 20 28 69 66 20 ansport)... (if
7e00: 28 6f 72 20 28 65 71 75 61 6c 3f 20 69 64 20 73 (or (equal? id s
7e10: 69 64 29 0a 09 09 09 20 28 65 71 75 61 6c 3f 20 id).... (equal?
7e20: 73 69 64 20 30 29 29 20 3b 3b 20 6b 69 6c 6c 20 sid 0)) ;; kill
7e30: 61 6c 6c 2f 61 6e 79 0a 09 09 20 20 20 20 20 28 all/any... (
7e40: 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 20 28 begin... (
7e50: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
7e60: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
7e70: 70 6f 72 74 2a 20 22 41 74 74 65 6d 70 74 69 6e port* "Attemptin
7e80: 67 20 74 6f 20 6b 69 6c 6c 20 22 6b 69 6c 6c 2d g to kill "kill-
7e90: 73 77 69 74 63 68 22 20 73 65 72 76 65 72 20 77 switch" server w
7ea0: 69 74 68 20 70 69 64 20 22 20 70 69 64 29 0a 09 ith pid " pid)..
7eb0: 09 20 20 20 20 20 20 20 28 74 61 73 6b 73 3a 6b . (tasks:k
7ec0: 69 6c 6c 2d 73 65 72 76 65 72 20 68 6f 73 74 6e ill-server hostn
7ed0: 61 6d 65 20 70 69 64 20 6b 69 6c 6c 2d 73 77 69 ame pid kill-swi
7ee0: 74 63 68 3a 20 6b 69 6c 6c 2d 73 77 69 74 63 68 tch: kill-switch
7ef0: 29 29 29 29 29 0a 09 20 20 20 20 20 73 65 72 76 ))))).. serv
7f00: 65 72 73 29 0a 09 20 20 20 20 28 64 65 62 75 67 ers).. (debug
7f10: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 :print-info 1 *d
7f20: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
7f30: 20 22 44 6f 6e 65 20 77 69 74 68 20 6c 69 73 74 "Done with list
7f40: 73 65 72 76 65 72 73 22 29 0a 09 20 20 20 20 28 servers").. (
7f50: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
7f60: 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 28 65 78 ng* #t).. (ex
7f70: 69 74 29 29 20 3b 3b 20 6d 75 73 74 20 64 6f 2c it)) ;; must do,
7f80: 20 77 6f 75 6c 64 20 68 61 76 65 20 74 6f 20 61 would have to a
7f90: 64 64 20 63 68 65 63 6b 73 20 74 6f 20 6d 61 6e dd checks to man
7fa0: 79 2f 61 6c 6c 20 63 61 6c 6c 73 20 62 65 6c 6f y/all calls belo
7fb0: 77 0a 09 20 20 28 65 78 69 74 29 29 29 29 0a 0a w.. (exit))))..
7fc0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
7fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8000: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 57 65 69 72 ========.;; Weir
8010: 64 20 73 70 65 63 69 61 6c 20 63 61 6c 6c 73 20 d special calls
8020: 74 68 61 74 20 6e 65 65 64 20 74 6f 20 72 75 6e that need to run
8030: 20 2a 61 66 74 65 72 2a 20 74 68 65 20 73 65 72 *after* the ser
8040: 76 65 72 20 68 61 73 20 73 74 61 72 74 65 64 3f ver has started?
8050: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
8060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
80a0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
80b0: 69 73 74 2d 74 61 72 67 65 74 73 22 29 0a 20 20 ist-targets").
80c0: 20 20 28 69 66 20 28 6c 61 75 6e 63 68 3a 73 65 (if (launch:se
80d0: 74 75 70 29 0a 20 20 20 20 20 20 20 20 28 6c 65 tup). (le
80e0: 74 20 28 28 74 61 72 67 65 74 73 20 28 63 6f 6d t ((targets (com
80f0: 6d 6f 6e 3a 67 65 74 2d 72 75 6e 63 6f 6e 66 69 mon:get-runconfi
8100: 67 2d 74 61 72 67 65 74 73 29 29 29 0a 20 20 20 g-targets))).
8110: 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
8120: 69 6e 74 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c int 1 *default-l
8130: 6f 67 2d 70 6f 72 74 2a 20 22 46 6f 75 6e 64 20 og-port* "Found
8140: 22 28 6c 65 6e 67 74 68 20 74 61 72 67 65 74 73 "(length targets
8150: 29 20 22 20 74 61 72 67 65 74 73 22 29 0a 20 20 ) " targets").
8160: 20 20 20 20 20 20 20 20 28 63 61 73 65 20 28 73 (case (s
8170: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f tring->symbol (o
8180: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
8190: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 61 6c "-dumpmode") "al
81a0: 69 73 74 22 29 29 0a 20 20 20 20 20 20 20 20 20 ist")).
81b0: 20 20 20 28 28 61 6c 69 73 74 29 0a 20 20 20 20 ((alist).
81c0: 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 (for-ea
81d0: 63 68 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 ch (lambda (x).
81e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
81f0: 20 20 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e ;; (prin
8200: 74 20 22 5b 22 20 78 20 22 5d 22 29 29 0a 20 20 t "[" x "]")).
8210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8220: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 78 29 (print x)
8230: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8240: 20 20 20 20 20 20 20 20 20 74 61 72 67 65 74 73 targets
8250: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
8260: 28 6a 73 6f 6e 29 0a 20 20 20 20 20 20 20 20 20 (json).
8270: 20 20 20 20 28 6a 73 6f 6e 2d 77 72 69 74 65 20 (json-write
8280: 74 61 72 67 65 74 73 29 29 0a 20 20 20 20 20 20 targets)).
8290: 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
82a0: 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
82b0: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
82c0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
82d0: 20 22 64 75 6d 70 20 6f 75 74 70 75 74 20 66 6f "dump output fo
82e0: 72 6d 61 74 20 22 20 28 61 72 67 73 3a 67 65 74 rmat " (args:get
82f0: 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 -arg "-dumpmode"
8300: 29 20 22 20 6e 6f 74 20 73 75 70 70 6f 72 74 65 ) " not supporte
8310: 64 20 66 6f 72 20 2d 6c 69 73 74 2d 74 61 72 67 d for -list-targ
8320: 65 74 73 22 29 29 29 0a 20 20 20 20 20 20 20 20 ets"))).
8330: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
8340: 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b thing* #t))))..;
8350: 3b 20 63 61 63 68 65 20 74 68 65 20 72 75 6e 63 ; cache the runc
8360: 6f 6e 66 69 67 73 20 69 6e 20 24 4d 54 5f 4c 49 onfigs in $MT_LI
8370: 4e 4b 54 52 45 45 2f 24 4d 54 5f 54 41 52 47 45 NKTREE/$MT_TARGE
8380: 54 2f 24 4d 54 5f 52 55 4e 4e 41 4d 45 2f 2e 72 T/$MT_RUNNAME/.r
8390: 75 6e 63 6f 6e 66 69 67 0a 3b 3b 0a 28 64 65 66 unconfig.;;.(def
83a0: 69 6e 65 20 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e ine (full-runcon
83b0: 66 69 67 73 2d 72 65 61 64 29 0a 3b 3b 20 69 6e figs-read).;; in
83c0: 20 74 68 65 20 65 6e 76 70 72 6f 63 65 73 73 69 the envprocessi
83d0: 6e 67 20 62 72 61 6e 63 68 20 74 68 65 20 62 65 ng branch the be
83e0: 6c 6f 77 20 63 6f 64 65 20 72 65 70 6c 61 63 65 low code replace
83f0: 73 20 74 68 65 20 66 75 72 74 68 65 72 20 62 65 s the further be
8400: 6c 6f 77 20 63 6f 64 65 0a 3b 3b 20 20 28 69 66 low code.;; (if
8410: 20 28 65 71 3f 20 2a 63 6f 6e 66 69 67 73 74 61 (eq? *configsta
8420: 74 75 73 2a 20 27 66 75 6c 6c 64 61 74 61 29 0a tus* 'fulldata).
8430: 3b 3b 20 20 20 20 20 20 2a 72 75 6e 63 6f 6e 66 ;; *runconf
8440: 69 67 64 61 74 2a 0a 3b 3b 20 20 20 20 20 20 28 igdat*.;; (
8450: 62 65 67 69 6e 0a 3b 3b 09 28 6c 61 75 6e 63 68 begin.;;.(launch
8460: 3a 73 65 74 75 70 29 0a 3b 3b 09 2a 72 75 6e 63 :setup).;;.*runc
8470: 6f 6e 66 69 67 64 61 74 2a 29 29 29 0a 0a 20 20 onfigdat*)))..
8480: 28 6c 65 74 2a 20 28 28 72 75 6e 64 69 72 20 28 (let* ((rundir (
8490: 69 66 20 28 61 6e 64 20 28 67 65 74 65 6e 76 20 if (and (getenv
84a0: 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 29 28 67 "MT_LINKTREE")(g
84b0: 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 etenv "MT_TARGET
84c0: 22 29 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 ")(getenv "MT_RU
84d0: 4e 4e 41 4d 45 22 29 29 0a 09 09 20 20 20 20 20 NNAME"))...
84e0: 28 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 22 4d (conc (getenv "M
84f0: 54 5f 4c 49 4e 4b 54 52 45 45 22 29 20 22 2f 22 T_LINKTREE") "/"
8500: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 (getenv "MT_TAR
8510: 47 45 54 22 29 20 22 2f 22 20 28 67 65 74 65 6e GET") "/" (geten
8520: 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 29 29 v "MT_RUNNAME"))
8530: 0a 09 09 20 20 20 20 20 23 66 29 29 0a 09 20 28 ... #f)).. (
8540: 63 66 67 66 20 20 20 28 69 66 20 72 75 6e 64 69 cfgf (if rundi
8550: 72 20 28 63 6f 6e 63 20 72 75 6e 64 69 72 20 22 r (conc rundir "
8560: 2f 2e 72 75 6e 63 6f 6e 66 69 67 2e 22 20 6d 65 /.runconfig." me
8570: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 gatest-version "
8580: 2d 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 -" megatest-foss
8590: 69 6c 2d 68 61 73 68 29 20 23 66 29 29 29 0a 20 il-hash) #f))).
85a0: 20 20 20 28 69 66 20 28 61 6e 64 20 63 66 67 66 (if (and cfgf
85b0: 0a 09 20 20 20 20 20 28 66 69 6c 65 2d 65 78 69 .. (file-exi
85c0: 73 74 73 3f 20 63 66 67 66 29 0a 09 20 20 20 20 sts? cfgf)..
85d0: 20 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 (file-write-acc
85e0: 65 73 73 3f 20 63 66 67 66 29 29 0a 09 28 63 6f ess? cfgf))..(co
85f0: 6e 66 69 67 66 3a 72 65 61 64 2d 61 6c 69 73 74 nfigf:read-alist
8600: 20 63 66 67 66 29 0a 09 28 6c 65 74 2a 20 28 28 cfgf)..(let* ((
8610: 6b 65 79 73 20 20 20 28 72 6d 74 3a 67 65 74 2d keys (rmt:get-
8620: 6b 65 79 73 29 29 0a 09 20 20 20 20 20 20 20 28 keys)).. (
8630: 74 61 72 67 65 74 20 28 63 6f 6d 6d 6f 6e 3a 61 target (common:a
8640: 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 29 rgs-get-target))
8650: 0a 09 20 20 20 20 20 20 20 28 6b 65 79 2d 76 61 .. (key-va
8660: 6c 73 20 28 69 66 20 74 61 72 67 65 74 20 28 6b ls (if target (k
8670: 65 79 73 3a 74 61 72 67 65 74 2d 3e 6b 65 79 76 eys:target->keyv
8680: 61 6c 20 6b 65 79 73 20 74 61 72 67 65 74 29 20 al keys target)
8690: 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 73 65 #f)).. (se
86a0: 63 74 69 6f 6e 73 20 28 69 66 20 74 61 72 67 65 ctions (if targe
86b0: 74 20 28 6c 69 73 74 20 22 64 65 66 61 75 6c 74 t (list "default
86c0: 22 20 74 61 72 67 65 74 29 20 23 66 29 29 0a 09 " target) #f))..
86d0: 20 20 20 20 20 20 20 28 64 61 74 61 20 20 20 20 (data
86e0: 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 28 73 (begin.... (s
86f0: 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 etenv "MT_RUN_AR
8700: 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 EA_HOME" *toppat
8710: 68 2a 29 0a 09 09 09 20 20 20 28 69 66 20 6b 65 h*).... (if ke
8720: 79 2d 76 61 6c 73 0a 09 09 09 20 20 20 20 20 20 y-vals....
8730: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
8740: 64 61 20 28 6b 74 29 0a 09 09 09 09 09 20 20 20 da (kt)......
8750: 28 73 65 74 65 6e 76 20 28 63 61 72 20 6b 74 29 (setenv (car kt)
8760: 20 28 63 61 64 72 20 6b 74 29 29 29 0a 09 09 09 (cadr kt)))....
8770: 09 09 20 6b 65 79 2d 76 61 6c 73 29 29 0a 09 09 .. key-vals))...
8780: 09 20 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 . (read-config
8790: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
87a0: 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f "/runconfigs.co
87b0: 6e 66 69 67 22 29 20 23 66 20 23 74 20 73 65 63 nfig") #f #t sec
87c0: 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f 6e 73 29 tions: sections)
87d0: 29 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 ))).. (if (and
87e0: 72 75 6e 64 69 72 20 3b 3b 20 68 61 76 65 20 61 rundir ;; have a
87f0: 6c 6c 20 6e 65 65 64 65 64 20 76 61 72 69 61 62 ll needed variab
8800: 6c 65 73 73 0a 09 09 20 20 20 28 64 69 72 65 63 less... (direc
8810: 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 72 75 6e tory-exists? run
8820: 64 69 72 29 0a 09 09 20 20 20 28 66 69 6c 65 2d dir)... (file-
8830: 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 72 75 write-access? ru
8840: 6e 64 69 72 29 29 0a 09 20 20 20 20 20 20 28 62 ndir)).. (b
8850: 65 67 69 6e 0a 09 09 28 63 6f 6e 66 69 67 66 3a egin...(configf:
8860: 77 72 69 74 65 2d 61 6c 69 73 74 20 64 61 74 61 write-alist data
8870: 20 63 66 67 66 29 0a 09 09 3b 3b 20 66 6f 72 63 cfgf)...;; forc
8880: 65 20 72 65 2d 72 65 61 64 20 6f 66 20 6d 65 67 e re-read of meg
8890: 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 2d 20 74 atest.config - t
88a0: 68 69 73 20 72 65 73 6f 6c 76 65 73 20 63 69 72 his resolves cir
88b0: 63 75 6c 61 72 20 72 65 66 65 72 65 6e 63 65 73 cular references
88c0: 20 62 65 74 77 65 65 6e 20 6d 65 67 61 74 65 73 between megates
88d0: 74 2e 63 6f 6e 66 69 67 0a 09 09 28 6c 61 75 6e t.config...(laun
88e0: 63 68 3a 73 65 74 75 70 20 66 6f 72 63 65 3a 20 ch:setup force:
88f0: 23 74 29 0a 09 09 28 6c 61 75 6e 63 68 3a 63 61 #t)...(launch:ca
8900: 63 68 65 2d 63 6f 6e 66 69 67 29 29 29 20 3b 3b che-config))) ;;
8910: 20 77 65 20 63 61 6e 20 73 61 66 65 6c 79 20 63 we can safely c
8920: 61 63 68 65 20 6d 65 67 61 74 65 73 74 2e 63 6f ache megatest.co
8930: 6e 66 69 67 20 73 69 6e 63 65 20 77 65 20 68 61 nfig since we ha
8940: 76 65 20 61 20 76 61 6c 69 64 20 72 75 6e 63 6f ve a valid runco
8950: 6e 66 69 67 0a 09 20 20 64 61 74 61 29 29 29 29 nfig.. data))))
8960: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
8970: 61 72 67 20 22 2d 73 68 6f 77 2d 72 75 6e 63 6f arg "-show-runco
8980: 6e 66 69 67 22 29 0a 20 20 20 20 28 6c 65 74 20 nfig"). (let
8990: 28 28 74 6c 20 28 6c 61 75 6e 63 68 3a 73 65 74 ((tl (launch:set
89a0: 75 70 29 29 29 0a 20 20 20 20 20 20 28 70 75 73 up))). (pus
89b0: 68 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 h-directory *top
89c0: 70 61 74 68 2a 29 0a 20 20 20 20 20 20 28 6c 65 path*). (le
89d0: 74 20 28 28 64 61 74 61 20 28 66 75 6c 6c 2d 72 t ((data (full-r
89e0: 75 6e 63 6f 6e 66 69 67 73 2d 72 65 61 64 29 29 unconfigs-read))
89f0: 29 0a 09 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 )..;; keep this
8a00: 6f 6e 65 20 6c 6f 63 61 6c 0a 09 28 63 6f 6e 64 one local..(cond
8a10: 0a 09 20 28 28 61 6e 64 20 28 61 72 67 73 3a 67 .. ((and (args:g
8a20: 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e et-arg "-section
8a30: 22 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 ").. (args
8a40: 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 :get-arg "-var")
8a50: 29 0a 09 20 20 28 6c 65 74 20 28 28 76 61 6c 20 ).. (let ((val
8a60: 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (or (configf:loo
8a70: 6b 75 70 20 64 61 74 61 20 28 61 72 67 73 3a 67 kup data (args:g
8a80: 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e et-arg "-section
8a90: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
8aa0: 22 2d 76 61 72 22 29 29 0a 09 09 09 20 28 63 6f "-var")).... (co
8ab0: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 nfigf:lookup dat
8ac0: 61 20 22 64 65 66 61 75 6c 74 22 20 28 61 72 67 a "default" (arg
8ad0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 s:get-arg "-var"
8ae0: 29 29 29 29 29 0a 09 20 20 20 20 28 69 66 20 76 ))))).. (if v
8af0: 61 6c 20 28 70 72 69 6e 74 20 76 61 6c 29 29 29 al (print val)))
8b00: 29 0a 09 20 28 28 6e 6f 74 20 28 61 72 67 73 3a ).. ((not (args:
8b10: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
8b20: 64 65 22 29 29 0a 09 20 20 28 70 70 20 28 68 61 de")).. (pp (ha
8b30: 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 sh-table->alist
8b40: 64 61 74 61 29 29 29 0a 09 20 28 28 73 74 72 69 data))).. ((stri
8b50: 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 ng=? (args:get-a
8b60: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 rg "-dumpmode")
8b70: 22 6a 73 6f 6e 22 29 0a 09 20 20 28 6a 73 6f 6e "json").. (json
8b80: 2d 77 72 69 74 65 20 64 61 74 61 29 29 0a 09 20 -write data))..
8b90: 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 ((string=? (args
8ba0: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
8bb0: 6f 64 65 22 29 20 22 69 6e 69 22 29 0a 09 20 20 ode") "ini")..
8bc0: 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 69 67 2d (configf:config-
8bd0: 3e 69 6e 69 20 64 61 74 61 29 29 0a 09 20 28 65 >ini data)).. (e
8be0: 6c 73 65 0a 09 20 20 28 64 65 62 75 67 3a 70 72 lse.. (debug:pr
8bf0: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
8c00: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
8c10: 2d 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 -dumpmode of " (
8c20: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
8c30: 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 umpmode") " not
8c40: 72 65 63 6f 67 6e 69 73 65 64 22 29 29 29 0a 09 recognised")))..
8c50: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
8c60: 69 6e 67 2a 20 23 74 29 29 0a 20 20 20 20 20 20 ing* #t)).
8c70: 28 70 6f 70 2d 64 69 72 65 63 74 6f 72 79 29 29 (pop-directory))
8c80: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
8c90: 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 6f 6e 66 -arg "-show-conf
8ca0: 69 67 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 ig"). (let ((
8cb0: 74 6c 20 20 20 28 6c 61 75 6e 63 68 3a 73 65 74 tl (launch:set
8cc0: 75 70 29 29 0a 09 20 20 28 64 61 74 61 20 2a 63 up)).. (data *c
8cd0: 6f 6e 66 69 67 64 61 74 2a 29 29 20 3b 3b 20 28 onfigdat*)) ;; (
8ce0: 72 65 61 64 2d 63 6f 6e 66 69 67 20 22 6d 65 67 read-config "meg
8cf0: 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 20 23 66 atest.config" #f
8d00: 20 23 74 29 29 29 0a 20 20 20 20 20 20 28 70 75 #t))). (pu
8d10: 73 68 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f sh-directory *to
8d20: 70 70 61 74 68 2a 29 0a 20 20 20 20 20 20 3b 3b ppath*). ;;
8d30: 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c keep this one l
8d40: 6f 63 61 6c 0a 20 20 20 20 20 20 28 63 6f 6e 64 ocal. (cond
8d50: 20 0a 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 . ((and (
8d60: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
8d70: 65 63 74 69 6f 6e 22 29 0a 09 20 20 20 20 20 28 ection").. (
8d80: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 args:get-arg "-v
8d90: 61 72 22 29 29 0a 09 28 6c 65 74 20 28 28 76 61 ar"))..(let ((va
8da0: 6c 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 l (configf:looku
8db0: 70 20 64 61 74 61 20 28 61 72 67 73 3a 67 65 74 p data (args:get
8dc0: 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 -arg "-section")
8dd0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8de0: 76 61 72 22 29 29 29 29 0a 09 20 20 28 69 66 20 var")))).. (if
8df0: 76 61 6c 20 28 70 72 69 6e 74 20 76 61 6c 29 29 val (print val))
8e00: 29 29 0a 0a 20 20 20 20 20 20 20 3b 3b 20 70 72 )).. ;; pr
8e10: 69 6e 74 20 6a 75 73 74 20 61 20 73 65 63 74 69 int just a secti
8e20: 6f 6e 20 69 66 20 6f 6e 6c 79 20 2d 73 65 63 74 on if only -sect
8e30: 69 6f 6e 0a 0a 20 20 20 20 20 20 20 28 28 6e 6f ion.. ((no
8e40: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
8e50: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 29 0a 09 28 "-dumpmode"))..(
8e60: 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e pp (hash-table->
8e70: 61 6c 69 73 74 20 64 61 74 61 29 29 29 0a 20 20 alist data))).
8e80: 20 20 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 ((string=?
8e90: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8ea0: 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e dumpmode") "json
8eb0: 22 29 0a 09 28 6a 73 6f 6e 2d 77 72 69 74 65 20 ")..(json-write
8ec0: 64 61 74 61 29 29 0a 20 20 20 20 20 20 20 28 28 data)). ((
8ed0: 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 string=? (args:g
8ee0: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
8ef0: 65 22 29 20 22 69 6e 69 22 29 0a 09 28 63 6f 6e e") "ini")..(con
8f00: 66 69 67 66 3a 63 6f 6e 66 69 67 2d 3e 69 6e 69 figf:config->ini
8f10: 20 64 61 74 61 29 29 0a 20 20 20 20 20 20 20 28 data)). (
8f20: 65 6c 73 65 0a 09 28 64 65 62 75 67 3a 70 72 69 else..(debug:pri
8f30: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
8f40: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d ult-log-port* "-
8f50: 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 61 dumpmode of " (a
8f60: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
8f70: 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 72 mpmode") " not r
8f80: 65 63 6f 67 6e 69 73 65 64 22 29 29 29 0a 20 20 ecognised"))).
8f90: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
8fa0: 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 20 20 20 mething* #t).
8fb0: 20 20 20 28 70 6f 70 2d 64 69 72 65 63 74 6f 72 (pop-director
8fc0: 79 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a y)))..(if (args:
8fd0: 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 get-arg "-show-c
8fe0: 6d 64 69 6e 66 6f 22 29 0a 20 20 20 20 28 69 66 mdinfo"). (if
8ff0: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
9000: 72 67 20 22 3a 76 61 6c 75 65 22 29 28 67 65 74 rg ":value")(get
9010: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
9020: 29 29 0a 09 28 6c 65 74 20 28 28 64 61 74 61 20 ))..(let ((data
9030: 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 (common:read-enc
9040: 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 6f 72 20 oded-string (or
9050: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
9060: 76 61 6c 75 65 22 29 28 67 65 74 65 6e 76 20 22 value")(getenv "
9070: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 MT_CMDINFO")))))
9080: 0a 09 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 .. (if (equal?
9090: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
90a0: 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e dumpmode") "json
90b0: 22 29 0a 09 20 20 20 20 20 20 28 6a 73 6f 6e 2d ").. (json-
90c0: 77 72 69 74 65 20 64 61 74 61 29 0a 09 20 20 20 write data)..
90d0: 20 20 20 28 70 70 20 64 61 74 61 29 29 0a 09 20 (pp data))..
90e0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
90f0: 68 69 6e 67 2a 20 23 74 29 29 0a 09 28 64 65 62 hing* #t))..(deb
9100: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
9110: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
9120: 74 2a 20 22 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 t* "environment
9130: 76 61 72 69 61 62 6c 65 20 4d 54 5f 43 4d 44 49 variable MT_CMDI
9140: 4e 46 4f 20 69 73 20 6e 6f 74 20 73 65 74 22 29 NFO is not set")
9150: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
9160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
91a0: 52 65 6d 6f 76 65 20 6f 6c 64 20 72 75 6e 28 73 Remove old run(s
91b0: 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ).;;============
91c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
91d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
91e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
91f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 ==========..;; s
9200: 69 6e 63 65 20 73 65 76 65 72 61 6c 20 61 63 74 ince several act
9210: 69 6f 6e 73 20 63 61 6e 20 62 65 20 73 70 65 63 ions can be spec
9220: 69 66 69 65 64 20 6f 6e 20 74 68 65 20 63 6f 6d ified on the com
9230: 6d 61 6e 64 20 6c 69 6e 65 20 74 68 65 20 72 65 mand line the re
9240: 6d 6f 76 61 6c 0a 3b 3b 20 69 73 20 64 6f 6e 65 moval.;; is done
9250: 20 66 69 72 73 74 0a 28 64 65 66 69 6e 65 20 28 first.(define (
9260: 6f 70 65 72 61 74 65 2d 6f 6e 20 61 63 74 69 6f operate-on actio
9270: 6e 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e n). (let* ((run
9280: 72 65 63 20 28 72 75 6e 73 3a 72 75 6e 72 65 63 rec (runs:runrec
9290: 2d 6d 61 6b 65 2d 72 65 63 6f 72 64 29 29 0a 09 -make-record))..
92a0: 20 28 74 61 72 67 65 74 20 28 63 6f 6d 6d 6f 6e (target (common
92b0: 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 :args-get-target
92c0: 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 ))). (cond.
92d0: 20 20 20 28 28 6e 6f 74 20 74 61 72 67 65 74 29 ((not target)
92e0: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
92f0: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
9300: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
9310: 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 Missing required
9320: 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 parameter for "
9330: 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d action ", you m
9340: 75 73 74 20 73 70 65 63 69 66 79 20 2d 74 61 72 ust specify -tar
9350: 67 65 74 20 6f 72 20 2d 72 65 71 74 61 72 67 22 get or -reqtarg"
9360: 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 31 29 ). (exit 1)
9370: 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 6f 72 ). ((not (or
9380: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9390: 3a 72 75 6e 6e 61 6d 65 22 29 0a 09 20 20 20 20 :runname")..
93a0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
93b0: 20 22 2d 72 75 6e 6e 61 6d 65 22 29 29 29 0a 20 "-runname"))).
93c0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
93d0: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
93e0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 lt-log-port* "Mi
93f0: 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 ssing required p
9400: 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 61 arameter for " a
9410: 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 ction ", you mus
9420: 74 20 73 70 65 63 69 66 79 20 74 68 65 20 72 75 t specify the ru
9430: 6e 20 6e 61 6d 65 20 70 61 74 74 65 72 6e 20 77 n name pattern w
9440: 69 74 68 20 2d 72 75 6e 6e 61 6d 65 20 70 61 74 ith -runname pat
9450: 74 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 t"). (exit
9460: 32 29 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 2)). ((not (
9470: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
9480: 65 73 74 70 61 74 74 22 29 29 0a 20 20 20 20 20 estpatt")).
9490: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
94a0: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
94b0: 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 69 6e og-port* "Missin
94c0: 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d g required param
94d0: 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f eter for " actio
94e0: 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 n ", you must sp
94f0: 65 63 69 66 79 20 74 68 65 20 74 65 73 74 20 70 ecify the test p
9500: 61 74 74 65 72 6e 20 77 69 74 68 20 2d 74 65 73 attern with -tes
9510: 74 70 61 74 74 22 29 0a 20 20 20 20 20 20 28 65 tpatt"). (e
9520: 78 69 74 20 33 29 29 0a 20 20 20 20 20 28 65 6c xit 3)). (el
9530: 73 65 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f se. (if (no
9540: 74 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e t (car *configin
9550: 66 6f 2a 29 29 0a 09 20 20 28 62 65 67 69 6e 0a fo*)).. (begin.
9560: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
9570: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
9580: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 41 74 lt-log-port* "At
9590: 74 65 6d 70 74 65 64 20 22 20 61 63 74 69 6f 6e tempted " action
95a0: 20 22 6f 6e 20 74 65 73 74 28 73 29 20 62 75 74 "on test(s) but
95b0: 20 72 75 6e 20 61 72 65 61 20 63 6f 6e 66 69 67 run area config
95c0: 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 22 file not found"
95d0: 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 ).. (exit 1))
95e0: 0a 09 20 20 3b 3b 20 70 75 74 20 74 65 73 74 20 .. ;; put test
95f0: 70 61 72 61 6d 65 74 65 72 73 20 69 6e 74 6f 20 parameters into
9600: 63 6f 6e 76 65 6e 69 65 6e 74 20 76 61 72 69 61 convenient varia
9610: 62 6c 65 73 0a 09 20 20 28 62 65 67 69 6e 0a 09 bles.. (begin..
9620: 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 66 6f 72 ;; check for
9630: 20 63 6f 72 72 65 63 74 20 76 65 72 73 69 6f 6e correct version
9640: 2c 20 65 78 69 74 20 77 69 74 68 20 6d 65 73 73 , exit with mess
9650: 61 67 65 20 69 66 20 6e 6f 74 20 63 6f 72 72 65 age if not corre
9660: 63 74 0a 09 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a ct.. (common:
9670: 65 78 69 74 2d 6f 6e 2d 76 65 72 73 69 6f 6e 2d exit-on-version-
9680: 63 68 61 6e 67 65 64 29 0a 09 20 20 20 20 28 72 changed).. (r
9690: 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 20 uns:operate-on
96a0: 61 63 74 69 6f 6e 0a 09 09 09 20 20 20 20 20 20 action....
96b0: 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 20 20 target....
96c0: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
96d0: 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f -runname) ;; (o
96e0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
96f0: 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 "-runname")(args
9700: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
9710: 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 20 28 me")).... (
9720: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
9730: 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 testpatt #f) ;;
9740: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
9750: 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 testpatt")....
9760: 20 20 20 20 73 74 61 74 65 3a 20 28 63 6f 6d 6d state: (comm
9770: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 73 74 61 74 on:args-get-stat
9780: 65 29 0a 09 09 09 20 20 20 20 20 20 73 74 61 74 e).... stat
9790: 75 73 3a 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 us: (common:args
97a0: 2d 67 65 74 2d 73 74 61 74 75 73 29 0a 09 09 09 -get-status)....
97b0: 20 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d new-state-
97c0: 73 74 61 74 75 73 3a 20 28 61 72 67 73 3a 67 65 status: (args:ge
97d0: 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 74 61 74 t-arg "-set-stat
97e0: 65 2d 73 74 61 74 75 73 22 29 29 29 29 0a 20 20 e-status")))).
97f0: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
9800: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 29 mething* #t)))))
9810: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
9820: 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e arg "-remove-run
9830: 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c s"). (general
9840: 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 -run-call .
9850: 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 0a 20 "-remove-runs".
9860: 20 20 20 20 22 72 65 6d 6f 76 65 20 72 75 6e 73 "remove runs
9870: 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ". (lambda (
9880: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
9890: 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 eys keyvals).
98a0: 20 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 (operate-on
98b0: 27 72 65 6d 6f 76 65 2d 72 75 6e 73 29 29 29 29 'remove-runs))))
98c0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
98d0: 61 72 67 20 22 2d 73 65 74 2d 73 74 61 74 65 2d arg "-set-state-
98e0: 73 74 61 74 75 73 22 29 0a 20 20 20 20 28 67 65 status"). (ge
98f0: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
9900: 20 20 20 20 20 22 2d 73 65 74 2d 73 74 61 74 65 "-set-state
9910: 2d 73 74 61 74 75 73 22 0a 20 20 20 20 20 22 73 -status". "s
9920: 65 74 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 et state and sta
9930: 74 75 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 tus". (lambd
9940: 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
9950: 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a e keys keyvals).
9960: 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d (operate-
9970: 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 on 'set-state-st
9980: 61 74 75 73 29 29 29 29 0a 0a 28 69 66 20 28 6f atus))))..(if (o
9990: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
99a0: 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 "-set-run-status
99b0: 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
99c0: 67 20 22 2d 67 65 74 2d 72 75 6e 2d 73 74 61 74 g "-get-run-stat
99d0: 75 73 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 us")). (gener
99e0: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 al-run-call.
99f0: 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 "-set-run-statu
9a00: 73 22 0a 20 20 20 20 20 22 73 65 74 20 72 75 6e s". "set run
9a10: 20 73 74 61 74 75 73 22 0a 20 20 20 20 20 28 6c status". (l
9a20: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
9a30: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 nname keys keyva
9a40: 6c 73 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a ls). (let*
9a50: 20 28 28 72 75 6e 73 64 61 74 20 20 28 72 6d 74 ((runsdat (rmt
9a60: 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 :get-runs-by-pat
9a70: 74 20 6b 65 79 73 20 72 75 6e 6e 61 6d 65 20 0a t keys runname .
9a80: 09 09 09 09 09 28 63 6f 6d 6d 6f 6e 3a 61 72 67 .....(common:arg
9a90: 73 2d 67 65 74 2d 74 61 72 67 65 74 29 0a 09 09 s-get-target)...
9aa0: 09 09 09 23 66 20 23 66 20 23 66 20 23 66 29 29 ...#f #f #f #f))
9ab0: 0a 09 20 20 20 20 20 20 28 68 65 61 64 65 72 20 .. (header
9ac0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 (vector-ref ru
9ad0: 6e 73 64 61 74 20 30 29 29 0a 09 20 20 20 20 20 nsdat 0))..
9ae0: 20 28 72 6f 77 73 20 20 20 20 20 28 76 65 63 74 (rows (vect
9af0: 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 31 or-ref runsdat 1
9b00: 29 29 29 0a 09 20 28 69 66 20 28 6e 75 6c 6c 3f ))).. (if (null?
9b10: 20 72 6f 77 73 29 0a 09 20 20 20 20 20 28 62 65 rows).. (be
9b20: 67 69 6e 0a 09 20 20 20 20 20 20 20 28 64 65 62 gin.. (deb
9b30: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
9b40: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
9b50: 74 2a 20 22 4e 6f 20 6d 61 74 63 68 69 6e 67 20 t* "No matching
9b60: 72 75 6e 20 66 6f 75 6e 64 2e 22 29 0a 09 20 20 run found.")..
9b70: 20 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 09 (exit 1))..
9b80: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 6f 77 (let* ((row
9b90: 20 20 20 20 20 20 28 63 61 72 20 28 76 65 63 74 (car (vect
9ba0: 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 31 or-ref runsdat 1
9bb0: 29 29 29 0a 09 09 20 20 20 20 28 72 75 6e 2d 69 )))... (run-i
9bc0: 64 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 d (db:get-valu
9bd0: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 6f 77 20 e-by-header row
9be0: 68 65 61 64 65 72 20 22 69 64 22 29 29 29 0a 09 header "id")))..
9bf0: 20 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 (if (args
9c00: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 72 :get-arg "-set-r
9c10: 75 6e 2d 73 74 61 74 75 73 22 29 0a 09 09 20 20 un-status")...
9c20: 20 28 72 6d 74 3a 73 65 74 2d 72 75 6e 2d 73 74 (rmt:set-run-st
9c30: 61 74 75 73 20 72 75 6e 2d 69 64 20 28 61 72 67 atus run-id (arg
9c40: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
9c50: 72 75 6e 2d 73 74 61 74 75 73 22 29 20 6d 73 67 run-status") msg
9c60: 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 : (args:get-arg
9c70: 22 2d 6d 22 29 29 0a 09 09 20 20 20 28 70 72 69 "-m"))... (pri
9c80: 6e 74 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d nt (rmt:get-run-
9c90: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 29 29 0a status run-id)).
9ca0: 09 09 20 20 20 29 29 29 29 29 29 29 0a 0a 3b 3b .. )))))))..;;
9cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9cf0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 75 65 72 79 20 ======.;; Query
9d00: 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d runs.;;=========
9d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
9d50: 3b 20 2d 66 69 65 6c 64 73 20 72 75 6e 73 3a 69 ; -fields runs:i
9d60: 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 d,target,runname
9d70: 2c 63 6f 6d 6d 65 6e 74 2b 74 65 73 74 73 3a 69 ,comment+tests:i
9d80: 64 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f d,testname,item_
9d90: 70 61 74 68 2b 73 74 65 70 73 0a 3b 3b 0a 3b 3b path+steps.;;.;;
9da0: 20 63 73 69 3e 20 28 65 78 74 72 61 63 74 2d 66 csi> (extract-f
9db0: 69 65 6c 64 73 2d 63 6f 6e 73 74 72 61 69 6e 74 ields-constraint
9dc0: 73 20 22 72 75 6e 73 3a 69 64 2c 74 61 72 67 65 s "runs:id,targe
9dd0: 74 2c 72 75 6e 6e 61 6d 65 2c 63 6f 6d 6d 65 6e t,runname,commen
9de0: 74 2b 74 65 73 74 73 3a 69 64 2c 74 65 73 74 6e t+tests:id,testn
9df0: 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2b 73 74 ame,item_path+st
9e00: 65 70 73 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 eps").;;
9e10: 20 3d 3e 20 28 28 22 72 75 6e 73 22 20 22 69 64 => (("runs" "id
9e20: 22 20 22 74 61 72 67 65 74 22 20 22 72 75 6e 6e " "target" "runn
9e30: 61 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 20 ame" "comment")
9e40: 28 22 74 65 73 74 73 22 20 22 69 64 22 20 22 74 ("tests" "id" "t
9e50: 65 73 74 6e 61 6d 65 22 20 22 69 74 65 6d 5f 70 estname" "item_p
9e60: 61 74 68 22 29 20 28 22 73 74 65 70 73 22 29 29 ath") ("steps"))
9e70: 0a 3b 3b 0a 3b 3b 20 20 20 4e 4f 54 45 3a 20 72 .;;.;; NOTE: r
9e80: 65 6d 65 6d 62 65 72 20 74 68 61 74 20 74 68 65 emember that the
9e90: 20 63 64 72 20 77 69 6c 6c 20 62 65 20 74 68 65 cdr will be the
9ea0: 20 6c 69 73 74 20 79 6f 75 20 65 78 70 65 63 74 list you expect
9eb0: 20 28 63 64 72 20 28 22 72 75 6e 73 22 20 22 69 (cdr ("runs" "i
9ec0: 64 22 20 22 74 61 72 67 65 74 22 20 22 72 75 6e d" "target" "run
9ed0: 6e 61 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 name" "comment")
9ee0: 29 20 3d 3e 20 28 22 69 64 22 20 22 74 61 72 67 ) => ("id" "targ
9ef0: 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 63 et" "runname" "c
9f00: 6f 6d 6d 65 6e 74 22 29 0a 3b 3b 20 20 20 20 20 omment").;;
9f10: 20 20 20 20 61 6e 64 20 73 6f 20 61 6c 69 73 74 and so alist
9f20: 2d 72 65 66 20 77 69 6c 6c 20 79 69 65 6c 64 20 -ref will yield
9f30: 77 68 61 74 20 79 6f 75 20 65 78 70 65 63 74 0a what you expect.
9f40: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 65 78 74 72 ;;.(define (extr
9f50: 61 63 74 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 74 act-fields-const
9f60: 72 61 69 6e 74 73 20 66 69 65 6c 64 73 2d 73 70 raints fields-sp
9f70: 65 63 29 0a 20 20 28 6d 61 70 20 28 6c 61 6d 62 ec). (map (lamb
9f80: 64 61 20 28 74 61 62 6c 65 2d 73 70 65 63 29 20 da (table-spec)
9f90: 3b 3b 20 72 75 6e 73 3a 69 64 2c 74 61 72 67 65 ;; runs:id,targe
9fa0: 74 2c 72 75 6e 6e 61 6d 65 0a 09 20 28 6c 65 74 t,runname.. (let
9fb0: 20 28 28 64 61 74 20 28 73 74 72 69 6e 67 2d 73 ((dat (string-s
9fc0: 70 6c 69 74 20 74 61 62 6c 65 2d 73 70 65 63 20 plit table-spec
9fd0: 22 3a 22 29 29 29 20 3b 3b 20 28 22 72 75 6e 73 ":"))) ;; ("runs
9fe0: 22 20 22 69 64 2c 74 61 72 67 65 74 2c 72 75 6e " "id,target,run
9ff0: 6e 61 6d 65 22 29 0a 09 20 20 20 28 69 66 20 28 name").. (if (
a000: 3e 20 28 6c 65 6e 67 74 68 20 64 61 74 29 20 31 > (length dat) 1
a010: 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 ).. (cons
a020: 28 63 61 72 20 64 61 74 29 28 73 74 72 69 6e 67 (car dat)(string
a030: 2d 73 70 6c 69 74 20 28 63 61 64 72 20 64 61 74 -split (cadr dat
a040: 29 20 22 2c 22 29 29 20 3b 3b 20 22 69 64 2c 74 ) ",")) ;; "id,t
a050: 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 22 0a 09 arget,runname"..
a060: 20 20 20 20 20 20 20 64 61 74 29 29 29 0a 20 20 dat))).
a070: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c (string-spl
a080: 69 74 20 66 69 65 6c 64 73 2d 73 70 65 63 20 22 it fields-spec "
a090: 2b 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 +")))..(define (
a0a0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
a0b0: 6c 64 6e 61 6d 65 20 64 61 74 61 76 65 63 20 74 ldname datavec t
a0c0: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
a0d0: 66 69 65 6c 64 6e 61 6d 65 29 0a 20 20 28 6c 65 fieldname). (le
a0e0: 74 20 28 28 69 6e 64 78 20 28 68 61 73 68 2d 74 t ((indx (hash-t
a0f0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
a100: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
a110: 78 20 66 69 65 6c 64 6e 61 6d 65 20 23 66 29 29 x fieldname #f))
a120: 29 0a 20 20 20 20 28 69 66 20 69 6e 64 78 0a 09 ). (if indx..
a130: 28 69 66 20 28 3e 3d 20 69 6e 64 78 20 28 76 65 (if (>= indx (ve
a140: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 64 61 74 61 ctor-length data
a150: 76 65 63 29 29 0a 09 20 20 20 20 23 66 20 3b 3b vec)).. #f ;;
a160: 20 69 6e 64 65 78 20 74 6f 6f 20 68 69 67 68 2c index too high,
a170: 20 73 68 6f 75 6c 64 20 72 61 69 73 65 20 61 6e should raise an
a180: 20 65 72 72 6f 72 20 49 20 73 75 70 70 6f 73 65 error I suppose
a190: 0a 09 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 .. (vector-re
a1a0: 66 20 64 61 74 61 76 65 63 20 69 6e 64 78 29 29 f datavec indx))
a1b0: 0a 09 23 66 29 29 29 0a 0a 3b 3b 20 4e 4f 54 45 ..#f)))..;; NOTE
a1c0: 3a 20 6c 69 73 74 2d 72 75 6e 73 20 61 6e 64 20 : list-runs and
a1d0: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 20 list-db-targets
a1e0: 6f 70 65 72 61 74 65 20 6f 6e 20 6c 6f 63 61 6c operate on local
a1f0: 20 64 62 21 21 21 0a 3b 3b 0a 3b 3b 20 49 44 45 db!!!.;;.;; IDE
a200: 41 3a 20 6d 65 67 61 74 65 73 74 20 6c 69 73 74 A: megatest list
a210: 20 2d 72 75 6e 6e 61 6d 65 20 62 6c 61 68 25 20 -runname blah%
a220: 2e 2e 2e 0a 3b 3b 0a 28 69 66 20 28 6f 72 20 28 ....;;.(if (or (
a230: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
a240: 69 73 74 2d 72 75 6e 73 22 29 0a 09 28 61 72 67 ist-runs")..(arg
a250: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
a260: 2d 64 62 2d 74 61 72 67 65 74 73 22 29 29 0a 20 -db-targets")).
a270: 20 20 20 28 69 66 20 28 6c 61 75 6e 63 68 3a 73 (if (launch:s
a280: 65 74 75 70 29 0a 09 28 6c 65 74 2a 20 28 3b 3b etup)..(let* (;;
a290: 20 28 64 62 73 74 72 75 63 74 20 20 20 20 28 6d (dbstruct (m
a2a0: 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 ake-dbr:dbstruct
a2b0: 20 70 61 74 68 3a 20 2a 74 6f 70 70 61 74 68 2a path: *toppath*
a2c0: 20 6c 6f 63 61 6c 3a 20 28 61 72 67 73 3a 67 65 local: (args:ge
a2d0: 74 2d 61 72 67 20 22 2d 6c 6f 63 61 6c 22 29 29 t-arg "-local"))
a2e0: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 70 61 ).. (runpa
a2f0: 74 74 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 tt (args:get
a300: 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 -arg "-list-runs
a310: 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ")).
a320: 20 20 20 28 61 63 63 65 73 73 2d 6d 6f 64 65 20 (access-mode
a330: 28 64 62 3a 67 65 74 2d 61 63 63 65 73 73 2d 6d (db:get-access-m
a340: 6f 64 65 29 29 0a 09 20 20 20 20 20 20 20 28 74 ode)).. (t
a350: 65 73 74 70 61 74 74 20 20 20 20 28 63 6f 6d 6d estpatt (comm
a360: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
a370: 70 61 74 74 20 23 66 29 29 0a 09 20 20 20 20 20 patt #f))..
a380: 20 20 3b 3b 20 28 69 66 20 28 61 72 67 73 3a 67 ;; (if (args:g
a390: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
a3a0: 74 22 29 20 0a 09 20 20 20 20 20 20 20 3b 3b 20 t") .. ;;
a3b0: 20 09 20 20 20 20 20 20 20 20 28 61 72 67 73 3a . (args:
a3c0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
a3d0: 74 74 22 29 20 0a 09 20 20 20 20 20 20 20 3b 3b tt") .. ;;
a3e0: 20 20 09 20 20 20 20 20 20 20 20 22 25 22 29 29 . "%"))
a3f0: 0a 09 20 20 20 20 20 20 20 28 6b 65 79 73 20 20 .. (keys
a400: 20 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b (rmt:get-k
a410: 65 79 73 29 29 20 3b 3b 20 28 64 62 3a 67 65 74 eys)) ;; (db:get
a420: 2d 6b 65 79 73 20 64 62 73 74 72 75 63 74 29 29 -keys dbstruct))
a430: 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 72 75 6e .. ;; (run
a440: 73 64 61 74 20 20 28 64 62 3a 67 65 74 2d 72 75 sdat (db:get-ru
a450: 6e 73 20 64 62 73 74 72 75 63 74 20 72 75 6e 70 ns dbstruct runp
a460: 61 74 74 20 23 66 20 23 66 20 27 28 29 29 29 0a att #f #f '())).
a470: 09 3b 3b 20 28 72 75 6e 73 64 61 74 20 20 20 20 .;; (runsdat
a480: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 (rmt:get-runs-b
a490: 79 2d 70 61 74 74 20 6b 65 79 73 20 28 6f 72 20 y-patt keys (or
a4a0: 72 75 6e 70 61 74 74 20 22 25 22 29 20 28 63 6f runpatt "%") (co
a4b0: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 mmon:args-get-ta
a4c0: 72 67 65 74 29 20 3b 3b 20 28 64 62 3a 67 65 74 rget) ;; (db:get
a4d0: 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 64 62 -runs-by-patt db
a4e0: 73 74 72 75 63 74 20 6b 65 79 73 20 28 6f 72 20 struct keys (or
a4f0: 72 75 6e 70 61 74 74 20 22 25 22 29 20 28 63 6f runpatt "%") (co
a500: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 mmon:args-get-ta
a510: 72 67 65 74 29 0a 09 3b 3b 20 09 09 20 20 20 20 rget)..;; ..
a520: 20 20 20 20 20 20 20 09 20 23 66 20 23 66 20 27 . #f #f '
a530: 28 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 ("id" "runname"
a540: 22 73 74 61 74 65 22 20 22 73 74 61 74 75 73 22 "state" "status"
a550: 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f "owner" "event_
a560: 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 time" "comment")
a570: 20 30 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 0)).. (ru
a580: 6e 73 64 61 74 20 20 20 20 20 28 72 6d 74 3a 67 nsdat (rmt:g
a590: 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 et-runs-by-patt
a5a0: 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 61 74 74 keys (or runpatt
a5b0: 20 22 25 22 29 20 0a 20 20 20 20 20 20 20 20 20 "%") .
a5c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a5d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a5e0: 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e (common
a5f0: 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 :args-get-target
a600: 29 20 23 66 20 23 66 20 27 28 22 69 64 22 20 22 ) #f #f '("id" "
a610: 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 runname" "state"
a620: 20 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 "status" "owner
a630: 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 22 " "event_time" "
a640: 63 6f 6d 6d 65 6e 74 22 29 20 30 29 29 0a 09 20 comment") 0))..
a650: 20 20 20 20 20 20 28 72 75 6e 73 74 6d 70 20 20 (runstmp
a660: 20 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 (db:get-rows
a670: 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 runsdat))..
a680: 20 20 28 68 65 61 64 65 72 20 20 20 20 20 20 28 (header (
a690: 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 db:get-header ru
a6a0: 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 nsdat))..
a6b0: 3b 3b 20 74 68 69 73 20 69 73 20 22 2d 73 69 6e ;; this is "-sin
a6c0: 63 65 22 20 73 75 70 70 6f 72 74 2e 20 54 68 69 ce" support. Thi
a6d0: 73 20 6c 6f 6f 6b 73 20 61 74 20 6c 61 73 74 20 s looks at last
a6e0: 6d 6f 64 20 74 69 6d 65 73 20 6f 66 20 3c 72 75 mod times of <ru
a6f0: 6e 2d 69 64 3e 2e 64 62 20 66 69 6c 65 73 0a 09 n-id>.db files..
a700: 20 20 20 20 20 20 20 3b 3b 20 61 6e 64 20 63 6f ;; and co
a710: 6c 6c 65 63 74 73 20 74 68 6f 73 65 20 6d 6f 64 llects those mod
a720: 69 66 69 65 64 20 73 69 6e 63 65 20 74 68 65 20 ified since the
a730: 2d 73 69 6e 63 65 20 74 69 6d 65 2e 0a 09 20 20 -since time...
a740: 20 20 20 20 20 28 72 75 6e 73 20 20 20 20 20 20 (runs
a750: 20 20 72 75 6e 73 74 6d 70 29 0a 20 20 20 20 20 runstmp).
a760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a770: 20 20 20 3b 3b 20 28 69 66 20 28 61 6e 64 20 28 ;; (if (and (
a780: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 75 6e 73 74 not (null? runst
a790: 6d 70 29 29 0a 09 09 09 3b 3b 20 20 20 20 20 20 mp))....;;
a7a0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
a7b0: 22 2d 73 69 6e 63 65 22 29 29 0a 09 09 09 3b 3b "-since"))....;;
a7c0: 20 20 20 28 6c 65 74 20 28 28 63 68 61 6e 67 65 (let ((change
a7d0: 64 2d 69 64 73 20 28 64 62 3a 67 65 74 2d 63 68 d-ids (db:get-ch
a7e0: 61 6e 67 65 64 2d 72 75 6e 2d 69 64 73 20 28 73 anged-run-ids (s
a7f0: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 tring->number (a
a800: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 rgs:get-arg "-si
a810: 6e 63 65 22 29 29 29 29 29 0a 09 09 09 3b 3b 20 nce")))))....;;
a820: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
a830: 68 65 64 20 28 63 61 72 20 72 75 6e 73 74 6d 70 hed (car runstmp
a840: 29 29 0a 09 09 09 3b 3b 20 20 20 09 20 20 20 20 ))....;; .
a850: 20 28 74 61 6c 20 28 63 64 72 20 72 75 6e 73 74 (tal (cdr runst
a860: 6d 70 29 29 0a 09 09 09 3b 3b 20 20 20 09 20 20 mp))....;; .
a870: 20 20 20 28 72 65 73 20 27 28 29 29 29 0a 09 09 (res '()))...
a880: 09 3b 3b 20 20 20 20 20 20 20 28 6c 65 74 20 28 .;; (let (
a890: 28 6e 65 77 2d 72 65 73 20 28 69 66 20 28 6d 65 (new-res (if (me
a8a0: 6d 62 65 72 20 28 64 62 3a 67 65 74 2d 76 61 6c mber (db:get-val
a8b0: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 68 65 64 ue-by-header hed
a8c0: 20 68 65 61 64 65 72 20 22 69 64 22 29 20 63 68 header "id") ch
a8d0: 61 6e 67 65 64 2d 69 64 73 29 0a 09 09 09 3b 3b anged-ids)....;;
a8e0: 20 20 20 09 09 20 20 20 20 20 20 20 28 63 6f 6e .. (con
a8f0: 73 20 68 65 64 20 72 65 73 29 0a 09 09 09 3b 3b s hed res)....;;
a900: 20 20 20 09 09 20 20 20 20 20 20 20 72 65 73 29 .. res)
a910: 29 29 0a 09 09 09 3b 3b 20 20 20 20 20 20 20 20 ))....;;
a920: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 (if (null? tal)
a930: 0a 09 09 09 3b 3b 20 20 20 09 20 20 28 72 65 76 ....;; . (rev
a940: 65 72 73 65 20 6e 65 77 2d 72 65 73 29 0a 09 09 erse new-res)...
a950: 09 3b 3b 20 20 20 09 20 20 28 6c 6f 6f 70 20 28 .;; . (loop (
a960: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal
a970: 29 20 6e 65 77 2d 72 65 73 29 29 29 29 29 0a 09 ) new-res)))))..
a980: 09 09 3b 3b 20 20 20 72 75 6e 73 74 6d 70 29 29 ..;; runstmp))
a990: 0a 09 20 20 20 20 20 20 20 28 64 62 2d 74 61 72 .. (db-tar
a9a0: 67 65 74 73 20 20 28 61 72 67 73 3a 67 65 74 2d gets (args:get-
a9b0: 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 61 arg "-list-db-ta
a9c0: 72 67 65 74 73 22 29 29 0a 09 20 20 20 20 20 20 rgets"))..
a9d0: 20 28 73 65 65 6e 20 20 20 20 20 20 20 20 28 6d (seen (m
a9e0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
a9f0: 0a 09 20 20 20 20 20 20 20 28 64 6d 6f 64 65 20 .. (dmode
aa00: 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 20 28 (let ((d (
aa10: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
aa20: 75 6d 70 6d 6f 64 65 22 29 29 29 0a 09 09 09 20 umpmode")))....
aa30: 20 20 20 20 20 28 69 66 20 64 20 28 73 74 72 69 (if d (stri
aa40: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 64 29 20 23 66 ng->symbol d) #f
aa50: 29 29 29 0a 09 20 20 20 20 20 20 20 28 64 61 74 ))).. (dat
aa60: 61 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 a (make-h
aa70: 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 20 ash-table))..
aa80: 20 20 20 20 28 66 69 65 6c 64 73 2d 73 70 65 63 (fields-spec
aa90: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
aaa0: 72 67 20 22 2d 66 69 65 6c 64 73 22 29 0a 09 09 rg "-fields")...
aab0: 09 09 28 65 78 74 72 61 63 74 2d 66 69 65 6c 64 ..(extract-field
aac0: 73 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 28 61 s-constraints (a
aad0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 66 69 rgs:get-arg "-fi
aae0: 65 6c 64 73 22 29 29 0a 09 09 09 09 28 6c 69 73 elds")).....(lis
aaf0: 74 20 28 63 6f 6e 73 20 22 72 75 6e 73 22 20 28 t (cons "runs" (
ab00: 61 70 70 65 6e 64 20 6b 65 79 73 20 28 6c 69 73 append keys (lis
ab10: 74 20 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 t "id" "runname"
ab20: 20 22 73 74 61 74 65 22 20 22 73 74 61 74 75 73 "state" "status
ab30: 22 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 " "owner" "event
ab40: 5f 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 _time" "comment"
ab50: 20 22 66 61 69 6c 5f 63 6f 75 6e 74 22 20 22 70 "fail_count" "p
ab60: 61 73 73 5f 63 6f 75 6e 74 22 29 29 29 0a 09 09 ass_count")))...
ab70: 09 09 20 20 20 20 20 20 28 63 6f 6e 73 20 22 74 .. (cons "t
ab80: 65 73 74 73 22 20 20 64 62 3a 74 65 73 74 2d 72 ests" db:test-r
ab90: 65 63 6f 72 64 2d 66 69 65 6c 64 73 29 20 3b 3b ecord-fields) ;;
aba0: 20 22 69 64 22 20 22 74 65 73 74 6e 61 6d 65 22 "id" "testname"
abb0: 20 22 74 65 73 74 5f 70 61 74 68 22 29 0a 09 09 "test_path")...
abc0: 09 09 20 20 20 20 20 20 28 6c 69 73 74 20 22 73 .. (list "s
abd0: 74 65 70 73 22 20 22 69 64 22 20 22 73 74 65 70 teps" "id" "step
abe0: 6e 61 6d 65 22 29 29 29 29 0a 09 20 20 20 20 20 name"))))..
abf0: 20 20 28 72 75 6e 73 2d 73 70 65 63 20 20 20 28 (runs-spec (
ac00: 6c 65 74 20 28 28 72 20 28 61 6c 69 73 74 2d 72 let ((r (alist-r
ac10: 65 66 20 22 72 75 6e 73 22 20 20 66 69 65 6c 64 ef "runs" field
ac20: 73 2d 73 70 65 63 20 65 71 75 61 6c 3f 29 29 29 s-spec equal?)))
ac30: 20 3b 3b 20 74 68 65 20 63 68 65 63 6b 20 69 73 ;; the check is
ac40: 20 6e 6f 77 20 75 6e 6e 65 63 65 73 73 61 72 79 now unnecessary
ac50: 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 61 .... (if (a
ac60: 6e 64 20 72 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f nd r (not (null?
ac70: 20 72 29 29 29 20 72 20 28 6c 69 73 74 20 22 69 r))) r (list "i
ac80: 64 22 20 29 29 29 29 0a 09 20 20 20 20 20 20 20 d" ))))..
ac90: 28 74 65 73 74 73 2d 73 70 65 63 20 20 28 6c 65 (tests-spec (le
aca0: 74 20 28 28 74 20 28 61 6c 69 73 74 2d 72 65 66 t ((t (alist-ref
acb0: 20 22 74 65 73 74 73 22 20 66 69 65 6c 64 73 2d "tests" fields-
acc0: 73 70 65 63 20 65 71 75 61 6c 3f 29 29 29 0a 09 spec equal?)))..
acd0: 09 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 .. (if (and
ace0: 20 74 20 28 6e 75 6c 6c 3f 20 74 29 29 20 3b 3b t (null? t)) ;;
acf0: 20 61 6c 6c 20 66 69 65 6c 64 73 0a 09 09 09 09 all fields.....
ad00: 20 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 db:test-record
ad10: 2d 66 69 65 6c 64 73 0a 09 09 09 09 20 20 74 29 -fields..... t)
ad20: 29 29 0a 09 20 20 20 20 20 20 20 28 61 64 6a 2d )).. (adj-
ad30: 74 65 73 74 73 2d 73 70 65 63 20 28 64 65 6c 65 tests-spec (dele
ad40: 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 28 69 te-duplicates (i
ad50: 66 20 74 65 73 74 73 2d 73 70 65 63 20 28 63 6f f tests-spec (co
ad60: 6e 73 20 22 69 64 22 20 74 65 73 74 73 2d 73 70 ns "id" tests-sp
ad70: 65 63 29 20 64 62 3a 74 65 73 74 2d 72 65 63 6f ec) db:test-reco
ad80: 72 64 2d 66 69 65 6c 64 73 29 29 29 20 3b 3b 20 rd-fields))) ;;
ad90: 27 28 22 69 64 22 29 29 29 29 0a 09 20 20 20 20 '("id"))))..
ada0: 20 20 20 28 73 74 65 70 73 2d 73 70 65 63 20 20 (steps-spec
adb0: 28 61 6c 69 73 74 2d 72 65 66 20 22 73 74 65 70 (alist-ref "step
adc0: 73 22 20 66 69 65 6c 64 73 2d 73 70 65 63 20 65 s" fields-spec e
add0: 71 75 61 6c 3f 29 29 0a 09 20 20 20 20 20 20 20 qual?))..
ade0: 28 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 (test-field-inde
adf0: 78 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 x (make-hash-tab
ae00: 6c 65 29 29 29 0a 09 20 20 28 69 66 20 28 61 6e le))).. (if (an
ae10: 64 20 74 65 73 74 73 2d 73 70 65 63 20 28 6e 6f d tests-spec (no
ae20: 74 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 2d 73 t (null? tests-s
ae30: 70 65 63 29 29 29 20 3b 3b 20 64 6f 20 73 6f 6d pec))) ;; do som
ae40: 65 20 76 61 6c 69 64 61 74 69 6f 6e 20 61 6e 64 e validation and
ae50: 20 70 72 6f 63 65 73 73 69 6e 67 20 6f 66 20 74 processing of t
ae60: 68 65 20 74 65 73 74 2d 73 70 65 63 0a 09 20 20 he test-spec..
ae70: 20 20 20 20 28 6c 65 74 20 28 28 69 6e 76 61 6c (let ((inval
ae80: 69 64 2d 74 65 73 74 73 2d 73 70 65 63 20 28 66 id-tests-spec (f
ae90: 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 ilter (lambda (x
aea0: 29 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 78 20 )(not (member x
aeb0: 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 db:test-record-f
aec0: 69 65 6c 64 73 29 29 29 20 74 65 73 74 73 2d 73 ields))) tests-s
aed0: 70 65 63 29 29 29 0a 09 09 28 69 66 20 28 6e 75 pec)))...(if (nu
aee0: 6c 6c 3f 20 69 6e 76 61 6c 69 64 2d 74 65 73 74 ll? invalid-test
aef0: 73 2d 73 70 65 63 29 0a 09 09 20 20 20 20 3b 3b s-spec)... ;;
af00: 20 67 65 6e 65 72 61 74 65 20 74 68 65 20 6c 6f generate the lo
af10: 6f 6b 75 70 20 6d 61 70 20 74 65 73 74 2d 66 69 okup map test-fi
af20: 65 6c 64 2d 6e 61 6d 65 20 3d 3e 20 69 6e 64 65 eld-name => inde
af30: 78 2d 6e 75 6d 62 65 72 0a 09 09 20 20 20 20 28 x-number... (
af40: 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 let loop ((hed (
af50: 63 61 72 20 61 64 6a 2d 74 65 73 74 73 2d 73 70 car adj-tests-sp
af60: 65 63 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 ec)).... (
af70: 74 61 6c 20 28 63 64 72 20 61 64 6a 2d 74 65 73 tal (cdr adj-tes
af80: 74 73 2d 73 70 65 63 29 29 0a 09 09 09 20 20 20 ts-spec))....
af90: 20 20 20 20 28 69 64 78 20 30 29 29 0a 09 09 20 (idx 0))...
afa0: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
afb0: 2d 73 65 74 21 20 74 65 73 74 2d 66 69 65 6c 64 -set! test-field
afc0: 2d 69 6e 64 65 78 20 68 65 64 20 69 64 78 29 0a -index hed idx).
afd0: 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not
afe0: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 28 6c 6f (null? tal))(lo
aff0: 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 op (car tal)(cdr
b000: 20 74 61 6c 29 28 2b 20 69 64 78 20 31 29 29 29 tal)(+ idx 1)))
b010: 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 )... (begin..
b020: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
b030: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
b040: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
b050: 49 6e 76 61 6c 69 64 20 74 65 73 74 20 66 69 65 Invalid test fie
b060: 6c 64 73 20 73 70 65 63 69 66 69 65 64 3a 20 22 lds specified: "
b070: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
b080: 65 72 73 65 20 69 6e 76 61 6c 69 64 2d 74 65 73 erse invalid-tes
b090: 74 73 2d 73 70 65 63 20 22 2c 20 22 29 29 0a 09 ts-spec ", "))..
b0a0: 09 20 20 20 20 20 20 28 65 78 69 74 29 29 29 29 . (exit))))
b0b0: 29 0a 0a 09 20 20 3b 3b 20 45 61 63 68 20 72 75 )... ;; Each ru
b0c0: 6e 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 20 0a n.. (for-each .
b0d0: 09 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e . (lambda (run
b0e0: 29 0a 09 20 20 20 20 20 28 6c 65 74 20 28 28 74 ).. (let ((t
b0f0: 61 72 67 65 74 73 74 72 20 28 73 74 72 69 6e 67 argetstr (string
b100: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 -intersperse (ma
b110: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 p (lambda (x)...
b120: 09 09 09 09 09 20 28 64 62 3a 67 65 74 2d 76 61 ..... (db:get-va
b130: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
b140: 6e 20 68 65 61 64 65 72 20 78 29 29 0a 09 09 09 n header x))....
b150: 09 09 09 20 20 20 20 20 20 20 6b 65 79 73 29 20 ... keys)
b160: 22 2f 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 "/"))).. (
b170: 69 66 20 64 62 2d 74 61 72 67 65 74 73 0a 09 09 if db-targets...
b180: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 (if (not (has
b190: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
b1a0: 75 6c 74 20 73 65 65 6e 20 74 61 72 67 65 74 73 ult seen targets
b1b0: 74 72 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 tr #f))...
b1c0: 20 28 62 65 67 69 6e 0a 09 09 09 20 28 68 61 73 (begin.... (has
b1d0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 65 65 h-table-set! see
b1e0: 6e 20 74 61 72 67 65 74 73 74 72 20 23 74 29 0a n targetstr #t).
b1f0: 09 09 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 5b ... ;; (print "[
b200: 22 20 74 61 72 67 65 74 73 74 72 20 22 5d 22 29 " targetstr "]")
b210: 29 29 29 0a 09 09 09 20 28 69 66 20 28 6e 6f 74 ))).... (if (not
b220: 20 64 6d 6f 64 65 29 0a 09 09 09 20 20 20 20 20 dmode)....
b230: 28 70 72 69 6e 74 20 74 61 72 67 65 74 73 74 72 (print targetstr
b240: 29 0a 09 09 09 20 20 20 20 20 28 68 61 73 68 2d ).... (hash-
b250: 74 61 62 6c 65 2d 73 65 74 21 20 64 61 74 61 20 table-set! data
b260: 22 74 61 72 67 65 74 73 22 20 28 63 6f 6e 73 20 "targets" (cons
b270: 74 61 72 67 65 74 73 74 72 20 28 68 61 73 68 2d targetstr (hash-
b280: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
b290: 74 20 64 61 74 61 20 22 74 61 72 67 65 74 73 22 t data "targets"
b2a0: 20 27 28 29 29 29 29 0a 09 09 09 20 20 20 20 20 '())))....
b2b0: 29 29 29 0a 09 09 20 20 20 28 6c 65 74 2a 20 28 )))... (let* (
b2c0: 28 72 75 6e 2d 69 64 20 20 28 64 62 3a 67 65 74 (run-id (db:get
b2d0: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
b2e0: 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 64 22 run header "id"
b2f0: 29 29 0a 09 09 09 20 20 28 72 75 6e 6e 61 6d 65 )).... (runname
b300: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
b310: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
b320: 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 20 der "runname"))
b330: 0a 09 09 09 20 20 28 73 74 61 74 65 73 20 20 28 .... (states (
b340: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 6f 72 string-split (or
b350: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
b360: 2d 73 74 61 74 65 22 29 20 22 22 29 20 22 2c 22 -state") "") ","
b370: 29 29 0a 09 09 09 20 20 28 73 74 61 74 75 73 65 )).... (statuse
b380: 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 s (string-split
b390: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
b3a0: 67 20 22 2d 73 74 61 74 75 73 22 29 20 22 22 29 g "-status") "")
b3b0: 20 22 2c 22 29 29 0a 09 09 09 20 20 28 74 65 73 ",")).... (tes
b3c0: 74 73 20 20 20 28 69 66 20 74 65 73 74 73 2d 73 ts (if tests-s
b3d0: 70 65 63 0a 09 09 09 09 20 20 20 20 20 20 20 28 pec..... (
b3e0: 64 62 3a 64 69 73 70 61 74 63 68 2d 71 75 65 72 db:dispatch-quer
b3f0: 79 20 61 63 63 65 73 73 2d 6d 6f 64 65 20 72 6d y access-mode rm
b400: 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d t:get-tests-for-
b410: 72 75 6e 20 64 62 3a 67 65 74 2d 74 65 73 74 73 run db:get-tests
b420: 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 64 20 -for-run run-id
b430: 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 testpatt states
b440: 73 74 61 74 75 73 65 73 20 23 66 20 23 66 20 23 statuses #f #f #
b450: 66 20 27 74 65 73 74 6e 61 6d 65 20 27 61 73 63 f 'testname 'asc
b460: 20 3b 3b 20 28 64 62 3a 67 65 74 2d 74 65 73 74 ;; (db:get-test
b470: 73 2d 66 6f 72 2d 72 75 6e 20 64 62 73 74 72 75 s-for-run dbstru
b480: 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 ct run-id testpa
b490: 74 74 20 27 28 29 20 27 28 29 20 23 66 20 23 66 tt '() '() #f #f
b4a0: 20 23 66 20 27 74 65 73 74 6e 61 6d 65 20 27 61 #f 'testname 'a
b4b0: 73 63 20 0a 09 09 09 09 09 09 09 20 20 20 20 20 sc ........
b4c0: 3b 3b 20 75 73 65 20 71 72 79 76 61 6c 73 20 69 ;; use qryvals i
b4d0: 66 20 74 65 73 74 2d 73 70 65 63 20 70 72 6f 76 f test-spec prov
b4e0: 69 64 65 64 0a 09 09 09 09 09 09 09 20 20 20 20 ided........
b4f0: 20 28 69 66 20 74 65 73 74 73 2d 73 70 65 63 0a (if tests-spec.
b500: 09 09 09 09 09 09 09 09 20 28 73 74 72 69 6e 67 ........ (string
b510: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 61 64 6a -intersperse adj
b520: 2d 74 65 73 74 73 2d 73 70 65 63 20 22 2c 22 29 -tests-spec ",")
b530: 0a 09 09 09 09 09 09 09 09 20 3b 3b 20 64 62 3a ......... ;; db:
b540: 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c test-record-fiel
b550: 64 73 0a 09 09 09 09 09 09 09 09 20 23 66 29 0a ds......... #f).
b560: 09 09 09 09 09 09 09 20 20 20 20 20 23 66 0a 09 ....... #f..
b570: 09 09 09 09 09 09 20 20 20 20 20 27 6e 6f 72 6d ...... 'norm
b580: 61 6c 29 0a 09 09 09 09 20 20 20 20 20 20 20 27 al)..... '
b590: 28 29 29 29 29 0a 09 09 20 20 20 20 20 28 63 61 ())))... (ca
b5a0: 73 65 20 64 6d 6f 64 65 0a 09 09 20 20 20 20 20 se dmode...
b5b0: 20 20 28 28 6a 73 6f 6e 20 6f 64 73 29 0a 09 09 ((json ods)...
b5c0: 09 28 69 66 20 72 75 6e 73 2d 73 70 65 63 0a 09 .(if runs-spec..
b5d0: 09 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 .. (for-each
b5e0: 0a 09 09 09 20 20 20 20 20 28 6c 61 6d 62 64 61 .... (lambda
b5f0: 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 (field-name)...
b600: 09 20 20 20 20 20 20 20 28 6d 75 74 69 6c 73 3a . (mutils:
b610: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
b620: 74 61 20 28 63 6f 6e 63 20 28 64 62 3a 67 65 74 ta (conc (db:get
b630: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
b640: 20 72 75 6e 20 68 65 61 64 65 72 20 66 69 65 6c run header fiel
b650: 64 2d 6e 61 6d 65 29 29 20 74 61 72 67 65 74 73 d-name)) targets
b660: 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 tr runname "meta
b670: 22 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 0a 09 " field-name))..
b680: 09 09 20 20 20 20 20 72 75 6e 73 2d 73 70 65 63 .. runs-spec
b690: 29 29 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c )))....;; (mutil
b6a0: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
b6b0: 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 6c data (db:get-val
b6c0: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
b6d0: 20 68 65 61 64 65 72 20 22 73 74 61 74 75 73 22 header "status"
b6e0: 29 20 20 20 20 20 74 61 72 67 65 74 73 74 72 20 ) targetstr
b6f0: 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 runname "meta" "
b700: 73 74 61 74 75 73 22 20 20 20 20 20 29 0a 09 09 status" )...
b710: 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 .;; (mutils:hier
b720: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 hash-set! data (
b730: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
b740: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
b750: 72 20 22 73 74 61 74 65 22 29 20 20 20 20 20 20 r "state")
b760: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
b770: 65 20 22 6d 65 74 61 22 20 22 73 74 61 74 65 22 e "meta" "state"
b780: 20 20 20 20 20 20 29 0a 09 09 09 3b 3b 20 28 6d )....;; (m
b790: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
b7a0: 65 74 21 20 64 61 74 61 20 28 63 6f 6e 63 20 28 et! data (conc (
b7b0: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
b7c0: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
b7d0: 72 20 22 69 64 22 29 29 20 20 74 61 72 67 65 74 r "id")) target
b7e0: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 str runname "met
b7f0: 61 22 20 22 69 64 22 20 20 20 20 20 20 20 20 20 a" "id"
b800: 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a )....;; (mutils:
b810: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
b820: 74 61 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 ta (db:get-value
b830: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
b840: 65 61 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d eader "event_tim
b850: 65 22 29 20 74 61 72 67 65 74 73 74 72 20 72 75 e") targetstr ru
b860: 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 65 76 nname "meta" "ev
b870: 65 6e 74 5f 74 69 6d 65 22 20 29 0a 09 09 09 3b ent_time" )....;
b880: 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 ; (mutils:hierha
b890: 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 64 62 sh-set! data (db
b8a0: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
b8b0: 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 ader run header
b8c0: 22 63 6f 6d 6d 65 6e 74 22 29 20 20 20 20 74 61 "comment") ta
b8d0: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
b8e0: 22 6d 65 74 61 22 20 22 63 6f 6d 6d 65 6e 74 22 "meta" "comment"
b8f0: 20 20 20 20 29 0a 09 09 09 3b 3b 20 3b 3b 20 61 )....;; ;; a
b900: 64 64 20 6c 61 73 74 20 65 6e 74 72 79 20 74 77 dd last entry tw
b910: 69 63 65 20 2d 20 73 65 65 6d 73 20 74 6f 20 62 ice - seems to b
b920: 65 20 61 20 62 75 67 20 69 6e 20 68 69 65 72 68 e a bug in hierh
b930: 61 73 68 3f 0a 09 09 09 3b 3b 20 28 6d 75 74 69 ash?....;; (muti
b940: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
b950: 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 data (db:get-va
b960: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
b970: 6e 20 68 65 61 64 65 72 20 22 63 6f 6d 6d 65 6e n header "commen
b980: 74 22 29 20 20 20 20 74 61 72 67 65 74 73 74 72 t") targetstr
b990: 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 runname "meta"
b9a0: 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 29 0a 09 "comment" )..
b9b0: 09 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 09 . (else...
b9c0: 09 28 69 66 20 28 6e 75 6c 6c 3f 20 72 75 6e 73 .(if (null? runs
b9d0: 2d 73 70 65 63 29 0a 09 09 09 20 20 20 20 28 70 -spec).... (p
b9e0: 72 69 6e 74 20 22 52 75 6e 3a 20 22 20 74 61 72 rint "Run: " tar
b9f0: 67 65 74 73 74 72 20 22 2f 22 20 72 75 6e 6e 61 getstr "/" runna
ba00: 6d 65 20 0a 09 09 09 09 20 20 20 22 20 73 74 61 me ..... " sta
ba10: 74 75 73 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 tus: " (db:get-v
ba20: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
ba30: 75 6e 20 68 65 61 64 65 72 20 22 73 74 61 74 65 un header "state
ba40: 22 29 0a 09 09 09 09 20 20 20 22 20 72 75 6e 2d ")..... " run-
ba50: 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 2c 20 id: " run-id ",
ba60: 6e 75 6d 62 65 72 20 74 65 73 74 73 3a 20 22 20 number tests: "
ba70: 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 0a 09 (length tests)..
ba80: 09 09 09 20 20 20 22 20 65 76 65 6e 74 5f 74 69 ... " event_ti
ba90: 6d 65 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 61 me: " (db:get-va
baa0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
bab0: 6e 20 68 65 61 64 65 72 20 22 65 76 65 6e 74 5f n header "event_
bac0: 74 69 6d 65 22 29 29 0a 09 09 09 20 20 20 20 28 time")).... (
bad0: 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 begin.... (
bae0: 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 if (not (member
baf0: 22 74 61 72 67 65 74 22 20 72 75 6e 73 2d 73 70 "target" runs-sp
bb00: 65 63 29 29 0a 09 09 09 20 20 20 20 20 20 20 20 ec))....
bb10: 20 20 3b 3b 20 28 64 69 73 70 6c 61 79 20 28 63 ;; (display (c
bb20: 6f 6e 63 20 22 54 61 72 67 65 74 3a 20 22 20 74 onc "Target: " t
bb30: 61 72 67 65 74 73 74 72 29 29 0a 09 09 09 20 20 argetstr))....
bb40: 20 20 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 (display
bb50: 20 28 63 6f 6e 63 20 22 52 75 6e 3a 20 22 20 74 (conc "Run: " t
bb60: 61 72 67 65 74 73 74 72 20 22 2f 22 20 72 75 6e argetstr "/" run
bb70: 6e 61 6d 65 20 22 20 22 29 29 29 0a 09 09 09 20 name " ")))....
bb80: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 (for-each..
bb90: 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda
bba0: 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 (field-name)...
bbb0: 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f 20 66 .. (if (equal? f
bbc0: 69 65 6c 64 2d 6e 61 6d 65 20 22 74 61 72 67 65 ield-name "targe
bbd0: 74 22 29 0a 09 09 09 09 20 20 20 20 20 28 64 69 t")..... (di
bbe0: 73 70 6c 61 79 20 28 63 6f 6e 63 20 22 74 61 72 splay (conc "tar
bbf0: 67 65 74 3a 20 22 20 74 61 72 67 65 74 73 74 72 get: " targetstr
bc00: 20 22 20 22 29 29 0a 09 09 09 09 20 20 20 20 20 " ")).....
bc10: 28 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 66 (display (conc f
bc20: 69 65 6c 64 2d 6e 61 6d 65 20 22 3a 20 22 20 28 ield-name ": " (
bc30: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
bc40: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
bc50: 72 20 28 63 6f 6e 63 20 66 69 65 6c 64 2d 6e 61 r (conc field-na
bc60: 6d 65 29 29 20 22 20 22 29 29 29 29 0a 09 09 09 me)) " "))))....
bc70: 20 20 20 20 20 20 20 72 75 6e 73 2d 73 70 65 63 runs-spec
bc80: 29 0a 09 09 09 20 20 20 20 20 20 28 6e 65 77 6c ).... (newl
bc90: 69 6e 65 29 29 29 29 29 0a 09 09 20 20 20 20 20 ine)))))...
bca0: 20 20 0a 09 09 20 20 20 20 20 28 66 6f 72 2d 65 ... (for-e
bcb0: 61 63 68 20 0a 09 09 20 20 20 20 20 20 28 6c 61 ach ... (la
bcc0: 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 20 20 mbda (test)...
bcd0: 20 20 20 20 09 28 68 61 6e 64 6c 65 2d 65 78 63 .(handle-exc
bce0: 65 70 74 69 6f 6e 73 0a 09 09 09 20 65 78 6e 0a eptions.... exn.
bcf0: 09 09 09 20 28 62 65 67 69 6e 0a 09 09 09 20 20 ... (begin....
bd00: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
bd10: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
bd20: 6f 67 2d 70 6f 72 74 2a 20 22 42 61 64 20 64 61 og-port* "Bad da
bd30: 74 61 20 69 6e 20 74 65 73 74 20 72 65 63 6f 72 ta in test recor
bd40: 64 3f 20 22 20 74 65 73 74 29 0a 09 09 09 20 20 d? " test)....
bd50: 20 28 70 72 69 6e 74 20 22 65 78 6e 3d 22 20 28 (print "exn=" (
bd60: 63 6f 6e 64 69 74 69 6f 6e 2d 3e 6c 69 73 74 20 condition->list
bd70: 65 78 6e 29 29 0a 09 09 09 20 20 20 28 64 65 62 exn)).... (deb
bd80: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
bd90: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 ult-log-port* "
bda0: 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f 6e message: " ((con
bdb0: 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d dition-property-
bdc0: 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d accessor 'exn 'm
bdd0: 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 09 essage) exn))...
bde0: 09 20 20 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d . (print-call-
bdf0: 63 68 61 69 6e 20 28 63 75 72 72 65 6e 74 2d 65 chain (current-e
be00: 72 72 6f 72 2d 70 6f 72 74 29 29 29 0a 09 09 09 rror-port)))....
be10: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 69 64 (let* ((test-id
be20: 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 (if (membe
be30: 72 20 22 69 64 22 20 20 20 20 20 20 20 20 20 20 r "id"
be40: 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 tests-spec)(get
be50: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
be60: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
be70: 65 6c 64 2d 69 6e 64 65 78 20 22 69 64 22 20 20 eld-index "id"
be80: 20 20 20 20 20 20 20 20 29 20 23 66 29 29 20 3b ) #f)) ;
be90: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 ; (db:test-get-i
bea0: 64 20 20 20 20 20 20 20 20 20 74 65 73 74 29 29 d test))
beb0: 0a 09 09 09 09 28 74 65 73 74 6e 61 6d 65 20 20 .....(testname
bec0: 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 (if (member "
bed0: 74 65 73 74 6e 61 6d 65 22 20 20 20 20 20 74 65 testname" te
bee0: 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 sts-spec)(get-va
bef0: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
bf00: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
bf10: 2d 69 6e 64 65 78 20 22 74 65 73 74 6e 61 6d 65 -index "testname
bf20: 22 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 " ) #f)) ;; (
bf30: 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 db:test-get-test
bf40: 6e 61 6d 65 20 20 20 74 65 73 74 29 29 0a 09 09 name test))...
bf50: 09 09 28 69 74 65 6d 70 61 74 68 20 20 20 20 20 ..(itempath
bf60: 28 69 66 20 28 6d 65 6d 62 65 72 20 22 69 74 65 (if (member "ite
bf70: 6d 5f 70 61 74 68 22 20 20 20 20 74 65 73 74 73 m_path" tests
bf80: 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 -spec)(get-value
bf90: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
bfa0: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
bfb0: 64 65 78 20 22 69 74 65 6d 5f 70 61 74 68 22 20 dex "item_path"
bfc0: 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a ) #f)) ;; (db:
bfd0: 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 test-get-item-pa
bfe0: 74 68 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 th test)).....(
bff0: 63 6f 6d 6d 65 6e 74 20 20 20 20 20 20 28 69 66 comment (if
c000: 20 28 6d 65 6d 62 65 72 20 22 63 6f 6d 6d 65 6e (member "commen
c010: 74 22 20 20 20 20 20 20 74 65 73 74 73 2d 73 70 t" tests-sp
c020: 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 ec)(get-value-by
c030: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
c040: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
c050: 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 20 29 "comment" )
c060: 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 #f)) ;; (db:tes
c070: 74 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 20 20 t-get-comment
c080: 20 74 65 73 74 29 29 0a 09 09 09 09 28 74 73 74 test)).....(tst
c090: 61 74 65 20 20 20 20 20 20 20 28 69 66 20 28 6d ate (if (m
c0a0: 65 6d 62 65 72 20 22 73 74 61 74 65 22 20 20 20 ember "state"
c0b0: 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 tests-spec)
c0c0: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
c0d0: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
c0e0: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 73 t-field-index "s
c0f0: 74 61 74 65 22 20 20 20 20 20 20 20 29 20 23 66 tate" ) #f
c100: 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 )) ;; (db:test-g
c110: 65 74 2d 73 74 61 74 65 20 20 20 20 20 20 74 65 et-state te
c120: 73 74 29 29 0a 09 09 09 09 28 74 73 74 61 74 75 st)).....(tstatu
c130: 73 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 s (if (memb
c140: 65 72 20 22 73 74 61 74 75 73 22 20 20 20 20 20 er "status"
c150: 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 tests-spec)(ge
c160: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
c170: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
c180: 69 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 ield-index "stat
c190: 75 73 22 20 20 20 20 20 20 29 20 23 66 29 29 20 us" ) #f))
c1a0: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
c1b0: 73 74 61 74 75 73 20 20 20 20 20 74 65 73 74 29 status test)
c1c0: 29 0a 09 09 09 09 28 65 76 65 6e 74 2d 74 69 6d ).....(event-tim
c1d0: 65 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 e (if (member
c1e0: 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 20 20 74 "event_time" t
c1f0: 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 ests-spec)(get-v
c200: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
c210: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
c220: 64 2d 69 6e 64 65 78 20 22 65 76 65 6e 74 5f 74 d-index "event_t
c230: 69 6d 65 22 20 20 29 20 23 66 29 29 20 3b 3b 20 ime" ) #f)) ;;
c240: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 (db:test-get-eve
c250: 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 29 0a 09 nt_time test))..
c260: 09 09 09 28 72 75 6e 64 69 72 20 20 20 20 20 20 ...(rundir
c270: 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 72 75 (if (member "ru
c280: 6e 64 69 72 22 20 20 20 20 20 20 20 74 65 73 74 ndir" test
c290: 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 s-spec)(get-valu
c2a0: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
c2b0: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
c2c0: 6e 64 65 78 20 22 72 75 6e 64 69 72 22 20 20 20 ndex "rundir"
c2d0: 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 ) #f)) ;; (db
c2e0: 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 :test-get-rundir
c2f0: 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 test)).....
c300: 28 66 69 6e 61 6c 5f 6c 6f 67 66 20 20 20 28 69 (final_logf (i
c310: 66 20 28 6d 65 6d 62 65 72 20 22 66 69 6e 61 6c f (member "final
c320: 5f 6c 6f 67 66 22 20 20 20 74 65 73 74 73 2d 73 _logf" tests-s
c330: 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 pec)(get-value-b
c340: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
c350: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
c360: 78 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 20 x "final_logf"
c370: 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 ) #f)) ;; (db:te
c380: 73 74 2d 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 st-get-final_log
c390: 66 20 74 65 73 74 29 29 0a 09 09 09 09 28 72 75 f test)).....(ru
c3a0: 6e 5f 64 75 72 61 74 69 6f 6e 20 28 69 66 20 28 n_duration (if (
c3b0: 6d 65 6d 62 65 72 20 22 72 75 6e 5f 64 75 72 61 member "run_dura
c3c0: 74 69 6f 6e 22 20 74 65 73 74 73 2d 73 70 65 63 tion" tests-spec
c3d0: 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 )(get-value-by-f
c3e0: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
c3f0: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
c400: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 20 23 run_duration") #
c410: 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d f)) ;; (db:test-
c420: 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e get-run_duration
c430: 20 74 65 73 74 29 29 0a 09 09 09 09 28 66 75 6c test)).....(ful
c440: 6c 6e 61 6d 65 20 20 20 20 20 28 63 6f 6e 63 20 lname (conc
c450: 74 65 73 74 6e 61 6d 65 0a 09 09 09 09 09 09 20 testname.......
c460: 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 (if (equal? i
c470: 74 65 6d 70 61 74 68 20 22 22 29 0a 09 09 09 09 tempath "").....
c480: 09 09 09 22 22 20 0a 09 09 09 09 09 09 09 28 63 ..."" ........(c
c490: 6f 6e 63 20 22 28 22 20 69 74 65 6d 70 61 74 68 onc "(" itempath
c4a0: 20 22 29 22 29 29 29 29 29 0a 09 09 09 20 20 20 ")")))))....
c4b0: 28 63 61 73 65 20 64 6d 6f 64 65 0a 09 09 09 20 (case dmode....
c4c0: 20 20 20 20 28 28 6a 73 6f 6e 20 6f 64 73 29 0a ((json ods).
c4d0: 09 09 09 20 20 20 20 20 20 28 69 66 20 74 65 73 ... (if tes
c4e0: 74 73 2d 73 70 65 63 0a 09 09 09 09 20 20 28 66 ts-spec..... (f
c4f0: 6f 72 2d 65 61 63 68 0a 09 09 09 09 20 20 20 28 or-each..... (
c500: 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 2d 6e 61 lambda (field-na
c510: 6d 65 29 0a 09 09 09 09 20 20 20 20 20 28 6d 75 me)..... (mu
c520: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
c530: 74 21 20 64 61 74 61 20 20 28 67 65 74 2d 76 61 t! data (get-va
c540: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
c550: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
c560: 2d 69 6e 64 65 78 20 66 69 65 6c 64 2d 6e 61 6d -index field-nam
c570: 65 29 20 74 61 72 67 65 74 73 74 72 20 72 75 6e e) targetstr run
c580: 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e name "data" (con
c590: 63 20 74 65 73 74 2d 69 64 29 20 66 69 65 6c 64 c test-id) field
c5a0: 2d 6e 61 6d 65 29 29 0a 09 09 09 09 20 20 20 74 -name))..... t
c5b0: 65 73 74 73 2d 73 70 65 63 29 29 29 0a 09 09 09 ests-spec)))....
c5c0: 20 20 20 20 20 3b 3b 20 3b 3b 20 28 6d 75 74 69 ;; ;; (muti
c5d0: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
c5e0: 20 64 61 74 61 20 20 66 75 6c 6c 6e 61 6d 65 20 data fullname
c5f0: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
c600: 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 ame "data" (conc
c610: 20 74 65 73 74 2d 69 64 29 20 22 74 6e 61 6d 65 test-id) "tname
c620: 22 20 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 " )....
c630: 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 ;; (mutils:hier
c640: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 hash-set! data
c650: 74 65 73 74 6e 61 6d 65 20 20 20 74 61 72 67 65 testname targe
c660: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 tstr runname "da
c670: 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 ta" (conc test-i
c680: 64 29 20 22 74 65 73 74 6e 61 6d 65 22 20 20 29 d) "testname" )
c690: 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 .... ;; (mu
c6a0: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
c6b0: 74 21 20 64 61 74 61 20 20 69 74 65 6d 70 61 74 t! data itempat
c6c0: 68 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 h targetstr ru
c6d0: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
c6e0: 6e 63 20 74 65 73 74 2d 69 64 29 20 22 69 74 65 nc test-id) "ite
c6f0: 6d 70 61 74 68 22 20 20 29 0a 09 09 09 20 20 20 mpath" )....
c700: 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 ;; (mutils:hi
c710: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
c720: 20 20 63 6f 6d 6d 65 6e 74 20 20 20 20 74 61 72 comment tar
c730: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
c740: 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 data" (conc test
c750: 2d 69 64 29 20 22 63 6f 6d 6d 65 6e 74 22 20 20 -id) "comment"
c760: 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 ).... ;; (
c770: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
c780: 73 65 74 21 20 64 61 74 61 20 20 74 73 74 61 74 set! data tstat
c790: 65 20 20 20 20 20 74 61 72 67 65 74 73 74 72 20 e targetstr
c7a0: 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 runname "data" (
c7b0: 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 73 conc test-id) "s
c7c0: 74 61 74 65 22 20 20 20 20 20 29 0a 09 09 09 20 tate" )....
c7d0: 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a ;; (mutils:
c7e0: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
c7f0: 74 61 20 20 74 73 74 61 74 75 73 20 20 20 20 74 ta tstatus t
c800: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
c810: 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 "data" (conc te
c820: 73 74 2d 69 64 29 20 22 73 74 61 74 75 73 22 20 st-id) "status"
c830: 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 ).... ;;
c840: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
c850: 68 2d 73 65 74 21 20 64 61 74 61 20 20 72 75 6e h-set! data run
c860: 64 69 72 20 20 20 20 20 74 61 72 67 65 74 73 74 dir targetst
c870: 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 r runname "data"
c880: 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 (conc test-id)
c890: 22 72 75 6e 64 69 72 22 20 20 20 20 29 0a 09 09 "rundir" )...
c8a0: 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c . ;; (mutil
c8b0: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
c8c0: 64 61 74 61 20 20 66 69 6e 61 6c 5f 6c 6f 67 66 data final_logf
c8d0: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
c8e0: 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 me "data" (conc
c8f0: 74 65 73 74 2d 69 64 29 20 22 66 69 6e 61 6c 5f test-id) "final_
c900: 6c 6f 67 66 22 29 0a 09 09 09 20 20 20 20 20 3b logf").... ;
c910: 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ; (mutils:hierh
c920: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 72 ash-set! data r
c930: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 61 72 67 un_duration targ
c940: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 etstr runname "d
c950: 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d ata" (conc test-
c960: 69 64 29 20 22 72 75 6e 5f 64 75 72 61 74 69 6f id) "run_duratio
c970: 6e 22 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 n").... ;;
c980: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
c990: 2d 73 65 74 21 20 64 61 74 61 20 20 65 76 65 6e -set! data even
c9a0: 74 2d 74 69 6d 65 20 74 61 72 67 65 74 73 74 72 t-time targetstr
c9b0: 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 runname "data"
c9c0: 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 (conc test-id) "
c9d0: 65 76 65 6e 74 5f 74 69 6d 65 22 29 0a 09 09 09 event_time")....
c9e0: 20 20 20 20 20 3b 3b 20 20 3b 3b 20 61 64 64 20 ;; ;; add
c9f0: 6c 61 73 74 20 65 6e 74 72 79 20 74 77 69 63 65 last entry twice
ca00: 20 2d 20 73 65 65 6d 73 20 74 6f 20 62 65 20 61 - seems to be a
ca10: 20 62 75 67 20 69 6e 20 68 69 65 72 68 61 73 68 bug in hierhash
ca20: 3f 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d ?.... ;; (m
ca30: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
ca40: 65 74 21 20 64 61 74 61 20 20 65 76 65 6e 74 2d et! data event-
ca50: 74 69 6d 65 20 74 61 72 67 65 74 73 74 72 20 72 time targetstr r
ca60: 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 unname "data" (c
ca70: 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 65 76 onc test-id) "ev
ca80: 65 6e 74 5f 74 69 6d 65 22 29 0a 09 09 09 20 20 ent_time")....
ca90: 20 20 20 3b 3b 20 20 29 0a 09 09 09 20 20 20 20 ;; )....
caa0: 20 28 65 6c 73 65 0a 09 09 09 20 20 20 20 20 20 (else....
cab0: 28 69 66 20 28 61 6e 64 20 74 73 74 61 74 65 20 (if (and tstate
cac0: 74 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 tstatus event-ti
cad0: 6d 65 29 0a 09 09 09 09 20 20 28 66 6f 72 6d 61 me)..... (forma
cae0: 74 20 23 74 0a 09 09 09 09 09 20 20 22 20 20 54 t #t...... " T
caf0: 65 73 74 3a 20 7e 32 35 61 20 53 74 61 74 65 3a est: ~25a State:
cb00: 20 7e 31 35 61 20 53 74 61 74 75 73 3a 20 7e 31 ~15a Status: ~1
cb10: 35 61 20 52 75 6e 74 69 6d 65 3a 20 7e 35 40 61 5a Runtime: ~5@a
cb20: 73 20 54 69 6d 65 3a 20 7e 32 32 61 20 48 6f 73 s Time: ~22a Hos
cb30: 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 09 09 09 t: ~10a\n"......
cb40: 20 20 28 69 66 20 66 75 6c 6c 6e 61 6d 65 20 66 (if fullname f
cb50: 75 6c 6c 6e 61 6d 65 20 22 22 29 0a 09 09 09 09 ullname "").....
cb60: 09 20 20 28 69 66 20 74 73 74 61 74 65 20 20 20 . (if tstate
cb70: 74 73 74 61 74 65 20 20 20 22 22 29 0a 09 09 09 tstate "")....
cb80: 09 09 20 20 28 69 66 20 74 73 74 61 74 75 73 20 .. (if tstatus
cb90: 20 74 73 74 61 74 75 73 20 20 22 22 29 0a 09 09 tstatus "")...
cba0: 09 09 09 20 20 28 67 65 74 2d 76 61 6c 75 65 2d ... (get-value-
cbb0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
cbc0: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
cbd0: 65 78 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e ex "run_duration
cbe0: 22 29 3b 3b 28 69 66 20 74 65 73 74 20 20 20 20 ");;(if test
cbf0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru
cc00: 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 29 n_duration test)
cc10: 20 22 22 29 0a 09 09 09 09 09 20 20 28 69 66 20 "")...... (if
cc20: 65 76 65 6e 74 2d 74 69 6d 65 20 65 76 65 6e 74 event-time event
cc30: 2d 74 69 6d 65 20 22 22 29 0a 09 09 09 09 09 20 -time "")......
cc40: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
cc50: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
cc60: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
cc70: 68 6f 73 74 22 29 29 20 3b 3b 28 69 66 20 74 65 host")) ;;(if te
cc80: 73 74 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d st (db:test-get-
cc90: 68 6f 73 74 20 74 65 73 74 29 29 20 22 22 29 0a host test)) "").
cca0: 09 09 09 09 20 20 28 70 72 69 6e 74 20 22 20 20 .... (print "
ccb0: 54 65 73 74 3a 20 22 20 66 75 6c 6c 6e 61 6d 65 Test: " fullname
ccc0: 0a 09 09 09 09 09 20 28 69 66 20 74 73 74 61 74 ...... (if tstat
ccd0: 65 20 20 28 63 6f 6e 63 20 22 20 53 74 61 74 65 e (conc " State
cce0: 3a 20 22 20 20 74 73 74 61 74 65 29 20 20 22 22 : " tstate) ""
ccf0: 29 0a 09 09 09 09 09 20 28 69 66 20 74 73 74 61 )...... (if tsta
cd00: 74 75 73 20 28 63 6f 6e 63 20 22 20 53 74 61 74 tus (conc " Stat
cd10: 75 73 3a 20 22 20 74 73 74 61 74 75 73 29 20 22 us: " tstatus) "
cd20: 22 29 0a 09 09 09 09 09 20 28 69 66 20 28 67 65 ")...... (if (ge
cd30: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
cd40: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
cd50: 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 5f ield-index "run_
cd60: 64 75 72 61 74 69 6f 6e 22 29 0a 09 09 09 09 09 duration")......
cd70: 20 20 20 20 20 28 63 6f 6e 63 20 22 20 52 75 6e (conc " Run
cd80: 74 69 6d 65 3a 20 22 20 28 67 65 74 2d 76 61 6c time: " (get-val
cd90: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
cda0: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
cdb0: 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 61 74 index "run_durat
cdc0: 69 6f 6e 22 29 29 0a 09 09 09 09 09 20 20 20 20 ion"))......
cdd0: 20 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 65 "")...... (if e
cde0: 76 65 6e 74 2d 74 69 6d 65 20 28 63 6f 6e 63 20 vent-time (conc
cdf0: 22 20 54 69 6d 65 3a 20 22 20 65 76 65 6e 74 2d " Time: " event-
ce00: 74 69 6d 65 29 20 22 22 29 0a 09 09 09 09 09 20 time) "")......
ce10: 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 (if (get-value-b
ce20: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
ce30: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
ce40: 78 20 22 68 6f 73 74 22 29 0a 09 09 09 09 09 20 x "host")......
ce50: 20 20 20 20 28 63 6f 6e 63 20 22 20 48 6f 73 74 (conc " Host
ce60: 3a 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 : " (get-value-b
ce70: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
ce80: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
ce90: 78 20 22 68 6f 73 74 22 29 29 0a 09 09 09 09 09 x "host"))......
cea0: 20 20 20 20 20 22 22 29 29 29 0a 09 09 09 20 20 "")))....
ceb0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 (if (not (or
cec0: 20 28 65 71 75 61 6c 3f 20 28 67 65 74 2d 76 61 (equal? (get-va
ced0: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
cee0: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
cef0: 2d 69 6e 64 65 78 20 22 73 74 61 74 75 73 22 29 -index "status")
cf00: 20 22 50 41 53 53 22 29 0a 09 09 09 09 09 20 20 "PASS")......
cf10: 20 28 65 71 75 61 6c 3f 20 28 67 65 74 2d 76 61 (equal? (get-va
cf20: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
cf30: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
cf40: 2d 69 6e 64 65 78 20 22 73 74 61 74 75 73 22 29 -index "status")
cf50: 20 22 57 41 52 4e 22 29 0a 09 09 09 09 09 20 20 "WARN")......
cf60: 20 28 65 71 75 61 6c 3f 20 28 67 65 74 2d 76 61 (equal? (get-va
cf70: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
cf80: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
cf90: 2d 69 6e 64 65 78 20 22 73 74 61 74 65 22 29 20 -index "state")
cfa0: 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 29 "NOT_STARTED"))
cfb0: 29 0a 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 )..... (begin..
cfc0: 09 09 09 20 20 20 20 28 70 72 69 6e 74 20 20 20 ... (print
cfd0: 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 (if (get-value-b
cfe0: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
cff0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
d000: 78 20 22 63 70 75 6c 6f 61 64 22 29 0a 09 09 09 x "cpuload")....
d010: 09 09 09 20 28 63 6f 6e 63 20 22 20 20 20 20 20 ... (conc "
d020: 20 20 20 20 63 70 75 6c 6f 61 64 3a 20 20 22 20 cpuload: "
d030: 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d (get-value-by-
d040: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
d050: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
d060: 22 63 70 75 6c 6f 61 64 22 29 29 0a 09 09 09 09 "cpuload")).....
d070: 09 09 20 22 22 29 20 3b 3b 20 28 64 62 3a 74 65 .. "") ;; (db:te
d080: 73 74 2d 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 st-get-cpuload t
d090: 65 73 74 29 0a 09 09 09 09 09 20 20 20 20 20 28 est)...... (
d0a0: 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 if (get-value-by
d0b0: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
d0c0: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
d0d0: 20 22 64 69 73 6b 66 72 65 65 22 29 0a 09 09 09 "diskfree")....
d0e0: 09 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 20 20 ... (conc "\n
d0f0: 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 3a 20 diskfree:
d100: 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d " (get-value-by-
d110: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
d120: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
d130: 22 64 69 73 6b 66 72 65 65 22 29 29 20 3b 3b 20 "diskfree")) ;;
d140: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 64 69 73 (db:test-get-dis
d150: 6b 66 72 65 65 20 74 65 73 74 29 0a 09 09 09 09 kfree test).....
d160: 09 09 20 22 22 29 0a 09 09 09 09 09 20 20 20 20 .. "")......
d170: 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d (if (get-value-
d180: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
d190: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
d1a0: 65 78 20 22 75 6e 61 6d 65 22 29 0a 09 09 09 09 ex "uname").....
d1b0: 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 20 20 20 .. (conc "\n
d1c0: 20 20 20 20 20 75 6e 61 6d 65 3a 20 20 20 20 22 uname: "
d1d0: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
d1e0: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
d1f0: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
d200: 75 6e 61 6d 65 22 29 29 20 3b 3b 20 28 64 62 3a uname")) ;; (db:
d210: 74 65 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 74 test-get-uname t
d220: 65 73 74 29 0a 09 09 09 09 09 09 20 22 22 29 0a est)....... "").
d230: 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 67 ..... (if (g
d240: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
d250: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
d260: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e field-index "run
d270: 64 69 72 22 29 0a 09 09 09 09 09 09 20 28 63 6f dir")....... (co
d280: 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 20 20 72 nc "\n r
d290: 75 6e 64 69 72 3a 20 20 20 22 20 28 67 65 74 2d undir: " (get-
d2a0: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
d2b0: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
d2c0: 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 64 69 72 ld-index "rundir
d2d0: 22 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d ")) ;; (db:test-
d2e0: 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 get-rundir test)
d2f0: 0a 09 09 09 09 09 09 20 22 22 29 0a 3b 3b 09 09 ....... "").;;..
d300: 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 ... "\n
d310: 20 20 20 20 72 75 6e 64 69 72 3a 20 20 20 22 20 rundir: "
d320: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
d330: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
d340: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 22 t-field-index ""
d350: 29 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 67 ) ;; (sdb:qry 'g
d360: 65 74 73 74 72 20 3b 3b 20 28 66 69 6c 65 64 62 etstr ;; (filedb
d370: 3a 67 65 74 2d 70 61 74 68 20 2a 66 64 62 2a 20 :get-path *fdb*
d380: 0a 3b 3b 20 09 09 09 09 09 20 20 20 20 20 28 64 .;; ..... (d
d390: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 b:test-get-rundi
d3a0: 72 20 74 65 73 74 29 20 3b 3b 20 29 0a 09 09 09 r test) ;; )....
d3b0: 09 09 20 20 20 20 20 29 0a 09 09 09 09 20 20 20 .. ).....
d3c0: 20 3b 3b 20 45 61 63 68 20 74 65 73 74 0a 09 09 ;; Each test...
d3d0: 09 09 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 .. ;; DO NOT
d3e0: 72 65 6d 6f 74 65 20 72 75 6e 0a 09 09 09 09 20 remote run.....
d3f0: 20 20 20 28 6c 65 74 20 28 28 73 74 65 70 73 20 (let ((steps
d400: 28 64 62 3a 64 69 73 70 61 74 63 68 2d 71 75 65 (db:dispatch-que
d410: 72 79 20 61 63 63 65 73 73 2d 6d 6f 64 65 20 72 ry access-mode r
d420: 6d 74 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 mt:get-steps-for
d430: 2d 74 65 73 74 20 64 62 3a 67 65 74 2d 73 74 65 -test db:get-ste
d440: 70 73 2d 66 6f 72 2d 74 65 73 74 20 72 75 6e 2d ps-for-test run-
d450: 69 64 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d id (db:test-get-
d460: 69 64 20 74 65 73 74 29 29 29 29 20 3b 3b 20 28 id test)))) ;; (
d470: 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 db:get-steps-for
d480: 2d 74 65 73 74 20 64 62 73 74 72 75 63 74 20 72 -test dbstruct r
d490: 75 6e 2d 69 64 20 28 64 62 3a 74 65 73 74 2d 67 un-id (db:test-g
d4a0: 65 74 2d 69 64 20 74 65 73 74 29 29 29 29 0a 09 et-id test))))..
d4b0: 09 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 ... (for-ea
d4c0: 63 68 20 0a 09 09 09 09 20 20 20 20 20 20 20 28 ch ..... (
d4d0: 6c 61 6d 62 64 61 20 28 73 74 65 70 29 0a 09 09 lambda (step)...
d4e0: 09 09 09 20 28 66 6f 72 6d 61 74 20 23 74 20 0a ... (format #t .
d4f0: 09 09 09 09 09 09 20 22 20 20 20 20 53 74 65 70 ...... " Step
d500: 3a 20 7e 32 30 61 20 53 74 61 74 65 3a 20 7e 31 : ~20a State: ~1
d510: 30 61 20 53 74 61 74 75 73 3a 20 7e 31 30 61 20 0a Status: ~10a
d520: 54 69 6d 65 20 7e 32 32 61 5c 6e 22 0a 09 09 09 Time ~22a\n"....
d530: 09 09 09 20 28 74 64 62 3a 73 74 65 70 2d 67 65 ... (tdb:step-ge
d540: 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 70 29 t-stepname step)
d550: 0a 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 ....... (tdb:ste
d560: 70 2d 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 p-get-state step
d570: 29 0a 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 )....... (tdb:st
d580: 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 ep-get-status st
d590: 65 70 29 0a 09 09 09 09 09 09 20 28 74 64 62 3a ep)....... (tdb:
d5a0: 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
d5b0: 69 6d 65 20 73 74 65 70 29 29 29 0a 09 09 09 09 ime step))).....
d5c0: 20 20 20 20 20 20 20 73 74 65 70 73 29 29 29 29 steps))))
d5d0: 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 28 69 )))))... (i
d5e0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
d5f0: 22 2d 73 6f 72 74 22 29 0a 09 09 09 20 20 28 73 "-sort").... (s
d600: 6f 72 74 20 74 65 73 74 73 0a 09 09 09 09 28 6c ort tests.....(l
d610: 61 6d 62 64 61 20 28 61 2d 74 65 73 74 20 62 2d ambda (a-test b-
d620: 74 65 73 74 29 0a 09 09 09 09 20 20 28 6c 65 74 test)..... (let
d630: 2a 20 28 28 6b 65 79 20 20 20 20 28 61 72 67 73 * ((key (args
d640: 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f 72 74 22 :get-arg "-sort"
d650: 29 29 0a 09 09 09 09 09 20 28 66 69 72 73 74 20 ))...... (first
d660: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
d670: 69 65 6c 64 6e 61 6d 65 20 61 2d 74 65 73 74 20 ieldname a-test
d680: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
d690: 20 6b 65 79 29 29 0a 09 09 09 09 09 20 28 73 65 key))...... (se
d6a0: 63 6f 6e 64 20 28 67 65 74 2d 76 61 6c 75 65 2d cond (get-value-
d6b0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 62 2d 74 by-fieldname b-t
d6c0: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
d6d0: 6e 64 65 78 20 6b 65 79 29 29 29 0a 09 09 09 09 ndex key))).....
d6e0: 20 20 20 20 28 28 63 6f 6e 64 20 0a 09 09 09 09 ((cond .....
d6f0: 20 20 20 20 20 20 28 28 61 6e 64 20 28 6e 75 6d ((and (num
d700: 62 65 72 3f 20 66 69 72 73 74 29 28 6e 75 6d 62 ber? first)(numb
d710: 65 72 3f 20 73 65 63 6f 6e 64 29 29 20 3c 29 0a er? second)) <).
d720: 09 09 09 09 20 20 20 20 20 20 28 28 61 6e 64 20 .... ((and
d730: 28 73 74 72 69 6e 67 3f 20 66 69 72 73 74 29 28 (string? first)(
d740: 73 74 72 69 6e 67 3f 20 73 65 63 6f 6e 64 29 29 string? second))
d750: 20 73 74 72 69 6e 67 3c 3d 3f 29 0a 09 09 09 09 string<=?).....
d760: 20 20 20 20 20 20 28 65 6c 73 65 20 65 71 75 61 (else equa
d770: 6c 3f 29 29 0a 09 09 09 09 20 20 20 20 20 66 69 l?))..... fi
d780: 72 73 74 20 73 65 63 6f 6e 64 29 29 29 29 0a 09 rst second))))..
d790: 09 09 20 20 74 65 73 74 73 29 29 29 29 29 29 0a .. tests)))))).
d7a0: 09 20 20 20 72 75 6e 73 29 0a 09 20 20 28 69 66 . runs).. (if
d7b0: 20 28 65 71 3f 20 64 6d 6f 64 65 20 27 6a 73 6f (eq? dmode 'jso
d7c0: 6e 29 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 n)(json-write da
d7d0: 74 61 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 ta)).. (let* ((
d7e0: 6d 65 74 61 64 61 74 2d 66 69 65 6c 64 73 20 28 metadat-fields (
d7f0: 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 delete-duplicate
d800: 73 0a 09 09 09 09 20 20 28 61 70 70 65 6e 64 20 s..... (append
d810: 6b 65 79 73 20 27 28 20 22 72 75 6e 6e 61 6d 65 keys '( "runname
d820: 22 20 22 74 69 6d 65 22 20 22 6f 77 6e 65 72 22 " "time" "owner"
d830: 20 22 70 61 73 73 5f 63 6f 75 6e 74 22 20 22 66 "pass_count" "f
d840: 61 69 6c 5f 63 6f 75 6e 74 22 20 22 73 74 61 74 ail_count" "stat
d850: 65 22 20 22 73 74 61 74 75 73 22 20 22 63 6f 6d e" "status" "com
d860: 6d 65 6e 74 22 20 22 69 64 22 29 29 29 29 0a 09 ment" "id"))))..
d870: 09 20 28 72 75 6e 2d 66 69 65 6c 64 73 20 20 20 . (run-fields
d880: 20 27 28 0a 09 09 09 09 20 20 22 74 65 73 74 6e '(..... "testn
d890: 61 6d 65 22 0a 09 09 09 09 20 20 22 69 74 65 6d ame"..... "item
d8a0: 5f 70 61 74 68 22 0a 09 09 09 09 20 20 22 73 74 _path"..... "st
d8b0: 61 74 65 22 0a 09 09 09 09 20 20 22 73 74 61 74 ate"..... "stat
d8c0: 75 73 22 0a 09 09 09 09 20 20 22 63 6f 6d 6d 65 us"..... "comme
d8d0: 6e 74 22 0a 09 09 09 09 20 20 22 65 76 65 6e 74 nt"..... "event
d8e0: 5f 74 69 6d 65 22 0a 09 09 09 09 20 20 22 68 6f _time"..... "ho
d8f0: 73 74 22 0a 09 09 09 09 20 20 22 72 75 6e 5f 69 st"..... "run_i
d900: 64 22 0a 09 09 09 09 20 20 22 72 75 6e 5f 64 75 d"..... "run_du
d910: 72 61 74 69 6f 6e 22 0a 09 09 09 09 20 20 22 61 ration"..... "a
d920: 74 74 65 6d 70 74 6e 75 6d 22 0a 09 09 09 09 20 ttemptnum".....
d930: 20 22 69 64 22 0a 09 09 09 09 20 20 22 61 72 63 "id"..... "arc
d940: 68 69 76 65 64 22 0a 09 09 09 09 20 20 22 64 69 hived"..... "di
d950: 73 6b 66 72 65 65 22 0a 09 09 09 09 20 20 22 63 skfree"..... "c
d960: 70 75 6c 6f 61 64 22 0a 09 09 09 09 20 20 22 66 puload"..... "f
d970: 69 6e 61 6c 5f 6c 6f 67 66 22 0a 09 09 09 09 20 inal_logf".....
d980: 20 22 73 68 6f 72 74 64 69 72 22 0a 09 09 09 09 "shortdir".....
d990: 20 20 22 72 75 6e 64 69 72 22 0a 09 09 09 09 20 "rundir".....
d9a0: 20 22 75 6e 61 6d 65 22 0a 09 09 09 09 20 20 29 "uname"..... )
d9b0: 0a 09 09 09 09 29 0a 09 09 20 28 6e 65 77 64 61 .....)... (newda
d9c0: 74 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d t (comm
d9d0: 6f 6e 3a 74 6f 2d 61 6c 69 73 74 20 64 61 74 61 on:to-alist data
d9e0: 29 29 0a 09 09 20 28 61 6c 6c 72 75 6e 64 61 74 ))... (allrundat
d9f0: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null
da00: 3f 20 6e 65 77 64 61 74 29 0a 09 09 09 09 20 20 ? newdat).....
da10: 20 20 20 20 27 28 29 0a 09 09 09 09 20 20 20 20 '().....
da20: 20 20 28 63 61 72 20 28 6d 61 70 20 63 64 72 20 (car (map cdr
da30: 6e 65 77 64 61 74 29 29 29 29 20 3b 3b 20 28 63 newdat)))) ;; (c
da40: 61 72 20 28 6d 61 70 20 63 64 72 20 28 63 61 72 ar (map cdr (car
da50: 20 28 6d 61 70 20 63 64 72 20 6e 65 77 64 61 74 (map cdr newdat
da60: 29 29 29 29 29 0a 09 09 20 28 72 75 6e 73 20 20 )))))... (runs
da70: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 65 6e (appen
da80: 64 0a 09 09 09 09 20 20 20 28 6c 69 73 74 20 22 d..... (list "
da90: 72 75 6e 73 22 20 3b 3b 20 73 68 65 65 74 6e 61 runs" ;; sheetna
daa0: 6d 65 0a 09 09 09 09 09 20 6d 65 74 61 64 61 74 me...... metadat
dab0: 2d 66 69 65 6c 64 73 29 0a 09 09 09 09 20 20 20 -fields).....
dac0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 75 (map (lambda (ru
dad0: 6e 29 0a 09 09 09 09 09 20 20 3b 3b 20 28 70 72 n)...... ;; (pr
dae0: 69 6e 74 20 22 72 75 6e 3a 20 22 20 72 75 6e 29 int "run: " run)
daf0: 0a 09 09 09 09 09 20 20 28 6c 65 74 2a 20 28 28 ...... (let* ((
db00: 72 75 6e 6e 61 6d 65 20 28 63 61 72 20 72 75 6e runname (car run
db10: 29 29 0a 09 09 09 09 09 09 20 28 72 75 6e 64 61 ))....... (runda
db20: 74 20 20 28 63 64 72 20 72 75 6e 29 29 0a 09 09 t (cdr run))...
db30: 09 09 09 09 20 28 6d 65 74 61 64 61 74 20 28 6c .... (metadat (l
db40: 65 74 20 28 28 74 6d 70 20 28 61 73 73 6f 63 20 et ((tmp (assoc
db50: 22 6d 65 74 61 22 20 72 75 6e 64 61 74 29 29 29 "meta" rundat)))
db60: 0a 09 09 09 09 09 09 09 20 20 20 20 28 69 66 20 ........ (if
db70: 74 6d 70 20 28 63 64 72 20 74 6d 70 29 20 23 66 tmp (cdr tmp) #f
db80: 29 29 29 29 0a 09 09 09 09 09 20 20 20 20 3b 3b ))))...... ;;
db90: 20 28 70 72 69 6e 74 20 22 72 75 6e 6e 61 6d 65 (print "runname
dba0: 3a 20 22 20 72 75 6e 6e 61 6d 65 20 22 5c 6e 5c : " runname "\n\
dbb0: 6e 72 75 6e 64 61 74 3a 20 22 20 29 28 70 70 20 nrundat: " )(pp
dbc0: 72 75 6e 64 61 74 29 28 70 72 69 6e 74 20 22 5c rundat)(print "\
dbd0: 6e 5c 6e 6d 65 74 61 64 61 74 3a 20 22 29 28 70 n\nmetadat: ")(p
dbe0: 70 20 6d 65 74 61 64 61 74 29 0a 09 09 09 09 09 p metadat)......
dbf0: 20 20 20 20 28 69 66 20 6d 65 74 61 64 61 74 0a (if metadat.
dc00: 09 09 09 09 09 09 28 6d 61 70 20 28 6c 61 6d 62 ......(map (lamb
dc10: 64 61 20 28 66 69 65 6c 64 29 0a 09 09 09 09 09 da (field)......
dc20: 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 . (let ((t
dc30: 6d 70 20 28 61 73 73 6f 63 20 66 69 65 6c 64 20 mp (assoc field
dc40: 6d 65 74 61 64 61 74 29 29 29 0a 09 09 09 09 09 metadat)))......
dc50: 09 09 20 28 69 66 20 74 6d 70 20 28 63 64 72 20 .. (if tmp (cdr
dc60: 74 6d 70 29 20 22 22 29 29 29 0a 09 09 09 09 09 tmp) "")))......
dc70: 09 20 20 20 20 20 6d 65 74 61 64 61 74 2d 66 69 . metadat-fi
dc80: 65 6c 64 73 29 0a 09 09 09 09 09 09 28 62 65 67 elds).......(beg
dc90: 69 6e 0a 09 09 09 09 09 09 20 20 28 64 65 62 75 in....... (debu
dca0: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
dcb0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 lt-log-port* "WA
dcc0: 52 4e 49 4e 47 3a 20 6d 65 74 61 20 64 61 74 61 RNING: meta data
dcd0: 20 66 6f 72 20 72 75 6e 20 22 20 72 75 6e 6e 61 for run " runna
dce0: 6d 65 20 22 20 6e 6f 74 20 66 6f 75 6e 64 22 29 me " not found")
dcf0: 0a 09 09 09 09 09 09 20 20 27 28 29 29 29 29 29 ....... '()))))
dd00: 0a 09 09 09 09 09 61 6c 6c 72 75 6e 64 61 74 29 ......allrundat)
dd10: 29 29 0a 09 09 20 3b 3b 20 27 28 20 28 20 22 74 ))... ;; '( ( "t
dd20: 61 72 67 65 74 22 20 28 20 22 72 75 6e 6e 61 6d arget" ( "runnam
dd30: 65 22 20 28 20 22 64 61 74 61 22 20 28 20 22 72 e" ( "data" ( "r
dd40: 75 6e 69 64 22 20 28 20 22 69 64 20 2e 20 22 33 unid" ( "id . "3
dd50: 37 22 20 29 20 28 20 2e 2e 2e 20 29 29 29 29 0a 7" ) ( ... )))).
dd60: 09 09 20 28 72 75 6e 2d 70 61 67 65 73 20 20 20 .. (run-pages
dd70: 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda
dd80: 28 74 61 72 67 64 61 74 29 0a 09 09 09 09 09 28 (targdat)......(
dd90: 6c 65 74 2a 20 28 28 74 61 72 67 65 74 20 20 28 let* ((target (
dda0: 63 61 72 20 74 61 72 67 64 61 74 29 29 0a 09 09 car targdat))...
ddb0: 09 09 09 20 20 20 20 20 20 20 28 72 75 6e 73 64 ... (runsd
ddc0: 61 74 20 28 63 64 72 20 74 61 72 67 64 61 74 29 at (cdr targdat)
ddd0: 29 29 0a 09 09 09 09 09 20 20 28 69 66 20 72 75 ))...... (if ru
dde0: 6e 73 64 61 74 0a 09 09 09 09 09 20 20 20 20 20 nsdat......
ddf0: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 (map (lambda (r
de00: 75 6e 64 61 74 29 0a 09 09 09 09 09 09 20 20 20 undat).......
de10: 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 6e 61 6d (let* ((runnam
de20: 65 20 20 28 63 61 72 20 72 75 6e 64 61 74 29 29 e (car rundat))
de30: 0a 09 09 09 09 09 09 09 20 20 20 20 28 72 75 6e ........ (run
de40: 64 61 74 20 20 20 28 63 64 72 20 72 75 6e 64 61 dat (cdr runda
de50: 74 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 t))........ (
de60: 74 65 73 74 73 64 61 74 20 28 6c 65 74 20 28 28 testsdat (let ((
de70: 74 6d 70 20 28 61 73 73 6f 63 20 22 64 61 74 61 tmp (assoc "data
de80: 22 20 72 75 6e 64 61 74 29 29 29 0a 09 09 09 09 " rundat))).....
de90: 09 09 09 09 09 28 69 66 20 74 6d 70 20 28 63 64 .....(if tmp (cd
dea0: 72 20 74 6d 70 29 20 23 66 29 29 29 29 0a 09 09 r tmp) #f))))...
deb0: 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 74 .... (if t
dec0: 65 73 74 73 64 61 74 0a 09 09 09 09 09 09 09 20 estsdat........
ded0: 20 20 28 6c 65 74 20 28 28 74 65 73 74 73 20 28 (let ((tests (
dee0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 74 65 73 map (lambda (tes
def0: 74 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 t)..........
df00: 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d (let* ((test-
df10: 69 64 20 20 28 63 61 72 20 74 65 73 74 29 29 0a id (car test)).
df20: 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
df30: 28 74 65 73 74 2d 64 61 74 20 28 63 64 72 20 74 (test-dat (cdr t
df40: 65 73 74 29 29 29 0a 09 09 09 09 09 09 09 09 09 est)))..........
df50: 09 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 . (map (lambda (
df60: 66 69 65 6c 64 29 0a 09 09 09 09 09 09 09 09 09 field)..........
df70: 09 09 28 6c 65 74 20 28 28 74 6d 70 20 28 61 73 ..(let ((tmp (as
df80: 73 6f 63 20 66 69 65 6c 64 20 74 65 73 74 2d 64 soc field test-d
df90: 61 74 29 29 29 0a 09 09 09 09 09 09 09 09 09 09 at)))...........
dfa0: 09 20 20 28 69 66 20 74 6d 70 20 28 63 64 72 20 . (if tmp (cdr
dfb0: 74 6d 70 29 20 22 22 29 29 29 0a 09 09 09 09 09 tmp) "")))......
dfc0: 09 09 09 09 09 20 20 20 20 20 20 72 75 6e 2d 66 ..... run-f
dfd0: 69 65 6c 64 73 29 29 29 0a 09 09 09 09 09 09 09 ields)))........
dfe0: 09 09 20 20 20 20 20 74 65 73 74 73 64 61 74 29 .. testsdat)
dff0: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 3b ))........ ;
e000: 3b 20 28 70 72 69 6e 74 20 22 54 61 72 67 65 74 ; (print "Target
e010: 3a 20 22 20 74 61 72 67 65 74 20 22 2f 22 20 72 : " target "/" r
e020: 75 6e 6e 61 6d 65 20 22 20 74 65 73 74 73 3a 22 unname " tests:"
e030: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 3b 3b )........ ;;
e040: 20 28 70 70 20 74 65 73 74 73 29 0a 09 09 09 09 (pp tests).....
e050: 09 09 09 20 20 20 20 20 28 63 6f 6e 73 20 28 63 ... (cons (c
e060: 6f 6e 63 20 74 61 72 67 65 74 20 22 2f 22 20 72 onc target "/" r
e070: 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 09 09 09 unname).........
e080: 20 20 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 28 (cons (list (
e090: 63 6f 6e 63 20 74 61 72 67 65 74 20 22 2f 22 20 conc target "/"
e0a0: 72 75 6e 6e 61 6d 65 29 29 0a 09 09 09 09 09 09 runname)).......
e0b0: 09 09 09 20 28 63 6f 6e 73 20 27 28 29 0a 09 09 ... (cons '()...
e0c0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 ....... (c
e0d0: 6f 6e 73 20 72 75 6e 2d 66 69 65 6c 64 73 20 74 ons run-fields t
e0e0: 65 73 74 73 29 29 29 29 29 0a 09 09 09 09 09 09 ests))))).......
e0f0: 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 . (begin......
e100: 09 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 .. (debug:pr
e110: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
e120: 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e og-port* "WARNIN
e130: 47 3a 20 72 75 6e 20 22 20 74 61 72 67 65 74 20 G: run " target
e140: 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 20 61 70 "/" runname " ap
e150: 70 65 61 72 73 20 74 6f 20 68 61 76 65 20 6e 6f pears to have no
e160: 20 64 61 74 61 22 29 0a 09 09 09 09 09 09 09 20 data")........
e170: 20 20 20 20 3b 3b 20 28 70 70 20 72 75 6e 64 61 ;; (pp runda
e180: 74 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 27 t)........ '
e190: 28 29 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 ())))).......
e1a0: 72 75 6e 73 64 61 74 29 0a 09 09 09 09 09 20 20 runsdat)......
e1b0: 20 20 20 20 27 28 29 29 29 29 0a 09 09 09 09 20 '()))).....
e1c0: 20 20 20 20 20 6e 65 77 64 61 74 29 29 20 3b 3b newdat)) ;;
e1d0: 20 77 65 20 75 73 65 20 6e 65 77 64 61 74 20 74 we use newdat t
e1e0: 6f 20 67 65 74 20 74 61 72 67 65 74 0a 09 09 20 o get target...
e1f0: 28 73 68 65 65 74 73 20 20 20 20 20 20 20 20 20 (sheets
e200: 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 (filter (lambda
e210: 28 78 29 0a 09 09 09 09 09 20 20 20 28 6e 6f 74 (x)...... (not
e220: 20 28 6e 75 6c 6c 3f 20 78 29 29 29 0a 09 09 09 (null? x)))....
e230: 09 09 20 28 63 6f 6e 73 20 72 75 6e 73 20 28 6d .. (cons runs (m
e240: 61 70 20 63 61 72 20 72 75 6e 2d 70 61 67 65 73 ap car run-pages
e250: 29 29 29 29 29 0a 09 20 20 20 20 3b 3b 20 28 70 ))))).. ;; (p
e260: 72 69 6e 74 20 22 61 6c 6c 72 75 6e 64 61 74 3a rint "allrundat:
e270: 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 70 20 61 ").. ;; (pp a
e280: 6c 6c 72 75 6e 64 61 74 29 0a 09 20 20 20 20 3b llrundat).. ;
e290: 3b 20 28 70 72 69 6e 74 20 22 72 75 6e 73 3a 22 ; (print "runs:"
e2a0: 29 0a 09 20 20 20 20 3b 3b 20 28 70 70 20 72 75 ).. ;; (pp ru
e2b0: 6e 73 29 0a 09 20 20 20 20 3b 28 70 72 69 6e 74 ns).. ;(print
e2c0: 20 22 73 68 65 65 74 73 3a 20 22 29 0a 09 20 20 "sheets: ")..
e2d0: 20 20 3b 3b 20 28 70 70 20 73 68 65 65 74 73 29 ;; (pp sheets)
e2e0: 0a 09 20 20 20 20 28 69 66 20 28 65 71 3f 20 64 .. (if (eq? d
e2f0: 6d 6f 64 65 20 27 6f 64 73 29 0a 09 09 28 6c 65 mode 'ods)...(le
e300: 74 2a 20 28 28 74 65 6d 70 64 69 72 20 20 20 20 t* ((tempdir
e310: 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 28 63 (conc "/tmp/" (c
e320: 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 urrent-user-name
e330: 29 20 22 2f 22 20 28 72 61 6e 64 6f 6d 20 31 30 ) "/" (random 10
e340: 30 30 30 29 20 22 5f 22 20 28 63 75 72 72 65 6e 000) "_" (curren
e350: 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 29 0a t-process-id))).
e360: 09 09 20 20 20 20 20 20 20 28 6f 75 74 70 75 74 .. (output
e370: 66 69 6c 65 20 28 6f 72 20 28 61 72 67 73 3a 67 file (or (args:g
e380: 65 74 2d 61 72 67 20 22 2d 6f 22 29 20 22 6f 75 et-arg "-o") "ou
e390: 74 2e 6f 64 73 22 29 29 0a 09 09 20 20 20 20 20 t.ods"))...
e3a0: 20 20 28 6f 75 66 20 20 20 20 20 20 20 20 28 69 (ouf (i
e3b0: 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 f (string-match
e3c0: 28 72 65 67 65 78 70 20 22 5e 5b 2f 7e 5d 2b 2e (regexp "^[/~]+.
e3d0: 2a 22 29 20 6f 75 74 70 75 74 66 69 6c 65 29 20 *") outputfile)
e3e0: 3b 3b 20 66 75 6c 6c 20 70 61 74 68 3f 0a 09 09 ;; full path?...
e3f0: 09 09 20 20 20 20 20 20 20 6f 75 74 70 75 74 66 .. outputf
e400: 69 6c 65 0a 09 09 09 09 20 20 20 20 20 20 20 28 ile..... (
e410: 62 65 67 69 6e 0a 09 09 09 09 09 20 28 64 65 62 begin...... (deb
e420: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
e430: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 ult-log-port* "W
e440: 41 52 4e 49 4e 47 3a 20 70 61 74 68 20 67 69 76 ARNING: path giv
e450: 65 6e 2c 20 22 20 6f 75 74 70 75 74 66 69 6c 65 en, " outputfile
e460: 20 22 20 69 73 20 72 65 6c 61 74 69 76 65 2c 20 " is relative,
e470: 70 72 65 66 69 78 69 6e 67 20 77 69 74 68 20 63 prefixing with c
e480: 75 72 72 65 6e 74 20 64 69 72 65 63 74 6f 72 79 urrent directory
e490: 22 29 0a 09 09 09 09 09 20 28 63 6f 6e 63 20 28 ")...... (conc (
e4a0: 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 current-director
e4b0: 79 29 20 22 2f 22 20 6f 75 74 70 75 74 66 69 6c y) "/" outputfil
e4c0: 65 29 29 29 29 29 0a 09 09 20 20 28 63 72 65 61 e)))))... (crea
e4d0: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 6d te-directory tem
e4e0: 70 64 69 72 20 23 74 29 0a 09 09 20 20 28 6f 64 pdir #t)... (od
e4f0: 73 3a 6c 69 73 74 2d 3e 6f 64 73 20 74 65 6d 70 s:list->ods temp
e500: 64 69 72 20 6f 75 66 20 73 68 65 65 74 73 29 29 dir ouf sheets))
e510: 29 29 0a 09 20 20 3b 3b 20 28 73 79 73 74 65 6d )).. ;; (system
e520: 20 28 63 6f 6e 63 20 22 72 6d 20 2d 72 66 20 22 (conc "rm -rf "
e530: 20 74 65 6d 70 64 69 72 29 29 0a 09 20 20 28 73 tempdir)).. (s
e540: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
e550: 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 20 44 6f g* #t))))..;; Do
e560: 6e 27 74 20 74 68 69 6e 6b 20 49 20 6e 65 65 64 n't think I need
e570: 20 74 68 69 73 2e 20 49 6e 63 6f 72 70 6f 72 61 this. Incorpora
e580: 74 65 64 20 69 6e 74 6f 20 2d 6c 69 73 74 2d 72 ted into -list-r
e590: 75 6e 73 20 69 6e 73 74 65 61 64 0a 3b 3b 0a 3b uns instead.;;.;
e5a0: 3b 20 28 69 66 20 28 61 6e 64 20 28 61 72 67 73 ; (if (and (args
e5b0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 :get-arg "-since
e5c0: 22 29 0a 3b 3b 20 09 20 28 6c 61 75 6e 63 68 3a ").;; . (launch:
e5d0: 73 65 74 75 70 29 29 0a 3b 3b 20 20 20 20 20 28 setup)).;; (
e5e0: 6c 65 74 2a 20 28 28 73 69 6e 63 65 2d 74 69 6d let* ((since-tim
e5f0: 65 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 e (string->numbe
e600: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
e610: 22 2d 73 69 6e 63 65 22 29 29 29 0a 3b 3b 20 09 "-since"))).;; .
e620: 20 20 20 28 72 75 6e 2d 69 64 73 20 20 20 20 28 (run-ids (
e630: 64 62 3a 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 db:get-changed-r
e640: 75 6e 2d 69 64 73 20 73 69 6e 63 65 2d 74 69 6d un-ids since-tim
e650: 65 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 3b 3b e))).;; ;;
e660: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d (rmt:get-tests-
e670: 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 for-runs-mindata
e680: 20 72 75 6e 2d 69 64 73 20 74 65 73 74 70 61 74 run-ids testpat
e690: 74 20 73 74 61 74 65 73 20 73 74 61 74 75 73 20 t states status
e6a0: 6e 6f 74 2d 69 6e 29 0a 3b 3b 20 20 20 20 20 20 not-in).;;
e6b0: 20 28 70 72 69 6e 74 20 28 73 6f 72 74 20 72 75 (print (sort ru
e6c0: 6e 2d 69 64 73 20 3c 29 29 0a 3b 3b 20 20 20 20 n-ids <)).;;
e6d0: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
e6e0: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 20 20 ething* #t))).
e6f0: 20 20 20 20 0a 20 20 20 20 20 20 0a 3b 3b 3d 3d . .;;==
e700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e740: 3d 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e ====.;; full run
e750: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
e760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 =========..;; ge
e7a0: 74 20 6c 6f 63 6b 20 69 6e 20 64 62 20 66 6f 72 t lock in db for
e7b0: 20 66 75 6c 6c 20 72 75 6e 20 66 6f 72 20 74 68 full run for th
e7c0: 69 73 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 is directory.;;
e7d0: 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 20 77 69 for all tests wi
e7e0: 74 68 20 64 65 70 73 0a 3b 3b 20 20 20 77 61 6c th deps.;; wal
e7f0: 6b 20 74 72 65 65 20 6f 66 20 74 65 73 74 73 20 k tree of tests
e800: 74 6f 20 66 69 6e 64 20 68 65 61 64 20 74 61 73 to find head tas
e810: 6b 73 0a 3b 3b 20 20 20 61 64 64 20 68 65 61 64 ks.;; add head
e820: 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 tasks to task q
e830: 75 65 75 65 0a 3b 3b 20 20 20 61 64 64 20 64 65 ueue.;; add de
e840: 70 65 6e 64 61 6e 74 20 74 61 73 6b 73 20 74 6f pendant tasks to
e850: 20 74 61 73 6b 20 71 75 65 75 65 20 0a 3b 3b 20 task queue .;;
e860: 20 20 61 64 64 20 72 65 6d 61 69 6e 69 6e 67 20 add remaining
e870: 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 tasks to task qu
e880: 65 75 65 0a 3b 3b 20 66 6f 72 20 65 61 63 68 20 eue.;; for each
e890: 74 61 73 6b 20 69 6e 20 74 61 73 6b 20 71 75 65 task in task que
e8a0: 75 65 0a 3b 3b 20 20 20 69 66 20 68 61 76 65 20 ue.;; if have
e8b0: 61 64 65 71 75 61 74 65 20 72 65 73 6f 75 72 63 adequate resourc
e8c0: 65 73 0a 3b 3b 20 20 20 20 20 6c 61 75 6e 63 68 es.;; launch
e8d0: 20 74 61 73 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a task.;; else.
e8e0: 3b 3b 20 20 20 20 20 70 75 74 20 74 61 73 6b 20 ;; put task
e8f0: 69 6e 20 64 65 66 65 72 72 65 64 20 71 75 65 75 in deferred queu
e900: 65 0a 3b 3b 20 69 66 20 73 74 69 6c 6c 20 6f 6b e.;; if still ok
e910: 20 74 6f 20 72 75 6e 20 74 61 73 6b 73 0a 3b 3b to run tasks.;;
e920: 20 20 20 70 72 6f 63 65 73 73 20 64 65 66 65 72 process defer
e930: 72 65 64 20 74 61 73 6b 73 20 70 65 72 20 61 62 red tasks per ab
e940: 6f 76 65 20 73 74 65 70 73 0a 0a 3b 3b 20 72 75 ove steps..;; ru
e950: 6e 20 61 6c 6c 20 74 65 73 74 73 20 61 72 65 20 n all tests are
e960: 61 72 65 20 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 are Not COMPLETE
e970: 44 20 61 6e 64 20 50 41 53 53 20 6f 72 20 43 48 D and PASS or CH
e980: 45 43 4b 0a 28 69 66 20 28 6f 72 20 28 61 72 67 ECK.(if (or (arg
e990: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 s:get-arg "-runa
e9a0: 6c 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d ll")..(args:get-
e9b0: 61 72 67 20 22 2d 72 75 6e 22 29 0a 09 28 61 72 arg "-run")..(ar
e9c0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 72 gs:get-arg "-rer
e9d0: 75 6e 2d 63 6c 65 61 6e 22 29 0a 09 28 61 72 67 un-clean")..(arg
e9e0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 72 75 s:get-arg "-reru
e9f0: 6e 2d 61 6c 6c 22 29 0a 09 28 61 72 67 73 3a 67 n-all")..(args:g
ea00: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
ea10: 73 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 s")). (genera
ea20: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 l-run-call .
ea30: 20 22 2d 72 75 6e 61 6c 6c 22 0a 20 20 20 20 20 "-runall".
ea40: 22 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 22 0a "run all tests".
ea50: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 (lambda (ta
ea60: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
ea70: 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 s keyvals).
ea80: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
ea90: 61 72 67 20 22 2d 72 65 72 75 6e 2d 63 6c 65 61 arg "-rerun-clea
eaa0: 6e 22 29 20 3b 3b 20 66 69 72 73 74 20 73 65 74 n") ;; first set
eab0: 20 73 74 61 74 65 73 2f 73 74 61 74 75 73 65 73 states/statuses
eac0: 20 63 6f 72 72 65 63 74 0a 09 20 20 20 28 6c 65 correct.. (le
ead0: 74 20 28 28 73 74 61 74 65 73 20 20 20 28 6f 72 t ((states (or
eae0: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
eaf0: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 76 61 *configdat* "va
eb00: 6c 69 64 76 61 6c 75 65 73 22 20 22 63 6c 65 61 lidvalues" "clea
eb10: 6e 72 65 72 75 6e 2d 73 74 61 74 65 73 22 29 0a nrerun-states").
eb20: 09 09 09 20 20 20 20 20 20 20 22 4b 49 4c 4c 52 ... "KILLR
eb30: 45 51 2c 4b 49 4c 4c 45 44 2c 55 4e 4b 4e 4f 57 EQ,KILLED,UNKNOW
eb40: 4e 2c 49 4e 43 4f 4d 50 4c 45 54 45 2c 53 54 55 N,INCOMPLETE,STU
eb50: 43 4b 2c 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 CK,NOT_STARTED")
eb60: 29 0a 09 09 20 28 73 74 61 74 75 73 65 73 20 28 )... (statuses (
eb70: 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b or (configf:look
eb80: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
eb90: 76 61 6c 69 64 76 61 6c 75 65 73 22 20 22 63 6c validvalues" "cl
eba0: 65 61 6e 72 65 72 75 6e 2d 73 74 61 74 75 73 65 eanrerun-statuse
ebb0: 73 22 29 0a 09 09 09 20 20 20 20 20 20 20 22 46 s").... "F
ebc0: 41 49 4c 2c 49 4e 43 4f 4d 50 4c 45 54 45 2c 41 AIL,INCOMPLETE,A
ebd0: 42 4f 52 54 2c 43 48 45 43 4b 22 29 29 29 0a 09 BORT,CHECK")))..
ebe0: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
ebf0: 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 2d 68 -set! args:arg-h
ec00: 61 73 68 20 22 2d 70 72 65 63 6c 65 61 6e 22 20 ash "-preclean"
ec10: 23 74 29 0a 09 20 20 20 20 20 28 72 75 6e 73 3a #t).. (runs:
ec20: 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d operate-on 'set-
ec30: 73 74 61 74 65 2d 73 74 61 74 75 73 0a 09 09 09 state-status....
ec40: 20 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 target....
ec50: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 (common:ar
ec60: 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 gs-get-runname)
ec70: 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 ;; (or (args:ge
ec80: 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
ec90: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
eca0: 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 :runname"))....
ecb0: 20 20 20 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d "%" ;; (com
ecc0: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 mon:args-get-tes
ecd0: 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 tpatt #f) ;; (ar
ece0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
ecf0: 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 tpatt")....
ed00: 20 73 74 61 74 65 3a 20 20 73 74 61 74 65 73 0a state: states.
ed10: 09 09 09 20 20 20 20 20 20 3b 3b 20 73 74 61 74 ... ;; stat
ed20: 75 73 3a 20 73 74 61 74 75 73 65 73 0a 09 09 09 us: statuses....
ed30: 20 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d new-state-
ed40: 73 74 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 status: "NOT_STA
ed50: 52 54 45 44 2c 6e 2f 61 22 29 0a 09 20 20 20 20 RTED,n/a")..
ed60: 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f (runs:operate-o
ed70: 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 61 n 'set-state-sta
ed80: 74 75 73 0a 09 09 09 20 20 20 20 20 20 74 61 72 tus.... tar
ed90: 67 65 74 0a 09 09 09 20 20 20 20 20 20 28 63 6f get.... (co
eda0: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 mmon:args-get-ru
edb0: 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 nname) ;; (or (
edc0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
edd0: 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 unname")(args:ge
ede0: 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 t-arg ":runname"
edf0: 29 29 0a 09 09 09 20 20 20 20 20 20 22 25 22 20 )).... "%"
ee00: 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d ;; (common:args-
ee10: 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 get-testpatt #f)
ee20: 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ;; (args:get-ar
ee30: 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 g "-testpatt")..
ee40: 09 09 20 20 20 20 20 20 3b 3b 20 73 74 61 74 65 .. ;; state
ee50: 3a 20 20 73 74 61 74 65 73 0a 09 09 09 20 20 20 : states....
ee60: 20 20 20 73 74 61 74 75 73 3a 20 73 74 61 74 75 status: statu
ee70: 73 65 73 0a 09 09 09 20 20 20 20 20 20 6e 65 77 ses.... new
ee80: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a 20 22 -state-status: "
ee90: 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 22 NOT_STARTED,n/a"
eea0: 29 29 29 0a 20 20 20 20 20 20 20 3b 3b 20 52 45 ))). ;; RE
eeb0: 52 55 4e 20 41 4c 4c 0a 20 20 20 20 20 20 20 28 RUN ALL. (
eec0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
eed0: 20 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 29 20 3b "-rerun-all") ;
eee0: 3b 20 66 69 72 73 74 20 73 65 74 20 73 74 61 74 ; first set stat
eef0: 65 73 2f 73 74 61 74 75 73 65 73 20 63 6f 72 72 es/statuses corr
ef00: 65 63 74 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 ect.. (begin..
ef10: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
ef20: 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 2d 68 -set! args:arg-h
ef30: 61 73 68 20 22 2d 70 72 65 63 6c 65 61 6e 22 20 ash "-preclean"
ef40: 23 74 29 0a 09 20 20 20 20 20 28 72 75 6e 73 3a #t).. (runs:
ef50: 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d operate-on 'set-
ef60: 73 74 61 74 65 2d 73 74 61 74 75 73 0a 09 09 09 state-status....
ef70: 20 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 target....
ef80: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 (common:ar
ef90: 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 gs-get-runname)
efa0: 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 ;; (or (args:ge
efb0: 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
efc0: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
efd0: 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 :runname"))....
efe0: 20 20 20 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d "%" ;; (com
eff0: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 mon:args-get-tes
f000: 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 tpatt #f) ;; (ar
f010: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
f020: 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 tpatt")....
f030: 20 73 74 61 74 65 3a 20 20 23 66 0a 09 09 09 20 state: #f....
f040: 20 20 20 20 20 3b 3b 20 73 74 61 74 75 73 3a 20 ;; status:
f050: 73 74 61 74 75 73 65 73 0a 09 09 09 20 20 20 20 statuses....
f060: 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 new-state-stat
f070: 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 us: "NOT_STARTED
f080: 2c 6e 2f 61 22 29 0a 09 20 20 20 20 20 28 72 75 ,n/a").. (ru
f090: 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 ns:operate-on 's
f0a0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a et-state-status.
f0b0: 09 09 09 20 20 20 20 20 20 74 61 72 67 65 74 0a ... target.
f0c0: 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e ... (common
f0d0: 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d :args-get-runnam
f0e0: 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 e) ;; (or (args
f0f0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 :get-arg "-runna
f100: 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 me")(args:get-ar
f110: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g ":runname"))..
f120: 09 09 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 .. "%" ;; (
f130: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
f140: 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 testpatt #f) ;;
f150: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
f160: 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 testpatt")....
f170: 20 20 20 20 3b 3b 20 73 74 61 74 65 3a 20 20 73 ;; state: s
f180: 74 61 74 65 73 0a 09 09 09 20 20 20 20 20 20 73 tates.... s
f190: 74 61 74 75 73 3a 20 23 66 0a 09 09 09 20 20 20 tatus: #f....
f1a0: 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 new-state-sta
f1b0: 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 tus: "NOT_STARTE
f1c0: 44 2c 6e 2f 61 22 29 29 29 0a 20 20 20 20 20 20 D,n/a"))).
f1d0: 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 (runs:run-tests
f1e0: 20 74 61 72 67 65 74 0a 09 09 20 20 20 20 20 20 target...
f1f0: 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 20 20 20 runname...
f200: 20 20 23 66 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a #f ;; (common:
f210: 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 args-get-testpat
f220: 74 20 23 66 29 0a 09 09 20 20 20 20 20 20 20 3b t #f)... ;
f230: 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d ; (or (args:get-
f240: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
f250: 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 20 20 20 ... ;;
f260: 20 22 25 22 29 0a 09 09 20 20 20 20 20 20 20 75 "%")... u
f270: 73 65 72 0a 09 09 20 20 20 20 20 20 20 61 72 67 ser... arg
f280: 73 3a 61 72 67 2d 68 61 73 68 29 29 29 29 0a 0a s:arg-hash))))..
f290: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
f2a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f2b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f2c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f2d0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e 20 ========.;; run
f2e0: 6f 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d one test.;;=====
f2f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f330: 3d 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 20 74 68 =..;; 1. find th
f340: 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b e config file.;;
f350: 20 32 2e 20 63 68 61 6e 67 65 20 74 6f 20 74 68 2. change to th
f360: 65 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 79 e test directory
f370: 0a 3b 3b 20 33 2e 20 75 70 64 61 74 65 20 74 68 .;; 3. update th
f380: 65 20 64 62 20 77 69 74 68 20 22 74 65 73 74 20 e db with "test
f390: 73 74 61 72 74 65 64 22 20 73 74 61 74 75 73 2c started" status,
f3a0: 20 73 65 74 20 72 75 6e 6e 69 6e 67 20 68 6f 73 set running hos
f3b0: 74 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 73 73 20 t.;; 4. process
f3c0: 6c 61 75 6e 63 68 20 74 68 65 20 74 65 73 74 0a launch the test.
f3d0: 3b 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 6f 72 20 ;; - monitor
f3e0: 74 68 65 20 70 72 6f 63 65 73 73 2c 20 75 70 64 the process, upd
f3f0: 61 74 65 20 73 74 61 74 73 20 69 6e 20 74 68 65 ate stats in the
f400: 20 64 62 20 65 76 65 72 79 20 32 5e 6e 20 6d 69 db every 2^n mi
f410: 6e 75 74 65 73 0a 3b 3b 20 35 2e 20 61 73 20 74 nutes.;; 5. as t
f420: 68 65 20 74 65 73 74 20 70 72 6f 63 65 65 64 73 he test proceeds
f430: 20 69 6e 74 65 72 6e 61 6c 6c 79 20 69 74 20 63 internally it c
f440: 61 6c 6c 73 20 6d 65 67 61 74 65 73 74 20 61 73 alls megatest as
f450: 20 65 61 63 68 20 73 74 65 70 20 69 73 0a 3b 3b each step is.;;
f460: 20 20 20 20 73 74 61 72 74 65 64 20 61 6e 64 20 started and
f470: 63 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 20 20 20 completed.;;
f480: 2d 20 73 74 65 70 20 73 74 61 72 74 65 64 2c 20 - step started,
f490: 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 20 20 20 timestamp.;;
f4a0: 2d 20 73 74 65 70 20 63 6f 6d 70 6c 65 74 65 64 - step completed
f4b0: 2c 20 65 78 69 74 20 73 74 61 74 75 73 2c 20 74 , exit status, t
f4c0: 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 2e 20 74 imestamp.;; 6. t
f4d0: 65 73 74 20 70 68 6f 6e 65 20 68 6f 6d 65 0a 3b est phone home.;
f4e0: 3b 20 20 20 20 2d 20 69 66 20 74 65 73 74 20 72 ; - if test r
f4f0: 75 6e 20 74 69 6d 65 20 3e 20 61 6c 6c 6f 77 65 un time > allowe
f500: 64 20 72 75 6e 20 74 69 6d 65 20 74 68 65 6e 20 d run time then
f510: 6b 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 20 20 2d kill job.;; -
f520: 20 69 66 20 63 61 6e 6e 6f 74 20 61 63 63 65 73 if cannot acces
f530: 73 20 64 62 20 3e 20 61 6c 6c 6f 77 65 64 20 64 s db > allowed d
f540: 69 73 63 6f 6e 6e 65 63 74 20 74 69 6d 65 20 74 isconnect time t
f550: 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 0a 3b 3b hen kill job..;;
f560: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
f570: 3d 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a = (if (or (args:
f580: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 28 get-arg "-run")(
f590: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
f5a0: 75 6e 74 65 73 74 73 22 29 29 0a 3b 3b 20 3d 3d untests")).;; ==
f5b0: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
f5c0: 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 (general-run-ca
f5d0: 6c 6c 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 ll .;; == duplic
f5e0: 61 74 65 64 20 3d 3d 20 20 20 20 22 2d 72 75 6e ated == "-run
f5f0: 74 65 73 74 73 22 20 0a 3b 3b 20 3d 3d 20 64 75 tests" .;; == du
f600: 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 22 plicated == "
f610: 72 75 6e 20 61 20 74 65 73 74 22 20 0a 3b 3b 20 run a test" .;;
f620: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f630: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
f640: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
f650: 20 6b 65 79 76 61 6c 73 29 0a 3b 3b 20 3d 3d 20 keyvals).;; ==
f660: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
f670: 20 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 70 6c ;;.;; == dupl
f680: 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b icated == ;
f690: 3b 20 4d 61 79 20 6f 72 20 6d 61 79 20 6e 6f 74 ; May or may not
f6a0: 20 69 6d 70 6c 65 6d 65 6e 74 20 69 74 20 74 68 implement it th
f6b0: 69 73 20 77 61 79 20 2e 2e 2e 0a 3b 3b 20 3d 3d is way ....;; ==
f6c0: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
f6d0: 20 20 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 70 ;;.;; == dup
f6e0: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 licated ==
f6f0: 3b 3b 20 49 6e 73 65 72 74 20 74 68 69 73 20 72 ;; Insert this r
f700: 75 6e 20 69 6e 74 6f 20 74 68 65 20 74 61 73 6b un into the task
f710: 73 20 71 75 65 75 65 0a 3b 3b 20 3d 3d 20 64 75 s queue.;; == du
f720: 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 plicated ==
f730: 20 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c ;; (open-run-cl
f740: 6f 73 65 20 74 61 73 6b 73 3a 61 64 64 20 74 61 ose tasks:add ta
f750: 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 0a 3b 3b 20 sks:open-db .;;
f760: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f770: 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 ;; .
f780: 20 20 22 72 75 6e 74 65 73 74 73 22 20 0a 3b 3b "runtests" .;;
f790: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
f7a0: 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 = ;; .
f7b0: 20 20 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 64 75 user.;; == du
f7c0: 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 plicated ==
f7d0: 20 3b 3b 20 20 20 20 09 20 20 20 20 20 74 61 72 ;; . tar
f7e0: 67 65 74 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 get.;; == duplic
f7f0: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 ated == ;;
f800: 20 20 20 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 . runname
f810: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
f820: 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 d == ;;
f830: 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d . (args:get-
f840: 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
f850: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
f860: 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 d == ;;
f870: 09 20 20 20 20 20 23 66 29 29 29 29 0a 3b 3b 20 . #f)))).;;
f880: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f890: 20 20 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d (runs:run-
f8a0: 74 65 73 74 73 20 74 61 72 67 65 74 0a 3b 3b 20 tests target.;;
f8b0: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f8c0: 20 09 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a .. runname.
f8d0: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f8e0: 20 3d 3d 20 09 09 20 20 20 20 20 28 63 6f 6d 6d == .. (comm
f8f0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
f900: 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 patt #f) ;; (arg
f910: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 s:get-arg "-runt
f920: 65 73 74 73 22 29 0a 3b 3b 20 3d 3d 20 64 75 70 ests").;; == dup
f930: 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 20 20 20 licated == ..
f940: 20 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 64 75 70 user.;; == dup
f950: 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 20 20 20 licated == ..
f960: 20 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 args:arg-hash)
f970: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
f980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f9a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f9b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
f9c0: 20 52 6f 6c 6c 75 70 20 69 6e 74 6f 20 61 20 72 Rollup into a r
f9d0: 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d un.;;===========
f9e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f9f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
fa20: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
fa30: 2d 72 6f 6c 6c 75 70 22 29 0a 20 20 20 20 28 67 -rollup"). (g
fa40: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
fa50: 0a 20 20 20 20 20 22 2d 72 6f 6c 6c 75 70 22 20 . "-rollup"
fa60: 0a 20 20 20 20 20 22 72 6f 6c 6c 75 70 20 74 65 . "rollup te
fa70: 73 74 73 22 20 0a 20 20 20 20 20 28 6c 61 6d 62 sts" . (lamb
fa80: 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 da (target runna
fa90: 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 me keys keyvals)
faa0: 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a 72 6f . (runs:ro
fab0: 6c 6c 75 70 2d 72 75 6e 20 6b 65 79 73 0a 09 09 llup-run keys...
fac0: 09 6b 65 79 76 61 6c 73 0a 09 09 09 28 6f 72 20 .keyvals....(or
fad0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
fae0: 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 runname")(args:g
faf0: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
fb00: 22 29 20 29 0a 09 09 09 75 73 65 72 29 29 29 29 ") )....user))))
fb10: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
fb20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 6f ==========.;; Lo
fb60: 63 6b 20 6f 72 20 75 6e 6c 6f 63 6b 20 61 20 72 ck or unlock a r
fb70: 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d un.;;===========
fb80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fbb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
fbc0: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
fbd0: 72 67 20 22 2d 6c 6f 63 6b 22 29 28 61 72 67 73 rg "-lock")(args
fbe0: 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 :get-arg "-unloc
fbf0: 6b 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 k")). (genera
fc00: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 l-run-call .
fc10: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
fc20: 72 67 20 22 2d 6c 6f 63 6b 22 29 20 22 2d 6c 6f rg "-lock") "-lo
fc30: 63 6b 22 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 ck" "-unlock").
fc40: 20 20 20 20 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b "lock/unlock
fc50: 20 74 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c tests" . (l
fc60: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
fc70: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 nname keys keyva
fc80: 6c 73 29 0a 20 20 20 20 20 20 20 28 72 75 6e 73 ls). (runs
fc90: 3a 68 61 6e 64 6c 65 2d 6c 6f 63 6b 69 6e 67 20 :handle-locking
fca0: 0a 09 09 20 20 74 61 72 67 65 74 0a 09 09 20 20 ... target...
fcb0: 6b 65 79 73 0a 09 09 20 20 28 6f 72 20 28 61 72 keys... (or (ar
fcc0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
fcd0: 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d name")(args:get-
fce0: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 arg ":runname")
fcf0: 29 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d )... (args:get-
fd00: 61 72 67 20 22 2d 6c 6f 63 6b 22 29 0a 09 09 20 arg "-lock")...
fd10: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
fd20: 2d 75 6e 6c 6f 63 6b 22 29 0a 09 09 20 20 75 73 -unlock")... us
fd30: 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d er))))..;;======
fd40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fd50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fd60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fd70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fd80: 0a 3b 3b 20 47 65 74 20 70 61 74 68 73 20 74 6f .;; Get paths to
fd90: 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d tests.;;=======
fda0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fdb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fdc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fdd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
fde0: 3b 3b 20 47 65 74 20 74 65 73 74 20 70 61 74 68 ;; Get test path
fdf0: 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 s matching targe
fe00: 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 t, runname, and
fe10: 74 65 73 74 70 61 74 74 0a 28 69 66 20 28 6f 72 testpatt.(if (or
fe20: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
fe30: 2d 74 65 73 74 2d 66 69 6c 65 73 22 29 28 61 72 -test-files")(ar
fe40: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
fe50: 74 2d 70 61 74 68 73 22 29 29 0a 20 20 20 20 3b t-paths")). ;
fe60: 3b 20 69 66 20 77 65 20 61 72 65 20 69 6e 20 61 ; if we are in a
fe70: 20 74 65 73 74 20 75 73 65 20 74 68 65 20 4d 54 test use the MT
fe80: 5f 43 4d 44 49 4e 46 4f 20 64 61 74 61 0a 20 20 _CMDINFO data.
fe90: 20 20 28 69 66 20 28 67 65 74 65 6e 76 20 22 4d (if (getenv "M
fea0: 54 5f 43 4d 44 49 4e 46 4f 22 29 0a 09 28 6c 65 T_CMDINFO")..(le
feb0: 74 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 t* ((startingdir
fec0: 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 (current-direct
fed0: 6f 72 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 ory)).. (c
fee0: 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e mdinfo (common
fef0: 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 74 :read-encoded-st
ff00: 72 69 6e 67 20 28 67 65 74 65 6e 76 20 22 4d 54 ring (getenv "MT
ff10: 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 20 20 _CMDINFO")))..
ff20: 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 (transport
ff30: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
ff40: 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 transport cmdinf
ff50: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 o)).. (tes
ff60: 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 tpath (assoc/de
ff70: 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 fault 'testpath
ff80: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
ff90: 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 (test-name (a
ffa0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
ffb0: 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 st-name cmdinfo)
ffc0: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 ).. (runsc
ffd0: 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 ript (assoc/defa
ffe0: 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 ult 'runscript c
fff0: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
10000 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 (db-host (ass
10010 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 oc/default 'db-h
10020 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a ost cmdinfo)).
10030 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 . (run-id
10040 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
10050 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 t 'run-id cmd
10060 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
10070 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 itemdat (assoc
10080 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 /default 'itemda
10090 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
100a0 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 (state
100b0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
100c0 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 :state"))..
100d0 20 20 28 73 74 61 74 75 73 20 20 20 20 28 61 72 (status (ar
100e0 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
100f0 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 tus")).. (
10100 74 61 72 67 65 74 20 20 20 20 28 61 72 67 73 3a target (args:
10110 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 get-arg "-target
10120 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 6f 70 ")).. (top
10130 70 61 74 68 20 20 20 28 61 73 73 6f 63 2f 64 65 path (assoc/de
10140 66 61 75 6c 74 20 27 74 6f 70 70 61 74 68 20 20 fault 'toppath
10150 20 63 6d 64 69 6e 66 6f 29 29 29 0a 09 20 20 28 cmdinfo))).. (
10160 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
10170 20 74 6f 70 70 61 74 68 29 0a 09 20 20 28 69 66 toppath).. (if
10180 20 28 6e 6f 74 20 74 61 72 67 65 74 29 0a 09 20 (not target)..
10190 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 (begin...(d
101a0 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
101b0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
101c0 70 6f 72 74 2a 20 22 2d 74 61 72 67 65 74 20 69 port* "-target i
101d0 73 20 72 65 71 75 69 72 65 64 2e 22 29 0a 09 09 s required.")...
101e0 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 69 (exit 1))).. (i
101f0 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
10200 65 74 75 70 29 29 0a 09 20 20 20 20 20 20 28 62 etup)).. (b
10210 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 egin...(debug:pr
10220 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
10230 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 og-port* "Failed
10240 20 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 6e to setup, givin
10250 67 20 75 70 20 6f 6e 20 2d 74 65 73 74 2d 70 61 g up on -test-pa
10260 74 68 73 20 6f 72 20 2d 74 65 73 74 2d 66 69 6c ths or -test-fil
10270 65 73 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 es, exiting")...
10280 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 6c (exit 1))).. (l
10290 65 74 2a 20 28 28 6b 65 79 73 20 20 20 20 20 28 et* ((keys (
102a0 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 0a 09 rmt:get-keys))..
102b0 09 20 3b 3b 20 64 62 3a 74 65 73 74 2d 67 65 74 . ;; db:test-get
102c0 2d 70 61 74 68 73 20 6d 75 73 74 20 6e 6f 74 20 -paths must not
102d0 62 65 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 be run remote...
102e0 20 28 70 61 74 68 73 20 20 20 20 28 74 65 73 74 (paths (test
102f0 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 s:test-get-paths
10300 2d 6d 61 74 63 68 69 6e 67 20 6b 65 79 73 20 74 -matching keys t
10310 61 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d arget (args:get-
10320 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 arg "-test-files
10330 22 29 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 ")))).. (set!
10340 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
10350 23 74 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 #t).. (for-ea
10360 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 74 68 ch (lambda (path
10370 29 0a 09 09 09 28 69 66 20 28 66 69 6c 65 2d 65 )....(if (file-e
10380 78 69 73 74 73 3f 20 70 61 74 68 29 0a 09 09 09 xists? path)....
10390 28 70 72 69 6e 74 20 70 61 74 68 29 29 29 09 0a (print path)))..
103a0 09 09 20 20 20 20 20 20 70 61 74 68 73 29 29 29 .. paths)))
103b0 0a 09 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 67 ..;; else do a g
103c0 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a eneral-run-call.
103d0 09 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 .(general-run-ca
103e0 6c 6c 20 0a 09 20 22 2d 74 65 73 74 2d 66 69 6c ll .. "-test-fil
103f0 65 73 22 0a 09 20 22 47 65 74 20 70 61 74 68 73 es".. "Get paths
10400 20 74 6f 20 74 65 73 74 22 0a 09 20 28 6c 61 6d to test".. (lam
10410 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
10420 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 ame keys keyvals
10430 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 64 62 ).. (let* ((db
10440 20 20 20 20 20 20 20 23 66 29 0a 09 09 20 20 3b #f)... ;
10450 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d ; DO NOT run rem
10460 6f 74 65 0a 09 09 20 20 28 70 61 74 68 73 20 20 ote... (paths
10470 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 67 65 (tests:test-ge
10480 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 t-paths-matching
10490 20 6b 65 79 73 20 74 61 72 67 65 74 20 28 61 72 keys target (ar
104a0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
104b0 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 20 t-files"))))..
104c0 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
104d0 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 20 mbda (path)....
104e0 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 (print path))...
104f0 20 20 20 20 20 20 20 70 61 74 68 73 29 29 29 29 paths))))
10500 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
10510 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10520 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10530 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10540 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
10550 41 72 63 68 69 76 65 20 74 65 73 74 73 0a 3b 3b Archive tests.;;
10560 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10570 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10580 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10590 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
105a0 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 ======.;; Archiv
105b0 65 20 74 65 73 74 73 20 6d 61 74 63 68 69 6e 67 e tests matching
105c0 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 target, runname
105d0 2c 20 61 6e 64 20 74 65 73 74 70 61 74 74 0a 28 , and testpatt.(
105e0 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
105f0 20 22 2d 61 72 63 68 69 76 65 22 29 0a 20 20 20 "-archive").
10600 20 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 67 65 ;; else do a ge
10610 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 neral-run-call.
10620 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
10630 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 61 72 63 call . "-arc
10640 68 69 76 65 22 0a 20 20 20 20 20 22 41 72 63 68 hive". "Arch
10650 69 76 65 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 ive". (lambd
10660 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
10670 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a e keys keyvals).
10680 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d (operate-
10690 6f 6e 20 27 61 72 63 68 69 76 65 29 29 29 29 0a on 'archive)))).
106a0 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
106b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
106c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
106d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
106e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 74 =========.;; Ext
106f0 72 61 63 74 20 61 20 73 70 72 65 61 64 73 68 65 ract a spreadshe
10700 65 74 20 66 72 6f 6d 20 74 68 65 20 72 75 6e 73 et from the runs
10710 20 64 61 74 61 62 61 73 65 0a 3b 3b 3d 3d 3d 3d database.;;====
10720 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10730 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10740 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10750 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10760 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ==..(if (args:ge
10770 74 2d 61 72 67 20 22 2d 65 78 74 72 61 63 74 2d t-arg "-extract-
10780 6f 64 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 ods"). (gener
10790 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 al-run-call.
107a0 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 0a "-extract-ods".
107b0 20 20 20 20 20 22 4d 61 6b 65 20 6f 64 73 20 73 "Make ods s
107c0 70 72 65 61 64 73 68 65 65 74 22 0a 20 20 20 20 preadsheet".
107d0 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
107e0 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
107f0 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6c yvals). (l
10800 65 74 20 28 28 64 62 73 74 72 75 63 74 20 20 20 et ((dbstruct
10810 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 (make-dbr:dbstru
10820 63 74 20 70 61 74 68 3a 20 2a 74 6f 70 70 61 74 ct path: *toppat
10830 68 2a 20 6c 6f 63 61 6c 3a 20 23 74 29 29 0a 09 h* local: #t))..
10840 20 20 20 20 20 28 6f 75 74 70 75 74 66 69 6c 65 (outputfile
10850 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
10860 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 29 0a -extract-ods")).
10870 09 20 20 20 20 20 28 72 75 6e 73 70 61 74 74 20 . (runspatt
10880 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d (or (args:get-
10890 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 arg "-runname")(
108a0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 args:get-arg ":r
108b0 75 6e 6e 61 6d 65 22 29 29 29 0a 09 20 20 20 20 unname")))..
108c0 20 28 70 61 74 68 6d 6f 64 20 20 20 20 28 61 72 (pathmod (ar
108d0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 61 74 gs:get-arg "-pat
108e0 68 6d 6f 64 22 29 29 29 0a 09 20 20 20 20 20 3b hmod"))).. ;
108f0 3b 20 28 6b 65 79 76 61 6c 61 6c 69 73 74 20 28 ; (keyvalalist (
10900 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 79 73 keys->alist keys
10910 20 22 25 22 29 29 29 0a 09 20 28 64 65 62 75 67 "%"))).. (debug
10920 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 75 6c :print 2 *defaul
10930 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 78 74 t-log-port* "Ext
10940 72 61 63 74 20 6f 64 73 2c 20 6f 75 74 70 75 74 ract ods, output
10950 66 69 6c 65 3a 20 22 20 6f 75 74 70 75 74 66 69 file: " outputfi
10960 6c 65 20 22 20 72 75 6e 73 70 61 74 74 3a 20 22 le " runspatt: "
10970 20 72 75 6e 73 70 61 74 74 20 22 20 6b 65 79 76 runspatt " keyv
10980 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 29 0a als: " keyvals).
10990 09 20 28 64 62 3a 65 78 74 72 61 63 74 2d 6f 64 . (db:extract-od
109a0 73 2d 66 69 6c 65 20 64 62 73 74 72 75 63 74 20 s-file dbstruct
109b0 6f 75 74 70 75 74 66 69 6c 65 20 6b 65 79 76 61 outputfile keyva
109c0 6c 73 20 28 69 66 20 72 75 6e 73 70 61 74 74 20 ls (if runspatt
109d0 72 75 6e 73 70 61 74 74 20 22 25 22 29 20 70 61 runspatt "%") pa
109e0 74 68 6d 6f 64 29 0a 09 20 28 64 62 3a 63 6c 6f thmod).. (db:clo
109f0 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 29 se-all dbstruct)
10a00 0a 09 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d .. (set! *didsom
10a10 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 29 0a ething* #t))))).
10a20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
10a30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a60 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 =========.;; exe
10a70 63 75 74 65 20 74 68 65 20 74 65 73 74 0a 3b 3b cute the test.;;
10a80 20 20 20 20 2d 20 67 65 74 73 20 63 61 6c 6c 65 - gets calle
10a90 64 20 6f 6e 20 72 65 6d 6f 74 65 20 68 6f 73 74 d on remote host
10aa0 0a 3b 3b 20 20 20 20 2d 20 72 65 63 65 69 76 65 .;; - receive
10ab0 73 20 69 6e 66 6f 20 66 72 6f 6d 20 74 68 65 20 s info from the
10ac0 2d 65 78 65 63 75 74 65 20 70 61 72 61 6d 0a 3b -execute param.;
10ad0 3b 20 20 20 20 2d 20 70 61 73 73 65 73 20 69 6e ; - passes in
10ae0 66 6f 20 74 6f 20 73 74 65 70 73 20 76 69 61 20 fo to steps via
10af0 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 MT_CMDINFO env v
10b00 61 72 20 28 66 75 74 75 72 65 20 69 73 20 74 6f ar (future is to
10b10 20 75 73 65 20 61 20 64 6f 74 20 66 69 6c 65 29 use a dot file)
10b20 0a 3b 3b 20 20 20 20 2d 20 67 61 74 68 65 72 73 .;; - gathers
10b30 20 68 6f 73 74 20 69 6e 66 6f 20 61 6e 64 20 0a host info and .
10b40 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
10b50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b80 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
10b90 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 rgs:get-arg "-ex
10ba0 65 63 75 74 65 22 29 0a 20 20 20 20 28 62 65 67 ecute"). (beg
10bb0 69 6e 0a 20 20 20 20 20 20 28 6c 61 75 6e 63 68 in. (launch
10bc0 3a 65 78 65 63 75 74 65 20 28 61 72 67 73 3a 67 :execute (args:g
10bd0 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 65 et-arg "-execute
10be0 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ")). (set!
10bf0 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
10c00 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
10c10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
10c50 3b 20 72 65 63 6f 76 65 72 20 66 72 6f 6d 20 61 ; recover from a
10c60 20 74 65 73 74 20 77 68 65 72 65 20 74 68 65 20 test where the
10c70 6d 61 6e 61 67 69 6e 67 20 6d 74 65 73 74 20 77 managing mtest w
10c80 61 73 20 6b 69 6c 6c 65 64 20 62 75 74 20 74 68 as killed but th
10c90 65 20 75 6e 64 65 72 6c 79 69 6e 67 0a 3b 3b 20 e underlying.;;
10ca0 70 72 6f 63 65 73 73 20 6d 69 67 68 74 20 73 74 process might st
10cb0 69 6c 6c 20 62 65 20 73 61 6c 76 61 67 65 61 62 ill be salvageab
10cc0 6c 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d le.;;===========
10cd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10ce0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10cf0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
10d10 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
10d20 2d 72 65 63 6f 76 65 72 2d 74 65 73 74 22 29 0a -recover-test").
10d30 20 20 20 20 28 6c 65 74 2a 20 28 28 70 61 72 61 (let* ((para
10d40 6d 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 ms (string-split
10d50 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
10d60 2d 72 65 63 6f 76 65 72 2d 74 65 73 74 22 29 20 -recover-test")
10d70 22 2c 22 29 29 29 0a 20 20 20 20 20 20 28 69 66 ","))). (if
10d80 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 72 61 (> (length para
10d90 6d 73 29 20 31 29 20 3b 3b 20 72 75 6e 2d 69 64 ms) 1) ;; run-id
10da0 20 61 6e 64 20 74 65 73 74 2d 69 64 0a 09 20 20 and test-id..
10db0 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 28 73 (let ((run-id (s
10dc0 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 tring->number (c
10dd0 61 72 20 70 61 72 61 6d 73 29 29 29 0a 09 09 28 ar params)))...(
10de0 74 65 73 74 2d 69 64 20 28 73 74 72 69 6e 67 2d test-id (string-
10df0 3e 6e 75 6d 62 65 72 20 28 63 61 64 72 20 70 61 >number (cadr pa
10e00 72 61 6d 73 29 29 29 29 0a 09 20 20 20 20 28 69 rams)))).. (i
10e10 66 20 28 61 6e 64 20 72 75 6e 2d 69 64 20 74 65 f (and run-id te
10e20 73 74 2d 69 64 29 0a 09 09 28 62 65 67 69 6e 0a st-id)...(begin.
10e30 09 09 20 20 28 6c 61 75 6e 63 68 3a 72 65 63 6f .. (launch:reco
10e40 76 65 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 ver-test run-id
10e50 74 65 73 74 2d 69 64 29 0a 09 09 20 20 28 73 65 test-id)... (se
10e60 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
10e70 2a 20 23 74 29 29 0a 09 09 28 62 65 67 69 6e 0a * #t))...(begin.
10e80 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
10e90 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
10ea0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 62 61 64 t-log-port* "bad
10eb0 20 72 75 6e 2d 69 64 20 6f 72 20 74 65 73 74 2d run-id or test-
10ec0 69 64 2c 20 6d 75 73 74 20 62 65 20 69 6e 74 65 id, must be inte
10ed0 67 65 72 73 22 29 0a 09 09 20 20 28 65 78 69 74 gers")... (exit
10ee0 20 31 29 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 1)))))))..;;===
10ef0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10f00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10f10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10f20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10f30 3d 3d 3d 0a 3b 3b 20 54 65 73 74 20 63 6f 6d 6d ===.;; Test comm
10f40 61 6e 64 73 20 28 69 2e 65 2e 20 66 6f 72 20 75 ands (i.e. for u
10f50 73 65 20 69 6e 73 69 64 65 20 74 65 73 74 73 29 se inside tests)
10f60 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
10f70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10f80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10f90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10fa0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
10fb0 6e 65 20 28 6d 65 67 61 74 65 73 74 3a 73 74 65 ne (megatest:ste
10fc0 70 20 73 74 65 70 20 73 74 61 74 65 20 73 74 61 p step state sta
10fd0 74 75 73 20 6c 6f 67 66 69 6c 65 20 6d 73 67 29 tus logfile msg)
10fe0 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 . (if (not (get
10ff0 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
11000 29 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a )). (begin.
11010 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 .(debug:print-er
11020 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
11030 6f 67 2d 70 6f 72 74 2a 20 22 4d 54 5f 43 4d 44 og-port* "MT_CMD
11040 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 INFO env var not
11050 20 73 65 74 2c 20 2d 73 74 65 70 20 6d 75 73 74 set, -step must
11060 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 be called *insi
11070 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 69 de* a megatest i
11080 6e 76 6f 6b 65 64 20 65 6e 76 69 72 6f 6e 6d 65 nvoked environme
11090 6e 74 21 22 29 0a 09 28 65 78 69 74 20 35 29 29 nt!")..(exit 5))
110a0 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 . (let* ((c
110b0 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e mdinfo (common
110c0 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 74 :read-encoded-st
110d0 72 69 6e 67 20 28 67 65 74 65 6e 76 20 22 4d 54 ring (getenv "MT
110e0 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 20 20 _CMDINFO")))..
110f0 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 (transport (a
11100 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 ssoc/default 'tr
11110 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 ansport cmdinfo)
11120 29 0a 09 20 20 20 20 20 28 74 65 73 74 70 61 74 ).. (testpat
11130 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c h (assoc/defaul
11140 74 20 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 t 'testpath cmd
11150 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 info)).. (te
11160 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 st-name (assoc/d
11170 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d efault 'test-nam
11180 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 e cmdinfo))..
11190 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 (runscript (as
111a0 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
111b0 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 script cmdinfo))
111c0 0a 09 20 20 20 20 20 28 64 62 2d 68 6f 73 74 20 .. (db-host
111d0 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
111e0 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 'db-host cmdi
111f0 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 75 6e nfo)).. (run
11200 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 -id (assoc/de
11210 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 fault 'run-id
11220 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
11230 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 73 73 (test-id (ass
11240 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
11250 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a -id cmdinfo)).
11260 09 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 . (itemdat
11270 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
11280 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 'itemdat cmdin
11290 66 6f 29 29 0a 09 20 20 20 20 20 28 77 6f 72 6b fo)).. (work
112a0 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 65 66 -area (assoc/def
112b0 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 ault 'work-area
112c0 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
112d0 28 64 62 20 20 20 20 20 20 20 20 23 66 29 29 0a (db #f)).
112e0 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f .(change-directo
112f0 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 28 69 ry testpath)..(i
11300 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
11310 65 74 75 70 29 29 0a 09 20 20 20 20 28 62 65 67 etup)).. (beg
11320 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 in.. (debug
11330 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
11340 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
11350 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
11360 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 20 28 iting").. (
11370 65 78 69 74 20 31 29 29 29 0a 09 28 69 66 20 28 exit 1)))..(if (
11380 61 6e 64 20 73 74 61 74 65 20 73 74 61 74 75 73 and state status
11390 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 63 6f ).. (let ((co
113a0 6d 6d 65 6e 74 20 28 6c 61 75 6e 63 68 3a 6c 6f mment (launch:lo
113b0 61 64 2d 6c 6f 67 70 72 6f 2d 64 61 74 20 72 75 ad-logpro-dat ru
113c0 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 n-id test-id ste
113d0 70 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 p))).. ;; (
113e0 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 rmt:test-set-log
113f0 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
11400 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
11410 22 2e 68 74 6d 6c 22 29 29 29 29 0a 09 20 20 20 ".html"))))..
11420 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 65 70 (rmt:teststep
11430 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
11440 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 -id test-id step
11450 20 73 74 61 74 65 20 73 74 61 74 75 73 20 28 6f state status (o
11460 72 20 63 6f 6d 6d 65 6e 74 20 6d 73 67 29 20 6c r comment msg) l
11470 6f 67 66 69 6c 65 29 29 0a 09 20 20 20 20 28 62 ogfile)).. (b
11480 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 egin.. (deb
11490 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
114a0 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
114b0 72 74 2a 20 22 59 6f 75 20 6d 75 73 74 20 73 70 rt* "You must sp
114c0 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 ecify :state and
114d0 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 65 76 :status with ev
114e0 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 73 74 65 ery call to -ste
114f0 70 22 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 p").. (exit
11500 20 36 29 29 29 29 29 29 0a 0a 28 69 66 20 28 61 6))))))..(if (a
11510 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
11520 65 70 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ep"). (begin.
11530 20 20 20 20 20 20 28 6d 65 67 61 74 65 73 74 3a (megatest:
11540 73 74 65 70 20 0a 20 20 20 20 20 20 20 28 61 72 step . (ar
11550 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 gs:get-arg "-ste
11560 70 22 29 0a 20 20 20 20 20 20 20 28 6f 72 20 28 p"). (or (
11570 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
11580 74 61 74 65 22 29 28 61 72 67 73 3a 67 65 74 2d tate")(args:get-
11590 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a 20 arg ":state")).
115a0 20 20 20 20 20 20 28 6f 72 20 28 61 72 67 73 3a (or (args:
115b0 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 75 73 get-arg "-status
115c0 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
115d0 22 3a 73 74 61 74 75 73 22 29 29 0a 20 20 20 20 ":status")).
115e0 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
115f0 20 22 2d 73 65 74 6c 6f 67 22 29 0a 20 20 20 20 "-setlog").
11600 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
11610 20 22 2d 6d 22 29 29 0a 20 20 20 20 20 20 3b 3b "-m")). ;;
11620 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 (if db (sqlite3
11630 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
11640 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
11650 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
11660 0a 20 20 20 20 0a 28 69 66 20 28 6f 72 20 28 61 . .(if (or (a
11670 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
11680 74 6c 6f 67 22 29 20 20 20 20 20 20 20 3b 3b 20 tlog") ;;
11690 73 69 6e 63 65 20 73 65 74 74 69 6e 67 20 75 70 since setting up
116a0 20 69 73 20 73 6f 20 63 6f 73 74 6c 79 20 6c 65 is so costly le
116b0 74 73 20 70 69 67 67 79 62 61 63 6b 20 6f 6e 20 ts piggyback on
116c0 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 09 3b 3b -test-status..;;
116d0 20 20 20 20 20 28 6e 6f 74 20 28 61 72 67 73 3a (not (args:
116e0 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 get-arg "-step")
116f0 29 29 20 20 3b 3b 20 2d 73 65 74 6c 6f 67 20 6d )) ;; -setlog m
11700 61 79 20 68 61 76 65 20 62 65 65 6e 20 70 72 6f ay have been pro
11710 63 65 73 73 65 64 20 61 6c 72 65 61 64 79 20 69 cessed already i
11720 6e 20 74 68 65 20 22 2d 73 74 65 70 22 20 70 72 n the "-step" pr
11730 65 76 69 6f 75 73 0a 09 3b 3b 20 20 20 20 20 4e evious..;; N
11740 45 57 20 50 4f 4c 49 43 59 20 2d 20 2d 73 65 74 EW POLICY - -set
11750 6c 6f 67 20 73 65 74 73 20 74 65 73 74 20 6f 76 log sets test ov
11760 65 72 61 6c 6c 20 6c 6f 67 20 6f 6e 20 65 76 65 erall log on eve
11770 72 79 20 63 61 6c 6c 2e 0a 09 28 61 72 67 73 3a ry call...(args:
11780 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f get-arg "-set-to
11790 70 6c 6f 67 22 29 0a 09 28 61 72 67 73 3a 67 65 plog")..(args:ge
117a0 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 t-arg "-test-sta
117b0 74 75 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 tus")..(args:get
117c0 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 -arg "-set-value
117d0 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 s")..(args:get-a
117e0 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 rg "-load-test-d
117f0 61 74 61 22 29 0a 09 28 61 72 67 73 3a 67 65 74 ata")..(args:get
11800 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 -arg "-runstep")
11810 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
11820 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d "-summarize-item
11830 73 22 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f s")). (if (no
11840 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d t (getenv "MT_CM
11850 44 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e DINFO"))..(begin
11860 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
11870 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
11880 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 54 5f t-log-port* "MT_
11890 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 CMDINFO env var
118a0 6e 6f 74 20 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 not set, command
118b0 73 20 2d 74 65 73 74 2d 73 74 61 74 75 73 2c 20 s -test-status,
118c0 2d 72 75 6e 73 74 65 70 20 61 6e 64 20 2d 73 65 -runstep and -se
118d0 74 6c 6f 67 20 6d 75 73 74 20 62 65 20 63 61 6c tlog must be cal
118e0 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d led *inside* a m
118f0 65 67 61 74 65 73 74 20 65 6e 76 69 72 6f 6e 6d egatest environm
11900 65 6e 74 21 22 29 0a 09 20 20 28 65 78 69 74 20 ent!").. (exit
11910 35 29 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 5))..(let* ((sta
11920 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 65 6e rtingdir (curren
11930 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 20 t-directory))..
11940 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 (cmdinfo
11950 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e (common:read-en
11960 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 67 65 coded-string (ge
11970 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
11980 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 72 "))).. (tr
11990 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f 64 ansport (assoc/d
119a0 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f 72 efault 'transpor
119b0 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
119c0 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 (testpath (
119d0 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
119e0 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
119f0 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
11a00 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 -name (assoc/def
11a10 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 ault 'test-name
11a20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
11a30 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 (runscript (as
11a40 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
11a50 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 script cmdinfo))
11a60 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 .. (db-hos
11a70 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
11a80 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d lt 'db-host cm
11a90 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
11aa0 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f (run-id (asso
11ab0 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 c/default 'run-i
11ac0 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 d cmdinfo))..
11ad0 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 (test-id
11ae0 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
11af0 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 'test-id cmdi
11b00 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 nfo)).. (i
11b10 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f temdat (assoc/
11b20 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 default 'itemdat
11b30 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
11b40 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 (work-area
11b50 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
11b60 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 66 work-area cmdinf
11b70 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 20 o)).. (db
11b80 20 20 20 20 20 20 20 23 66 29 20 3b 3b 20 28 6f #f) ;; (o
11b90 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 20 20 pen-db))..
11ba0 20 28 73 74 61 74 65 20 20 20 20 20 28 61 72 67 (state (arg
11bb0 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
11bc0 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 e")).. (st
11bd0 61 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 atus (args:ge
11be0 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 t-arg ":status")
11bf0 29 0a 09 20 20 20 20 20 20 20 28 73 74 65 70 6e ).. (stepn
11c00 61 6d 65 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ame (args:get-a
11c10 72 67 20 22 2d 73 74 65 70 22 29 29 29 0a 09 20 rg "-step")))..
11c20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 (if (not (launc
11c30 68 3a 73 65 74 75 70 29 29 0a 09 20 20 20 20 20 h:setup))..
11c40 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
11c50 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
11c60 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
11c70 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
11c80 69 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 iting")...(exit
11c90 31 29 29 29 0a 0a 09 20 20 28 69 66 20 28 61 72 1)))... (if (ar
11ca0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
11cb0 73 74 65 70 22 29 28 64 65 62 75 67 3a 70 72 69 step")(debug:pri
11cc0 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 nt-info 1 *defau
11cd0 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 75 lt-log-port* "Ru
11ce0 6e 6e 69 6e 67 20 2d 72 75 6e 73 74 65 70 2c 20 nning -runstep,
11cf0 66 69 72 73 74 20 63 68 61 6e 67 65 20 74 6f 20 first change to
11d00 64 69 72 65 63 74 6f 72 79 20 22 20 77 6f 72 6b directory " work
11d10 2d 61 72 65 61 29 29 0a 09 20 20 28 63 68 61 6e -area)).. (chan
11d20 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 ge-directory wor
11d30 6b 2d 61 72 65 61 29 0a 09 20 20 3b 3b 20 63 61 k-area).. ;; ca
11d40 6e 20 73 65 74 75 70 20 61 73 20 63 6c 69 65 6e n setup as clien
11d50 74 20 66 6f 72 20 73 65 72 76 65 72 20 6d 6f 64 t for server mod
11d60 65 20 6e 6f 77 0a 09 20 20 3b 3b 20 28 63 6c 69 e now.. ;; (cli
11d70 65 6e 74 3a 73 65 74 75 70 29 0a 0a 09 20 20 28 ent:setup)... (
11d80 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
11d90 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 "-load-test-dat
11da0 61 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 68 61 a").. ;; ha
11db0 73 20 73 75 62 20 63 6f 6d 6d 61 6e 64 73 20 74 s sub commands t
11dc0 68 61 74 20 61 72 65 20 72 64 62 3a 0a 09 20 20 hat are rdb:..
11dd0 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 70 75 ;; DO NOT pu
11de0 74 20 74 68 69 73 20 6f 6e 65 20 69 6e 74 6f 20 t this one into
11df0 65 69 74 68 65 72 20 72 6d 74 3a 20 6f 72 20 6f either rmt: or o
11e00 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 0a 09 20 pen-run-close..
11e10 20 20 20 20 20 28 74 64 62 3a 6c 6f 61 64 2d 74 (tdb:load-t
11e20 65 73 74 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 est-data run-id
11e30 74 65 73 74 2d 69 64 29 29 0a 09 20 20 28 69 66 test-id)).. (if
11e40 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
11e50 2d 73 65 74 6c 6f 67 22 29 0a 09 20 20 20 20 20 -setlog")..
11e60 20 28 6c 65 74 20 28 28 6c 6f 67 66 6e 61 6d 65 (let ((logfname
11e70 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
11e80 2d 73 65 74 6c 6f 67 22 29 29 29 0a 09 09 28 72 -setlog")))...(r
11e90 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 mt:test-set-log!
11ea0 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
11eb0 6c 6f 67 66 6e 61 6d 65 29 29 29 0a 09 20 20 28 logfname))).. (
11ec0 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
11ed0 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a "-set-toplog").
11ee0 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 . ;; DO NOT
11ef0 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 run remote..
11f00 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 (tests:test-s
11f10 65 74 2d 74 6f 70 6c 6f 67 21 20 72 75 6e 2d 69 et-toplog! run-i
11f20 64 20 74 65 73 74 2d 6e 61 6d 65 20 28 61 72 67 d test-name (arg
11f30 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
11f40 74 6f 70 6c 6f 67 22 29 29 29 0a 09 20 20 28 69 toplog"))).. (i
11f50 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
11f60 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d "-summarize-item
11f70 73 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 44 4f s").. ;; DO
11f80 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a NOT run remote.
11f90 09 20 20 20 20 20 20 28 74 65 73 74 73 3a 73 75 . (tests:su
11fa0 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 72 75 mmarize-items ru
11fb0 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 n-id test-id tes
11fc0 74 2d 6e 61 6d 65 20 23 74 29 29 20 3b 3b 20 64 t-name #t)) ;; d
11fd0 6f 20 66 6f 72 63 65 20 68 65 72 65 0a 09 20 20 o force here..
11fe0 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
11ff0 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 20 g "-runstep")..
12000 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
12010 72 65 6d 61 72 67 73 29 0a 09 09 20 20 28 62 65 remargs)... (be
12020 67 69 6e 0a 09 09 20 20 20 20 28 64 65 62 75 67 gin... (debug
12030 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
12040 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
12050 2a 20 22 6e 6f 74 68 69 6e 67 20 73 70 65 63 69 * "nothing speci
12060 66 69 65 64 20 74 6f 20 72 75 6e 21 22 29 0a 09 fied to run!")..
12070 09 20 20 20 20 28 69 66 20 64 62 20 28 73 71 6c . (if db (sql
12080 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
12090 62 29 29 0a 09 09 20 20 20 20 28 65 78 69 74 20 b))... (exit
120a0 36 29 29 0a 09 09 20 20 28 6c 65 74 2a 20 28 28 6))... (let* ((
120b0 73 74 65 70 6e 61 6d 65 20 20 20 28 61 72 67 73 stepname (args
120c0 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 :get-arg "-runst
120d0 65 70 22 29 29 0a 09 09 09 20 28 6c 6f 67 70 72 ep")).... (logpr
120e0 6f 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d ofile (args:get-
120f0 61 72 67 20 22 2d 6c 6f 67 70 72 6f 22 29 29 0a arg "-logpro")).
12100 09 09 09 20 28 6c 6f 67 66 69 6c 65 20 20 20 20 ... (logfile
12110 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 (conc stepname "
12120 2e 6c 6f 67 22 29 29 0a 09 09 09 20 28 63 6d 64 .log")).... (cmd
12130 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c (if (nul
12140 6c 3f 20 72 65 6d 61 72 67 73 29 20 23 66 20 28 l? remargs) #f (
12150 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 0a 09 car remargs)))..
12160 09 09 20 28 70 61 72 61 6d 73 20 20 20 20 20 28 .. (params (
12170 69 66 20 63 6d 64 20 28 63 64 72 20 72 65 6d 61 if cmd (cdr rema
12180 72 67 73 29 20 27 28 29 29 29 0a 09 09 09 20 28 rgs) '())).... (
12190 65 78 69 74 73 74 61 74 20 20 20 23 66 29 0a 09 exitstat #f)..
121a0 09 09 20 28 73 68 65 6c 6c 20 20 20 20 20 20 28 .. (shell (
121b0 6c 65 74 20 28 28 73 68 20 28 67 65 74 2d 65 6e let ((sh (get-en
121c0 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
121d0 6c 65 20 22 53 48 45 4c 4c 22 29 20 29 29 0a 09 le "SHELL") ))..
121e0 09 09 09 20 20 20 20 20 20 20 28 69 66 20 73 68 ... (if sh
121f0 20 0a 09 09 09 09 09 20 20 20 28 6c 61 73 74 20 ...... (last
12200 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 73 68 (string-split sh
12210 20 22 2f 22 29 29 0a 09 09 09 09 09 20 20 20 22 "/"))...... "
12220 62 61 73 68 22 29 29 29 0a 09 09 09 20 28 72 65 bash"))).... (re
12230 64 69 72 20 20 20 20 20 20 28 63 61 73 65 20 28 dir (case (
12240 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 string->symbol s
12250 68 65 6c 6c 29 0a 09 09 09 09 20 20 20 20 20 20 hell).....
12260 20 28 28 74 63 73 68 20 63 73 68 20 6b 73 68 29 ((tcsh csh ksh)
12270 20 20 20 20 22 3e 26 22 29 0a 09 09 09 09 20 20 ">&").....
12280 20 20 20 20 20 28 28 7a 73 68 20 62 61 73 68 20 ((zsh bash
12290 73 68 20 61 73 68 29 20 22 32 3e 26 31 20 3e 22 sh ash) "2>&1 >"
122a0 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 65 6c )..... (el
122b0 73 65 20 22 3e 26 22 29 29 29 0a 09 09 09 20 28 se ">&"))).... (
122c0 66 75 6c 6c 63 6d 64 20 20 20 20 28 63 6f 6e 63 fullcmd (conc
122d0 20 22 28 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 "(" (string-int
122e0 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 09 09 ersperse .......
122f0 28 63 6f 6e 73 20 63 6d 64 20 70 61 72 61 6d 73 (cons cmd params
12300 29 20 22 20 22 29 0a 09 09 09 09 09 20 20 20 22 ) " ")...... "
12310 29 20 22 20 72 65 64 69 72 20 22 20 22 20 6c 6f ) " redir " " lo
12320 67 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 3b gfile)))... ;
12330 3b 20 6d 61 72 6b 20 74 68 65 20 73 74 61 72 74 ; mark the start
12340 20 6f 66 20 74 68 65 20 74 65 73 74 0a 09 09 20 of the test...
12350 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 65 70 (rmt:teststep
12360 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
12370 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 -id test-id step
12380 6e 61 6d 65 20 22 73 74 61 72 74 22 20 22 6e 2f name "start" "n/
12390 61 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 a" (args:get-arg
123a0 20 22 2d 6d 22 29 20 6c 6f 67 66 69 6c 65 29 0a "-m") logfile).
123b0 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 74 68 65 .. ;; run the
123c0 20 74 65 73 74 20 73 74 65 70 0a 09 09 20 20 20 test step...
123d0 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
123e0 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 2 *default-lo
123f0 67 2d 70 6f 72 74 2a 20 22 52 75 6e 6e 69 6e 67 g-port* "Running
12400 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 5c 22 \"" fullcmd "\"
12410 20 69 6e 20 64 69 72 65 63 74 6f 72 79 20 5c 22 in directory \"
12420 22 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 " startingdir)..
12430 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 . (change-dir
12440 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 64 ectory startingd
12450 69 72 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 ir)... (set!
12460 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65 6d exitstat (system
12470 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 20 20 20 fullcmd))...
12480 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 (set! *globalex
12490 69 74 73 74 61 74 75 73 2a 20 65 78 69 74 73 74 itstatus* exitst
124a0 61 74 29 0a 09 09 20 20 20 20 3b 3b 20 28 63 68 at)... ;; (ch
124b0 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
124c0 65 73 74 70 61 74 68 29 0a 09 09 20 20 20 20 3b estpath)... ;
124d0 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 66 20 ; run logpro if
124e0 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b 20 28 70 applicable ;; (p
124f0 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c 73 22 20 rocess-run "ls"
12500 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20 22 32 3e (list "/foo" "2>
12510 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67 22 29 29 &1" "blah.log"))
12520 0a 09 09 20 20 20 20 28 69 66 20 6c 6f 67 70 72 ... (if logpr
12530 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74 2a 20 28 ofile....(let* (
12540 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 28 63 6f (htmllogfile (co
12550 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 nc stepname ".ht
12560 6d 6c 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 ml"))....
12570 28 6f 6c 64 65 78 69 74 73 74 61 74 20 65 78 69 (oldexitstat exi
12580 74 73 74 61 74 29 0a 09 09 09 20 20 20 20 20 20 tstat)....
12590 20 28 63 6d 64 20 20 20 20 20 20 20 20 20 28 73 (cmd (s
125a0 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
125b0 65 20 28 6c 69 73 74 20 22 6c 6f 67 70 72 6f 22 e (list "logpro"
125c0 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68 74 6d 6c logprofile html
125d0 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c 6f 67 66 logfile "<" logf
125e0 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63 20 73 74 ile ">" (conc st
125f0 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70 72 6f 2e epname "_logpro.
12600 6c 6f 67 22 29 29 20 22 20 22 29 29 29 0a 09 09 log")) " ")))...
12610 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
12620 69 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d info 2 *default-
12630 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 75 6e 6e 69 log-port* "runni
12640 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 29 ng \"" cmd "\"")
12650 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 .... (change-di
12660 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 rectory starting
12670 64 69 72 29 0a 09 09 09 20 20 28 73 65 74 21 20 dir).... (set!
12680 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65 6d exitstat (system
12690 20 63 6d 64 29 29 0a 09 09 09 20 20 28 73 65 74 cmd)).... (set
126a0 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 ! *globalexitsta
126b0 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 20 3b tus* exitstat) ;
126c0 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 0a 09 ; no necessary..
126d0 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 .. (change-dire
126e0 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a ctory testpath).
126f0 09 09 09 20 20 28 72 6d 74 3a 74 65 73 74 2d 73 ... (rmt:test-s
12700 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 et-log! run-id t
12710 65 73 74 2d 69 64 20 68 74 6d 6c 6c 6f 67 66 69 est-id htmllogfi
12720 6c 65 29 29 29 0a 09 09 20 20 20 20 28 6c 65 74 le)))... (let
12730 20 28 28 6d 73 67 20 28 61 72 67 73 3a 67 65 74 ((msg (args:get
12740 2d 61 72 67 20 22 2d 6d 22 29 29 29 0a 09 09 20 -arg "-m")))...
12750 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 (rmt:testst
12760 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 ep-set-status! r
12770 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 un-id test-id st
12780 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 78 69 epname "end" exi
12790 74 73 74 61 74 20 6d 73 67 20 6c 6f 67 66 69 6c tstat msg logfil
127a0 65 29 29 0a 09 09 20 20 20 20 29 29 29 0a 09 20 e))... )))..
127b0 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 (if (or (args:g
127c0 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 et-arg "-test-st
127d0 61 74 75 73 22 29 0a 09 09 20 20 28 61 72 67 73 atus")... (args
127e0 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 :get-arg "-set-v
127f0 61 6c 75 65 73 22 29 29 0a 09 20 20 20 20 20 20 alues"))..
12800 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 75 73 (let ((newstatus
12810 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e 75 6d (cond.....((num
12820 62 65 72 3f 20 73 74 61 74 75 73 29 20 20 20 20 ber? status)
12830 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 (if (equal? s
12840 74 61 74 75 73 20 30 29 20 22 50 41 53 53 22 20 tatus 0) "PASS"
12850 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 28 61 "FAIL")).....((a
12860 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 74 61 74 nd (string? stat
12870 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 28 73 us)..... (s
12880 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 tring->number st
12890 61 74 75 73 29 29 28 69 66 20 28 65 71 75 61 6c atus))(if (equal
128a0 3f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 ? (string->numbe
128b0 72 20 73 74 61 74 75 73 29 20 30 29 20 22 50 41 r status) 0) "PA
128c0 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 09 09 SS" "FAIL"))....
128d0 09 28 65 6c 73 65 20 73 74 61 74 75 73 29 29 29 .(else status)))
128e0 0a 09 09 20 20 20 20 3b 3b 20 74 72 61 6e 73 66 ... ;; transf
128f0 65 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 79 73 er relevant keys
12900 20 69 6e 74 6f 20 61 20 68 61 73 68 20 74 6f 20 into a hash to
12910 62 65 20 70 61 73 73 65 64 20 74 6f 20 74 65 73 be passed to tes
12920 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a 09 09 t-set-status!...
12930 20 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 73 65 ;; could use
12940 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 20 49 an assoc list I
12950 20 67 75 65 73 73 2e 20 0a 09 09 20 20 20 20 28 guess. ... (
12960 6f 74 68 65 72 64 61 74 61 20 28 6c 65 74 20 28 otherdata (let (
12970 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d (res (make-hash-
12980 74 61 62 6c 65 29 29 29 0a 09 09 09 09 20 28 66 table)))..... (f
12990 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
129a0 28 6b 65 79 29 0a 09 09 09 09 09 20 20 20 20 20 (key)......
129b0 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
129c0 67 20 6b 65 79 29 0a 09 09 09 09 09 09 20 28 68 g key)....... (h
129d0 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 ash-table-set! r
129e0 65 73 20 6b 65 79 20 28 61 72 67 73 3a 67 65 74 es key (args:get
129f0 2d 61 72 67 20 6b 65 79 29 29 29 29 0a 09 09 09 -arg key))))....
12a00 09 09 20 20 20 28 6c 69 73 74 20 22 3a 76 61 6c .. (list ":val
12a10 75 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 78 70 ue" ":tol" ":exp
12a20 65 63 74 65 64 22 20 22 3a 66 69 72 73 74 5f 65 ected" ":first_e
12a30 72 72 22 20 22 3a 66 69 72 73 74 5f 77 61 72 6e rr" ":first_warn
12a40 22 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 61 74 " ":units" ":cat
12a50 65 67 6f 72 79 22 20 22 3a 76 61 72 69 61 62 6c egory" ":variabl
12a60 65 22 29 29 0a 09 09 09 09 20 72 65 73 29 29 29 e"))..... res)))
12a70 0a 09 09 28 69 66 20 28 61 6e 64 20 28 61 72 67 ...(if (and (arg
12a80 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
12a90 2d 73 74 61 74 75 73 22 29 0a 09 09 09 20 28 6f -status").... (o
12aa0 72 20 28 6e 6f 74 20 73 74 61 74 65 29 0a 09 09 r (not state)...
12ab0 09 20 20 20 20 20 28 6e 6f 74 20 73 74 61 74 75 . (not statu
12ac0 73 29 29 29 0a 09 09 20 20 20 20 28 62 65 67 69 s)))... (begi
12ad0 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 67 n... (debug
12ae0 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
12af0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
12b00 2a 20 22 59 6f 75 20 6d 75 73 74 20 73 70 65 63 * "You must spec
12b10 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a ify :state and :
12b20 73 74 61 74 75 73 20 77 69 74 68 20 65 76 65 72 status with ever
12b30 79 20 63 61 6c 6c 20 74 6f 20 2d 74 65 73 74 2d y call to -test-
12b40 73 74 61 74 75 73 5c 6e 22 20 68 65 6c 70 29 0a status\n" help).
12b50 09 09 20 20 20 20 20 20 28 69 66 20 28 73 71 6c .. (if (sql
12b60 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 64 ite3:database? d
12b70 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c b)(sqlite3:final
12b80 69 7a 65 21 20 64 62 29 29 0a 09 09 20 20 20 20 ize! db))...
12b90 20 20 28 65 78 69 74 20 36 29 29 29 0a 09 09 28 (exit 6)))...(
12ba0 6c 65 74 2a 20 28 28 6d 73 67 20 20 20 20 28 61 let* ((msg (a
12bb0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
12bc0 29 29 0a 09 09 20 20 20 20 20 20 20 28 6e 75 6d ))... (num
12bd0 6f 74 68 20 28 6c 65 6e 67 74 68 20 28 68 61 73 oth (length (has
12be0 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 6f 74 68 h-table-keys oth
12bf0 65 72 64 61 74 61 29 29 29 29 0a 09 09 20 20 3b erdata))))... ;
12c00 3b 20 43 6f 6e 76 65 72 74 20 74 6f 20 72 70 63 ; Convert to rpc
12c10 20 69 6e 73 69 64 65 20 74 68 65 20 74 65 73 74 inside the test
12c20 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
12c30 73 21 20 63 61 6c 6c 2c 20 6e 6f 74 20 68 65 72 s! call, not her
12c40 65 0a 09 09 20 20 28 74 65 73 74 73 3a 74 65 73 e... (tests:tes
12c50 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 t-set-status! ru
12c60 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 61 n-id test-id sta
12c70 74 65 20 6e 65 77 73 74 61 74 75 73 20 6d 73 67 te newstatus msg
12c80 20 6f 74 68 65 72 64 61 74 61 20 77 6f 72 6b 2d otherdata work-
12c90 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 61 29 area: work-area)
12ca0 29 29 29 0a 09 20 20 28 69 66 20 28 73 71 6c 69 ))).. (if (sqli
12cb0 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 64 62 te3:database? db
12cc0 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 )(sqlite3:finali
12cd0 7a 65 21 20 64 62 29 29 0a 09 20 20 28 73 65 74 ze! db)).. (set
12ce0 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
12cf0 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d #t))))..;;=====
12d00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12d10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12d20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12d30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12d40 3d 0a 3b 3b 20 56 61 72 69 6f 75 73 20 68 65 6c =.;; Various hel
12d50 70 65 72 20 63 6f 6d 6d 61 6e 64 73 20 63 61 6e per commands can
12d60 20 67 6f 20 62 65 6c 6f 77 20 68 65 72 65 0a 3b go below here.;
12d70 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
12d80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12d90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12da0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12db0 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 =======..(if (or
12dc0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
12dd0 2d 73 68 6f 77 6b 65 79 73 22 29 0a 20 20 20 20 -showkeys").
12de0 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
12df0 67 20 22 2d 73 68 6f 77 2d 6b 65 79 73 22 29 29 g "-show-keys"))
12e00 0a 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 23 . (let ((db #
12e10 66 29 0a 09 20 20 28 6b 65 79 73 20 23 66 29 29 f).. (keys #f))
12e20 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
12e30 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
12e40 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
12e50 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
12e60 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
12e70 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
12e80 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 p, exiting")..
12e90 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 (exit 1))).
12ea0 20 20 20 28 73 65 74 21 20 6b 65 79 73 20 28 72 (set! keys (r
12eb0 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 20 3b 3b mt:get-keys)) ;;
12ec0 20 20 64 62 29 29 0a 20 20 20 20 20 20 28 64 65 db)). (de
12ed0 62 75 67 3a 70 72 69 6e 74 20 31 20 2a 64 65 66 bug:print 1 *def
12ee0 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
12ef0 4b 65 79 73 3a 20 22 20 28 73 74 72 69 6e 67 2d Keys: " (string-
12f00 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 73 intersperse keys
12f10 20 22 2c 20 22 29 29 0a 20 20 20 20 20 20 28 69 ", ")). (i
12f20 66 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 62 f (sqlite3:datab
12f30 61 73 65 3f 20 64 62 29 28 73 71 6c 69 74 65 33 ase? db)(sqlite3
12f40 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
12f50 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
12f60 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
12f70 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
12f80 61 72 67 20 22 2d 67 75 69 22 29 0a 20 20 20 20 arg "-gui").
12f90 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 64 65 (begin. (de
12fa0 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
12fb0 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
12fc0 4c 6f 6f 6b 20 61 74 20 74 68 65 20 64 61 73 68 Look at the dash
12fd0 62 6f 61 72 64 20 66 6f 72 20 6e 6f 77 22 29 0a board for now").
12fe0 20 20 20 20 20 20 3b 3b 20 28 6d 65 67 61 74 65 ;; (megate
12ff0 73 74 2d 67 75 69 29 0a 20 20 20 20 20 20 28 73 st-gui). (s
13000 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
13010 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
13020 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 72 rgs:get-arg "-cr
13030 65 61 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 72 eate-megatest-ar
13040 65 61 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ea"). (begin.
13050 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c (genexampl
13060 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2e 63 6f e:mk-megatest.co
13070 6e 66 69 67 29 0a 20 20 20 20 20 20 28 73 65 74 nfig). (set
13080 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
13090 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
130a0 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 72 65 61 s:get-arg "-crea
130b0 74 65 2d 74 65 73 74 22 29 0a 20 20 20 20 28 6c te-test"). (l
130c0 65 74 20 28 28 74 65 73 74 6e 61 6d 65 20 28 61 et ((testname (a
130d0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 72 rgs:get-arg "-cr
130e0 65 61 74 65 2d 74 65 73 74 22 29 29 29 0a 20 20 eate-test"))).
130f0 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 3a (genexample:
13100 6d 6b 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 mk-megatest-test
13110 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 20 20 20 testname).
13120 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
13130 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d hing* #t)))..;;=
13140 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13150 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13160 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13170 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13180 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 =====.;; Update
13190 74 68 65 20 64 61 74 61 62 61 73 65 20 73 63 68 the database sch
131a0 65 6d 61 2c 20 63 6c 65 61 6e 20 75 70 20 74 68 ema, clean up th
131b0 65 20 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d e db.;;=========
131c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
13200 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
13210 20 22 2d 72 65 62 75 69 6c 64 2d 64 62 22 29 0a "-rebuild-db").
13220 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
13230 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 (if (not (launc
13240 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 65 h:setup)).. (be
13250 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a gin.. (debug:
13260 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
13270 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c -log-port* "Fail
13280 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
13290 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 78 ting") .. (ex
132a0 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 3b 3b it 1))). ;;
132b0 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c keep this one l
132c0 6f 63 61 6c 0a 20 20 20 20 20 20 28 6f 70 65 6e ocal. (open
132d0 2d 72 75 6e 2d 63 6c 6f 73 65 20 70 61 74 63 68 -run-close patch
132e0 2d 64 62 20 23 66 29 0a 20 20 20 20 20 20 28 73 -db #f). (s
132f0 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
13300 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
13310 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6c rgs:get-arg "-cl
13320 65 61 6e 75 70 2d 64 62 22 29 0a 20 20 20 20 28 eanup-db"). (
13330 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 begin. (if
13340 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 (not (launch:set
13350 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 up)).. (begin..
13360 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
13370 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
13380 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f port* "Failed to
13390 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
133a0 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ) .. (exit 1)
133b0 29 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 )). (let ((
133c0 64 62 73 74 72 75 63 74 20 28 64 62 3a 73 65 74 dbstruct (db:set
133d0 75 70 20 2a 74 6f 70 70 61 74 68 2a 29 29 29 0a up *toppath*))).
133e0 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a (common:
133f0 63 6c 65 61 6e 75 70 2d 64 62 20 64 62 73 74 72 cleanup-db dbstr
13400 75 63 74 29 29 0a 20 20 20 20 20 20 28 73 65 74 uct)). (set
13410 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
13420 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
13430 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 61 72 6b s:get-arg "-mark
13440 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 22 29 0a 20 -incompletes").
13450 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
13460 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 (if (not (launch
13470 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 65 67 :setup)).. (beg
13480 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 in.. (debug:p
13490 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
134a0 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 log-port* "Faile
134b0 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit
134c0 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 69 74 ing").. (exit
134d0 20 31 29 29 29 0a 20 20 20 20 20 20 28 6f 70 65 1))). (ope
134e0 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 66 n-run-close db:f
134f0 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 ind-and-mark-inc
13500 6f 6d 70 6c 65 74 65 20 23 66 29 0a 20 20 20 20 omplete #f).
13510 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
13520 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
13530 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13540 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13550 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13560 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13570 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 ======.;; Update
13580 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 61 20 the tests meta
13590 64 61 74 61 20 66 72 6f 6d 20 74 68 65 20 74 65 data from the te
135a0 73 74 63 6f 6e 66 69 67 20 66 69 6c 65 73 0a 3b stconfig files.;
135b0 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
135c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
135d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
135e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
135f0 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
13600 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 70 64 gs:get-arg "-upd
13610 61 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 20 28 ate-meta"). (
13620 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 begin. (if
13630 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 (not (launch:set
13640 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 up)).. (begin..
13650 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
13660 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
13670 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f port* "Failed to
13680 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
13690 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ) .. (exit 1)
136a0 29 29 0a 20 20 20 20 20 20 28 72 75 6e 73 3a 75 )). (runs:u
136b0 70 64 61 74 65 2d 61 6c 6c 2d 74 65 73 74 5f 6d pdate-all-test_m
136c0 65 74 61 20 23 66 29 0a 20 20 20 20 20 20 28 73 eta #f). (s
136d0 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
136e0 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d g* #t)))..;;====
136f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13700 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13710 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13720 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13730 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 61 20 72 65 ==.;; Start a re
13740 70 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d pl.;;===========
13750 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13760 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13770 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13780 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
13790 66 61 6b 65 6f 75 74 20 72 65 61 64 6c 69 6e 65 fakeout readline
137a0 0a 28 69 6e 63 6c 75 64 65 20 22 72 65 61 64 6c .(include "readl
137b0 69 6e 65 2d 66 69 78 2e 73 63 6d 22 29 0a 0a 0a ine-fix.scm")...
137c0 28 77 68 65 6e 20 28 61 72 67 73 3a 67 65 74 2d (when (args:get-
137d0 61 72 67 20 22 2d 64 69 66 66 2d 72 65 70 22 29 arg "-diff-rep")
137e0 0a 20 20 28 77 68 65 6e 20 28 61 6e 64 0a 20 20 . (when (and.
137f0 20 20 20 20 20 20 20 28 6e 6f 74 20 28 61 72 67 (not (arg
13800 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 69 66 66 s:get-arg "-diff
13810 2d 68 74 6d 6c 22 29 29 0a 20 20 20 20 20 20 20 -html")).
13820 20 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 (not (args:get
13830 2d 61 72 67 20 22 2d 64 69 66 66 2d 65 6d 61 69 -arg "-diff-emai
13840 6c 22 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 l"))). (debug
13850 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
13860 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 75 73 t-log-port* "Mus
13870 74 20 73 70 65 63 69 66 79 20 2d 64 69 66 66 2d t specify -diff-
13880 68 74 6d 6c 20 6f 72 20 2d 64 69 66 66 2d 65 6d html or -diff-em
13890 61 69 6c 20 77 69 74 68 20 2d 64 69 66 66 2d 72 ail with -diff-r
138a0 65 70 22 29 0a 20 20 20 20 28 73 65 74 21 20 2a ep"). (set! *
138b0 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 31 29 didsomething* 1)
138c0 0a 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 20 . (exit 1)).
138d0 20 0a 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 . (let* ((topp
138e0 61 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 ath (launch:setu
138f0 70 29 29 29 0a 20 20 20 20 28 64 6f 2d 64 69 66 p))). (do-dif
13900 66 2d 72 65 70 6f 72 74 0a 20 20 20 20 20 28 61 f-report. (a
13910 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 72 rgs:get-arg "-sr
13920 63 2d 74 61 72 67 65 74 22 29 0a 20 20 20 20 20 c-target").
13930 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
13940 73 72 63 2d 72 75 6e 6e 61 6d 65 22 29 0a 20 20 src-runname").
13950 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
13960 20 22 2d 74 61 72 67 65 74 22 29 0a 20 20 20 20 "-target").
13970 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
13980 2d 72 75 6e 6e 61 6d 65 22 29 0a 20 20 20 20 20 -runname").
13990 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
139a0 64 69 66 66 2d 68 74 6d 6c 22 29 0a 20 20 20 20 diff-html").
139b0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
139c0 2d 64 69 66 66 2d 65 6d 61 69 6c 22 29 29 0a 20 -diff-email")).
139d0 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
139e0 65 74 68 69 6e 67 2a 20 23 74 29 0a 20 20 20 20 ething* #t).
139f0 28 65 78 69 74 20 30 29 29 29 0a 0a 28 69 66 20 (exit 0)))..(if
13a00 28 6f 72 20 28 67 65 74 65 6e 76 20 22 4d 54 5f (or (getenv "MT_
13a10 52 55 4e 53 43 52 49 50 54 22 29 0a 09 28 61 72 RUNSCRIPT")..(ar
13a20 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 gs:get-arg "-rep
13a30 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 l")..(args:get-a
13a40 72 67 20 22 2d 6c 6f 61 64 22 29 29 0a 20 20 20 rg "-load")).
13a50 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 (let* ((toppath
13a60 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
13a70 0a 09 20 20 20 28 64 62 73 74 72 75 63 74 20 28 .. (dbstruct (
13a80 69 66 20 28 61 6e 64 20 74 6f 70 70 61 74 68 0a if (and toppath.
13a90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13aa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
13ab0 6f 6d 6d 6f 6e 3a 6f 6e 2d 68 6f 6d 65 68 6f 73 ommon:on-homehos
13ac0 74 3f 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t?)).
13ad0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 (d
13ae0 62 3a 73 65 74 75 70 29 0a 20 20 20 20 20 20 20 b:setup).
13af0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13b00 20 20 23 66 29 29 29 20 3b 3b 20 6d 61 6b 65 2d #f))) ;; make-
13b10 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 dbr:dbstruct pat
13b20 68 3a 20 74 6f 70 70 61 74 68 20 6c 6f 63 61 6c h: toppath local
13b30 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 : (args:get-arg
13b40 22 2d 6c 6f 63 61 6c 22 29 29 20 23 66 29 29 29 "-local")) #f)))
13b50 0a 20 20 20 20 20 20 28 69 66 20 2a 74 6f 70 70 . (if *topp
13b60 61 74 68 2a 0a 09 20 20 28 63 6f 6e 64 0a 09 20 ath*.. (cond..
13b70 20 20 28 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 ((getenv "MT_R
13b80 55 4e 53 43 52 49 50 54 22 29 0a 09 20 20 20 20 UNSCRIPT")..
13b90 3b 3b 20 48 6f 77 20 74 6f 20 72 75 6e 20 6d 65 ;; How to run me
13ba0 67 61 74 65 73 74 20 73 63 72 69 70 74 73 0a 09 gatest scripts..
13bb0 20 20 20 20 3b 3b 0a 09 20 20 20 20 3b 3b 20 23 ;;.. ;; #
13bc0 21 2f 62 69 6e 2f 62 61 73 68 0a 09 20 20 20 20 !/bin/bash..
13bd0 3b 3b 0a 09 20 20 20 20 3b 3b 20 65 78 70 6f 72 ;;.. ;; expor
13be0 74 20 4d 54 5f 52 55 4e 53 43 52 49 50 54 3d 79 t MT_RUNSCRIPT=y
13bf0 65 73 0a 09 20 20 20 20 3b 3b 20 6d 65 67 61 74 es.. ;; megat
13c00 65 73 74 20 3c 3c 20 45 4f 46 0a 09 20 20 20 20 est << EOF..
13c10 3b 3b 20 28 70 72 69 6e 74 20 22 48 65 6c 6c 6f ;; (print "Hello
13c20 20 77 6f 72 6c 64 22 29 0a 09 20 20 20 20 3b 3b world").. ;;
13c30 20 28 65 78 69 74 29 0a 09 20 20 20 20 3b 3b 20 (exit).. ;;
13c40 45 4f 46 0a 0a 09 20 20 20 20 28 72 65 70 6c 29 EOF... (repl)
13c50 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 20 20 20 ).. (else..
13c60 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 (begin.. (
13c70 73 65 74 21 20 2a 64 62 2a 20 64 62 73 74 72 75 set! *db* dbstru
13c80 63 74 29 0a 09 20 20 20 20 20 20 28 69 6d 70 6f ct).. (impo
13c90 72 74 20 65 78 74 72 61 73 29 20 3b 3b 20 6d 69 rt extras) ;; mi
13ca0 67 68 74 20 6e 6f 74 20 62 65 20 6e 65 65 64 65 ght not be neede
13cb0 64 0a 09 20 20 20 20 20 20 3b 3b 20 28 69 6d 70 d.. ;; (imp
13cc0 6f 72 74 20 63 73 69 29 0a 09 20 20 20 20 20 20 ort csi)..
13cd0 28 69 6d 70 6f 72 74 20 72 65 61 64 6c 69 6e 65 (import readline
13ce0 29 0a 09 20 20 20 20 20 20 28 69 6d 70 6f 72 74 ).. (import
13cf0 20 61 70 72 6f 70 6f 73 29 0a 09 20 20 20 20 20 apropos)..
13d00 20 3b 3b 20 28 69 6d 70 6f 72 74 20 28 70 72 65 ;; (import (pre
13d10 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 fix sqlite3 sqli
13d20 74 65 33 3a 29 29 20 3b 3b 20 64 6f 65 73 6e 27 te3:)) ;; doesn'
13d30 74 20 77 6f 72 6b 20 2e 2e 2e 0a 0a 09 20 20 20 t work ......
13d40 20 20 20 28 69 66 20 2a 75 73 65 2d 6e 65 77 2d (if *use-new-
13d50 72 65 61 64 6c 69 6e 65 2a 0a 09 09 20 20 28 62 readline*... (b
13d60 65 67 69 6e 0a 09 09 20 20 20 20 28 69 6e 73 74 egin... (inst
13d70 61 6c 6c 2d 68 69 73 74 6f 72 79 2d 66 69 6c 65 all-history-file
13d80 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e (get-environmen
13d90 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 t-variable "HOME
13da0 22 29 20 22 2e 6d 65 67 61 74 65 73 74 5f 68 69 ") ".megatest_hi
13db0 73 74 6f 72 79 22 29 20 3b 3b 20 20 5b 68 6f 6d story") ;; [hom
13dc0 65 64 69 72 5d 20 5b 66 69 6c 65 6e 61 6d 65 5d edir] [filename]
13dd0 20 5b 6e 6c 69 6e 65 73 5d 29 0a 09 09 20 20 20 [nlines])...
13de0 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 2d (current-input-
13df0 70 6f 72 74 20 28 6d 61 6b 65 2d 72 65 61 64 6c port (make-readl
13e00 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 65 ine-port "megate
13e10 73 74 3e 20 22 29 29 29 0a 09 09 20 20 28 62 65 st> ")))... (be
13e20 67 69 6e 0a 09 09 20 20 20 20 28 67 6e 75 2d 68 gin... (gnu-h
13e30 69 73 74 6f 72 79 2d 69 6e 73 74 61 6c 6c 2d 66 istory-install-f
13e40 69 6c 65 2d 6d 61 6e 61 67 65 72 0a 09 09 20 20 ile-manager...
13e50 20 20 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e (string-appen
13e60 64 0a 09 09 20 20 20 20 20 20 28 6f 72 20 28 67 d... (or (g
13e70 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
13e80 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 ariable "HOME")
13e90 22 2e 22 29 20 22 2f 2e 6d 65 67 61 74 65 73 74 ".") "/.megatest
13ea0 5f 68 69 73 74 6f 72 79 22 29 29 0a 09 09 20 20 _history"))...
13eb0 20 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 (current-input
13ec0 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 67 6e 75 2d -port (make-gnu-
13ed0 72 65 61 64 6c 69 6e 65 2d 70 6f 72 74 20 22 6d readline-port "m
13ee0 65 67 61 74 65 73 74 3e 20 22 29 29 29 29 0a 09 egatest> "))))..
13ef0 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a (if (args:
13f00 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 29 get-arg "-repl")
13f10 0a 09 09 20 20 28 72 65 70 6c 29 0a 09 09 20 20 ... (repl)...
13f20 28 6c 6f 61 64 20 28 61 72 67 73 3a 67 65 74 2d (load (args:get-
13f30 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 29 0a 09 arg "-load")))..
13f40 20 20 20 20 20 20 3b 3b 20 28 64 62 3a 63 6c 6f ;; (db:clo
13f50 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 29 se-all dbstruct)
13f60 20 3c 3d 20 74 61 6b 65 6e 20 63 61 72 65 20 6f <= taken care o
13f70 66 20 62 79 20 6f 6e 2d 65 78 69 74 20 63 61 6c f by on-exit cal
13f80 6c 0a 09 20 20 20 20 20 20 29 0a 09 20 20 20 20 l.. )..
13f90 28 65 78 69 74 29 29 29 0a 09 20 20 28 73 65 74 (exit))).. (set
13fa0 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
13fb0 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d #t))))..;;=====
13fc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13fd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13fe0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ff0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14000 3d 0a 3b 3b 20 57 61 69 74 20 6f 6e 20 61 20 72 =.;; Wait on a r
14010 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 65 0a 3b un to complete.;
14020 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
14030 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14040 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14050 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14060 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 6e =======..(if (an
14070 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
14080 22 2d 72 75 6e 2d 77 61 69 74 22 29 0a 09 20 28 "-run-wait").. (
14090 6e 6f 74 20 28 6f 72 20 28 61 72 67 73 3a 67 65 not (or (args:ge
140a0 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a 09 09 t-arg "-run")...
140b0 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
140c0 22 2d 72 75 6e 74 65 73 74 73 22 29 29 29 29 20 "-runtests"))))
140d0 3b 3b 20 72 75 6e 2d 77 61 69 74 20 69 73 20 62 ;; run-wait is b
140e0 75 69 6c 74 20 69 6e 74 6f 20 72 75 6e 74 65 73 uilt into runtes
140f0 74 73 20 6e 6f 77 0a 20 20 20 20 28 62 65 67 69 ts now. (begi
14100 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 n. (if (not
14110 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
14120 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
14130 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
14140 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
14150 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
14160 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 up, exiting") ..
14170 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
14180 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e (operate-on
14190 20 27 72 75 6e 2d 77 61 69 74 29 0a 20 20 20 20 'run-wait).
141a0 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
141b0 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
141c0 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 3b ;; ;; redo me ;
141d0 3b 20 4e 6f 74 20 63 6f 6e 76 65 72 74 65 64 20 ; Not converted
141e0 74 6f 20 75 73 65 20 64 62 73 74 72 75 63 74 20 to use dbstruct
141f0 79 65 74 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 yet.;; ;; ;; red
14200 6f 20 6d 65 20 3b 3b 0a 3b 3b 20 3b 3b 20 3b 3b o me ;;.;; ;; ;;
14210 20 72 65 64 6f 20 6d 65 20 28 69 66 20 28 61 72 redo me (if (ar
14220 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e gs:get-arg "-con
14230 76 65 72 74 2d 74 6f 2d 6e 6f 72 6d 22 29 0a 3b vert-to-norm").;
14240 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
14250 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 (let* ((topp
14260 61 74 68 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 ath (setup-for-r
14270 75 6e 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 un)).;; ;; ;; re
14280 64 6f 20 6d 65 20 09 20 20 20 28 64 62 73 74 72 do me . (dbstr
14290 75 63 74 20 28 69 66 20 74 6f 70 70 61 74 68 20 uct (if toppath
142a0 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 (make-dbr:dbstru
142b0 63 74 20 70 61 74 68 3a 20 74 6f 70 70 61 74 68 ct path: toppath
142c0 20 6c 6f 63 61 6c 3a 20 23 74 29 29 29 29 0a 3b local: #t)))).;
142d0 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
142e0 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
142f0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
14300 65 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 e (lambda
14310 20 28 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b (field).;; ;; ;
14320 3b 20 72 65 64 6f 20 6d 65 20 09 20 28 6c 65 74 ; redo me . (let
14330 20 28 28 64 61 74 20 27 28 29 29 29 0a 3b 3b 20 ((dat '())).;;
14340 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 ;; ;; redo me .
14350 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
14360 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
14370 6f 67 2d 70 6f 72 74 2a 20 22 47 65 74 74 69 6e og-port* "Gettin
14380 67 20 64 61 74 61 20 66 6f 72 20 66 69 65 6c 64 g data for field
14390 20 22 20 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 " field).;; ;;
143a0 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 ;; redo me . (
143b0 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
143c0 2d 72 6f 77 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 -row.;; ;; ;; re
143d0 64 6f 20 6d 65 20 09 20 20 20 20 28 6c 61 6d 62 do me . (lamb
143e0 64 61 20 28 69 64 20 76 61 6c 29 0a 3b 3b 20 3b da (id val).;; ;
143f0 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 ; ;; redo me .
14400 20 20 20 20 28 73 65 74 21 20 64 61 74 20 28 63 (set! dat (c
14410 6f 6e 73 20 28 6c 69 73 74 20 69 64 20 76 61 6c ons (list id val
14420 29 20 64 61 74 29 29 29 0a 3b 3b 20 3b 3b 20 3b ) dat))).;; ;; ;
14430 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 28 ; redo me . (
14440 64 62 3a 67 65 74 2d 64 62 20 64 62 20 72 75 6e db:get-db db run
14450 2d 69 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 -id).;; ;; ;; re
14460 64 6f 20 6d 65 20 09 20 20 20 20 28 63 6f 6e 63 do me . (conc
14470 20 22 53 45 4c 45 43 54 20 69 64 2c 22 20 66 69 "SELECT id," fi
14480 65 6c 64 20 22 20 46 52 4f 4d 20 74 65 73 74 73 eld " FROM tests
14490 3b 22 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 ;")).;; ;; ;; re
144a0 64 6f 20 6d 65 20 09 20 20 20 28 64 65 62 75 67 do me . (debug
144b0 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 :print-info 0 *d
144c0 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
144d0 20 22 66 6f 75 6e 64 20 22 20 28 6c 65 6e 67 74 "found " (lengt
144e0 68 20 64 61 74 29 20 22 20 69 74 65 6d 73 20 66 h dat) " items f
144f0 6f 72 20 66 69 65 6c 64 20 22 20 66 69 65 6c 64 or field " field
14500 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
14510 6d 65 20 09 20 20 20 28 6c 65 74 20 28 28 71 72 me . (let ((qr
14520 79 20 28 73 71 6c 69 74 65 33 3a 70 72 65 70 61 y (sqlite3:prepa
14530 72 65 20 64 62 20 28 63 6f 6e 63 20 22 55 50 44 re db (conc "UPD
14540 41 54 45 20 74 65 73 74 73 20 53 45 54 20 22 20 ATE tests SET "
14550 66 69 65 6c 64 20 22 3d 3f 20 57 48 45 52 45 20 field "=? WHERE
14560 69 64 3d 3f 3b 22 29 29 29 29 0a 3b 3b 20 3b 3b id=?;")))).;; ;;
14570 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
14580 20 20 28 66 6f 72 2d 65 61 63 68 0a 3b 3b 20 3b (for-each.;; ;
14590 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 ; ;; redo me .
145a0 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 74 65 (lambda (ite
145b0 6d 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f m).;; ;; ;; redo
145c0 20 6d 65 20 09 09 28 6c 65 74 20 28 28 6e 65 77 me ..(let ((new
145d0 76 61 6c 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 val ;; (sdb:qry
145e0 27 67 65 74 69 64 20 0a 3b 3b 20 3b 3b 20 3b 3b 'getid .;; ;; ;;
145f0 20 72 65 64 6f 20 6d 65 20 09 09 20 20 20 20 20 redo me ..
14600 20 20 28 63 61 64 72 20 69 74 65 6d 29 29 29 20 (cadr item)))
14610 3b 3b 20 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 ;; ).;; ;; ;; re
14620 64 6f 20 6d 65 20 09 09 20 20 28 69 66 20 28 6e do me .. (if (n
14630 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 77 76 61 ot (equal? newva
14640 6c 20 28 63 61 64 72 20 69 74 65 6d 29 29 29 0a l (cadr item))).
14650 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
14660 20 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a .. (debug:
14670 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
14680 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
14690 22 43 6f 6e 76 65 72 74 69 6e 67 20 22 20 28 63 "Converting " (c
146a0 61 64 72 20 69 74 65 6d 29 20 22 20 74 6f 20 22 adr item) " to "
146b0 20 6e 65 77 76 61 6c 20 22 20 66 6f 72 20 74 65 newval " for te
146c0 73 74 20 23 22 20 28 63 61 72 20 69 74 65 6d 29 st #" (car item)
146d0 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f )).;; ;; ;; redo
146e0 20 6d 65 20 09 09 20 20 28 73 71 6c 69 74 65 33 me .. (sqlite3
146f0 3a 65 78 65 63 75 74 65 20 71 72 79 20 6e 65 77 :execute qry new
14700 76 61 6c 20 28 63 61 72 20 69 74 65 6d 29 29 29 val (car item)))
14710 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
14720 6d 65 20 09 20 20 20 20 20 20 64 61 74 29 0a 3b me . dat).;
14730 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
14740 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 . (sqlite3:f
14750 69 6e 61 6c 69 7a 65 21 20 71 72 79 29 29 29 29 inalize! qry))))
14760 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
14770 65 20 20 20 20 20 20 20 20 28 64 62 3a 63 6c 6f e (db:clo
14780 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 29 se-all dbstruct)
14790 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
147a0 65 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 22 e (list "
147b0 75 6e 61 6d 65 22 20 22 72 75 6e 64 69 72 22 20 uname" "rundir"
147c0 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 22 63 6f "final_logf" "co
147d0 6d 6d 65 6e 74 22 29 29 0a 3b 3b 20 3b 3b 20 3b mment")).;; ;; ;
147e0 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 20 20 ; redo me
147f0 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
14800 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
14810 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
14820 69 6d 70 6f 72 74 2d 6d 65 67 61 74 65 73 74 2e import-megatest.
14830 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a db"). (begin.
14840 20 20 20 20 20 20 28 64 62 3a 6d 75 6c 74 69 2d (db:multi-
14850 64 62 2d 73 79 6e 63 20 0a 20 20 20 20 20 20 20 db-sync .
14860 28 64 62 3a 73 65 74 75 70 29 0a 20 20 20 20 20 (db:setup).
14870 20 20 27 6b 69 6c 6c 73 65 72 76 65 72 73 0a 20 'killservers.
14880 20 20 20 20 20 20 27 64 65 6a 75 6e 6b 0a 20 20 'dejunk.
14890 20 20 20 20 20 27 61 64 6a 2d 74 65 73 74 69 64 'adj-testid
148a0 73 0a 20 20 20 20 20 20 20 27 6f 6c 64 32 6e 65 s. 'old2ne
148b0 77 0a 20 20 20 20 20 20 20 3b 3b 20 27 6e 65 77 w. ;; 'new
148c0 32 6f 6c 64 0a 20 20 20 20 20 20 20 29 0a 20 20 2old. ).
148d0 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
148e0 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
148f0 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
14900 67 20 22 2d 73 79 6e 63 2d 74 6f 2d 6d 65 67 61 g "-sync-to-mega
14910 74 65 73 74 2e 64 62 22 29 0a 20 20 20 20 28 62 test.db"). (b
14920 65 67 69 6e 0a 20 20 20 20 20 20 28 64 62 3a 6d egin. (db:m
14930 75 6c 74 69 2d 64 62 2d 73 79 6e 63 20 0a 20 20 ulti-db-sync .
14940 20 20 20 20 20 28 64 62 3a 73 65 74 75 70 29 0a (db:setup).
14950 20 20 20 20 20 20 20 27 6e 65 77 32 6f 6c 64 0a 'new2old.
14960 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 20 28 ). (
14970 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
14980 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 ng* #t)))..(if (
14990 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 args:get-arg "-g
149a0 65 6e 65 72 61 74 65 2d 68 74 6d 6c 22 29 0a 20 enerate-html").
149b0 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 (let* ((toppa
149c0 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 th (launch:setup
149d0 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 74 ))). (if (t
149e0 65 73 74 73 3a 63 72 65 61 74 65 2d 68 74 6d 6c ests:create-html
149f0 2d 74 72 65 65 20 23 66 29 0a 20 20 20 20 20 20 -tree #f).
14a00 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
14a10 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
14a20 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 48 54 4d 4c -log-port* "HTML
14a30 20 6f 75 74 70 75 74 20 63 72 65 61 74 65 64 20 output created
14a40 69 6e 20 22 20 74 6f 70 70 61 74 68 20 22 2f 6c in " toppath "/l
14a50 74 2f 72 75 6e 73 2d 69 6e 64 65 78 2e 68 74 6d t/runs-index.htm
14a60 6c 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 64 l"). (d
14a70 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
14a80 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
14a90 22 46 61 69 6c 65 64 20 74 6f 20 63 72 65 61 74 "Failed to creat
14aa0 65 20 48 54 4d 4c 20 6f 75 74 70 75 74 20 69 6e e HTML output in
14ab0 20 22 20 74 6f 70 70 61 74 68 20 22 2f 6c 74 2f " toppath "/lt/
14ac0 72 75 6e 73 2d 69 6e 64 65 78 2e 68 74 6d 6c 22 runs-index.html"
14ad0 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
14ae0 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
14af0 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
14b00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14b10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14b20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14b30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
14b40 20 45 78 69 74 20 61 6e 64 20 63 6c 65 61 6e 20 Exit and clean
14b50 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d up.;;===========
14b60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14b70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14b80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14b90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
14ba0 20 28 6e 6f 74 20 2a 64 69 64 73 6f 6d 65 74 68 (not *didsometh
14bb0 69 6e 67 2a 29 0a 20 20 20 20 28 64 65 62 75 67 ing*). (debug
14bc0 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
14bd0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 68 65 6c 70 t-log-port* help
14be0 29 29 0a 3b 3b 28 42 42 3e 20 22 74 68 72 65 61 )).;;(BB> "threa
14bf0 64 2d 6a 6f 69 6e 21 20 77 61 74 63 68 64 6f 67 d-join! watchdog
14c00 22 29 0a 0a 3b 3b 20 6a 6f 69 6e 20 74 68 65 20 ")..;; join the
14c10 77 61 74 63 68 64 6f 67 20 74 68 72 65 61 64 20 watchdog thread
14c20 69 66 20 69 74 20 68 61 73 20 62 65 65 6e 20 74 if it has been t
14c30 68 72 65 61 64 2d 73 74 61 72 74 21 65 64 20 20 hread-start!ed
14c40 28 69 74 20 6d 61 79 20 6e 6f 74 20 68 61 76 65 (it may not have
14c50 20 62 65 65 6e 20 73 74 61 72 74 65 64 20 69 6e been started in
14c60 20 74 68 65 20 63 61 73 65 20 6f 66 20 61 20 73 the case of a s
14c70 65 72 76 65 72 20 74 68 61 74 20 6e 65 76 65 72 erver that never
14c80 20 65 6e 74 65 72 73 20 72 75 6e 6e 69 6e 67 20 enters running
14c90 73 74 61 74 65 29 0a 3b 3b 20 20 20 28 73 79 6d state).;; (sym
14ca0 62 6f 6c 73 20 72 65 74 75 72 6e 65 64 20 62 79 bols returned by
14cb0 20 74 68 72 65 61 64 2d 73 74 61 74 65 3a 20 63 thread-state: c
14cc0 72 65 61 74 65 64 20 72 65 61 64 79 20 72 75 6e reated ready run
14cd0 6e 69 6e 67 20 62 6c 6f 63 6b 65 64 20 73 75 73 ning blocked sus
14ce0 70 65 6e 64 65 64 20 73 6c 65 65 70 69 6e 67 20 pended sleeping
14cf0 74 65 72 6d 69 6e 61 74 65 64 20 64 65 61 64 29 terminated dead)
14d00 0a 28 69 66 20 28 74 68 72 65 61 64 3f 20 2a 77 .(if (thread? *w
14d10 61 74 63 68 64 6f 67 2a 29 0a 20 20 20 20 28 63 atchdog*). (c
14d20 61 73 65 20 28 74 68 72 65 61 64 2d 73 74 61 74 ase (thread-stat
14d30 65 20 2a 77 61 74 63 68 64 6f 67 2a 29 0a 20 20 e *watchdog*).
14d40 20 20 20 20 28 28 72 65 61 64 79 20 72 75 6e 6e ((ready runn
14d50 69 6e 67 20 62 6c 6f 63 6b 65 64 20 73 6c 65 65 ing blocked slee
14d60 70 69 6e 67 20 74 65 72 6d 69 6e 61 74 65 64 20 ping terminated
14d70 64 65 61 64 29 0a 20 20 20 20 20 20 20 28 74 68 dead). (th
14d80 72 65 61 64 2d 6a 6f 69 6e 21 20 2a 77 61 74 63 read-join! *watc
14d90 68 64 6f 67 2a 29 29 29 29 0a 0a 28 73 65 74 21 hdog*))))..(set!
14da0 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a 20 *time-to-exit*
14db0 23 74 29 0a 0a 28 69 66 20 28 6e 6f 74 20 28 65 #t)..(if (not (e
14dc0 71 3f 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 q? *globalexitst
14dd0 61 74 75 73 2a 20 30 29 29 0a 20 20 20 20 28 69 atus* 0)). (i
14de0 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
14df0 61 72 67 20 22 2d 72 75 6e 22 29 28 61 72 67 73 arg "-run")(args
14e00 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
14e10 73 74 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 sts")(args:get-a
14e20 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 29 0a 20 rg "-runall")).
14e30 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 (begin.
14e40 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
14e50 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
14e60 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 4f 54 45 -log-port* "NOTE
14e70 3a 20 53 75 62 70 72 6f 63 65 73 73 65 73 20 77 : Subprocesses w
14e80 69 74 68 20 6e 6f 6e 2d 7a 65 72 6f 20 65 78 69 ith non-zero exi
14e90 74 20 63 6f 64 65 20 64 65 74 65 63 74 65 64 3a t code detected:
14ea0 20 22 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 " *globalexitst
14eb0 61 74 75 73 2a 29 0a 20 20 20 20 20 20 20 20 20 atus*).
14ec0 20 20 28 65 78 69 74 20 30 29 29 0a 20 20 20 20 (exit 0)).
14ed0 20 20 20 20 28 63 61 73 65 20 2a 67 6c 6f 62 61 (case *globa
14ee0 6c 65 78 69 74 73 74 61 74 75 73 2a 0a 20 20 20 lexitstatus*.
14ef0 20 20 20 20 20 20 28 28 30 29 28 65 78 69 74 20 ((0)(exit
14f00 30 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 31 0)). ((1
14f10 29 28 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 )(exit 1)).
14f20 20 20 20 20 28 28 32 29 28 65 78 69 74 20 32 29 ((2)(exit 2)
14f30 29 0a 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 ). (else
14f40 20 28 65 78 69 74 20 33 29 29 29 29 29 0a (exit 3))))).