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 37 2c 20 4d 61 74 74 68 65 77 20 6-2017, 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 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n
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 63 6f 6e 74 6f 75 72 20 63 6e st. -contour cn
1b30: 61 6d 65 20 20 20 20 20 20 20 20 20 20 3a 20 61 ame : a
1b40: 64 64 20 61 20 6c 65 76 65 6c 20 6f 66 20 68 69 dd a level of hi
1b50: 65 72 61 72 63 79 20 74 6f 20 74 68 65 20 6c 69 erarcy to the li
1b60: 6e 6b 74 72 65 65 20 61 6e 64 20 72 75 6e 20 70 nktree and run p
1b70: 61 74 68 73 0a 20 20 2d 72 65 62 75 69 6c 64 2d aths. -rebuild-
1b80: 64 62 20 20 20 20 20 20 20 20 20 20 20 20 20 3a db :
1b90: 20 62 72 69 6e 67 20 74 68 65 20 64 61 74 61 62 bring the datab
1ba0: 61 73 65 20 73 63 68 65 6d 61 20 75 70 20 74 6f ase schema up to
1bb0: 20 64 61 74 65 0a 20 20 2d 63 6c 65 61 6e 75 70 date. -cleanup
1bc0: 2d 64 62 20 20 20 20 20 20 20 20 20 20 20 20 20 -db
1bd0: 3a 20 72 65 6d 6f 76 65 20 61 6e 79 20 6f 72 70 : remove any orp
1be0: 68 61 6e 20 72 65 63 6f 72 64 73 2c 20 76 61 63 han records, vac
1bf0: 75 75 6d 20 74 68 65 20 64 62 0a 20 20 2d 69 6d uum the db. -im
1c00: 70 6f 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 port-megatest.db
1c10: 20 20 20 20 20 3a 20 70 75 73 68 20 64 61 74 61 : push data
1c20: 20 66 72 6f 6d 20 6d 65 67 61 74 65 73 74 2e 64 from megatest.d
1c30: 62 20 74 6f 20 63 61 63 68 65 20 64 62 20 66 69 b to cache db fi
1c40: 6c 65 73 20 69 6e 20 2f 74 6d 70 2f 24 55 53 45 les in /tmp/$USE
1c50: 52 0a 20 20 2d 73 79 6e 63 2d 74 6f 2d 6d 65 67 R. -sync-to-meg
1c60: 61 74 65 73 74 2e 64 62 20 20 20 20 3a 20 70 75 atest.db : pu
1c70: 6c 6c 20 64 61 74 61 20 66 72 6f 6d 20 63 61 63 ll data from cac
1c80: 68 65 20 66 69 6c 65 73 20 69 6e 20 2f 74 6d 70 he files in /tmp
1c90: 2f 24 55 53 45 52 20 74 6f 20 6d 65 67 61 74 65 /$USER to megate
1ca0: 73 74 2e 64 62 0a 20 20 2d 73 79 6e 63 2d 74 6f st.db. -sync-to
1cb0: 20 64 65 73 74 20 20 20 20 20 20 20 20 20 20 20 dest
1cc0: 3a 20 73 79 6e 63 20 74 6f 20 6e 65 77 20 70 6f : sync to new po
1cd0: 73 74 67 72 65 73 71 6c 20 63 65 6e 74 72 61 6c stgresql central
1ce0: 20 73 74 79 6c 65 20 64 61 74 61 62 61 73 65 0a style database.
1cf0: 20 20 2d 75 70 64 61 74 65 2d 6d 65 74 61 20 20 -update-meta
1d00: 20 20 20 20 20 20 20 20 20 20 3a 20 75 70 64 61 : upda
1d10: 74 65 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 te the tests met
1d20: 61 64 61 74 61 20 66 6f 72 20 61 6c 6c 20 74 65 adata for all te
1d30: 73 74 73 0a 20 20 2d 73 65 74 76 61 72 73 20 56 sts. -setvars V
1d40: 41 52 31 3d 76 61 6c 31 2c 56 41 52 32 3d 76 61 AR1=val1,VAR2=va
1d50: 6c 32 20 3a 20 41 64 64 20 65 6e 76 69 72 6f 6e l2 : Add environ
1d60: 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 20 74 ment variables t
1d70: 6f 20 61 20 72 75 6e 20 4e 42 2f 2f 20 74 68 65 o a run NB// the
1d80: 73 65 20 61 72 65 0a 20 20 20 20 20 20 20 20 20 se are.
1d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1da0: 20 20 20 20 20 20 20 20 6f 76 65 72 77 72 69 74 overwrit
1db0: 74 65 6e 20 62 79 20 76 61 6c 75 65 73 20 73 65 ten by values se
1dc0: 74 20 69 6e 20 63 6f 6e 66 69 67 20 66 69 6c 65 t in config file
1dd0: 73 2e 0a 20 20 2d 73 65 72 76 65 72 20 2d 7c 68 s.. -server -|h
1de0: 6f 73 74 6e 61 6d 65 20 20 20 20 20 20 3a 20 73 ostname : s
1df0: 74 61 72 74 20 74 68 65 20 73 65 72 76 65 72 20 tart the server
1e00: 28 72 65 64 75 63 65 73 20 63 6f 6e 74 65 6e 74 (reduces content
1e10: 69 6f 6e 20 6f 6e 20 6d 65 67 61 74 65 73 74 2e ion on megatest.
1e20: 64 62 29 2c 20 75 73 65 0a 20 20 20 20 20 20 20 db), use.
1e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e40: 20 20 20 20 20 2d 20 74 6f 20 61 75 74 6f 6d 61 - to automa
1e50: 74 69 63 61 6c 6c 79 20 66 69 67 75 72 65 20 6f tically figure o
1e60: 75 74 20 68 6f 73 74 6e 61 6d 65 0a 20 20 2d 74 ut hostname. -t
1e70: 72 61 6e 73 70 6f 72 74 20 68 74 74 70 7c 72 70 ransport http|rp
1e80: 63 20 20 20 20 20 3a 20 75 73 65 20 68 74 74 70 c : use http
1e90: 20 6f 72 20 72 70 63 20 66 6f 72 20 74 72 61 6e or rpc for tran
1ea0: 73 70 6f 72 74 20 28 64 65 66 61 75 6c 74 20 69 sport (default i
1eb0: 73 20 68 74 74 70 29 20 0a 20 20 2d 64 61 65 6d s http) . -daem
1ec0: 6f 6e 69 7a 65 20 20 20 20 20 20 20 20 20 20 20 onize
1ed0: 20 20 20 3a 20 66 6f 72 6b 20 69 6e 74 6f 20 62 : fork into b
1ee0: 61 63 6b 67 72 6f 75 6e 64 20 61 6e 64 20 64 69 ackground and di
1ef0: 73 63 6f 6e 6e 65 63 74 20 66 72 6f 6d 20 73 74 sconnect from st
1f00: 64 69 6e 2f 6f 75 74 0a 20 20 2d 6c 6f 67 20 6c din/out. -log l
1f10: 6f 67 66 69 6c 65 20 20 20 20 20 20 20 20 20 20 ogfile
1f20: 20 20 3a 20 73 65 6e 64 20 73 74 64 6f 75 74 20 : send stdout
1f30: 61 6e 64 20 73 74 64 65 72 72 20 74 6f 20 6c 6f and stderr to lo
1f40: 67 66 69 6c 65 0a 20 20 2d 6c 69 73 74 2d 73 65 gfile. -list-se
1f50: 72 76 65 72 73 20 20 20 20 20 20 20 20 20 20 20 rvers
1f60: 3a 20 6c 69 73 74 20 74 68 65 20 73 65 72 76 65 : list the serve
1f70: 72 73 20 0a 20 20 2d 73 74 6f 70 2d 73 65 72 76 rs . -stop-serv
1f80: 65 72 20 69 64 20 20 20 20 20 20 20 20 20 3a 20 er id :
1f90: 73 74 6f 70 20 73 65 72 76 65 72 20 73 70 65 63 stop server spec
1fa0: 69 66 69 65 64 20 62 79 20 69 64 20 28 73 65 65 ified by id (see
1fb0: 20 6f 75 74 70 75 74 20 6f 66 20 2d 6c 69 73 74 output of -list
1fc0: 2d 73 65 72 76 65 72 73 29 2c 20 75 73 65 0a 20 -servers), use.
1fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fe0: 20 20 20 20 20 20 20 20 20 20 20 30 20 74 6f 20 0 to
1ff0: 6b 69 6c 6c 20 61 6c 6c 0a 20 20 2d 72 65 70 6c kill all. -repl
2000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2010: 20 20 20 3a 20 73 74 61 72 74 20 61 20 72 65 70 : start a rep
2020: 6c 20 28 75 73 65 66 75 6c 20 66 6f 72 20 65 78 l (useful for ex
2030: 74 65 6e 64 69 6e 67 20 6d 65 67 61 74 65 73 74 tending megatest
2040: 29 0a 20 20 2d 6c 6f 61 64 20 66 69 6c 65 2e 73 ). -load file.s
2050: 63 6d 20 20 20 20 20 20 20 20 20 20 3a 20 6c 6f cm : lo
2060: 61 64 20 61 6e 64 20 72 75 6e 20 66 69 6c 65 2e ad and run file.
2070: 73 63 6d 0a 20 20 2d 6d 61 72 6b 2d 69 6e 63 6f scm. -mark-inco
2080: 6d 70 6c 65 74 65 73 20 20 20 20 20 20 20 3a 20 mpletes :
2090: 66 69 6e 64 20 61 6e 64 20 6d 61 72 6b 20 69 6e find and mark in
20a0: 63 6f 6d 70 6c 65 74 65 20 74 65 73 74 73 0a 20 complete tests.
20b0: 20 2d 70 69 6e 67 20 72 75 6e 2d 69 64 7c 68 6f -ping run-id|ho
20c0: 73 74 3a 70 6f 72 74 20 20 3a 20 70 69 6e 67 20 st:port : ping
20d0: 73 65 72 76 65 72 2c 20 65 78 69 74 20 77 69 74 server, exit wit
20e0: 68 20 30 20 69 66 20 66 6f 75 6e 64 0a 20 20 2d h 0 if found. -
20f0: 64 65 62 75 67 20 4e 7c 4e 2c 4d 2c 4f 2e 2e 2e debug N|N,M,O...
2100: 20 20 20 20 20 20 20 3a 20 65 6e 61 62 6c 65 20 : enable
2110: 64 65 62 75 67 20 30 2d 4e 20 6f 72 20 4e 20 61 debug 0-N or N a
2120: 6e 64 20 4d 20 61 6e 64 20 4f 20 2e 2e 2e 0a 20 nd M and O ....
2130: 20 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 20 -config fname
2140: 20 20 20 20 20 20 20 20 20 3a 20 6f 76 65 72 72 : overr
2150: 69 64 65 20 74 68 65 20 6d 65 67 61 74 65 73 74 ide the megatest
2160: 2e 63 6f 6e 66 69 67 20 66 69 6c 65 20 77 69 74 .config file wit
2170: 68 20 66 6e 61 6d 65 0a 20 20 2d 61 70 70 65 6e h fname. -appen
2180: 64 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 20 d-config fname
2190: 20 20 3a 20 61 70 70 65 6e 64 20 66 6e 61 6d 65 : append fname
21a0: 20 74 6f 20 74 68 65 20 6d 65 67 61 74 65 73 74 to the megatest
21b0: 2e 63 6f 6e 66 69 67 20 66 69 6c 65 0a 0a 55 74 .config file..Ut
21c0: 69 6c 69 74 69 65 73 0a 20 20 2d 65 6e 76 32 66 ilities. -env2f
21d0: 69 6c 65 20 66 6e 61 6d 65 20 20 20 20 20 20 20 ile fname
21e0: 20 20 3a 20 77 72 69 74 65 20 74 68 65 20 65 6e : write the en
21f0: 76 69 72 6f 6e 6d 65 6e 74 20 74 6f 20 66 6e 61 vironment to fna
2200: 6d 65 2e 63 73 68 20 61 6e 64 20 66 6e 61 6d 65 me.csh and fname
2210: 2e 73 68 0a 20 20 2d 65 6e 76 63 61 70 20 61 20 .sh. -envcap a
2220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
2230: 73 61 76 65 20 63 75 72 72 65 6e 74 20 76 61 72 save current var
2240: 69 61 62 6c 65 73 20 6c 61 62 65 6c 65 64 20 61 iables labeled a
2250: 73 20 63 6f 6e 74 65 78 74 20 27 61 27 20 69 6e s context 'a' in
2260: 20 66 69 6c 65 20 65 6e 76 64 61 74 2e 64 62 0a file envdat.db.
2270: 20 20 2d 65 6e 76 64 65 6c 74 61 20 61 2d 62 20 -envdelta a-b
2280: 20 20 20 20 20 20 20 20 20 20 3a 20 6f 75 74 70 : outp
2290: 75 74 20 65 6e 76 69 72 6f 6d 65 6e 74 20 64 65 ut enviroment de
22a0: 6c 74 61 20 66 72 6f 6d 20 63 6f 6e 74 65 78 74 lta from context
22b0: 20 61 20 74 6f 20 63 6f 6e 74 65 78 74 20 62 20 a to context b
22c0: 74 6f 20 2d 6f 20 66 6e 61 6d 65 0a 20 20 20 20 to -o fname.
22d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22e0: 20 20 20 20 20 20 20 20 73 65 74 20 74 68 65 20 set the
22f0: 6f 75 74 70 75 74 20 6d 6f 64 65 20 77 69 74 68 output mode with
2300: 20 2d 64 75 6d 70 6d 6f 64 65 20 63 73 68 2c 20 -dumpmode csh,
2310: 62 61 73 68 20 6f 72 20 69 6e 69 0a 20 20 20 20 bash or ini.
2320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2330: 20 20 20 20 20 20 20 20 6e 6f 74 65 3a 20 69 6e note: in
2340: 69 20 66 6f 72 6d 61 74 20 77 69 6c 6c 20 75 73 i format will us
2350: 65 20 63 61 6c 6c 73 20 74 6f 20 75 73 65 20 63 e calls to use c
2360: 75 72 72 20 61 6e 64 20 6d 69 6e 69 6d 69 7a 65 urr and minimize
2370: 20 70 61 74 68 0a 20 20 2d 72 65 66 64 62 32 64 path. -refdb2d
2380: 61 74 20 72 65 66 64 62 20 20 20 20 20 20 20 20 at refdb
2390: 3a 20 63 6f 6e 76 65 72 74 20 72 65 66 64 62 20 : convert refdb
23a0: 74 6f 20 73 65 78 70 20 6f 72 20 74 6f 20 66 6f to sexp or to fo
23b0: 72 6d 61 74 20 73 70 65 63 69 66 69 65 64 20 62 rmat specified b
23c0: 79 20 73 2d 64 75 6d 70 6d 6f 64 65 0a 20 20 20 y s-dumpmode.
23d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23e0: 20 20 20 20 20 20 20 20 20 66 6f 72 6d 61 74 73 formats
23f0: 3a 20 70 65 72 6c 2c 20 72 75 62 79 2c 20 73 71 : perl, ruby, sq
2400: 6c 69 74 65 33 2c 20 63 73 76 20 28 66 6f 72 20 lite3, csv (for
2410: 63 73 76 20 74 68 65 20 2d 6f 20 70 61 72 61 6d csv the -o param
2420: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2430: 20 20 20 20 20 20 20 20 20 20 20 20 20 77 69 6c wil
2440: 6c 20 73 75 62 73 74 69 74 75 74 65 20 25 73 20 l substitute %s
2450: 66 6f 72 20 74 68 65 20 73 68 65 65 74 20 6e 61 for the sheet na
2460: 6d 65 20 69 6e 20 67 65 6e 65 72 61 74 69 6e 67 me in generating
2470: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6d 75 mu
2490: 6c 74 69 70 6c 65 20 73 68 65 65 74 73 29 0a 20 ltiple sheets).
24a0: 20 2d 6f 20 20 20 20 20 20 20 20 20 20 20 20 20 -o
24b0: 20 20 20 20 20 20 20 20 20 3a 20 6f 75 74 70 75 : outpu
24c0: 74 20 66 69 6c 65 20 66 6f 72 20 72 65 66 64 62 t file for refdb
24d0: 32 64 61 74 20 28 64 65 66 61 75 6c 74 73 20 74 2dat (defaults t
24e0: 6f 20 73 74 64 6f 75 74 29 0a 20 20 2d 61 72 63 o stdout). -arc
24f0: 68 69 76 65 20 63 6d 64 20 20 20 20 20 20 20 20 hive cmd
2500: 20 20 20 20 3a 20 61 72 63 68 69 76 65 20 72 75 : archive ru
2510: 6e 73 20 73 70 65 63 69 66 69 65 64 20 62 79 20 ns specified by
2520: 73 65 6c 65 63 74 6f 72 73 20 74 6f 20 6f 6e 65 selectors to one
2530: 20 6f 66 20 64 69 73 6b 73 20 73 70 65 63 69 66 of disks specif
2540: 69 65 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 ied.
2550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2560: 69 6e 20 74 68 65 20 5b 61 72 63 68 69 76 65 2d in the [archive-
2570: 64 69 73 6b 73 5d 20 73 65 63 74 69 6f 6e 2e 0a disks] section..
2580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2590: 20 20 20 20 20 20 20 20 20 20 20 20 63 6d 64 3a cmd:
25a0: 20 6b 65 65 70 2d 68 74 6d 6c 2c 20 72 65 73 74 keep-html, rest
25b0: 6f 72 65 2c 20 73 61 76 65 2c 20 73 61 76 65 2d ore, save, save-
25c0: 72 65 6d 6f 76 65 0a 20 20 2d 67 65 6e 65 72 61 remove. -genera
25d0: 74 65 2d 68 74 6d 6c 20 20 20 20 20 20 20 20 20 te-html
25e0: 20 3a 20 63 72 65 61 74 65 20 61 20 73 69 6d 70 : create a simp
25f0: 6c 65 20 68 74 6d 6c 20 74 72 65 65 20 66 6f 72 le html tree for
2600: 20 62 72 6f 77 73 69 6e 67 20 79 6f 75 72 20 72 browsing your r
2610: 75 6e 73 0a 0a 44 69 66 66 20 72 65 70 6f 72 74 uns..Diff report
2620: 0a 20 20 2d 64 69 66 66 2d 72 65 70 20 20 20 20 . -diff-rep
2630: 20 20 20 20 20 20 20 20 20 20 20 3a 20 67 65 6e : gen
2640: 65 72 61 74 65 20 64 69 66 66 20 72 65 70 6f 72 erate diff repor
2650: 74 20 28 6d 75 73 74 20 69 6e 63 6c 75 64 65 20 t (must include
2660: 2d 73 72 63 2d 74 61 72 67 65 74 2c 20 2d 73 72 -src-target, -sr
2670: 63 2d 72 75 6e 6e 61 6d 65 2c 20 2d 74 61 72 67 c-runname, -targ
2680: 65 74 2c 20 2d 72 75 6e 6e 61 6d 65 0a 20 20 20 et, -runname.
2690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 a
26c0: 6e 64 20 65 69 74 68 65 72 20 2d 64 69 66 66 2d nd either -diff-
26d0: 65 6d 61 69 6c 20 6f 72 20 2d 64 69 66 66 2d 68 email or -diff-h
26e0: 74 6d 6c 29 0a 20 20 2d 73 72 63 2d 74 61 72 67 tml). -src-targ
26f0: 65 74 20 3c 74 61 72 67 65 74 3e 0a 20 20 2d 73 et <target>. -s
2700: 72 63 2d 72 75 6e 6e 61 6d 65 20 3c 74 61 72 67 rc-runname <targ
2710: 65 74 3e 0a 20 20 2d 64 69 66 66 2d 65 6d 61 69 et>. -diff-emai
2720: 6c 20 3c 65 6d 61 69 6c 73 3e 20 20 20 20 3a 20 l <emails> :
2730: 63 6f 6d 6d 61 20 73 65 70 61 72 61 74 65 64 20 comma separated
2740: 6c 69 73 74 20 6f 66 20 65 6d 61 69 6c 20 61 64 list of email ad
2750: 64 72 65 73 73 65 73 20 74 6f 20 73 65 6e 64 20 dresses to send
2760: 64 69 66 66 20 72 65 70 6f 72 74 0a 20 20 2d 64 diff report. -d
2770: 69 66 66 2d 68 74 6d 6c 20 20 3c 72 65 70 2e 68 iff-html <rep.h
2780: 74 6d 6c 3e 20 20 3a 20 70 61 74 68 20 74 6f 20 tml> : path to
2790: 68 74 6d 6c 20 66 69 6c 65 20 74 6f 20 67 65 6e html file to gen
27a0: 65 72 61 74 65 0a 0a 53 70 72 65 61 64 73 68 65 erate..Spreadshe
27b0: 65 74 20 67 65 6e 65 72 61 74 69 6f 6e 0a 20 20 et generation.
27c0: 2d 65 78 74 72 61 63 74 2d 6f 64 73 20 66 6e 61 -extract-ods fna
27d0: 6d 65 2e 6f 64 73 20 20 3a 20 65 78 74 72 61 63 me.ods : extrac
27e0: 74 20 61 6e 20 6f 70 65 6e 20 64 6f 63 75 6d 65 t an open docume
27f0: 6e 74 20 73 70 72 65 61 64 73 68 65 65 74 20 66 nt spreadsheet f
2800: 72 6f 6d 20 74 68 65 20 64 61 74 61 62 61 73 65 rom the database
2810: 0a 20 20 2d 70 61 74 68 6d 6f 64 20 70 61 74 68 . -pathmod path
2820: 20 20 20 20 20 20 20 20 20 20 20 3a 20 69 6e 73 : ins
2830: 65 72 74 20 70 61 74 68 2c 20 69 2e 65 2e 20 70 ert path, i.e. p
2840: 61 74 68 2f 72 75 6e 61 6d 65 2f 69 74 65 6d 70 ath/runame/itemp
2850: 61 74 68 2f 6c 6f 67 66 69 6c 65 2e 68 74 6d 6c ath/logfile.html
2860: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2870: 20 20 20 20 20 20 20 20 20 20 20 20 20 77 69 6c wil
2880: 6c 20 63 6c 65 61 72 20 74 68 65 20 66 69 65 6c l clear the fiel
2890: 64 20 69 66 20 6e 6f 20 72 75 6e 64 69 72 2f 74 d if no rundir/t
28a0: 65 73 74 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 estname/itempath
28b0: 2f 6c 6f 67 66 69 6c 65 0a 20 20 20 20 20 20 20 /logfile.
28c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28d0: 20 20 20 20 20 69 66 20 69 74 20 63 6f 6e 74 61 if it conta
28e0: 69 6e 73 20 66 6f 72 77 61 72 64 20 73 6c 61 73 ins forward slas
28f0: 68 65 73 20 74 68 65 20 70 61 74 68 20 77 69 6c hes the path wil
2900: 6c 20 62 65 20 63 6f 6e 76 65 72 74 65 64 0a 20 l be converted.
2910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2920: 20 20 20 20 20 20 20 20 20 20 20 74 6f 20 77 69 to wi
2930: 6e 64 6f 77 73 20 73 74 79 6c 65 0a 47 65 74 74 ndows style.Gett
2940: 69 6e 67 20 73 74 61 72 74 65 64 0a 20 20 2d 63 ing started. -c
2950: 72 65 61 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 reate-megatest-a
2960: 72 65 61 20 20 20 20 20 20 20 3a 20 63 72 65 61 rea : crea
2970: 74 65 20 61 20 73 6b 65 6c 65 74 6f 6e 20 6d 65 te a skeleton me
2980: 67 61 74 65 73 74 20 61 72 65 61 2e 20 59 6f 75 gatest area. You
2990: 20 77 69 6c 6c 20 62 65 20 70 72 6f 6d 70 74 65 will be prompte
29a0: 64 20 66 6f 72 20 70 61 74 68 73 0a 20 20 2d 63 d for paths. -c
29b0: 72 65 61 74 65 2d 74 65 73 74 20 74 65 73 74 6e reate-test testn
29c0: 61 6d 65 20 20 20 20 20 20 20 3a 20 63 72 65 61 ame : crea
29d0: 74 65 20 61 20 73 6b 65 6c 65 74 6f 6e 20 6d 65 te a skeleton me
29e0: 67 61 74 65 73 74 20 74 65 73 74 2e 20 59 6f 75 gatest test. You
29f0: 20 77 69 6c 6c 20 62 65 20 70 72 6f 6d 70 74 65 will be prompte
2a00: 64 20 66 6f 72 20 69 6e 66 6f 0a 0a 45 78 61 6d d for info..Exam
2a10: 70 6c 65 73 0a 0a 23 20 47 65 74 20 74 65 73 74 ples..# Get test
2a20: 20 70 61 74 68 2c 20 75 73 65 20 27 2e 27 20 74 path, use '.' t
2a30: 6f 20 67 65 74 20 61 20 73 69 6e 67 6c 65 20 70 o get a single p
2a40: 61 74 68 20 6f 72 20 61 20 73 70 65 63 69 66 69 ath or a specifi
2a50: 63 20 70 61 74 68 2f 66 69 6c 65 20 70 61 74 74 c path/file patt
2a60: 65 72 6e 0a 6d 65 67 61 74 65 73 74 20 2d 74 65 ern.megatest -te
2a70: 73 74 2d 66 69 6c 65 73 20 27 6c 6f 67 73 2f 2a st-files 'logs/*
2a80: 2e 6c 6f 67 27 20 2d 74 61 72 67 65 74 20 75 62 .log' -target ub
2a90: 75 6e 74 75 2f 6e 25 2f 6e 6f 25 20 2d 72 75 6e untu/n%/no% -run
2aa0: 6e 61 6d 65 20 77 34 39 25 20 2d 74 65 73 74 70 name w49% -testp
2ab0: 61 74 74 20 74 65 73 74 5f 6d 74 25 0a 0a 43 61 att test_mt%..Ca
2ac0: 6c 6c 65 64 20 61 73 20 22 20 28 73 74 72 69 6e lled as " (strin
2ad0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 61 g-intersperse (a
2ae0: 72 67 76 29 20 22 20 22 29 20 22 0a 56 65 72 73 rgv) " ") ".Vers
2af0: 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 2d 76 ion " megatest-v
2b00: 65 72 73 69 6f 6e 20 22 2c 20 62 75 69 6c 74 20 ersion ", built
2b10: 66 72 6f 6d 20 22 20 6d 65 67 61 74 65 73 74 2d from " megatest-
2b20: 66 6f 73 73 69 6c 2d 68 61 73 68 20 29 29 0a 0a fossil-hash ))..
2b30: 3b 3b 20 20 2d 67 75 69 20 20 20 20 20 20 20 20 ;; -gui
2b40: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 74 : st
2b50: 61 72 74 20 61 20 67 75 69 20 69 6e 74 65 72 66 art a gui interf
2b60: 61 63 65 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 20 ace..;; process
2b70: 61 72 67 73 0a 28 64 65 66 69 6e 65 20 72 65 6d args.(define rem
2b80: 61 72 67 73 20 28 61 72 67 73 3a 67 65 74 2d 61 args (args:get-a
2b90: 72 67 73 20 0a 09 09 20 28 61 72 67 76 29 0a 09 rgs ... (argv)..
2ba0: 09 20 28 6c 69 73 74 20 20 22 2d 72 75 6e 74 65 . (list "-runte
2bb0: 73 74 73 22 20 20 3b 3b 20 72 75 6e 20 61 20 73 sts" ;; run a s
2bc0: 70 65 63 69 66 69 63 20 74 65 73 74 0a 09 09 09 pecific test....
2bd0: 22 2d 63 6f 6e 66 69 67 22 20 20 20 20 3b 3b 20 "-config" ;;
2be0: 6f 76 65 72 72 69 64 65 20 74 68 65 20 63 6f 6e override the con
2bf0: 66 69 67 20 66 69 6c 65 20 6e 61 6d 65 0a 09 09 fig file name...
2c00: 09 22 2d 61 70 70 65 6e 64 2d 63 6f 6e 66 69 67 ."-append-config
2c10: 22 0a 09 09 09 22 2d 65 78 65 63 75 74 65 22 20 "...."-execute"
2c20: 20 20 3b 3b 20 72 75 6e 20 74 68 65 20 63 6f 6d ;; run the com
2c30: 6d 61 6e 64 20 65 6e 63 6f 64 65 64 20 69 6e 20 mand encoded in
2c40: 74 68 65 20 62 61 73 65 36 34 20 70 61 72 61 6d the base64 param
2c50: 65 74 65 72 0a 09 09 09 22 2d 73 74 65 70 22 0a eter...."-step".
2c60: 09 09 09 22 2d 74 61 72 67 65 74 22 0a 09 09 09 ..."-target"....
2c70: 22 2d 72 65 71 74 61 72 67 22 0a 09 09 09 22 3a "-reqtarg"....":
2c80: 72 75 6e 6e 61 6d 65 22 0a 09 09 09 22 2d 72 75 runname"...."-ru
2c90: 6e 6e 61 6d 65 22 0a 09 09 09 22 3a 73 74 61 74 nname"....":stat
2ca0: 65 22 20 20 0a 09 09 09 22 2d 73 74 61 74 65 22 e" ...."-state"
2cb0: 0a 09 09 09 22 3a 73 74 61 74 75 73 22 0a 09 09 ....":status"...
2cc0: 09 22 2d 73 74 61 74 75 73 22 0a 09 09 09 22 2d ."-status"...."-
2cd0: 6c 69 73 74 2d 72 75 6e 73 22 0a 09 09 09 22 2d list-runs"...."-
2ce0: 74 65 73 74 70 61 74 74 22 0a 20 20 20 20 20 20 testpatt".
2cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d00: 20 20 22 2d 2d 6d 6f 64 65 70 61 74 74 22 0a 20 "--modepatt".
2d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d20: 20 20 20 20 20 20 20 22 2d 74 61 67 65 78 70 72 "-tagexpr
2d30: 22 0a 09 09 09 22 2d 69 74 65 6d 70 61 74 74 22 "...."-itempatt"
2d40: 0a 09 09 09 22 2d 73 65 74 6c 6f 67 22 0a 09 09 ...."-setlog"...
2d50: 09 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 0a 09 ."-set-toplog"..
2d60: 09 09 22 2d 72 75 6e 73 74 65 70 22 0a 09 09 09 .."-runstep"....
2d70: 22 2d 6c 6f 67 70 72 6f 22 0a 09 09 09 22 2d 6d "-logpro"...."-m
2d80: 22 0a 09 09 09 22 2d 72 65 72 75 6e 22 0a 09 09 "...."-rerun"...
2d90: 09 22 2d 64 61 79 73 22 0a 09 09 09 22 2d 72 65 ."-days"...."-re
2da0: 6e 61 6d 65 2d 72 75 6e 22 0a 09 09 09 22 2d 74 name-run"...."-t
2db0: 6f 22 0a 09 09 09 3b 3b 20 76 61 6c 75 65 73 20 o"....;; values
2dc0: 61 6e 64 20 6d 65 73 73 61 67 65 73 0a 09 09 09 and messages....
2dd0: 22 3a 63 61 74 65 67 6f 72 79 22 0a 09 09 09 22 ":category"...."
2de0: 3a 76 61 72 69 61 62 6c 65 22 0a 09 09 09 22 3a :variable"....":
2df0: 76 61 6c 75 65 22 0a 09 09 09 22 3a 65 78 70 65 value"....":expe
2e00: 63 74 65 64 22 0a 09 09 09 22 3a 74 6f 6c 22 0a cted"....":tol".
2e10: 09 09 09 22 3a 75 6e 69 74 73 22 0a 09 09 09 3b ...":units"....;
2e20: 3b 20 6d 69 73 63 0a 09 09 09 22 2d 73 74 61 72 ; misc...."-star
2e30: 74 2d 64 69 72 22 0a 09 09 09 22 2d 63 6f 6e 74 t-dir"...."-cont
2e40: 6f 75 72 22 0a 09 09 09 22 2d 73 65 72 76 65 72 our"...."-server
2e50: 22 0a 09 09 09 22 2d 73 74 6f 70 2d 73 65 72 76 "...."-stop-serv
2e60: 65 72 22 0a 09 09 09 22 2d 74 72 61 6e 73 70 6f er"...."-transpo
2e70: 72 74 22 0a 09 09 09 22 2d 6b 69 6c 6c 2d 73 65 rt"...."-kill-se
2e80: 72 76 65 72 22 0a 09 09 09 22 2d 70 6f 72 74 22 rver"...."-port"
2e90: 0a 09 09 09 22 2d 65 78 74 72 61 63 74 2d 6f 64 ...."-extract-od
2ea0: 73 22 0a 09 09 09 22 2d 70 61 74 68 6d 6f 64 22 s"...."-pathmod"
2eb0: 0a 09 09 09 22 2d 65 6e 76 32 66 69 6c 65 22 0a ...."-env2file".
2ec0: 09 09 09 22 2d 65 6e 76 63 61 70 22 0a 09 09 09 ..."-envcap"....
2ed0: 22 2d 65 6e 76 64 65 6c 74 61 22 0a 09 09 09 22 "-envdelta"...."
2ee0: 2d 73 65 74 76 61 72 73 22 0a 09 09 09 22 2d 73 -setvars"...."-s
2ef0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 et-state-status"
2f00: 0a 09 09 09 22 2d 73 65 74 2d 72 75 6e 2d 73 74 ...."-set-run-st
2f10: 61 74 75 73 22 0a 09 09 09 22 2d 64 65 62 75 67 atus"...."-debug
2f20: 22 20 3b 3b 20 66 6f 72 20 2a 76 65 72 62 6f 73 " ;; for *verbos
2f30: 69 74 79 2a 20 3e 20 32 0a 09 09 09 22 2d 63 72 ity* > 2...."-cr
2f40: 65 61 74 65 2d 74 65 73 74 22 0a 09 09 09 22 2d eate-test"...."-
2f50: 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 74 override-timeout
2f60: 22 0a 09 09 09 22 2d 74 65 73 74 2d 66 69 6c 65 "...."-test-file
2f70: 73 22 20 20 3b 3b 20 2d 74 65 73 74 2d 70 61 74 s" ;; -test-pat
2f80: 68 73 20 69 73 20 66 6f 72 20 6c 69 73 74 69 6e hs is for listin
2f90: 67 20 61 6c 6c 0a 09 09 09 22 2d 6c 6f 61 64 22 g all...."-load"
2fa0: 20 20 20 20 20 20 20 20 3b 3b 20 6c 6f 61 64 20 ;; load
2fb0: 61 6e 64 20 65 78 65 63 74 75 74 65 20 61 20 73 and exectute a s
2fc0: 63 68 65 6d 65 20 66 69 6c 65 0a 09 09 09 22 2d cheme file...."-
2fd0: 73 65 63 74 69 6f 6e 22 0a 09 09 09 22 2d 76 61 section"...."-va
2fe0: 72 22 0a 09 09 09 22 2d 64 75 6d 70 6d 6f 64 65 r"...."-dumpmode
2ff0: 22 0a 09 09 09 22 2d 72 75 6e 2d 69 64 22 0a 09 "...."-run-id"..
3000: 09 09 22 2d 70 69 6e 67 22 0a 09 09 09 22 2d 72 .."-ping"...."-r
3010: 65 66 64 62 32 64 61 74 22 0a 09 09 09 22 2d 6f efdb2dat"...."-o
3020: 22 0a 09 09 09 22 2d 6c 6f 67 22 0a 09 09 09 22 "...."-log"...."
3030: 2d 61 72 63 68 69 76 65 22 0a 09 09 09 22 2d 73 -archive"...."-s
3040: 69 6e 63 65 22 0a 09 09 09 22 2d 66 69 65 6c 64 ince"...."-field
3050: 73 22 0a 09 09 09 22 2d 72 65 63 6f 76 65 72 2d s"...."-recover-
3060: 74 65 73 74 22 20 3b 3b 20 72 75 6e 2d 69 64 2c test" ;; run-id,
3070: 74 65 73 74 2d 69 64 20 2d 20 75 73 65 64 20 69 test-id - used i
3080: 6e 74 65 72 6e 61 6c 6c 79 20 74 6f 20 72 65 63 nternally to rec
3090: 6f 76 65 72 20 61 20 74 65 73 74 20 73 74 75 63 over a test stuc
30a0: 6b 20 69 6e 20 52 55 4e 4e 49 4e 47 20 73 74 61 k in RUNNING sta
30b0: 74 65 0a 09 09 09 22 2d 73 6f 72 74 22 0a 09 09 te...."-sort"...
30c0: 09 22 2d 74 61 72 67 65 74 2d 64 62 22 0a 09 09 ."-target-db"...
30d0: 09 22 2d 73 6f 75 72 63 65 2d 64 62 22 0a 0a 20 ."-source-db"..
30e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
30f0: 20 20 20 20 20 20 20 22 2d 73 72 63 2d 74 61 72 "-src-tar
3100: 67 65 74 22 0a 20 20 20 20 20 20 20 20 20 20 20 get".
3110: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 2d 73 "-s
3120: 72 63 2d 72 75 6e 6e 61 6d 65 22 0a 20 20 20 20 rc-runname".
3130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3140: 20 20 20 20 22 2d 64 69 66 66 2d 65 6d 61 69 6c "-diff-email
3150: 22 0a 09 09 09 22 2d 73 79 6e 63 2d 74 6f 22 0a "...."-sync-to".
3160: 09 09 09 22 2d 70 72 65 66 69 78 2d 74 61 72 67 ..."-prefix-targ
3170: 65 74 22 09 09 09 0a 09 09 09 22 2d 70 67 73 79 et"......."-pgsy
3180: 6e 63 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 nc".
3190: 20 20 20 20 20 20 20 20 20 20 20 20 22 2d 64 69 "-di
31a0: 66 66 2d 68 74 6d 6c 22 0a 09 09 09 29 0a 20 09 ff-html"....). .
31b0: 09 20 28 6c 69 73 74 20 20 22 2d 68 22 20 22 2d . (list "-h" "-
31c0: 68 65 6c 70 22 20 22 2d 2d 68 65 6c 70 22 0a 09 help" "--help"..
31d0: 09 09 22 2d 6d 61 6e 75 61 6c 22 0a 09 09 09 22 .."-manual"...."
31e0: 2d 76 65 72 73 69 6f 6e 22 0a 09 09 20 20 20 20 -version"...
31f0: 20 20 20 20 22 2d 66 6f 72 63 65 22 0a 09 09 20 "-force"...
3200: 20 20 20 20 20 20 20 22 2d 78 74 65 72 6d 22 0a "-xterm".
3210: 09 09 20 20 20 20 20 20 20 20 22 2d 73 68 6f 77 .. "-show
3220: 6b 65 79 73 22 0a 09 09 20 20 20 20 20 20 20 20 keys"...
3230: 22 2d 73 68 6f 77 2d 6b 65 79 73 22 0a 09 09 20 "-show-keys"...
3240: 20 20 20 20 20 20 20 22 2d 74 65 73 74 2d 73 74 "-test-st
3250: 61 74 75 73 22 0a 09 09 09 22 2d 73 65 74 2d 76 atus"...."-set-v
3260: 61 6c 75 65 73 22 0a 09 09 09 22 2d 6c 6f 61 64 alues"...."-load
3270: 2d 74 65 73 74 2d 64 61 74 61 22 0a 09 09 09 22 -test-data"...."
3280: 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 -summarize-items
3290: 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d 67 75 "... "-gu
32a0: 69 22 0a 09 09 09 22 2d 64 61 65 6d 6f 6e 69 7a i"...."-daemoniz
32b0: 65 22 0a 09 09 09 22 2d 70 72 65 63 6c 65 61 6e e"...."-preclean
32c0: 22 0a 09 09 09 22 2d 72 65 72 75 6e 2d 63 6c 65 "...."-rerun-cle
32d0: 61 6e 22 0a 09 09 09 22 2d 72 65 72 75 6e 2d 61 an"...."-rerun-a
32e0: 6c 6c 22 0a 09 09 09 22 2d 63 6c 65 61 6e 2d 63 ll"...."-clean-c
32f0: 61 63 68 65 22 0a 09 09 09 22 2d 63 61 63 68 65 ache"...."-cache
3300: 2d 64 62 22 0a 20 20 20 20 20 20 20 20 20 20 20 -db".
3310: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 2d 75 "-u
3320: 73 65 2d 64 62 2d 63 61 63 68 65 22 0a 09 09 09 se-db-cache"....
3330: 3b 3b 20 6d 69 73 63 0a 09 09 09 22 2d 72 65 70 ;; misc...."-rep
3340: 6c 22 0a 09 09 09 22 2d 6c 6f 63 6b 22 0a 09 09 l"...."-lock"...
3350: 09 22 2d 75 6e 6c 6f 63 6b 22 0a 09 09 09 22 2d ."-unlock"...."-
3360: 6c 69 73 74 2d 73 65 72 76 65 72 73 22 0a 20 20 list-servers".
3370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3380: 20 20 20 20 20 20 22 2d 72 75 6e 2d 77 61 69 74 "-run-wait
3390: 22 20 20 20 20 20 20 3b 3b 20 77 61 69 74 20 6f " ;; wait o
33a0: 6e 20 61 20 72 75 6e 20 74 6f 20 63 6f 6d 70 6c n a run to compl
33b0: 65 74 65 20 28 69 2e 65 2e 20 6e 6f 20 52 55 4e ete (i.e. no RUN
33c0: 4e 49 4e 47 29 0a 09 09 09 22 2d 6c 6f 63 61 6c NING)...."-local
33d0: 22 20 20 20 20 20 20 20 20 20 3b 3b 20 72 75 6e " ;; run
33e0: 20 73 6f 6d 65 20 63 6f 6d 6d 61 6e 64 73 20 75 some commands u
33f0: 73 69 6e 67 20 6c 6f 63 61 6c 20 64 62 20 61 63 sing local db ac
3400: 63 65 73 73 0a 20 20 20 20 20 20 20 20 20 20 20 cess.
3410: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 2d 67 "-g
3420: 65 6e 65 72 61 74 65 2d 68 74 6d 6c 22 0a 0a 09 enerate-html"...
3430: 09 09 3b 3b 20 6d 69 73 63 20 71 75 65 72 69 65 ..;; misc querie
3440: 73 0a 09 09 09 22 2d 6c 69 73 74 2d 64 69 73 6b s...."-list-disk
3450: 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d 74 61 72 s"...."-list-tar
3460: 67 65 74 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d gets"...."-list-
3470: 64 62 2d 74 61 72 67 65 74 73 22 0a 09 09 09 22 db-targets"...."
3480: 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 22 -show-runconfig"
3490: 0a 09 09 09 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 ...."-show-confi
34a0: 67 22 0a 09 09 09 22 2d 73 68 6f 77 2d 63 6d 64 g"...."-show-cmd
34b0: 69 6e 66 6f 22 0a 09 09 09 22 2d 67 65 74 2d 72 info"...."-get-r
34c0: 75 6e 2d 73 74 61 74 75 73 22 0a 0a 09 09 09 3b un-status".....;
34d0: 3b 20 71 75 65 72 69 65 73 0a 09 09 09 22 2d 74 ; queries...."-t
34e0: 65 73 74 2d 70 61 74 68 73 22 20 3b 3b 20 67 65 est-paths" ;; ge
34f0: 74 20 70 61 74 68 28 73 29 20 74 6f 20 61 20 74 t path(s) to a t
3500: 65 73 74 2c 20 6f 72 64 65 72 65 64 20 62 79 20 est, ordered by
3510: 79 6f 75 6e 67 65 73 74 20 66 69 72 73 74 0a 0a youngest first..
3520: 09 09 09 22 2d 72 75 6e 61 6c 6c 22 20 20 20 20 ..."-runall"
3530: 3b 3b 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 ;; run all tests
3540: 2c 20 72 65 73 70 65 63 74 73 20 2d 74 65 73 74 , respects -test
3550: 70 61 74 74 2c 20 64 65 66 61 75 6c 74 73 20 74 patt, defaults t
3560: 6f 20 25 0a 09 09 09 22 2d 72 75 6e 22 20 20 20 o %...."-run"
3570: 20 20 20 20 3b 3b 20 61 6c 69 61 73 20 66 6f 72 ;; alias for
3580: 20 2d 72 75 6e 61 6c 6c 0a 09 09 09 22 2d 72 65 -runall...."-re
3590: 6d 6f 76 65 2d 72 75 6e 73 22 0a 09 09 09 22 2d move-runs"...."-
35a0: 72 65 62 75 69 6c 64 2d 64 62 22 0a 09 09 09 22 rebuild-db"...."
35b0: 2d 63 6c 65 61 6e 75 70 2d 64 62 22 0a 09 09 09 -cleanup-db"....
35c0: 22 2d 72 6f 6c 6c 75 70 22 0a 09 09 09 22 2d 75 "-rollup"...."-u
35d0: 70 64 61 74 65 2d 6d 65 74 61 22 0a 09 09 09 22 pdate-meta"...."
35e0: 2d 63 72 65 61 74 65 2d 6d 65 67 61 74 65 73 74 -create-megatest
35f0: 2d 61 72 65 61 22 0a 09 09 09 22 2d 6d 61 72 6b -area"...."-mark
3600: 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 22 0a 0a 09 -incompletes"...
3610: 09 09 22 2d 63 6f 6e 76 65 72 74 2d 74 6f 2d 6e .."-convert-to-n
3620: 6f 72 6d 22 0a 09 09 09 22 2d 63 6f 6e 76 65 72 orm"...."-conver
3630: 74 2d 74 6f 2d 6f 6c 64 22 0a 09 09 09 22 2d 69 t-to-old"...."-i
3640: 6d 70 6f 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 mport-megatest.d
3650: 62 22 0a 09 09 09 22 2d 73 79 6e 63 2d 74 6f 2d b"...."-sync-to-
3660: 6d 65 67 61 74 65 73 74 2e 64 62 22 0a 09 09 09 megatest.db"....
3670: 0a 09 09 09 22 2d 6c 6f 67 67 69 6e 67 22 0a 09 ...."-logging"..
3680: 09 09 22 2d 76 22 20 3b 3b 20 76 65 72 62 6f 73 .."-v" ;; verbos
3690: 65 20 32 2c 20 6d 6f 72 65 20 74 68 61 6e 20 6e e 2, more than n
36a0: 6f 72 6d 61 6c 20 28 6e 6f 72 6d 61 6c 20 69 73 ormal (normal is
36b0: 20 31 29 0a 09 09 09 22 2d 71 22 20 3b 3b 20 71 1)...."-q" ;; q
36c0: 75 69 65 74 20 30 2c 20 65 72 72 6f 72 73 2f 77 uiet 0, errors/w
36d0: 61 72 6e 69 6e 67 73 20 6f 6e 6c 79 0a 0a 20 20 arnings only..
36e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
36f0: 20 20 20 20 20 20 22 2d 64 69 66 66 2d 72 65 70 "-diff-rep
3700: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ".
3710: 20 20 20 20 20 20 20 20 20 20 29 0a 09 09 20 61 )... a
3720: 72 67 73 3a 61 72 67 2d 68 61 73 68 0a 09 09 20 rgs:arg-hash...
3730: 30 29 29 0a 0a 3b 3b 20 41 64 64 20 61 72 67 73 0))..;; Add args
3740: 20 74 68 61 74 20 75 73 65 20 72 65 6d 61 72 67 that use remarg
3750: 73 20 68 65 72 65 0a 3b 3b 0a 28 69 66 20 28 61 s here.;;.(if (a
3760: 6e 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 nd (not (null? r
3770: 65 6d 61 72 67 73 29 29 0a 09 20 28 6e 6f 74 20 emargs)).. (not
3780: 28 6f 72 0a 09 20 20 20 20 20 20 20 28 61 72 67 (or.. (arg
3790: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 s:get-arg "-runs
37a0: 74 65 70 22 29 0a 09 20 20 20 20 20 20 20 28 61 tep").. (a
37b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e rgs:get-arg "-en
37c0: 76 63 61 70 22 29 0a 09 20 20 20 20 20 20 20 28 vcap").. (
37d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
37e0: 6e 76 64 65 6c 74 61 22 29 0a 09 20 20 20 20 20 nvdelta")..
37f0: 20 20 29 0a 09 20 20 20 20 20 20 29 29 0a 20 20 ).. )).
3800: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
3810: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
3820: 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 6e 72 65 63 log-port* "Unrec
3830: 6f 67 6e 69 73 65 64 20 61 72 67 75 6d 65 6e 74 ognised argument
3840: 73 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 s: " (string-int
3850: 65 72 73 70 65 72 73 65 20 28 69 66 20 28 6c 69 ersperse (if (li
3860: 73 74 3f 20 72 65 6d 61 72 67 73 29 20 72 65 6d st? remargs) rem
3870: 61 72 67 73 20 28 61 72 67 76 29 29 20 20 22 20 args (argv)) "
3880: 22 29 29 29 0a 0a 3b 3b 20 62 65 66 6f 72 65 20 ")))..;; before
3890: 64 6f 69 6e 67 20 61 6e 79 74 68 69 6e 67 20 65 doing anything e
38a0: 6c 73 65 20 63 68 61 6e 67 65 20 74 6f 20 74 68 lse change to th
38b0: 65 20 73 74 61 72 74 2d 64 69 72 20 69 66 20 70 e start-dir if p
38c0: 72 6f 76 69 64 65 64 0a 3b 3b 0a 28 69 66 20 28 rovided.;;.(if (
38d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
38e0: 74 61 72 74 2d 64 69 72 22 29 0a 20 20 20 20 28 tart-dir"). (
38f0: 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f if (file-exists?
3900: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3910: 2d 73 74 61 72 74 2d 64 69 72 22 29 29 0a 09 28 -start-dir"))..(
3920: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
3930: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3940: 2d 73 74 61 72 74 2d 64 69 72 22 29 29 0a 09 28 -start-dir"))..(
3950: 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a begin.. (debug:
3960: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
3970: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
3980: 20 22 6e 6f 6e 2d 65 78 69 73 74 61 6e 74 20 73 "non-existant s
3990: 74 61 72 74 20 64 69 72 20 22 20 28 61 72 67 73 tart dir " (args
39a0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 74 :get-arg "-start
39b0: 2d 64 69 72 22 29 20 22 20 73 70 65 63 69 66 69 -dir") " specifi
39c0: 65 64 2c 20 65 78 69 74 69 6e 67 2e 22 29 0a 09 ed, exiting.")..
39d0: 20 20 28 65 78 69 74 20 31 29 29 29 29 0a 0a 3b (exit 1))))..;
39e0: 3b 20 69 6d 6d 65 64 69 61 74 65 6c 79 20 73 65 ; immediately se
39f0: 74 20 4d 54 5f 54 41 52 47 45 54 20 69 66 20 2d t MT_TARGET if -
3a00: 72 65 71 74 61 72 67 20 6f 72 20 2d 74 61 72 67 reqtarg or -targ
3a10: 65 74 20 61 72 65 20 61 76 61 69 6c 61 62 6c 65 et are available
3a20: 0a 3b 3b 0a 28 6c 65 74 20 28 28 74 61 72 67 20 .;;.(let ((targ
3a30: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
3a40: 67 20 22 2d 72 65 71 74 61 72 67 22 29 28 61 72 g "-reqtarg")(ar
3a50: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 gs:get-arg "-tar
3a60: 67 65 74 22 29 29 29 29 0a 20 20 28 69 66 20 74 get")))). (if t
3a70: 61 72 67 20 28 73 65 74 65 6e 76 20 22 4d 54 5f arg (setenv "MT_
3a80: 54 41 52 47 45 54 22 20 74 61 72 67 29 29 29 0a TARGET" targ))).
3a90: 0a 3b 3b 20 54 68 65 20 77 61 74 63 68 64 6f 67 .;; The watchdog
3aa0: 20 69 73 20 74 6f 20 6b 65 65 70 20 61 6e 20 65 is to keep an e
3ab0: 79 65 20 6f 6e 20 74 68 69 6e 67 73 20 6c 69 6b ye on things lik
3ac0: 65 20 64 62 20 73 79 6e 63 20 65 74 63 2e 0a 3b e db sync etc..;
3ad0: 3b 0a 0a 3b 3b 20 54 4f 44 4f 3a 20 66 6f 72 20 ;..;; TODO: for
3ae0: 6d 75 6c 74 69 70 6c 65 20 61 72 65 61 73 2c 20 multiple areas,
3af0: 77 65 20 77 69 6c 6c 20 68 61 76 65 20 6d 75 6c we will have mul
3b00: 74 69 70 6c 65 20 77 61 74 63 68 64 6f 67 73 3b tiple watchdogs;
3b10: 20 61 6e 64 20 6d 75 6c 74 69 70 6c 65 20 74 68 and multiple th
3b20: 72 65 61 64 73 20 74 6f 20 6d 61 6e 61 67 65 0a reads to manage.
3b30: 28 64 65 66 69 6e 65 20 2a 77 61 74 63 68 64 6f (define *watchdo
3b40: 67 2a 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 g* (make-thread
3b50: 63 6f 6d 6d 6f 6e 3a 77 61 74 63 68 64 6f 67 20 common:watchdog
3b60: 22 57 61 74 63 68 64 6f 67 20 74 68 72 65 61 64 "Watchdog thread
3b70: 22 29 29 0a 0a 3b 3b 28 69 66 20 28 6e 6f 74 20 "))..;;(if (not
3b80: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3b90: 73 65 72 76 65 72 22 29 29 0a 3b 3b 20 20 20 20 server")).;;
3ba0: 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 2a (thread-start! *
3bb0: 77 61 74 63 68 64 6f 67 2a 29 29 20 3b 3b 20 69 watchdog*)) ;; i
3bc0: 66 20 73 74 61 72 74 69 6e 67 20 61 20 73 65 72 f starting a ser
3bd0: 76 65 72 3b 20 77 61 69 74 20 74 69 6c 6c 20 77 ver; wait till w
3be0: 65 20 67 65 74 20 74 6f 20 72 75 6e 6e 69 6e 67 e get to running
3bf0: 20 73 74 61 74 65 20 62 65 66 6f 72 65 20 6b 69 state before ki
3c00: 63 6b 69 6e 67 20 6f 66 66 20 77 61 74 63 68 64 cking off watchd
3c10: 6f 67 0a 28 6c 65 74 2a 20 28 28 6e 6f 2d 77 61 og.(let* ((no-wa
3c20: 74 63 68 64 6f 67 2d 61 72 67 73 0a 20 20 20 20 tchdog-args.
3c30: 20 20 20 27 28 22 2d 6c 69 73 74 2d 72 75 6e 73 '("-list-runs
3c40: 22 0a 20 20 20 20 20 20 20 20 20 22 2d 6c 69 73 ". "-lis
3c50: 74 2d 73 65 72 76 65 72 73 22 0a 20 20 20 20 20 t-servers".
3c60: 20 20 20 20 22 2d 73 65 72 76 65 72 22 0a 20 20 "-server".
3c70: 20 20 20 20 20 20 20 22 2d 6c 69 73 74 2d 64 69 "-list-di
3c80: 73 6b 73 22 0a 20 20 20 20 20 20 20 20 20 22 2d sks". "-
3c90: 6c 69 73 74 2d 74 61 72 67 65 74 73 22 0a 20 20 list-targets".
3ca0: 20 20 20 20 20 20 20 22 2d 73 68 6f 77 2d 72 75 "-show-ru
3cb0: 6e 63 6f 6e 66 69 67 22 0a 20 20 20 20 20 20 20 nconfig".
3cc0: 20 20 3b 3b 22 2d 6c 69 73 74 2d 64 62 2d 74 61 ;;"-list-db-ta
3cd0: 72 67 65 74 73 22 0a 20 20 20 20 20 20 20 20 20 rgets".
3ce0: 22 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 "-show-runconfig
3cf0: 22 0a 20 20 20 20 20 20 20 20 20 22 2d 73 68 6f ". "-sho
3d00: 77 2d 63 6f 6e 66 69 67 22 0a 20 20 20 20 20 20 w-config".
3d10: 20 20 20 22 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 "-show-cmdinf
3d20: 6f 22 29 29 0a 20 20 20 20 20 20 20 28 6e 6f 2d o")). (no-
3d30: 77 61 74 63 68 64 6f 67 2d 61 72 67 73 2d 76 61 watchdog-args-va
3d40: 6c 73 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 ls (filter (lamb
3d50: 64 61 20 28 78 29 20 78 29 0a 20 20 20 20 20 20 da (x) x).
3d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d80: 28 6d 61 70 20 61 72 67 73 3a 67 65 74 2d 61 72 (map args:get-ar
3d90: 67 20 6e 6f 2d 77 61 74 63 68 64 6f 67 2d 61 72 g no-watchdog-ar
3da0: 67 73 29 29 29 0a 20 20 20 20 20 20 20 28 73 74 gs))). (st
3db0: 61 72 74 2d 77 61 74 63 68 64 6f 67 20 28 6e 75 art-watchdog (nu
3dc0: 6c 6c 3f 20 6e 6f 2d 77 61 74 63 68 64 6f 67 2d ll? no-watchdog-
3dd0: 61 72 67 73 2d 76 61 6c 73 29 29 29 0a 20 20 3b args-vals))). ;
3de0: 3b 28 42 42 3e 20 22 6e 6f 2d 77 61 74 63 68 64 ;(BB> "no-watchd
3df0: 6f 67 2d 61 72 67 73 3d 22 6e 6f 2d 77 61 74 63 og-args="no-watc
3e00: 68 64 6f 67 2d 61 72 67 73 20 22 6e 6f 2d 77 61 hdog-args "no-wa
3e10: 74 63 68 64 6f 67 2d 61 72 67 73 2d 76 61 6c 73 tchdog-args-vals
3e20: 3d 22 6e 6f 2d 77 61 74 63 68 64 6f 67 2d 61 72 ="no-watchdog-ar
3e30: 67 73 2d 76 61 6c 73 29 20 0a 20 20 28 69 66 20 gs-vals) . (if
3e40: 73 74 61 72 74 2d 77 61 74 63 68 64 6f 67 0a 20 start-watchdog.
3e50: 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 (thread-sta
3e60: 72 74 21 20 2a 77 61 74 63 68 64 6f 67 2a 29 29 rt! *watchdog*))
3e70: 29 0a 0a 0a 3b 3b 20 62 72 61 63 6b 65 74 20 6f )...;; bracket o
3e80: 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 pen-output-file
3e90: 77 69 74 68 20 63 6f 64 65 20 74 6f 20 6d 61 6b with code to mak
3ea0: 65 20 6c 65 61 64 69 6e 67 20 64 69 72 65 63 74 e leading direct
3eb0: 6f 72 79 20 69 66 20 69 74 20 64 6f 65 73 20 6e ory if it does n
3ec0: 6f 74 20 65 78 69 73 74 20 61 6e 64 20 68 61 6e ot exist and han
3ed0: 64 6c 65 20 65 78 63 65 70 74 69 6f 6e 73 0a 28 dle exceptions.(
3ee0: 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 6c 6f 67 define (open-log
3ef0: 66 69 6c 65 20 6c 6f 67 70 61 74 68 29 0a 20 20 file logpath).
3f00: 28 63 6f 6e 64 69 74 69 6f 6e 2d 63 61 73 65 0a (condition-case.
3f10: 20 20 20 28 6c 65 74 2a 20 28 28 6c 6f 67 2d 64 (let* ((log-d
3f20: 69 72 20 28 6f 72 20 28 70 61 74 68 6e 61 6d 65 ir (or (pathname
3f30: 2d 64 69 72 65 63 74 6f 72 79 20 6c 6f 67 70 61 -directory logpa
3f40: 74 68 29 20 22 2e 22 29 29 29 0a 20 20 20 20 20 th) "."))).
3f50: 28 69 66 20 28 6e 6f 74 20 28 64 69 72 65 63 74 (if (not (direct
3f60: 6f 72 79 2d 65 78 69 73 74 73 3f 20 6c 6f 67 2d ory-exists? log-
3f70: 64 69 72 29 29 0a 20 20 20 20 20 20 20 20 20 28 dir)). (
3f80: 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d 6b system (conc "mk
3f90: 64 69 72 20 2d 70 20 22 20 6c 6f 67 2d 64 69 72 dir -p " log-dir
3fa0: 29 29 29 0a 20 20 20 20 20 28 6f 70 65 6e 2d 6f ))). (open-o
3fb0: 75 74 70 75 74 2d 66 69 6c 65 20 6c 6f 67 70 61 utput-file logpa
3fc0: 74 68 29 29 0a 20 20 20 28 65 78 6e 20 28 29 0a th)). (exn ().
3fd0: 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 (debug:p
3fe0: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
3ff0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
4000: 22 43 6f 75 6c 64 20 6e 6f 74 20 6f 70 65 6e 20 "Could not open
4010: 6c 6f 67 20 66 69 6c 65 20 66 6f 72 20 77 72 69 log file for wri
4020: 74 65 3a 20 22 6c 6f 67 70 61 74 68 29 0a 20 20 te: "logpath).
4030: 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 2a 64 (define *d
4040: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
4050: 20 20 0a 20 20 20 20 20 20 20 20 28 65 78 69 74 . (exit
4060: 20 31 29 29 29 29 0a 0a 20 20 20 20 0a 28 69 66 1)))).. .(if
4070: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
4080: 72 67 20 22 2d 6c 6f 67 22 29 28 61 72 67 73 3a rg "-log")(args:
4090: 67 65 74 2d 61 72 67 20 22 2d 73 65 72 76 65 72 get-arg "-server
40a0: 22 29 29 20 3b 3b 20 72 65 64 69 72 65 63 74 20 ")) ;; redirect
40b0: 74 68 65 20 6c 6f 67 20 61 6c 77 61 79 73 20 77 the log always w
40c0: 68 65 6e 20 61 20 73 65 72 76 65 72 0a 20 20 20 hen a server.
40d0: 20 28 6c 65 74 2a 20 28 28 74 6c 20 20 20 28 6f (let* ((tl (o
40e0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
40f0: 22 2d 6c 6f 67 22 29 28 6c 61 75 6e 63 68 3a 73 "-log")(launch:s
4100: 65 74 75 70 29 29 29 20 20 20 3b 3b 20 72 75 6e etup))) ;; run
4110: 20 6c 61 75 6e 63 68 3a 73 65 74 75 70 20 69 66 launch:setup if
4120: 20 2d 73 65 72 76 65 72 0a 09 20 20 20 28 6c 6f -server.. (lo
4130: 67 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 gf (or (args:get
4140: 2d 61 72 67 20 22 2d 6c 6f 67 22 29 20 3b 3b 20 -arg "-log") ;;
4150: 75 73 65 20 2d 6c 6f 67 20 75 6e 6c 65 73 73 20 use -log unless
4160: 77 65 20 61 72 65 20 61 20 73 65 72 76 65 72 2c we are a server,
4170: 20 74 68 65 6e 20 63 72 61 66 74 20 61 20 6c 6f then craft a lo
4180: 67 66 69 6c 65 20 6e 61 6d 65 0a 09 09 20 20 20 gfile name...
4190: 20 20 28 63 6f 6e 63 20 74 6c 20 22 2f 6c 6f 67 (conc tl "/log
41a0: 73 2f 73 65 72 76 65 72 2d 22 20 28 63 75 72 72 s/server-" (curr
41b0: 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 20 ent-process-id)
41c0: 22 2d 22 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 "-" (get-host-na
41d0: 6d 65 29 20 22 2e 6c 6f 67 22 29 29 29 0a 09 20 me) ".log")))..
41e0: 20 20 28 6f 75 70 20 20 28 6f 70 65 6e 2d 6c 6f (oup (open-lo
41f0: 67 66 69 6c 65 20 6c 6f 67 66 29 29 29 0a 20 20 gfile logf))).
4200: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 61 72 (if (not (ar
4210: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 gs:get-arg "-log
4220: 22 29 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 ")).. (hash-tab
4230: 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 le-set! args:arg
4240: 2d 68 61 73 68 20 22 2d 6c 6f 67 22 20 6c 6f 67 -hash "-log" log
4250: 66 29 29 20 3b 3b 20 66 61 6b 65 20 6f 75 74 20 f)) ;; fake out
4260: 66 75 74 75 72 65 20 71 75 65 72 69 65 73 20 6f future queries o
4270: 66 20 2d 6c 6f 67 0a 20 20 20 20 20 20 28 64 65 f -log. (de
4280: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
4290: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
42a0: 72 74 2a 20 22 53 65 6e 64 69 6e 67 20 6c 6f 67 rt* "Sending log
42b0: 20 6f 75 74 70 75 74 20 74 6f 20 22 20 6c 6f 67 output to " log
42c0: 66 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a f). (set! *
42d0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
42e0: 2a 20 6f 75 70 29 29 29 0a 0a 28 69 66 20 28 6f * oup)))..(if (o
42f0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
4300: 22 2d 68 22 29 0a 09 28 61 72 67 73 3a 67 65 74 "-h")..(args:get
4310: 2d 61 72 67 20 22 2d 68 65 6c 70 22 29 0a 09 28 -arg "-help")..(
4320: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 2d args:get-arg "--
4330: 68 65 6c 70 22 29 29 0a 20 20 20 20 28 62 65 67 help")). (beg
4340: 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 in. (print
4350: 68 65 6c 70 29 0a 20 20 20 20 20 20 28 65 78 69 help). (exi
4360: 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a t)))..(if (args:
4370: 67 65 74 2d 61 72 67 20 22 2d 6d 61 6e 75 61 6c get-arg "-manual
4380: 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 68 "). (let* ((h
4390: 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 28 6f 72 tmlviewercmd (or
43a0: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
43b0: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
43c0: 74 75 70 22 20 22 68 74 6d 6c 76 69 65 77 65 72 tup" "htmlviewer
43d0: 63 6d 64 22 29 0a 09 09 09 20 20 20 20 20 20 28 cmd").... (
43e0: 63 6f 6d 6d 6f 6e 3a 77 68 69 63 68 20 27 28 22 common:which '("
43f0: 66 69 72 65 66 6f 78 22 20 22 61 72 6f 72 61 22 firefox" "arora"
4400: 29 29 29 29 0a 09 20 20 20 28 69 6e 73 74 61 6c )))).. (instal
4410: 6c 2d 68 6f 6d 65 20 20 28 63 6f 6d 6d 6f 6e 3a l-home (common:
4420: 67 65 74 2d 69 6e 73 74 61 6c 6c 2d 61 72 65 61 get-install-area
4430: 29 29 0a 09 20 20 20 28 6d 61 6e 75 61 6c 2d 68 )).. (manual-h
4440: 74 6d 6c 20 20 20 28 63 6f 6e 63 20 69 6e 73 74 tml (conc inst
4450: 61 6c 6c 2d 68 6f 6d 65 20 22 2f 73 68 61 72 65 all-home "/share
4460: 2f 64 6f 63 73 2f 6d 65 67 61 74 65 73 74 5f 6d /docs/megatest_m
4470: 61 6e 75 61 6c 2e 68 74 6d 6c 22 29 29 29 0a 20 anual.html"))).
4480: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 69 6e (if (and in
4490: 73 74 61 6c 6c 2d 68 6f 6d 65 0a 09 20 20 20 20 stall-home..
44a0: 20 20 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f (file-exists?
44b0: 20 6d 61 6e 75 61 6c 2d 68 74 6d 6c 29 29 0a 09 manual-html))..
44c0: 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 (system (conc
44d0: 22 28 22 20 68 74 6d 6c 76 69 65 77 65 72 63 6d "(" htmlviewercm
44e0: 64 20 22 20 22 20 6d 61 6e 75 61 6c 2d 68 74 6d d " " manual-htm
44f0: 6c 20 22 20 29 20 26 22 29 29 0a 09 20 20 28 73 l " ) &")).. (s
4500: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 28 22 20 ystem (conc "("
4510: 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 22 20 htmlviewercmd "
4520: 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f http://www.kiato
4530: 61 2e 63 6f 6d 2f 63 67 69 2d 62 69 6e 2f 66 6f a.com/cgi-bin/fo
4540: 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 2f 64 ssils/megatest/d
4550: 6f 63 2f 74 69 70 2f 64 6f 63 73 2f 6d 61 6e 75 oc/tip/docs/manu
4560: 61 6c 2f 6d 65 67 61 74 65 73 74 5f 6d 61 6e 75 al/megatest_manu
4570: 61 6c 2e 68 74 6d 6c 20 29 20 26 22 29 29 29 0a al.html ) &"))).
4580: 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a (exit)))..
4590: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
45a0: 67 20 22 2d 76 65 72 73 69 6f 6e 22 29 0a 20 20 g "-version").
45b0: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
45c0: 70 72 69 6e 74 20 28 63 6f 6d 6d 6f 6e 3a 76 65 print (common:ve
45d0: 72 73 69 6f 6e 2d 73 69 67 6e 61 74 75 72 65 29 rsion-signature)
45e0: 29 20 3b 3b 20 28 70 72 69 6e 74 20 6d 65 67 61 ) ;; (print mega
45f0: 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 20 test-version).
4600: 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a 28 64 (exit)))..(d
4610: 65 66 69 6e 65 20 2a 64 69 64 73 6f 6d 65 74 68 efine *didsometh
4620: 69 6e 67 2a 20 23 66 29 0a 0a 3b 3b 20 4f 76 65 ing* #f)..;; Ove
4630: 72 61 6c 6c 20 65 78 69 74 20 68 61 6e 64 6c 69 rall exit handli
4640: 6e 67 20 73 65 74 75 70 20 69 6d 6d 65 64 69 61 ng setup immedia
4650: 74 65 6c 79 0a 3b 3b 0a 28 69 66 20 28 6f 72 20 tely.;;.(if (or
4660: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4670: 70 72 6f 63 65 73 73 2d 72 65 61 70 22 29 29 0a process-reap")).
4680: 20 20 20 20 20 20 20 20 3b 3b 20 28 61 72 67 73 ;; (args
4690: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
46a0: 73 74 73 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a sts")..;; (args:
46b0: 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 get-arg "-execut
46c0: 65 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a 67 65 e")..;; (args:ge
46d0: 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d 72 t-arg "-remove-r
46e0: 75 6e 73 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a uns")..;; (args:
46f0: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 get-arg "-runste
4700: 70 22 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 p")). (let ((
4710: 6f 72 69 67 69 6e 61 6c 2d 65 78 69 74 20 28 65 original-exit (e
4720: 78 69 74 2d 68 61 6e 64 6c 65 72 29 29 29 0a 20 xit-handler))).
4730: 20 20 20 20 20 28 65 78 69 74 2d 68 61 6e 64 6c (exit-handl
4740: 65 72 20 28 6c 61 6d 62 64 61 20 28 23 21 6f 70 er (lambda (#!op
4750: 74 69 6f 6e 61 6c 20 28 65 78 69 74 2d 63 6f 64 tional (exit-cod
4760: 65 20 30 29 29 0a 09 09 20 20 20 20 20 20 28 70 e 0))... (p
4770: 72 69 6e 74 66 20 22 50 72 65 70 61 72 69 6e 67 rintf "Preparing
4780: 20 74 6f 20 65 78 69 74 20 77 69 74 68 20 65 78 to exit with ex
4790: 69 74 20 63 6f 64 65 20 7e 41 20 2e 2e 2e 5c 6e it code ~A ...\n
47a0: 22 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 20 " exit-code)...
47b0: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 (for-each..
47c0: 09 20 20 20 20 20 20 20 0a 09 09 20 20 20 20 20 . ...
47d0: 20 20 28 6c 61 6d 62 64 61 20 28 70 69 64 29 0a (lambda (pid).
47e0: 09 09 09 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 ... (handle-exce
47f0: 70 74 69 6f 6e 73 0a 09 09 09 20 20 65 78 6e 0a ptions.... exn.
4800: 09 09 09 20 20 23 74 0a 09 09 09 20 20 28 6c 65 ... #t.... (le
4810: 74 2d 76 61 6c 75 65 73 20 28 28 28 70 69 64 2d t-values (((pid-
4820: 76 61 6c 20 65 78 69 74 2d 73 74 61 74 75 73 20 val exit-status
4830: 65 78 69 74 2d 63 6f 64 65 29 20 28 70 72 6f 63 exit-code) (proc
4840: 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 74 29 ess-wait pid #t)
4850: 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 69 66 ))..... (if
4860: 20 28 6f 72 20 28 65 71 3f 20 70 69 64 2d 76 61 (or (eq? pid-va
4870: 6c 20 70 69 64 29 0a 09 09 09 09 09 20 20 20 20 l pid)......
4880: 20 20 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 (eq? pid-val 0
4890: 29 29 0a 09 09 09 09 09 20 20 28 62 65 67 69 6e ))...... (begin
48a0: 0a 09 09 09 09 09 20 20 20 20 28 70 72 69 6e 74 ...... (print
48b0: 66 20 22 53 65 6e 64 69 6e 67 20 73 69 67 6e 61 f "Sending signa
48c0: 6c 2f 74 65 72 6d 20 74 6f 20 7e 41 5c 6e 22 20 l/term to ~A\n"
48d0: 70 69 64 29 0a 09 09 09 09 09 20 20 20 20 28 70 pid)...... (p
48e0: 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 69 rocess-signal pi
48f0: 64 20 73 69 67 6e 61 6c 2f 74 65 72 6d 29 29 29 d signal/term)))
4900: 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 70 72 )))... (pr
4910: 6f 63 65 73 73 3a 63 68 69 6c 64 72 65 6e 20 23 ocess:children #
4920: 66 29 29 0a 09 09 20 20 20 20 20 20 28 6f 72 69 f))... (ori
4930: 67 69 6e 61 6c 2d 65 78 69 74 20 65 78 69 74 2d ginal-exit exit-
4940: 63 6f 64 65 29 29 29 29 29 0a 0a 3b 3b 20 66 6f code)))))..;; fo
4950: 72 20 73 6f 6d 65 20 73 77 69 74 63 68 65 73 20 r some switches
4960: 61 6c 77 61 79 20 70 72 69 6e 74 20 74 68 65 20 alway print the
4970: 63 6f 6d 6d 61 6e 64 20 74 6f 20 73 74 64 65 72 command to stder
4980: 72 0a 3b 3b 0a 28 69 66 20 28 61 72 67 73 3a 61 r.;;.(if (args:a
4990: 6e 79 3f 20 22 2d 72 75 6e 22 20 22 2d 72 75 6e ny? "-run" "-run
49a0: 61 6c 6c 22 20 22 2d 6c 69 73 74 2d 72 75 6e 73 all" "-list-runs
49b0: 22 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 " "-remove-runs"
49c0: 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 "-set-state-sta
49d0: 74 75 73 22 29 0a 20 20 20 20 28 64 65 62 75 67 tus"). (debug
49e0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
49f0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 28 73 74 72 t-log-port* (str
4a00: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
4a10: 28 61 72 67 76 29 20 22 20 22 29 29 29 0a 0a 3b (argv) " ")))..;
4a20: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
4a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a60: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 20 =======.;; Misc
4a70: 73 65 74 75 70 20 73 74 75 66 66 0a 3b 3b 3d 3d setup stuff.;;==
4a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4ac0: 3d 3d 3d 3d 0a 0a 28 64 65 62 75 67 3a 73 65 74 ====..(debug:set
4ad0: 75 70 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 up)..(if (args:g
4ae0: 65 74 2d 61 72 67 20 22 2d 6c 6f 67 67 69 6e 67 et-arg "-logging
4af0: 22 29 28 73 65 74 21 20 2a 6c 6f 67 67 69 6e 67 ")(set! *logging
4b00: 2a 20 23 74 29 29 0a 0a 28 69 66 20 28 64 65 62 * #t))..(if (deb
4b10: 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 33 29 ug:debug-mode 3)
4b20: 20 3b 3b 20 77 65 20 61 72 65 20 6f 62 76 69 6f ;; we are obvio
4b30: 75 73 6c 79 20 64 65 62 75 67 67 69 6e 67 0a 20 usly debugging.
4b40: 20 20 20 28 73 65 74 21 20 6f 70 65 6e 2d 72 75 (set! open-ru
4b50: 6e 2d 63 6c 6f 73 65 20 6f 70 65 6e 2d 72 75 6e n-close open-run
4b60: 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 -close-no-except
4b70: 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 29 29 0a 0a ion-handling))..
4b80: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
4b90: 67 20 22 2d 69 74 65 6d 70 61 74 74 22 29 0a 20 g "-itempatt").
4ba0: 20 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c (let ((newval
4bb0: 20 28 63 6f 6e 63 20 28 61 72 67 73 3a 67 65 74 (conc (args:get
4bc0: 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 -arg "-testpatt"
4bd0: 29 20 22 2f 22 20 28 61 72 67 73 3a 67 65 74 2d ) "/" (args:get-
4be0: 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 29 arg "-itempatt")
4bf0: 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 ))). (debug
4c00: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
4c10: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 t-log-port* "WAR
4c20: 4e 49 4e 47 3a 20 2d 69 74 65 6d 70 61 74 74 20 NING: -itempatt
4c30: 68 61 73 20 62 65 65 6e 20 64 65 70 72 65 63 61 has been depreca
4c40: 74 65 64 2c 20 70 6c 65 61 73 65 20 75 73 65 20 ted, please use
4c50: 2d 74 65 73 74 70 61 74 74 20 74 65 73 74 70 61 -testpatt testpa
4c60: 74 74 2f 69 74 65 6d 70 61 74 74 20 6d 65 74 68 tt/itempatt meth
4c70: 6f 64 2c 20 6e 65 77 20 74 65 73 74 70 61 74 74 od, new testpatt
4c80: 20 69 73 20 22 6e 65 77 76 61 6c 29 0a 20 20 20 is "newval).
4c90: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
4ca0: 65 74 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 et! args:arg-has
4cb0: 68 20 22 2d 74 65 73 74 70 61 74 74 22 20 6e 65 h "-testpatt" ne
4cc0: 77 76 61 6c 29 0a 20 20 20 20 20 20 28 68 61 73 wval). (has
4cd0: 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 h-table-delete!
4ce0: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d args:arg-hash "-
4cf0: 69 74 65 6d 70 61 74 74 22 29 29 29 0a 0a 28 69 itempatt")))..(i
4d00: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
4d10: 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 20 20 20 "-runtests").
4d20: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
4d30: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
4d40: 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 5c 22 2d t* "WARNING: \"-
4d50: 72 75 6e 74 65 73 74 73 5c 22 20 69 73 20 64 65 runtests\" is de
4d60: 70 72 65 63 61 74 65 64 2e 20 55 73 65 20 5c 22 precated. Use \"
4d70: 2d 72 75 6e 5c 22 20 77 69 74 68 20 5c 22 2d 74 -run\" with \"-t
4d80: 65 73 74 70 61 74 74 5c 22 20 69 6e 73 74 65 61 estpatt\" instea
4d90: 64 22 29 29 0a 0a 28 6f 6e 2d 65 78 69 74 20 73 d"))..(on-exit s
4da0: 74 64 2d 65 78 69 74 2d 70 72 6f 63 65 64 75 72 td-exit-procedur
4db0: 65 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d e)..;;==========
4dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
4e00: 4d 69 73 63 20 67 65 6e 65 72 61 6c 20 63 61 6c Misc general cal
4e10: 6c 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ls.;;===========
4e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
4e60: 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d (and (args:get-
4e70: 61 72 67 20 22 2d 63 61 63 68 65 2d 64 62 22 29 arg "-cache-db")
4e80: 0a 20 20 20 20 20 20 20 20 20 28 61 72 67 73 3a . (args:
4e90: 67 65 74 2d 61 72 67 20 22 2d 73 6f 75 72 63 65 get-arg "-source
4ea0: 2d 64 62 22 29 29 0a 20 20 20 20 28 6c 65 74 2a -db")). (let*
4eb0: 20 28 28 74 65 6d 70 2d 64 69 72 20 28 6f 72 20 ((temp-dir (or
4ec0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4ed0: 74 61 72 67 65 74 2d 64 62 22 29 20 28 63 72 65 target-db") (cre
4ee0: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 28 63 ate-directory (c
4ef0: 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 28 67 65 74 onc "/tmp/" (get
4f00: 65 6e 76 20 22 55 53 45 52 22 29 20 22 2f 22 20 env "USER") "/"
4f10: 28 73 74 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 (string-translat
4f20: 65 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 e (current-direc
4f30: 74 6f 72 79 29 20 22 2f 22 20 22 5f 22 29 29 29 tory) "/" "_")))
4f40: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 74 )). (t
4f50: 61 72 67 65 74 2d 64 62 20 28 63 6f 6e 63 20 74 arget-db (conc t
4f60: 65 6d 70 2d 64 69 72 20 22 2f 63 61 63 68 65 64 emp-dir "/cached
4f70: 2e 64 62 22 29 29 0a 20 20 20 20 20 20 20 20 20 .db")).
4f80: 20 20 28 73 6f 75 72 63 65 2d 64 62 20 28 61 72 (source-db (ar
4f90: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f 75 gs:get-arg "-sou
4fa0: 72 63 65 2d 64 62 22 29 29 29 20 20 20 20 20 20 rce-db")))
4fb0: 20 20 0a 20 20 20 20 20 20 28 64 62 3a 63 61 63 . (db:cac
4fc0: 68 65 2d 66 6f 72 2d 72 65 61 64 2d 6f 6e 6c 79 he-for-read-only
4fd0: 20 73 6f 75 72 63 65 2d 64 62 20 74 61 72 67 65 source-db targe
4fe0: 74 2d 64 62 29 0a 20 20 20 20 20 20 28 73 65 74 t-db). (set
4ff0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
5000: 20 23 74 29 29 29 0a 0a 3b 3b 20 68 61 6e 64 6c #t)))..;; handl
5010: 65 20 61 20 63 6c 65 61 6e 2d 63 61 63 68 65 20 e a clean-cache
5020: 72 65 71 75 65 73 74 20 61 73 20 65 61 72 6c 79 request as early
5030: 20 61 73 20 70 6f 73 73 69 62 6c 65 0a 3b 3b 0a as possible.;;.
5040: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
5050: 67 20 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 22 g "-clean-cache"
5060: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
5070: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
5080: 65 74 68 69 6e 67 2a 20 23 74 29 20 3b 3b 20 73 ething* #t) ;; s
5090: 75 70 70 72 65 73 73 20 74 68 65 20 68 65 6c 70 uppress the help
50a0: 20 6f 75 74 70 75 74 2e 0a 20 20 20 20 20 20 28 output.. (
50b0: 69 66 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 if (getenv "MT_T
50c0: 41 52 47 45 54 22 29 20 3b 3b 20 6e 6f 20 70 6f ARGET") ;; no po
50d0: 69 6e 74 20 69 6e 20 74 72 79 69 6e 67 20 69 66 int in trying if
50e0: 20 6e 6f 20 74 61 72 67 65 74 0a 09 20 20 28 69 no target.. (i
50f0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
5100: 22 2d 72 75 6e 6e 61 6d 65 22 29 0a 09 20 20 20 "-runname")..
5110: 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 (let* ((toppa
5120: 74 68 20 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 th (launch:setu
5130: 70 29 29 0a 09 09 20 20 20 20 20 28 6c 69 6e 6b p))... (link
5140: 74 72 65 65 20 28 69 66 20 74 6f 70 70 61 74 68 tree (if toppath
5150: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
5160: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
5170: 74 75 70 22 20 22 6c 69 6e 6b 74 72 65 65 22 29 tup" "linktree")
5180: 29 29 0a 09 09 20 20 20 20 20 28 72 75 6e 74 6f ))... (runto
5190: 70 20 20 20 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 p (conc linktr
51a0: 65 65 20 22 2f 22 20 28 67 65 74 65 6e 76 20 22 ee "/" (getenv "
51b0: 4d 54 5f 54 41 52 47 45 54 22 29 20 22 2f 22 20 MT_TARGET") "/"
51c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
51d0: 72 75 6e 6e 61 6d 65 22 29 29 29 0a 09 09 20 20 runname")))...
51e0: 20 20 20 28 66 69 6c 65 73 20 20 20 20 28 69 66 (files (if
51f0: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 72 (file-exists? r
5200: 75 6e 74 6f 70 29 0a 09 09 09 09 20 20 20 28 61 untop)..... (a
5210: 70 70 65 6e 64 20 28 67 6c 6f 62 20 28 63 6f 6e ppend (glob (con
5220: 63 20 72 75 6e 74 6f 70 20 22 2f 2e 6d 65 67 61 c runtop "/.mega
5230: 74 65 73 74 2a 22 29 29 0a 09 09 09 09 09 20 20 test*"))......
5240: 20 28 67 6c 6f 62 20 28 63 6f 6e 63 20 72 75 6e (glob (conc run
5250: 74 6f 70 20 22 2f 2e 72 75 6e 63 6f 6e 66 69 67 top "/.runconfig
5260: 2a 22 29 29 29 0a 09 09 09 09 20 20 20 27 28 29 *")))..... '()
5270: 29 29 29 0a 09 09 28 69 66 20 28 6e 75 6c 6c 3f )))...(if (null?
5280: 20 66 69 6c 65 73 29 0a 09 09 20 20 20 20 28 64 files)... (d
5290: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
52a0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
52b0: 6f 72 74 2a 20 22 4e 6f 20 63 61 63 68 65 64 20 ort* "No cached
52c0: 6d 65 67 61 74 65 73 74 20 6f 72 20 72 75 6e 63 megatest or runc
52d0: 6f 6e 66 69 67 73 20 66 69 6c 65 73 20 66 6f 75 onfigs files fou
52e0: 6e 64 2e 20 4e 6f 6e 65 20 72 65 6d 6f 76 65 64 nd. None removed
52f0: 2e 22 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e .")... (begin
5300: 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a ... (debug:
5310: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
5320: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
5330: 22 52 65 6d 6f 76 69 6e 67 20 63 61 63 68 65 64 "Removing cached
5340: 20 66 69 6c 65 73 3a 5c 6e 20 20 20 20 22 20 28 files:\n " (
5350: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
5360: 73 65 20 66 69 6c 65 73 20 22 5c 6e 20 20 20 20 se files "\n
5370: 22 29 29 0a 09 09 20 20 20 20 20 20 28 66 6f 72 "))... (for
5380: 2d 65 61 63 68 20 0a 09 09 20 20 20 20 20 20 20 -each ...
5390: 28 6c 61 6d 62 64 61 20 28 66 29 0a 09 09 09 20 (lambda (f)....
53a0: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
53b0: 6e 73 0a 09 09 09 20 20 20 20 20 65 78 6e 0a 09 ns.... exn..
53c0: 09 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 .. (debug:pr
53d0: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
53e0: 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e og-port* "WARNIN
53f0: 47 3a 20 46 61 69 6c 65 64 20 74 6f 20 72 65 6d G: Failed to rem
5400: 6f 76 65 20 66 69 6c 65 20 22 20 66 29 0a 09 09 ove file " f)...
5410: 09 20 20 20 28 64 65 6c 65 74 65 2d 66 69 6c 65 . (delete-file
5420: 20 66 29 29 29 0a 09 09 20 20 20 20 20 20 20 66 f)))... f
5430: 69 6c 65 73 29 29 29 29 0a 09 20 20 20 20 20 20 iles))))..
5440: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
5450: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
5460: 67 2d 70 6f 72 74 2a 20 22 2d 63 6c 65 61 6e 2d g-port* "-clean-
5470: 63 61 63 68 65 20 72 65 71 75 69 72 65 73 20 2d cache requires -
5480: 72 75 6e 6e 61 6d 65 2e 22 29 29 0a 09 20 20 28 runname.")).. (
5490: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
54a0: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
54b0: 2d 70 6f 72 74 2a 20 22 2d 63 6c 65 61 6e 2d 63 -port* "-clean-c
54c0: 61 63 68 65 20 72 65 71 75 69 72 65 73 20 2d 74 ache requires -t
54d0: 61 72 67 65 74 20 6f 72 20 2d 72 65 71 74 61 72 arget or -reqtar
54e0: 67 22 29 29 29 29 0a 09 20 20 20 20 0a 09 20 20 g")))).. ..
54f0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
5500: 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 29 0a rg "-env2file").
5510: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
5520: 20 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 (save-environme
5530: 6e 74 2d 61 73 2d 66 69 6c 65 73 20 28 61 72 67 nt-as-files (arg
5540: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 32 s:get-arg "-env2
5550: 66 69 6c 65 22 29 29 0a 20 20 20 20 20 20 28 73 file")). (s
5560: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
5570: 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
5580: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
5590: 73 74 2d 64 69 73 6b 73 22 29 0a 20 20 20 20 28 st-disks"). (
55a0: 6c 65 74 20 28 28 74 6f 70 70 61 74 68 20 28 6c let ((toppath (l
55b0: 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 0a 20 aunch:setup))).
55c0: 20 20 20 20 20 28 70 72 69 6e 74 20 0a 20 20 20 (print .
55d0: 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 (string-inte
55e0: 72 73 70 65 72 73 65 20 0a 09 28 6d 61 70 20 28 rsperse ..(map (
55f0: 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 20 20 20 lambda (x)..
5600: 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 (string-inter
5610: 73 70 65 72 73 65 20 0a 09 09 78 0a 09 09 22 20 sperse ...x..."
5620: 3d 3e 20 22 29 29 0a 09 20 20 20 20 20 28 63 6f => ")).. (co
5630: 6d 6d 6f 6e 3a 67 65 74 2d 64 69 73 6b 73 20 2a mmon:get-disks *
5640: 63 6f 6e 66 69 67 64 61 74 2a 29 29 0a 09 22 5c configdat*)).."\
5650: 6e 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 n")). (set!
5660: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
5670: 23 74 29 29 29 0a 0a 3b 3b 20 63 73 76 20 70 72 #t)))..;; csv pr
5680: 6f 63 65 73 73 69 6e 67 20 72 65 63 6f 72 64 0a ocessing record.
5690: 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 72 65 (define (make-re
56a0: 66 64 62 3a 63 73 76 29 0a 20 20 28 76 65 63 74 fdb:csv). (vect
56b0: 6f 72 20 0a 20 20 20 28 6d 61 6b 65 2d 73 70 61 or . (make-spa
56c0: 72 73 65 2d 61 72 72 61 79 29 0a 20 20 20 28 6d rse-array). (m
56d0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 0a ake-hash-table).
56e0: 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 (make-hash-ta
56f0: 62 6c 65 29 0a 20 20 20 30 0a 20 20 20 30 29 29 ble). 0. 0))
5700: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
5710: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 73 (refdb:csv-get-s
5720: 76 65 63 20 20 20 20 20 76 65 63 29 20 20 20 20 vec vec)
5730: 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 (vector-ref vec
5740: 20 30 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 0)).(define-inl
5750: 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 67 ine (refdb:csv-g
5760: 65 74 2d 72 6f 77 73 20 20 20 20 20 76 65 63 29 et-rows vec)
5770: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
5780: 20 76 65 63 20 31 29 29 0a 28 64 65 66 69 6e 65 vec 1)).(define
5790: 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 -inline (refdb:c
57a0: 73 76 2d 67 65 74 2d 63 6f 6c 73 20 20 20 20 20 sv-get-cols
57b0: 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d vec) (vector-
57c0: 72 65 66 20 20 76 65 63 20 32 29 29 0a 28 64 65 ref vec 2)).(de
57d0: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 fine-inline (ref
57e0: 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 72 6f db:csv-get-maxro
57f0: 77 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 w vec) (vec
5800: 74 6f 72 2d 72 65 66 20 20 76 65 63 20 33 29 29 tor-ref vec 3))
5810: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
5820: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d (refdb:csv-get-m
5830: 61 78 63 6f 6c 20 20 20 76 65 63 29 20 20 20 20 axcol vec)
5840: 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 (vector-ref vec
5850: 20 34 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 4)).(define-inl
5860: 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 73 ine (refdb:csv-s
5870: 65 74 2d 73 76 65 63 21 20 20 20 20 76 65 63 20 et-svec! vec
5880: 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 val)(vector-set!
5890: 20 76 65 63 20 30 20 76 61 6c 29 29 0a 28 64 65 vec 0 val)).(de
58a0: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 fine-inline (ref
58b0: 64 62 3a 63 73 76 2d 73 65 74 2d 72 6f 77 73 21 db:csv-set-rows!
58c0: 20 20 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 vec val)(vec
58d0: 74 6f 72 2d 73 65 74 21 20 76 65 63 20 31 20 76 tor-set! vec 1 v
58e0: 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c al)).(define-inl
58f0: 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 73 ine (refdb:csv-s
5900: 65 74 2d 63 6f 6c 73 21 20 20 20 20 76 65 63 20 et-cols! vec
5910: 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 val)(vector-set!
5920: 20 76 65 63 20 32 20 76 61 6c 29 29 0a 28 64 65 vec 2 val)).(de
5930: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 fine-inline (ref
5940: 64 62 3a 63 73 76 2d 73 65 74 2d 6d 61 78 72 6f db:csv-set-maxro
5950: 77 21 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 w! vec val)(vec
5960: 74 6f 72 2d 73 65 74 21 20 76 65 63 20 33 20 76 tor-set! vec 3 v
5970: 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c al)).(define-inl
5980: 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 73 ine (refdb:csv-s
5990: 65 74 2d 6d 61 78 63 6f 6c 21 20 20 76 65 63 20 et-maxcol! vec
59a0: 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 val)(vector-set!
59b0: 20 76 65 63 20 34 20 76 61 6c 29 29 0a 0a 28 64 vec 4 val))..(d
59c0: 65 66 69 6e 65 20 28 67 65 74 2d 64 61 74 20 72 efine (get-dat r
59d0: 65 73 75 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 esults sheetname
59e0: 29 0a 20 20 28 6f 72 20 28 68 61 73 68 2d 74 61 ). (or (hash-ta
59f0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
5a00: 72 65 73 75 6c 74 73 20 73 68 65 65 74 6e 61 6d results sheetnam
5a10: 65 20 23 66 29 0a 20 20 20 20 20 20 28 6c 65 74 e #f). (let
5a20: 20 28 28 74 6d 70 2d 76 65 63 20 20 28 6d 61 6b ((tmp-vec (mak
5a30: 65 2d 72 65 66 64 62 3a 63 73 76 29 29 29 0a 09 e-refdb:csv)))..
5a40: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
5a50: 20 72 65 73 75 6c 74 73 20 73 68 65 65 74 6e 61 results sheetna
5a60: 6d 65 20 74 6d 70 2d 76 65 63 29 0a 09 74 6d 70 me tmp-vec)..tmp
5a70: 2d 76 65 63 29 29 29 0a 0a 28 69 66 20 28 61 72 -vec)))..(if (ar
5a80: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 66 gs:get-arg "-ref
5a90: 64 62 32 64 61 74 22 29 0a 20 20 20 20 28 6c 65 db2dat"). (le
5aa0: 74 2a 20 28 28 69 6e 70 75 74 2d 64 62 20 28 61 t* ((input-db (a
5ab0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
5ac0: 66 64 62 32 64 61 74 22 29 29 0a 09 20 20 20 28 fdb2dat")).. (
5ad0: 6f 75 74 2d 66 69 6c 65 20 28 61 72 67 73 3a 67 out-file (args:g
5ae0: 65 74 2d 61 72 67 20 22 2d 6f 22 29 29 0a 09 20 et-arg "-o"))..
5af0: 20 20 28 6f 75 74 2d 66 6d 74 20 20 28 6f 72 20 (out-fmt (or
5b00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5b10: 64 75 6d 70 6d 6f 64 65 22 29 20 22 73 63 68 65 dumpmode") "sche
5b20: 6d 65 22 29 29 0a 09 20 20 20 28 6f 75 74 2d 70 me")).. (out-p
5b30: 6f 72 74 20 28 69 66 20 28 61 6e 64 20 6f 75 74 ort (if (and out
5b40: 2d 66 69 6c 65 20 0a 09 09 09 20 20 20 20 20 20 -file ....
5b50: 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 6f 75 74 (not (member out
5b60: 2d 66 6d 74 20 27 28 22 73 71 6c 69 74 65 33 22 -fmt '("sqlite3"
5b70: 20 22 63 73 76 22 29 29 29 29 0a 09 09 09 20 28 "csv")))).... (
5b80: 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 open-output-file
5b90: 20 6f 75 74 2d 66 69 6c 65 29 0a 09 09 09 20 28 out-file).... (
5ba0: 63 75 72 72 65 6e 74 2d 6f 75 74 70 75 74 2d 70 current-output-p
5bb0: 6f 72 74 29 29 29 0a 09 20 20 20 28 72 65 73 2d ort))).. (res-
5bc0: 64 61 74 61 20 28 63 6f 6e 66 69 67 66 3a 72 65 data (configf:re
5bd0: 61 64 2d 72 65 66 64 62 20 69 6e 70 75 74 2d 64 ad-refdb input-d
5be0: 62 29 29 0a 09 20 20 20 28 64 61 74 61 20 20 20 b)).. (data
5bf0: 20 20 28 63 61 72 20 72 65 73 2d 64 61 74 61 29 (car res-data)
5c00: 29 0a 09 20 20 20 28 6d 73 67 20 20 20 20 20 20 ).. (msg
5c10: 28 63 61 64 72 20 72 65 73 2d 64 61 74 61 29 29 (cadr res-data))
5c20: 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 ). (if (not
5c30: 20 64 61 74 61 29 0a 09 20 20 28 64 65 62 75 67 data).. (debug
5c40: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
5c50: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 42 61 64 t-log-port* "Bad
5c60: 20 69 6e 70 75 74 3f 20 64 61 74 61 3d 22 20 64 input? data=" d
5c70: 61 74 61 29 20 3b 3b 20 73 6f 6d 65 20 65 72 72 ata) ;; some err
5c80: 6f 72 20 6f 63 63 75 72 72 65 64 0a 09 20 20 28 or occurred.. (
5c90: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 70 with-output-to-p
5ca0: 6f 72 74 20 6f 75 74 2d 70 6f 72 74 0a 09 20 20 ort out-port..
5cb0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 (lambda ()..
5cc0: 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e (case (strin
5cd0: 67 2d 3e 73 79 6d 62 6f 6c 20 6f 75 74 2d 66 6d g->symbol out-fm
5ce0: 74 29 0a 09 09 28 28 73 63 68 65 6d 65 29 28 70 t)...((scheme)(p
5cf0: 70 20 64 61 74 61 29 29 0a 09 09 28 28 70 65 72 p data))...((per
5d00: 6c 29 0a 09 09 20 3b 3b 20 28 70 72 69 6e 74 20 l)... ;; (print
5d10: 22 25 68 61 73 68 20 3d 20 28 22 29 0a 09 09 20 "%hash = (")...
5d20: 3b 3b 20 20 20 20 20 20 20 20 6b 65 79 31 20 3d ;; key1 =
5d30: 3e 20 27 76 61 6c 75 65 31 27 2c 0a 09 09 20 3b > 'value1',... ;
5d40: 3b 20 20 20 20 20 20 20 20 6b 65 79 32 20 3d 3e ; key2 =>
5d50: 20 27 76 61 6c 75 65 32 27 2c 0a 09 09 20 3b 3b 'value2',... ;;
5d60: 20 20 20 20 20 20 20 20 6b 65 79 33 20 3d 3e 20 key3 =>
5d70: 27 76 61 6c 75 65 33 27 2c 0a 09 09 20 3b 3b 20 'value3',... ;;
5d80: 29 3b 0a 09 09 20 28 63 6f 6e 66 69 67 66 3a 6d );... (configf:m
5d90: 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 ap-all-hier-alis
5da0: 74 20 0a 09 09 20 20 64 61 74 61 20 0a 09 09 20 t ... data ...
5db0: 20 28 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e (lambda (sheetn
5dc0: 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 ame sectionname
5dd0: 76 61 72 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 varname val)...
5de0: 20 20 20 28 70 72 69 6e 74 20 22 24 64 61 74 61 (print "$data
5df0: 7b 5c 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 {\"" sheetname "
5e00: 5c 22 7d 7b 5c 22 22 20 73 65 63 74 69 6f 6e 6e \"}{\"" sectionn
5e10: 61 6d 65 20 22 5c 22 7d 7b 5c 22 22 20 76 61 72 ame "\"}{\"" var
5e20: 6e 61 6d 65 20 22 5c 22 7d 20 3d 20 5c 22 22 20 name "\"} = \""
5e30: 76 61 6c 20 22 5c 22 3b 22 29 29 29 29 0a 09 09 val "\";"))))...
5e40: 28 28 70 79 74 68 6f 6e 20 72 75 62 79 29 0a 09 ((python ruby)..
5e50: 09 20 28 70 72 69 6e 74 20 22 64 61 74 61 3d 7b . (print "data={
5e60: 7d 22 29 0a 09 09 20 28 63 6f 6e 66 69 67 66 3a }")... (configf:
5e70: 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 map-all-hier-ali
5e80: 73 74 0a 09 09 20 20 64 61 74 61 0a 09 09 20 20 st... data...
5e90: 28 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 (lambda (sheetna
5ea0: 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 me sectionname v
5eb0: 61 72 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 arname val)...
5ec0: 20 20 28 70 72 69 6e 74 20 22 64 61 74 61 5b 5c (print "data[\
5ed0: 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 "" sheetname "\"
5ee0: 5d 5b 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d ][\"" sectionnam
5ef0: 65 20 22 5c 22 5d 5b 5c 22 22 20 76 61 72 6e 61 e "\"][\"" varna
5f00: 6d 65 20 22 5c 22 5d 20 3d 20 5c 22 22 20 76 61 me "\"] = \"" va
5f10: 6c 20 22 5c 22 22 29 29 0a 09 09 20 20 69 6e 69 l "\""))... ini
5f20: 74 70 72 6f 63 31 3a 0a 09 09 20 20 28 6c 61 6d tproc1:... (lam
5f30: 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 29 0a bda (sheetname).
5f40: 09 09 20 20 20 20 28 70 72 69 6e 74 20 22 64 61 .. (print "da
5f50: 74 61 5b 5c 22 22 20 73 68 65 65 74 6e 61 6d 65 ta[\"" sheetname
5f60: 20 22 5c 22 5d 20 3d 20 7b 7d 22 29 29 0a 09 09 "\"] = {}"))...
5f70: 20 20 69 6e 69 74 70 72 6f 63 32 3a 0a 09 09 20 initproc2:...
5f80: 20 28 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e (lambda (sheetn
5f90: 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 29 ame sectionname)
5fa0: 0a 09 09 20 20 20 20 28 70 72 69 6e 74 20 22 64 ... (print "d
5fb0: 61 74 61 5b 5c 22 22 20 73 68 65 65 74 6e 61 6d ata[\"" sheetnam
5fc0: 65 20 22 5c 22 5d 5b 5c 22 22 20 73 65 63 74 69 e "\"][\"" secti
5fd0: 6f 6e 6e 61 6d 65 20 22 5c 22 5d 20 3d 20 7b 7d onname "\"] = {}
5fe0: 22 29 29 29 29 0a 09 09 28 28 63 73 76 29 0a 09 "))))...((csv)..
5ff0: 09 20 28 6c 65 74 2a 20 28 28 72 65 73 75 6c 74 . (let* ((result
6000: 73 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 s (make-hash-ta
6010: 62 6c 65 29 29 20 3b 3b 20 28 6d 61 6b 65 2d 73 ble)) ;; (make-s
6020: 70 61 72 73 65 2d 61 72 72 61 79 29 29 29 0a 09 parse-array)))..
6030: 09 09 28 72 6f 77 2d 63 6f 6c 73 20 28 6d 61 6b ..(row-cols (mak
6040: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 20 e-hash-table)))
6050: 3b 3b 20 68 61 73 68 20 6f 66 20 68 61 73 68 65 ;; hash of hashe
6060: 73 20 77 68 65 72 65 20 73 65 63 74 69 6f 6e 20 s where section
6070: 3d 3e 20 68 74 20 7b 20 72 6f 77 2d 3c 6e 61 6d => ht { row-<nam
6080: 65 3e 20 3d 3e 20 6e 75 6d 20 6f 72 20 63 6f 6c e> => num or col
6090: 2d 3c 6e 61 6d 65 3e 20 3d 3e 20 6e 75 6d 0a 09 -<name> => num..
60a0: 09 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 64 . ;; (print "d
60b0: 61 74 61 3d 22 29 0a 09 09 20 20 20 3b 3b 20 28 ata=")... ;; (
60c0: 70 70 20 64 61 74 61 29 0a 09 09 20 20 20 28 63 pp data)... (c
60d0: 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 onfigf:map-all-h
60e0: 69 65 72 2d 61 6c 69 73 74 0a 09 09 20 20 20 20 ier-alist...
60f0: 64 61 74 61 0a 09 09 20 20 20 20 28 6c 61 6d 62 data... (lamb
6100: 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 65 da (sheetname se
6110: 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d ctionname varnam
6120: 65 20 76 61 6c 29 0a 09 09 20 20 20 20 20 20 3b e val)... ;
6130: 3b 20 28 70 72 69 6e 74 20 22 73 68 65 65 74 6e ; (print "sheetn
6140: 61 6d 65 3a 20 22 20 73 68 65 65 74 6e 61 6d 65 ame: " sheetname
6150: 20 22 2c 20 73 65 63 74 69 6f 6e 6e 61 6d 65 3a ", sectionname:
6160: 20 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 " sectionname "
6170: 2c 20 76 61 72 6e 61 6d 65 3a 20 22 20 76 61 72 , varname: " var
6180: 6e 61 6d 65 20 22 2c 20 76 61 6c 3a 20 22 20 76 name ", val: " v
6190: 61 6c 29 0a 09 09 20 20 20 20 20 20 28 6c 65 74 al)... (let
61a0: 2a 20 28 28 64 61 74 20 20 20 20 20 20 28 67 65 * ((dat (ge
61b0: 74 2d 64 61 74 20 72 65 73 75 6c 74 73 20 73 68 t-dat results sh
61c0: 65 65 74 6e 61 6d 65 29 29 0a 09 09 09 20 20 20 eetname))....
61d0: 20 20 28 76 65 63 20 20 20 20 20 20 28 72 65 66 (vec (ref
61e0: 64 62 3a 63 73 76 2d 67 65 74 2d 73 76 65 63 20 db:csv-get-svec
61f0: 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 72 dat)).... (r
6200: 6f 77 6e 61 6d 65 73 20 28 72 65 66 64 62 3a 63 ownames (refdb:c
6210: 73 76 2d 67 65 74 2d 72 6f 77 73 20 64 61 74 29 sv-get-rows dat)
6220: 29 0a 09 09 09 20 20 20 20 20 28 63 6f 6c 6e 61 ).... (colna
6230: 6d 65 73 20 28 72 65 66 64 62 3a 63 73 76 2d 67 mes (refdb:csv-g
6240: 65 74 2d 63 6f 6c 73 20 64 61 74 29 29 0a 09 09 et-cols dat))...
6250: 09 20 20 20 20 20 28 63 75 72 72 72 6f 77 6e 20 . (currrown
6260: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
6270: 64 65 66 61 75 6c 74 20 72 6f 77 6e 61 6d 65 73 default rownames
6280: 20 76 61 72 6e 61 6d 65 20 23 66 29 29 0a 09 09 varname #f))...
6290: 09 20 20 20 20 20 28 63 75 72 72 63 6f 6c 6e 20 . (currcoln
62a0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
62b0: 64 65 66 61 75 6c 74 20 63 6f 6c 6e 61 6d 65 73 default colnames
62c0: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 23 66 29 sectionname #f)
62d0: 29 0a 09 09 09 20 20 20 20 20 28 72 6f 77 6e 20 ).... (rown
62e0: 20 20 20 20 28 6f 72 20 63 75 72 72 72 6f 77 6e (or currrown
62f0: 20 0a 09 09 09 09 09 20 20 20 28 6c 65 74 2a 20 ...... (let*
6300: 28 28 6c 61 73 74 6e 20 20 20 28 72 65 66 64 62 ((lastn (refdb
6310: 3a 63 73 76 2d 67 65 74 2d 6d 61 78 72 6f 77 20 :csv-get-maxrow
6320: 64 61 74 29 29 0a 09 09 09 09 09 09 20 20 28 6e dat))....... (n
6330: 65 77 72 6f 77 6e 20 28 2b 20 6c 61 73 74 6e 20 ewrown (+ lastn
6340: 31 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 1)))...... (
6350: 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d 61 refdb:csv-set-ma
6360: 78 72 6f 77 21 20 64 61 74 20 6e 65 77 72 6f 77 xrow! dat newrow
6370: 6e 29 0a 09 09 09 09 09 20 20 20 20 20 6e 65 77 n)...... new
6380: 72 6f 77 6e 29 29 29 0a 09 09 09 20 20 20 20 20 rown)))....
6390: 28 63 6f 6c 6e 20 20 20 20 20 28 6f 72 20 63 75 (coln (or cu
63a0: 72 72 63 6f 6c 6e 20 0a 09 09 09 09 09 20 20 20 rrcoln ......
63b0: 28 6c 65 74 2a 20 28 28 6c 61 73 74 6e 20 20 20 (let* ((lastn
63c0: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d (refdb:csv-get-m
63d0: 61 78 63 6f 6c 20 64 61 74 29 29 0a 09 09 09 09 axcol dat)).....
63e0: 09 09 20 20 28 6e 65 77 63 6f 6c 6e 20 28 2b 20 .. (newcoln (+
63f0: 6c 61 73 74 6e 20 31 29 29 29 0a 09 09 09 09 09 lastn 1)))......
6400: 20 20 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d (refdb:csv-
6410: 73 65 74 2d 6d 61 78 63 6f 6c 21 20 64 61 74 20 set-maxcol! dat
6420: 6e 65 77 63 6f 6c 6e 29 0a 09 09 09 09 09 20 20 newcoln)......
6430: 20 20 20 6e 65 77 63 6f 6c 6e 29 29 29 29 0a 09 newcoln))))..
6440: 09 09 28 69 66 20 28 6e 6f 74 20 28 73 70 61 72 ..(if (not (spar
6450: 73 65 2d 61 72 72 61 79 2d 72 65 66 20 76 65 63 se-array-ref vec
6460: 20 30 20 63 6f 6c 6e 29 29 20 3b 3b 20 28 65 71 0 coln)) ;; (eq
6470: 3f 20 72 6f 77 6e 20 30 29 0a 09 09 09 20 20 20 ? rown 0)....
6480: 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 (begin....
6490: 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d 73 (sparse-array-s
64a0: 65 74 21 20 76 65 63 20 30 20 63 6f 6c 6e 20 73 et! vec 0 coln s
64b0: 65 63 74 69 6f 6e 6e 61 6d 65 29 0a 09 09 09 20 ectionname)....
64c0: 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 ;; (print "
64d0: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 sparse-array-ref
64e0: 20 22 20 30 20 22 2c 22 20 63 6f 6c 6e 20 22 3d " 0 "," coln "=
64f0: 22 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d " (sparse-array-
6500: 72 65 66 20 76 65 63 20 30 20 63 6f 6c 6e 29 29 ref vec 0 coln))
6510: 0a 09 09 09 20 20 20 20 20 20 29 29 0a 09 09 09 .... ))....
6520: 28 69 66 20 28 6e 6f 74 20 28 73 70 61 72 73 65 (if (not (sparse
6530: 2d 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 72 -array-ref vec r
6540: 6f 77 6e 20 30 29 29 20 3b 3b 20 28 65 71 3f 20 own 0)) ;; (eq?
6550: 63 6f 6c 6e 20 30 29 0a 09 09 09 20 20 20 20 28 coln 0).... (
6560: 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 begin.... (
6570: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 sparse-array-set
6580: 21 20 76 65 63 20 72 6f 77 6e 20 30 20 76 61 72 ! vec rown 0 var
6590: 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 20 3b name).... ;
65a0: 3b 20 28 70 72 69 6e 74 20 22 73 70 61 72 73 65 ; (print "sparse
65b0: 2d 61 72 72 61 79 2d 72 65 66 20 22 20 72 6f 77 -array-ref " row
65c0: 6e 20 22 2c 22 20 30 20 22 3d 22 20 28 73 70 61 n "," 0 "=" (spa
65d0: 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 76 65 rse-array-ref ve
65e0: 63 20 72 6f 77 6e 20 30 29 29 0a 09 09 09 20 20 c rown 0))....
65f0: 20 20 20 20 29 29 0a 09 09 09 28 69 66 20 28 6e ))....(if (n
6600: 6f 74 20 63 75 72 72 72 6f 77 6e 29 28 68 61 73 ot currrown)(has
6610: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 6f 77 h-table-set! row
6620: 6e 61 6d 65 73 20 76 61 72 6e 61 6d 65 20 72 6f names varname ro
6630: 77 6e 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 wn))....(if (not
6640: 20 63 75 72 72 63 6f 6c 6e 29 28 68 61 73 68 2d currcoln)(hash-
6650: 74 61 62 6c 65 2d 73 65 74 21 20 63 6f 6c 6e 61 table-set! colna
6660: 6d 65 73 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 mes sectionname
6670: 63 6f 6c 6e 29 29 0a 09 09 09 3b 3b 20 28 70 72 coln))....;; (pr
6680: 69 6e 74 20 22 64 61 74 3d 22 20 64 61 74 20 22 int "dat=" dat "
6690: 2c 20 72 6f 77 6e 3d 22 20 72 6f 77 6e 20 22 2c , rown=" rown ",
66a0: 20 63 6f 6c 6e 3d 22 20 63 6f 6c 6e 29 0a 09 09 coln=" coln)...
66b0: 09 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d 73 .(sparse-array-s
66c0: 65 74 21 20 76 65 63 20 72 6f 77 6e 20 63 6f 6c et! vec rown col
66d0: 6e 20 76 61 6c 29 0a 09 09 09 3b 3b 20 28 70 72 n val)....;; (pr
66e0: 69 6e 74 20 22 73 70 61 72 73 65 2d 61 72 72 61 int "sparse-arra
66f0: 79 2d 72 65 66 20 22 20 72 6f 77 6e 20 22 2c 22 y-ref " rown ","
6700: 20 63 6f 6c 6e 20 22 3d 22 20 28 73 70 61 72 73 coln "=" (spars
6710: 65 2d 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 e-array-ref vec
6720: 72 6f 77 6e 20 63 6f 6c 6e 29 29 0a 09 09 09 29 rown coln))....)
6730: 29 29 0a 09 09 20 20 20 28 66 6f 72 2d 65 61 63 ))... (for-eac
6740: 68 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 h... (lambda
6750: 28 73 68 65 65 74 6e 61 6d 65 29 0a 09 09 20 20 (sheetname)...
6760: 20 20 20 20 28 6c 65 74 2a 20 28 28 73 68 65 65 (let* ((shee
6770: 74 64 61 74 20 28 67 65 74 2d 64 61 74 20 72 65 tdat (get-dat re
6780: 73 75 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 29 sults sheetname)
6790: 29 0a 09 09 09 20 20 20 20 20 28 73 76 65 63 20 ).... (svec
67a0: 20 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 (refdb:csv-g
67b0: 65 74 2d 73 76 65 63 20 73 68 65 65 74 64 61 74 et-svec sheetdat
67c0: 29 29 0a 09 09 09 20 20 20 20 20 28 6d 61 78 72 )).... (maxr
67d0: 6f 77 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d ow (refdb:csv-
67e0: 67 65 74 2d 6d 61 78 72 6f 77 20 73 68 65 65 74 get-maxrow sheet
67f0: 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 6d dat)).... (m
6800: 61 78 63 6f 6c 20 20 20 28 72 65 66 64 62 3a 63 axcol (refdb:c
6810: 73 76 2d 67 65 74 2d 6d 61 78 63 6f 6c 20 73 68 sv-get-maxcol sh
6820: 65 65 74 64 61 74 29 29 0a 09 09 09 20 20 20 20 eetdat))....
6830: 20 28 66 6e 61 6d 65 20 20 20 20 28 69 66 20 6f (fname (if o
6840: 75 74 2d 66 69 6c 65 20 0a 09 09 09 09 09 20 20 ut-file ......
6850: 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 (string-substit
6860: 75 74 65 20 22 25 73 22 20 73 68 65 65 74 6e 61 ute "%s" sheetna
6870: 6d 65 20 6f 75 74 2d 66 69 6c 65 29 20 3b 3b 20 me out-file) ;;
6880: 22 2f 66 6f 6f 2f 62 61 72 2f 25 73 2e 63 73 76 "/foo/bar/%s.csv
6890: 22 29 0a 09 09 09 09 09 20 20 20 28 63 6f 6e 63 ")...... (conc
68a0: 20 73 68 65 65 74 6e 61 6d 65 20 22 2e 63 73 76 sheetname ".csv
68b0: 22 29 29 29 29 0a 09 09 09 28 77 69 74 68 2d 6f "))))....(with-o
68c0: 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 66 6e utput-to-file fn
68d0: 61 6d 65 0a 09 09 09 20 20 28 6c 61 6d 62 64 61 ame.... (lambda
68e0: 20 28 29 0a 09 09 09 20 20 20 20 3b 3b 20 28 70 ().... ;; (p
68f0: 72 69 6e 74 20 22 53 68 65 65 74 6e 61 6d 65 3a rint "Sheetname:
6900: 20 22 20 73 68 65 65 74 6e 61 6d 65 29 0a 09 09 " sheetname)...
6910: 09 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 . (let loop (
6920: 28 72 6f 77 20 20 20 20 20 20 20 30 29 0a 09 09 (row 0)...
6930: 09 09 20 20 20 20 20 20 20 28 63 6f 6c 20 20 20 .. (col
6940: 20 20 20 20 30 29 0a 09 09 09 09 20 20 20 20 20 0).....
6950: 20 20 28 63 75 72 72 2d 72 6f 77 20 27 28 29 29 (curr-row '())
6960: 0a 09 09 09 09 20 20 20 20 20 20 20 28 72 65 73 ..... (res
6970: 75 6c 74 20 20 20 27 28 29 29 29 0a 09 09 09 20 ult '()))....
6980: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 76 61 6c (let* ((val
6990: 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 (sparse-array-r
69a0: 65 66 20 73 76 65 63 20 72 6f 77 20 63 6f 6c 29 ef svec row col)
69b0: 29 0a 09 09 09 09 20 20 20 20 20 28 64 69 73 70 )..... (disp
69c0: 2d 76 61 6c 20 28 69 66 20 76 61 6c 0a 09 09 09 -val (if val....
69d0: 09 09 09 20 20 20 28 63 6f 6e 63 20 22 5c 22 22 ... (conc "\""
69e0: 20 76 61 6c 20 22 5c 22 22 29 0a 09 09 09 09 09 val "\"")......
69f0: 09 20 20 20 22 22 29 29 29 0a 09 09 09 09 28 69 . ""))).....(i
6a00: 66 20 28 3e 20 63 6f 6c 20 30 29 28 64 69 73 70 f (> col 0)(disp
6a10: 6c 61 79 20 22 2c 22 29 29 0a 09 09 09 09 28 64 lay ",")).....(d
6a20: 69 73 70 6c 61 79 20 64 69 73 70 2d 76 61 6c 29 isplay disp-val)
6a30: 0a 09 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 20 .....(cond.....
6a40: 28 28 3e 20 72 6f 77 20 6d 61 78 72 6f 77 29 28 ((> row maxrow)(
6a50: 64 69 73 70 6c 61 79 20 22 5c 6e 22 29 20 72 65 display "\n") re
6a60: 73 75 6c 74 29 0a 09 09 09 09 20 28 28 3e 3d 20 sult)..... ((>=
6a70: 63 6f 6c 20 6d 61 78 63 6f 6c 29 0a 09 09 09 09 col maxcol).....
6a80: 20 20 28 64 69 73 70 6c 61 79 20 22 5c 6e 22 29 (display "\n")
6a90: 0a 09 09 09 09 20 20 28 6c 6f 6f 70 20 28 2b 20 ..... (loop (+
6aa0: 72 6f 77 20 31 29 20 30 20 27 28 29 20 28 61 70 row 1) 0 '() (ap
6ab0: 70 65 6e 64 20 72 65 73 75 6c 74 20 28 6c 69 73 pend result (lis
6ac0: 74 20 63 75 72 72 2d 72 6f 77 29 29 29 29 0a 09 t curr-row))))..
6ad0: 09 09 09 20 28 65 6c 73 65 0a 09 09 09 09 20 20 ... (else.....
6ae0: 28 6c 6f 6f 70 20 72 6f 77 20 28 2b 20 63 6f 6c (loop row (+ col
6af0: 20 31 29 20 28 61 70 70 65 6e 64 20 63 75 72 72 1) (append curr
6b00: 2d 72 6f 77 20 28 6c 69 73 74 20 76 61 6c 29 29 -row (list val))
6b10: 20 72 65 73 75 6c 74 29 29 29 29 29 29 29 29 29 result)))))))))
6b20: 0a 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 ... (hash-tab
6b30: 6c 65 2d 6b 65 79 73 20 72 65 73 75 6c 74 73 29 le-keys results)
6b40: 29 29 29 0a 09 09 28 28 73 71 6c 69 74 65 33 29 )))...((sqlite3)
6b50: 0a 09 09 20 28 6c 65 74 2a 20 28 28 64 62 2d 66 ... (let* ((db-f
6b60: 69 6c 65 20 20 20 28 6f 72 20 6f 75 74 2d 66 69 ile (or out-fi
6b70: 6c 65 20 28 70 61 74 68 6e 61 6d 65 2d 66 69 6c le (pathname-fil
6b80: 65 20 69 6e 70 75 74 2d 64 62 29 29 29 0a 09 09 e input-db)))...
6b90: 09 28 64 62 2d 65 78 69 73 74 73 20 28 66 69 6c .(db-exists (fil
6ba0: 65 2d 65 78 69 73 74 73 3f 20 64 62 2d 66 69 6c e-exists? db-fil
6bb0: 65 29 29 0a 09 09 09 28 64 62 20 20 20 20 20 20 e))....(db
6bc0: 20 20 28 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d (sqlite3:open-
6bd0: 64 61 74 61 62 61 73 65 20 64 62 2d 66 69 6c 65 database db-file
6be0: 29 29 29 0a 09 09 20 20 20 28 69 66 20 28 6e 6f )))... (if (no
6bf0: 74 20 64 62 2d 65 78 69 73 74 73 29 28 73 71 6c t db-exists)(sql
6c00: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
6c10: 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 64 61 "CREATE TABLE da
6c20: 74 61 20 28 73 68 65 65 74 2c 73 65 63 74 69 6f ta (sheet,sectio
6c30: 6e 2c 76 61 72 2c 76 61 6c 29 3b 22 29 29 0a 09 n,var,val);"))..
6c40: 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 . (configf:map
6c50: 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 0a -all-hier-alist.
6c60: 09 09 20 20 20 20 64 61 74 61 0a 09 09 20 20 20 .. data...
6c70: 20 28 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e (lambda (sheetn
6c80: 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 ame sectionname
6c90: 76 61 72 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 varname val)...
6ca0: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 (sqlite3:ex
6cb0: 65 63 75 74 65 20 64 62 0a 09 09 09 09 20 20 20 ecute db.....
6cc0: 20 20 20 20 22 49 4e 53 45 52 54 20 4f 52 20 52 "INSERT OR R
6cd0: 45 50 4c 41 43 45 20 49 4e 54 4f 20 64 61 74 61 EPLACE INTO data
6ce0: 20 28 73 68 65 65 74 2c 73 65 63 74 69 6f 6e 2c (sheet,section,
6cf0: 76 61 72 2c 76 61 6c 29 20 56 41 4c 55 45 53 20 var,val) VALUES
6d00: 28 3f 2c 3f 2c 3f 2c 3f 29 3b 22 0a 09 09 09 09 (?,?,?,?);".....
6d10: 20 20 20 20 20 20 20 73 68 65 65 74 6e 61 6d 65 sheetname
6d20: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 sectionname var
6d30: 6e 61 6d 65 20 76 61 6c 29 29 29 0a 09 09 20 20 name val)))...
6d40: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
6d50: 7a 65 21 20 64 62 29 29 29 0a 09 09 28 65 6c 73 ze! db)))...(els
6d60: 65 0a 09 09 20 28 70 70 20 64 61 74 61 29 29 29 e... (pp data)))
6d70: 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 6f 75 ))). (if ou
6d80: 74 2d 66 69 6c 65 20 28 63 6c 6f 73 65 2d 6f 75 t-file (close-ou
6d90: 74 70 75 74 2d 70 6f 72 74 20 6f 75 74 2d 70 6f tput-port out-po
6da0: 72 74 29 29 0a 20 20 20 20 20 20 28 65 78 69 74 rt)). (exit
6db0: 29 20 3b 3b 20 79 65 73 2c 20 62 65 6e 64 69 6e ) ;; yes, bendin
6dc0: 67 20 74 68 65 20 72 75 6c 65 73 20 68 65 72 65 g the rules here
6dd0: 20 2d 20 6e 65 65 64 20 74 6f 20 65 78 69 74 20 - need to exit
6de0: 73 69 6e 63 65 20 74 68 69 73 20 69 73 20 61 20 since this is a
6df0: 75 74 69 6c 69 74 79 0a 20 20 20 20 20 20 29 29 utility. ))
6e00: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
6e10: 61 72 67 20 22 2d 70 69 6e 67 22 29 0a 20 20 20 arg "-ping").
6e20: 20 28 6c 65 74 2a 20 28 28 73 65 72 76 65 72 2d (let* ((server-
6e30: 69 64 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e id (string->
6e40: 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 number (args:get
6e50: 2d 61 72 67 20 22 2d 70 69 6e 67 22 29 29 29 20 -arg "-ping")))
6e60: 3b 3b 20 65 78 74 72 61 63 74 20 72 75 6e 2d 69 ;; extract run-i
6e70: 64 20 28 69 2e 65 2e 20 6e 6f 20 22 3a 22 0a 09 d (i.e. no ":"..
6e80: 20 20 20 28 68 6f 73 74 3a 70 6f 72 74 20 20 20 (host:port
6e90: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
6ea0: 22 2d 70 69 6e 67 22 29 29 29 0a 20 20 20 20 20 "-ping"))).
6eb0: 20 28 73 65 72 76 65 72 3a 70 69 6e 67 20 28 6f (server:ping (o
6ec0: 72 20 73 65 72 76 65 72 2d 69 64 20 68 6f 73 74 r server-id host
6ed0: 3a 70 6f 72 74 29 20 64 6f 2d 65 78 69 74 3a 20 :port) do-exit:
6ee0: 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d #t)))..;;=======
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 3d ================
6f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
6f30: 3b 3b 20 43 61 70 74 75 72 65 2c 20 73 61 76 65 ;; Capture, save
6f40: 20 61 6e 64 20 6d 61 6e 69 70 75 6c 61 74 65 20 and manipulate
6f50: 65 6e 76 69 72 6f 6e 6d 65 6e 74 73 0a 3b 3b 3d environments.;;=
6f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6fa0: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 =====..;; NOTE:
6fb0: 4b 65 65 70 20 74 68 65 73 65 20 61 62 6f 76 65 Keep these above
6fc0: 20 74 68 65 20 73 65 63 74 69 6f 6e 20 77 68 65 the section whe
6fd0: 72 65 20 74 68 65 20 73 65 72 76 65 72 20 6f 72 re the server or
6fe0: 20 63 6c 69 65 6e 74 20 63 6f 64 65 20 69 73 20 client code is
6ff0: 73 65 74 75 70 0a 0a 28 6c 65 74 20 28 28 65 6e setup..(let ((en
7000: 76 63 61 70 20 28 61 72 67 73 3a 67 65 74 2d 61 vcap (args:get-a
7010: 72 67 20 22 2d 65 6e 76 63 61 70 22 29 29 29 0a rg "-envcap"))).
7020: 20 20 28 69 66 20 65 6e 76 63 61 70 0a 20 20 20 (if envcap.
7030: 20 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 (let* ((db
7040: 20 20 20 28 65 6e 76 3a 6f 70 65 6e 2d 64 62 20 (env:open-db
7050: 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 (if (null? remar
7060: 67 73 29 20 22 65 6e 76 64 61 74 2e 64 62 22 20 gs) "envdat.db"
7070: 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 29 (car remargs))))
7080: 29 0a 09 28 65 6e 76 3a 73 61 76 65 2d 65 6e 76 )..(env:save-env
7090: 2d 76 61 72 73 20 64 62 20 65 6e 76 63 61 70 29 -vars db envcap)
70a0: 0a 09 28 65 6e 76 3a 63 6c 6f 73 65 2d 64 61 74 ..(env:close-dat
70b0: 61 62 61 73 65 20 64 62 29 0a 09 28 73 65 74 21 abase db)..(set!
70c0: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
70d0: 23 74 29 29 29 29 0a 0a 3b 3b 20 64 65 6c 74 61 #t))))..;; delta
70e0: 20 22 6c 61 6e 67 75 61 67 65 22 20 77 69 6c 6c "language" will
70f0: 20 65 76 65 6e 74 75 61 6c 6c 79 20 62 65 20 72 eventually be r
7100: 65 73 3d 61 2b 62 2d 63 20 62 75 74 20 66 6f 72 es=a+b-c but for
7110: 20 6e 6f 77 20 69 74 20 69 73 20 6a 75 73 74 20 now it is just
7120: 72 65 73 3d 61 2d 62 20 0a 3b 3b 0a 28 6c 65 74 res=a-b .;;.(let
7130: 20 28 28 65 6e 76 64 65 6c 74 61 20 28 61 72 67 ((envdelta (arg
7140: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 64 s:get-arg "-envd
7150: 65 6c 74 61 22 29 29 29 0a 20 20 28 69 66 20 65 elta"))). (if e
7160: 6e 76 64 65 6c 74 61 0a 20 20 20 20 20 20 28 6c nvdelta. (l
7170: 65 74 20 28 28 6d 61 74 63 68 20 28 73 74 72 69 et ((match (stri
7180: 6e 67 2d 73 70 6c 69 74 20 65 6e 76 64 65 6c 74 ng-split envdelt
7190: 61 20 22 2d 22 29 29 29 3b 3b 20 28 73 74 72 69 a "-")));; (stri
71a0: 6e 67 2d 6d 61 74 63 68 20 22 28 5b 61 2d 7a 30 ng-match "([a-z0
71b0: 2d 39 5f 5d 2b 29 3d 28 5b 61 2d 7a 30 2d 39 5f -9_]+)=([a-z0-9_
71c0: 5c 5c 2d 2c 5d 2b 29 22 20 65 6e 76 64 65 6c 74 \\-,]+)" envdelt
71d0: 61 29 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 a)))..(if (not (
71e0: 6e 75 6c 6c 3f 20 6d 61 74 63 68 29 29 0a 09 20 null? match))..
71f0: 20 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 (let* ((db
7200: 20 20 20 20 20 28 65 6e 76 3a 6f 70 65 6e 2d 64 (env:open-d
7210: 62 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d b (if (null? rem
7220: 61 72 67 73 29 20 22 65 6e 76 64 61 74 2e 64 62 args) "envdat.db
7230: 22 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 " (car remargs))
7240: 29 29 0a 09 09 20 20 20 3b 3b 20 28 72 65 73 63 ))... ;; (resc
7250: 74 78 20 20 20 20 28 63 61 64 72 20 6d 61 74 63 tx (cadr matc
7260: 68 29 29 0a 09 09 20 20 20 3b 3b 20 28 65 71 75 h))... ;; (equ
7270: 6e 20 20 20 20 20 20 28 63 61 64 64 72 20 6d 61 n (caddr ma
7280: 74 63 68 29 29 0a 09 09 20 20 20 28 70 61 72 74 tch))... (part
7290: 73 20 20 20 20 20 6d 61 74 63 68 29 20 3b 3b 20 s match) ;;
72a0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 65 71 (string-split eq
72b0: 75 6e 20 22 2d 22 29 29 0a 09 09 20 20 20 28 6d un "-"))... (m
72c0: 69 6e 75 65 6e 64 20 20 20 28 63 61 72 20 70 61 inuend (car pa
72d0: 72 74 73 29 29 0a 09 09 20 20 20 28 73 75 62 74 rts))... (subt
72e0: 72 61 65 6e 64 20 28 63 61 64 72 20 70 61 72 74 raend (cadr part
72f0: 73 29 29 0a 09 09 20 20 20 28 61 64 64 65 64 20 s))... (added
7300: 20 20 20 20 28 65 6e 76 3a 67 65 74 2d 61 64 64 (env:get-add
7310: 65 64 20 20 20 64 62 20 6d 69 6e 75 65 6e 64 20 ed db minuend
7320: 73 75 62 74 72 61 65 6e 64 29 29 0a 09 09 20 20 subtraend))...
7330: 20 28 72 65 6d 6f 76 65 64 20 20 20 28 65 6e 76 (removed (env
7340: 3a 67 65 74 2d 72 65 6d 6f 76 65 64 20 64 62 20 :get-removed db
7350: 6d 69 6e 75 65 6e 64 20 73 75 62 74 72 61 65 6e minuend subtraen
7360: 64 29 29 0a 09 09 20 20 20 28 63 68 61 6e 67 65 d))... (change
7370: 64 20 20 20 28 65 6e 76 3a 67 65 74 2d 63 68 61 d (env:get-cha
7380: 6e 67 65 64 20 64 62 20 6d 69 6e 75 65 6e 64 20 nged db minuend
7390: 73 75 62 74 72 61 65 6e 64 29 29 29 0a 09 20 20 subtraend)))..
73a0: 20 20 20 20 3b 3b 20 28 70 70 20 28 68 61 73 68 ;; (pp (hash
73b0: 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 61 64 -table->alist ad
73c0: 64 65 64 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 ded)).. ;;
73d0: 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (pp (hash-table-
73e0: 3e 61 6c 69 73 74 20 72 65 6d 6f 76 65 64 29 29 >alist removed))
73f0: 0a 09 20 20 20 20 20 20 3b 3b 20 28 70 70 20 28 .. ;; (pp (
7400: 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 hash-table->alis
7410: 74 20 63 68 61 6e 67 65 64 29 29 0a 09 20 20 20 t changed))..
7420: 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 (if (args:get
7430: 2d 61 72 67 20 22 2d 6f 22 29 0a 09 09 20 20 28 -arg "-o")... (
7440: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 with-output-to-f
7450: 69 6c 65 0a 09 09 20 20 20 20 20 20 28 61 72 67 ile... (arg
7460: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 0a s:get-arg "-o").
7470: 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 .. (lambda ()
7480: 0a 09 09 20 20 20 20 20 20 28 65 6e 76 3a 70 72 ... (env:pr
7490: 69 6e 74 20 61 64 64 65 64 20 72 65 6d 6f 76 65 int added remove
74a0: 64 20 63 68 61 6e 67 65 64 29 29 29 0a 09 09 20 d changed)))...
74b0: 20 28 65 6e 76 3a 70 72 69 6e 74 20 61 64 64 65 (env:print adde
74c0: 64 20 72 65 6d 6f 76 65 64 20 63 68 61 6e 67 65 d removed change
74d0: 64 29 29 0a 09 20 20 20 20 20 20 28 65 6e 76 3a d)).. (env:
74e0: 63 6c 6f 73 65 2d 64 61 74 61 62 61 73 65 20 64 close-database d
74f0: 62 29 0a 09 20 20 20 20 20 20 28 73 65 74 21 20 b).. (set!
7500: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
7510: 74 29 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a t)).. (debug:
7520: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
7530: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
7540: 20 22 50 61 72 61 6d 65 74 65 72 20 74 6f 20 2d "Parameter to -
7550: 65 6e 76 64 65 6c 74 61 20 73 68 6f 75 6c 64 20 envdelta should
7560: 62 65 20 6e 65 77 3d 73 74 61 72 2d 65 6e 64 22 be new=star-end"
7570: 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d )))))..;;=======
7580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
75a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
75b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
75c0: 3b 3b 20 53 74 61 72 74 20 74 68 65 20 73 65 72 ;; Start the ser
75d0: 76 65 72 20 2d 20 63 61 6e 20 62 65 20 64 6f 6e ver - can be don
75e0: 65 20 69 6e 20 63 6f 6e 6a 75 6e 63 74 69 6f 6e e in conjunction
75f0: 20 77 69 74 68 20 2d 72 75 6e 61 6c 6c 20 6f 72 with -runall or
7600: 20 2d 72 75 6e 74 65 73 74 73 20 28 6f 6e 65 20 -runtests (one
7610: 64 61 79 2e 2e 2e 29 0a 3b 3b 20 20 20 77 65 20 day...).;; we
7620: 73 74 61 72 74 20 74 68 65 20 73 65 72 76 65 72 start the server
7630: 20 69 66 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 if not running
7640: 65 6c 73 65 20 73 74 61 72 74 20 74 68 65 20 63 else start the c
7650: 6c 69 65 6e 74 20 74 68 72 65 61 64 0a 3b 3b 3d lient thread.;;=
7660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76a0: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 53 65 72 76 65 72 =====..;; Server
76b0: 3f 20 53 74 61 72 74 20 75 70 20 68 65 72 65 2e ? Start up here.
76c0: 0a 3b 3b 0a 28 69 66 20 28 61 72 67 73 3a 67 65 .;;.(if (args:ge
76d0: 74 2d 61 72 67 20 22 2d 73 65 72 76 65 72 22 29 t-arg "-server")
76e0: 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 20 . (let ((tl
76f0: 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 73 65 (launch:se
7700: 74 75 70 29 29 0a 20 20 20 20 20 20 20 20 20 20 tup)).
7710: 28 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 20 (transport-type
7720: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
7730: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
7740: 67 20 22 2d 74 72 61 6e 73 70 6f 72 74 22 29 20 g "-transport")
7750: 22 68 74 74 70 22 29 29 29 29 0a 20 20 20 20 20 "http")))).
7760: 20 28 73 65 72 76 65 72 3a 6c 61 75 6e 63 68 20 (server:launch
7770: 30 20 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 0 transport-type
7780: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
7790: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
77a0: 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 ))..(if (or (arg
77b0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
77c0: 2d 73 65 72 76 65 72 73 22 29 0a 09 28 61 72 67 -servers")..(arg
77d0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 6f 70 s:get-arg "-stop
77e0: 2d 73 65 72 76 65 72 22 29 0a 20 20 20 20 20 20 -server").
77f0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
7800: 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 29 29 "-kill-server"))
7810: 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 28 . (let ((tl (
7820: 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 0a launch:setup))).
7830: 20 20 20 20 20 20 28 69 66 20 74 6c 20 0a 09 20 (if tl ..
7840: 20 28 6c 65 74 2a 20 28 28 74 64 62 64 61 74 20 (let* ((tdbdat
7850: 20 28 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 (tasks:open-db)
7860: 29 0a 09 09 20 28 73 65 72 76 65 72 73 20 28 74 )... (servers (t
7870: 61 73 6b 73 3a 67 65 74 2d 61 6c 6c 2d 73 65 72 asks:get-all-ser
7880: 76 65 72 73 20 28 64 62 3a 64 65 6c 61 79 2d 69 vers (db:delay-i
7890: 66 2d 62 75 73 79 20 74 64 62 64 61 74 29 29 29 f-busy tdbdat)))
78a0: 0a 09 09 20 28 66 6d 74 73 74 72 20 20 22 7e 35 ... (fmtstr "~5
78b0: 61 7e 31 32 61 7e 38 61 7e 32 30 61 7e 32 34 61 a~12a~8a~20a~24a
78c0: 7e 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 ~10a~10a~10a~10a
78d0: 5c 6e 22 29 0a 09 09 20 28 73 65 72 76 65 72 73 \n")... (servers
78e0: 2d 74 6f 2d 6b 69 6c 6c 20 27 28 29 29 0a 20 20 -to-kill '()).
78f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
7900: 6b 69 6c 6c 2d 73 77 69 74 63 68 20 20 28 69 66 kill-switch (if
7910: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7920: 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 29 20 22 -kill-server") "
7930: 2d 39 22 20 22 22 29 29 0a 20 20 20 20 20 20 20 -9" "")).
7940: 20 20 20 20 20 20 20 20 20 20 28 6b 69 6c 6c 69 (killi
7950: 6e 66 6f 20 20 20 28 6f 72 20 28 61 72 67 73 3a nfo (or (args:
7960: 67 65 74 2d 61 72 67 20 22 2d 73 74 6f 70 2d 73 get-arg "-stop-s
7970: 65 72 76 65 72 22 29 20 28 61 72 67 73 3a 67 65 erver") (args:ge
7980: 74 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 72 t-arg "-kill-ser
7990: 76 65 72 22 29 20 29 29 0a 09 09 20 28 6b 68 6f ver") ))... (kho
79a0: 73 74 2d 70 6f 72 74 20 28 69 66 20 6b 69 6c 6c st-port (if kill
79b0: 69 6e 66 6f 20 28 69 66 20 28 73 75 62 73 74 72 info (if (substr
79c0: 69 6e 67 2d 69 6e 64 65 78 20 22 3a 22 20 6b 69 ing-index ":" ki
79d0: 6c 6c 69 6e 66 6f 29 28 73 74 72 69 6e 67 2d 73 llinfo)(string-s
79e0: 70 6c 69 74 20 22 3a 22 29 20 23 66 29 20 23 66 plit ":") #f) #f
79f0: 29 29 0a 09 09 20 28 73 69 64 20 20 20 20 20 20 ))... (sid
7a00: 20 20 28 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 (if killinfo (
7a10: 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e if (substring-in
7a20: 64 65 78 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f dex ":" killinfo
7a30: 29 20 23 66 20 28 73 74 72 69 6e 67 2d 3e 6e 75 ) #f (string->nu
7a40: 6d 62 65 72 20 6b 69 6c 6c 69 6e 66 6f 29 29 20 mber killinfo))
7a50: 23 66 29 29 29 0a 09 20 20 20 20 28 66 6f 72 6d #f))).. (form
7a60: 61 74 20 23 74 20 66 6d 74 73 74 72 20 22 49 64 at #t fmtstr "Id
7a70: 22 20 22 4d 54 76 65 72 22 20 22 50 69 64 22 20 " "MTver" "Pid"
7a80: 22 48 6f 73 74 22 20 22 49 6e 74 65 72 66 61 63 "Host" "Interfac
7a90: 65 3a 4f 75 74 50 6f 72 74 22 20 22 49 6e 50 6f e:OutPort" "InPo
7aa0: 72 74 22 20 22 4c 61 73 74 42 65 61 74 22 20 22 rt" "LastBeat" "
7ab0: 53 74 61 74 65 22 20 22 54 72 61 6e 73 70 6f 72 State" "Transpor
7ac0: 74 22 29 0a 09 20 20 20 20 28 66 6f 72 6d 61 74 t").. (format
7ad0: 20 23 74 20 66 6d 74 73 74 72 20 22 3d 3d 22 20 #t fmtstr "=="
7ae0: 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 20 22 3d "=====" "===" "=
7af0: 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ===" "==========
7b00: 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d =======" "======
7b10: 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d " "========" "==
7b20: 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 ===" "========="
7b30: 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 ).. (for-each
7b40: 20 0a 09 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
7b50: 28 73 65 72 76 65 72 29 0a 09 20 20 20 20 20 20 (server)..
7b60: 20 28 6c 65 74 2a 20 28 28 69 64 20 20 20 20 20 (let* ((id
7b70: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
7b80: 73 65 72 76 65 72 20 30 29 29 0a 09 09 20 20 20 server 0))...
7b90: 20 20 20 28 70 69 64 20 20 20 20 20 20 20 20 28 (pid (
7ba0: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
7bb0: 72 20 31 29 29 0a 09 09 20 20 20 20 20 20 28 68 r 1))... (h
7bc0: 6f 73 74 6e 61 6d 65 20 20 20 28 76 65 63 74 6f ostname (vecto
7bd0: 72 2d 72 65 66 20 73 65 72 76 65 72 20 32 29 29 r-ref server 2))
7be0: 0a 09 09 20 20 20 20 20 20 28 69 6e 74 65 72 66 ... (interf
7bf0: 61 63 65 20 20 28 76 65 63 74 6f 72 2d 72 65 66 ace (vector-ref
7c00: 20 73 65 72 76 65 72 20 33 29 29 20 0a 09 09 20 server 3)) ...
7c10: 20 20 20 20 20 28 70 75 6c 6c 70 6f 72 74 20 20 (pullport
7c20: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
7c30: 76 65 72 20 34 29 29 0a 09 09 20 20 20 20 20 20 ver 4))...
7c40: 28 70 75 62 70 6f 72 74 20 20 20 20 28 76 65 63 (pubport (vec
7c50: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 35 tor-ref server 5
7c60: 29 29 0a 09 09 20 20 20 20 20 20 28 73 74 61 72 ))... (star
7c70: 74 2d 74 69 6d 65 20 28 76 65 63 74 6f 72 2d 72 t-time (vector-r
7c80: 65 66 20 73 65 72 76 65 72 20 36 29 29 0a 09 09 ef server 6))...
7c90: 20 20 20 20 20 20 28 70 72 69 6f 72 69 74 79 20 (priority
7ca0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
7cb0: 72 76 65 72 20 37 29 29 0a 09 09 20 20 20 20 20 rver 7))...
7cc0: 20 28 73 74 61 74 65 20 20 20 20 20 20 28 76 65 (state (ve
7cd0: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
7ce0: 38 29 29 0a 09 09 20 20 20 20 20 20 28 6d 74 2d 8))... (mt-
7cf0: 76 65 72 20 20 20 20 20 28 76 65 63 74 6f 72 2d ver (vector-
7d00: 72 65 66 20 73 65 72 76 65 72 20 39 29 29 0a 09 ref server 9))..
7d10: 09 20 20 20 20 20 20 28 6c 61 73 74 2d 75 70 64 . (last-upd
7d20: 61 74 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ate (vector-ref
7d30: 73 65 72 76 65 72 20 31 30 29 29 20 0a 09 09 20 server 10)) ...
7d40: 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 (transport
7d50: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
7d60: 76 65 72 20 31 31 29 29 0a 09 09 20 20 20 20 20 ver 11))...
7d70: 20 28 6b 69 6c 6c 65 64 20 20 20 20 20 23 66 29 (killed #f)
7d80: 0a 09 09 20 20 20 20 20 20 28 73 74 61 74 75 73 ... (status
7d90: 20 20 20 20 20 28 3c 20 6c 61 73 74 2d 75 70 64 (< last-upd
7da0: 61 74 65 20 32 30 29 29 29 0a 09 09 20 3b 3b 20 ate 20)))... ;;
7db0: 20 20 28 7a 6d 71 2d 73 6f 63 6b 65 74 73 20 28 (zmq-sockets (
7dc0: 69 66 20 73 74 61 74 75 73 20 28 73 65 72 76 65 if status (serve
7dd0: 72 3a 63 6c 69 65 6e 74 2d 63 6f 6e 6e 65 63 74 r:client-connect
7de0: 20 68 6f 73 74 6e 61 6d 65 20 70 6f 72 74 29 20 hostname port)
7df0: 23 66 29 29 29 0a 09 09 20 3b 3b 20 6e 6f 20 6e #f)))... ;; no n
7e00: 65 65 64 20 74 6f 20 6c 6f 67 69 6e 20 61 73 20 eed to login as
7e10: 73 74 61 74 75 73 20 6f 66 20 23 74 20 69 6e 64 status of #t ind
7e20: 69 63 61 74 65 73 20 77 65 20 61 72 65 20 63 6f icates we are co
7e30: 6e 6e 65 63 74 69 6e 67 20 74 6f 20 63 6f 72 72 nnecting to corr
7e40: 65 63 74 20 0a 09 09 20 3b 3b 20 73 65 72 76 65 ect ... ;; serve
7e50: 72 0a 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f r... (if (equal?
7e60: 20 73 74 61 74 65 20 22 64 65 61 64 22 29 0a 09 state "dead")..
7e70: 09 20 20 20 20 20 28 69 66 20 28 3e 20 6c 61 73 . (if (> las
7e80: 74 2d 75 70 64 61 74 65 20 28 2a 20 32 35 20 36 t-update (* 25 6
7e90: 30 20 36 30 29 29 20 3b 3b 20 6b 65 65 70 20 72 0 60)) ;; keep r
7ea0: 65 63 6f 72 64 73 20 61 72 6f 75 6e 64 20 66 6f ecords around fo
7eb0: 72 20 73 6c 69 67 68 6c 79 20 6f 76 65 72 20 61 r slighly over a
7ec0: 20 64 61 79 2e 0a 09 09 09 20 28 74 61 73 6b 73 day..... (tasks
7ed0: 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 :server-deregist
7ee0: 65 72 20 28 64 62 3a 64 65 6c 61 79 2d 69 66 2d er (db:delay-if-
7ef0: 62 75 73 79 20 74 64 62 64 61 74 29 20 68 6f 73 busy tdbdat) hos
7f00: 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 74 3a 20 tname pullport:
7f10: 70 75 6c 6c 70 6f 72 74 20 70 69 64 3a 20 70 69 pullport pid: pi
7f20: 64 20 61 63 74 69 6f 6e 3a 20 27 64 65 6c 65 74 d action: 'delet
7f30: 65 29 29 0a 09 09 20 20 20 20 20 28 69 66 20 28 e))... (if (
7f40: 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 32 30 > last-update 20
7f50: 29 20 20 20 20 20 20 20 20 3b 3b 20 4d 61 72 6b ) ;; Mark
7f60: 20 61 73 20 64 65 61 64 20 69 66 20 6e 6f 74 20 as dead if not
7f70: 75 70 64 61 74 65 64 20 69 6e 20 6c 61 73 74 20 updated in last
7f80: 32 30 20 73 65 63 6f 6e 64 73 0a 09 09 09 20 28 20 seconds.... (
7f90: 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 tasks:server-der
7fa0: 65 67 69 73 74 65 72 20 28 64 62 3a 64 65 6c 61 egister (db:dela
7fb0: 79 2d 69 66 2d 62 75 73 79 20 74 64 62 64 61 74 y-if-busy tdbdat
7fc0: 29 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 ) hostname pullp
7fd0: 6f 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 70 69 ort: pullport pi
7fe0: 64 3a 20 70 69 64 29 29 29 0a 09 09 20 28 66 6f d: pid)))... (fo
7ff0: 72 6d 61 74 20 23 74 20 66 6d 74 73 74 72 20 69 rmat #t fmtstr i
8000: 64 20 6d 74 2d 76 65 72 20 70 69 64 20 68 6f 73 d mt-ver pid hos
8010: 74 6e 61 6d 65 20 28 63 6f 6e 63 20 69 6e 74 65 tname (conc inte
8020: 72 66 61 63 65 20 22 3a 22 20 70 75 6c 6c 70 6f rface ":" pullpo
8030: 72 74 29 20 70 75 62 70 6f 72 74 20 6c 61 73 74 rt) pubport last
8040: 2d 75 70 64 61 74 65 0a 09 09 09 20 28 69 66 20 -update.... (if
8050: 73 74 61 74 75 73 20 22 61 6c 69 76 65 22 20 22 status "alive" "
8060: 64 65 61 64 22 29 20 74 72 61 6e 73 70 6f 72 74 dead") transport
8070: 29 0a 09 09 20 28 69 66 20 28 6f 72 20 28 65 71 )... (if (or (eq
8080: 75 61 6c 3f 20 69 64 20 73 69 64 29 0a 09 09 09 ual? id sid)....
8090: 20 28 65 71 75 61 6c 3f 20 73 69 64 20 30 29 29 (equal? sid 0))
80a0: 20 3b 3b 20 6b 69 6c 6c 20 61 6c 6c 2f 61 6e 79 ;; kill all/any
80b0: 0a 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ... (begin..
80c0: 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
80d0: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
80e0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
80f0: 41 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 6b 69 Attempting to ki
8100: 6c 6c 20 22 6b 69 6c 6c 2d 73 77 69 74 63 68 22 ll "kill-switch"
8110: 20 73 65 72 76 65 72 20 77 69 74 68 20 70 69 64 server with pid
8120: 20 22 20 70 69 64 29 0a 09 09 20 20 20 20 20 20 " pid)...
8130: 20 28 74 61 73 6b 73 3a 6b 69 6c 6c 2d 73 65 72 (tasks:kill-ser
8140: 76 65 72 20 68 6f 73 74 6e 61 6d 65 20 70 69 64 ver hostname pid
8150: 20 6b 69 6c 6c 2d 73 77 69 74 63 68 3a 20 6b 69 kill-switch: ki
8160: 6c 6c 2d 73 77 69 74 63 68 29 29 29 29 29 0a 09 ll-switch)))))..
8170: 20 20 20 20 20 73 65 72 76 65 72 73 29 0a 09 20 servers)..
8180: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
8190: 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d info 1 *default-
81a0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 44 6f 6e 65 20 log-port* "Done
81b0: 77 69 74 68 20 6c 69 73 74 73 65 72 76 65 72 73 with listservers
81c0: 22 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 ").. (set! *d
81d0: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
81e0: 0a 09 20 20 20 20 28 65 78 69 74 29 29 20 3b 3b .. (exit)) ;;
81f0: 20 6d 75 73 74 20 64 6f 2c 20 77 6f 75 6c 64 20 must do, would
8200: 68 61 76 65 20 74 6f 20 61 64 64 20 63 68 65 63 have to add chec
8210: 6b 73 20 74 6f 20 6d 61 6e 79 2f 61 6c 6c 20 63 ks to many/all c
8220: 61 6c 6c 73 20 62 65 6c 6f 77 0a 09 20 20 28 65 alls below.. (e
8230: 78 69 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d xit))))..;;=====
8240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8280: 3d 0a 3b 3b 20 57 65 69 72 64 20 73 70 65 63 69 =.;; Weird speci
8290: 61 6c 20 63 61 6c 6c 73 20 74 68 61 74 20 6e 65 al calls that ne
82a0: 65 64 20 74 6f 20 72 75 6e 20 2a 61 66 74 65 72 ed to run *after
82b0: 2a 20 74 68 65 20 73 65 72 76 65 72 20 68 61 73 * the server has
82c0: 20 73 74 61 72 74 65 64 3f 0a 3b 3b 3d 3d 3d 3d started?.;;====
82d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8310: 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ==..(if (args:ge
8320: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 74 61 72 t-arg "-list-tar
8330: 67 65 74 73 22 29 0a 20 20 20 20 28 69 66 20 28 gets"). (if (
8340: 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 0a 20 20 launch:setup).
8350: 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 61 72 (let ((tar
8360: 67 65 74 73 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 gets (common:get
8370: 2d 72 75 6e 63 6f 6e 66 69 67 2d 74 61 72 67 65 -runconfig-targe
8380: 74 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ts))).
8390: 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ;; (debug:print
83a0: 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 1 *default-log-p
83b0: 6f 72 74 2a 20 22 46 6f 75 6e 64 20 22 28 6c 65 ort* "Found "(le
83c0: 6e 67 74 68 20 74 61 72 67 65 74 73 29 20 22 20 ngth targets) "
83d0: 74 61 72 67 65 74 73 22 29 0a 20 20 20 20 20 20 targets").
83e0: 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e (case (strin
83f0: 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 20 28 61 g->symbol (or (a
8400: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
8410: 6d 70 6d 6f 64 65 22 29 20 22 61 6c 69 73 74 22 mpmode") "alist"
8420: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
8430: 28 61 6c 69 73 74 29 0a 20 20 20 20 20 20 20 20 (alist).
8440: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 (for-each (
8450: 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 20 20 lambda (x).
8460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8470: 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 5b ;; (print "[
8480: 22 20 78 20 22 5d 22 29 29 0a 20 20 20 20 20 20 " x "]")).
8490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
84a0: 20 20 20 28 70 72 69 6e 74 20 78 29 29 0a 20 20 (print x)).
84b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
84c0: 20 20 20 20 20 74 61 72 67 65 74 73 29 29 0a 20 targets)).
84d0: 20 20 20 20 20 20 20 20 20 20 20 28 28 6a 73 6f ((jso
84e0: 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n).
84f0: 28 6a 73 6f 6e 2d 77 72 69 74 65 20 74 61 72 67 (json-write targ
8500: 65 74 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ets)).
8510: 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
8520: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
8530: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
8540: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 64 75 lt-log-port* "du
8550: 6d 70 20 6f 75 74 70 75 74 20 66 6f 72 6d 61 74 mp output format
8560: 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 " (args:get-arg
8570: 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 "-dumpmode") "
8580: 6e 6f 74 20 73 75 70 70 6f 72 74 65 64 20 66 6f not supported fo
8590: 72 20 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 22 r -list-targets"
85a0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 ))). (s
85b0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
85c0: 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 20 63 61 g* #t))))..;; ca
85d0: 63 68 65 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 che the runconfi
85e0: 67 73 20 69 6e 20 24 4d 54 5f 4c 49 4e 4b 54 52 gs in $MT_LINKTR
85f0: 45 45 2f 24 4d 54 5f 54 41 52 47 45 54 2f 24 4d EE/$MT_TARGET/$M
8600: 54 5f 52 55 4e 4e 41 4d 45 2f 2e 72 75 6e 63 6f T_RUNNAME/.runco
8610: 6e 66 69 67 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 nfig.;;.(define
8620: 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e 66 69 67 73 (full-runconfigs
8630: 2d 72 65 61 64 29 0a 3b 3b 20 69 6e 20 74 68 65 -read).;; in the
8640: 20 65 6e 76 70 72 6f 63 65 73 73 69 6e 67 20 62 envprocessing b
8650: 72 61 6e 63 68 20 74 68 65 20 62 65 6c 6f 77 20 ranch the below
8660: 63 6f 64 65 20 72 65 70 6c 61 63 65 73 20 74 68 code replaces th
8670: 65 20 66 75 72 74 68 65 72 20 62 65 6c 6f 77 20 e further below
8680: 63 6f 64 65 0a 3b 3b 20 20 28 69 66 20 28 65 71 code.;; (if (eq
8690: 3f 20 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 2a ? *configstatus*
86a0: 20 27 66 75 6c 6c 64 61 74 61 29 0a 3b 3b 20 20 'fulldata).;;
86b0: 20 20 20 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 *runconfigda
86c0: 74 2a 0a 3b 3b 20 20 20 20 20 20 28 62 65 67 69 t*.;; (begi
86d0: 6e 0a 3b 3b 09 28 6c 61 75 6e 63 68 3a 73 65 74 n.;;.(launch:set
86e0: 75 70 29 0a 3b 3b 09 2a 72 75 6e 63 6f 6e 66 69 up).;;.*runconfi
86f0: 67 64 61 74 2a 29 29 29 0a 0a 20 20 28 6c 65 74 gdat*))).. (let
8700: 2a 20 28 28 72 75 6e 64 69 72 20 28 69 66 20 28 * ((rundir (if (
8710: 61 6e 64 20 28 67 65 74 65 6e 76 20 22 4d 54 5f and (getenv "MT_
8720: 4c 49 4e 4b 54 52 45 45 22 29 28 67 65 74 65 6e LINKTREE")(geten
8730: 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 28 67 v "MT_TARGET")(g
8740: 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d etenv "MT_RUNNAM
8750: 45 22 29 29 0a 09 09 20 20 20 20 20 28 63 6f 6e E"))... (con
8760: 63 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 4c 49 c (getenv "MT_LI
8770: 4e 4b 54 52 45 45 22 29 20 22 2f 22 20 28 67 65 NKTREE") "/" (ge
8780: 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 tenv "MT_TARGET"
8790: 29 20 22 2f 22 20 28 67 65 74 65 6e 76 20 22 4d ) "/" (getenv "M
87a0: 54 5f 52 55 4e 4e 41 4d 45 22 29 29 0a 09 09 20 T_RUNNAME"))...
87b0: 20 20 20 20 23 66 29 29 0a 09 20 28 63 66 67 66 #f)).. (cfgf
87c0: 20 20 20 28 69 66 20 72 75 6e 64 69 72 20 28 63 (if rundir (c
87d0: 6f 6e 63 20 72 75 6e 64 69 72 20 22 2f 2e 72 75 onc rundir "/.ru
87e0: 6e 63 6f 6e 66 69 67 2e 22 20 6d 65 67 61 74 65 nconfig." megate
87f0: 73 74 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d st-version "-" m
8800: 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 egatest-fossil-h
8810: 61 73 68 29 20 23 66 29 29 29 0a 20 20 20 20 28 ash) #f))). (
8820: 69 66 20 28 61 6e 64 20 63 66 67 66 0a 09 20 20 if (and cfgf..
8830: 20 20 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f (file-exists?
8840: 20 63 66 67 66 29 0a 09 20 20 20 20 20 28 66 69 cfgf).. (fi
8850: 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f le-write-access?
8860: 20 63 66 67 66 29 29 0a 09 28 63 6f 6e 66 69 67 cfgf))..(config
8870: 66 3a 72 65 61 64 2d 61 6c 69 73 74 20 63 66 67 f:read-alist cfg
8880: 66 29 0a 09 28 6c 65 74 2a 20 28 28 6b 65 79 73 f)..(let* ((keys
8890: 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 (rmt:get-keys
88a0: 29 29 0a 09 20 20 20 20 20 20 20 28 74 61 72 67 )).. (targ
88b0: 65 74 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d et (common:args-
88c0: 67 65 74 2d 74 61 72 67 65 74 29 29 0a 09 20 20 get-target))..
88d0: 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 28 (key-vals (
88e0: 69 66 20 74 61 72 67 65 74 20 28 6b 65 79 73 3a if target (keys:
88f0: 74 61 72 67 65 74 2d 3e 6b 65 79 76 61 6c 20 6b target->keyval k
8900: 65 79 73 20 74 61 72 67 65 74 29 20 23 66 29 29 eys target) #f))
8910: 0a 09 20 20 20 20 20 20 20 28 73 65 63 74 69 6f .. (sectio
8920: 6e 73 20 28 69 66 20 74 61 72 67 65 74 20 28 6c ns (if target (l
8930: 69 73 74 20 22 64 65 66 61 75 6c 74 22 20 74 61 ist "default" ta
8940: 72 67 65 74 29 20 23 66 29 29 0a 09 20 20 20 20 rget) #f))..
8950: 20 20 20 28 64 61 74 61 20 20 20 20 20 28 62 65 (data (be
8960: 67 69 6e 0a 09 09 09 20 20 20 28 73 65 74 65 6e gin.... (seten
8970: 76 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 v "MT_RUN_AREA_H
8980: 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a OME" *toppath*).
8990: 09 09 09 20 20 20 28 69 66 20 6b 65 79 2d 76 61 ... (if key-va
89a0: 6c 73 0a 09 09 09 20 20 20 20 20 20 20 28 66 6f ls.... (fo
89b0: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
89c0: 6b 74 29 0a 09 09 09 09 09 20 20 20 28 73 65 74 kt)...... (set
89d0: 65 6e 76 20 28 63 61 72 20 6b 74 29 20 28 63 61 env (car kt) (ca
89e0: 64 72 20 6b 74 29 29 29 0a 09 09 09 09 09 20 6b dr kt)))...... k
89f0: 65 79 2d 76 61 6c 73 29 29 0a 09 09 09 20 20 20 ey-vals))....
8a00: 3b 3b 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 ;; (read-config
8a10: 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 (conc *toppath*
8a20: 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e "/runconfigs.con
8a30: 66 69 67 22 29 20 23 66 20 23 74 20 73 65 63 74 fig") #f #t sect
8a40: 69 6f 6e 73 3a 20 73 65 63 74 69 6f 6e 73 29 29 ions: sections))
8a50: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
8a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
8a70: 75 6e 63 6f 6e 66 69 67 3a 72 65 61 64 20 28 63 unconfig:read (c
8a80: 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f onc *toppath* "/
8a90: 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 runconfigs.confi
8aa0: 67 22 29 20 74 61 72 67 65 74 20 23 66 29 29 29 g") target #f)))
8ab0: 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 72 75 ).. (if (and ru
8ac0: 6e 64 69 72 20 3b 3b 20 68 61 76 65 20 61 6c 6c ndir ;; have all
8ad0: 20 6e 65 65 64 65 64 20 76 61 72 69 61 62 6c 65 needed variable
8ae0: 73 73 0a 09 09 20 20 20 28 64 69 72 65 63 74 6f ss... (directo
8af0: 72 79 2d 65 78 69 73 74 73 3f 20 72 75 6e 64 69 ry-exists? rundi
8b00: 72 29 0a 09 09 20 20 20 28 66 69 6c 65 2d 77 72 r)... (file-wr
8b10: 69 74 65 2d 61 63 63 65 73 73 3f 20 72 75 6e 64 ite-access? rund
8b20: 69 72 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 ir)).. (beg
8b30: 69 6e 0a 09 09 28 63 6f 6e 66 69 67 66 3a 77 72 in...(configf:wr
8b40: 69 74 65 2d 61 6c 69 73 74 20 64 61 74 61 20 63 ite-alist data c
8b50: 66 67 66 29 0a 09 09 3b 3b 20 66 6f 72 63 65 20 fgf)...;; force
8b60: 72 65 2d 72 65 61 64 20 6f 66 20 6d 65 67 61 74 re-read of megat
8b70: 65 73 74 2e 63 6f 6e 66 69 67 20 2d 20 74 68 69 est.config - thi
8b80: 73 20 72 65 73 6f 6c 76 65 73 20 63 69 72 63 75 s resolves circu
8b90: 6c 61 72 20 72 65 66 65 72 65 6e 63 65 73 20 62 lar references b
8ba0: 65 74 77 65 65 6e 20 6d 65 67 61 74 65 73 74 2e etween megatest.
8bb0: 63 6f 6e 66 69 67 0a 09 09 28 6c 61 75 6e 63 68 config...(launch
8bc0: 3a 73 65 74 75 70 20 66 6f 72 63 65 3a 20 23 74 :setup force: #t
8bd0: 29 0a 09 09 28 6c 61 75 6e 63 68 3a 63 61 63 68 )...(launch:cach
8be0: 65 2d 63 6f 6e 66 69 67 29 29 29 20 3b 3b 20 77 e-config))) ;; w
8bf0: 65 20 63 61 6e 20 73 61 66 65 6c 79 20 63 61 63 e can safely cac
8c00: 68 65 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 he megatest.conf
8c10: 69 67 20 73 69 6e 63 65 20 77 65 20 68 61 76 65 ig since we have
8c20: 20 61 20 76 61 6c 69 64 20 72 75 6e 63 6f 6e 66 a valid runconf
8c30: 69 67 0a 09 20 20 64 61 74 61 29 29 29 29 0a 0a ig.. data))))..
8c40: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
8c50: 67 20 22 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 g "-show-runconf
8c60: 69 67 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 ig"). (let ((
8c70: 74 6c 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 tl (launch:setup
8c80: 29 29 29 0a 20 20 20 20 20 20 28 70 75 73 68 2d ))). (push-
8c90: 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 directory *toppa
8ca0: 74 68 2a 29 0a 20 20 20 20 20 20 28 6c 65 74 20 th*). (let
8cb0: 28 28 64 61 74 61 20 28 66 75 6c 6c 2d 72 75 6e ((data (full-run
8cc0: 63 6f 6e 66 69 67 73 2d 72 65 61 64 29 29 29 0a configs-read))).
8cd0: 09 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e .;; keep this on
8ce0: 65 20 6c 6f 63 61 6c 0a 09 28 63 6f 6e 64 0a 09 e local..(cond..
8cf0: 20 28 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 ((and (args:get
8d00: 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 -arg "-section")
8d10: 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 .. (args:g
8d20: 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 0a et-arg "-var")).
8d30: 09 20 20 28 6c 65 74 20 28 28 76 61 6c 20 28 6f . (let ((val (o
8d40: 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 r (configf:looku
8d50: 70 20 64 61 74 61 20 28 61 72 67 73 3a 67 65 74 p data (args:get
8d60: 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 -arg "-section")
8d70: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8d80: 76 61 72 22 29 29 0a 09 09 09 20 28 63 6f 6e 66 var")).... (conf
8d90: 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 61 20 igf:lookup data
8da0: 22 64 65 66 61 75 6c 74 22 20 28 61 72 67 73 3a "default" (args:
8db0: 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 get-arg "-var"))
8dc0: 29 29 29 0a 09 20 20 20 20 28 69 66 20 76 61 6c ))).. (if val
8dd0: 20 28 70 72 69 6e 74 20 76 61 6c 29 29 29 29 0a (print val)))).
8de0: 09 20 28 28 6f 72 20 28 6e 6f 74 20 28 61 72 67 . ((or (not (arg
8df0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
8e00: 6d 6f 64 65 22 29 29 0a 20 20 20 20 20 20 20 20 mode")).
8e10: 20 20 20 20 20 20 28 73 74 72 69 6e 67 3d 3f 20 (string=?
8e20: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8e30: 64 75 6d 70 6d 6f 64 65 22 29 20 22 69 6e 69 22 dumpmode") "ini"
8e40: 29 29 0a 09 20 20 28 63 6f 6e 66 69 67 66 3a 63 )).. (configf:c
8e50: 6f 6e 66 69 67 2d 3e 69 6e 69 20 64 61 74 61 29 onfig->ini data)
8e60: 29 0a 09 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 ).. ((string=? (
8e70: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
8e80: 75 6d 70 6d 6f 64 65 22 29 20 22 73 65 78 70 22 umpmode") "sexp"
8e90: 29 0a 09 20 20 28 70 70 20 28 68 61 73 68 2d 74 ).. (pp (hash-t
8ea0: 61 62 6c 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 able->alist data
8eb0: 29 29 29 0a 09 20 28 28 73 74 72 69 6e 67 3d 3f ))).. ((string=?
8ec0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8ed0: 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f -dumpmode") "jso
8ee0: 6e 22 29 0a 09 20 20 28 6a 73 6f 6e 2d 77 72 69 n").. (json-wri
8ef0: 74 65 20 64 61 74 61 29 29 0a 09 20 28 65 6c 73 te data)).. (els
8f00: 65 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e e.. (debug:prin
8f10: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
8f20: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 64 lt-log-port* "-d
8f30: 75 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 61 72 umpmode of " (ar
8f40: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d gs:get-arg "-dum
8f50: 70 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 72 65 pmode") " not re
8f60: 63 6f 67 6e 69 73 65 64 22 29 29 29 0a 09 28 73 cognised")))..(s
8f70: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
8f80: 67 2a 20 23 74 29 29 0a 20 20 20 20 20 20 28 70 g* #t)). (p
8f90: 6f 70 2d 64 69 72 65 63 74 6f 72 79 29 29 29 0a op-directory))).
8fa0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
8fb0: 72 67 20 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 rg "-show-config
8fc0: 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c "). (let ((tl
8fd0: 20 20 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 (launch:setup
8fe0: 29 29 0a 09 20 20 28 64 61 74 61 20 2a 63 6f 6e )).. (data *con
8ff0: 66 69 67 64 61 74 2a 29 29 20 3b 3b 20 28 72 65 figdat*)) ;; (re
9000: 61 64 2d 63 6f 6e 66 69 67 20 22 6d 65 67 61 74 ad-config "megat
9010: 65 73 74 2e 63 6f 6e 66 69 67 22 20 23 66 20 23 est.config" #f #
9020: 74 29 29 29 0a 20 20 20 20 20 20 28 70 75 73 68 t))). (push
9030: 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 -directory *topp
9040: 61 74 68 2a 29 0a 20 20 20 20 20 20 3b 3b 20 6b ath*). ;; k
9050: 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 eep this one loc
9060: 61 6c 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 0a al. (cond .
9070: 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 61 72 ((and (ar
9080: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 63 gs:get-arg "-sec
9090: 74 69 6f 6e 22 29 0a 09 20 20 20 20 20 28 61 72 tion").. (ar
90a0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 gs:get-arg "-var
90b0: 22 29 29 0a 09 28 6c 65 74 20 28 28 76 61 6c 20 "))..(let ((val
90c0: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
90d0: 64 61 74 61 20 28 61 72 67 73 3a 67 65 74 2d 61 data (args:get-a
90e0: 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 28 61 rg "-section")(a
90f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 rgs:get-arg "-va
9100: 72 22 29 29 29 29 0a 09 20 20 28 69 66 20 76 61 r")))).. (if va
9110: 6c 20 28 70 72 69 6e 74 20 76 61 6c 29 29 29 29 l (print val))))
9120: 0a 0a 20 20 20 20 20 20 20 3b 3b 20 70 72 69 6e .. ;; prin
9130: 74 20 6a 75 73 74 20 61 20 73 65 63 74 69 6f 6e t just a section
9140: 20 69 66 20 6f 6e 6c 79 20 2d 73 65 63 74 69 6f if only -sectio
9150: 6e 0a 0a 20 20 20 20 20 20 20 28 28 6e 6f 74 20 n.. ((not
9160: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
9170: 64 75 6d 70 6d 6f 64 65 22 29 29 0a 09 28 70 70 dumpmode"))..(pp
9180: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c (hash-table->al
9190: 69 73 74 20 64 61 74 61 29 29 29 0a 20 20 20 20 ist data))).
91a0: 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 ((string=? (a
91b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
91c0: 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 29 mpmode") "json")
91d0: 0a 09 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 ..(json-write da
91e0: 74 61 29 29 0a 20 20 20 20 20 20 20 28 28 73 74 ta)). ((st
91f0: 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 ring=? (args:get
9200: 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 -arg "-dumpmode"
9210: 29 20 22 69 6e 69 22 29 0a 09 28 63 6f 6e 66 69 ) "ini")..(confi
9220: 67 66 3a 63 6f 6e 66 69 67 2d 3e 69 6e 69 20 64 gf:config->ini d
9230: 61 74 61 29 29 0a 20 20 20 20 20 20 20 28 65 6c ata)). (el
9240: 73 65 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 se..(debug:print
9250: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
9260: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 64 75 t-log-port* "-du
9270: 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 61 72 67 mpmode of " (arg
9280: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
9290: 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 72 65 63 mode") " not rec
92a0: 6f 67 6e 69 73 65 64 22 29 29 29 0a 20 20 20 20 ognised"))).
92b0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
92c0: 74 68 69 6e 67 2a 20 23 74 29 0a 20 20 20 20 20 thing* #t).
92d0: 20 28 70 6f 70 2d 64 69 72 65 63 74 6f 72 79 29 (pop-directory)
92e0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 74 69 . (set! *ti
92f0: 6d 65 2d 74 6f 2d 65 78 69 74 2a 20 23 74 29 29 me-to-exit* #t))
9300: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
9310: 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 6d 64 69 -arg "-show-cmdi
9320: 6e 66 6f 22 29 0a 20 20 20 20 28 69 66 20 28 6f nfo"). (if (o
9330: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
9340: 22 3a 76 61 6c 75 65 22 29 28 67 65 74 65 6e 76 ":value")(getenv
9350: 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a "MT_CMDINFO")).
9360: 09 28 6c 65 74 20 28 28 64 61 74 61 20 28 63 6f .(let ((data (co
9370: 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 mmon:read-encode
9380: 64 2d 73 74 72 69 6e 67 20 28 6f 72 20 28 61 72 d-string (or (ar
9390: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 76 61 6c gs:get-arg ":val
93a0: 75 65 22 29 28 67 65 74 65 6e 76 20 22 4d 54 5f ue")(getenv "MT_
93b0: 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 CMDINFO")))))..
93c0: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 61 72 (if (equal? (ar
93d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d gs:get-arg "-dum
93e0: 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 29 0a pmode") "json").
93f0: 09 20 20 20 20 20 20 28 6a 73 6f 6e 2d 77 72 69 . (json-wri
9400: 74 65 20 64 61 74 61 29 0a 09 20 20 20 20 20 20 te data)..
9410: 28 70 70 20 64 61 74 61 29 29 0a 09 20 20 28 73 (pp data)).. (s
9420: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
9430: 67 2a 20 23 74 29 29 0a 09 28 64 65 62 75 67 3a g* #t))..(debug:
9440: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
9450: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
9460: 22 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 "environment var
9470: 69 61 62 6c 65 20 4d 54 5f 43 4d 44 49 4e 46 4f iable MT_CMDINFO
9480: 20 69 73 20 6e 6f 74 20 73 65 74 22 29 29 29 0a is not set"))).
9490: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
94a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
94b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
94c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
94d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 65 6d =========.;; Rem
94e0: 6f 76 65 20 6f 6c 64 20 72 75 6e 28 73 29 0a 3b ove old run(s).;
94f0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
9500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9530: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 69 6e 63 =======..;; sinc
9540: 65 20 73 65 76 65 72 61 6c 20 61 63 74 69 6f 6e e several action
9550: 73 20 63 61 6e 20 62 65 20 73 70 65 63 69 66 69 s can be specifi
9560: 65 64 20 6f 6e 20 74 68 65 20 63 6f 6d 6d 61 6e ed on the comman
9570: 64 20 6c 69 6e 65 20 74 68 65 20 72 65 6d 6f 76 d line the remov
9580: 61 6c 0a 3b 3b 20 69 73 20 64 6f 6e 65 20 66 69 al.;; is done fi
9590: 72 73 74 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 rst.(define (ope
95a0: 72 61 74 65 2d 6f 6e 20 61 63 74 69 6f 6e 29 0a rate-on action).
95b0: 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 72 65 63 (let* ((runrec
95c0: 20 28 72 75 6e 73 3a 72 75 6e 72 65 63 2d 6d 61 (runs:runrec-ma
95d0: 6b 65 2d 72 65 63 6f 72 64 29 29 0a 09 20 28 74 ke-record)).. (t
95e0: 61 72 67 65 74 20 28 63 6f 6d 6d 6f 6e 3a 61 72 arget (common:ar
95f0: 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 29 29 gs-get-target)))
9600: 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 . (cond.
9610: 28 28 6e 6f 74 20 74 61 72 67 65 74 29 0a 20 20 ((not target).
9620: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
9630: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
9640: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 73 t-log-port* "Mis
9650: 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 sing required pa
9660: 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 rameter for " ac
9670: 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 tion ", you must
9680: 20 73 70 65 63 69 66 79 20 2d 74 61 72 67 65 74 specify -target
9690: 20 6f 72 20 2d 72 65 71 74 61 72 67 22 29 0a 20 or -reqtarg").
96a0: 20 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 20 (exit 1)).
96b0: 20 20 20 20 28 28 6e 6f 74 20 28 6f 72 20 28 61 ((not (or (a
96c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 rgs:get-arg ":ru
96d0: 6e 6e 61 6d 65 22 29 0a 09 20 20 20 20 20 20 20 nname")..
96e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
96f0: 72 75 6e 6e 61 6d 65 22 29 29 29 0a 20 20 20 20 runname"))).
9700: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
9710: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
9720: 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 69 log-port* "Missi
9730: 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 ng required para
9740: 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 meter for " acti
9750: 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 on ", you must s
9760: 70 65 63 69 66 79 20 74 68 65 20 72 75 6e 20 6e pecify the run n
9770: 61 6d 65 20 70 61 74 74 65 72 6e 20 77 69 74 68 ame pattern with
9780: 20 2d 72 75 6e 6e 61 6d 65 20 70 61 74 74 22 29 -runname patt")
9790: 0a 20 20 20 20 20 20 28 65 78 69 74 20 32 29 29 . (exit 2))
97a0: 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 61 72 67 . ((not (arg
97b0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
97c0: 70 61 74 74 22 29 29 0a 20 20 20 20 20 20 28 64 patt")). (d
97d0: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
97e0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
97f0: 70 6f 72 74 2a 20 22 4d 69 73 73 69 6e 67 20 72 port* "Missing r
9800: 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 74 65 equired paramete
9810: 72 20 66 6f 72 20 22 20 61 63 74 69 6f 6e 20 22 r for " action "
9820: 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 69 , you must speci
9830: 66 79 20 74 68 65 20 74 65 73 74 20 70 61 74 74 fy the test patt
9840: 65 72 6e 20 77 69 74 68 20 2d 74 65 73 74 70 61 ern with -testpa
9850: 74 74 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 tt"). (exit
9860: 20 33 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 3)). (else.
9870: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
9880: 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a car *configinfo*
9890: 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 )).. (begin..
98a0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
98b0: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
98c0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 41 74 74 65 6d log-port* "Attem
98d0: 70 74 65 64 20 22 20 61 63 74 69 6f 6e 20 22 6f pted " action "o
98e0: 6e 20 74 65 73 74 28 73 29 20 62 75 74 20 72 75 n test(s) but ru
98f0: 6e 20 61 72 65 61 20 63 6f 6e 66 69 67 20 66 69 n area config fi
9900: 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 09 le not found")..
9910: 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 09 20 (exit 1))..
9920: 20 3b 3b 20 70 75 74 20 74 65 73 74 20 70 61 72 ;; put test par
9930: 61 6d 65 74 65 72 73 20 69 6e 74 6f 20 63 6f 6e ameters into con
9940: 76 65 6e 69 65 6e 74 20 76 61 72 69 61 62 6c 65 venient variable
9950: 73 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 s.. (begin..
9960: 20 3b 3b 20 63 68 65 63 6b 20 66 6f 72 20 63 6f ;; check for co
9970: 72 72 65 63 74 20 76 65 72 73 69 6f 6e 2c 20 65 rrect version, e
9980: 78 69 74 20 77 69 74 68 20 6d 65 73 73 61 67 65 xit with message
9990: 20 69 66 20 6e 6f 74 20 63 6f 72 72 65 63 74 0a if not correct.
99a0: 09 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 65 78 69 . (common:exi
99b0: 74 2d 6f 6e 2d 76 65 72 73 69 6f 6e 2d 63 68 61 t-on-version-cha
99c0: 6e 67 65 64 29 0a 09 20 20 20 20 28 72 75 6e 73 nged).. (runs
99d0: 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 20 61 63 74 :operate-on act
99e0: 69 6f 6e 0a 09 09 09 20 20 20 20 20 20 74 61 72 ion.... tar
99f0: 67 65 74 0a 09 09 09 20 20 20 20 20 20 28 63 6f get.... (co
9a00: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 mmon:args-get-ru
9a10: 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 nname) ;; (or (
9a20: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
9a30: 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 unname")(args:ge
9a40: 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 t-arg ":runname"
9a50: 29 29 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d )).... (com
9a60: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 mon:args-get-tes
9a70: 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 tpatt #f) ;; (ar
9a80: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
9a90: 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 tpatt")....
9aa0: 20 73 74 61 74 65 3a 20 28 63 6f 6d 6d 6f 6e 3a state: (common:
9ab0: 61 72 67 73 2d 67 65 74 2d 73 74 61 74 65 29 0a args-get-state).
9ac0: 09 09 09 20 20 20 20 20 20 73 74 61 74 75 73 3a ... status:
9ad0: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
9ae0: 74 2d 73 74 61 74 75 73 29 0a 09 09 09 20 20 20 t-status)....
9af0: 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 new-state-sta
9b00: 74 75 73 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 tus: (args:get-a
9b10: 72 67 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 rg "-set-state-s
9b20: 74 61 74 75 73 22 29 29 29 29 0a 20 20 20 20 20 tatus")))).
9b30: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
9b40: 68 69 6e 67 2a 20 23 74 29 29 29 29 29 0a 0a 28 hing* #t)))))..(
9b50: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
9b60: 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 "-remove-runs")
9b70: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
9b80: 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 n-call . "-r
9b90: 65 6d 6f 76 65 2d 72 75 6e 73 22 0a 20 20 20 20 emove-runs".
9ba0: 20 22 72 65 6d 6f 76 65 20 72 75 6e 73 22 0a 20 "remove runs".
9bb0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
9bc0: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
9bd0: 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 keyvals).
9be0: 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 72 65 (operate-on 're
9bf0: 6d 6f 76 65 2d 72 75 6e 73 29 29 29 29 0a 0a 28 move-runs))))..(
9c00: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
9c10: 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 "-set-state-sta
9c20: 74 75 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 tus"). (gener
9c30: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 al-run-call .
9c40: 20 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 "-set-state-st
9c50: 61 74 75 73 22 0a 20 20 20 20 20 22 73 65 74 20 atus". "set
9c60: 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 73 state and status
9c70: 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ". (lambda (
9c80: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
9c90: 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 eys keyvals).
9ca0: 20 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 (operate-on
9cb0: 27 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 'set-state-statu
9cc0: 73 29 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 s))))..(if (or (
9cd0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
9ce0: 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 29 0a et-run-status").
9cf0: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
9d00: 2d 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 -get-run-status"
9d10: 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d )). (general-
9d20: 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 20 22 2d run-call. "-
9d30: 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 0a set-run-status".
9d40: 20 20 20 20 20 22 73 65 74 20 72 75 6e 20 73 74 "set run st
9d50: 61 74 75 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 atus". (lamb
9d60: 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 da (target runna
9d70: 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 me keys keyvals)
9d80: 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 . (let* ((
9d90: 72 75 6e 73 64 61 74 20 20 28 72 6d 74 3a 67 65 runsdat (rmt:ge
9da0: 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 6b t-runs-by-patt k
9db0: 65 79 73 20 72 75 6e 6e 61 6d 65 20 0a 09 09 09 eys runname ....
9dc0: 09 09 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 ..(common:args-g
9dd0: 65 74 2d 74 61 72 67 65 74 29 0a 09 09 09 09 09 et-target)......
9de0: 23 66 20 23 66 20 23 66 20 23 66 29 29 0a 09 20 #f #f #f #f))..
9df0: 20 20 20 20 20 28 68 65 61 64 65 72 20 20 20 28 (header (
9e00: 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 64 vector-ref runsd
9e10: 61 74 20 30 29 29 0a 09 20 20 20 20 20 20 28 72 at 0)).. (r
9e20: 6f 77 73 20 20 20 20 20 28 76 65 63 74 6f 72 2d ows (vector-
9e30: 72 65 66 20 72 75 6e 73 64 61 74 20 31 29 29 29 ref runsdat 1)))
9e40: 0a 09 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 6f .. (if (null? ro
9e50: 77 73 29 0a 09 20 20 20 20 20 28 62 65 67 69 6e ws).. (begin
9e60: 0a 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a .. (debug:
9e70: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
9e80: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
9e90: 22 4e 6f 20 6d 61 74 63 68 69 6e 67 20 72 75 6e "No matching run
9ea0: 20 66 6f 75 6e 64 2e 22 29 0a 09 20 20 20 20 20 found.")..
9eb0: 20 20 28 65 78 69 74 20 31 29 29 0a 09 20 20 20 (exit 1))..
9ec0: 20 20 28 6c 65 74 2a 20 28 28 72 6f 77 20 20 20 (let* ((row
9ed0: 20 20 20 28 63 61 72 20 28 76 65 63 74 6f 72 2d (car (vector-
9ee0: 72 65 66 20 72 75 6e 73 64 61 74 20 31 29 29 29 ref runsdat 1)))
9ef0: 0a 09 09 20 20 20 20 28 72 75 6e 2d 69 64 20 20 ... (run-id
9f00: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
9f10: 79 2d 68 65 61 64 65 72 20 72 6f 77 20 68 65 61 y-header row hea
9f20: 64 65 72 20 22 69 64 22 29 29 29 0a 09 20 20 20 der "id")))..
9f30: 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 (if (args:ge
9f40: 74 2d 61 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d t-arg "-set-run-
9f50: 73 74 61 74 75 73 22 29 0a 09 09 20 20 20 28 72 status")... (r
9f60: 6d 74 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 mt:set-run-statu
9f70: 73 20 72 75 6e 2d 69 64 20 28 61 72 67 73 3a 67 s run-id (args:g
9f80: 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 72 75 6e et-arg "-set-run
9f90: 2d 73 74 61 74 75 73 22 29 20 6d 73 67 3a 20 28 -status") msg: (
9fa0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
9fb0: 22 29 29 0a 09 09 20 20 20 28 70 72 69 6e 74 20 "))... (print
9fc0: 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 74 61 (rmt:get-run-sta
9fd0: 74 75 73 20 72 75 6e 2d 69 64 29 29 0a 09 09 20 tus run-id))...
9fe0: 20 20 29 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d )))))))..;;===
9ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a030: 3d 3d 3d 0a 3b 3b 20 51 75 65 72 79 20 72 75 6e ===.;; Query run
a040: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
a050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 2d ==========..;; -
a090: 66 69 65 6c 64 73 20 72 75 6e 73 3a 69 64 2c 74 fields runs:id,t
a0a0: 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 2c 63 6f arget,runname,co
a0b0: 6d 6d 65 6e 74 2b 74 65 73 74 73 3a 69 64 2c 74 mment+tests:id,t
a0c0: 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 61 74 estname,item_pat
a0d0: 68 2b 73 74 65 70 73 0a 3b 3b 0a 3b 3b 20 63 73 h+steps.;;.;; cs
a0e0: 69 3e 20 28 65 78 74 72 61 63 74 2d 66 69 65 6c i> (extract-fiel
a0f0: 64 73 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 22 ds-constraints "
a100: 72 75 6e 73 3a 69 64 2c 74 61 72 67 65 74 2c 72 runs:id,target,r
a110: 75 6e 6e 61 6d 65 2c 63 6f 6d 6d 65 6e 74 2b 74 unname,comment+t
a120: 65 73 74 73 3a 69 64 2c 74 65 73 74 6e 61 6d 65 ests:id,testname
a130: 2c 69 74 65 6d 5f 70 61 74 68 2b 73 74 65 70 73 ,item_path+steps
a140: 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 3d 3e ").;; =>
a150: 20 28 28 22 72 75 6e 73 22 20 22 69 64 22 20 22 (("runs" "id" "
a160: 74 61 72 67 65 74 22 20 22 72 75 6e 6e 61 6d 65 target" "runname
a170: 22 20 22 63 6f 6d 6d 65 6e 74 22 29 20 28 22 74 " "comment") ("t
a180: 65 73 74 73 22 20 22 69 64 22 20 22 74 65 73 74 ests" "id" "test
a190: 6e 61 6d 65 22 20 22 69 74 65 6d 5f 70 61 74 68 name" "item_path
a1a0: 22 29 20 28 22 73 74 65 70 73 22 29 29 0a 3b 3b ") ("steps")).;;
a1b0: 0a 3b 3b 20 20 20 4e 4f 54 45 3a 20 72 65 6d 65 .;; NOTE: reme
a1c0: 6d 62 65 72 20 74 68 61 74 20 74 68 65 20 63 64 mber that the cd
a1d0: 72 20 77 69 6c 6c 20 62 65 20 74 68 65 20 6c 69 r will be the li
a1e0: 73 74 20 79 6f 75 20 65 78 70 65 63 74 20 28 63 st you expect (c
a1f0: 64 72 20 28 22 72 75 6e 73 22 20 22 69 64 22 20 dr ("runs" "id"
a200: 22 74 61 72 67 65 74 22 20 22 72 75 6e 6e 61 6d "target" "runnam
a210: 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 29 20 3d e" "comment")) =
a220: 3e 20 28 22 69 64 22 20 22 74 61 72 67 65 74 22 > ("id" "target"
a230: 20 22 72 75 6e 6e 61 6d 65 22 20 22 63 6f 6d 6d "runname" "comm
a240: 65 6e 74 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 ent").;;
a250: 20 61 6e 64 20 73 6f 20 61 6c 69 73 74 2d 72 65 and so alist-re
a260: 66 20 77 69 6c 6c 20 79 69 65 6c 64 20 77 68 61 f will yield wha
a270: 74 20 79 6f 75 20 65 78 70 65 63 74 0a 3b 3b 0a t you expect.;;.
a280: 28 64 65 66 69 6e 65 20 28 65 78 74 72 61 63 74 (define (extract
a290: 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 74 72 61 69 -fields-constrai
a2a0: 6e 74 73 20 66 69 65 6c 64 73 2d 73 70 65 63 29 nts fields-spec)
a2b0: 0a 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 . (map (lambda
a2c0: 28 74 61 62 6c 65 2d 73 70 65 63 29 20 3b 3b 20 (table-spec) ;;
a2d0: 72 75 6e 73 3a 69 64 2c 74 61 72 67 65 74 2c 72 runs:id,target,r
a2e0: 75 6e 6e 61 6d 65 0a 09 20 28 6c 65 74 20 28 28 unname.. (let ((
a2f0: 64 61 74 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 dat (string-spli
a300: 74 20 74 61 62 6c 65 2d 73 70 65 63 20 22 3a 22 t table-spec ":"
a310: 29 29 29 20 3b 3b 20 28 22 72 75 6e 73 22 20 22 ))) ;; ("runs" "
a320: 69 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d id,target,runnam
a330: 65 22 29 0a 09 20 20 20 28 69 66 20 28 3e 20 28 e").. (if (> (
a340: 6c 65 6e 67 74 68 20 64 61 74 29 20 31 29 0a 09 length dat) 1)..
a350: 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 63 61 (cons (ca
a360: 72 20 64 61 74 29 28 73 74 72 69 6e 67 2d 73 70 r dat)(string-sp
a370: 6c 69 74 20 28 63 61 64 72 20 64 61 74 29 20 22 lit (cadr dat) "
a380: 2c 22 29 29 20 3b 3b 20 22 69 64 2c 74 61 72 67 ,")) ;; "id,targ
a390: 65 74 2c 72 75 6e 6e 61 6d 65 22 0a 09 20 20 20 et,runname"..
a3a0: 20 20 20 20 64 61 74 29 29 29 0a 20 20 20 20 20 dat))).
a3b0: 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 (string-split
a3c0: 66 69 65 6c 64 73 2d 73 70 65 63 20 22 2b 22 29 fields-spec "+")
a3d0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 74 ))..(define (get
a3e0: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
a3f0: 61 6d 65 20 64 61 74 61 76 65 63 20 74 65 73 74 ame datavec test
a400: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 66 69 65 -field-index fie
a410: 6c 64 6e 61 6d 65 29 0a 20 20 28 6c 65 74 20 28 ldname). (let (
a420: 28 69 6e 64 78 20 28 68 61 73 68 2d 74 61 62 6c (indx (hash-tabl
a430: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 e-ref/default te
a440: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 66 st-field-index f
a450: 69 65 6c 64 6e 61 6d 65 20 23 66 29 29 29 0a 20 ieldname #f))).
a460: 20 20 20 28 69 66 20 69 6e 64 78 0a 09 28 69 66 (if indx..(if
a470: 20 28 3e 3d 20 69 6e 64 78 20 28 76 65 63 74 6f (>= indx (vecto
a480: 72 2d 6c 65 6e 67 74 68 20 64 61 74 61 76 65 63 r-length datavec
a490: 29 29 0a 09 20 20 20 20 23 66 20 3b 3b 20 69 6e )).. #f ;; in
a4a0: 64 65 78 20 74 6f 6f 20 68 69 67 68 2c 20 73 68 dex too high, sh
a4b0: 6f 75 6c 64 20 72 61 69 73 65 20 61 6e 20 65 72 ould raise an er
a4c0: 72 6f 72 20 49 20 73 75 70 70 6f 73 65 0a 09 20 ror I suppose..
a4d0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 64 (vector-ref d
a4e0: 61 74 61 76 65 63 20 69 6e 64 78 29 29 0a 09 23 atavec indx))..#
a4f0: 66 29 29 29 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 6c f)))..;; NOTE: l
a500: 69 73 74 2d 72 75 6e 73 20 61 6e 64 20 6c 69 73 ist-runs and lis
a510: 74 2d 64 62 2d 74 61 72 67 65 74 73 20 6f 70 65 t-db-targets ope
a520: 72 61 74 65 20 6f 6e 20 6c 6f 63 61 6c 20 64 62 rate on local db
a530: 21 21 21 0a 3b 3b 0a 3b 3b 20 49 44 45 41 3a 20 !!!.;;.;; IDEA:
a540: 6d 65 67 61 74 65 73 74 20 6c 69 73 74 20 2d 72 megatest list -r
a550: 75 6e 6e 61 6d 65 20 62 6c 61 68 25 20 2e 2e 2e unname blah% ...
a560: 0a 3b 3b 0a 28 69 66 20 28 6f 72 20 28 61 72 67 .;;.(if (or (arg
a570: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
a580: 2d 72 75 6e 73 22 29 0a 09 28 61 72 67 73 3a 67 -runs")..(args:g
a590: 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 et-arg "-list-db
a5a0: 2d 74 61 72 67 65 74 73 22 29 29 0a 20 20 20 20 -targets")).
a5b0: 28 69 66 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 (if (launch:setu
a5c0: 70 29 0a 09 28 6c 65 74 2a 20 28 3b 3b 20 28 64 p)..(let* (;; (d
a5d0: 62 73 74 72 75 63 74 20 20 20 20 28 6d 61 6b 65 bstruct (make
a5e0: 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 -dbr:dbstruct pa
a5f0: 74 68 3a 20 2a 74 6f 70 70 61 74 68 2a 20 6c 6f th: *toppath* lo
a600: 63 61 6c 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 cal: (args:get-a
a610: 72 67 20 22 2d 6c 6f 63 61 6c 22 29 29 29 0a 09 rg "-local")))..
a620: 20 20 20 20 20 20 20 28 72 75 6e 70 61 74 74 20 (runpatt
a630: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
a640: 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 29 g "-list-runs"))
a650: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a660: 28 61 63 63 65 73 73 2d 6d 6f 64 65 20 28 64 62 (access-mode (db
a670: 3a 67 65 74 2d 61 63 63 65 73 73 2d 6d 6f 64 65 :get-access-mode
a680: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
a690: 70 61 74 74 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a patt (common:
a6a0: 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 args-get-testpat
a6b0: 74 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 3b t #f)).. ;
a6c0: 3b 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ; (if (args:get-
a6d0: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
a6e0: 20 0a 09 20 20 20 20 20 20 20 3b 3b 20 20 09 20 .. ;; .
a6f0: 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 (args:get
a700: 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 -arg "-testpatt"
a710: 29 20 0a 09 20 20 20 20 20 20 20 3b 3b 20 20 09 ) .. ;; .
a720: 20 20 20 20 20 20 20 20 22 25 22 29 29 0a 09 20 "%"))..
a730: 20 20 20 20 20 20 28 6b 65 79 73 20 20 20 20 20 (keys
a740: 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 (rmt:get-keys
a750: 29 29 20 3b 3b 20 28 64 62 3a 67 65 74 2d 6b 65 )) ;; (db:get-ke
a760: 79 73 20 64 62 73 74 72 75 63 74 29 29 0a 09 20 ys dbstruct))..
a770: 20 20 20 20 20 20 3b 3b 20 28 72 75 6e 73 64 61 ;; (runsda
a780: 74 20 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 20 t (db:get-runs
a790: 64 62 73 74 72 75 63 74 20 72 75 6e 70 61 74 74 dbstruct runpatt
a7a0: 20 23 66 20 23 66 20 27 28 29 29 29 0a 09 3b 3b #f #f '()))..;;
a7b0: 20 28 72 75 6e 73 64 61 74 20 20 20 20 20 28 72 (runsdat (r
a7c0: 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 mt:get-runs-by-p
a7d0: 61 74 74 20 6b 65 79 73 20 28 6f 72 20 72 75 6e att keys (or run
a7e0: 70 61 74 74 20 22 25 22 29 20 28 63 6f 6d 6d 6f patt "%") (commo
a7f0: 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 n:args-get-targe
a800: 74 29 20 3b 3b 20 28 64 62 3a 67 65 74 2d 72 75 t) ;; (db:get-ru
a810: 6e 73 2d 62 79 2d 70 61 74 74 20 64 62 73 74 72 ns-by-patt dbstr
a820: 75 63 74 20 6b 65 79 73 20 28 6f 72 20 72 75 6e uct keys (or run
a830: 70 61 74 74 20 22 25 22 29 20 28 63 6f 6d 6d 6f patt "%") (commo
a840: 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 n:args-get-targe
a850: 74 29 0a 09 3b 3b 20 09 09 20 20 20 20 20 20 20 t)..;; ..
a860: 20 20 20 20 09 20 23 66 20 23 66 20 27 28 22 69 . #f #f '("i
a870: 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 d" "runname" "st
a880: 61 74 65 22 20 22 73 74 61 74 75 73 22 20 22 6f ate" "status" "o
a890: 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 69 6d wner" "event_tim
a8a0: 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 20 30 29 e" "comment") 0)
a8b0: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 64 ).. (runsd
a8c0: 61 74 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d at (rmt:get-
a8d0: 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 6b 65 79 runs-by-patt key
a8e0: 73 20 28 6f 72 20 72 75 6e 70 61 74 74 20 22 25 s (or runpatt "%
a8f0: 22 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 ") .
a900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a920: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 (common:ar
a930: 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 20 23 gs-get-target) #
a940: 66 20 23 66 20 27 28 22 69 64 22 20 22 72 75 6e f #f '("id" "run
a950: 6e 61 6d 65 22 20 22 73 74 61 74 65 22 20 22 73 name" "state" "s
a960: 74 61 74 75 73 22 20 22 6f 77 6e 65 72 22 20 22 tatus" "owner" "
a970: 65 76 65 6e 74 5f 74 69 6d 65 22 20 22 63 6f 6d event_time" "com
a980: 6d 65 6e 74 22 29 20 30 29 29 0a 09 20 20 20 20 ment") 0))..
a990: 20 20 20 28 72 75 6e 73 74 6d 70 20 20 20 20 20 (runstmp
a9a0: 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e (db:get-rows run
a9b0: 73 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 28 sdat)).. (
a9c0: 68 65 61 64 65 72 20 20 20 20 20 20 28 64 62 3a header (db:
a9d0: 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 73 64 get-header runsd
a9e0: 61 74 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 at)).. ;;
a9f0: 74 68 69 73 20 69 73 20 22 2d 73 69 6e 63 65 22 this is "-since"
aa00: 20 73 75 70 70 6f 72 74 2e 20 54 68 69 73 20 6c support. This l
aa10: 6f 6f 6b 73 20 61 74 20 6c 61 73 74 20 6d 6f 64 ooks at last mod
aa20: 20 74 69 6d 65 73 20 6f 66 20 3c 72 75 6e 2d 69 times of <run-i
aa30: 64 3e 2e 64 62 20 66 69 6c 65 73 0a 09 20 20 20 d>.db files..
aa40: 20 20 20 20 3b 3b 20 61 6e 64 20 63 6f 6c 6c 65 ;; and colle
aa50: 63 74 73 20 74 68 6f 73 65 20 6d 6f 64 69 66 69 cts those modifi
aa60: 65 64 20 73 69 6e 63 65 20 74 68 65 20 2d 73 69 ed since the -si
aa70: 6e 63 65 20 74 69 6d 65 2e 0a 09 20 20 20 20 20 nce time...
aa80: 20 20 28 72 75 6e 73 20 20 20 20 20 20 20 20 72 (runs r
aa90: 75 6e 73 74 6d 70 29 0a 20 20 20 20 20 20 20 20 unstmp).
aaa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aab0: 3b 3b 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 ;; (if (and (not
aac0: 20 28 6e 75 6c 6c 3f 20 72 75 6e 73 74 6d 70 29 (null? runstmp)
aad0: 29 0a 09 09 09 3b 3b 20 20 20 20 20 20 20 20 28 )....;; (
aae0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
aaf0: 69 6e 63 65 22 29 29 0a 09 09 09 3b 3b 20 20 20 ince"))....;;
ab00: 28 6c 65 74 20 28 28 63 68 61 6e 67 65 64 2d 69 (let ((changed-i
ab10: 64 73 20 28 64 62 3a 67 65 74 2d 63 68 61 6e 67 ds (db:get-chang
ab20: 65 64 2d 72 75 6e 2d 69 64 73 20 28 73 74 72 69 ed-run-ids (stri
ab30: 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 ng->number (args
ab40: 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 :get-arg "-since
ab50: 22 29 29 29 29 29 0a 09 09 09 3b 3b 20 20 20 20 ")))))....;;
ab60: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 (let loop ((hed
ab70: 20 28 63 61 72 20 72 75 6e 73 74 6d 70 29 29 0a (car runstmp)).
ab80: 09 09 09 3b 3b 20 20 20 09 20 20 20 20 20 28 74 ...;; . (t
ab90: 61 6c 20 28 63 64 72 20 72 75 6e 73 74 6d 70 29 al (cdr runstmp)
aba0: 29 0a 09 09 09 3b 3b 20 20 20 09 20 20 20 20 20 )....;; .
abb0: 28 72 65 73 20 27 28 29 29 29 0a 09 09 09 3b 3b (res '()))....;;
abc0: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 (let ((ne
abd0: 77 2d 72 65 73 20 28 69 66 20 28 6d 65 6d 62 65 w-res (if (membe
abe0: 72 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d r (db:get-value-
abf0: 62 79 2d 68 65 61 64 65 72 20 68 65 64 20 68 65 by-header hed he
ac00: 61 64 65 72 20 22 69 64 22 29 20 63 68 61 6e 67 ader "id") chang
ac10: 65 64 2d 69 64 73 29 0a 09 09 09 3b 3b 20 20 20 ed-ids)....;;
ac20: 09 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 68 .. (cons h
ac30: 65 64 20 72 65 73 29 0a 09 09 09 3b 3b 20 20 20 ed res)....;;
ac40: 09 09 20 20 20 20 20 20 20 72 65 73 29 29 29 0a .. res))).
ac50: 09 09 09 3b 3b 20 20 20 20 20 20 20 20 20 28 69 ...;; (i
ac60: 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 f (null? tal)...
ac70: 09 3b 3b 20 20 20 09 20 20 28 72 65 76 65 72 73 .;; . (revers
ac80: 65 20 6e 65 77 2d 72 65 73 29 0a 09 09 09 3b 3b e new-res)....;;
ac90: 20 20 20 09 20 20 28 6c 6f 6f 70 20 28 63 61 72 . (loop (car
aca0: 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e tal)(cdr tal) n
acb0: 65 77 2d 72 65 73 29 29 29 29 29 0a 09 09 09 3b ew-res)))))....;
acc0: 3b 20 20 20 72 75 6e 73 74 6d 70 29 29 0a 09 20 ; runstmp))..
acd0: 20 20 20 20 20 20 28 64 62 2d 74 61 72 67 65 74 (db-target
ace0: 73 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 s (args:get-arg
acf0: 20 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 "-list-db-targe
ad00: 74 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 ts")).. (s
ad10: 65 65 6e 20 20 20 20 20 20 20 20 28 6d 61 6b 65 een (make
ad20: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 -hash-table))..
ad30: 20 20 20 20 20 20 28 64 6d 6f 64 65 20 20 20 20 (dmode
ad40: 20 20 20 28 6c 65 74 20 28 28 64 20 28 61 72 67 (let ((d (arg
ad50: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
ad60: 6d 6f 64 65 22 29 29 29 0a 09 09 09 20 20 20 20 mode")))....
ad70: 20 20 28 69 66 20 64 20 28 73 74 72 69 6e 67 2d (if d (string-
ad80: 3e 73 79 6d 62 6f 6c 20 64 29 20 23 66 29 29 29 >symbol d) #f)))
ad90: 0a 09 20 20 20 20 20 20 20 28 64 61 74 61 20 20 .. (data
ada0: 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 (make-hash
adb0: 2d 74 61 62 6c 65 29 29 0a 09 20 20 20 20 20 20 -table))..
adc0: 20 28 66 69 65 6c 64 73 2d 73 70 65 63 20 28 69 (fields-spec (i
add0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
ade0: 22 2d 66 69 65 6c 64 73 22 29 0a 09 09 09 09 28 "-fields").....(
adf0: 65 78 74 72 61 63 74 2d 66 69 65 6c 64 73 2d 63 extract-fields-c
ae00: 6f 6e 73 74 72 61 69 6e 74 73 20 28 61 72 67 73 onstraints (args
ae10: 3a 67 65 74 2d 61 72 67 20 22 2d 66 69 65 6c 64 :get-arg "-field
ae20: 73 22 29 29 0a 09 09 09 09 28 6c 69 73 74 20 28 s")).....(list (
ae30: 63 6f 6e 73 20 22 72 75 6e 73 22 20 28 61 70 70 cons "runs" (app
ae40: 65 6e 64 20 6b 65 79 73 20 28 6c 69 73 74 20 22 end keys (list "
ae50: 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 id" "runname" "s
ae60: 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 22 tate" "status" "
ae70: 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 69 owner" "event_ti
ae80: 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 20 22 66 me" "comment" "f
ae90: 61 69 6c 5f 63 6f 75 6e 74 22 20 22 70 61 73 73 ail_count" "pass
aea0: 5f 63 6f 75 6e 74 22 29 29 29 0a 09 09 09 09 20 _count"))).....
aeb0: 20 20 20 20 20 28 63 6f 6e 73 20 22 74 65 73 74 (cons "test
aec0: 73 22 20 20 64 62 3a 74 65 73 74 2d 72 65 63 6f s" db:test-reco
aed0: 72 64 2d 66 69 65 6c 64 73 29 20 3b 3b 20 22 69 rd-fields) ;; "i
aee0: 64 22 20 22 74 65 73 74 6e 61 6d 65 22 20 22 74 d" "testname" "t
aef0: 65 73 74 5f 70 61 74 68 22 29 0a 09 09 09 09 20 est_path").....
af00: 20 20 20 20 20 28 6c 69 73 74 20 22 73 74 65 70 (list "step
af10: 73 22 20 22 69 64 22 20 22 73 74 65 70 6e 61 6d s" "id" "stepnam
af20: 65 22 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 e")))).. (
af30: 72 75 6e 73 2d 73 70 65 63 20 20 20 28 6c 65 74 runs-spec (let
af40: 20 28 28 72 20 28 61 6c 69 73 74 2d 72 65 66 20 ((r (alist-ref
af50: 22 72 75 6e 73 22 20 20 66 69 65 6c 64 73 2d 73 "runs" fields-s
af60: 70 65 63 20 65 71 75 61 6c 3f 29 29 29 20 3b 3b pec equal?))) ;;
af70: 20 74 68 65 20 63 68 65 63 6b 20 69 73 20 6e 6f the check is no
af80: 77 20 75 6e 6e 65 63 65 73 73 61 72 79 0a 09 09 w unnecessary...
af90: 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 . (if (and
afa0: 72 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 29 r (not (null? r)
afb0: 29 29 20 72 20 28 6c 69 73 74 20 22 69 64 22 20 )) r (list "id"
afc0: 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 )))).. (te
afd0: 73 74 73 2d 73 70 65 63 20 20 28 6c 65 74 20 28 sts-spec (let (
afe0: 28 74 20 28 61 6c 69 73 74 2d 72 65 66 20 22 74 (t (alist-ref "t
aff0: 65 73 74 73 22 20 66 69 65 6c 64 73 2d 73 70 65 ests" fields-spe
b000: 63 20 65 71 75 61 6c 3f 29 29 29 0a 09 09 09 20 c equal?)))....
b010: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 20 (if (and t
b020: 28 6e 75 6c 6c 3f 20 74 29 29 20 3b 3b 20 61 6c (null? t)) ;; al
b030: 6c 20 66 69 65 6c 64 73 0a 09 09 09 09 20 20 64 l fields..... d
b040: 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 b:test-record-fi
b050: 65 6c 64 73 0a 09 09 09 09 20 20 74 29 29 29 0a elds..... t))).
b060: 09 20 20 20 20 20 20 20 28 61 64 6a 2d 74 65 73 . (adj-tes
b070: 74 73 2d 73 70 65 63 20 28 64 65 6c 65 74 65 2d ts-spec (delete-
b080: 64 75 70 6c 69 63 61 74 65 73 20 28 69 66 20 74 duplicates (if t
b090: 65 73 74 73 2d 73 70 65 63 20 28 63 6f 6e 73 20 ests-spec (cons
b0a0: 22 69 64 22 20 74 65 73 74 73 2d 73 70 65 63 29 "id" tests-spec)
b0b0: 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d db:test-record-
b0c0: 66 69 65 6c 64 73 29 29 29 20 3b 3b 20 27 28 22 fields))) ;; '("
b0d0: 69 64 22 29 29 29 29 0a 09 20 20 20 20 20 20 20 id"))))..
b0e0: 28 73 74 65 70 73 2d 73 70 65 63 20 20 28 61 6c (steps-spec (al
b0f0: 69 73 74 2d 72 65 66 20 22 73 74 65 70 73 22 20 ist-ref "steps"
b100: 66 69 65 6c 64 73 2d 73 70 65 63 20 65 71 75 61 fields-spec equa
b110: 6c 3f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 l?)).. (te
b120: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 28 st-field-index (
b130: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
b140: 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 74 )).. (if (and t
b150: 65 73 74 73 2d 73 70 65 63 20 28 6e 6f 74 20 28 ests-spec (not (
b160: 6e 75 6c 6c 3f 20 74 65 73 74 73 2d 73 70 65 63 null? tests-spec
b170: 29 29 29 20 3b 3b 20 64 6f 20 73 6f 6d 65 20 76 ))) ;; do some v
b180: 61 6c 69 64 61 74 69 6f 6e 20 61 6e 64 20 70 72 alidation and pr
b190: 6f 63 65 73 73 69 6e 67 20 6f 66 20 74 68 65 20 ocessing of the
b1a0: 74 65 73 74 2d 73 70 65 63 0a 09 20 20 20 20 20 test-spec..
b1b0: 20 28 6c 65 74 20 28 28 69 6e 76 61 6c 69 64 2d (let ((invalid-
b1c0: 74 65 73 74 73 2d 73 70 65 63 20 28 66 69 6c 74 tests-spec (filt
b1d0: 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e er (lambda (x)(n
b1e0: 6f 74 20 28 6d 65 6d 62 65 72 20 78 20 64 62 3a ot (member x db:
b1f0: 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c test-record-fiel
b200: 64 73 29 29 29 20 74 65 73 74 73 2d 73 70 65 63 ds))) tests-spec
b210: 29 29 29 0a 09 09 28 69 66 20 28 6e 75 6c 6c 3f )))...(if (null?
b220: 20 69 6e 76 61 6c 69 64 2d 74 65 73 74 73 2d 73 invalid-tests-s
b230: 70 65 63 29 0a 09 09 20 20 20 20 3b 3b 20 67 65 pec)... ;; ge
b240: 6e 65 72 61 74 65 20 74 68 65 20 6c 6f 6f 6b 75 nerate the looku
b250: 70 20 6d 61 70 20 74 65 73 74 2d 66 69 65 6c 64 p map test-field
b260: 2d 6e 61 6d 65 20 3d 3e 20 69 6e 64 65 78 2d 6e -name => index-n
b270: 75 6d 62 65 72 0a 09 09 20 20 20 20 28 6c 65 74 umber... (let
b280: 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 loop ((hed (car
b290: 20 61 64 6a 2d 74 65 73 74 73 2d 73 70 65 63 29 adj-tests-spec)
b2a0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 74 61 6c ).... (tal
b2b0: 20 28 63 64 72 20 61 64 6a 2d 74 65 73 74 73 2d (cdr adj-tests-
b2c0: 73 70 65 63 29 29 0a 09 09 09 20 20 20 20 20 20 spec))....
b2d0: 20 28 69 64 78 20 30 29 29 0a 09 09 20 20 20 20 (idx 0))...
b2e0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
b2f0: 74 21 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e t! test-field-in
b300: 64 65 78 20 68 65 64 20 69 64 78 29 0a 09 09 20 dex hed idx)...
b310: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e (if (not (n
b320: 75 6c 6c 3f 20 74 61 6c 29 29 28 6c 6f 6f 70 20 ull? tal))(loop
b330: 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 (car tal)(cdr ta
b340: 6c 29 28 2b 20 69 64 78 20 31 29 29 29 29 0a 09 l)(+ idx 1))))..
b350: 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 . (begin...
b360: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
b370: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
b380: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 6e 76 t-log-port* "Inv
b390: 61 6c 69 64 20 74 65 73 74 20 66 69 65 6c 64 73 alid test fields
b3a0: 20 73 70 65 63 69 66 69 65 64 3a 20 22 20 28 73 specified: " (s
b3b0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
b3c0: 65 20 69 6e 76 61 6c 69 64 2d 74 65 73 74 73 2d e invalid-tests-
b3d0: 73 70 65 63 20 22 2c 20 22 29 29 0a 09 09 20 20 spec ", "))...
b3e0: 20 20 20 20 28 65 78 69 74 29 29 29 29 29 0a 09 (exit)))))..
b3f0: 20 20 3b 3b 20 45 61 63 68 20 72 75 6e 0a 09 20 ;; Each run..
b400: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 (for-each ..
b410: 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 20 (lambda (run)..
b420: 20 20 20 20 28 6c 65 74 20 28 28 74 61 72 67 65 (let ((targe
b430: 74 73 74 72 20 28 73 74 72 69 6e 67 2d 69 6e 74 tstr (string-int
b440: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c ersperse (map (l
b450: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 ambda (x).......
b460: 09 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d . (db:get-value-
b470: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
b480: 61 64 65 72 20 78 29 29 0a 09 09 09 09 09 09 20 ader x)).......
b490: 20 20 20 20 20 20 6b 65 79 73 29 20 22 2f 22 29 keys) "/")
b4a0: 29 29 0a 09 20 20 20 20 20 20 20 28 69 66 20 64 )).. (if d
b4b0: 62 2d 74 61 72 67 65 74 73 0a 09 09 20 20 20 28 b-targets... (
b4c0: 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 if (not (hash-ta
b4d0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
b4e0: 73 65 65 6e 20 74 61 72 67 65 74 73 74 72 20 23 seen targetstr #
b4f0: 66 29 29 0a 09 09 20 20 20 20 20 20 20 28 62 65 f))... (be
b500: 67 69 6e 0a 09 09 09 20 28 68 61 73 68 2d 74 61 gin.... (hash-ta
b510: 62 6c 65 2d 73 65 74 21 20 73 65 65 6e 20 74 61 ble-set! seen ta
b520: 72 67 65 74 73 74 72 20 23 74 29 0a 09 09 09 20 rgetstr #t)....
b530: 3b 3b 20 28 70 72 69 6e 74 20 22 5b 22 20 74 61 ;; (print "[" ta
b540: 72 67 65 74 73 74 72 20 22 5d 22 29 29 29 29 0a rgetstr "]")))).
b550: 09 09 09 20 28 69 66 20 28 6e 6f 74 20 64 6d 6f ... (if (not dmo
b560: 64 65 29 0a 09 09 09 20 20 20 20 20 28 70 72 69 de).... (pri
b570: 6e 74 20 74 61 72 67 65 74 73 74 72 29 0a 09 09 nt targetstr)...
b580: 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c . (hash-tabl
b590: 65 2d 73 65 74 21 20 64 61 74 61 20 22 74 61 72 e-set! data "tar
b5a0: 67 65 74 73 22 20 28 63 6f 6e 73 20 74 61 72 67 gets" (cons targ
b5b0: 65 74 73 74 72 20 28 68 61 73 68 2d 74 61 62 6c etstr (hash-tabl
b5c0: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 64 61 e-ref/default da
b5d0: 74 61 20 22 74 61 72 67 65 74 73 22 20 27 28 29 ta "targets" '()
b5e0: 29 29 29 0a 09 09 09 20 20 20 20 20 29 29 29 0a ))).... ))).
b5f0: 09 09 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e .. (let* ((run
b600: 2d 69 64 20 20 28 64 62 3a 67 65 74 2d 76 61 6c -id (db:get-val
b610: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
b620: 20 68 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 header "id"))..
b630: 09 09 20 20 28 72 75 6e 6e 61 6d 65 20 28 64 62 .. (runname (db
b640: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
b650: 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 ader run header
b660: 22 72 75 6e 6e 61 6d 65 22 29 29 20 0a 09 09 09 "runname")) ....
b670: 20 20 28 73 74 61 74 65 73 20 20 28 73 74 72 69 (states (stri
b680: 6e 67 2d 73 70 6c 69 74 20 28 6f 72 20 28 61 72 ng-split (or (ar
b690: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 gs:get-arg "-sta
b6a0: 74 65 22 29 20 22 22 29 20 22 2c 22 29 29 0a 09 te") "") ","))..
b6b0: 09 09 20 20 28 73 74 61 74 75 73 65 73 20 28 73 .. (statuses (s
b6c0: 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 6f 72 20 tring-split (or
b6d0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
b6e0: 73 74 61 74 75 73 22 29 20 22 22 29 20 22 2c 22 status") "") ","
b6f0: 29 29 0a 09 09 09 20 20 28 74 65 73 74 73 20 20 )).... (tests
b700: 20 28 69 66 20 74 65 73 74 73 2d 73 70 65 63 0a (if tests-spec.
b710: 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a 64 .... (db:d
b720: 69 73 70 61 74 63 68 2d 71 75 65 72 79 20 61 63 ispatch-query ac
b730: 63 65 73 73 2d 6d 6f 64 65 20 72 6d 74 3a 67 65 cess-mode rmt:ge
b740: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
b750: 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 db:get-tests-for
b760: 2d 72 75 6e 20 72 75 6e 2d 69 64 20 74 65 73 74 -run run-id test
b770: 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 patt states stat
b780: 75 73 65 73 20 23 66 20 23 66 20 23 66 20 27 74 uses #f #f #f 't
b790: 65 73 74 6e 61 6d 65 20 27 61 73 63 20 3b 3b 20 estname 'asc ;;
b7a0: 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f (db:get-tests-fo
b7b0: 72 2d 72 75 6e 20 64 62 73 74 72 75 63 74 20 72 r-run dbstruct r
b7c0: 75 6e 2d 69 64 20 74 65 73 74 70 61 74 74 20 27 un-id testpatt '
b7d0: 28 29 20 27 28 29 20 23 66 20 23 66 20 23 66 20 () '() #f #f #f
b7e0: 27 74 65 73 74 6e 61 6d 65 20 27 61 73 63 20 0a 'testname 'asc .
b7f0: 09 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 75 ....... ;; u
b800: 73 65 20 71 72 79 76 61 6c 73 20 69 66 20 74 65 se qryvals if te
b810: 73 74 2d 73 70 65 63 20 70 72 6f 76 69 64 65 64 st-spec provided
b820: 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 69 66 ........ (if
b830: 20 74 65 73 74 73 2d 73 70 65 63 0a 09 09 09 09 tests-spec.....
b840: 09 09 09 09 20 28 73 74 72 69 6e 67 2d 69 6e 74 .... (string-int
b850: 65 72 73 70 65 72 73 65 20 61 64 6a 2d 74 65 73 ersperse adj-tes
b860: 74 73 2d 73 70 65 63 20 22 2c 22 29 0a 09 09 09 ts-spec ",")....
b870: 09 09 09 09 09 20 3b 3b 20 64 62 3a 74 65 73 74 ..... ;; db:test
b880: 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 0a 09 -record-fields..
b890: 09 09 09 09 09 09 09 20 23 66 29 0a 09 09 09 09 ....... #f).....
b8a0: 09 09 09 20 20 20 20 20 23 66 0a 09 09 09 09 09 ... #f......
b8b0: 09 09 20 20 20 20 20 27 6e 6f 72 6d 61 6c 29 0a .. 'normal).
b8c0: 09 09 09 09 20 20 20 20 20 20 20 27 28 29 29 29 .... '()))
b8d0: 29 0a 09 09 20 20 20 20 20 28 63 61 73 65 20 64 )... (case d
b8e0: 6d 6f 64 65 0a 09 09 20 20 20 20 20 20 20 28 28 mode... ((
b8f0: 6a 73 6f 6e 20 6f 64 73 29 0a 09 09 09 28 69 66 json ods)....(if
b900: 20 72 75 6e 73 2d 73 70 65 63 0a 09 09 09 20 20 runs-spec....
b910: 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 (for-each ....
b920: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 69 (lambda (fi
b930: 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 20 20 20 eld-name)....
b940: 20 20 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 (mutils:hier
b950: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 hash-set! data (
b960: 63 6f 6e 63 20 28 64 62 3a 67 65 74 2d 76 61 6c conc (db:get-val
b970: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
b980: 20 68 65 61 64 65 72 20 66 69 65 6c 64 2d 6e 61 header field-na
b990: 6d 65 29 29 20 74 61 72 67 65 74 73 74 72 20 72 me)) targetstr r
b9a0: 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 66 69 unname "meta" fi
b9b0: 65 6c 64 2d 6e 61 6d 65 29 29 0a 09 09 09 20 20 eld-name))....
b9c0: 20 20 20 72 75 6e 73 2d 73 70 65 63 29 29 29 0a runs-spec))).
b9d0: 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 ...;; (mutils:hi
b9e0: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
b9f0: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
ba00: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
ba10: 64 65 72 20 22 73 74 61 74 75 73 22 29 20 20 20 der "status")
ba20: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
ba30: 61 6d 65 20 22 6d 65 74 61 22 20 22 73 74 61 74 ame "meta" "stat
ba40: 75 73 22 20 20 20 20 20 29 0a 09 09 09 3b 3b 20 us" )....;;
ba50: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
ba60: 2d 73 65 74 21 20 64 61 74 61 20 28 64 62 3a 67 -set! data (db:g
ba70: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
ba80: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 73 er run header "s
ba90: 74 61 74 65 22 29 20 20 20 20 20 20 74 61 72 67 tate") targ
baa0: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d etstr runname "m
bab0: 65 74 61 22 20 22 73 74 61 74 65 22 20 20 20 20 eta" "state"
bac0: 20 20 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c )....;; (mutil
bad0: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
bae0: 64 61 74 61 20 28 63 6f 6e 63 20 28 64 62 3a 67 data (conc (db:g
baf0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
bb00: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 er run header "i
bb10: 64 22 29 29 20 20 74 61 72 67 65 74 73 74 72 20 d")) targetstr
bb20: 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 runname "meta" "
bb30: 69 64 22 20 20 20 20 20 20 20 20 20 29 0a 09 09 id" )...
bb40: 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 .;; (mutils:hier
bb50: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 hash-set! data (
bb60: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
bb70: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
bb80: 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 20 r "event_time")
bb90: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
bba0: 65 20 22 6d 65 74 61 22 20 22 65 76 65 6e 74 5f e "meta" "event_
bbb0: 74 69 6d 65 22 20 29 0a 09 09 09 3b 3b 20 28 6d time" )....;; (m
bbc0: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
bbd0: 65 74 21 20 64 61 74 61 20 28 64 62 3a 67 65 74 et! data (db:get
bbe0: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
bbf0: 20 72 75 6e 20 68 65 61 64 65 72 20 22 63 6f 6d run header "com
bc00: 6d 65 6e 74 22 29 20 20 20 20 74 61 72 67 65 74 ment") target
bc10: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 str runname "met
bc20: 61 22 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 a" "comment"
bc30: 29 0a 09 09 09 3b 3b 20 3b 3b 20 61 64 64 20 6c )....;; ;; add l
bc40: 61 73 74 20 65 6e 74 72 79 20 74 77 69 63 65 20 ast entry twice
bc50: 2d 20 73 65 65 6d 73 20 74 6f 20 62 65 20 61 20 - seems to be a
bc60: 62 75 67 20 69 6e 20 68 69 65 72 68 61 73 68 3f bug in hierhash?
bc70: 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 ....;; (mutils:h
bc80: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
bc90: 61 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d a (db:get-value-
bca0: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
bcb0: 61 64 65 72 20 22 63 6f 6d 6d 65 6e 74 22 29 20 ader "comment")
bcc0: 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e targetstr run
bcd0: 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 63 6f 6d name "meta" "com
bce0: 6d 65 6e 74 22 20 20 20 20 29 0a 09 09 20 20 20 ment" )...
bcf0: 20 20 20 20 28 65 6c 73 65 0a 09 09 09 28 69 66 (else....(if
bd00: 20 28 6e 75 6c 6c 3f 20 72 75 6e 73 2d 73 70 65 (null? runs-spe
bd10: 63 29 0a 09 09 09 20 20 20 20 28 70 72 69 6e 74 c).... (print
bd20: 20 22 52 75 6e 3a 20 22 20 74 61 72 67 65 74 73 "Run: " targets
bd30: 74 72 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 0a tr "/" runname .
bd40: 09 09 09 09 20 20 20 22 20 73 74 61 74 75 73 3a .... " status:
bd50: 20 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 " (db:get-value
bd60: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
bd70: 65 61 64 65 72 20 22 73 74 61 74 65 22 29 0a 09 eader "state")..
bd80: 09 09 09 20 20 20 22 20 72 75 6e 2d 69 64 3a 20 ... " run-id:
bd90: 22 20 72 75 6e 2d 69 64 20 22 2c 20 6e 75 6d 62 " run-id ", numb
bda0: 65 72 20 74 65 73 74 73 3a 20 22 20 28 6c 65 6e er tests: " (len
bdb0: 67 74 68 20 74 65 73 74 73 29 0a 09 09 09 09 20 gth tests).....
bdc0: 20 20 22 20 65 76 65 6e 74 5f 74 69 6d 65 3a 20 " event_time:
bdd0: 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d " (db:get-value-
bde0: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
bdf0: 61 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 ader "event_time
be00: 22 29 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 ")).... (begi
be10: 6e 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 n.... (if (
be20: 6e 6f 74 20 28 6d 65 6d 62 65 72 20 22 74 61 72 not (member "tar
be30: 67 65 74 22 20 72 75 6e 73 2d 73 70 65 63 29 29 get" runs-spec))
be40: 0a 09 09 09 20 20 20 20 20 20 20 20 20 20 3b 3b .... ;;
be50: 20 28 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 (display (conc
be60: 22 54 61 72 67 65 74 3a 20 22 20 74 61 72 67 65 "Target: " targe
be70: 74 73 74 72 29 29 0a 09 09 09 20 20 20 20 20 20 tstr))....
be80: 20 20 20 20 28 64 69 73 70 6c 61 79 20 28 63 6f (display (co
be90: 6e 63 20 22 52 75 6e 3a 20 22 20 74 61 72 67 65 nc "Run: " targe
bea0: 74 73 74 72 20 22 2f 22 20 72 75 6e 6e 61 6d 65 tstr "/" runname
beb0: 20 22 20 22 29 29 29 0a 09 09 09 20 20 20 20 20 " ")))....
bec0: 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 20 20 (for-each....
bed0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 69 (lambda (fi
bee0: 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 09 20 28 eld-name)..... (
bef0: 69 66 20 28 65 71 75 61 6c 3f 20 66 69 65 6c 64 if (equal? field
bf00: 2d 6e 61 6d 65 20 22 74 61 72 67 65 74 22 29 0a -name "target").
bf10: 09 09 09 09 20 20 20 20 20 28 64 69 73 70 6c 61 .... (displa
bf20: 79 20 28 63 6f 6e 63 20 22 74 61 72 67 65 74 3a y (conc "target:
bf30: 20 22 20 74 61 72 67 65 74 73 74 72 20 22 20 22 " targetstr " "
bf40: 29 29 0a 09 09 09 09 20 20 20 20 20 28 64 69 73 ))..... (dis
bf50: 70 6c 61 79 20 28 63 6f 6e 63 20 66 69 65 6c 64 play (conc field
bf60: 2d 6e 61 6d 65 20 22 3a 20 22 20 28 64 62 3a 67 -name ": " (db:g
bf70: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
bf80: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 28 63 er run header (c
bf90: 6f 6e 63 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 onc field-name))
bfa0: 20 22 20 22 29 29 29 29 0a 09 09 09 20 20 20 20 " "))))....
bfb0: 20 20 20 72 75 6e 73 2d 73 70 65 63 29 0a 09 09 runs-spec)...
bfc0: 09 20 20 20 20 20 20 28 6e 65 77 6c 69 6e 65 29 . (newline)
bfd0: 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 0a 09 ))))... ..
bfe0: 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 . (for-each
bff0: 0a 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 ... (lambda
c000: 20 28 74 65 73 74 29 0a 09 09 20 20 20 20 20 20 (test)...
c010: 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 .(handle-excepti
c020: 6f 6e 73 0a 09 09 09 20 65 78 6e 0a 09 09 09 20 ons.... exn....
c030: 28 62 65 67 69 6e 0a 09 09 09 20 20 20 28 64 65 (begin.... (de
c040: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
c050: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
c060: 6f 72 74 2a 20 22 42 61 64 20 64 61 74 61 20 69 ort* "Bad data i
c070: 6e 20 74 65 73 74 20 72 65 63 6f 72 64 3f 20 22 n test record? "
c080: 20 74 65 73 74 29 0a 09 09 09 20 20 20 28 70 72 test).... (pr
c090: 69 6e 74 20 22 65 78 6e 3d 22 20 28 63 6f 6e 64 int "exn=" (cond
c0a0: 69 74 69 6f 6e 2d 3e 6c 69 73 74 20 65 78 6e 29 ition->list exn)
c0b0: 29 0a 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 ).... (debug:p
c0c0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
c0d0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 73 log-port* " mess
c0e0: 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 age: " ((conditi
c0f0: 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 on-property-acce
c100: 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 ssor 'exn 'messa
c110: 67 65 29 20 65 78 6e 29 29 0a 09 09 09 20 20 20 ge) exn))....
c120: 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 (print-call-chai
c130: 6e 20 28 63 75 72 72 65 6e 74 2d 65 72 72 6f 72 n (current-error
c140: 2d 70 6f 72 74 29 29 29 0a 09 09 09 20 28 6c 65 -port))).... (le
c150: 74 2a 20 28 28 74 65 73 74 2d 69 64 20 20 20 20 t* ((test-id
c160: 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 69 (if (member "i
c170: 64 22 20 20 20 20 20 20 20 20 20 20 20 74 65 73 d" tes
c180: 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c ts-spec)(get-val
c190: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
c1a0: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
c1b0: 69 6e 64 65 78 20 22 69 64 22 20 20 20 20 20 20 index "id"
c1c0: 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 ) #f)) ;; (d
c1d0: 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 20 20 b:test-get-id
c1e0: 20 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 test))....
c1f0: 09 28 74 65 73 74 6e 61 6d 65 20 20 20 20 20 28 .(testname (
c200: 69 66 20 28 6d 65 6d 62 65 72 20 22 74 65 73 74 if (member "test
c210: 6e 61 6d 65 22 20 20 20 20 20 74 65 73 74 73 2d name" tests-
c220: 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d spec)(get-value-
c230: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
c240: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
c250: 65 78 20 22 74 65 73 74 6e 61 6d 65 22 20 20 20 ex "testname"
c260: 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 ) #f)) ;; (db:t
c270: 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 est-get-testname
c280: 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 69 test)).....(i
c290: 74 65 6d 70 61 74 68 20 20 20 20 20 28 69 66 20 tempath (if
c2a0: 28 6d 65 6d 62 65 72 20 22 69 74 65 6d 5f 70 61 (member "item_pa
c2b0: 74 68 22 20 20 20 20 74 65 73 74 73 2d 73 70 65 th" tests-spe
c2c0: 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d c)(get-value-by-
c2d0: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
c2e0: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
c2f0: 22 69 74 65 6d 5f 70 61 74 68 22 20 20 20 29 20 "item_path" )
c300: 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 #f)) ;; (db:test
c310: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 20 -get-item-path
c320: 74 65 73 74 29 29 0a 09 09 09 09 28 63 6f 6d 6d test)).....(comm
c330: 65 6e 74 20 20 20 20 20 20 28 69 66 20 28 6d 65 ent (if (me
c340: 6d 62 65 72 20 22 63 6f 6d 6d 65 6e 74 22 20 20 mber "comment"
c350: 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 tests-spec)(
c360: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
c370: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
c380: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 63 6f -field-index "co
c390: 6d 6d 65 6e 74 22 20 20 20 20 20 29 20 23 66 29 mment" ) #f)
c3a0: 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 ) ;; (db:test-ge
c3b0: 74 2d 63 6f 6d 6d 65 6e 74 20 20 20 20 74 65 73 t-comment tes
c3c0: 74 29 29 0a 09 09 09 09 28 74 73 74 61 74 65 20 t)).....(tstate
c3d0: 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 (if (membe
c3e0: 72 20 22 73 74 61 74 65 22 20 20 20 20 20 20 20 r "state"
c3f0: 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 tests-spec)(get
c400: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
c410: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
c420: 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 65 eld-index "state
c430: 22 20 20 20 20 20 20 20 29 20 23 66 29 29 20 3b " ) #f)) ;
c440: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ; (db:test-get-s
c450: 74 61 74 65 20 20 20 20 20 20 74 65 73 74 29 29 tate test))
c460: 0a 09 09 09 09 28 74 73 74 61 74 75 73 20 20 20 .....(tstatus
c470: 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 (if (member "
c480: 73 74 61 74 75 73 22 20 20 20 20 20 20 20 74 65 status" te
c490: 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 sts-spec)(get-va
c4a0: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
c4b0: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
c4c0: 2d 69 6e 64 65 78 20 22 73 74 61 74 75 73 22 20 -index "status"
c4d0: 20 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 ) #f)) ;; (
c4e0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
c4f0: 75 73 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 us test))...
c500: 09 09 28 65 76 65 6e 74 2d 74 69 6d 65 20 20 20 ..(event-time
c510: 28 69 66 20 28 6d 65 6d 62 65 72 20 22 65 76 65 (if (member "eve
c520: 6e 74 5f 74 69 6d 65 22 20 20 20 74 65 73 74 73 nt_time" tests
c530: 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 -spec)(get-value
c540: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
c550: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
c560: 64 65 78 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 dex "event_time"
c570: 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a ) #f)) ;; (db:
c580: 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 test-get-event_t
c590: 69 6d 65 20 74 65 73 74 29 29 0a 09 09 09 09 28 ime test)).....(
c5a0: 72 75 6e 64 69 72 20 20 20 20 20 20 20 28 69 66 rundir (if
c5b0: 20 28 6d 65 6d 62 65 72 20 22 72 75 6e 64 69 72 (member "rundir
c5c0: 22 20 20 20 20 20 20 20 74 65 73 74 73 2d 73 70 " tests-sp
c5d0: 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 ec)(get-value-by
c5e0: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
c5f0: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
c600: 20 22 72 75 6e 64 69 72 22 20 20 20 20 20 20 29 "rundir" )
c610: 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 #f)) ;; (db:tes
c620: 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 20 20 20 t-get-rundir
c630: 20 74 65 73 74 29 29 0a 09 09 09 09 28 66 69 6e test)).....(fin
c640: 61 6c 5f 6c 6f 67 66 20 20 20 28 69 66 20 28 6d al_logf (if (m
c650: 65 6d 62 65 72 20 22 66 69 6e 61 6c 5f 6c 6f 67 ember "final_log
c660: 66 22 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 f" tests-spec)
c670: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
c680: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
c690: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 66 t-field-index "f
c6a0: 69 6e 61 6c 5f 6c 6f 67 66 22 20 20 29 20 23 66 inal_logf" ) #f
c6b0: 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 )) ;; (db:test-g
c6c0: 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 et-final_logf te
c6d0: 73 74 29 29 0a 09 09 09 09 28 72 75 6e 5f 64 75 st)).....(run_du
c6e0: 72 61 74 69 6f 6e 20 28 69 66 20 28 6d 65 6d 62 ration (if (memb
c6f0: 65 72 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e er "run_duration
c700: 22 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 " tests-spec)(ge
c710: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
c720: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
c730: 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 5f ield-index "run_
c740: 64 75 72 61 74 69 6f 6e 22 29 20 23 66 29 29 20 duration") #f))
c750: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
c760: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 run_duration tes
c770: 74 29 29 0a 09 09 09 09 28 66 75 6c 6c 6e 61 6d t)).....(fullnam
c780: 65 20 20 20 20 20 28 63 6f 6e 63 20 74 65 73 74 e (conc test
c790: 6e 61 6d 65 0a 09 09 09 09 09 09 20 20 20 20 28 name....... (
c7a0: 69 66 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 70 if (equal? itemp
c7b0: 61 74 68 20 22 22 29 0a 09 09 09 09 09 09 09 22 ath "")........"
c7c0: 22 20 0a 09 09 09 09 09 09 09 28 63 6f 6e 63 20 " ........(conc
c7d0: 22 28 22 20 69 74 65 6d 70 61 74 68 20 22 29 22 "(" itempath ")"
c7e0: 29 29 29 29 29 0a 09 09 09 20 20 20 28 63 61 73 ))))).... (cas
c7f0: 65 20 64 6d 6f 64 65 0a 09 09 09 20 20 20 20 20 e dmode....
c800: 28 28 6a 73 6f 6e 20 6f 64 73 29 0a 09 09 09 20 ((json ods)....
c810: 20 20 20 20 20 28 69 66 20 74 65 73 74 73 2d 73 (if tests-s
c820: 70 65 63 0a 09 09 09 09 20 20 28 66 6f 72 2d 65 pec..... (for-e
c830: 61 63 68 0a 09 09 09 09 20 20 20 28 6c 61 6d 62 ach..... (lamb
c840: 64 61 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a da (field-name).
c850: 09 09 09 09 20 20 20 20 20 28 6d 75 74 69 6c 73 .... (mutils
c860: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
c870: 61 74 61 20 20 28 67 65 74 2d 76 61 6c 75 65 2d ata (get-value-
c880: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
c890: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
c8a0: 65 78 20 66 69 65 6c 64 2d 6e 61 6d 65 29 20 74 ex field-name) t
c8b0: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
c8c0: 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 "data" (conc te
c8d0: 73 74 2d 69 64 29 20 66 69 65 6c 64 2d 6e 61 6d st-id) field-nam
c8e0: 65 29 29 0a 09 09 09 09 20 20 20 74 65 73 74 73 e))..... tests
c8f0: 2d 73 70 65 63 29 29 29 0a 09 09 09 20 20 20 20 -spec)))....
c900: 20 3b 3b 20 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 ;; ;; (mutils:h
c910: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
c920: 61 20 20 66 75 6c 6c 6e 61 6d 65 20 20 20 74 61 a fullname ta
c930: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
c940: 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 "data" (conc tes
c950: 74 2d 69 64 29 20 22 74 6e 61 6d 65 22 20 20 20 t-id) "tname"
c960: 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 ).... ;;
c970: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
c980: 2d 73 65 74 21 20 64 61 74 61 20 20 74 65 73 74 -set! data test
c990: 6e 61 6d 65 20 20 20 74 61 72 67 65 74 73 74 72 name targetstr
c9a0: 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 runname "data"
c9b0: 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 (conc test-id) "
c9c0: 74 65 73 74 6e 61 6d 65 22 20 20 29 0a 09 09 09 testname" )....
c9d0: 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 ;; (mutils
c9e0: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
c9f0: 61 74 61 20 20 69 74 65 6d 70 61 74 68 20 20 20 ata itempath
ca00: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
ca10: 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 e "data" (conc t
ca20: 65 73 74 2d 69 64 29 20 22 69 74 65 6d 70 61 74 est-id) "itempat
ca30: 68 22 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b h" ).... ;;
ca40: 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 (mutils:hierha
ca50: 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 63 6f sh-set! data co
ca60: 6d 6d 65 6e 74 20 20 20 20 74 61 72 67 65 74 73 mment targets
ca70: 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 tr runname "data
ca80: 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 " (conc test-id)
ca90: 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 29 0a 09 "comment" )..
caa0: 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 .. ;; (muti
cab0: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
cac0: 20 64 61 74 61 20 20 74 73 74 61 74 65 20 20 20 data tstate
cad0: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
cae0: 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 ame "data" (conc
caf0: 20 74 65 73 74 2d 69 64 29 20 22 73 74 61 74 65 test-id) "state
cb00: 22 20 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 " )....
cb10: 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 ;; (mutils:hier
cb20: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 hash-set! data
cb30: 74 73 74 61 74 75 73 20 20 20 20 74 61 72 67 65 tstatus targe
cb40: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 tstr runname "da
cb50: 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 ta" (conc test-i
cb60: 64 29 20 22 73 74 61 74 75 73 22 20 20 20 20 29 d) "status" )
cb70: 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 .... ;; (mu
cb80: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
cb90: 74 21 20 64 61 74 61 20 20 72 75 6e 64 69 72 20 t! data rundir
cba0: 20 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 targetstr ru
cbb0: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
cbc0: 6e 63 20 74 65 73 74 2d 69 64 29 20 22 72 75 6e nc test-id) "run
cbd0: 64 69 72 22 20 20 20 20 29 0a 09 09 09 20 20 20 dir" )....
cbe0: 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 ;; (mutils:hi
cbf0: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
cc00: 20 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 61 72 final_logf tar
cc10: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
cc20: 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 data" (conc test
cc30: 2d 69 64 29 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 -id) "final_logf
cc40: 22 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 ").... ;; (
cc50: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
cc60: 73 65 74 21 20 64 61 74 61 20 20 72 75 6e 5f 64 set! data run_d
cc70: 75 72 61 74 69 6f 6e 20 74 61 72 67 65 74 73 74 uration targetst
cc80: 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 r runname "data"
cc90: 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 (conc test-id)
cca0: 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 0a "run_duration").
ccb0: 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 ... ;; (mut
ccc0: 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 ils:hierhash-set
ccd0: 21 20 64 61 74 61 20 20 65 76 65 6e 74 2d 74 69 ! data event-ti
cce0: 6d 65 20 74 61 72 67 65 74 73 74 72 20 72 75 6e me targetstr run
ccf0: 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e name "data" (con
cd00: 63 20 74 65 73 74 2d 69 64 29 20 22 65 76 65 6e c test-id) "even
cd10: 74 5f 74 69 6d 65 22 29 0a 09 09 09 20 20 20 20 t_time")....
cd20: 20 3b 3b 20 20 3b 3b 20 61 64 64 20 6c 61 73 74 ;; ;; add last
cd30: 20 65 6e 74 72 79 20 74 77 69 63 65 20 2d 20 73 entry twice - s
cd40: 65 65 6d 73 20 74 6f 20 62 65 20 61 20 62 75 67 eems to be a bug
cd50: 20 69 6e 20 68 69 65 72 68 61 73 68 3f 0a 09 09 in hierhash?...
cd60: 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c . ;; (mutil
cd70: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
cd80: 64 61 74 61 20 20 65 76 65 6e 74 2d 74 69 6d 65 data event-time
cd90: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
cda0: 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 me "data" (conc
cdb0: 74 65 73 74 2d 69 64 29 20 22 65 76 65 6e 74 5f test-id) "event_
cdc0: 74 69 6d 65 22 29 0a 09 09 09 20 20 20 20 20 3b time").... ;
cdd0: 3b 20 20 29 0a 09 09 09 20 20 20 20 20 28 65 6c ; ).... (el
cde0: 73 65 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 se.... (if
cdf0: 28 61 6e 64 20 74 73 74 61 74 65 20 74 73 74 61 (and tstate tsta
ce00: 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 29 0a tus event-time).
ce10: 09 09 09 09 20 20 28 66 6f 72 6d 61 74 20 23 74 .... (format #t
ce20: 0a 09 09 09 09 09 20 20 22 20 20 54 65 73 74 3a ...... " Test:
ce30: 20 7e 32 35 61 20 53 74 61 74 65 3a 20 7e 31 35 ~25a State: ~15
ce40: 61 20 53 74 61 74 75 73 3a 20 7e 31 35 61 20 52 a Status: ~15a R
ce50: 75 6e 74 69 6d 65 3a 20 7e 35 40 61 73 20 54 69 untime: ~5@as Ti
ce60: 6d 65 3a 20 7e 32 32 61 20 48 6f 73 74 3a 20 7e me: ~22a Host: ~
ce70: 31 30 61 5c 6e 22 0a 09 09 09 09 09 20 20 28 69 10a\n"...... (i
ce80: 66 20 66 75 6c 6c 6e 61 6d 65 20 66 75 6c 6c 6e f fullname fulln
ce90: 61 6d 65 20 22 22 29 0a 09 09 09 09 09 20 20 28 ame "")...... (
cea0: 69 66 20 74 73 74 61 74 65 20 20 20 74 73 74 61 if tstate tsta
ceb0: 74 65 20 20 20 22 22 29 0a 09 09 09 09 09 20 20 te "")......
cec0: 28 69 66 20 74 73 74 61 74 75 73 20 20 74 73 74 (if tstatus tst
ced0: 61 74 75 73 20 20 22 22 29 0a 09 09 09 09 09 20 atus "")......
cee0: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
cef0: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
cf00: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
cf10: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 3b 3b run_duration");;
cf20: 28 69 66 20 74 65 73 74 20 20 20 20 20 28 64 62 (if test (db
cf30: 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 :test-get-run_du
cf40: 72 61 74 69 6f 6e 20 74 65 73 74 29 20 22 22 29 ration test) "")
cf50: 0a 09 09 09 09 09 20 20 28 69 66 20 65 76 65 6e ...... (if even
cf60: 74 2d 74 69 6d 65 20 65 76 65 6e 74 2d 74 69 6d t-time event-tim
cf70: 65 20 22 22 29 0a 09 09 09 09 09 20 20 28 67 65 e "")...... (ge
cf80: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
cf90: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
cfa0: 69 65 6c 64 2d 69 6e 64 65 78 20 22 68 6f 73 74 ield-index "host
cfb0: 22 29 29 20 3b 3b 28 69 66 20 74 65 73 74 20 28 ")) ;;(if test (
cfc0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 db:test-get-host
cfd0: 20 74 65 73 74 29 29 20 22 22 29 0a 09 09 09 09 test)) "").....
cfe0: 20 20 28 70 72 69 6e 74 20 22 20 20 54 65 73 74 (print " Test
cff0: 3a 20 22 20 66 75 6c 6c 6e 61 6d 65 0a 09 09 09 : " fullname....
d000: 09 09 20 28 69 66 20 74 73 74 61 74 65 20 20 28 .. (if tstate (
d010: 63 6f 6e 63 20 22 20 53 74 61 74 65 3a 20 22 20 conc " State: "
d020: 20 74 73 74 61 74 65 29 20 20 22 22 29 0a 09 09 tstate) "")...
d030: 09 09 09 20 28 69 66 20 74 73 74 61 74 75 73 20 ... (if tstatus
d040: 28 63 6f 6e 63 20 22 20 53 74 61 74 75 73 3a 20 (conc " Status:
d050: 22 20 74 73 74 61 74 75 73 29 20 22 22 29 0a 09 " tstatus) "")..
d060: 09 09 09 09 20 28 69 66 20 28 67 65 74 2d 76 61 .... (if (get-va
d070: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
d080: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
d090: 2d 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 61 -index "run_dura
d0a0: 74 69 6f 6e 22 29 0a 09 09 09 09 09 20 20 20 20 tion")......
d0b0: 20 28 63 6f 6e 63 20 22 20 52 75 6e 74 69 6d 65 (conc " Runtime
d0c0: 3a 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 : " (get-value-b
d0d0: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
d0e0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
d0f0: 78 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 x "run_duration"
d100: 29 29 0a 09 09 09 09 09 20 20 20 20 20 22 22 29 ))...... "")
d110: 0a 09 09 09 09 09 20 28 69 66 20 65 76 65 6e 74 ...... (if event
d120: 2d 74 69 6d 65 20 28 63 6f 6e 63 20 22 20 54 69 -time (conc " Ti
d130: 6d 65 3a 20 22 20 65 76 65 6e 74 2d 74 69 6d 65 me: " event-time
d140: 29 20 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 ) "")...... (if
d150: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
d160: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
d170: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 68 t-field-index "h
d180: 6f 73 74 22 29 0a 09 09 09 09 09 20 20 20 20 20 ost")......
d190: 28 63 6f 6e 63 20 22 20 48 6f 73 74 3a 20 22 20 (conc " Host: "
d1a0: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
d1b0: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
d1c0: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 68 t-field-index "h
d1d0: 6f 73 74 22 29 29 0a 09 09 09 09 09 20 20 20 20 ost"))......
d1e0: 20 22 22 29 29 29 0a 09 09 09 20 20 20 20 20 20 "")))....
d1f0: 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 65 71 (if (not (or (eq
d200: 75 61 6c 3f 20 28 67 65 74 2d 76 61 6c 75 65 2d ual? (get-value-
d210: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
d220: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
d230: 65 78 20 22 73 74 61 74 75 73 22 29 20 22 50 41 ex "status") "PA
d240: 53 53 22 29 0a 09 09 09 09 09 20 20 20 28 65 71 SS")...... (eq
d250: 75 61 6c 3f 20 28 67 65 74 2d 76 61 6c 75 65 2d ual? (get-value-
d260: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
d270: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
d280: 65 78 20 22 73 74 61 74 75 73 22 29 20 22 57 41 ex "status") "WA
d290: 52 4e 22 29 0a 09 09 09 09 09 20 20 20 28 65 71 RN")...... (eq
d2a0: 75 61 6c 3f 20 28 67 65 74 2d 76 61 6c 75 65 2d ual? (get-value-
d2b0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
d2c0: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
d2d0: 65 78 20 22 73 74 61 74 65 22 29 20 20 22 4e 4f ex "state") "NO
d2e0: 54 5f 53 54 41 52 54 45 44 22 29 29 29 0a 09 09 T_STARTED")))...
d2f0: 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 .. (begin.....
d300: 20 20 20 28 70 72 69 6e 74 20 20 20 28 69 66 20 (print (if
d310: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
d320: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
d330: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 63 t-field-index "c
d340: 70 75 6c 6f 61 64 22 29 0a 09 09 09 09 09 09 20 puload").......
d350: 28 63 6f 6e 63 20 22 20 20 20 20 20 20 20 20 20 (conc "
d360: 63 70 75 6c 6f 61 64 3a 20 20 22 20 20 20 28 67 cpuload: " (g
d370: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
d380: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
d390: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 63 70 75 field-index "cpu
d3a0: 6c 6f 61 64 22 29 29 0a 09 09 09 09 09 09 20 22 load"))....... "
d3b0: 22 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 ") ;; (db:test-g
d3c0: 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 73 74 29 et-cpuload test)
d3d0: 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 ...... (if (
d3e0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
d3f0: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
d400: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 64 69 -field-index "di
d410: 73 6b 66 72 65 65 22 29 0a 09 09 09 09 09 09 20 skfree").......
d420: 28 63 6f 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 (conc "\n
d430: 20 20 64 69 73 6b 66 72 65 65 3a 20 22 20 28 67 diskfree: " (g
d440: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
d450: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
d460: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 64 69 73 field-index "dis
d470: 6b 66 72 65 65 22 29 29 20 3b 3b 20 28 64 62 3a kfree")) ;; (db:
d480: 74 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 test-get-diskfre
d490: 65 20 74 65 73 74 29 0a 09 09 09 09 09 09 20 22 e test)....... "
d4a0: 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 ")...... (if
d4b0: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
d4c0: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
d4d0: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
d4e0: 75 6e 61 6d 65 22 29 0a 09 09 09 09 09 09 20 28 uname")....... (
d4f0: 63 6f 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 20 conc "\n
d500: 20 75 6e 61 6d 65 3a 20 20 20 20 22 20 28 67 65 uname: " (ge
d510: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
d520: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
d530: 69 65 6c 64 2d 69 6e 64 65 78 20 22 75 6e 61 6d ield-index "unam
d540: 65 22 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 e")) ;; (db:test
d550: 2d 67 65 74 2d 75 6e 61 6d 65 20 74 65 73 74 29 -get-uname test)
d560: 0a 09 09 09 09 09 09 20 22 22 29 0a 09 09 09 09 ....... "").....
d570: 09 20 20 20 20 20 28 69 66 20 28 67 65 74 2d 76 . (if (get-v
d580: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
d590: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
d5a0: 64 2d 69 6e 64 65 78 20 22 72 75 6e 64 69 72 22 d-index "rundir"
d5b0: 29 0a 09 09 09 09 09 09 20 28 63 6f 6e 63 20 22 )....... (conc "
d5c0: 5c 6e 20 20 20 20 20 20 20 20 20 72 75 6e 64 69 \n rundi
d5d0: 72 3a 20 20 20 22 20 28 67 65 74 2d 76 61 6c 75 r: " (get-valu
d5e0: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
d5f0: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
d600: 6e 64 65 78 20 22 72 75 6e 64 69 72 22 29 29 20 ndex "rundir"))
d610: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
d620: 72 75 6e 64 69 72 20 74 65 73 74 29 0a 09 09 09 rundir test)....
d630: 09 09 09 20 22 22 29 0a 3b 3b 09 09 09 09 09 20 ... "").;;.....
d640: 20 20 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 "\n
d650: 72 75 6e 64 69 72 3a 20 20 20 22 20 28 67 65 74 rundir: " (get
d660: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
d670: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
d680: 65 6c 64 2d 69 6e 64 65 78 20 22 22 29 20 3b 3b eld-index "") ;;
d690: 20 28 73 64 62 3a 71 72 79 20 27 67 65 74 73 74 (sdb:qry 'getst
d6a0: 72 20 3b 3b 20 28 66 69 6c 65 64 62 3a 67 65 74 r ;; (filedb:get
d6b0: 2d 70 61 74 68 20 2a 66 64 62 2a 20 0a 3b 3b 20 -path *fdb* .;;
d6c0: 09 09 09 09 09 20 20 20 20 20 28 64 62 3a 74 65 ..... (db:te
d6d0: 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 st-get-rundir te
d6e0: 73 74 29 20 3b 3b 20 29 0a 09 09 09 09 09 20 20 st) ;; )......
d6f0: 20 20 20 29 0a 09 09 09 09 20 20 20 20 3b 3b 20 )..... ;;
d700: 45 61 63 68 20 74 65 73 74 0a 09 09 09 09 20 20 Each test.....
d710: 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 65 6d 6f ;; DO NOT remo
d720: 74 65 20 72 75 6e 0a 09 09 09 09 20 20 20 20 28 te run..... (
d730: 6c 65 74 20 28 28 73 74 65 70 73 20 28 64 62 3a let ((steps (db:
d740: 64 69 73 70 61 74 63 68 2d 71 75 65 72 79 20 61 dispatch-query a
d750: 63 63 65 73 73 2d 6d 6f 64 65 20 72 6d 74 3a 67 ccess-mode rmt:g
d760: 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 et-steps-for-tes
d770: 74 20 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 t db:get-steps-f
d780: 6f 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 28 or-test run-id (
d790: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 db:test-get-id t
d7a0: 65 73 74 29 29 29 29 20 3b 3b 20 28 64 62 3a 67 est)))) ;; (db:g
d7b0: 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 et-steps-for-tes
d7c0: 74 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 t dbstruct run-i
d7d0: 64 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 d (db:test-get-i
d7e0: 64 20 74 65 73 74 29 29 29 29 0a 09 09 09 09 20 d test)))).....
d7f0: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
d800: 09 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 .... (lamb
d810: 64 61 20 28 73 74 65 70 29 0a 09 09 09 09 09 20 da (step)......
d820: 28 66 6f 72 6d 61 74 20 23 74 20 0a 09 09 09 09 (format #t .....
d830: 09 09 20 22 20 20 20 20 53 74 65 70 3a 20 7e 32 .. " Step: ~2
d840: 30 61 20 53 74 61 74 65 3a 20 7e 31 30 61 20 53 0a State: ~10a S
d850: 74 61 74 75 73 3a 20 7e 31 30 61 20 54 69 6d 65 tatus: ~10a Time
d860: 20 7e 32 32 61 5c 6e 22 0a 09 09 09 09 09 09 20 ~22a\n".......
d870: 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 (tdb:step-get-st
d880: 65 70 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 09 epname step)....
d890: 09 09 09 20 28 74 64 62 3a 73 74 65 70 2d 67 65 ... (tdb:step-ge
d8a0: 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 09 t-state step)...
d8b0: 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 2d 67 .... (tdb:step-g
d8c0: 65 74 2d 73 74 61 74 75 73 20 73 74 65 70 29 0a et-status step).
d8d0: 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 ...... (tdb:step
d8e0: 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -get-event_time
d8f0: 73 74 65 70 29 29 29 0a 09 09 09 09 20 20 20 20 step))).....
d900: 20 20 20 73 74 65 70 73 29 29 29 29 29 29 29 29 steps))))))))
d910: 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 61 )... (if (a
d920: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f rgs:get-arg "-so
d930: 72 74 22 29 0a 09 09 09 20 20 28 73 6f 72 74 20 rt").... (sort
d940: 74 65 73 74 73 0a 09 09 09 09 28 6c 61 6d 62 64 tests.....(lambd
d950: 61 20 28 61 2d 74 65 73 74 20 62 2d 74 65 73 74 a (a-test b-test
d960: 29 0a 09 09 09 09 20 20 28 6c 65 74 2a 20 28 28 )..... (let* ((
d970: 6b 65 79 20 20 20 20 28 61 72 67 73 3a 67 65 74 key (args:get
d980: 2d 61 72 67 20 22 2d 73 6f 72 74 22 29 29 0a 09 -arg "-sort"))..
d990: 09 09 09 09 20 28 66 69 72 73 74 20 20 28 67 65 .... (first (ge
d9a0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
d9b0: 6e 61 6d 65 20 61 2d 74 65 73 74 20 74 65 73 74 name a-test test
d9c0: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 6b 65 79 -field-index key
d9d0: 29 29 0a 09 09 09 09 09 20 28 73 65 63 6f 6e 64 ))...... (second
d9e0: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
d9f0: 69 65 6c 64 6e 61 6d 65 20 62 2d 74 65 73 74 20 ieldname b-test
da00: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
da10: 20 6b 65 79 29 29 29 0a 09 09 09 09 20 20 20 20 key))).....
da20: 28 28 63 6f 6e 64 20 0a 09 09 09 09 20 20 20 20 ((cond .....
da30: 20 20 28 28 61 6e 64 20 28 6e 75 6d 62 65 72 3f ((and (number?
da40: 20 66 69 72 73 74 29 28 6e 75 6d 62 65 72 3f 20 first)(number?
da50: 73 65 63 6f 6e 64 29 29 20 3c 29 0a 09 09 09 09 second)) <).....
da60: 20 20 20 20 20 20 28 28 61 6e 64 20 28 73 74 72 ((and (str
da70: 69 6e 67 3f 20 66 69 72 73 74 29 28 73 74 72 69 ing? first)(stri
da80: 6e 67 3f 20 73 65 63 6f 6e 64 29 29 20 73 74 72 ng? second)) str
da90: 69 6e 67 3c 3d 3f 29 0a 09 09 09 09 20 20 20 20 ing<=?).....
daa0: 20 20 28 65 6c 73 65 20 65 71 75 61 6c 3f 29 29 (else equal?))
dab0: 0a 09 09 09 09 20 20 20 20 20 66 69 72 73 74 20 ..... first
dac0: 73 65 63 6f 6e 64 29 29 29 29 0a 09 09 09 20 20 second))))....
dad0: 74 65 73 74 73 29 29 29 29 29 29 0a 09 20 20 20 tests))))))..
dae0: 72 75 6e 73 29 0a 09 20 20 28 69 66 20 28 65 71 runs).. (if (eq
daf0: 3f 20 64 6d 6f 64 65 20 27 6a 73 6f 6e 29 28 6a ? dmode 'json)(j
db00: 73 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 29 29 son-write data))
db10: 0a 09 20 20 28 6c 65 74 2a 20 28 28 6d 65 74 61 .. (let* ((meta
db20: 64 61 74 2d 66 69 65 6c 64 73 20 28 64 65 6c 65 dat-fields (dele
db30: 74 65 2d 64 75 70 6c 69 63 61 74 65 73 0a 09 09 te-duplicates...
db40: 09 09 20 20 28 61 70 70 65 6e 64 20 6b 65 79 73 .. (append keys
db50: 20 27 28 20 22 72 75 6e 6e 61 6d 65 22 20 22 74 '( "runname" "t
db60: 69 6d 65 22 20 22 6f 77 6e 65 72 22 20 22 70 61 ime" "owner" "pa
db70: 73 73 5f 63 6f 75 6e 74 22 20 22 66 61 69 6c 5f ss_count" "fail_
db80: 63 6f 75 6e 74 22 20 22 73 74 61 74 65 22 20 22 count" "state" "
db90: 73 74 61 74 75 73 22 20 22 63 6f 6d 6d 65 6e 74 status" "comment
dba0: 22 20 22 69 64 22 29 29 29 29 0a 09 09 20 28 72 " "id"))))... (r
dbb0: 75 6e 2d 66 69 65 6c 64 73 20 20 20 20 27 28 0a un-fields '(.
dbc0: 09 09 09 09 20 20 22 74 65 73 74 6e 61 6d 65 22 .... "testname"
dbd0: 0a 09 09 09 09 20 20 22 69 74 65 6d 5f 70 61 74 ..... "item_pat
dbe0: 68 22 0a 09 09 09 09 20 20 22 73 74 61 74 65 22 h"..... "state"
dbf0: 0a 09 09 09 09 20 20 22 73 74 61 74 75 73 22 0a ..... "status".
dc00: 09 09 09 09 20 20 22 63 6f 6d 6d 65 6e 74 22 0a .... "comment".
dc10: 09 09 09 09 20 20 22 65 76 65 6e 74 5f 74 69 6d .... "event_tim
dc20: 65 22 0a 09 09 09 09 20 20 22 68 6f 73 74 22 0a e"..... "host".
dc30: 09 09 09 09 20 20 22 72 75 6e 5f 69 64 22 0a 09 .... "run_id"..
dc40: 09 09 09 20 20 22 72 75 6e 5f 64 75 72 61 74 69 ... "run_durati
dc50: 6f 6e 22 0a 09 09 09 09 20 20 22 61 74 74 65 6d on"..... "attem
dc60: 70 74 6e 75 6d 22 0a 09 09 09 09 20 20 22 69 64 ptnum"..... "id
dc70: 22 0a 09 09 09 09 20 20 22 61 72 63 68 69 76 65 "..... "archive
dc80: 64 22 0a 09 09 09 09 20 20 22 64 69 73 6b 66 72 d"..... "diskfr
dc90: 65 65 22 0a 09 09 09 09 20 20 22 63 70 75 6c 6f ee"..... "cpulo
dca0: 61 64 22 0a 09 09 09 09 20 20 22 66 69 6e 61 6c ad"..... "final
dcb0: 5f 6c 6f 67 66 22 0a 09 09 09 09 20 20 22 73 68 _logf"..... "sh
dcc0: 6f 72 74 64 69 72 22 0a 09 09 09 09 20 20 22 72 ortdir"..... "r
dcd0: 75 6e 64 69 72 22 0a 09 09 09 09 20 20 22 75 6e undir"..... "un
dce0: 61 6d 65 22 0a 09 09 09 09 20 20 29 0a 09 09 09 ame"..... )....
dcf0: 09 29 0a 09 09 20 28 6e 65 77 64 61 74 20 20 20 .)... (newdat
dd00: 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 74 (common:t
dd10: 6f 2d 61 6c 69 73 74 20 64 61 74 61 29 29 0a 09 o-alist data))..
dd20: 09 20 28 61 6c 6c 72 75 6e 64 61 74 20 20 20 20 . (allrundat
dd30: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6e 65 (if (null? ne
dd40: 77 64 61 74 29 0a 09 09 09 09 20 20 20 20 20 20 wdat).....
dd50: 27 28 29 0a 09 09 09 09 20 20 20 20 20 20 28 63 '()..... (c
dd60: 61 72 20 28 6d 61 70 20 63 64 72 20 6e 65 77 64 ar (map cdr newd
dd70: 61 74 29 29 29 29 20 3b 3b 20 28 63 61 72 20 28 at)))) ;; (car (
dd80: 6d 61 70 20 63 64 72 20 28 63 61 72 20 28 6d 61 map cdr (car (ma
dd90: 70 20 63 64 72 20 6e 65 77 64 61 74 29 29 29 29 p cdr newdat))))
dda0: 29 0a 09 09 20 28 72 75 6e 73 20 20 20 20 20 20 )... (runs
ddb0: 20 20 20 20 20 20 28 61 70 70 65 6e 64 0a 09 09 (append...
ddc0: 09 09 20 20 20 28 6c 69 73 74 20 22 72 75 6e 73 .. (list "runs
ddd0: 22 20 3b 3b 20 73 68 65 65 74 6e 61 6d 65 0a 09 " ;; sheetname..
dde0: 09 09 09 09 20 6d 65 74 61 64 61 74 2d 66 69 65 .... metadat-fie
ddf0: 6c 64 73 29 0a 09 09 09 09 20 20 20 28 6d 61 70 lds)..... (map
de00: 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 (lambda (run)..
de10: 09 09 09 09 20 20 3b 3b 20 28 70 72 69 6e 74 20 .... ;; (print
de20: 22 72 75 6e 3a 20 22 20 72 75 6e 29 0a 09 09 09 "run: " run)....
de30: 09 09 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 6e .. (let* ((runn
de40: 61 6d 65 20 28 63 61 72 20 72 75 6e 29 29 0a 09 ame (car run))..
de50: 09 09 09 09 09 20 28 72 75 6e 64 61 74 20 20 28 ..... (rundat (
de60: 63 64 72 20 72 75 6e 29 29 0a 09 09 09 09 09 09 cdr run)).......
de70: 20 28 6d 65 74 61 64 61 74 20 28 6c 65 74 20 28 (metadat (let (
de80: 28 74 6d 70 20 28 61 73 73 6f 63 20 22 6d 65 74 (tmp (assoc "met
de90: 61 22 20 72 75 6e 64 61 74 29 29 29 0a 09 09 09 a" rundat)))....
dea0: 09 09 09 09 20 20 20 20 28 69 66 20 74 6d 70 20 .... (if tmp
deb0: 28 63 64 72 20 74 6d 70 29 20 23 66 29 29 29 29 (cdr tmp) #f))))
dec0: 0a 09 09 09 09 09 20 20 20 20 3b 3b 20 28 70 72 ...... ;; (pr
ded0: 69 6e 74 20 22 72 75 6e 6e 61 6d 65 3a 20 22 20 int "runname: "
dee0: 72 75 6e 6e 61 6d 65 20 22 5c 6e 5c 6e 72 75 6e runname "\n\nrun
def0: 64 61 74 3a 20 22 20 29 28 70 70 20 72 75 6e 64 dat: " )(pp rund
df00: 61 74 29 28 70 72 69 6e 74 20 22 5c 6e 5c 6e 6d at)(print "\n\nm
df10: 65 74 61 64 61 74 3a 20 22 29 28 70 70 20 6d 65 etadat: ")(pp me
df20: 74 61 64 61 74 29 0a 09 09 09 09 09 20 20 20 20 tadat)......
df30: 28 69 66 20 6d 65 74 61 64 61 74 0a 09 09 09 09 (if metadat.....
df40: 09 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 ..(map (lambda (
df50: 66 69 65 6c 64 29 0a 09 09 09 09 09 09 20 20 20 field).......
df60: 20 20 20 20 28 6c 65 74 20 28 28 74 6d 70 20 28 (let ((tmp (
df70: 61 73 73 6f 63 20 66 69 65 6c 64 20 6d 65 74 61 assoc field meta
df80: 64 61 74 29 29 29 0a 09 09 09 09 09 09 09 20 28 dat)))........ (
df90: 69 66 20 74 6d 70 20 28 63 64 72 20 74 6d 70 29 if tmp (cdr tmp)
dfa0: 20 22 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 ""))).......
dfb0: 20 20 6d 65 74 61 64 61 74 2d 66 69 65 6c 64 73 metadat-fields
dfc0: 29 0a 09 09 09 09 09 09 28 62 65 67 69 6e 0a 09 ).......(begin..
dfd0: 09 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 ..... (debug:pr
dfe0: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
dff0: 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e og-port* "WARNIN
e000: 47 3a 20 6d 65 74 61 20 64 61 74 61 20 66 6f 72 G: meta data for
e010: 20 72 75 6e 20 22 20 72 75 6e 6e 61 6d 65 20 22 run " runname "
e020: 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 09 09 09 not found")....
e030: 09 09 09 20 20 27 28 29 29 29 29 29 0a 09 09 09 ... '()))))....
e040: 09 09 61 6c 6c 72 75 6e 64 61 74 29 29 29 0a 09 ..allrundat)))..
e050: 09 20 3b 3b 20 27 28 20 28 20 22 74 61 72 67 65 . ;; '( ( "targe
e060: 74 22 20 28 20 22 72 75 6e 6e 61 6d 65 22 20 28 t" ( "runname" (
e070: 20 22 64 61 74 61 22 20 28 20 22 72 75 6e 69 64 "data" ( "runid
e080: 22 20 28 20 22 69 64 20 2e 20 22 33 37 22 20 29 " ( "id . "37" )
e090: 20 28 20 2e 2e 2e 20 29 29 29 29 0a 09 09 20 28 ( ... ))))... (
e0a0: 72 75 6e 2d 70 61 67 65 73 20 20 20 20 20 20 28 run-pages (
e0b0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 74 61 72 map (lambda (tar
e0c0: 67 64 61 74 29 0a 09 09 09 09 09 28 6c 65 74 2a gdat)......(let*
e0d0: 20 28 28 74 61 72 67 65 74 20 20 28 63 61 72 20 ((target (car
e0e0: 74 61 72 67 64 61 74 29 29 0a 09 09 09 09 09 20 targdat))......
e0f0: 20 20 20 20 20 20 28 72 75 6e 73 64 61 74 20 28 (runsdat (
e100: 63 64 72 20 74 61 72 67 64 61 74 29 29 29 0a 09 cdr targdat)))..
e110: 09 09 09 09 20 20 28 69 66 20 72 75 6e 73 64 61 .... (if runsda
e120: 74 0a 09 09 09 09 09 20 20 20 20 20 20 28 6d 61 t...... (ma
e130: 70 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 64 61 p (lambda (runda
e140: 74 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 6c t)....... (l
e150: 65 74 2a 20 28 28 72 75 6e 6e 61 6d 65 20 20 28 et* ((runname (
e160: 63 61 72 20 72 75 6e 64 61 74 29 29 0a 09 09 09 car rundat))....
e170: 09 09 09 09 20 20 20 20 28 72 75 6e 64 61 74 20 .... (rundat
e180: 20 20 28 63 64 72 20 72 75 6e 64 61 74 29 29 0a (cdr rundat)).
e190: 09 09 09 09 09 09 09 20 20 20 20 28 74 65 73 74 ....... (test
e1a0: 73 64 61 74 20 28 6c 65 74 20 28 28 74 6d 70 20 sdat (let ((tmp
e1b0: 28 61 73 73 6f 63 20 22 64 61 74 61 22 20 72 75 (assoc "data" ru
e1c0: 6e 64 61 74 29 29 29 0a 09 09 09 09 09 09 09 09 ndat))).........
e1d0: 09 28 69 66 20 74 6d 70 20 28 63 64 72 20 74 6d .(if tmp (cdr tm
e1e0: 70 29 20 23 66 29 29 29 29 0a 09 09 09 09 09 09 p) #f)))).......
e1f0: 20 20 20 20 20 20 20 28 69 66 20 74 65 73 74 73 (if tests
e200: 64 61 74 0a 09 09 09 09 09 09 09 20 20 20 28 6c dat........ (l
e210: 65 74 20 28 28 74 65 73 74 73 20 28 6d 61 70 20 et ((tests (map
e220: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 (lambda (test)..
e230: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
e240: 6c 65 74 2a 20 28 28 74 65 73 74 2d 69 64 20 20 let* ((test-id
e250: 28 63 61 72 20 74 65 73 74 29 29 0a 09 09 09 09 (car test)).....
e260: 09 09 09 09 09 09 20 20 20 20 20 20 28 74 65 73 ...... (tes
e270: 74 2d 64 61 74 20 28 63 64 72 20 74 65 73 74 29 t-dat (cdr test)
e280: 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 28 6d ))........... (m
e290: 61 70 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c ap (lambda (fiel
e2a0: 64 29 0a 09 09 09 09 09 09 09 09 09 09 09 28 6c d)............(l
e2b0: 65 74 20 28 28 74 6d 70 20 28 61 73 73 6f 63 20 et ((tmp (assoc
e2c0: 66 69 65 6c 64 20 74 65 73 74 2d 64 61 74 29 29 field test-dat))
e2d0: 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 28 )............ (
e2e0: 69 66 20 74 6d 70 20 28 63 64 72 20 74 6d 70 29 if tmp (cdr tmp)
e2f0: 20 22 22 29 29 29 0a 09 09 09 09 09 09 09 09 09 "")))..........
e300: 09 20 20 20 20 20 20 72 75 6e 2d 66 69 65 6c 64 . run-field
e310: 73 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 s)))..........
e320: 20 20 20 74 65 73 74 73 64 61 74 29 29 29 0a 09 testsdat)))..
e330: 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 28 70 ...... ;; (p
e340: 72 69 6e 74 20 22 54 61 72 67 65 74 3a 20 22 20 rint "Target: "
e350: 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 target "/" runna
e360: 6d 65 20 22 20 74 65 73 74 73 3a 22 29 0a 09 09 me " tests:")...
e370: 09 09 09 09 09 20 20 20 20 20 3b 3b 20 28 70 70 ..... ;; (pp
e380: 20 74 65 73 74 73 29 0a 09 09 09 09 09 09 09 20 tests)........
e390: 20 20 20 20 28 63 6f 6e 73 20 28 63 6f 6e 63 20 (cons (conc
e3a0: 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 target "/" runna
e3b0: 6d 65 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 me)......... (
e3c0: 63 6f 6e 73 20 28 6c 69 73 74 20 28 63 6f 6e 63 cons (list (conc
e3d0: 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e target "/" runn
e3e0: 61 6d 65 29 29 0a 09 09 09 09 09 09 09 09 09 20 ame))..........
e3f0: 28 63 6f 6e 73 20 27 28 29 0a 09 09 09 09 09 09 (cons '().......
e400: 09 09 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 ... (cons
e410: 72 75 6e 2d 66 69 65 6c 64 73 20 74 65 73 74 73 run-fields tests
e420: 29 29 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 )))))........
e430: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 20 20 (begin........
e440: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
e450: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
e460: 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 72 ort* "WARNING: r
e470: 75 6e 20 22 20 74 61 72 67 65 74 20 22 2f 22 20 un " target "/"
e480: 72 75 6e 6e 61 6d 65 20 22 20 61 70 70 65 61 72 runname " appear
e490: 73 20 74 6f 20 68 61 76 65 20 6e 6f 20 64 61 74 s to have no dat
e4a0: 61 22 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 a")........
e4b0: 3b 3b 20 28 70 70 20 72 75 6e 64 61 74 29 0a 09 ;; (pp rundat)..
e4c0: 09 09 09 09 09 09 20 20 20 20 20 27 28 29 29 29 ...... '()))
e4d0: 29 29 0a 09 09 09 09 09 09 20 20 20 72 75 6e 73 ))....... runs
e4e0: 64 61 74 29 0a 09 09 09 09 09 20 20 20 20 20 20 dat)......
e4f0: 27 28 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 '()))).....
e500: 20 6e 65 77 64 61 74 29 29 20 3b 3b 20 77 65 20 newdat)) ;; we
e510: 75 73 65 20 6e 65 77 64 61 74 20 74 6f 20 67 65 use newdat to ge
e520: 74 20 74 61 72 67 65 74 0a 09 09 20 28 73 68 65 t target... (she
e530: 65 74 73 20 20 20 20 20 20 20 20 20 28 66 69 6c ets (fil
e540: 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 0a ter (lambda (x).
e550: 09 09 09 09 09 20 20 20 28 6e 6f 74 20 28 6e 75 ..... (not (nu
e560: 6c 6c 3f 20 78 29 29 29 0a 09 09 09 09 09 20 28 ll? x)))...... (
e570: 63 6f 6e 73 20 72 75 6e 73 20 28 6d 61 70 20 63 cons runs (map c
e580: 61 72 20 72 75 6e 2d 70 61 67 65 73 29 29 29 29 ar run-pages))))
e590: 29 0a 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 ).. ;; (print
e5a0: 20 22 61 6c 6c 72 75 6e 64 61 74 3a 22 29 0a 09 "allrundat:")..
e5b0: 20 20 20 20 3b 3b 20 28 70 70 20 61 6c 6c 72 75 ;; (pp allru
e5c0: 6e 64 61 74 29 0a 09 20 20 20 20 3b 3b 20 28 70 ndat).. ;; (p
e5d0: 72 69 6e 74 20 22 72 75 6e 73 3a 22 29 0a 09 20 rint "runs:")..
e5e0: 20 20 20 3b 3b 20 28 70 70 20 72 75 6e 73 29 0a ;; (pp runs).
e5f0: 09 20 20 20 20 3b 28 70 72 69 6e 74 20 22 73 68 . ;(print "sh
e600: 65 65 74 73 3a 20 22 29 0a 09 20 20 20 20 3b 3b eets: ").. ;;
e610: 20 28 70 70 20 73 68 65 65 74 73 29 0a 09 20 20 (pp sheets)..
e620: 20 20 28 69 66 20 28 65 71 3f 20 64 6d 6f 64 65 (if (eq? dmode
e630: 20 27 6f 64 73 29 0a 09 09 28 6c 65 74 2a 20 28 'ods)...(let* (
e640: 28 74 65 6d 70 64 69 72 20 20 20 20 28 63 6f 6e (tempdir (con
e650: 63 20 22 2f 74 6d 70 2f 22 20 28 63 75 72 72 65 c "/tmp/" (curre
e660: 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 29 20 22 2f nt-user-name) "/
e670: 22 20 28 72 61 6e 64 6f 6d 20 31 30 30 30 30 29 " (random 10000)
e680: 20 22 5f 22 20 28 63 75 72 72 65 6e 74 2d 70 72 "_" (current-pr
e690: 6f 63 65 73 73 2d 69 64 29 29 29 0a 09 09 20 20 ocess-id)))...
e6a0: 20 20 20 20 20 28 6f 75 74 70 75 74 66 69 6c 65 (outputfile
e6b0: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
e6c0: 72 67 20 22 2d 6f 22 29 20 22 6f 75 74 2e 6f 64 rg "-o") "out.od
e6d0: 73 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 6f s"))... (o
e6e0: 75 66 20 20 20 20 20 20 20 20 28 69 66 20 28 73 uf (if (s
e6f0: 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 tring-match (reg
e700: 65 78 70 20 22 5e 5b 2f 7e 5d 2b 2e 2a 22 29 20 exp "^[/~]+.*")
e710: 6f 75 74 70 75 74 66 69 6c 65 29 20 3b 3b 20 66 outputfile) ;; f
e720: 75 6c 6c 20 70 61 74 68 3f 0a 09 09 09 09 20 20 ull path?.....
e730: 20 20 20 20 20 6f 75 74 70 75 74 66 69 6c 65 0a outputfile.
e740: 09 09 09 09 20 20 20 20 20 20 20 28 62 65 67 69 .... (begi
e750: 6e 0a 09 09 09 09 09 20 28 64 65 62 75 67 3a 70 n...... (debug:p
e760: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
e770: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
e780: 4e 47 3a 20 70 61 74 68 20 67 69 76 65 6e 2c 20 NG: path given,
e790: 22 20 6f 75 74 70 75 74 66 69 6c 65 20 22 20 69 " outputfile " i
e7a0: 73 20 72 65 6c 61 74 69 76 65 2c 20 70 72 65 66 s relative, pref
e7b0: 69 78 69 6e 67 20 77 69 74 68 20 63 75 72 72 65 ixing with curre
e7c0: 6e 74 20 64 69 72 65 63 74 6f 72 79 22 29 0a 09 nt directory")..
e7d0: 09 09 09 09 20 28 63 6f 6e 63 20 28 63 75 72 72 .... (conc (curr
e7e0: 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 20 22 ent-directory) "
e7f0: 2f 22 20 6f 75 74 70 75 74 66 69 6c 65 29 29 29 /" outputfile)))
e800: 29 29 0a 09 09 20 20 28 63 72 65 61 74 65 2d 64 ))... (create-d
e810: 69 72 65 63 74 6f 72 79 20 74 65 6d 70 64 69 72 irectory tempdir
e820: 20 23 74 29 0a 09 09 20 20 28 6f 64 73 3a 6c 69 #t)... (ods:li
e830: 73 74 2d 3e 6f 64 73 20 74 65 6d 70 64 69 72 20 st->ods tempdir
e840: 6f 75 66 20 73 68 65 65 74 73 29 29 29 29 0a 09 ouf sheets))))..
e850: 20 20 3b 3b 20 28 73 79 73 74 65 6d 20 28 63 6f ;; (system (co
e860: 6e 63 20 22 72 6d 20 2d 72 66 20 22 20 74 65 6d nc "rm -rf " tem
e870: 70 64 69 72 29 29 0a 09 20 20 28 73 65 74 21 20 pdir)).. (set!
e880: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
e890: 74 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 t). (se
e8a0: 74 21 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 t! *time-to-exit
e8b0: 2a 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 20 * #t).
e8c0: 29 20 3b 3b 20 65 6e 64 20 69 66 20 74 72 75 65 ) ;; end if true
e8d0: 20 62 72 61 6e 63 68 20 28 65 6e 64 20 6f 66 20 branch (end of
e8e0: 61 20 6c 65 74 29 0a 20 20 20 20 20 20 20 20 29 a let). )
e8f0: 20 3b 3b 20 65 6e 64 20 69 66 0a 20 20 20 20 29 ;; end if. )
e900: 20 3b 3b 20 65 6e 64 20 69 66 20 2d 6c 69 73 74 ;; end if -list
e910: 2d 72 75 6e 73 0a 0a 3b 3b 20 44 6f 6e 27 74 20 -runs..;; Don't
e920: 74 68 69 6e 6b 20 49 20 6e 65 65 64 20 74 68 69 think I need thi
e930: 73 2e 20 49 6e 63 6f 72 70 6f 72 61 74 65 64 20 s. Incorporated
e940: 69 6e 74 6f 20 2d 6c 69 73 74 2d 72 75 6e 73 20 into -list-runs
e950: 69 6e 73 74 65 61 64 0a 3b 3b 0a 3b 3b 20 28 69 instead.;;.;; (i
e960: 66 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 f (and (args:get
e970: 2d 61 72 67 20 22 2d 73 69 6e 63 65 22 29 0a 3b -arg "-since").;
e980: 3b 20 09 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 ; . (launch:setu
e990: 70 29 29 0a 3b 3b 20 20 20 20 20 28 6c 65 74 2a p)).;; (let*
e9a0: 20 28 28 73 69 6e 63 65 2d 74 69 6d 65 20 28 73 ((since-time (s
e9b0: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 tring->number (a
e9c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 rgs:get-arg "-si
e9d0: 6e 63 65 22 29 29 29 0a 3b 3b 20 09 20 20 20 28 nce"))).;; . (
e9e0: 72 75 6e 2d 69 64 73 20 20 20 20 28 64 62 3a 67 run-ids (db:g
e9f0: 65 74 2d 63 68 61 6e 67 65 64 2d 72 75 6e 2d 69 et-changed-run-i
ea00: 64 73 20 73 69 6e 63 65 2d 74 69 6d 65 29 29 29 ds since-time)))
ea10: 0a 3b 3b 20 20 20 20 20 20 20 3b 3b 20 28 72 6d .;; ;; (rm
ea20: 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d t:get-tests-for-
ea30: 72 75 6e 73 2d 6d 69 6e 64 61 74 61 20 72 75 6e runs-mindata run
ea40: 2d 69 64 73 20 74 65 73 74 70 61 74 74 20 73 74 -ids testpatt st
ea50: 61 74 65 73 20 73 74 61 74 75 73 20 6e 6f 74 2d ates status not-
ea60: 69 6e 29 0a 3b 3b 20 20 20 20 20 20 20 28 70 72 in).;; (pr
ea70: 69 6e 74 20 28 73 6f 72 74 20 72 75 6e 2d 69 64 int (sort run-id
ea80: 73 20 3c 29 29 0a 3b 3b 20 20 20 20 20 20 20 28 s <)).;; (
ea90: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
eaa0: 6e 67 2a 20 23 74 29 29 29 0a 20 20 20 20 20 20 ng* #t))).
eab0: 0a 20 20 20 20 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d . .;;======
eac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ead0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eaf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb00: 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e 0a 3b 3b 3d .;; full run.;;=
eb10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb50: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 20 6c 6f =====..;; get lo
eb60: 63 6b 20 69 6e 20 64 62 20 66 6f 72 20 66 75 6c ck in db for ful
eb70: 6c 20 72 75 6e 20 66 6f 72 20 74 68 69 73 20 64 l run for this d
eb80: 69 72 65 63 74 6f 72 79 0a 3b 3b 20 66 6f 72 20 irectory.;; for
eb90: 61 6c 6c 20 74 65 73 74 73 20 77 69 74 68 20 64 all tests with d
eba0: 65 70 73 0a 3b 3b 20 20 20 77 61 6c 6b 20 74 72 eps.;; walk tr
ebb0: 65 65 20 6f 66 20 74 65 73 74 73 20 74 6f 20 66 ee of tests to f
ebc0: 69 6e 64 20 68 65 61 64 20 74 61 73 6b 73 0a 3b ind head tasks.;
ebd0: 3b 20 20 20 61 64 64 20 68 65 61 64 20 74 61 73 ; add head tas
ebe0: 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 ks to task queue
ebf0: 0a 3b 3b 20 20 20 61 64 64 20 64 65 70 65 6e 64 .;; add depend
ec00: 61 6e 74 20 74 61 73 6b 73 20 74 6f 20 74 61 73 ant tasks to tas
ec10: 6b 20 71 75 65 75 65 20 0a 3b 3b 20 20 20 61 64 k queue .;; ad
ec20: 64 20 72 65 6d 61 69 6e 69 6e 67 20 74 61 73 6b d remaining task
ec30: 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 0a s to task queue.
ec40: 3b 3b 20 66 6f 72 20 65 61 63 68 20 74 61 73 6b ;; for each task
ec50: 20 69 6e 20 74 61 73 6b 20 71 75 65 75 65 0a 3b in task queue.;
ec60: 3b 20 20 20 69 66 20 68 61 76 65 20 61 64 65 71 ; if have adeq
ec70: 75 61 74 65 20 72 65 73 6f 75 72 63 65 73 0a 3b uate resources.;
ec80: 3b 20 20 20 20 20 6c 61 75 6e 63 68 20 74 61 73 ; launch tas
ec90: 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b 20 20 k.;; else.;;
eca0: 20 20 20 70 75 74 20 74 61 73 6b 20 69 6e 20 64 put task in d
ecb0: 65 66 65 72 72 65 64 20 71 75 65 75 65 0a 3b 3b eferred queue.;;
ecc0: 20 69 66 20 73 74 69 6c 6c 20 6f 6b 20 74 6f 20 if still ok to
ecd0: 72 75 6e 20 74 61 73 6b 73 0a 3b 3b 20 20 20 70 run tasks.;; p
ece0: 72 6f 63 65 73 73 20 64 65 66 65 72 72 65 64 20 rocess deferred
ecf0: 74 61 73 6b 73 20 70 65 72 20 61 62 6f 76 65 20 tasks per above
ed00: 73 74 65 70 73 0a 0a 3b 3b 20 72 75 6e 20 61 6c steps..;; run al
ed10: 6c 20 74 65 73 74 73 20 61 72 65 20 61 72 65 20 l tests are are
ed20: 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e Not COMPLETED an
ed30: 64 20 50 41 53 53 20 6f 72 20 43 48 45 43 4b 0a d PASS or CHECK.
ed40: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
ed50: 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 t-arg "-runall")
ed60: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
ed70: 22 2d 72 75 6e 22 29 0a 09 28 61 72 67 73 3a 67 "-run")..(args:g
ed80: 65 74 2d 61 72 67 20 22 2d 72 65 72 75 6e 2d 63 et-arg "-rerun-c
ed90: 6c 65 61 6e 22 29 0a 09 28 61 72 67 73 3a 67 65 lean")..(args:ge
eda0: 74 2d 61 72 67 20 22 2d 72 65 72 75 6e 2d 61 6c t-arg "-rerun-al
edb0: 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 l")..(args:get-a
edc0: 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 29 rg "-runtests"))
edd0: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
ede0: 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 n-call . "-r
edf0: 75 6e 61 6c 6c 22 0a 20 20 20 20 20 22 72 75 6e unall". "run
ee00: 20 61 6c 6c 20 74 65 73 74 73 22 0a 20 20 20 20 all tests".
ee10: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
ee20: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
ee30: 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 69 yvals). (i
ee40: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
ee50: 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 22 29 20 "-rerun-clean")
ee60: 3b 3b 20 66 69 72 73 74 20 73 65 74 20 73 74 61 ;; first set sta
ee70: 74 65 73 2f 73 74 61 74 75 73 65 73 20 63 6f 72 tes/statuses cor
ee80: 72 65 63 74 0a 09 20 20 20 28 6c 65 74 20 28 28 rect.. (let ((
ee90: 73 74 61 74 65 73 20 20 20 28 6f 72 20 28 63 6f states (or (co
eea0: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f nfigf:lookup *co
eeb0: 6e 66 69 67 64 61 74 2a 20 22 76 61 6c 69 64 76 nfigdat* "validv
eec0: 61 6c 75 65 73 22 20 22 63 6c 65 61 6e 72 65 72 alues" "cleanrer
eed0: 75 6e 2d 73 74 61 74 65 73 22 29 0a 09 09 09 20 un-states")....
eee0: 20 20 20 20 20 20 22 4b 49 4c 4c 52 45 51 2c 4b "KILLREQ,K
eef0: 49 4c 4c 45 44 2c 55 4e 4b 4e 4f 57 4e 2c 49 4e ILLED,UNKNOWN,IN
ef00: 43 4f 4d 50 4c 45 54 45 2c 53 54 55 43 4b 2c 4e COMPLETE,STUCK,N
ef10: 4f 54 5f 53 54 41 52 54 45 44 22 29 29 0a 09 09 OT_STARTED"))...
ef20: 20 28 73 74 61 74 75 73 65 73 20 28 6f 72 20 28 (statuses (or (
ef30: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a configf:lookup *
ef40: 63 6f 6e 66 69 67 64 61 74 2a 20 22 76 61 6c 69 configdat* "vali
ef50: 64 76 61 6c 75 65 73 22 20 22 63 6c 65 61 6e 72 dvalues" "cleanr
ef60: 65 72 75 6e 2d 73 74 61 74 75 73 65 73 22 29 0a erun-statuses").
ef70: 09 09 09 20 20 20 20 20 20 20 22 46 41 49 4c 2c ... "FAIL,
ef80: 49 4e 43 4f 4d 50 4c 45 54 45 2c 41 42 4f 52 54 INCOMPLETE,ABORT
ef90: 2c 43 48 45 43 4b 22 29 29 29 0a 09 20 20 20 20 ,CHECK")))..
efa0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
efb0: 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 ! args:arg-hash
efc0: 22 2d 70 72 65 63 6c 65 61 6e 22 20 23 74 29 0a "-preclean" #t).
efd0: 09 20 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 . (runs:oper
efe0: 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 ate-on 'set-stat
eff0: 65 2d 73 74 61 74 75 73 0a 09 09 09 20 20 20 20 e-status....
f000: 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 target....
f010: 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 (common:args-g
f020: 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 et-runname) ;;
f030: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
f040: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 g "-runname")(ar
f050: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
f060: 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 name"))....
f070: 20 22 25 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a "%" ;; (common:
f080: 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 args-get-testpat
f090: 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 t #f) ;; (args:g
f0a0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
f0b0: 74 22 29 0a 09 09 09 20 20 20 20 20 20 73 74 61 t").... sta
f0c0: 74 65 3a 20 20 73 74 61 74 65 73 0a 09 09 09 20 te: states....
f0d0: 20 20 20 20 20 3b 3b 20 73 74 61 74 75 73 3a 20 ;; status:
f0e0: 73 74 61 74 75 73 65 73 0a 09 09 09 20 20 20 20 statuses....
f0f0: 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 new-state-stat
f100: 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 us: "NOT_STARTED
f110: 2c 6e 2f 61 22 29 0a 09 20 20 20 20 20 28 72 75 ,n/a").. (ru
f120: 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 ns:operate-on 's
f130: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a et-state-status.
f140: 09 09 09 20 20 20 20 20 20 74 61 72 67 65 74 0a ... target.
f150: 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e ... (common
f160: 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d :args-get-runnam
f170: 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 e) ;; (or (args
f180: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 :get-arg "-runna
f190: 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 me")(args:get-ar
f1a0: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g ":runname"))..
f1b0: 09 09 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 .. "%" ;; (
f1c0: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
f1d0: 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 testpatt #f) ;;
f1e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
f1f0: 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 testpatt")....
f200: 20 20 20 20 3b 3b 20 73 74 61 74 65 3a 20 20 73 ;; state: s
f210: 74 61 74 65 73 0a 09 09 09 20 20 20 20 20 20 73 tates.... s
f220: 74 61 74 75 73 3a 20 73 74 61 74 75 73 65 73 0a tatus: statuses.
f230: 09 09 09 20 20 20 20 20 20 6e 65 77 2d 73 74 61 ... new-sta
f240: 74 65 2d 73 74 61 74 75 73 3a 20 22 4e 4f 54 5f te-status: "NOT_
f250: 53 54 41 52 54 45 44 2c 6e 2f 61 22 29 29 29 0a STARTED,n/a"))).
f260: 20 20 20 20 20 20 20 3b 3b 20 52 45 52 55 4e 20 ;; RERUN
f270: 41 4c 4c 0a 20 20 20 20 20 20 20 28 69 66 20 28 ALL. (if (
f280: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
f290: 65 72 75 6e 2d 61 6c 6c 22 29 20 3b 3b 20 66 69 erun-all") ;; fi
f2a0: 72 73 74 20 73 65 74 20 73 74 61 74 65 73 2f 73 rst set states/s
f2b0: 74 61 74 75 73 65 73 20 63 6f 72 72 65 63 74 0a tatuses correct.
f2c0: 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 . (begin..
f2d0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
f2e0: 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 ! args:arg-hash
f2f0: 22 2d 70 72 65 63 6c 65 61 6e 22 20 23 74 29 0a "-preclean" #t).
f300: 09 20 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 . (runs:oper
f310: 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 ate-on 'set-stat
f320: 65 2d 73 74 61 74 75 73 0a 09 09 09 20 20 20 20 e-status....
f330: 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 target....
f340: 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 (common:args-g
f350: 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 et-runname) ;;
f360: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
f370: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 g "-runname")(ar
f380: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
f390: 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 name"))....
f3a0: 20 22 25 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a "%" ;; (common:
f3b0: 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 args-get-testpat
f3c0: 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 t #f) ;; (args:g
f3d0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
f3e0: 74 22 29 0a 09 09 09 20 20 20 20 20 20 73 74 61 t").... sta
f3f0: 74 65 3a 20 20 23 66 0a 09 09 09 20 20 20 20 20 te: #f....
f400: 20 3b 3b 20 73 74 61 74 75 73 3a 20 73 74 61 74 ;; status: stat
f410: 75 73 65 73 0a 09 09 09 20 20 20 20 20 20 6e 65 uses.... ne
f420: 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a 20 w-state-status:
f430: 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 "NOT_STARTED,n/a
f440: 22 29 0a 09 20 20 20 20 20 28 72 75 6e 73 3a 6f ").. (runs:o
f450: 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 perate-on 'set-s
f460: 74 61 74 65 2d 73 74 61 74 75 73 0a 09 09 09 20 tate-status....
f470: 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 20 target....
f480: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 (common:arg
f490: 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 s-get-runname)
f4a0: 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 ;; (or (args:get
f4b0: 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 -arg "-runname")
f4c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
f4d0: 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 runname"))....
f4e0: 20 20 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d 6d "%" ;; (comm
f4f0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
f500: 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 patt #f) ;; (arg
f510: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
f520: 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 20 patt")....
f530: 3b 3b 20 73 74 61 74 65 3a 20 20 73 74 61 74 65 ;; state: state
f540: 73 0a 09 09 09 20 20 20 20 20 20 73 74 61 74 75 s.... statu
f550: 73 3a 20 23 66 0a 09 09 09 20 20 20 20 20 20 6e s: #f.... n
f560: 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a ew-state-status:
f570: 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f "NOT_STARTED,n/
f580: 61 22 29 29 29 0a 20 20 20 20 20 20 20 28 72 75 a"))). (ru
f590: 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 72 ns:run-tests tar
f5a0: 67 65 74 0a 09 09 20 20 20 20 20 20 20 72 75 6e get... run
f5b0: 6e 61 6d 65 0a 09 09 20 20 20 20 20 20 20 23 66 name... #f
f5c0: 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 ;; (common:args
f5d0: 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 -get-testpatt #f
f5e0: 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 28 6f )... ;; (o
f5f0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
f600: 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 20 "-testpatt")...
f610: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 22 25 22 ;; "%"
f620: 29 0a 09 09 20 20 20 20 20 20 20 75 73 65 72 0a )... user.
f630: 09 09 20 20 20 20 20 20 20 61 72 67 73 3a 61 72 .. args:ar
f640: 67 2d 68 61 73 68 29 29 29 29 0a 0a 3b 3b 3d 3d g-hash))))..;;==
f650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f690: 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e 20 6f 6e 65 20 ====.;; run one
f6a0: 74 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d test.;;=========
f6b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f6c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f6d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f6e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
f6f0: 3b 20 31 2e 20 66 69 6e 64 20 74 68 65 20 63 6f ; 1. find the co
f700: 6e 66 69 67 20 66 69 6c 65 0a 3b 3b 20 32 2e 20 nfig file.;; 2.
f710: 63 68 61 6e 67 65 20 74 6f 20 74 68 65 20 74 65 change to the te
f720: 73 74 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 st directory.;;
f730: 33 2e 20 75 70 64 61 74 65 20 74 68 65 20 64 62 3. update the db
f740: 20 77 69 74 68 20 22 74 65 73 74 20 73 74 61 72 with "test star
f750: 74 65 64 22 20 73 74 61 74 75 73 2c 20 73 65 74 ted" status, set
f760: 20 72 75 6e 6e 69 6e 67 20 68 6f 73 74 0a 3b 3b running host.;;
f770: 20 34 2e 20 70 72 6f 63 65 73 73 20 6c 61 75 6e 4. process laun
f780: 63 68 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 ch the test.;;
f790: 20 20 2d 20 6d 6f 6e 69 74 6f 72 20 74 68 65 20 - monitor the
f7a0: 70 72 6f 63 65 73 73 2c 20 75 70 64 61 74 65 20 process, update
f7b0: 73 74 61 74 73 20 69 6e 20 74 68 65 20 64 62 20 stats in the db
f7c0: 65 76 65 72 79 20 32 5e 6e 20 6d 69 6e 75 74 65 every 2^n minute
f7d0: 73 0a 3b 3b 20 35 2e 20 61 73 20 74 68 65 20 74 s.;; 5. as the t
f7e0: 65 73 74 20 70 72 6f 63 65 65 64 73 20 69 6e 74 est proceeds int
f7f0: 65 72 6e 61 6c 6c 79 20 69 74 20 63 61 6c 6c 73 ernally it calls
f800: 20 6d 65 67 61 74 65 73 74 20 61 73 20 65 61 63 megatest as eac
f810: 68 20 73 74 65 70 20 69 73 0a 3b 3b 20 20 20 20 h step is.;;
f820: 73 74 61 72 74 65 64 20 61 6e 64 20 63 6f 6d 70 started and comp
f830: 6c 65 74 65 64 0a 3b 3b 20 20 20 20 2d 20 73 74 leted.;; - st
f840: 65 70 20 73 74 61 72 74 65 64 2c 20 74 69 6d 65 ep started, time
f850: 73 74 61 6d 70 0a 3b 3b 20 20 20 20 2d 20 73 74 stamp.;; - st
f860: 65 70 20 63 6f 6d 70 6c 65 74 65 64 2c 20 65 78 ep completed, ex
f870: 69 74 20 73 74 61 74 75 73 2c 20 74 69 6d 65 73 it status, times
f880: 74 61 6d 70 0a 3b 3b 20 36 2e 20 74 65 73 74 20 tamp.;; 6. test
f890: 70 68 6f 6e 65 20 68 6f 6d 65 0a 3b 3b 20 20 20 phone home.;;
f8a0: 20 2d 20 69 66 20 74 65 73 74 20 72 75 6e 20 74 - if test run t
f8b0: 69 6d 65 20 3e 20 61 6c 6c 6f 77 65 64 20 72 75 ime > allowed ru
f8c0: 6e 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c n time then kill
f8d0: 20 6a 6f 62 0a 3b 3b 20 20 20 20 2d 20 69 66 20 job.;; - if
f8e0: 63 61 6e 6e 6f 74 20 61 63 63 65 73 73 20 64 62 cannot access db
f8f0: 20 3e 20 61 6c 6c 6f 77 65 64 20 64 69 73 63 6f > allowed disco
f900: 6e 6e 65 63 74 20 74 69 6d 65 20 74 68 65 6e 20 nnect time then
f910: 6b 69 6c 6c 20 6a 6f 62 0a 0a 3b 3b 20 3d 3d 20 kill job..;; ==
f920: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 28 69 duplicated == (i
f930: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
f940: 61 72 67 20 22 2d 72 75 6e 22 29 28 61 72 67 73 arg "-run")(args
f950: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
f960: 73 74 73 22 29 29 0a 3b 3b 20 3d 3d 20 64 75 70 sts")).;; == dup
f970: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 28 67 65 licated == (ge
f980: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
f990: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f9a0: 20 3d 3d 20 20 20 20 22 2d 72 75 6e 74 65 73 74 == "-runtest
f9b0: 73 22 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 s" .;; == duplic
f9c0: 61 74 65 64 20 3d 3d 20 20 20 20 22 72 75 6e 20 ated == "run
f9d0: 61 20 74 65 73 74 22 20 0a 3b 3b 20 3d 3d 20 64 a test" .;; == d
f9e0: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
f9f0: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
fa00: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
fa10: 76 61 6c 73 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c vals).;; == dupl
fa20: 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b icated == ;
fa30: 3b 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 ;.;; == duplicat
fa40: 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 4d 61 ed == ;; Ma
fa50: 79 20 6f 72 20 6d 61 79 20 6e 6f 74 20 69 6d 70 y or may not imp
fa60: 6c 65 6d 65 6e 74 20 69 74 20 74 68 69 73 20 77 lement it this w
fa70: 61 79 20 2e 2e 2e 0a 3b 3b 20 3d 3d 20 64 75 70 ay ....;; == dup
fa80: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 licated ==
fa90: 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 ;;.;; == duplica
faa0: 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 49 ted == ;; I
fab0: 6e 73 65 72 74 20 74 68 69 73 20 72 75 6e 20 69 nsert this run i
fac0: 6e 74 6f 20 74 68 65 20 74 61 73 6b 73 20 71 75 nto the tasks qu
fad0: 65 75 65 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 eue.;; == duplic
fae0: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 ated == ;;
faf0: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
fb00: 74 61 73 6b 73 3a 61 64 64 20 74 61 73 6b 73 3a tasks:add tasks:
fb10: 6f 70 65 6e 2d 64 62 20 0a 3b 3b 20 3d 3d 20 64 open-db .;; == d
fb20: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
fb30: 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 22 72 ;; . "r
fb40: 75 6e 74 65 73 74 73 22 20 0a 3b 3b 20 3d 3d 20 untests" .;; ==
fb50: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
fb60: 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 75 ;; . u
fb70: 73 65 72 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 ser.;; == duplic
fb80: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 ated == ;;
fb90: 20 20 20 09 20 20 20 20 20 74 61 72 67 65 74 0a . target.
fba0: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
fbb0: 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 == ;; .
fbc0: 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a 3b 3b 20 runname.;;
fbd0: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
fbe0: 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 ;; .
fbf0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
fc00: 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 3b 3b 20 "-runtests").;;
fc10: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
fc20: 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 ;; .
fc30: 20 20 23 66 29 29 29 29 0a 3b 3b 20 3d 3d 20 64 #f)))).;; == d
fc40: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
fc50: 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 (runs:run-test
fc60: 73 20 74 61 72 67 65 74 0a 3b 3b 20 3d 3d 20 64 s target.;; == d
fc70: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 20 uplicated == ..
fc80: 20 20 20 20 72 75 6e 6e 61 6d 65 0a 3b 3b 20 3d runname.;; =
fc90: 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
fca0: 09 09 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 .. (common:a
fcb0: 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 rgs-get-testpatt
fcc0: 20 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 #f) ;; (args:ge
fcd0: 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 t-arg "-runtests
fce0: 22 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 ").;; == duplica
fcf0: 74 65 64 20 3d 3d 20 09 09 20 20 20 20 20 75 73 ted == .. us
fd00: 65 72 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 er.;; == duplica
fd10: 74 65 64 20 3d 3d 20 09 09 20 20 20 20 20 61 72 ted == .. ar
fd20: 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 29 0a gs:arg-hash)))).
fd30: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
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 0a 3b 3b 20 52 6f 6c =========.;; Rol
fd80: 6c 75 70 20 69 6e 74 6f 20 61 20 72 75 6e 0a 3b lup into a run.;
fd90: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
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 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
fde0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 6f 6c gs:get-arg "-rol
fdf0: 6c 75 70 22 29 0a 20 20 20 20 28 67 65 6e 65 72 lup"). (gener
fe00: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 al-run-call .
fe10: 20 20 22 2d 72 6f 6c 6c 75 70 22 20 0a 20 20 20 "-rollup" .
fe20: 20 20 22 72 6f 6c 6c 75 70 20 74 65 73 74 73 22 "rollup tests"
fe30: 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
fe40: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
fe50: 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 eys keyvals).
fe60: 20 20 20 20 28 72 75 6e 73 3a 72 6f 6c 6c 75 70 (runs:rollup
fe70: 2d 72 75 6e 20 6b 65 79 73 0a 09 09 09 6b 65 79 -run keys....key
fe80: 76 61 6c 73 0a 09 09 09 28 6f 72 20 28 61 72 67 vals....(or (arg
fe90: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
fea0: 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 ame")(args:get-a
feb0: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 29 rg ":runname") )
fec0: 0a 09 09 09 75 73 65 72 29 29 29 29 0a 0a 3b 3b ....user))))..;;
fed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ff00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ff10: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 6f 63 6b 20 6f ======.;; Lock o
ff20: 72 20 75 6e 6c 6f 63 6b 20 61 20 72 75 6e 0a 3b r unlock a run.;
ff30: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
ff40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ff50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ff60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ff70: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 =======..(if (or
ff80: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
ff90: 2d 6c 6f 63 6b 22 29 28 61 72 67 73 3a 67 65 74 -lock")(args:get
ffa0: 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b 22 29 29 -arg "-unlock"))
ffb0: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
ffc0: 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 28 69 66 n-call . (if
ffd0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
ffe0: 2d 6c 6f 63 6b 22 29 20 22 2d 6c 6f 63 6b 22 20 -lock") "-lock"
fff0: 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 20 20 20 20 "-unlock").
10000 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 20 74 65 73 "lock/unlock tes
10010 74 73 22 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 ts" . (lambd
10020 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
10030 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a e keys keyvals).
10040 20 20 20 20 20 20 20 28 72 75 6e 73 3a 68 61 6e (runs:han
10050 64 6c 65 2d 6c 6f 63 6b 69 6e 67 20 0a 09 09 20 dle-locking ...
10060 20 74 61 72 67 65 74 0a 09 09 20 20 6b 65 79 73 target... keys
10070 0a 09 09 20 20 28 6f 72 20 28 61 72 67 73 3a 67 ... (or (args:g
10080 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 et-arg "-runname
10090 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
100a0 22 3a 72 75 6e 6e 61 6d 65 22 29 20 29 0a 09 09 ":runname") )...
100b0 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
100c0 22 2d 6c 6f 63 6b 22 29 0a 09 09 20 20 28 61 72 "-lock")... (ar
100d0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c gs:get-arg "-unl
100e0 6f 63 6b 22 29 0a 09 09 20 20 75 73 65 72 29 29 ock")... user))
100f0 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
10100 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10110 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10120 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10130 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
10140 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 Get paths to tes
10150 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ts.;;===========
10160 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10170 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10180 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10190 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 ===========.;; G
101a0 65 74 20 74 65 73 74 20 70 61 74 68 73 20 6d 61 et test paths ma
101b0 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 tching target, r
101c0 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 65 73 74 unname, and test
101d0 70 61 74 74 0a 28 69 66 20 28 6f 72 20 28 61 72 patt.(if (or (ar
101e0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
101f0 74 2d 66 69 6c 65 73 22 29 28 61 72 67 73 3a 67 t-files")(args:g
10200 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 70 61 et-arg "-test-pa
10210 74 68 73 22 29 29 0a 20 20 20 20 3b 3b 20 69 66 ths")). ;; if
10220 20 77 65 20 61 72 65 20 69 6e 20 61 20 74 65 73 we are in a tes
10230 74 20 75 73 65 20 74 68 65 20 4d 54 5f 43 4d 44 t use the MT_CMD
10240 49 4e 46 4f 20 64 61 74 61 0a 20 20 20 20 28 69 INFO data. (i
10250 66 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d f (getenv "MT_CM
10260 44 49 4e 46 4f 22 29 0a 09 28 6c 65 74 2a 20 28 DINFO")..(let* (
10270 28 73 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 (startingdir (cu
10280 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
10290 29 0a 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e ).. (cmdin
102a0 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 fo (common:rea
102b0 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 d-encoded-string
102c0 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
102d0 49 4e 46 4f 22 29 29 29 0a 09 20 20 20 20 20 20 INFO")))..
102e0 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 (transport (ass
102f0 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e oc/default 'tran
10300 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a sport cmdinfo)).
10310 09 20 20 20 20 20 20 20 28 74 65 73 74 70 61 74 . (testpat
10320 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c h (assoc/defaul
10330 74 20 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 t 'testpath cmd
10340 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
10350 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 test-name (assoc
10360 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e /default 'test-n
10370 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ame cmdinfo))..
10380 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 (runscript
10390 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
103a0 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 'runscript cmdin
103b0 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 fo)).. (db
103c0 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 -host (assoc/d
103d0 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 efault 'db-host
103e0 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
103f0 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 (run-id (
10400 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
10410 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f un-id cmdinfo
10420 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d )).. (item
10430 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 dat (assoc/def
10440 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 ault 'itemdat
10450 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
10460 20 20 28 73 74 61 74 65 20 20 20 20 20 28 61 72 (state (ar
10470 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
10480 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 te")).. (s
10490 74 61 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 tatus (args:g
104a0 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 et-arg ":status"
104b0 29 29 0a 09 20 20 20 20 20 20 20 28 74 61 72 67 )).. (targ
104c0 65 74 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d et (args:get-
104d0 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 29 0a arg "-target")).
104e0 09 20 20 20 20 20 20 20 28 74 6f 70 70 61 74 68 . (toppath
104f0 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
10500 74 20 27 74 6f 70 70 61 74 68 20 20 20 63 6d 64 t 'toppath cmd
10510 69 6e 66 6f 29 29 29 0a 09 20 20 28 63 68 61 6e info))).. (chan
10520 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 ge-directory top
10530 70 61 74 68 29 0a 09 20 20 28 69 66 20 28 6e 6f path).. (if (no
10540 74 20 74 61 72 67 65 74 29 0a 09 20 20 20 20 20 t target)..
10550 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
10560 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
10570 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
10580 2a 20 22 2d 74 61 72 67 65 74 20 69 73 20 72 65 * "-target is re
10590 71 75 69 72 65 64 2e 22 29 0a 09 09 28 65 78 69 quired.")...(exi
105a0 74 20 31 29 29 29 0a 09 20 20 28 69 66 20 28 6e t 1))).. (if (n
105b0 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 ot (launch:setup
105c0 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e )).. (begin
105d0 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
105e0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
105f0 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 ort* "Failed to
10600 73 65 74 75 70 2c 20 67 69 76 69 6e 67 20 75 70 setup, giving up
10610 20 6f 6e 20 2d 74 65 73 74 2d 70 61 74 68 73 20 on -test-paths
10620 6f 72 20 2d 74 65 73 74 2d 66 69 6c 65 73 2c 20 or -test-files,
10630 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 69 exiting")...(exi
10640 74 20 31 29 29 29 0a 09 20 20 28 6c 65 74 2a 20 t 1))).. (let*
10650 28 28 6b 65 79 73 20 20 20 20 20 28 72 6d 74 3a ((keys (rmt:
10660 67 65 74 2d 6b 65 79 73 29 29 0a 09 09 20 3b 3b get-keys))... ;;
10670 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 db:test-get-pat
10680 68 73 20 6d 75 73 74 20 6e 6f 74 20 62 65 20 72 hs must not be r
10690 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 28 70 61 un remote... (pa
106a0 74 68 73 20 20 20 20 28 74 65 73 74 73 3a 74 65 ths (tests:te
106b0 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 st-get-paths-mat
106c0 63 68 69 6e 67 20 6b 65 79 73 20 74 61 72 67 65 ching keys targe
106d0 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
106e0 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 29 29 29 "-test-files")))
106f0 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 69 ).. (set! *di
10700 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a dsomething* #t).
10710 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 . (for-each (
10720 6c 61 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 lambda (path)...
10730 09 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 .(if (file-exist
10740 73 3f 20 70 61 74 68 29 0a 09 09 09 28 70 72 69 s? path)....(pri
10750 6e 74 20 70 61 74 68 29 29 29 09 0a 09 09 20 20 nt path)))....
10760 20 20 20 20 70 61 74 68 73 29 29 29 0a 09 3b 3b paths)))..;;
10770 20 65 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 72 else do a gener
10780 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 al-run-call..(ge
10790 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
107a0 09 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 0a . "-test-files".
107b0 09 20 22 47 65 74 20 70 61 74 68 73 20 74 6f 20 . "Get paths to
107c0 74 65 73 74 22 0a 09 20 28 6c 61 6d 62 64 61 20 test".. (lambda
107d0 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 (target runname
107e0 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 09 20 keys keyvals)..
107f0 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 20 (let* ((db
10800 20 20 20 23 66 29 0a 09 09 20 20 3b 3b 20 44 4f #f)... ;; DO
10810 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a NOT run remote.
10820 09 09 20 20 28 70 61 74 68 73 20 20 20 20 28 74 .. (paths (t
10830 65 73 74 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 ests:test-get-pa
10840 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 6b 65 79 ths-matching key
10850 73 20 74 61 72 67 65 74 20 28 61 72 67 73 3a 67 s target (args:g
10860 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 et-arg "-test-fi
10870 6c 65 73 22 29 29 29 29 0a 09 20 20 20 20 20 28 les")))).. (
10880 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
10890 20 28 70 61 74 68 29 0a 09 09 09 20 28 70 72 69 (path).... (pri
108a0 6e 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 nt path))...
108b0 20 20 20 70 61 74 68 73 29 29 29 29 29 29 0a 0a paths))))))..
108c0 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
108d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10900 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 ========.;; Arch
10910 69 76 65 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d ive tests.;;====
10920 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10930 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10940 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10950 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10960 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 20 74 65 ==.;; Archive te
10970 73 74 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 sts matching tar
10980 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e get, runname, an
10990 64 20 74 65 73 74 70 61 74 74 0a 28 69 66 20 28 d testpatt.(if (
109a0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 61 args:get-arg "-a
109b0 72 63 68 69 76 65 22 29 0a 20 20 20 20 3b 3b 20 rchive"). ;;
109c0 65 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 else do a genera
109d0 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 28 l-run-call. (
109e0 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
109f0 20 0a 20 20 20 20 20 22 2d 61 72 63 68 69 76 65 . "-archive
10a00 22 0a 20 20 20 20 20 22 41 72 63 68 69 76 65 22 ". "Archive"
10a10 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 . (lambda (t
10a20 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
10a30 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 ys keyvals).
10a40 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 (operate-on '
10a50 61 72 63 68 69 76 65 29 29 29 29 0a 0a 3b 3b 3d archive))))..;;=
10a60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10aa0 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 74 72 61 63 74 =====.;; Extract
10ab0 20 61 20 73 70 72 65 61 64 73 68 65 65 74 20 66 a spreadsheet f
10ac0 72 6f 6d 20 74 68 65 20 72 75 6e 73 20 64 61 74 rom the runs dat
10ad0 61 62 61 73 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d abase.;;========
10ae0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10af0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
10b20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
10b30 67 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 g "-extract-ods"
10b40 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 ). (general-r
10b50 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 20 22 2d 65 un-call. "-e
10b60 78 74 72 61 63 74 2d 6f 64 73 22 0a 20 20 20 20 xtract-ods".
10b70 20 22 4d 61 6b 65 20 6f 64 73 20 73 70 72 65 61 "Make ods sprea
10b80 64 73 68 65 65 74 22 0a 20 20 20 20 20 28 6c 61 dsheet". (la
10b90 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
10ba0 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c name keys keyval
10bb0 73 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 s). (let (
10bc0 28 64 62 73 74 72 75 63 74 20 20 20 28 6d 61 6b (dbstruct (mak
10bd0 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 e-dbr:dbstruct p
10be0 61 74 68 3a 20 2a 74 6f 70 70 61 74 68 2a 20 6c ath: *toppath* l
10bf0 6f 63 61 6c 3a 20 23 74 29 29 0a 09 20 20 20 20 ocal: #t))..
10c00 20 28 6f 75 74 70 75 74 66 69 6c 65 20 28 61 72 (outputfile (ar
10c10 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 74 gs:get-arg "-ext
10c20 72 61 63 74 2d 6f 64 73 22 29 29 0a 09 20 20 20 ract-ods"))..
10c30 20 20 28 72 75 6e 73 70 61 74 74 20 20 20 28 6f (runspatt (o
10c40 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
10c50 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 "-runname")(args
10c60 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
10c70 6d 65 22 29 29 29 0a 09 20 20 20 20 20 28 70 61 me"))).. (pa
10c80 74 68 6d 6f 64 20 20 20 20 28 61 72 67 73 3a 67 thmod (args:g
10c90 65 74 2d 61 72 67 20 22 2d 70 61 74 68 6d 6f 64 et-arg "-pathmod
10ca0 22 29 29 29 0a 09 20 20 20 20 20 3b 3b 20 28 6b "))).. ;; (k
10cb0 65 79 76 61 6c 61 6c 69 73 74 20 28 6b 65 79 73 eyvalalist (keys
10cc0 2d 3e 61 6c 69 73 74 20 6b 65 79 73 20 22 25 22 ->alist keys "%"
10cd0 29 29 29 0a 09 20 28 64 65 62 75 67 3a 70 72 69 ))).. (debug:pri
10ce0 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 2 *default-lo
10cf0 67 2d 70 6f 72 74 2a 20 22 45 78 74 72 61 63 74 g-port* "Extract
10d00 20 6f 64 73 2c 20 6f 75 74 70 75 74 66 69 6c 65 ods, outputfile
10d10 3a 20 22 20 6f 75 74 70 75 74 66 69 6c 65 20 22 : " outputfile "
10d20 20 72 75 6e 73 70 61 74 74 3a 20 22 20 72 75 6e runspatt: " run
10d30 73 70 61 74 74 20 22 20 6b 65 79 76 61 6c 73 3a spatt " keyvals:
10d40 20 22 20 6b 65 79 76 61 6c 73 29 0a 09 20 28 64 " keyvals).. (d
10d50 62 3a 65 78 74 72 61 63 74 2d 6f 64 73 2d 66 69 b:extract-ods-fi
10d60 6c 65 20 64 62 73 74 72 75 63 74 20 6f 75 74 70 le dbstruct outp
10d70 75 74 66 69 6c 65 20 6b 65 79 76 61 6c 73 20 28 utfile keyvals (
10d80 69 66 20 72 75 6e 73 70 61 74 74 20 72 75 6e 73 if runspatt runs
10d90 70 61 74 74 20 22 25 22 29 20 70 61 74 68 6d 6f patt "%") pathmo
10da0 64 29 0a 09 20 28 64 62 3a 63 6c 6f 73 65 2d 61 d).. (db:close-a
10db0 6c 6c 20 64 62 73 74 72 75 63 74 29 0a 09 20 28 ll dbstruct).. (
10dc0 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
10dd0 6e 67 2a 20 23 74 29 29 29 29 29 0a 0a 3b 3b 3d ng* #t)))))..;;=
10de0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10df0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10e00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10e10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10e20 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 63 75 74 65 =====.;; execute
10e30 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 the test.;;
10e40 2d 20 67 65 74 73 20 63 61 6c 6c 65 64 20 6f 6e - gets called on
10e50 20 72 65 6d 6f 74 65 20 68 6f 73 74 0a 3b 3b 20 remote host.;;
10e60 20 20 20 2d 20 72 65 63 65 69 76 65 73 20 69 6e - receives in
10e70 66 6f 20 66 72 6f 6d 20 74 68 65 20 2d 65 78 65 fo from the -exe
10e80 63 75 74 65 20 70 61 72 61 6d 0a 3b 3b 20 20 20 cute param.;;
10e90 20 2d 20 70 61 73 73 65 73 20 69 6e 66 6f 20 74 - passes info t
10ea0 6f 20 73 74 65 70 73 20 76 69 61 20 4d 54 5f 43 o steps via MT_C
10eb0 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 28 MDINFO env var (
10ec0 66 75 74 75 72 65 20 69 73 20 74 6f 20 75 73 65 future is to use
10ed0 20 61 20 64 6f 74 20 66 69 6c 65 29 0a 3b 3b 20 a dot file).;;
10ee0 20 20 20 2d 20 67 61 74 68 65 72 73 20 68 6f 73 - gathers hos
10ef0 74 20 69 6e 66 6f 20 61 6e 64 20 0a 3b 3b 3d 3d t info and .;;==
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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10f40 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
10f50 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 get-arg "-execut
10f60 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 e"). (begin.
10f70 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 65 78 65 (launch:exe
10f80 63 75 74 65 20 28 61 72 67 73 3a 67 65 74 2d 61 cute (args:get-a
10f90 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 29 0a rg "-execute")).
10fa0 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
10fb0 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
10fc0 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
10fd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10fe0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10ff0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11000 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 65 ==========.;; re
11010 63 6f 76 65 72 20 66 72 6f 6d 20 61 20 74 65 73 cover from a tes
11020 74 20 77 68 65 72 65 20 74 68 65 20 6d 61 6e 61 t where the mana
11030 67 69 6e 67 20 6d 74 65 73 74 20 77 61 73 20 6b ging mtest was k
11040 69 6c 6c 65 64 20 62 75 74 20 74 68 65 20 75 6e illed but the un
11050 64 65 72 6c 79 69 6e 67 0a 3b 3b 20 70 72 6f 63 derlying.;; proc
11060 65 73 73 20 6d 69 67 68 74 20 73 74 69 6c 6c 20 ess might still
11070 62 65 20 73 61 6c 76 61 67 65 61 62 6c 65 0a 3b be salvageable.;
11080 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
11090 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
110a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
110b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
110c0 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
110d0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 63 gs:get-arg "-rec
110e0 6f 76 65 72 2d 74 65 73 74 22 29 0a 20 20 20 20 over-test").
110f0 28 6c 65 74 2a 20 28 28 70 61 72 61 6d 73 20 28 (let* ((params (
11100 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 61 72 string-split (ar
11110 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 63 gs:get-arg "-rec
11120 6f 76 65 72 2d 74 65 73 74 22 29 20 22 2c 22 29 over-test") ",")
11130 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 3e 20 )). (if (>
11140 28 6c 65 6e 67 74 68 20 70 61 72 61 6d 73 29 20 (length params)
11150 31 29 20 3b 3b 20 72 75 6e 2d 69 64 20 61 6e 64 1) ;; run-id and
11160 20 74 65 73 74 2d 69 64 0a 09 20 20 28 6c 65 74 test-id.. (let
11170 20 28 28 72 75 6e 2d 69 64 20 28 73 74 72 69 6e ((run-id (strin
11180 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 72 20 70 g->number (car p
11190 61 72 61 6d 73 29 29 29 0a 09 09 28 74 65 73 74 arams)))...(test
111a0 2d 69 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d -id (string->num
111b0 62 65 72 20 28 63 61 64 72 20 70 61 72 61 6d 73 ber (cadr params
111c0 29 29 29 29 0a 09 20 20 20 20 28 69 66 20 28 61 )))).. (if (a
111d0 6e 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 nd run-id test-i
111e0 64 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 d)...(begin...
111f0 28 6c 61 75 6e 63 68 3a 72 65 63 6f 76 65 72 2d (launch:recover-
11200 74 65 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 test run-id test
11210 2d 69 64 29 0a 09 09 20 20 28 73 65 74 21 20 2a -id)... (set! *
11220 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
11230 29 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 ))...(begin...
11240 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
11250 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
11260 67 2d 70 6f 72 74 2a 20 22 62 61 64 20 72 75 6e g-port* "bad run
11270 2d 69 64 20 6f 72 20 74 65 73 74 2d 69 64 2c 20 -id or test-id,
11280 6d 75 73 74 20 62 65 20 69 6e 74 65 67 65 72 73 must be integers
11290 22 29 0a 09 09 20 20 28 65 78 69 74 20 31 29 29 ")... (exit 1))
112a0 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d )))))..;;=======
112b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
112c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
112d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
112e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
112f0 3b 3b 20 54 65 73 74 20 63 6f 6d 6d 61 6e 64 73 ;; Test commands
11300 20 28 69 2e 65 2e 20 66 6f 72 20 75 73 65 20 69 (i.e. for use i
11310 6e 73 69 64 65 20 74 65 73 74 73 29 0a 3b 3b 3d nside tests).;;=
11320 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11330 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11340 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11350 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11360 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
11370 6d 65 67 61 74 65 73 74 3a 73 74 65 70 20 73 74 megatest:step st
11380 65 70 20 73 74 61 74 65 20 73 74 61 74 75 73 20 ep state status
11390 6c 6f 67 66 69 6c 65 20 6d 73 67 29 0a 20 20 28 logfile msg). (
113a0 69 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 if (not (getenv
113b0 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 20 "MT_CMDINFO")).
113c0 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 (begin..(de
113d0 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
113e0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
113f0 6f 72 74 2a 20 22 4d 54 5f 43 4d 44 49 4e 46 4f ort* "MT_CMDINFO
11400 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 env var not set
11410 2c 20 2d 73 74 65 70 20 6d 75 73 74 20 62 65 20 , -step must be
11420 63 61 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 called *inside*
11430 61 20 6d 65 67 61 74 65 73 74 20 69 6e 76 6f 6b a megatest invok
11440 65 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 ed environment!"
11450 29 0a 09 28 65 78 69 74 20 35 29 29 0a 20 20 20 )..(exit 5)).
11460 20 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e (let* ((cmdin
11470 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 fo (common:rea
11480 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 d-encoded-string
11490 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
114a0 49 4e 46 4f 22 29 29 29 0a 09 20 20 20 20 20 28 INFO"))).. (
114b0 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 transport (assoc
114c0 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 /default 'transp
114d0 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ort cmdinfo))..
114e0 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 (testpath (
114f0 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
11500 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
11510 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 2d 6e )).. (test-n
11520 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ame (assoc/defau
11530 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d lt 'test-name cm
11540 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 dinfo)).. (r
11550 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f unscript (assoc/
11560 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 default 'runscri
11570 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 pt cmdinfo))..
11580 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 (db-host (a
11590 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 ssoc/default 'db
115a0 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 -host cmdinfo)
115b0 29 0a 09 20 20 20 20 20 28 72 75 6e 2d 69 64 20 ).. (run-id
115c0 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
115d0 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 t 'run-id cmd
115e0 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 info)).. (te
115f0 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 st-id (assoc/d
11600 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 efault 'test-id
11610 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
11620 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
11630 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
11640 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
11650 0a 09 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 .. (work-are
11660 61 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 a (assoc/default
11670 20 27 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 'work-area cmdi
11680 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 64 62 20 nfo)).. (db
11690 20 20 20 20 20 20 20 23 66 29 29 0a 09 28 63 68 #f))..(ch
116a0 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
116b0 65 73 74 70 61 74 68 29 0a 09 28 69 66 20 28 6e estpath)..(if (n
116c0 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 ot (launch:setup
116d0 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 )).. (begin..
116e0 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
116f0 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
11700 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 g-port* "Failed
11710 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
11720 67 22 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 g").. (exit
11730 20 31 29 29 29 0a 09 28 69 66 20 28 61 6e 64 20 1)))..(if (and
11740 73 74 61 74 65 20 73 74 61 74 75 73 29 0a 09 20 state status)..
11750 20 20 20 28 6c 65 74 20 28 28 63 6f 6d 6d 65 6e (let ((commen
11760 74 20 28 6c 61 75 6e 63 68 3a 6c 6f 61 64 2d 6c t (launch:load-l
11770 6f 67 70 72 6f 2d 64 61 74 20 72 75 6e 2d 69 64 ogpro-dat run-id
11780 20 74 65 73 74 2d 69 64 20 73 74 65 70 29 29 29 test-id step)))
11790 0a 09 20 20 20 20 20 20 3b 3b 20 28 72 6d 74 3a .. ;; (rmt:
117a0 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 test-set-log! ru
117b0 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 28 63 6f n-id test-id (co
117c0 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 nc stepname ".ht
117d0 6d 6c 22 29 29 29 29 0a 09 20 20 20 20 20 20 28 ml")))).. (
117e0 72 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 74 rmt:teststep-set
117f0 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 -status! run-id
11800 74 65 73 74 2d 69 64 20 73 74 65 70 20 73 74 61 test-id step sta
11810 74 65 20 73 74 61 74 75 73 20 28 6f 72 20 63 6f te status (or co
11820 6d 6d 65 6e 74 20 6d 73 67 29 20 6c 6f 67 66 69 mment msg) logfi
11830 6c 65 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e le)).. (begin
11840 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
11850 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
11860 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
11870 22 59 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 "You must specif
11880 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 y :state and :st
11890 61 74 75 73 20 77 69 74 68 20 65 76 65 72 79 20 atus with every
118a0 63 61 6c 6c 20 74 6f 20 2d 73 74 65 70 22 29 0a call to -step").
118b0 09 20 20 20 20 20 20 28 65 78 69 74 20 36 29 29 . (exit 6))
118c0 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a ))))..(if (args:
118d0 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 get-arg "-step")
118e0 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
118f0 20 20 28 6d 65 67 61 74 65 73 74 3a 73 74 65 70 (megatest:step
11900 20 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 . (args:g
11910 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a et-arg "-step").
11920 20 20 20 20 20 20 20 28 6f 72 20 28 61 72 67 73 (or (args
11930 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 65 :get-arg "-state
11940 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
11950 22 3a 73 74 61 74 65 22 29 29 0a 20 20 20 20 20 ":state")).
11960 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d (or (args:get-
11970 61 72 67 20 22 2d 73 74 61 74 75 73 22 29 28 61 arg "-status")(a
11980 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
11990 61 74 75 73 22 29 29 0a 20 20 20 20 20 20 20 28 atus")). (
119a0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
119b0 65 74 6c 6f 67 22 29 0a 20 20 20 20 20 20 20 28 etlog"). (
119c0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
119d0 22 29 29 0a 20 20 20 20 20 20 3b 3b 20 28 69 66 ")). ;; (if
119e0 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e db (sqlite3:fin
119f0 61 6c 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 alize! db)).
11a00 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
11a10 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 20 20 20 thing* #t))).
11a20 20 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a .(if (or (args:
11a30 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 get-arg "-setlog
11a40 22 29 20 20 20 20 20 20 20 3b 3b 20 73 69 6e 63 ") ;; sinc
11a50 65 20 73 65 74 74 69 6e 67 20 75 70 20 69 73 20 e setting up is
11a60 73 6f 20 63 6f 73 74 6c 79 20 6c 65 74 73 20 70 so costly lets p
11a70 69 67 67 79 62 61 63 6b 20 6f 6e 20 2d 74 65 73 iggyback on -tes
11a80 74 2d 73 74 61 74 75 73 0a 09 3b 3b 20 20 20 20 t-status..;;
11a90 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d (not (args:get-
11aa0 61 72 67 20 22 2d 73 74 65 70 22 29 29 29 20 20 arg "-step")))
11ab0 3b 3b 20 2d 73 65 74 6c 6f 67 20 6d 61 79 20 68 ;; -setlog may h
11ac0 61 76 65 20 62 65 65 6e 20 70 72 6f 63 65 73 73 ave been process
11ad0 65 64 20 61 6c 72 65 61 64 79 20 69 6e 20 74 68 ed already in th
11ae0 65 20 22 2d 73 74 65 70 22 20 70 72 65 76 69 6f e "-step" previo
11af0 75 73 0a 09 3b 3b 20 20 20 20 20 4e 45 57 20 50 us..;; NEW P
11b00 4f 4c 49 43 59 20 2d 20 2d 73 65 74 6c 6f 67 20 OLICY - -setlog
11b10 73 65 74 73 20 74 65 73 74 20 6f 76 65 72 61 6c sets test overal
11b20 6c 20 6c 6f 67 20 6f 6e 20 65 76 65 72 79 20 63 l log on every c
11b30 61 6c 6c 2e 0a 09 28 61 72 67 73 3a 67 65 74 2d all...(args:get-
11b40 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 arg "-set-toplog
11b50 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
11b60 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 g "-test-status"
11b70 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
11b80 20 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 0a "-set-values").
11b90 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
11ba0 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 -load-test-data"
11bb0 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
11bc0 20 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 28 61 "-runstep")..(a
11bd0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 rgs:get-arg "-su
11be0 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 29 mmarize-items"))
11bf0 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 67 . (if (not (g
11c00 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
11c10 4f 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 O"))..(begin..
11c20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
11c30 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
11c40 67 2d 70 6f 72 74 2a 20 22 4d 54 5f 43 4d 44 49 g-port* "MT_CMDI
11c50 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 NFO env var not
11c60 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 set, commands -t
11c70 65 73 74 2d 73 74 61 74 75 73 2c 20 2d 72 75 6e est-status, -run
11c80 73 74 65 70 20 61 6e 64 20 2d 73 65 74 6c 6f 67 step and -setlog
11c90 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 20 must be called
11ca0 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 74 *inside* a megat
11cb0 65 73 74 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 est environment!
11cc0 22 29 0a 09 20 20 28 65 78 69 74 20 35 29 29 0a ").. (exit 5)).
11cd0 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e .(let* ((startin
11ce0 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 gdir (current-di
11cf0 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 rectory))..
11d00 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 63 6f (cmdinfo (co
11d10 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 mmon:read-encode
11d20 64 2d 73 74 72 69 6e 67 20 28 67 65 74 65 6e 76 d-string (getenv
11d30 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 "MT_CMDINFO")))
11d40 0a 09 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 .. (transp
11d50 6f 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ort (assoc/defau
11d60 6c 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d lt 'transport cm
11d70 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
11d80 28 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f (testpath (asso
11d90 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 c/default 'testp
11da0 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 ath cmdinfo))..
11db0 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d (test-nam
11dc0 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 e (assoc/default
11dd0 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 'test-name cmdi
11de0 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 nfo)).. (r
11df0 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f unscript (assoc/
11e00 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 default 'runscri
11e10 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 pt cmdinfo))..
11e20 20 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 (db-host
11e30 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
11e40 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 db-host cmdinf
11e50 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
11e60 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 -id (assoc/de
11e70 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 fault 'run-id
11e80 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
11e90 20 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 (test-id (a
11ea0 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
11eb0 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 st-id cmdinfo)
11ec0 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 ).. (itemd
11ed0 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 at (assoc/defa
11ee0 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 ult 'itemdat c
11ef0 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
11f00 20 28 77 6f 72 6b 2d 61 72 65 61 20 28 61 73 73 (work-area (ass
11f10 6f 63 2f 64 65 66 61 75 6c 74 20 27 77 6f 72 6b oc/default 'work
11f20 2d 61 72 65 61 20 63 6d 64 69 6e 66 6f 29 29 0a -area cmdinfo)).
11f30 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 20 . (db
11f40 20 20 20 23 66 29 20 3b 3b 20 28 6f 70 65 6e 2d #f) ;; (open-
11f50 64 62 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 db)).. (st
11f60 61 74 65 20 20 20 20 20 28 61 72 67 73 3a 67 65 ate (args:ge
11f70 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 t-arg ":state"))
11f80 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 .. (status
11f90 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
11fa0 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a 09 20 g ":status"))..
11fb0 20 20 20 20 20 20 28 73 74 65 70 6e 61 6d 65 20 (stepname
11fc0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
11fd0 2d 73 74 65 70 22 29 29 29 0a 09 20 20 28 69 66 -step"))).. (if
11fe0 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
11ff0 74 75 70 29 29 0a 09 20 20 20 20 20 20 28 62 65 tup)).. (be
12000 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 gin...(debug:pri
12010 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
12020 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 g-port* "Failed
12030 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
12040 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 g")...(exit 1)))
12050 0a 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 ... (if (args:g
12060 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 et-arg "-runstep
12070 22 29 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ")(debug:print-i
12080 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 1 *default-l
12090 6f 67 2d 70 6f 72 74 2a 20 22 52 75 6e 6e 69 6e og-port* "Runnin
120a0 67 20 2d 72 75 6e 73 74 65 70 2c 20 66 69 72 73 g -runstep, firs
120b0 74 20 63 68 61 6e 67 65 20 74 6f 20 64 69 72 65 t change to dire
120c0 63 74 6f 72 79 20 22 20 77 6f 72 6b 2d 61 72 65 ctory " work-are
120d0 61 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 a)).. (change-d
120e0 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 irectory work-ar
120f0 65 61 29 0a 09 20 20 3b 3b 20 63 61 6e 20 73 65 ea).. ;; can se
12100 74 75 70 20 61 73 20 63 6c 69 65 6e 74 20 66 6f tup as client fo
12110 72 20 73 65 72 76 65 72 20 6d 6f 64 65 20 6e 6f r server mode no
12120 77 0a 09 20 20 3b 3b 20 28 63 6c 69 65 6e 74 3a w.. ;; (client:
12130 73 65 74 75 70 29 0a 0a 09 20 20 28 69 66 20 28 setup)... (if (
12140 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
12150 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a oad-test-data").
12160 09 20 20 20 20 20 20 3b 3b 20 68 61 73 20 73 75 . ;; has su
12170 62 20 63 6f 6d 6d 61 6e 64 73 20 74 68 61 74 20 b commands that
12180 61 72 65 20 72 64 62 3a 0a 09 20 20 20 20 20 20 are rdb:..
12190 3b 3b 20 44 4f 20 4e 4f 54 20 70 75 74 20 74 68 ;; DO NOT put th
121a0 69 73 20 6f 6e 65 20 69 6e 74 6f 20 65 69 74 68 is one into eith
121b0 65 72 20 72 6d 74 3a 20 6f 72 20 6f 70 65 6e 2d er rmt: or open-
121c0 72 75 6e 2d 63 6c 6f 73 65 0a 09 20 20 20 20 20 run-close..
121d0 20 28 74 64 62 3a 6c 6f 61 64 2d 74 65 73 74 2d (tdb:load-test-
121e0 64 61 74 61 20 72 75 6e 2d 69 64 20 74 65 73 74 data run-id test
121f0 2d 69 64 29 29 0a 09 20 20 28 69 66 20 28 61 72 -id)).. (if (ar
12200 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
12210 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 28 6c 65 log").. (le
12220 74 20 28 28 6c 6f 67 66 6e 61 6d 65 20 28 61 72 t ((logfname (ar
12230 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
12240 6c 6f 67 22 29 29 29 0a 09 09 28 72 6d 74 3a 74 log")))...(rmt:t
12250 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e est-set-log! run
12260 2d 69 64 20 74 65 73 74 2d 69 64 20 6c 6f 67 66 -id test-id logf
12270 6e 61 6d 65 29 29 29 0a 09 20 20 28 69 66 20 28 name))).. (if (
12280 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
12290 65 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 20 20 20 et-toplog")..
122a0 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e ;; DO NOT run
122b0 20 72 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 28 remote.. (
122c0 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 74 tests:test-set-t
122d0 6f 70 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 oplog! run-id te
122e0 73 74 2d 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 st-name (args:ge
122f0 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c t-arg "-set-topl
12300 6f 67 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 og"))).. (if (a
12310 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 rgs:get-arg "-su
12320 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 0a mmarize-items").
12330 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 . ;; DO NOT
12340 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 run remote..
12350 20 20 20 28 74 65 73 74 73 3a 73 75 6d 6d 61 72 (tests:summar
12360 69 7a 65 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 ize-items run-id
12370 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d 6e 61 test-id test-na
12380 6d 65 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 6f me #t)) ;; do fo
12390 72 63 65 20 68 65 72 65 0a 09 20 20 28 69 66 20 rce here.. (if
123a0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
123b0 72 75 6e 73 74 65 70 22 29 0a 09 20 20 20 20 20 runstep")..
123c0 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 (if (null? rema
123d0 72 67 73 29 0a 09 09 20 20 28 62 65 67 69 6e 0a rgs)... (begin.
123e0 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
123f0 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
12400 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6e ult-log-port* "n
12410 6f 74 68 69 6e 67 20 73 70 65 63 69 66 69 65 64 othing specified
12420 20 74 6f 20 72 75 6e 21 22 29 0a 09 09 20 20 20 to run!")...
12430 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 (if db (sqlite3
12440 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
12450 09 09 20 20 20 20 28 65 78 69 74 20 36 29 29 0a .. (exit 6)).
12460 09 09 20 20 28 6c 65 74 2a 20 28 28 73 74 65 70 .. (let* ((step
12470 6e 61 6d 65 20 20 20 28 61 72 67 73 3a 67 65 74 name (args:get
12480 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 -arg "-runstep")
12490 29 0a 09 09 09 20 28 6c 6f 67 70 72 6f 66 69 6c ).... (logprofil
124a0 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 e (args:get-arg
124b0 22 2d 6c 6f 67 70 72 6f 22 29 29 0a 09 09 09 20 "-logpro"))....
124c0 28 6c 6f 67 66 69 6c 65 20 20 20 20 28 63 6f 6e (logfile (con
124d0 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 c stepname ".log
124e0 22 29 29 0a 09 09 09 20 28 63 6d 64 20 20 20 20 ")).... (cmd
124f0 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 (if (null? r
12500 65 6d 61 72 67 73 29 20 23 66 20 28 63 61 72 20 emargs) #f (car
12510 72 65 6d 61 72 67 73 29 29 29 0a 09 09 09 20 28 remargs))).... (
12520 70 61 72 61 6d 73 20 20 20 20 20 28 69 66 20 63 params (if c
12530 6d 64 20 28 63 64 72 20 72 65 6d 61 72 67 73 29 md (cdr remargs)
12540 20 27 28 29 29 29 0a 09 09 09 20 28 65 78 69 74 '())).... (exit
12550 73 74 61 74 20 20 20 23 66 29 0a 09 09 09 20 28 stat #f).... (
12560 73 68 65 6c 6c 20 20 20 20 20 20 28 6c 65 74 20 shell (let
12570 28 28 73 68 20 28 67 65 74 2d 65 6e 76 69 72 6f ((sh (get-enviro
12580 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
12590 53 48 45 4c 4c 22 29 20 29 29 0a 09 09 09 09 20 SHELL") )).....
125a0 20 20 20 20 20 20 28 69 66 20 73 68 20 0a 09 09 (if sh ...
125b0 09 09 09 20 20 20 28 6c 61 73 74 20 28 73 74 72 ... (last (str
125c0 69 6e 67 2d 73 70 6c 69 74 20 73 68 20 22 2f 22 ing-split sh "/"
125d0 29 29 0a 09 09 09 09 09 20 20 20 22 62 61 73 68 ))...... "bash
125e0 22 29 29 29 0a 09 09 09 20 28 72 65 64 69 72 20 "))).... (redir
125f0 20 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 (case (stri
12600 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 68 65 6c 6c ng->symbol shell
12610 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 74 )..... ((t
12620 63 73 68 20 63 73 68 20 6b 73 68 29 20 20 20 20 csh csh ksh)
12630 22 3e 26 22 29 0a 09 09 09 09 20 20 20 20 20 20 ">&").....
12640 20 28 28 7a 73 68 20 62 61 73 68 20 73 68 20 61 ((zsh bash sh a
12650 73 68 29 20 22 32 3e 26 31 20 3e 22 29 0a 09 09 sh) "2>&1 >")...
12660 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 22 .. (else "
12670 3e 26 22 29 29 29 0a 09 09 09 20 28 66 75 6c 6c >&"))).... (full
12680 63 6d 64 20 20 20 20 28 63 6f 6e 63 20 22 28 22 cmd (conc "("
12690 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
126a0 65 72 73 65 20 0a 09 09 09 09 09 09 28 63 6f 6e erse .......(con
126b0 73 20 63 6d 64 20 70 61 72 61 6d 73 29 20 22 20 s cmd params) "
126c0 22 29 0a 09 09 09 09 09 20 20 20 22 29 20 22 20 ")...... ") "
126d0 72 65 64 69 72 20 22 20 22 20 6c 6f 67 66 69 6c redir " " logfil
126e0 65 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 6d 61 e)))... ;; ma
126f0 72 6b 20 74 68 65 20 73 74 61 72 74 20 6f 66 20 rk the start of
12700 74 68 65 20 74 65 73 74 0a 09 09 20 20 20 20 28 the test... (
12710 72 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 74 rmt:teststep-set
12720 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 -status! run-id
12730 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 test-id stepname
12740 20 22 73 74 61 72 74 22 20 22 6e 2f 61 22 20 28 "start" "n/a" (
12750 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
12760 22 29 20 6c 6f 67 66 69 6c 65 29 0a 09 09 20 20 ") logfile)...
12770 20 20 3b 3b 20 72 75 6e 20 74 68 65 20 74 65 73 ;; run the tes
12780 74 20 73 74 65 70 0a 09 09 20 20 20 20 28 64 65 t step... (de
12790 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 bug:print-info 2
127a0 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
127b0 72 74 2a 20 22 52 75 6e 6e 69 6e 67 20 5c 22 22 rt* "Running \""
127c0 20 66 75 6c 6c 63 6d 64 20 22 5c 22 20 69 6e 20 fullcmd "\" in
127d0 64 69 72 65 63 74 6f 72 79 20 5c 22 22 20 73 74 directory \"" st
127e0 61 72 74 69 6e 67 64 69 72 29 0a 09 09 20 20 20 artingdir)...
127f0 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
12800 72 79 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a ry startingdir).
12810 09 09 20 20 20 20 28 73 65 74 21 20 65 78 69 74 .. (set! exit
12820 73 74 61 74 20 28 73 79 73 74 65 6d 20 66 75 6c stat (system ful
12830 6c 63 6d 64 29 29 0a 09 09 20 20 20 20 28 73 65 lcmd))... (se
12840 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 t! *globalexitst
12850 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 0a atus* exitstat).
12860 09 09 20 20 20 20 3b 3b 20 28 63 68 61 6e 67 65 .. ;; (change
12870 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 -directory testp
12880 61 74 68 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 ath)... ;; ru
12890 6e 20 6c 6f 67 70 72 6f 20 69 66 20 61 70 70 6c n logpro if appl
128a0 69 63 61 62 6c 65 20 3b 3b 20 28 70 72 6f 63 65 icable ;; (proce
128b0 73 73 2d 72 75 6e 20 22 6c 73 22 20 28 6c 69 73 ss-run "ls" (lis
128c0 74 20 22 2f 66 6f 6f 22 20 22 32 3e 26 31 22 20 t "/foo" "2>&1"
128d0 22 62 6c 61 68 2e 6c 6f 67 22 29 29 0a 09 09 20 "blah.log"))...
128e0 20 20 20 28 69 66 20 6c 6f 67 70 72 6f 66 69 6c (if logprofil
128f0 65 0a 09 09 09 28 6c 65 74 2a 20 28 28 68 74 6d e....(let* ((htm
12900 6c 6c 6f 67 66 69 6c 65 20 28 63 6f 6e 63 20 73 llogfile (conc s
12910 74 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 tepname ".html")
12920 29 0a 09 09 09 20 20 20 20 20 20 20 28 6f 6c 64 ).... (old
12930 65 78 69 74 73 74 61 74 20 65 78 69 74 73 74 61 exitstat exitsta
12940 74 29 0a 09 09 09 20 20 20 20 20 20 20 28 63 6d t).... (cm
12950 64 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e d (strin
12960 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6c g-intersperse (l
12970 69 73 74 20 22 6c 6f 67 70 72 6f 22 20 6c 6f 67 ist "logpro" log
12980 70 72 6f 66 69 6c 65 20 68 74 6d 6c 6c 6f 67 66 profile htmllogf
12990 69 6c 65 20 22 3c 22 20 6c 6f 67 66 69 6c 65 20 ile "<" logfile
129a0 22 3e 22 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 ">" (conc stepna
129b0 6d 65 20 22 5f 6c 6f 67 70 72 6f 2e 6c 6f 67 22 me "_logpro.log"
129c0 29 29 20 22 20 22 29 29 29 0a 09 09 09 20 20 28 )) " "))).... (
129d0 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
129e0 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 2 *default-log-
129f0 70 6f 72 74 2a 20 22 72 75 6e 6e 69 6e 67 20 5c port* "running \
12a00 22 22 20 63 6d 64 20 22 5c 22 22 29 0a 09 09 09 "" cmd "\"")....
12a10 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
12a20 6f 72 79 20 73 74 61 72 74 69 6e 67 64 69 72 29 ory startingdir)
12a30 0a 09 09 09 20 20 28 73 65 74 21 20 65 78 69 74 .... (set! exit
12a40 73 74 61 74 20 28 73 79 73 74 65 6d 20 63 6d 64 stat (system cmd
12a50 29 29 0a 09 09 09 20 20 28 73 65 74 21 20 2a 67 )).... (set! *g
12a60 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
12a70 20 65 78 69 74 73 74 61 74 29 20 3b 3b 20 6e 6f exitstat) ;; no
12a80 20 6e 65 63 65 73 73 61 72 79 0a 09 09 09 20 20 necessary....
12a90 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
12aa0 79 20 74 65 73 74 70 61 74 68 29 0a 09 09 09 20 y testpath)....
12ab0 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c (rmt:test-set-l
12ac0 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d og! run-id test-
12ad0 69 64 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 29 29 id htmllogfile))
12ae0 29 0a 09 09 20 20 20 20 28 6c 65 74 20 28 28 6d )... (let ((m
12af0 73 67 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 sg (args:get-arg
12b00 20 22 2d 6d 22 29 29 29 0a 09 09 20 20 20 20 20 "-m")))...
12b10 20 28 72 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 (rmt:teststep-s
12b20 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 et-status! run-i
12b30 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 d test-id stepna
12b40 6d 65 20 22 65 6e 64 22 20 65 78 69 74 73 74 61 me "end" exitsta
12b50 74 20 6d 73 67 20 6c 6f 67 66 69 6c 65 29 29 0a t msg logfile)).
12b60 09 09 20 20 20 20 29 29 29 0a 09 20 20 28 69 66 .. ))).. (if
12b70 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
12b80 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 rg "-test-status
12b90 22 29 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 ")... (args:get
12ba0 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 -arg "-set-value
12bb0 73 22 29 29 0a 09 20 20 20 20 20 20 28 6c 65 74 s")).. (let
12bc0 20 28 28 6e 65 77 73 74 61 74 75 73 20 28 63 6f ((newstatus (co
12bd0 6e 64 0a 09 09 09 09 28 28 6e 75 6d 62 65 72 3f nd.....((number?
12be0 20 73 74 61 74 75 73 29 20 20 20 20 20 20 20 28 status) (
12bf0 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75 if (equal? statu
12c00 73 20 30 29 20 22 50 41 53 53 22 20 22 46 41 49 s 0) "PASS" "FAI
12c10 4c 22 29 29 0a 09 09 09 09 28 28 61 6e 64 20 28 L")).....((and (
12c20 73 74 72 69 6e 67 3f 20 73 74 61 74 75 73 29 0a string? status).
12c30 09 09 09 09 20 20 20 20 20 20 28 73 74 72 69 6e .... (strin
12c40 67 2d 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 73 g->number status
12c50 29 29 28 69 66 20 28 65 71 75 61 6c 3f 20 28 73 ))(if (equal? (s
12c60 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 tring->number st
12c70 61 74 75 73 29 20 30 29 20 22 50 41 53 53 22 20 atus) 0) "PASS"
12c80 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 65 6c "FAIL")).....(el
12c90 73 65 20 73 74 61 74 75 73 29 29 29 0a 09 09 20 se status)))...
12ca0 20 20 20 3b 3b 20 74 72 61 6e 73 66 65 72 20 72 ;; transfer r
12cb0 65 6c 65 76 61 6e 74 20 6b 65 79 73 20 69 6e 74 elevant keys int
12cc0 6f 20 61 20 68 61 73 68 20 74 6f 20 62 65 20 70 o a hash to be p
12cd0 61 73 73 65 64 20 74 6f 20 74 65 73 74 2d 73 65 assed to test-se
12ce0 74 2d 73 74 61 74 75 73 21 0a 09 09 20 20 20 20 t-status!...
12cf0 3b 3b 20 63 6f 75 6c 64 20 75 73 65 20 61 6e 20 ;; could use an
12d00 61 73 73 6f 63 20 6c 69 73 74 20 49 20 67 75 65 assoc list I gue
12d10 73 73 2e 20 0a 09 09 20 20 20 20 28 6f 74 68 65 ss. ... (othe
12d20 72 64 61 74 61 20 28 6c 65 74 20 28 28 72 65 73 rdata (let ((res
12d30 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
12d40 65 29 29 29 0a 09 09 09 09 20 28 66 6f 72 2d 65 e)))..... (for-e
12d50 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 ach (lambda (key
12d60 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 )...... (if
12d70 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 (args:get-arg ke
12d80 79 29 0a 09 09 09 09 09 09 20 28 68 61 73 68 2d y)....... (hash-
12d90 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 6b table-set! res k
12da0 65 79 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ey (args:get-arg
12db0 20 6b 65 79 29 29 29 29 0a 09 09 09 09 09 20 20 key))))......
12dc0 20 28 6c 69 73 74 20 22 3a 76 61 6c 75 65 22 20 (list ":value"
12dd0 22 3a 74 6f 6c 22 20 22 3a 65 78 70 65 63 74 65 ":tol" ":expecte
12de0 64 22 20 22 3a 66 69 72 73 74 5f 65 72 72 22 20 d" ":first_err"
12df0 22 3a 66 69 72 73 74 5f 77 61 72 6e 22 20 22 3a ":first_warn" ":
12e00 75 6e 69 74 73 22 20 22 3a 63 61 74 65 67 6f 72 units" ":categor
12e10 79 22 20 22 3a 76 61 72 69 61 62 6c 65 22 29 29 y" ":variable"))
12e20 0a 09 09 09 09 20 72 65 73 29 29 29 0a 09 09 28 ..... res)))...(
12e30 69 66 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 if (and (args:ge
12e40 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 t-arg "-test-sta
12e50 74 75 73 22 29 0a 09 09 09 20 28 6f 72 20 28 6e tus").... (or (n
12e60 6f 74 20 73 74 61 74 65 29 0a 09 09 09 20 20 20 ot state)....
12e70 20 20 28 6e 6f 74 20 73 74 61 74 75 73 29 29 29 (not status)))
12e80 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ... (begin...
12e90 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
12ea0 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
12eb0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 59 ult-log-port* "Y
12ec0 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 ou must specify
12ed0 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 :state and :stat
12ee0 75 73 20 77 69 74 68 20 65 76 65 72 79 20 63 61 us with every ca
12ef0 6c 6c 20 74 6f 20 2d 74 65 73 74 2d 73 74 61 74 ll to -test-stat
12f00 75 73 5c 6e 22 20 68 65 6c 70 29 0a 09 09 20 20 us\n" help)...
12f10 20 20 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 (if (sqlite3
12f20 3a 64 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 :database? db)(s
12f30 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
12f40 20 64 62 29 29 0a 09 09 20 20 20 20 20 20 28 65 db))... (e
12f50 78 69 74 20 36 29 29 29 0a 09 09 28 6c 65 74 2a xit 6)))...(let*
12f60 20 28 28 6d 73 67 20 20 20 20 28 61 72 67 73 3a ((msg (args:
12f70 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 get-arg "-m"))..
12f80 09 20 20 20 20 20 20 20 28 6e 75 6d 6f 74 68 20 . (numoth
12f90 28 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 (length (hash-ta
12fa0 62 6c 65 2d 6b 65 79 73 20 6f 74 68 65 72 64 61 ble-keys otherda
12fb0 74 61 29 29 29 29 0a 09 09 20 20 3b 3b 20 43 6f ta))))... ;; Co
12fc0 6e 76 65 72 74 20 74 6f 20 72 70 63 20 69 6e 73 nvert to rpc ins
12fd0 69 64 65 20 74 68 65 20 74 65 73 74 73 3a 74 65 ide the tests:te
12fe0 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 63 st-set-status! c
12ff0 61 6c 6c 2c 20 6e 6f 74 20 68 65 72 65 0a 09 09 all, not here...
13000 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 (tests:test-se
13010 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 t-status! run-id
13020 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 6e test-id state n
13030 65 77 73 74 61 74 75 73 20 6d 73 67 20 6f 74 68 ewstatus msg oth
13040 65 72 64 61 74 61 20 77 6f 72 6b 2d 61 72 65 61 erdata work-area
13050 3a 20 77 6f 72 6b 2d 61 72 65 61 29 29 29 29 0a : work-area)))).
13060 09 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 3a . (if (sqlite3:
13070 64 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 71 database? db)(sq
13080 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
13090 64 62 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 db)).. (set! *d
130a0 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
130b0 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
130c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
130d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
130e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
130f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
13100 20 56 61 72 69 6f 75 73 20 68 65 6c 70 65 72 20 Various helper
13110 63 6f 6d 6d 61 6e 64 73 20 63 61 6e 20 67 6f 20 commands can go
13120 62 65 6c 6f 77 20 68 65 72 65 0a 3b 3b 3d 3d 3d below here.;;===
13130 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 ===..(if (or (ar
13180 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f gs:get-arg "-sho
13190 77 6b 65 79 73 22 29 0a 20 20 20 20 20 20 20 20 wkeys").
131a0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
131b0 73 68 6f 77 2d 6b 65 79 73 22 29 29 0a 20 20 20 show-keys")).
131c0 20 28 6c 65 74 20 28 28 64 62 20 23 66 29 0a 09 (let ((db #f)..
131d0 20 20 28 6b 65 79 73 20 23 66 29 29 0a 20 20 20 (keys #f)).
131e0 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 (if (not (lau
131f0 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 nch:setup)).. (
13200 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 begin.. (debu
13210 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
13220 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 lt-log-port* "Fa
13230 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 iled to setup, e
13240 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 28 65 xiting").. (e
13250 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 xit 1))). (
13260 73 65 74 21 20 6b 65 79 73 20 28 72 6d 74 3a 67 set! keys (rmt:g
13270 65 74 2d 6b 65 79 73 29 29 20 3b 3b 20 20 64 62 et-keys)) ;; db
13280 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a )). (debug:
13290 70 72 69 6e 74 20 31 20 2a 64 65 66 61 75 6c 74 print 1 *default
132a0 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4b 65 79 73 -log-port* "Keys
132b0 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 : " (string-inte
132c0 72 73 70 65 72 73 65 20 6b 65 79 73 20 22 2c 20 rsperse keys ",
132d0 22 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 73 ")). (if (s
132e0 71 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f qlite3:database?
132f0 20 64 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e db)(sqlite3:fin
13300 61 6c 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 alize! db)).
13310 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
13320 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
13330 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
13340 22 2d 67 75 69 22 29 0a 20 20 20 20 28 62 65 67 "-gui"). (beg
13350 69 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a in. (debug:
13360 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
13370 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4c 6f 6f 6b -log-port* "Look
13380 20 61 74 20 74 68 65 20 64 61 73 68 62 6f 61 72 at the dashboar
13390 64 20 66 6f 72 20 6e 6f 77 22 29 0a 20 20 20 20 d for now").
133a0 20 20 3b 3b 20 28 6d 65 67 61 74 65 73 74 2d 67 ;; (megatest-g
133b0 75 69 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ui). (set!
133c0 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
133d0 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a t)))..(if (args:
133e0 67 65 74 2d 61 72 67 20 22 2d 63 72 65 61 74 65 get-arg "-create
133f0 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 22 29 -megatest-area")
13400 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
13410 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b (genexample:mk
13420 2d 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 -megatest.config
13430 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
13440 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
13450 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
13460 74 2d 61 72 67 20 22 2d 63 72 65 61 74 65 2d 74 t-arg "-create-t
13470 65 73 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 est"). (let (
13480 28 74 65 73 74 6e 61 6d 65 20 28 61 72 67 73 3a (testname (args:
13490 67 65 74 2d 61 72 67 20 22 2d 63 72 65 61 74 65 get-arg "-create
134a0 2d 74 65 73 74 22 29 29 29 0a 20 20 20 20 20 20 -test"))).
134b0 28 67 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d (genexample:mk-m
134c0 65 67 61 74 65 73 74 2d 74 65 73 74 20 74 65 73 egatest-test tes
134d0 74 6e 61 6d 65 29 0a 20 20 20 20 20 20 28 73 65 tname). (se
134e0 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
134f0 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d * #t)))..;;=====
13500 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13510 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13520 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13530 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13540 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 =.;; Update the
13550 64 61 74 61 62 61 73 65 20 73 63 68 65 6d 61 2c database schema,
13560 20 63 6c 65 61 6e 20 75 70 20 74 68 65 20 64 62 clean up the db
13570 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
13580 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13590 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
135a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
135b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
135c0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
135d0 65 62 75 69 6c 64 2d 64 62 22 29 0a 20 20 20 20 ebuild-db").
135e0 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 (begin. (if
135f0 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
13600 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a tup)).. (begin.
13610 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
13620 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
13630 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 -port* "Failed t
13640 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
13650 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 ") .. (exit 1
13660 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 ))). ;; kee
13670 70 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c p this one local
13680 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e . (open-run
13690 2d 63 6c 6f 73 65 20 70 61 74 63 68 2d 64 62 20 -close patch-db
136a0 23 66 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 #f). (set!
136b0 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
136c0 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a t)))..(if (args:
136d0 67 65 74 2d 61 72 67 20 22 2d 63 6c 65 61 6e 75 get-arg "-cleanu
136e0 70 2d 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 p-db"). (begi
136f0 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 n. (if (not
13700 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
13710 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
13720 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
13730 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
13740 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
13750 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 up, exiting") ..
13760 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
13770 20 20 20 20 20 28 6c 65 74 20 28 28 64 62 73 74 (let ((dbst
13780 72 75 63 74 20 28 64 62 3a 73 65 74 75 70 20 2a ruct (db:setup *
13790 74 6f 70 70 61 74 68 2a 29 29 29 0a 20 20 20 20 toppath*))).
137a0 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 63 6c 65 61 (common:clea
137b0 6e 75 70 2d 64 62 20 64 62 73 74 72 75 63 74 29 nup-db dbstruct)
137c0 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
137d0 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
137e0 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
137f0 74 2d 61 72 67 20 22 2d 6d 61 72 6b 2d 69 6e 63 t-arg "-mark-inc
13800 6f 6d 70 6c 65 74 65 73 22 29 0a 20 20 20 20 28 ompletes"). (
13810 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 begin. (if
13820 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 (not (launch:set
13830 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 up)).. (begin..
13840 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
13850 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
13860 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f port* "Failed to
13870 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
13880 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 ).. (exit 1))
13890 29 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 ). (open-ru
138a0 6e 2d 63 6c 6f 73 65 20 64 62 3a 66 69 6e 64 2d n-close db:find-
138b0 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c and-mark-incompl
138c0 65 74 65 20 23 66 29 0a 20 20 20 20 20 20 28 73 ete #f). (s
138d0 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
138e0 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d g* #t)))..;;====
138f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13900 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13910 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13920 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13930 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 ==.;; Update the
13940 20 74 65 73 74 73 20 6d 65 74 61 20 64 61 74 61 tests meta data
13950 20 66 72 6f 6d 20 74 68 65 20 74 65 73 74 63 6f from the testco
13960 6e 66 69 67 20 66 69 6c 65 73 0a 3b 3b 3d 3d 3d nfig files.;;===
13970 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13980 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13990 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
139a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
139b0 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
139c0 65 74 2d 61 72 67 20 22 2d 75 70 64 61 74 65 2d et-arg "-update-
139d0 6d 65 74 61 22 29 0a 20 20 20 20 28 62 65 67 69 meta"). (begi
139e0 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 n. (if (not
139f0 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
13a00 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
13a10 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
13a20 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
13a30 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
13a40 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 up, exiting") ..
13a50 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
13a60 20 20 20 20 20 28 72 75 6e 73 3a 75 70 64 61 74 (runs:updat
13a70 65 2d 61 6c 6c 2d 74 65 73 74 5f 6d 65 74 61 20 e-all-test_meta
13a80 23 66 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 #f). (set!
13a90 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
13aa0 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
13ab0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ac0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ad0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ae0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
13af0 3b 20 53 74 61 72 74 20 61 20 72 65 70 6c 0a 3b ; Start a repl.;
13b00 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
13b10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b40 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 66 61 6b 65 =======..;; fake
13b50 6f 75 74 20 72 65 61 64 6c 69 6e 65 0a 28 69 6e out readline.(in
13b60 63 6c 75 64 65 20 22 72 65 61 64 6c 69 6e 65 2d clude "readline-
13b70 66 69 78 2e 73 63 6d 22 29 0a 0a 0a 28 77 68 65 fix.scm")...(whe
13b80 6e 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 n (args:get-arg
13b90 22 2d 64 69 66 66 2d 72 65 70 22 29 0a 20 20 28 "-diff-rep"). (
13ba0 77 68 65 6e 20 28 61 6e 64 0a 20 20 20 20 20 20 when (and.
13bb0 20 20 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 (not (args:ge
13bc0 74 2d 61 72 67 20 22 2d 64 69 66 66 2d 68 74 6d t-arg "-diff-htm
13bd0 6c 22 29 29 0a 20 20 20 20 20 20 20 20 20 28 6e l")). (n
13be0 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
13bf0 20 22 2d 64 69 66 66 2d 65 6d 61 69 6c 22 29 29 "-diff-email"))
13c00 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
13c10 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
13c20 67 2d 70 6f 72 74 2a 20 22 4d 75 73 74 20 73 70 g-port* "Must sp
13c30 65 63 69 66 79 20 2d 64 69 66 66 2d 68 74 6d 6c ecify -diff-html
13c40 20 6f 72 20 2d 64 69 66 66 2d 65 6d 61 69 6c 20 or -diff-email
13c50 77 69 74 68 20 2d 64 69 66 66 2d 72 65 70 22 29 with -diff-rep")
13c60 0a 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 . (set! *dids
13c70 6f 6d 65 74 68 69 6e 67 2a 20 31 29 0a 20 20 20 omething* 1).
13c80 20 28 65 78 69 74 20 31 29 29 0a 20 20 0a 20 20 (exit 1)). .
13c90 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 (let* ((toppath
13ca0 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 (launch:setup)))
13cb0 0a 20 20 20 20 28 64 6f 2d 64 69 66 66 2d 72 65 . (do-diff-re
13cc0 70 6f 72 74 0a 20 20 20 20 20 28 61 72 67 73 3a port. (args:
13cd0 67 65 74 2d 61 72 67 20 22 2d 73 72 63 2d 74 61 get-arg "-src-ta
13ce0 72 67 65 74 22 29 0a 20 20 20 20 20 28 61 72 67 rget"). (arg
13cf0 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 72 63 2d s:get-arg "-src-
13d00 72 75 6e 6e 61 6d 65 22 29 0a 20 20 20 20 20 28 runname"). (
13d10 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
13d20 61 72 67 65 74 22 29 0a 20 20 20 20 20 28 61 72 arget"). (ar
13d30 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
13d40 6e 61 6d 65 22 29 0a 20 20 20 20 20 28 61 72 67 name"). (arg
13d50 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 69 66 66 s:get-arg "-diff
13d60 2d 68 74 6d 6c 22 29 0a 20 20 20 20 20 28 61 72 -html"). (ar
13d70 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 69 66 gs:get-arg "-dif
13d80 66 2d 65 6d 61 69 6c 22 29 29 0a 20 20 20 20 28 f-email")). (
13d90 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
13da0 6e 67 2a 20 23 74 29 0a 20 20 20 20 28 65 78 69 ng* #t). (exi
13db0 74 20 30 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 t 0)))..(if (or
13dc0 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 53 (getenv "MT_RUNS
13dd0 43 52 49 50 54 22 29 0a 09 28 61 72 67 73 3a 67 CRIPT")..(args:g
13de0 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 29 0a et-arg "-repl").
13df0 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
13e00 2d 6c 6f 61 64 22 29 29 0a 20 20 20 20 28 6c 65 -load")). (le
13e10 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 6c 61 t* ((toppath (la
13e20 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 unch:setup))..
13e30 20 28 64 62 73 74 72 75 63 74 20 28 69 66 20 28 (dbstruct (if (
13e40 61 6e 64 20 74 6f 70 70 61 74 68 0a 20 20 20 20 and toppath.
13e50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13e60 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f (commo
13e70 6e 3a 6f 6e 2d 68 6f 6d 65 68 6f 73 74 3f 29 29 n:on-homehost?))
13e80 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
13e90 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 73 65 (db:se
13ea0 74 75 70 29 0a 20 20 20 20 20 20 20 20 20 20 20 tup).
13eb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 #f
13ec0 29 29 29 20 3b 3b 20 6d 61 6b 65 2d 64 62 72 3a ))) ;; make-dbr:
13ed0 64 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 74 dbstruct path: t
13ee0 6f 70 70 61 74 68 20 6c 6f 63 61 6c 3a 20 28 61 oppath local: (a
13ef0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
13f00 63 61 6c 22 29 29 20 23 66 29 29 29 0a 20 20 20 cal")) #f))).
13f10 20 20 20 28 69 66 20 2a 74 6f 70 70 61 74 68 2a (if *toppath*
13f20 0a 09 20 20 28 63 6f 6e 64 0a 09 20 20 20 28 28 .. (cond.. ((
13f30 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 53 43 getenv "MT_RUNSC
13f40 52 49 50 54 22 29 0a 09 20 20 20 20 3b 3b 20 48 RIPT").. ;; H
13f50 6f 77 20 74 6f 20 72 75 6e 20 6d 65 67 61 74 65 ow to run megate
13f60 73 74 20 73 63 72 69 70 74 73 0a 09 20 20 20 20 st scripts..
13f70 3b 3b 0a 09 20 20 20 20 3b 3b 20 23 21 2f 62 69 ;;.. ;; #!/bi
13f80 6e 2f 62 61 73 68 0a 09 20 20 20 20 3b 3b 0a 09 n/bash.. ;;..
13f90 20 20 20 20 3b 3b 20 65 78 70 6f 72 74 20 4d 54 ;; export MT
13fa0 5f 52 55 4e 53 43 52 49 50 54 3d 79 65 73 0a 09 _RUNSCRIPT=yes..
13fb0 20 20 20 20 3b 3b 20 6d 65 67 61 74 65 73 74 20 ;; megatest
13fc0 3c 3c 20 45 4f 46 0a 09 20 20 20 20 3b 3b 20 28 << EOF.. ;; (
13fd0 70 72 69 6e 74 20 22 48 65 6c 6c 6f 20 77 6f 72 print "Hello wor
13fe0 6c 64 22 29 0a 09 20 20 20 20 3b 3b 20 28 65 78 ld").. ;; (ex
13ff0 69 74 29 0a 09 20 20 20 20 3b 3b 20 45 4f 46 0a it).. ;; EOF.
14000 0a 09 20 20 20 20 28 72 65 70 6c 29 29 0a 09 20 .. (repl))..
14010 20 20 28 65 6c 73 65 0a 09 20 20 20 20 28 62 65 (else.. (be
14020 67 69 6e 0a 09 20 20 20 20 20 20 28 73 65 74 21 gin.. (set!
14030 20 2a 64 62 2a 20 64 62 73 74 72 75 63 74 29 0a *db* dbstruct).
14040 09 20 20 20 20 20 20 28 69 6d 70 6f 72 74 20 65 . (import e
14050 78 74 72 61 73 29 20 3b 3b 20 6d 69 67 68 74 20 xtras) ;; might
14060 6e 6f 74 20 62 65 20 6e 65 65 64 65 64 0a 09 20 not be needed..
14070 20 20 20 20 20 3b 3b 20 28 69 6d 70 6f 72 74 20 ;; (import
14080 63 73 69 29 0a 09 20 20 20 20 20 20 28 69 6d 70 csi).. (imp
14090 6f 72 74 20 72 65 61 64 6c 69 6e 65 29 0a 09 20 ort readline)..
140a0 20 20 20 20 20 28 69 6d 70 6f 72 74 20 61 70 72 (import apr
140b0 6f 70 6f 73 29 0a 09 20 20 20 20 20 20 3b 3b 20 opos).. ;;
140c0 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 (import (prefix
140d0 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a sqlite3 sqlite3:
140e0 29 29 20 3b 3b 20 64 6f 65 73 6e 27 74 20 77 6f )) ;; doesn't wo
140f0 72 6b 20 2e 2e 2e 0a 0a 09 20 20 20 20 20 20 28 rk ...... (
14100 69 66 20 2a 75 73 65 2d 6e 65 77 2d 72 65 61 64 if *use-new-read
14110 6c 69 6e 65 2a 0a 09 09 20 20 28 62 65 67 69 6e line*... (begin
14120 0a 09 09 20 20 20 20 28 69 6e 73 74 61 6c 6c 2d ... (install-
14130 68 69 73 74 6f 72 79 2d 66 69 6c 65 20 28 67 65 history-file (ge
14140 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
14150 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 riable "HOME") "
14160 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 74 6f 72 .megatest_histor
14170 79 22 29 20 3b 3b 20 20 5b 68 6f 6d 65 64 69 72 y") ;; [homedir
14180 5d 20 5b 66 69 6c 65 6e 61 6d 65 5d 20 5b 6e 6c ] [filename] [nl
14190 69 6e 65 73 5d 29 0a 09 09 20 20 20 20 28 63 75 ines])... (cu
141a0 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 rrent-input-port
141b0 20 28 6d 61 6b 65 2d 72 65 61 64 6c 69 6e 65 2d (make-readline-
141c0 70 6f 72 74 20 22 6d 65 67 61 74 65 73 74 3e 20 port "megatest>
141d0 22 29 29 29 0a 09 09 20 20 28 62 65 67 69 6e 0a ")))... (begin.
141e0 09 09 20 20 20 20 28 67 6e 75 2d 68 69 73 74 6f .. (gnu-histo
141f0 72 79 2d 69 6e 73 74 61 6c 6c 2d 66 69 6c 65 2d ry-install-file-
14200 6d 61 6e 61 67 65 72 0a 09 09 20 20 20 20 20 28 manager... (
14210 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 0a 09 09 string-append...
14220 20 20 20 20 20 20 28 6f 72 20 28 67 65 74 2d 65 (or (get-e
14230 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
14240 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2e 22 29 ble "HOME") ".")
14250 20 22 2f 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 "/.megatest_his
14260 74 6f 72 79 22 29 29 0a 09 09 20 20 20 20 28 63 tory"))... (c
14270 75 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 urrent-input-por
14280 74 20 28 6d 61 6b 65 2d 67 6e 75 2d 72 65 61 64 t (make-gnu-read
14290 6c 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 line-port "megat
142a0 65 73 74 3e 20 22 29 29 29 29 0a 09 20 20 20 20 est> "))))..
142b0 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
142c0 61 72 67 20 22 2d 72 65 70 6c 22 29 0a 09 09 20 arg "-repl")...
142d0 20 28 72 65 70 6c 29 0a 09 09 20 20 28 6c 6f 61 (repl)... (loa
142e0 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
142f0 22 2d 6c 6f 61 64 22 29 29 29 0a 09 20 20 20 20 "-load")))..
14300 20 20 3b 3b 20 28 64 62 3a 63 6c 6f 73 65 2d 61 ;; (db:close-a
14310 6c 6c 20 64 62 73 74 72 75 63 74 29 20 3c 3d 20 ll dbstruct) <=
14320 74 61 6b 65 6e 20 63 61 72 65 20 6f 66 20 62 79 taken care of by
14330 20 6f 6e 2d 65 78 69 74 20 63 61 6c 6c 0a 09 20 on-exit call..
14340 20 20 20 20 20 29 0a 09 20 20 20 20 28 65 78 69 ).. (exi
14350 74 29 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 t))).. (set! *d
14360 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
14370 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
14380 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14390 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
143a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
143b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
143c0 20 57 61 69 74 20 6f 6e 20 61 20 72 75 6e 20 74 Wait on a run t
143d0 6f 20 63 6f 6d 70 6c 65 74 65 0a 3b 3b 3d 3d 3d o complete.;;===
143e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
143f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14400 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14410 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14420 3d 3d 3d 0a 0a 28 69 66 20 28 61 6e 64 20 28 61 ===..(if (and (a
14430 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
14440 6e 2d 77 61 69 74 22 29 0a 09 20 28 6e 6f 74 20 n-wait").. (not
14450 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
14460 67 20 22 2d 72 75 6e 22 29 0a 09 09 20 20 28 61 g "-run")... (a
14470 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
14480 6e 74 65 73 74 73 22 29 29 29 29 20 3b 3b 20 72 ntests")))) ;; r
14490 75 6e 2d 77 61 69 74 20 69 73 20 62 75 69 6c 74 un-wait is built
144a0 20 69 6e 74 6f 20 72 75 6e 74 65 73 74 73 20 6e into runtests n
144b0 6f 77 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 ow. (begin.
144c0 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 (if (not (la
144d0 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 unch:setup))..
144e0 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 (begin.. (deb
144f0 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
14500 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 ult-log-port* "F
14510 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 ailed to setup,
14520 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 exiting") ..
14530 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 (exit 1))).
14540 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 72 75 (operate-on 'ru
14550 6e 2d 77 61 69 74 29 0a 20 20 20 20 20 20 28 73 n-wait). (s
14560 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
14570 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 3b 3b 20 g* #t)))..;; ;;
14580 3b 3b 20 72 65 64 6f 20 6d 65 20 3b 3b 20 4e 6f ;; redo me ;; No
14590 74 20 63 6f 6e 76 65 72 74 65 64 20 74 6f 20 75 t converted to u
145a0 73 65 20 64 62 73 74 72 75 63 74 20 79 65 74 0a se dbstruct yet.
145b0 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
145c0 20 3b 3b 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ;;.;; ;; ;; red
145d0 6f 20 6d 65 20 28 69 66 20 28 61 72 67 73 3a 67 o me (if (args:g
145e0 65 74 2d 61 72 67 20 22 2d 63 6f 6e 76 65 72 74 et-arg "-convert
145f0 2d 74 6f 2d 6e 6f 72 6d 22 29 0a 3b 3b 20 3b 3b -to-norm").;; ;;
14600 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 ;; redo me
14610 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 (let* ((toppath
14620 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
14630 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
14640 65 20 09 20 20 20 28 64 62 73 74 72 75 63 74 20 e . (dbstruct
14650 28 69 66 20 74 6f 70 70 61 74 68 20 28 6d 61 6b (if toppath (mak
14660 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 e-dbr:dbstruct p
14670 61 74 68 3a 20 74 6f 70 70 61 74 68 20 6c 6f 63 ath: toppath loc
14680 61 6c 3a 20 23 74 29 29 29 29 0a 3b 3b 20 3b 3b al: #t)))).;; ;;
14690 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 ;; redo me
146a0 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 3b 3b 20 (for-each .;;
146b0 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
146c0 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 69 (lambda (fi
146d0 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 eld).;; ;; ;; re
146e0 64 6f 20 6d 65 20 09 20 28 6c 65 74 20 28 28 64 do me . (let ((d
146f0 61 74 20 27 28 29 29 29 0a 3b 3b 20 3b 3b 20 3b at '())).;; ;; ;
14700 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 64 ; redo me . (d
14710 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
14720 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
14730 6f 72 74 2a 20 22 47 65 74 74 69 6e 67 20 64 61 ort* "Getting da
14740 74 61 20 66 6f 72 20 66 69 65 6c 64 20 22 20 66 ta for field " f
14750 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 ield).;; ;; ;; r
14760 65 64 6f 20 6d 65 20 09 20 20 20 28 73 71 6c 69 edo me . (sqli
14770 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
14780 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
14790 65 20 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 e . (lambda (
147a0 69 64 20 76 61 6c 29 0a 3b 3b 20 3b 3b 20 3b 3b id val).;; ;; ;;
147b0 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 20 redo me .
147c0 28 73 65 74 21 20 64 61 74 20 28 63 6f 6e 73 20 (set! dat (cons
147d0 28 6c 69 73 74 20 69 64 20 76 61 6c 29 20 64 61 (list id val) da
147e0 74 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 t))).;; ;; ;; re
147f0 64 6f 20 6d 65 20 09 20 20 20 20 28 64 62 3a 67 do me . (db:g
14800 65 74 2d 64 62 20 64 62 20 72 75 6e 2d 69 64 29 et-db db run-id)
14810 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
14820 65 20 09 20 20 20 20 28 63 6f 6e 63 20 22 53 45 e . (conc "SE
14830 4c 45 43 54 20 69 64 2c 22 20 66 69 65 6c 64 20 LECT id," field
14840 22 20 46 52 4f 4d 20 74 65 73 74 73 3b 22 29 29 " FROM tests;"))
14850 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
14860 65 20 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 e . (debug:pri
14870 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
14880 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 6f lt-log-port* "fo
14890 75 6e 64 20 22 20 28 6c 65 6e 67 74 68 20 64 61 und " (length da
148a0 74 29 20 22 20 69 74 65 6d 73 20 66 6f 72 20 66 t) " items for f
148b0 69 65 6c 64 20 22 20 66 69 65 6c 64 29 0a 3b 3b ield " field).;;
148c0 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
148d0 20 20 20 28 6c 65 74 20 28 28 71 72 79 20 28 73 (let ((qry (s
148e0 71 6c 69 74 65 33 3a 70 72 65 70 61 72 65 20 64 qlite3:prepare d
148f0 62 20 28 63 6f 6e 63 20 22 55 50 44 41 54 45 20 b (conc "UPDATE
14900 74 65 73 74 73 20 53 45 54 20 22 20 66 69 65 6c tests SET " fiel
14910 64 20 22 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f d "=? WHERE id=?
14920 3b 22 29 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 ;")))).;; ;; ;;
14930 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 28 66 redo me . (f
14940 6f 72 2d 65 61 63 68 0a 3b 3b 20 3b 3b 20 3b 3b or-each.;; ;; ;;
14950 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 20 redo me .
14960 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 3b (lambda (item).;
14970 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
14980 09 09 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 ..(let ((newval
14990 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 67 65 74 ;; (sdb:qry 'get
149a0 69 64 20 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 id .;; ;; ;; red
149b0 6f 20 6d 65 20 09 09 20 20 20 20 20 20 20 28 63 o me .. (c
149c0 61 64 72 20 69 74 65 6d 29 29 29 20 3b 3b 20 29 adr item))) ;; )
149d0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
149e0 65 20 09 09 20 20 28 69 66 20 28 6e 6f 74 20 28 e .. (if (not (
149f0 65 71 75 61 6c 3f 20 6e 65 77 76 61 6c 20 28 63 equal? newval (c
14a00 61 64 72 20 69 74 65 6d 29 29 29 0a 3b 3b 20 3b adr item))).;; ;
14a10 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 20 ; ;; redo me ..
14a20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
14a30 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
14a40 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 6f 6e t-log-port* "Con
14a50 76 65 72 74 69 6e 67 20 22 20 28 63 61 64 72 20 verting " (cadr
14a60 69 74 65 6d 29 20 22 20 74 6f 20 22 20 6e 65 77 item) " to " new
14a70 76 61 6c 20 22 20 66 6f 72 20 74 65 73 74 20 23 val " for test #
14a80 22 20 28 63 61 72 20 69 74 65 6d 29 29 29 0a 3b " (car item))).;
14a90 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
14aa0 09 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 .. (sqlite3:exe
14ab0 63 75 74 65 20 71 72 79 20 6e 65 77 76 61 6c 20 cute qry newval
14ac0 28 63 61 72 20 69 74 65 6d 29 29 29 29 0a 3b 3b (car item)))).;;
14ad0 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
14ae0 20 20 20 20 20 20 64 61 74 29 0a 3b 3b 20 3b 3b dat).;; ;;
14af0 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
14b00 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
14b10 69 7a 65 21 20 71 72 79 29 29 29 29 0a 3b 3b 20 ize! qry)))).;;
14b20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
14b30 20 20 20 20 20 28 64 62 3a 63 6c 6f 73 65 2d 61 (db:close-a
14b40 6c 6c 20 64 62 73 74 72 75 63 74 29 0a 3b 3b 20 ll dbstruct).;;
14b50 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
14b60 20 20 20 20 20 28 6c 69 73 74 20 22 75 6e 61 6d (list "unam
14b70 65 22 20 22 72 75 6e 64 69 72 22 20 22 66 69 6e e" "rundir" "fin
14b80 61 6c 5f 6c 6f 67 66 22 20 22 63 6f 6d 6d 65 6e al_logf" "commen
14b90 74 22 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 t")).;; ;; ;; re
14ba0 64 6f 20 6d 65 20 20 20 20 20 20 20 28 73 65 74 do me (set
14bb0 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
14bc0 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
14bd0 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 6d 70 6f s:get-arg "-impo
14be0 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 29 rt-megatest.db")
14bf0 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
14c00 20 20 28 64 62 3a 6d 75 6c 74 69 2d 64 62 2d 73 (db:multi-db-s
14c10 79 6e 63 20 0a 20 20 20 20 20 20 20 28 64 62 3a ync . (db:
14c20 73 65 74 75 70 29 0a 20 20 20 20 20 20 20 27 6b setup). 'k
14c30 69 6c 6c 73 65 72 76 65 72 73 0a 20 20 20 20 20 illservers.
14c40 20 20 27 64 65 6a 75 6e 6b 0a 20 20 20 20 20 20 'dejunk.
14c50 20 27 61 64 6a 2d 74 65 73 74 69 64 73 0a 20 20 'adj-testids.
14c60 20 20 20 20 20 27 6f 6c 64 32 6e 65 77 0a 20 20 'old2new.
14c70 20 20 20 20 20 3b 3b 20 27 6e 65 77 32 6f 6c 64 ;; 'new2old
14c80 0a 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 20 . ).
14c90 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
14ca0 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
14cb0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
14cc0 73 79 6e 63 2d 74 6f 2d 6d 65 67 61 74 65 73 74 sync-to-megatest
14cd0 2e 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e .db"). (begin
14ce0 0a 20 20 20 20 20 20 28 64 62 3a 6d 75 6c 74 69 . (db:multi
14cf0 2d 64 62 2d 73 79 6e 63 20 0a 20 20 20 20 20 20 -db-sync .
14d00 20 28 64 62 3a 73 65 74 75 70 29 0a 20 20 20 20 (db:setup).
14d10 20 20 20 27 6e 65 77 32 6f 6c 64 0a 20 20 20 20 'new2old.
14d20 20 20 20 29 0a 20 20 20 20 20 20 28 73 65 74 21 ). (set!
14d30 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
14d40 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 #t)))..(if (args
14d50 3a 67 65 74 2d 61 72 67 20 22 2d 73 79 6e 63 2d :get-arg "-sync-
14d60 74 6f 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 to"). (let ((
14d70 74 6f 70 70 61 74 68 20 28 6c 61 75 6e 63 68 3a toppath (launch:
14d80 73 65 74 75 70 29 29 29 0a 20 20 20 20 20 20 28 setup))). (
14d90 74 61 73 6b 73 3a 73 79 6e 63 2d 74 6f 2d 70 6f tasks:sync-to-po
14da0 73 74 67 72 65 73 20 2a 63 6f 6e 66 69 67 64 61 stgres *configda
14db0 74 2a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 t* (args:get-arg
14dc0 20 22 2d 73 79 6e 63 2d 74 6f 22 29 29 0a 20 20 "-sync-to")).
14dd0 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
14de0 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
14df0 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
14e00 67 20 22 2d 67 65 6e 65 72 61 74 65 2d 68 74 6d g "-generate-htm
14e10 6c 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 l"). (let* ((
14e20 74 6f 70 70 61 74 68 20 28 6c 61 75 6e 63 68 3a toppath (launch:
14e30 73 65 74 75 70 29 29 29 0a 20 20 20 20 20 20 28 setup))). (
14e40 69 66 20 28 74 65 73 74 73 3a 63 72 65 61 74 65 if (tests:create
14e50 2d 68 74 6d 6c 2d 74 72 65 65 20 23 66 29 0a 20 -html-tree #f).
14e60 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
14e70 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
14e80 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
14e90 22 48 54 4d 4c 20 6f 75 74 70 75 74 20 63 72 65 "HTML output cre
14ea0 61 74 65 64 20 69 6e 20 22 20 74 6f 70 70 61 74 ated in " toppat
14eb0 68 20 22 2f 6c 74 2f 70 61 67 65 23 2e 68 74 6d h "/lt/page#.htm
14ec0 6c 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 64 l"). (d
14ed0 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
14ee0 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
14ef0 22 46 61 69 6c 65 64 20 74 6f 20 63 72 65 61 74 "Failed to creat
14f00 65 20 48 54 4d 4c 20 6f 75 74 70 75 74 20 69 6e e HTML output in
14f10 20 22 20 74 6f 70 70 61 74 68 20 22 2f 6c 74 2f " toppath "/lt/
14f20 72 75 6e 73 2d 69 6e 64 65 78 2e 68 74 6d 6c 22 runs-index.html"
14f30 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
14f40 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
14f50 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
14f60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14f70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14f80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14f90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
14fa0 20 45 78 69 74 20 61 6e 64 20 63 6c 65 61 6e 20 Exit and clean
14fb0 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d up.;;===========
14fc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14fd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14fe0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14ff0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
15000 20 28 6e 6f 74 20 2a 64 69 64 73 6f 6d 65 74 68 (not *didsometh
15010 69 6e 67 2a 29 0a 20 20 20 20 28 64 65 62 75 67 ing*). (debug
15020 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
15030 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 68 65 6c 70 t-log-port* help
15040 29 0a 20 20 20 20 28 73 65 74 21 20 2a 74 69 6d ). (set! *tim
15050 65 2d 74 6f 2d 65 78 69 74 2a 20 23 74 29 0a 20 e-to-exit* #t).
15060 20 20 20 29 0a 3b 3b 28 64 65 62 75 67 3a 70 72 ).;;(debug:pr
15070 69 6e 74 2d 69 6e 66 6f 20 31 33 20 2a 64 65 66 int-info 13 *def
15080 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
15090 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 77 61 74 thread-join! wat
150a0 63 68 64 6f 67 22 29 0a 0a 3b 3b 20 6a 6f 69 6e chdog")..;; join
150b0 20 74 68 65 20 77 61 74 63 68 64 6f 67 20 74 68 the watchdog th
150c0 72 65 61 64 20 69 66 20 69 74 20 68 61 73 20 62 read if it has b
150d0 65 65 6e 20 74 68 72 65 61 64 2d 73 74 61 72 74 een thread-start
150e0 21 65 64 20 20 28 69 74 20 6d 61 79 20 6e 6f 74 !ed (it may not
150f0 20 68 61 76 65 20 62 65 65 6e 20 73 74 61 72 74 have been start
15100 65 64 20 69 6e 20 74 68 65 20 63 61 73 65 20 6f ed in the case o
15110 66 20 61 20 73 65 72 76 65 72 20 74 68 61 74 20 f a server that
15120 6e 65 76 65 72 20 65 6e 74 65 72 73 20 72 75 6e never enters run
15130 6e 69 6e 67 20 73 74 61 74 65 29 0a 3b 3b 20 20 ning state).;;
15140 20 28 73 79 6d 62 6f 6c 73 20 72 65 74 75 72 6e (symbols return
15150 65 64 20 62 79 20 74 68 72 65 61 64 2d 73 74 61 ed by thread-sta
15160 74 65 3a 20 63 72 65 61 74 65 64 20 72 65 61 64 te: created read
15170 79 20 72 75 6e 6e 69 6e 67 20 62 6c 6f 63 6b 65 y running blocke
15180 64 20 73 75 73 70 65 6e 64 65 64 20 73 6c 65 65 d suspended slee
15190 70 69 6e 67 20 74 65 72 6d 69 6e 61 74 65 64 20 ping terminated
151a0 64 65 61 64 29 0a 3b 3b 20 54 4f 44 4f 3a 20 66 dead).;; TODO: f
151b0 6f 72 20 6d 75 6c 74 69 70 6c 65 20 61 72 65 61 or multiple area
151c0 73 2c 20 77 65 20 77 69 6c 6c 20 68 61 76 65 20 s, we will have
151d0 6d 75 6c 74 69 70 6c 65 20 77 61 74 63 68 64 6f multiple watchdo
151e0 67 73 3b 20 61 6e 64 20 6d 75 6c 74 69 70 6c 65 gs; and multiple
151f0 20 74 68 72 65 61 64 73 20 74 6f 20 6d 61 6e 61 threads to mana
15200 67 65 0a 28 69 66 20 28 74 68 72 65 61 64 3f 20 ge.(if (thread?
15210 2a 77 61 74 63 68 64 6f 67 2a 29 0a 20 20 20 20 *watchdog*).
15220 28 63 61 73 65 20 28 74 68 72 65 61 64 2d 73 74 (case (thread-st
15230 61 74 65 20 2a 77 61 74 63 68 64 6f 67 2a 29 0a ate *watchdog*).
15240 20 20 20 20 20 20 28 28 72 65 61 64 79 20 72 75 ((ready ru
15250 6e 6e 69 6e 67 20 62 6c 6f 63 6b 65 64 20 73 6c nning blocked sl
15260 65 65 70 69 6e 67 20 74 65 72 6d 69 6e 61 74 65 eeping terminate
15270 64 20 64 65 61 64 29 0a 20 20 20 20 20 20 20 28 d dead). (
15280 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 2a 77 61 thread-join! *wa
15290 74 63 68 64 6f 67 2a 29 29 29 29 0a 0a 28 73 65 tchdog*))))..(se
152a0 74 21 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 t! *time-to-exit
152b0 2a 20 23 74 29 0a 0a 28 69 66 20 28 6e 6f 74 20 * #t)..(if (not
152c0 28 65 71 3f 20 2a 67 6c 6f 62 61 6c 65 78 69 74 (eq? *globalexit
152d0 73 74 61 74 75 73 2a 20 30 29 29 0a 20 20 20 20 status* 0)).
152e0 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
152f0 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 28 61 72 t-arg "-run")(ar
15300 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
15310 74 65 73 74 73 22 29 28 61 72 67 73 3a 67 65 74 tests")(args:get
15320 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 29 -arg "-runall"))
15330 0a 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a . (begin.
15340 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 (debu
15350 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
15360 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 4f lt-log-port* "NO
15370 54 45 3a 20 53 75 62 70 72 6f 63 65 73 73 65 73 TE: Subprocesses
15380 20 77 69 74 68 20 6e 6f 6e 2d 7a 65 72 6f 20 65 with non-zero e
15390 78 69 74 20 63 6f 64 65 20 64 65 74 65 63 74 65 xit code detecte
153a0 64 3a 20 22 20 2a 67 6c 6f 62 61 6c 65 78 69 74 d: " *globalexit
153b0 73 74 61 74 75 73 2a 29 0a 20 20 20 20 20 20 20 status*).
153c0 20 20 20 20 28 65 78 69 74 20 30 29 29 0a 20 20 (exit 0)).
153d0 20 20 20 20 20 20 28 63 61 73 65 20 2a 67 6c 6f (case *glo
153e0 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 0a 20 balexitstatus*.
153f0 20 20 20 20 20 20 20 20 28 28 30 29 28 65 78 69 ((0)(exi
15400 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 28 t 0)). (
15410 28 31 29 28 65 78 69 74 20 31 29 29 0a 20 20 20 (1)(exit 1)).
15420 20 20 20 20 20 20 28 28 32 29 28 65 78 69 74 20 ((2)(exit
15430 32 29 29 0a 20 20 20 20 20 20 20 20 20 28 65 6c 2)). (el
15440 73 65 20 28 65 78 69 74 20 33 29 29 29 29 29 0a se (exit 3))))).