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 20 20 -start-dir")).
3920: 20 20 20 20 20 20 28 6c 65 74 20 28 28 66 75 6c (let ((ful
3930: 6c 70 61 74 68 20 28 63 6f 6d 6d 6f 6e 3a 72 65 lpath (common:re
3940: 61 6c 2d 70 61 74 68 20 28 61 72 67 73 3a 67 65 al-path (args:ge
3950: 74 2d 61 72 67 20 22 2d 73 74 61 72 74 2d 64 69 t-arg "-start-di
3960: 72 22 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 r")))).
3970: 20 28 73 65 74 65 6e 76 20 22 50 57 44 22 20 66 (setenv "PWD" f
3980: 75 6c 6c 70 61 74 68 29 0a 20 20 20 20 20 20 20 ullpath).
3990: 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 (change-direc
39a0: 74 6f 72 79 20 66 75 6c 6c 70 61 74 68 29 29 0a tory fullpath)).
39b0: 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 .(begin.. (debu
39c0: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
39d0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
39e0: 74 2a 20 22 6e 6f 6e 2d 65 78 69 73 74 61 6e 74 t* "non-existant
39f0: 20 73 74 61 72 74 20 64 69 72 20 22 20 28 61 72 start dir " (ar
3a00: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 gs:get-arg "-sta
3a10: 72 74 2d 64 69 72 22 29 20 22 20 73 70 65 63 69 rt-dir") " speci
3a20: 66 69 65 64 2c 20 65 78 69 74 69 6e 67 2e 22 29 fied, exiting.")
3a30: 0a 09 20 20 28 65 78 69 74 20 31 29 29 29 29 0a .. (exit 1)))).
3a40: 0a 3b 3b 20 69 6d 6d 65 64 69 61 74 65 6c 79 20 .;; immediately
3a50: 73 65 74 20 4d 54 5f 54 41 52 47 45 54 20 69 66 set MT_TARGET if
3a60: 20 2d 72 65 71 74 61 72 67 20 6f 72 20 2d 74 61 -reqtarg or -ta
3a70: 72 67 65 74 20 61 72 65 20 61 76 61 69 6c 61 62 rget are availab
3a80: 6c 65 0a 3b 3b 0a 28 6c 65 74 20 28 28 74 61 72 le.;;.(let ((tar
3a90: 67 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d g (or (args:get-
3aa0: 61 72 67 20 22 2d 72 65 71 74 61 72 67 22 29 28 arg "-reqtarg")(
3ab0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
3ac0: 61 72 67 65 74 22 29 29 29 29 0a 20 20 28 69 66 arget")))). (if
3ad0: 20 74 61 72 67 20 28 73 65 74 65 6e 76 20 22 4d targ (setenv "M
3ae0: 54 5f 54 41 52 47 45 54 22 20 74 61 72 67 29 29 T_TARGET" targ))
3af0: 29 0a 0a 3b 3b 20 54 68 65 20 77 61 74 63 68 64 )..;; The watchd
3b00: 6f 67 20 69 73 20 74 6f 20 6b 65 65 70 20 61 6e og is to keep an
3b10: 20 65 79 65 20 6f 6e 20 74 68 69 6e 67 73 20 6c eye on things l
3b20: 69 6b 65 20 64 62 20 73 79 6e 63 20 65 74 63 2e ike db sync etc.
3b30: 0a 3b 3b 0a 0a 3b 3b 20 54 4f 44 4f 3a 20 66 6f .;;..;; TODO: fo
3b40: 72 20 6d 75 6c 74 69 70 6c 65 20 61 72 65 61 73 r multiple areas
3b50: 2c 20 77 65 20 77 69 6c 6c 20 68 61 76 65 20 6d , we will have m
3b60: 75 6c 74 69 70 6c 65 20 77 61 74 63 68 64 6f 67 ultiple watchdog
3b70: 73 3b 20 61 6e 64 20 6d 75 6c 74 69 70 6c 65 20 s; and multiple
3b80: 74 68 72 65 61 64 73 20 74 6f 20 6d 61 6e 61 67 threads to manag
3b90: 65 0a 28 64 65 66 69 6e 65 20 2a 77 61 74 63 68 e.(define *watch
3ba0: 64 6f 67 2a 20 28 6d 61 6b 65 2d 74 68 72 65 61 dog* (make-threa
3bb0: 64 20 63 6f 6d 6d 6f 6e 3a 77 61 74 63 68 64 6f d common:watchdo
3bc0: 67 20 22 57 61 74 63 68 64 6f 67 20 74 68 72 65 g "Watchdog thre
3bd0: 61 64 22 29 29 0a 0a 3b 3b 28 69 66 20 28 6e 6f ad"))..;;(if (no
3be0: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
3bf0: 22 2d 73 65 72 76 65 72 22 29 29 0a 3b 3b 20 20 "-server")).;;
3c00: 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 (thread-start!
3c10: 20 2a 77 61 74 63 68 64 6f 67 2a 29 29 20 3b 3b *watchdog*)) ;;
3c20: 20 69 66 20 73 74 61 72 74 69 6e 67 20 61 20 73 if starting a s
3c30: 65 72 76 65 72 3b 20 77 61 69 74 20 74 69 6c 6c erver; wait till
3c40: 20 77 65 20 67 65 74 20 74 6f 20 72 75 6e 6e 69 we get to runni
3c50: 6e 67 20 73 74 61 74 65 20 62 65 66 6f 72 65 20 ng state before
3c60: 6b 69 63 6b 69 6e 67 20 6f 66 66 20 77 61 74 63 kicking off watc
3c70: 68 64 6f 67 0a 28 6c 65 74 2a 20 28 28 6e 6f 2d hdog.(let* ((no-
3c80: 77 61 74 63 68 64 6f 67 2d 61 72 67 73 0a 20 20 watchdog-args.
3c90: 20 20 20 20 20 27 28 22 2d 6c 69 73 74 2d 72 75 '("-list-ru
3ca0: 6e 73 22 0a 20 20 20 20 20 20 20 20 20 22 2d 6c ns". "-l
3cb0: 69 73 74 2d 73 65 72 76 65 72 73 22 0a 20 20 20 ist-servers".
3cc0: 20 20 20 20 20 20 22 2d 73 65 72 76 65 72 22 0a "-server".
3cd0: 20 20 20 20 20 20 20 20 20 22 2d 6c 69 73 74 2d "-list-
3ce0: 64 69 73 6b 73 22 0a 20 20 20 20 20 20 20 20 20 disks".
3cf0: 22 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 22 0a "-list-targets".
3d00: 20 20 20 20 20 20 20 20 20 22 2d 73 68 6f 77 2d "-show-
3d10: 72 75 6e 63 6f 6e 66 69 67 22 0a 20 20 20 20 20 runconfig".
3d20: 20 20 20 20 3b 3b 22 2d 6c 69 73 74 2d 64 62 2d ;;"-list-db-
3d30: 74 61 72 67 65 74 73 22 0a 20 20 20 20 20 20 20 targets".
3d40: 20 20 22 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 "-show-runconf
3d50: 69 67 22 0a 20 20 20 20 20 20 20 20 20 22 2d 73 ig". "-s
3d60: 68 6f 77 2d 63 6f 6e 66 69 67 22 0a 20 20 20 20 how-config".
3d70: 20 20 20 20 20 22 2d 73 68 6f 77 2d 63 6d 64 69 "-show-cmdi
3d80: 6e 66 6f 22 29 29 0a 20 20 20 20 20 20 20 28 6e nfo")). (n
3d90: 6f 2d 77 61 74 63 68 64 6f 67 2d 61 72 67 73 2d o-watchdog-args-
3da0: 76 61 6c 73 20 28 66 69 6c 74 65 72 20 28 6c 61 vals (filter (la
3db0: 6d 62 64 61 20 28 78 29 20 78 29 0a 20 20 20 20 mbda (x) x).
3dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3de0: 20 20 28 6d 61 70 20 61 72 67 73 3a 67 65 74 2d (map args:get-
3df0: 61 72 67 20 6e 6f 2d 77 61 74 63 68 64 6f 67 2d arg no-watchdog-
3e00: 61 72 67 73 29 29 29 0a 20 20 20 20 20 20 20 28 args))). (
3e10: 73 74 61 72 74 2d 77 61 74 63 68 64 6f 67 20 28 start-watchdog (
3e20: 6e 75 6c 6c 3f 20 6e 6f 2d 77 61 74 63 68 64 6f null? no-watchdo
3e30: 67 2d 61 72 67 73 2d 76 61 6c 73 29 29 29 0a 20 g-args-vals))).
3e40: 20 3b 3b 28 42 42 3e 20 22 6e 6f 2d 77 61 74 63 ;;(BB> "no-watc
3e50: 68 64 6f 67 2d 61 72 67 73 3d 22 6e 6f 2d 77 61 hdog-args="no-wa
3e60: 74 63 68 64 6f 67 2d 61 72 67 73 20 22 6e 6f 2d tchdog-args "no-
3e70: 77 61 74 63 68 64 6f 67 2d 61 72 67 73 2d 76 61 watchdog-args-va
3e80: 6c 73 3d 22 6e 6f 2d 77 61 74 63 68 64 6f 67 2d ls="no-watchdog-
3e90: 61 72 67 73 2d 76 61 6c 73 29 20 0a 20 20 28 69 args-vals) . (i
3ea0: 66 20 73 74 61 72 74 2d 77 61 74 63 68 64 6f 67 f start-watchdog
3eb0: 0a 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 . (thread-s
3ec0: 74 61 72 74 21 20 2a 77 61 74 63 68 64 6f 67 2a tart! *watchdog*
3ed0: 29 29 29 0a 0a 0a 3b 3b 20 62 72 61 63 6b 65 74 )))...;; bracket
3ee0: 20 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c open-output-fil
3ef0: 65 20 77 69 74 68 20 63 6f 64 65 20 74 6f 20 6d e with code to m
3f00: 61 6b 65 20 6c 65 61 64 69 6e 67 20 64 69 72 65 ake leading dire
3f10: 63 74 6f 72 79 20 69 66 20 69 74 20 64 6f 65 73 ctory if it does
3f20: 20 6e 6f 74 20 65 78 69 73 74 20 61 6e 64 20 68 not exist and h
3f30: 61 6e 64 6c 65 20 65 78 63 65 70 74 69 6f 6e 73 andle exceptions
3f40: 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 6c .(define (open-l
3f50: 6f 67 66 69 6c 65 20 6c 6f 67 70 61 74 68 29 0a ogfile logpath).
3f60: 20 20 28 63 6f 6e 64 69 74 69 6f 6e 2d 63 61 73 (condition-cas
3f70: 65 0a 20 20 20 28 6c 65 74 2a 20 28 28 6c 6f 67 e. (let* ((log
3f80: 2d 64 69 72 20 28 6f 72 20 28 70 61 74 68 6e 61 -dir (or (pathna
3f90: 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 6f 67 me-directory log
3fa0: 70 61 74 68 29 20 22 2e 22 29 29 29 0a 20 20 20 path) "."))).
3fb0: 20 20 28 69 66 20 28 6e 6f 74 20 28 64 69 72 65 (if (not (dire
3fc0: 63 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 6c 6f ctory-exists? lo
3fd0: 67 2d 64 69 72 29 29 0a 20 20 20 20 20 20 20 20 g-dir)).
3fe0: 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
3ff0: 6d 6b 64 69 72 20 2d 70 20 22 20 6c 6f 67 2d 64 mkdir -p " log-d
4000: 69 72 29 29 29 0a 20 20 20 20 20 28 6f 70 65 6e ir))). (open
4010: 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 6c 6f 67 -output-file log
4020: 70 61 74 68 29 29 0a 20 20 20 28 65 78 6e 20 28 path)). (exn (
4030: 29 0a 20 20 20 20 20 20 20 20 28 64 65 62 75 67 ). (debug
4040: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
4050: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
4060: 2a 20 22 43 6f 75 6c 64 20 6e 6f 74 20 6f 70 65 * "Could not ope
4070: 6e 20 6c 6f 67 20 66 69 6c 65 20 66 6f 72 20 77 n log file for w
4080: 72 69 74 65 3a 20 22 6c 6f 67 70 61 74 68 29 0a rite: "logpath).
4090: 20 20 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 (define
40a0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
40b0: 74 29 20 20 0a 20 20 20 20 20 20 20 20 28 65 78 t) . (ex
40c0: 69 74 20 31 29 29 29 29 0a 0a 20 20 20 20 0a 28 it 1)))).. .(
40d0: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
40e0: 2d 61 72 67 20 22 2d 6c 6f 67 22 29 28 61 72 67 -arg "-log")(arg
40f0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 72 76 s:get-arg "-serv
4100: 65 72 22 29 29 20 3b 3b 20 72 65 64 69 72 65 63 er")) ;; redirec
4110: 74 20 74 68 65 20 6c 6f 67 20 61 6c 77 61 79 73 t the log always
4120: 20 77 68 65 6e 20 61 20 73 65 72 76 65 72 0a 20 when a server.
4130: 20 20 20 28 6c 65 74 2a 20 28 28 74 6c 20 20 20 (let* ((tl
4140: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
4150: 67 20 22 2d 6c 6f 67 22 29 28 6c 61 75 6e 63 68 g "-log")(launch
4160: 3a 73 65 74 75 70 29 29 29 20 20 20 3b 3b 20 72 :setup))) ;; r
4170: 75 6e 20 6c 61 75 6e 63 68 3a 73 65 74 75 70 20 un launch:setup
4180: 69 66 20 2d 73 65 72 76 65 72 0a 09 20 20 20 28 if -server.. (
4190: 6c 6f 67 66 20 28 6f 72 20 28 61 72 67 73 3a 67 logf (or (args:g
41a0: 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 20 3b et-arg "-log") ;
41b0: 3b 20 75 73 65 20 2d 6c 6f 67 20 75 6e 6c 65 73 ; use -log unles
41c0: 73 20 77 65 20 61 72 65 20 61 20 73 65 72 76 65 s we are a serve
41d0: 72 2c 20 74 68 65 6e 20 63 72 61 66 74 20 61 20 r, then craft a
41e0: 6c 6f 67 66 69 6c 65 20 6e 61 6d 65 0a 09 09 20 logfile name...
41f0: 20 20 20 20 28 63 6f 6e 63 20 74 6c 20 22 2f 6c (conc tl "/l
4200: 6f 67 73 2f 73 65 72 76 65 72 2d 22 20 28 63 75 ogs/server-" (cu
4210: 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 rrent-process-id
4220: 29 20 22 2d 22 20 28 67 65 74 2d 68 6f 73 74 2d ) "-" (get-host-
4230: 6e 61 6d 65 29 20 22 2e 6c 6f 67 22 29 29 29 0a name) ".log"))).
4240: 09 20 20 20 28 6f 75 70 20 20 28 6f 70 65 6e 2d . (oup (open-
4250: 6c 6f 67 66 69 6c 65 20 6c 6f 67 66 29 29 29 0a logfile logf))).
4260: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
4270: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
4280: 6f 67 22 29 29 0a 09 20 20 28 68 61 73 68 2d 74 og")).. (hash-t
4290: 61 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 able-set! args:a
42a0: 72 67 2d 68 61 73 68 20 22 2d 6c 6f 67 22 20 6c rg-hash "-log" l
42b0: 6f 67 66 29 29 20 3b 3b 20 66 61 6b 65 20 6f 75 ogf)) ;; fake ou
42c0: 74 20 66 75 74 75 72 65 20 71 75 65 72 69 65 73 t future queries
42d0: 20 6f 66 20 2d 6c 6f 67 0a 20 20 20 20 20 20 28 of -log. (
42e0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
42f0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
4300: 70 6f 72 74 2a 20 22 53 65 6e 64 69 6e 67 20 6c port* "Sending l
4310: 6f 67 20 6f 75 74 70 75 74 20 74 6f 20 22 20 6c og output to " l
4320: 6f 67 66 29 0a 20 20 20 20 20 20 28 73 65 74 21 ogf). (set!
4330: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
4340: 72 74 2a 20 6f 75 70 29 29 29 0a 0a 28 69 66 20 rt* oup)))..(if
4350: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
4360: 67 20 22 2d 68 22 29 0a 09 28 61 72 67 73 3a 67 g "-h")..(args:g
4370: 65 74 2d 61 72 67 20 22 2d 68 65 6c 70 22 29 0a et-arg "-help").
4380: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
4390: 2d 2d 68 65 6c 70 22 29 29 0a 20 20 20 20 28 62 --help")). (b
43a0: 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e egin. (prin
43b0: 74 20 68 65 6c 70 29 0a 20 20 20 20 20 20 28 65 t help). (e
43c0: 78 69 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 xit)))..(if (arg
43d0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 61 6e 75 s:get-arg "-manu
43e0: 61 6c 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 al"). (let* (
43f0: 28 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 28 (htmlviewercmd (
4400: 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b or (configf:look
4410: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
4420: 73 65 74 75 70 22 20 22 68 74 6d 6c 76 69 65 77 setup" "htmlview
4430: 65 72 63 6d 64 22 29 0a 09 09 09 20 20 20 20 20 ercmd")....
4440: 20 28 63 6f 6d 6d 6f 6e 3a 77 68 69 63 68 20 27 (common:which '
4450: 28 22 66 69 72 65 66 6f 78 22 20 22 61 72 6f 72 ("firefox" "aror
4460: 61 22 29 29 29 29 0a 09 20 20 20 28 69 6e 73 74 a")))).. (inst
4470: 61 6c 6c 2d 68 6f 6d 65 20 20 28 63 6f 6d 6d 6f all-home (commo
4480: 6e 3a 67 65 74 2d 69 6e 73 74 61 6c 6c 2d 61 72 n:get-install-ar
4490: 65 61 29 29 0a 09 20 20 20 28 6d 61 6e 75 61 6c ea)).. (manual
44a0: 2d 68 74 6d 6c 20 20 20 28 63 6f 6e 63 20 69 6e -html (conc in
44b0: 73 74 61 6c 6c 2d 68 6f 6d 65 20 22 2f 73 68 61 stall-home "/sha
44c0: 72 65 2f 64 6f 63 73 2f 6d 65 67 61 74 65 73 74 re/docs/megatest
44d0: 5f 6d 61 6e 75 61 6c 2e 68 74 6d 6c 22 29 29 29 _manual.html")))
44e0: 0a 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 . (if (and
44f0: 69 6e 73 74 61 6c 6c 2d 68 6f 6d 65 0a 09 20 20 install-home..
4500: 20 20 20 20 20 28 66 69 6c 65 2d 65 78 69 73 74 (file-exist
4510: 73 3f 20 6d 61 6e 75 61 6c 2d 68 74 6d 6c 29 29 s? manual-html))
4520: 0a 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e .. (system (con
4530: 63 20 22 28 22 20 68 74 6d 6c 76 69 65 77 65 72 c "(" htmlviewer
4540: 63 6d 64 20 22 20 22 20 6d 61 6e 75 61 6c 2d 68 cmd " " manual-h
4550: 74 6d 6c 20 22 20 29 20 26 22 29 29 0a 09 20 20 tml " ) &"))..
4560: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 28 (system (conc "(
4570: 22 20 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 " htmlviewercmd
4580: 22 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 " http://www.kia
4590: 74 6f 61 2e 63 6f 6d 2f 63 67 69 2d 62 69 6e 2f toa.com/cgi-bin/
45a0: 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 fossils/megatest
45b0: 2f 64 6f 63 2f 74 69 70 2f 64 6f 63 73 2f 6d 61 /doc/tip/docs/ma
45c0: 6e 75 61 6c 2f 6d 65 67 61 74 65 73 74 5f 6d 61 nual/megatest_ma
45d0: 6e 75 61 6c 2e 68 74 6d 6c 20 29 20 26 22 29 29 nual.html ) &"))
45e0: 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 29 ). (exit)))
45f0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
4600: 61 72 67 20 22 2d 76 65 72 73 69 6f 6e 22 29 0a arg "-version").
4610: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
4620: 20 28 70 72 69 6e 74 20 28 63 6f 6d 6d 6f 6e 3a (print (common:
4630: 76 65 72 73 69 6f 6e 2d 73 69 67 6e 61 74 75 72 version-signatur
4640: 65 29 29 20 3b 3b 20 28 70 72 69 6e 74 20 6d 65 e)) ;; (print me
4650: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a gatest-version).
4660: 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a (exit)))..
4670: 28 64 65 66 69 6e 65 20 2a 64 69 64 73 6f 6d 65 (define *didsome
4680: 74 68 69 6e 67 2a 20 23 66 29 0a 0a 3b 3b 20 4f thing* #f)..;; O
4690: 76 65 72 61 6c 6c 20 65 78 69 74 20 68 61 6e 64 verall exit hand
46a0: 6c 69 6e 67 20 73 65 74 75 70 20 69 6d 6d 65 64 ling setup immed
46b0: 69 61 74 65 6c 79 0a 3b 3b 0a 28 69 66 20 28 6f iately.;;.(if (o
46c0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
46d0: 22 2d 70 72 6f 63 65 73 73 2d 72 65 61 70 22 29 "-process-reap")
46e0: 29 0a 20 20 20 20 20 20 20 20 3b 3b 20 28 61 72 ). ;; (ar
46f0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
4700: 74 65 73 74 73 22 29 0a 09 3b 3b 20 28 61 72 67 tests")..;; (arg
4710: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 s:get-arg "-exec
4720: 75 74 65 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a ute")..;; (args:
4730: 67 65 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 65 get-arg "-remove
4740: 2d 72 75 6e 73 22 29 0a 09 3b 3b 20 28 61 72 67 -runs")..;; (arg
4750: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 s:get-arg "-runs
4760: 74 65 70 22 29 29 0a 20 20 20 20 28 6c 65 74 20 tep")). (let
4770: 28 28 6f 72 69 67 69 6e 61 6c 2d 65 78 69 74 20 ((original-exit
4780: 28 65 78 69 74 2d 68 61 6e 64 6c 65 72 29 29 29 (exit-handler)))
4790: 0a 20 20 20 20 20 20 28 65 78 69 74 2d 68 61 6e . (exit-han
47a0: 64 6c 65 72 20 28 6c 61 6d 62 64 61 20 28 23 21 dler (lambda (#!
47b0: 6f 70 74 69 6f 6e 61 6c 20 28 65 78 69 74 2d 63 optional (exit-c
47c0: 6f 64 65 20 30 29 29 0a 09 09 20 20 20 20 20 20 ode 0))...
47d0: 28 70 72 69 6e 74 66 20 22 50 72 65 70 61 72 69 (printf "Prepari
47e0: 6e 67 20 74 6f 20 65 78 69 74 20 77 69 74 68 20 ng to exit with
47f0: 65 78 69 74 20 63 6f 64 65 20 7e 41 20 2e 2e 2e exit code ~A ...
4800: 5c 6e 22 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 \n" exit-code)..
4810: 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 . (for-each
4820: 0a 09 09 20 20 20 20 20 20 20 0a 09 09 20 20 20 ... ...
4830: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 69 64 (lambda (pid
4840: 29 0a 09 09 09 20 28 68 61 6e 64 6c 65 2d 65 78 ).... (handle-ex
4850: 63 65 70 74 69 6f 6e 73 0a 09 09 09 20 20 65 78 ceptions.... ex
4860: 6e 0a 09 09 09 20 20 23 74 0a 09 09 09 20 20 28 n.... #t.... (
4870: 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 70 69 let-values (((pi
4880: 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 75 d-val exit-statu
4890: 73 20 65 78 69 74 2d 63 6f 64 65 29 20 28 70 72 s exit-code) (pr
48a0: 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 ocess-wait pid #
48b0: 74 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 t)))..... (
48c0: 69 66 20 28 6f 72 20 28 65 71 3f 20 70 69 64 2d if (or (eq? pid-
48d0: 76 61 6c 20 70 69 64 29 0a 09 09 09 09 09 20 20 val pid)......
48e0: 20 20 20 20 28 65 71 3f 20 70 69 64 2d 76 61 6c (eq? pid-val
48f0: 20 30 29 29 0a 09 09 09 09 09 20 20 28 62 65 67 0))...... (beg
4900: 69 6e 0a 09 09 09 09 09 20 20 20 20 28 70 72 69 in...... (pri
4910: 6e 74 66 20 22 53 65 6e 64 69 6e 67 20 73 69 67 ntf "Sending sig
4920: 6e 61 6c 2f 74 65 72 6d 20 74 6f 20 7e 41 5c 6e nal/term to ~A\n
4930: 22 20 70 69 64 29 0a 09 09 09 09 09 20 20 20 20 " pid)......
4940: 28 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 (process-signal
4950: 70 69 64 20 73 69 67 6e 61 6c 2f 74 65 72 6d 29 pid signal/term)
4960: 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 )))))... (
4970: 70 72 6f 63 65 73 73 3a 63 68 69 6c 64 72 65 6e process:children
4980: 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 28 6f #f))... (o
4990: 72 69 67 69 6e 61 6c 2d 65 78 69 74 20 65 78 69 riginal-exit exi
49a0: 74 2d 63 6f 64 65 29 29 29 29 29 0a 0a 3b 3b 20 t-code)))))..;;
49b0: 66 6f 72 20 73 6f 6d 65 20 73 77 69 74 63 68 65 for some switche
49c0: 73 20 61 6c 77 61 79 20 70 72 69 6e 74 20 74 68 s alway print th
49d0: 65 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 73 74 64 e command to std
49e0: 65 72 72 0a 3b 3b 0a 28 69 66 20 28 61 72 67 73 err.;;.(if (args
49f0: 3a 61 6e 79 3f 20 22 2d 72 75 6e 22 20 22 2d 72 :any? "-run" "-r
4a00: 75 6e 61 6c 6c 22 20 22 2d 6c 69 73 74 2d 72 75 unall" "-list-ru
4a10: 6e 73 22 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e ns" "-remove-run
4a20: 73 22 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 s" "-set-state-s
4a30: 74 61 74 75 73 22 29 0a 20 20 20 20 28 64 65 62 tatus"). (deb
4a40: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
4a50: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 28 73 ult-log-port* (s
4a60: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
4a70: 65 20 28 61 72 67 76 29 20 22 20 22 29 29 29 0a e (argv) " "))).
4a80: 0a 3b 3b 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 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 =========.;; Mis
4ad0: 63 20 73 65 74 75 70 20 73 74 75 66 66 0a 3b 3b c setup stuff.;;
4ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4b20: 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 62 75 67 3a 73 ======..(debug:s
4b30: 65 74 75 70 29 0a 0a 28 69 66 20 28 61 72 67 73 etup)..(if (args
4b40: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 67 69 :get-arg "-loggi
4b50: 6e 67 22 29 28 73 65 74 21 20 2a 6c 6f 67 67 69 ng")(set! *loggi
4b60: 6e 67 2a 20 23 74 29 29 0a 0a 28 69 66 20 28 64 ng* #t))..(if (d
4b70: 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 ebug:debug-mode
4b80: 33 29 20 3b 3b 20 77 65 20 61 72 65 20 6f 62 76 3) ;; we are obv
4b90: 69 6f 75 73 6c 79 20 64 65 62 75 67 67 69 6e 67 iously debugging
4ba0: 0a 20 20 20 20 28 73 65 74 21 20 6f 70 65 6e 2d . (set! open-
4bb0: 72 75 6e 2d 63 6c 6f 73 65 20 6f 70 65 6e 2d 72 run-close open-r
4bc0: 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 un-close-no-exce
4bd0: 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 29 29 ption-handling))
4be0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
4bf0: 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 29 arg "-itempatt")
4c00: 0a 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 76 . (let ((newv
4c10: 61 6c 20 28 63 6f 6e 63 20 28 61 72 67 73 3a 67 al (conc (args:g
4c20: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
4c30: 74 22 29 20 22 2f 22 20 28 61 72 67 73 3a 67 65 t") "/" (args:ge
4c40: 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 t-arg "-itempatt
4c50: 22 29 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 ")))). (deb
4c60: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
4c70: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 ult-log-port* "W
4c80: 41 52 4e 49 4e 47 3a 20 2d 69 74 65 6d 70 61 74 ARNING: -itempat
4c90: 74 20 68 61 73 20 62 65 65 6e 20 64 65 70 72 65 t has been depre
4ca0: 63 61 74 65 64 2c 20 70 6c 65 61 73 65 20 75 73 cated, please us
4cb0: 65 20 2d 74 65 73 74 70 61 74 74 20 74 65 73 74 e -testpatt test
4cc0: 70 61 74 74 2f 69 74 65 6d 70 61 74 74 20 6d 65 patt/itempatt me
4cd0: 74 68 6f 64 2c 20 6e 65 77 20 74 65 73 74 70 61 thod, new testpa
4ce0: 74 74 20 69 73 20 22 6e 65 77 76 61 6c 29 0a 20 tt is "newval).
4cf0: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
4d00: 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 2d 68 -set! args:arg-h
4d10: 61 73 68 20 22 2d 74 65 73 74 70 61 74 74 22 20 ash "-testpatt"
4d20: 6e 65 77 76 61 6c 29 0a 20 20 20 20 20 20 28 68 newval). (h
4d30: 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 ash-table-delete
4d40: 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 ! args:arg-hash
4d50: 22 2d 69 74 65 6d 70 61 74 74 22 29 29 29 0a 0a "-itempatt")))..
4d60: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
4d70: 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 20 g "-runtests").
4d80: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
4d90: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
4da0: 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 5c ort* "WARNING: \
4db0: 22 2d 72 75 6e 74 65 73 74 73 5c 22 20 69 73 20 "-runtests\" is
4dc0: 64 65 70 72 65 63 61 74 65 64 2e 20 55 73 65 20 deprecated. Use
4dd0: 5c 22 2d 72 75 6e 5c 22 20 77 69 74 68 20 5c 22 \"-run\" with \"
4de0: 2d 74 65 73 74 70 61 74 74 5c 22 20 69 6e 73 74 -testpatt\" inst
4df0: 65 61 64 22 29 29 0a 0a 28 6f 6e 2d 65 78 69 74 ead"))..(on-exit
4e00: 20 73 74 64 2d 65 78 69 74 2d 70 72 6f 63 65 64 std-exit-proced
4e10: 75 72 65 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ure)..;;========
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 3d 3d 3d 0a 3b ==============.;
4e60: 3b 20 4d 69 73 63 20 67 65 6e 65 72 61 6c 20 63 ; Misc general c
4e70: 61 6c 6c 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d alls.;;=========
4e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
4ec0: 69 66 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 if (and (args:ge
4ed0: 74 2d 61 72 67 20 22 2d 63 61 63 68 65 2d 64 62 t-arg "-cache-db
4ee0: 22 29 0a 20 20 20 20 20 20 20 20 20 28 61 72 67 "). (arg
4ef0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f 75 72 s:get-arg "-sour
4f00: 63 65 2d 64 62 22 29 29 0a 20 20 20 20 28 6c 65 ce-db")). (le
4f10: 74 2a 20 28 28 74 65 6d 70 2d 64 69 72 20 28 6f t* ((temp-dir (o
4f20: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
4f30: 22 2d 74 61 72 67 65 74 2d 64 62 22 29 20 28 63 "-target-db") (c
4f40: 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 reate-directory
4f50: 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 28 67 (conc "/tmp/" (g
4f60: 65 74 65 6e 76 20 22 55 53 45 52 22 29 20 22 2f etenv "USER") "/
4f70: 22 20 28 73 74 72 69 6e 67 2d 74 72 61 6e 73 6c " (string-transl
4f80: 61 74 65 20 28 63 75 72 72 65 6e 74 2d 64 69 72 ate (current-dir
4f90: 65 63 74 6f 72 79 29 20 22 2f 22 20 22 5f 22 29 ectory) "/" "_")
4fa0: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
4fb0: 28 74 61 72 67 65 74 2d 64 62 20 28 63 6f 6e 63 (target-db (conc
4fc0: 20 74 65 6d 70 2d 64 69 72 20 22 2f 63 61 63 68 temp-dir "/cach
4fd0: 65 64 2e 64 62 22 29 29 0a 20 20 20 20 20 20 20 ed.db")).
4fe0: 20 20 20 20 28 73 6f 75 72 63 65 2d 64 62 20 28 (source-db (
4ff0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
5000: 6f 75 72 63 65 2d 64 62 22 29 29 29 20 20 20 20 ource-db")))
5010: 20 20 20 20 0a 20 20 20 20 20 20 28 64 62 3a 63 . (db:c
5020: 61 63 68 65 2d 66 6f 72 2d 72 65 61 64 2d 6f 6e ache-for-read-on
5030: 6c 79 20 73 6f 75 72 63 65 2d 64 62 20 74 61 72 ly source-db tar
5040: 67 65 74 2d 64 62 29 0a 20 20 20 20 20 20 28 73 get-db). (s
5050: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
5060: 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 68 61 6e g* #t)))..;; han
5070: 64 6c 65 20 61 20 63 6c 65 61 6e 2d 63 61 63 68 dle a clean-cach
5080: 65 20 72 65 71 75 65 73 74 20 61 73 20 65 61 72 e request as ear
5090: 6c 79 20 61 73 20 70 6f 73 73 69 62 6c 65 0a 3b ly as possible.;
50a0: 3b 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ;.(if (args:get-
50b0: 61 72 67 20 22 2d 63 6c 65 61 6e 2d 63 61 63 68 arg "-clean-cach
50c0: 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 e"). (begin.
50d0: 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
50e0: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 20 3b 3b omething* #t) ;;
50f0: 20 73 75 70 70 72 65 73 73 20 74 68 65 20 68 65 suppress the he
5100: 6c 70 20 6f 75 74 70 75 74 2e 0a 20 20 20 20 20 lp output..
5110: 20 28 69 66 20 28 67 65 74 65 6e 76 20 22 4d 54 (if (getenv "MT
5120: 5f 54 41 52 47 45 54 22 29 20 3b 3b 20 6e 6f 20 _TARGET") ;; no
5130: 70 6f 69 6e 74 20 69 6e 20 74 72 79 69 6e 67 20 point in trying
5140: 69 66 20 6e 6f 20 74 61 72 67 65 74 0a 09 20 20 if no target..
5150: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
5160: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 0a 09 20 g "-runname")..
5170: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 (let* ((top
5180: 70 61 74 68 20 20 28 6c 61 75 6e 63 68 3a 73 65 path (launch:se
5190: 74 75 70 29 29 0a 09 09 20 20 20 20 20 28 6c 69 tup))... (li
51a0: 6e 6b 74 72 65 65 20 28 63 6f 6d 6d 6f 6e 3a 67 nktree (common:g
51b0: 65 74 2d 6c 69 6e 6b 74 72 65 65 29 29 20 3b 3b et-linktree)) ;;
51c0: 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 63 6f (if toppath (co
51d0: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f nfigf:lookup *co
51e0: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
51f0: 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 29 0a 09 "linktree")))..
5200: 09 20 20 20 20 20 28 72 75 6e 74 6f 70 20 20 20 . (runtop
5210: 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 22 (conc linktree "
5220: 2f 22 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 /" (getenv "MT_T
5230: 41 52 47 45 54 22 29 20 22 2f 22 20 28 61 72 67 ARGET") "/" (arg
5240: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
5250: 61 6d 65 22 29 29 29 0a 09 09 20 20 20 20 20 28 ame")))... (
5260: 66 69 6c 65 73 20 20 20 20 28 69 66 20 28 66 69 files (if (fi
5270: 6c 65 2d 65 78 69 73 74 73 3f 20 72 75 6e 74 6f le-exists? runto
5280: 70 29 0a 09 09 09 09 20 20 20 28 61 70 70 65 6e p)..... (appen
5290: 64 20 28 67 6c 6f 62 20 28 63 6f 6e 63 20 72 75 d (glob (conc ru
52a0: 6e 74 6f 70 20 22 2f 2e 6d 65 67 61 74 65 73 74 ntop "/.megatest
52b0: 2a 22 29 29 0a 09 09 09 09 09 20 20 20 28 67 6c *"))...... (gl
52c0: 6f 62 20 28 63 6f 6e 63 20 72 75 6e 74 6f 70 20 ob (conc runtop
52d0: 22 2f 2e 72 75 6e 63 6f 6e 66 69 67 2a 22 29 29 "/.runconfig*"))
52e0: 29 0a 09 09 09 09 20 20 20 27 28 29 29 29 29 0a )..... '()))).
52f0: 09 09 28 69 66 20 28 6e 75 6c 6c 3f 20 66 69 6c ..(if (null? fil
5300: 65 73 29 0a 09 09 20 20 20 20 28 64 65 62 75 67 es)... (debug
5310: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 :print-info 0 *d
5320: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
5330: 20 22 4e 6f 20 63 61 63 68 65 64 20 6d 65 67 61 "No cached mega
5340: 74 65 73 74 20 6f 72 20 72 75 6e 63 6f 6e 66 69 test or runconfi
5350: 67 73 20 66 69 6c 65 73 20 66 6f 75 6e 64 2e 20 gs files found.
5360: 4e 6f 6e 65 20 72 65 6d 6f 76 65 64 2e 22 29 0a None removed.").
5370: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 .. (begin...
5380: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
5390: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
53a0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 65 6d t-log-port* "Rem
53b0: 6f 76 69 6e 67 20 63 61 63 68 65 64 20 66 69 6c oving cached fil
53c0: 65 73 3a 5c 6e 20 20 20 20 22 20 28 73 74 72 69 es:\n " (stri
53d0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 ng-intersperse f
53e0: 69 6c 65 73 20 22 5c 6e 20 20 20 20 22 29 29 0a iles "\n ")).
53f0: 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 .. (for-eac
5400: 68 20 0a 09 09 20 20 20 20 20 20 20 28 6c 61 6d h ... (lam
5410: 62 64 61 20 28 66 29 0a 09 09 09 20 28 68 61 6e bda (f).... (han
5420: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
5430: 09 09 20 20 20 20 20 65 78 6e 0a 09 09 09 20 20 .. exn....
5440: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
5450: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
5460: 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 46 ort* "WARNING: F
5470: 61 69 6c 65 64 20 74 6f 20 72 65 6d 6f 76 65 20 ailed to remove
5480: 66 69 6c 65 20 22 20 66 29 0a 09 09 09 20 20 20 file " f)....
5490: 28 64 65 6c 65 74 65 2d 66 69 6c 65 20 66 29 29 (delete-file f))
54a0: 29 0a 09 09 20 20 20 20 20 20 20 66 69 6c 65 73 )... files
54b0: 29 29 29 29 0a 09 20 20 20 20 20 20 28 64 65 62 )))).. (deb
54c0: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
54d0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
54e0: 72 74 2a 20 22 2d 63 6c 65 61 6e 2d 63 61 63 68 rt* "-clean-cach
54f0: 65 20 72 65 71 75 69 72 65 73 20 2d 72 75 6e 6e e requires -runn
5500: 61 6d 65 2e 22 29 29 0a 09 20 20 28 64 65 62 75 ame.")).. (debu
5510: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
5520: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
5530: 74 2a 20 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 t* "-clean-cache
5540: 20 72 65 71 75 69 72 65 73 20 2d 74 61 72 67 65 requires -targe
5550: 74 20 6f 72 20 2d 72 65 71 74 61 72 67 22 29 29 t or -reqtarg"))
5560: 29 29 0a 09 20 20 20 20 0a 09 20 20 0a 28 69 66 )).. .. .(if
5570: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5580: 2d 65 6e 76 32 66 69 6c 65 22 29 0a 20 20 20 20 -env2file").
5590: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 73 61 (begin. (sa
55a0: 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 ve-environment-a
55b0: 73 2d 66 69 6c 65 73 20 28 61 72 67 73 3a 67 65 s-files (args:ge
55c0: 74 2d 61 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 t-arg "-env2file
55d0: 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ")). (set!
55e0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
55f0: 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a t)))..(if (args:
5600: 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 get-arg "-list-d
5610: 69 73 6b 73 22 29 0a 20 20 20 20 28 6c 65 74 20 isks"). (let
5620: 28 28 74 6f 70 70 61 74 68 20 28 6c 61 75 6e 63 ((toppath (launc
5630: 68 3a 73 65 74 75 70 29 29 29 0a 20 20 20 20 20 h:setup))).
5640: 20 28 70 72 69 6e 74 20 0a 20 20 20 20 20 20 20 (print .
5650: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
5660: 72 73 65 20 0a 09 28 6d 61 70 20 28 6c 61 6d 62 rse ..(map (lamb
5670: 64 61 20 28 78 29 0a 09 20 20 20 20 20 20 20 28 da (x).. (
5680: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
5690: 73 65 20 0a 09 09 78 0a 09 09 22 20 3d 3e 20 22 se ...x..." => "
56a0: 29 29 0a 09 20 20 20 20 20 28 63 6f 6d 6d 6f 6e )).. (common
56b0: 3a 67 65 74 2d 64 69 73 6b 73 20 2a 63 6f 6e 66 :get-disks *conf
56c0: 69 67 64 61 74 2a 29 29 0a 09 22 5c 6e 22 29 29 igdat*)).."\n"))
56d0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
56e0: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
56f0: 29 0a 0a 3b 3b 20 63 73 76 20 70 72 6f 63 65 73 )..;; csv proces
5700: 73 69 6e 67 20 72 65 63 6f 72 64 0a 28 64 65 66 sing record.(def
5710: 69 6e 65 20 28 6d 61 6b 65 2d 72 65 66 64 62 3a ine (make-refdb:
5720: 63 73 76 29 0a 20 20 28 76 65 63 74 6f 72 20 0a csv). (vector .
5730: 20 20 20 28 6d 61 6b 65 2d 73 70 61 72 73 65 2d (make-sparse-
5740: 61 72 72 61 79 29 0a 20 20 20 28 6d 61 6b 65 2d array). (make-
5750: 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 20 28 hash-table). (
5760: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
5770: 0a 20 20 20 30 0a 20 20 20 30 29 29 0a 28 64 65 . 0. 0)).(de
5780: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 fine-inline (ref
5790: 64 62 3a 63 73 76 2d 67 65 74 2d 73 76 65 63 20 db:csv-get-svec
57a0: 20 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 vec) (vec
57b0: 74 6f 72 2d 72 65 66 20 20 76 65 63 20 30 29 29 tor-ref vec 0))
57c0: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
57d0: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 72 (refdb:csv-get-r
57e0: 6f 77 73 20 20 20 20 20 76 65 63 29 20 20 20 20 ows vec)
57f0: 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 (vector-ref vec
5800: 20 31 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 1)).(define-inl
5810: 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 67 ine (refdb:csv-g
5820: 65 74 2d 63 6f 6c 73 20 20 20 20 20 76 65 63 29 et-cols vec)
5830: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
5840: 20 76 65 63 20 32 29 29 0a 28 64 65 66 69 6e 65 vec 2)).(define
5850: 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 -inline (refdb:c
5860: 73 76 2d 67 65 74 2d 6d 61 78 72 6f 77 20 20 20 sv-get-maxrow
5870: 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d vec) (vector-
5880: 72 65 66 20 20 76 65 63 20 33 29 29 0a 28 64 65 ref vec 3)).(de
5890: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 fine-inline (ref
58a0: 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 63 6f db:csv-get-maxco
58b0: 6c 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 l vec) (vec
58c0: 74 6f 72 2d 72 65 66 20 20 76 65 63 20 34 29 29 tor-ref vec 4))
58d0: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
58e0: 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 73 (refdb:csv-set-s
58f0: 76 65 63 21 20 20 20 20 76 65 63 20 76 61 6c 29 vec! vec val)
5900: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
5910: 20 30 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 0 val)).(define
5920: 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 -inline (refdb:c
5930: 73 76 2d 73 65 74 2d 72 6f 77 73 21 20 20 20 20 sv-set-rows!
5940: 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d vec val)(vector-
5950: 73 65 74 21 20 76 65 63 20 31 20 76 61 6c 29 29 set! vec 1 val))
5960: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
5970: 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 63 (refdb:csv-set-c
5980: 6f 6c 73 21 20 20 20 20 76 65 63 20 76 61 6c 29 ols! vec val)
5990: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
59a0: 20 32 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2 val)).(define
59b0: 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 -inline (refdb:c
59c0: 73 76 2d 73 65 74 2d 6d 61 78 72 6f 77 21 20 20 sv-set-maxrow!
59d0: 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d vec val)(vector-
59e0: 73 65 74 21 20 76 65 63 20 33 20 76 61 6c 29 29 set! vec 3 val))
59f0: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
5a00: 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d (refdb:csv-set-m
5a10: 61 78 63 6f 6c 21 20 20 76 65 63 20 76 61 6c 29 axcol! vec val)
5a20: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
5a30: 20 34 20 76 61 6c 29 29 0a 0a 28 64 65 66 69 6e 4 val))..(defin
5a40: 65 20 28 67 65 74 2d 64 61 74 20 72 65 73 75 6c e (get-dat resul
5a50: 74 73 20 73 68 65 65 74 6e 61 6d 65 29 0a 20 20 ts sheetname).
5a60: 28 6f 72 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (or (hash-table-
5a70: 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 75 ref/default resu
5a80: 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 20 23 66 lts sheetname #f
5a90: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 ). (let ((t
5aa0: 6d 70 2d 76 65 63 20 20 28 6d 61 6b 65 2d 72 65 mp-vec (make-re
5ab0: 66 64 62 3a 63 73 76 29 29 29 0a 09 28 68 61 73 fdb:csv)))..(has
5ac0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 h-table-set! res
5ad0: 75 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 20 74 ults sheetname t
5ae0: 6d 70 2d 76 65 63 29 0a 09 74 6d 70 2d 76 65 63 mp-vec)..tmp-vec
5af0: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
5b00: 65 74 2d 61 72 67 20 22 2d 72 65 66 64 62 32 64 et-arg "-refdb2d
5b10: 61 74 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 at"). (let* (
5b20: 28 69 6e 70 75 74 2d 64 62 20 28 61 72 67 73 3a (input-db (args:
5b30: 67 65 74 2d 61 72 67 20 22 2d 72 65 66 64 62 32 get-arg "-refdb2
5b40: 64 61 74 22 29 29 0a 09 20 20 20 28 6f 75 74 2d dat")).. (out-
5b50: 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 file (args:get-a
5b60: 72 67 20 22 2d 6f 22 29 29 0a 09 20 20 20 28 6f rg "-o")).. (o
5b70: 75 74 2d 66 6d 74 20 20 28 6f 72 20 28 61 72 67 ut-fmt (or (arg
5b80: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
5b90: 6d 6f 64 65 22 29 20 22 73 63 68 65 6d 65 22 29 mode") "scheme")
5ba0: 29 0a 09 20 20 20 28 6f 75 74 2d 70 6f 72 74 20 ).. (out-port
5bb0: 28 69 66 20 28 61 6e 64 20 6f 75 74 2d 66 69 6c (if (and out-fil
5bc0: 65 20 0a 09 09 09 20 20 20 20 20 20 28 6e 6f 74 e .... (not
5bd0: 20 28 6d 65 6d 62 65 72 20 6f 75 74 2d 66 6d 74 (member out-fmt
5be0: 20 27 28 22 73 71 6c 69 74 65 33 22 20 22 63 73 '("sqlite3" "cs
5bf0: 76 22 29 29 29 29 0a 09 09 09 20 28 6f 70 65 6e v")))).... (open
5c00: 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 6f 75 74 -output-file out
5c10: 2d 66 69 6c 65 29 0a 09 09 09 20 28 63 75 72 72 -file).... (curr
5c20: 65 6e 74 2d 6f 75 74 70 75 74 2d 70 6f 72 74 29 ent-output-port)
5c30: 29 29 0a 09 20 20 20 28 72 65 73 2d 64 61 74 61 )).. (res-data
5c40: 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 72 (configf:read-r
5c50: 65 66 64 62 20 69 6e 70 75 74 2d 64 62 29 29 0a efdb input-db)).
5c60: 09 20 20 20 28 64 61 74 61 20 20 20 20 20 28 63 . (data (c
5c70: 61 72 20 72 65 73 2d 64 61 74 61 29 29 0a 09 20 ar res-data))..
5c80: 20 20 28 6d 73 67 20 20 20 20 20 20 28 63 61 64 (msg (cad
5c90: 72 20 72 65 73 2d 64 61 74 61 29 29 29 0a 20 20 r res-data))).
5ca0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 64 61 74 (if (not dat
5cb0: 61 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 a).. (debug:pri
5cc0: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
5cd0: 67 2d 70 6f 72 74 2a 20 22 42 61 64 20 69 6e 70 g-port* "Bad inp
5ce0: 75 74 3f 20 64 61 74 61 3d 22 20 64 61 74 61 29 ut? data=" data)
5cf0: 20 3b 3b 20 73 6f 6d 65 20 65 72 72 6f 72 20 6f ;; some error o
5d00: 63 63 75 72 72 65 64 0a 09 20 20 28 77 69 74 68 ccurred.. (with
5d10: 2d 6f 75 74 70 75 74 2d 74 6f 2d 70 6f 72 74 20 -output-to-port
5d20: 6f 75 74 2d 70 6f 72 74 0a 09 20 20 20 20 28 6c out-port.. (l
5d30: 61 6d 62 64 61 20 28 29 0a 09 20 20 20 20 20 20 ambda ()..
5d40: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
5d50: 79 6d 62 6f 6c 20 6f 75 74 2d 66 6d 74 29 0a 09 ymbol out-fmt)..
5d60: 09 28 28 73 63 68 65 6d 65 29 28 70 70 20 64 61 .((scheme)(pp da
5d70: 74 61 29 29 0a 09 09 28 28 70 65 72 6c 29 0a 09 ta))...((perl)..
5d80: 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 25 68 61 . ;; (print "%ha
5d90: 73 68 20 3d 20 28 22 29 0a 09 09 20 3b 3b 20 20 sh = (")... ;;
5da0: 20 20 20 20 20 20 6b 65 79 31 20 3d 3e 20 27 76 key1 => 'v
5db0: 61 6c 75 65 31 27 2c 0a 09 09 20 3b 3b 20 20 20 alue1',... ;;
5dc0: 20 20 20 20 20 6b 65 79 32 20 3d 3e 20 27 76 61 key2 => 'va
5dd0: 6c 75 65 32 27 2c 0a 09 09 20 3b 3b 20 20 20 20 lue2',... ;;
5de0: 20 20 20 20 6b 65 79 33 20 3d 3e 20 27 76 61 6c key3 => 'val
5df0: 75 65 33 27 2c 0a 09 09 20 3b 3b 20 29 3b 0a 09 ue3',... ;; );..
5e00: 09 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 . (configf:map-a
5e10: 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 20 0a 09 ll-hier-alist ..
5e20: 09 20 20 64 61 74 61 20 0a 09 09 20 20 28 6c 61 . data ... (la
5e30: 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 mbda (sheetname
5e40: 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e sectionname varn
5e50: 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 28 ame val)... (
5e60: 70 72 69 6e 74 20 22 24 64 61 74 61 7b 5c 22 22 print "$data{\""
5e70: 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 7d 7b sheetname "\"}{
5e80: 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 \"" sectionname
5e90: 22 5c 22 7d 7b 5c 22 22 20 76 61 72 6e 61 6d 65 "\"}{\"" varname
5ea0: 20 22 5c 22 7d 20 3d 20 5c 22 22 20 76 61 6c 20 "\"} = \"" val
5eb0: 22 5c 22 3b 22 29 29 29 29 0a 09 09 28 28 70 79 "\";"))))...((py
5ec0: 74 68 6f 6e 20 72 75 62 79 29 0a 09 09 20 28 70 thon ruby)... (p
5ed0: 72 69 6e 74 20 22 64 61 74 61 3d 7b 7d 22 29 0a rint "data={}").
5ee0: 09 09 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d .. (configf:map-
5ef0: 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 0a 09 all-hier-alist..
5f00: 09 20 20 64 61 74 61 0a 09 09 20 20 28 6c 61 6d . data... (lam
5f10: 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 bda (sheetname s
5f20: 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 ectionname varna
5f30: 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 28 70 me val)... (p
5f40: 72 69 6e 74 20 22 64 61 74 61 5b 5c 22 22 20 73 rint "data[\"" s
5f50: 68 65 65 74 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 heetname "\"][\"
5f60: 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 5c " sectionname "\
5f70: 22 5d 5b 5c 22 22 20 76 61 72 6e 61 6d 65 20 22 "][\"" varname "
5f80: 5c 22 5d 20 3d 20 5c 22 22 20 76 61 6c 20 22 5c \"] = \"" val "\
5f90: 22 22 29 29 0a 09 09 20 20 69 6e 69 74 70 72 6f ""))... initpro
5fa0: 63 31 3a 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 c1:... (lambda
5fb0: 28 73 68 65 65 74 6e 61 6d 65 29 0a 09 09 20 20 (sheetname)...
5fc0: 20 20 28 70 72 69 6e 74 20 22 64 61 74 61 5b 5c (print "data[\
5fd0: 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 "" sheetname "\"
5fe0: 5d 20 3d 20 7b 7d 22 29 29 0a 09 09 20 20 69 6e ] = {}"))... in
5ff0: 69 74 70 72 6f 63 32 3a 0a 09 09 20 20 28 6c 61 itproc2:... (la
6000: 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 mbda (sheetname
6010: 73 65 63 74 69 6f 6e 6e 61 6d 65 29 0a 09 09 20 sectionname)...
6020: 20 20 20 28 70 72 69 6e 74 20 22 64 61 74 61 5b (print "data[
6030: 5c 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 5c \"" sheetname "\
6040: 22 5d 5b 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 "][\"" sectionna
6050: 6d 65 20 22 5c 22 5d 20 3d 20 7b 7d 22 29 29 29 me "\"] = {}")))
6060: 29 0a 09 09 28 28 63 73 76 29 0a 09 09 20 28 6c )...((csv)... (l
6070: 65 74 2a 20 28 28 72 65 73 75 6c 74 73 20 20 28 et* ((results (
6080: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
6090: 29 20 3b 3b 20 28 6d 61 6b 65 2d 73 70 61 72 73 ) ;; (make-spars
60a0: 65 2d 61 72 72 61 79 29 29 29 0a 09 09 09 28 72 e-array)))....(r
60b0: 6f 77 2d 63 6f 6c 73 20 28 6d 61 6b 65 2d 68 61 ow-cols (make-ha
60c0: 73 68 2d 74 61 62 6c 65 29 29 29 20 3b 3b 20 68 sh-table))) ;; h
60d0: 61 73 68 20 6f 66 20 68 61 73 68 65 73 20 77 68 ash of hashes wh
60e0: 65 72 65 20 73 65 63 74 69 6f 6e 20 3d 3e 20 68 ere section => h
60f0: 74 20 7b 20 72 6f 77 2d 3c 6e 61 6d 65 3e 20 3d t { row-<name> =
6100: 3e 20 6e 75 6d 20 6f 72 20 63 6f 6c 2d 3c 6e 61 > num or col-<na
6110: 6d 65 3e 20 3d 3e 20 6e 75 6d 0a 09 09 20 20 20 me> => num...
6120: 3b 3b 20 28 70 72 69 6e 74 20 22 64 61 74 61 3d ;; (print "data=
6130: 22 29 0a 09 09 20 20 20 3b 3b 20 28 70 70 20 64 ")... ;; (pp d
6140: 61 74 61 29 0a 09 09 20 20 20 28 63 6f 6e 66 69 ata)... (confi
6150: 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d gf:map-all-hier-
6160: 61 6c 69 73 74 0a 09 09 20 20 20 20 64 61 74 61 alist... data
6170: 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ... (lambda (
6180: 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f sheetname sectio
6190: 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 nname varname va
61a0: 6c 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 28 70 l)... ;; (p
61b0: 72 69 6e 74 20 22 73 68 65 65 74 6e 61 6d 65 3a rint "sheetname:
61c0: 20 22 20 73 68 65 65 74 6e 61 6d 65 20 22 2c 20 " sheetname ",
61d0: 73 65 63 74 69 6f 6e 6e 61 6d 65 3a 20 22 20 73 sectionname: " s
61e0: 65 63 74 69 6f 6e 6e 61 6d 65 20 22 2c 20 76 61 ectionname ", va
61f0: 72 6e 61 6d 65 3a 20 22 20 76 61 72 6e 61 6d 65 rname: " varname
6200: 20 22 2c 20 76 61 6c 3a 20 22 20 76 61 6c 29 0a ", val: " val).
6210: 09 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 .. (let* ((
6220: 64 61 74 20 20 20 20 20 20 28 67 65 74 2d 64 61 dat (get-da
6230: 74 20 72 65 73 75 6c 74 73 20 73 68 65 65 74 6e t results sheetn
6240: 61 6d 65 29 29 0a 09 09 09 20 20 20 20 20 28 76 ame)).... (v
6250: 65 63 20 20 20 20 20 20 28 72 65 66 64 62 3a 63 ec (refdb:c
6260: 73 76 2d 67 65 74 2d 73 76 65 63 20 64 61 74 29 sv-get-svec dat)
6270: 29 0a 09 09 09 20 20 20 20 20 28 72 6f 77 6e 61 ).... (rowna
6280: 6d 65 73 20 28 72 65 66 64 62 3a 63 73 76 2d 67 mes (refdb:csv-g
6290: 65 74 2d 72 6f 77 73 20 64 61 74 29 29 0a 09 09 et-rows dat))...
62a0: 09 20 20 20 20 20 28 63 6f 6c 6e 61 6d 65 73 20 . (colnames
62b0: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 63 (refdb:csv-get-c
62c0: 6f 6c 73 20 64 61 74 29 29 0a 09 09 09 20 20 20 ols dat))....
62d0: 20 20 28 63 75 72 72 72 6f 77 6e 20 28 68 61 73 (currrown (has
62e0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
62f0: 75 6c 74 20 72 6f 77 6e 61 6d 65 73 20 76 61 72 ult rownames var
6300: 6e 61 6d 65 20 23 66 29 29 0a 09 09 09 20 20 20 name #f))....
6310: 20 20 28 63 75 72 72 63 6f 6c 6e 20 28 68 61 73 (currcoln (has
6320: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
6330: 75 6c 74 20 63 6f 6c 6e 61 6d 65 73 20 73 65 63 ult colnames sec
6340: 74 69 6f 6e 6e 61 6d 65 20 23 66 29 29 0a 09 09 tionname #f))...
6350: 09 20 20 20 20 20 28 72 6f 77 6e 20 20 20 20 20 . (rown
6360: 28 6f 72 20 63 75 72 72 72 6f 77 6e 20 0a 09 09 (or currrown ...
6370: 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 6c 61 ... (let* ((la
6380: 73 74 6e 20 20 20 28 72 65 66 64 62 3a 63 73 76 stn (refdb:csv
6390: 2d 67 65 74 2d 6d 61 78 72 6f 77 20 64 61 74 29 -get-maxrow dat)
63a0: 29 0a 09 09 09 09 09 09 20 20 28 6e 65 77 72 6f )....... (newro
63b0: 77 6e 20 28 2b 20 6c 61 73 74 6e 20 31 29 29 29 wn (+ lastn 1)))
63c0: 0a 09 09 09 09 09 20 20 20 20 20 28 72 65 66 64 ...... (refd
63d0: 62 3a 63 73 76 2d 73 65 74 2d 6d 61 78 72 6f 77 b:csv-set-maxrow
63e0: 21 20 64 61 74 20 6e 65 77 72 6f 77 6e 29 0a 09 ! dat newrown)..
63f0: 09 09 09 09 20 20 20 20 20 6e 65 77 72 6f 77 6e .... newrown
6400: 29 29 29 0a 09 09 09 20 20 20 20 20 28 63 6f 6c ))).... (col
6410: 6e 20 20 20 20 20 28 6f 72 20 63 75 72 72 63 6f n (or currco
6420: 6c 6e 20 0a 09 09 09 09 09 20 20 20 28 6c 65 74 ln ...... (let
6430: 2a 20 28 28 6c 61 73 74 6e 20 20 20 28 72 65 66 * ((lastn (ref
6440: 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 63 6f db:csv-get-maxco
6450: 6c 20 64 61 74 29 29 0a 09 09 09 09 09 09 20 20 l dat)).......
6460: 28 6e 65 77 63 6f 6c 6e 20 28 2b 20 6c 61 73 74 (newcoln (+ last
6470: 6e 20 31 29 29 29 0a 09 09 09 09 09 20 20 20 20 n 1)))......
6480: 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d (refdb:csv-set-
6490: 6d 61 78 63 6f 6c 21 20 64 61 74 20 6e 65 77 63 maxcol! dat newc
64a0: 6f 6c 6e 29 0a 09 09 09 09 09 20 20 20 20 20 6e oln)...... n
64b0: 65 77 63 6f 6c 6e 29 29 29 29 0a 09 09 09 28 69 ewcoln))))....(i
64c0: 66 20 28 6e 6f 74 20 28 73 70 61 72 73 65 2d 61 f (not (sparse-a
64d0: 72 72 61 79 2d 72 65 66 20 76 65 63 20 30 20 63 rray-ref vec 0 c
64e0: 6f 6c 6e 29 29 20 3b 3b 20 28 65 71 3f 20 72 6f oln)) ;; (eq? ro
64f0: 77 6e 20 30 29 0a 09 09 09 20 20 20 20 28 62 65 wn 0).... (be
6500: 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 73 70 gin.... (sp
6510: 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 21 20 arse-array-set!
6520: 76 65 63 20 30 20 63 6f 6c 6e 20 73 65 63 74 69 vec 0 coln secti
6530: 6f 6e 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 onname)....
6540: 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 70 61 72 ;; (print "spar
6550: 73 65 2d 61 72 72 61 79 2d 72 65 66 20 22 20 30 se-array-ref " 0
6560: 20 22 2c 22 20 63 6f 6c 6e 20 22 3d 22 20 28 73 "," coln "=" (s
6570: 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 parse-array-ref
6580: 76 65 63 20 30 20 63 6f 6c 6e 29 29 0a 09 09 09 vec 0 coln))....
6590: 20 20 20 20 20 20 29 29 0a 09 09 09 28 69 66 20 ))....(if
65a0: 28 6e 6f 74 20 28 73 70 61 72 73 65 2d 61 72 72 (not (sparse-arr
65b0: 61 79 2d 72 65 66 20 76 65 63 20 72 6f 77 6e 20 ay-ref vec rown
65c0: 30 29 29 20 3b 3b 20 28 65 71 3f 20 63 6f 6c 6e 0)) ;; (eq? coln
65d0: 20 30 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 0).... (begi
65e0: 6e 0a 09 09 09 20 20 20 20 20 20 28 73 70 61 72 n.... (spar
65f0: 73 65 2d 61 72 72 61 79 2d 73 65 74 21 20 76 65 se-array-set! ve
6600: 63 20 72 6f 77 6e 20 30 20 76 61 72 6e 61 6d 65 c rown 0 varname
6610: 29 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 28 70 ).... ;; (p
6620: 72 69 6e 74 20 22 73 70 61 72 73 65 2d 61 72 72 rint "sparse-arr
6630: 61 79 2d 72 65 66 20 22 20 72 6f 77 6e 20 22 2c ay-ref " rown ",
6640: 22 20 30 20 22 3d 22 20 28 73 70 61 72 73 65 2d " 0 "=" (sparse-
6650: 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 72 6f array-ref vec ro
6660: 77 6e 20 30 29 29 0a 09 09 09 20 20 20 20 20 20 wn 0))....
6670: 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 63 ))....(if (not c
6680: 75 72 72 72 6f 77 6e 29 28 68 61 73 68 2d 74 61 urrrown)(hash-ta
6690: 62 6c 65 2d 73 65 74 21 20 72 6f 77 6e 61 6d 65 ble-set! rowname
66a0: 73 20 76 61 72 6e 61 6d 65 20 72 6f 77 6e 29 29 s varname rown))
66b0: 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 63 75 72 ....(if (not cur
66c0: 72 63 6f 6c 6e 29 28 68 61 73 68 2d 74 61 62 6c rcoln)(hash-tabl
66d0: 65 2d 73 65 74 21 20 63 6f 6c 6e 61 6d 65 73 20 e-set! colnames
66e0: 73 65 63 74 69 6f 6e 6e 61 6d 65 20 63 6f 6c 6e sectionname coln
66f0: 29 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e 74 20 ))....;; (print
6700: 22 64 61 74 3d 22 20 64 61 74 20 22 2c 20 72 6f "dat=" dat ", ro
6710: 77 6e 3d 22 20 72 6f 77 6e 20 22 2c 20 63 6f 6c wn=" rown ", col
6720: 6e 3d 22 20 63 6f 6c 6e 29 0a 09 09 09 28 73 70 n=" coln)....(sp
6730: 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 21 20 arse-array-set!
6740: 76 65 63 20 72 6f 77 6e 20 63 6f 6c 6e 20 76 61 vec rown coln va
6750: 6c 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e 74 20 l)....;; (print
6760: 22 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 "sparse-array-re
6770: 66 20 22 20 72 6f 77 6e 20 22 2c 22 20 63 6f 6c f " rown "," col
6780: 6e 20 22 3d 22 20 28 73 70 61 72 73 65 2d 61 72 n "=" (sparse-ar
6790: 72 61 79 2d 72 65 66 20 76 65 63 20 72 6f 77 6e ray-ref vec rown
67a0: 20 63 6f 6c 6e 29 29 0a 09 09 09 29 29 29 0a 09 coln))....)))..
67b0: 09 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 . (for-each...
67c0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 (lambda (she
67d0: 65 74 6e 61 6d 65 29 0a 09 09 20 20 20 20 20 20 etname)...
67e0: 28 6c 65 74 2a 20 28 28 73 68 65 65 74 64 61 74 (let* ((sheetdat
67f0: 20 28 67 65 74 2d 64 61 74 20 72 65 73 75 6c 74 (get-dat result
6800: 73 20 73 68 65 65 74 6e 61 6d 65 29 29 0a 09 09 s sheetname))...
6810: 09 20 20 20 20 20 28 73 76 65 63 20 20 20 20 20 . (svec
6820: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 73 (refdb:csv-get-s
6830: 76 65 63 20 73 68 65 65 74 64 61 74 29 29 0a 09 vec sheetdat))..
6840: 09 09 20 20 20 20 20 28 6d 61 78 72 6f 77 20 20 .. (maxrow
6850: 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d (refdb:csv-get-
6860: 6d 61 78 72 6f 77 20 73 68 65 65 74 64 61 74 29 maxrow sheetdat)
6870: 29 0a 09 09 09 20 20 20 20 20 28 6d 61 78 63 6f ).... (maxco
6880: 6c 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 l (refdb:csv-g
6890: 65 74 2d 6d 61 78 63 6f 6c 20 73 68 65 65 74 64 et-maxcol sheetd
68a0: 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 66 6e at)).... (fn
68b0: 61 6d 65 20 20 20 20 28 69 66 20 6f 75 74 2d 66 ame (if out-f
68c0: 69 6c 65 20 0a 09 09 09 09 09 20 20 20 28 73 74 ile ...... (st
68d0: 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 ring-substitute
68e0: 22 25 73 22 20 73 68 65 65 74 6e 61 6d 65 20 6f "%s" sheetname o
68f0: 75 74 2d 66 69 6c 65 29 20 3b 3b 20 22 2f 66 6f ut-file) ;; "/fo
6900: 6f 2f 62 61 72 2f 25 73 2e 63 73 76 22 29 0a 09 o/bar/%s.csv")..
6910: 09 09 09 09 20 20 20 28 63 6f 6e 63 20 73 68 65 .... (conc she
6920: 65 74 6e 61 6d 65 20 22 2e 63 73 76 22 29 29 29 etname ".csv")))
6930: 29 0a 09 09 09 28 77 69 74 68 2d 6f 75 74 70 75 )....(with-outpu
6940: 74 2d 74 6f 2d 66 69 6c 65 20 66 6e 61 6d 65 0a t-to-file fname.
6950: 09 09 09 20 20 28 6c 61 6d 62 64 61 20 28 29 0a ... (lambda ().
6960: 09 09 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 ... ;; (print
6970: 20 22 53 68 65 65 74 6e 61 6d 65 3a 20 22 20 73 "Sheetname: " s
6980: 68 65 65 74 6e 61 6d 65 29 0a 09 09 09 20 20 20 heetname)....
6990: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 6f 77 (let loop ((row
69a0: 20 20 20 20 20 20 20 30 29 0a 09 09 09 09 20 20 0).....
69b0: 20 20 20 20 20 28 63 6f 6c 20 20 20 20 20 20 20 (col
69c0: 30 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 63 0)..... (c
69d0: 75 72 72 2d 72 6f 77 20 27 28 29 29 0a 09 09 09 urr-row '())....
69e0: 09 20 20 20 20 20 20 20 28 72 65 73 75 6c 74 20 . (result
69f0: 20 20 27 28 29 29 29 0a 09 09 09 20 20 20 20 20 '()))....
6a00: 20 28 6c 65 74 2a 20 28 28 76 61 6c 20 28 73 70 (let* ((val (sp
6a10: 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 73 arse-array-ref s
6a20: 76 65 63 20 72 6f 77 20 63 6f 6c 29 29 0a 09 09 vec row col))...
6a30: 09 09 20 20 20 20 20 28 64 69 73 70 2d 76 61 6c .. (disp-val
6a40: 20 28 69 66 20 76 61 6c 0a 09 09 09 09 09 09 20 (if val.......
6a50: 20 20 28 63 6f 6e 63 20 22 5c 22 22 20 76 61 6c (conc "\"" val
6a60: 20 22 5c 22 22 29 0a 09 09 09 09 09 09 20 20 20 "\"").......
6a70: 22 22 29 29 29 0a 09 09 09 09 28 69 66 20 28 3e ""))).....(if (>
6a80: 20 63 6f 6c 20 30 29 28 64 69 73 70 6c 61 79 20 col 0)(display
6a90: 22 2c 22 29 29 0a 09 09 09 09 28 64 69 73 70 6c ",")).....(displ
6aa0: 61 79 20 64 69 73 70 2d 76 61 6c 29 0a 09 09 09 ay disp-val)....
6ab0: 09 28 63 6f 6e 64 0a 09 09 09 09 20 28 28 3e 20 .(cond..... ((>
6ac0: 72 6f 77 20 6d 61 78 72 6f 77 29 28 64 69 73 70 row maxrow)(disp
6ad0: 6c 61 79 20 22 5c 6e 22 29 20 72 65 73 75 6c 74 lay "\n") result
6ae0: 29 0a 09 09 09 09 20 28 28 3e 3d 20 63 6f 6c 20 )..... ((>= col
6af0: 6d 61 78 63 6f 6c 29 0a 09 09 09 09 20 20 28 64 maxcol)..... (d
6b00: 69 73 70 6c 61 79 20 22 5c 6e 22 29 0a 09 09 09 isplay "\n")....
6b10: 09 20 20 28 6c 6f 6f 70 20 28 2b 20 72 6f 77 20 . (loop (+ row
6b20: 31 29 20 30 20 27 28 29 20 28 61 70 70 65 6e 64 1) 0 '() (append
6b30: 20 72 65 73 75 6c 74 20 28 6c 69 73 74 20 63 75 result (list cu
6b40: 72 72 2d 72 6f 77 29 29 29 29 0a 09 09 09 09 20 rr-row)))).....
6b50: 28 65 6c 73 65 0a 09 09 09 09 20 20 28 6c 6f 6f (else..... (loo
6b60: 70 20 72 6f 77 20 28 2b 20 63 6f 6c 20 31 29 20 p row (+ col 1)
6b70: 28 61 70 70 65 6e 64 20 63 75 72 72 2d 72 6f 77 (append curr-row
6b80: 20 28 6c 69 73 74 20 76 61 6c 29 29 20 72 65 73 (list val)) res
6b90: 75 6c 74 29 29 29 29 29 29 29 29 29 0a 09 09 20 ult)))))))))...
6ba0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b (hash-table-k
6bb0: 65 79 73 20 72 65 73 75 6c 74 73 29 29 29 29 0a eys results)))).
6bc0: 09 09 28 28 73 71 6c 69 74 65 33 29 0a 09 09 20 ..((sqlite3)...
6bd0: 28 6c 65 74 2a 20 28 28 64 62 2d 66 69 6c 65 20 (let* ((db-file
6be0: 20 20 28 6f 72 20 6f 75 74 2d 66 69 6c 65 20 28 (or out-file (
6bf0: 70 61 74 68 6e 61 6d 65 2d 66 69 6c 65 20 69 6e pathname-file in
6c00: 70 75 74 2d 64 62 29 29 29 0a 09 09 09 28 64 62 put-db)))....(db
6c10: 2d 65 78 69 73 74 73 20 28 66 69 6c 65 2d 65 78 -exists (file-ex
6c20: 69 73 74 73 3f 20 64 62 2d 66 69 6c 65 29 29 0a ists? db-file)).
6c30: 09 09 09 28 64 62 20 20 20 20 20 20 20 20 28 73 ...(db (s
6c40: 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 74 61 qlite3:open-data
6c50: 62 61 73 65 20 64 62 2d 66 69 6c 65 29 29 29 0a base db-file))).
6c60: 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 64 62 .. (if (not db
6c70: 2d 65 78 69 73 74 73 29 28 73 71 6c 69 74 65 33 -exists)(sqlite3
6c80: 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 52 45 :execute db "CRE
6c90: 41 54 45 20 54 41 42 4c 45 20 64 61 74 61 20 28 ATE TABLE data (
6ca0: 73 68 65 65 74 2c 73 65 63 74 69 6f 6e 2c 76 61 sheet,section,va
6cb0: 72 2c 76 61 6c 29 3b 22 29 29 0a 09 09 20 20 20 r,val);"))...
6cc0: 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c 6c (configf:map-all
6cd0: 2d 68 69 65 72 2d 61 6c 69 73 74 0a 09 09 20 20 -hier-alist...
6ce0: 20 20 64 61 74 61 0a 09 09 20 20 20 20 28 6c 61 data... (la
6cf0: 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 mbda (sheetname
6d00: 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e sectionname varn
6d10: 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 20 ame val)...
6d20: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
6d30: 65 20 64 62 0a 09 09 09 09 20 20 20 20 20 20 20 e db.....
6d40: 22 49 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 "INSERT OR REPLA
6d50: 43 45 20 49 4e 54 4f 20 64 61 74 61 20 28 73 68 CE INTO data (sh
6d60: 65 65 74 2c 73 65 63 74 69 6f 6e 2c 76 61 72 2c eet,section,var,
6d70: 76 61 6c 29 20 56 41 4c 55 45 53 20 28 3f 2c 3f val) VALUES (?,?
6d80: 2c 3f 2c 3f 29 3b 22 0a 09 09 09 09 20 20 20 20 ,?,?);".....
6d90: 20 20 20 73 68 65 65 74 6e 61 6d 65 20 73 65 63 sheetname sec
6da0: 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 tionname varname
6db0: 20 76 61 6c 29 29 29 0a 09 09 20 20 20 28 73 71 val)))... (sq
6dc0: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
6dd0: 64 62 29 29 29 0a 09 09 28 65 6c 73 65 0a 09 09 db)))...(else...
6de0: 20 28 70 70 20 64 61 74 61 29 29 29 29 29 29 0a (pp data)))))).
6df0: 20 20 20 20 20 20 28 69 66 20 6f 75 74 2d 66 69 (if out-fi
6e00: 6c 65 20 28 63 6c 6f 73 65 2d 6f 75 74 70 75 74 le (close-output
6e10: 2d 70 6f 72 74 20 6f 75 74 2d 70 6f 72 74 29 29 -port out-port))
6e20: 0a 20 20 20 20 20 20 28 65 78 69 74 29 20 3b 3b . (exit) ;;
6e30: 20 79 65 73 2c 20 62 65 6e 64 69 6e 67 20 74 68 yes, bending th
6e40: 65 20 72 75 6c 65 73 20 68 65 72 65 20 2d 20 6e e rules here - n
6e50: 65 65 64 20 74 6f 20 65 78 69 74 20 73 69 6e 63 eed to exit sinc
6e60: 65 20 74 68 69 73 20 69 73 20 61 20 75 74 69 6c e this is a util
6e70: 69 74 79 0a 20 20 20 20 20 20 29 29 0a 0a 28 69 ity. ))..(i
6e80: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
6e90: 22 2d 70 69 6e 67 22 29 0a 20 20 20 20 28 6c 65 "-ping"). (le
6ea0: 74 2a 20 28 28 73 65 72 76 65 72 2d 69 64 20 20 t* ((server-id
6eb0: 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 (string->numb
6ec0: 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 er (args:get-arg
6ed0: 20 22 2d 70 69 6e 67 22 29 29 29 20 3b 3b 20 65 "-ping"))) ;; e
6ee0: 78 74 72 61 63 74 20 72 75 6e 2d 69 64 20 28 69 xtract run-id (i
6ef0: 2e 65 2e 20 6e 6f 20 22 3a 22 0a 09 20 20 20 28 .e. no ":".. (
6f00: 68 6f 73 74 3a 70 6f 72 74 20 20 20 20 20 28 61 host:port (a
6f10: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 69 rgs:get-arg "-pi
6f20: 6e 67 22 29 29 29 0a 20 20 20 20 20 20 28 73 65 ng"))). (se
6f30: 72 76 65 72 3a 70 69 6e 67 20 28 6f 72 20 73 65 rver:ping (or se
6f40: 72 76 65 72 2d 69 64 20 68 6f 73 74 3a 70 6f 72 rver-id host:por
6f50: 74 29 20 64 6f 2d 65 78 69 74 3a 20 23 74 29 29 t) do-exit: #t))
6f60: 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 ===========.;; C
6fb0: 61 70 74 75 72 65 2c 20 73 61 76 65 20 61 6e 64 apture, save and
6fc0: 20 6d 61 6e 69 70 75 6c 61 74 65 20 65 6e 76 69 manipulate envi
6fd0: 72 6f 6e 6d 65 6e 74 73 0a 3b 3b 3d 3d 3d 3d 3d ronments.;;=====
6fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7020: 3d 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 4b 65 65 70 =..;; NOTE: Keep
7030: 20 74 68 65 73 65 20 61 62 6f 76 65 20 74 68 65 these above the
7040: 20 73 65 63 74 69 6f 6e 20 77 68 65 72 65 20 74 section where t
7050: 68 65 20 73 65 72 76 65 72 20 6f 72 20 63 6c 69 he server or cli
7060: 65 6e 74 20 63 6f 64 65 20 69 73 20 73 65 74 75 ent code is setu
7070: 70 0a 0a 28 6c 65 74 20 28 28 65 6e 76 63 61 70 p..(let ((envcap
7080: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7090: 2d 65 6e 76 63 61 70 22 29 29 29 0a 20 20 28 69 -envcap"))). (i
70a0: 66 20 65 6e 76 63 61 70 0a 20 20 20 20 20 20 28 f envcap. (
70b0: 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 28 let* ((db (
70c0: 65 6e 76 3a 6f 70 65 6e 2d 64 62 20 28 69 66 20 env:open-db (if
70d0: 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 (null? remargs)
70e0: 22 65 6e 76 64 61 74 2e 64 62 22 20 28 63 61 72 "envdat.db" (car
70f0: 20 72 65 6d 61 72 67 73 29 29 29 29 29 0a 09 28 remargs)))))..(
7100: 65 6e 76 3a 73 61 76 65 2d 65 6e 76 2d 76 61 72 env:save-env-var
7110: 73 20 64 62 20 65 6e 76 63 61 70 29 0a 09 28 65 s db envcap)..(e
7120: 6e 76 3a 63 6c 6f 73 65 2d 64 61 74 61 62 61 73 nv:close-databas
7130: 65 20 64 62 29 0a 09 28 73 65 74 21 20 2a 64 69 e db)..(set! *di
7140: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
7150: 29 29 0a 0a 3b 3b 20 64 65 6c 74 61 20 22 6c 61 ))..;; delta "la
7160: 6e 67 75 61 67 65 22 20 77 69 6c 6c 20 65 76 65 nguage" will eve
7170: 6e 74 75 61 6c 6c 79 20 62 65 20 72 65 73 3d 61 ntually be res=a
7180: 2b 62 2d 63 20 62 75 74 20 66 6f 72 20 6e 6f 77 +b-c but for now
7190: 20 69 74 20 69 73 20 6a 75 73 74 20 72 65 73 3d it is just res=
71a0: 61 2d 62 20 0a 3b 3b 0a 28 6c 65 74 20 28 28 65 a-b .;;.(let ((e
71b0: 6e 76 64 65 6c 74 61 20 28 61 72 67 73 3a 67 65 nvdelta (args:ge
71c0: 74 2d 61 72 67 20 22 2d 65 6e 76 64 65 6c 74 61 t-arg "-envdelta
71d0: 22 29 29 29 0a 20 20 28 69 66 20 65 6e 76 64 65 "))). (if envde
71e0: 6c 74 61 0a 20 20 20 20 20 20 28 6c 65 74 20 28 lta. (let (
71f0: 28 6d 61 74 63 68 20 28 73 74 72 69 6e 67 2d 73 (match (string-s
7200: 70 6c 69 74 20 65 6e 76 64 65 6c 74 61 20 22 2d plit envdelta "-
7210: 22 29 29 29 3b 3b 20 28 73 74 72 69 6e 67 2d 6d ")));; (string-m
7220: 61 74 63 68 20 22 28 5b 61 2d 7a 30 2d 39 5f 5d atch "([a-z0-9_]
7230: 2b 29 3d 28 5b 61 2d 7a 30 2d 39 5f 5c 5c 2d 2c +)=([a-z0-9_\\-,
7240: 5d 2b 29 22 20 65 6e 76 64 65 6c 74 61 29 29 29 ]+)" envdelta)))
7250: 0a 09 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c ..(if (not (null
7260: 3f 20 6d 61 74 63 68 29 29 0a 09 20 20 20 20 28 ? match)).. (
7270: 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 let* ((db
7280: 20 28 65 6e 76 3a 6f 70 65 6e 2d 64 62 20 28 69 (env:open-db (i
7290: 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 f (null? remargs
72a0: 29 20 22 65 6e 76 64 61 74 2e 64 62 22 20 28 63 ) "envdat.db" (c
72b0: 61 72 20 72 65 6d 61 72 67 73 29 29 29 29 0a 09 ar remargs))))..
72c0: 09 20 20 20 3b 3b 20 28 72 65 73 63 74 78 20 20 . ;; (resctx
72d0: 20 20 28 63 61 64 72 20 6d 61 74 63 68 29 29 0a (cadr match)).
72e0: 09 09 20 20 20 3b 3b 20 28 65 71 75 6e 20 20 20 .. ;; (equn
72f0: 20 20 20 28 63 61 64 64 72 20 6d 61 74 63 68 29 (caddr match)
7300: 29 0a 09 09 20 20 20 28 70 61 72 74 73 20 20 20 )... (parts
7310: 20 20 6d 61 74 63 68 29 20 3b 3b 20 28 73 74 72 match) ;; (str
7320: 69 6e 67 2d 73 70 6c 69 74 20 65 71 75 6e 20 22 ing-split equn "
7330: 2d 22 29 29 0a 09 09 20 20 20 28 6d 69 6e 75 65 -"))... (minue
7340: 6e 64 20 20 20 28 63 61 72 20 70 61 72 74 73 29 nd (car parts)
7350: 29 0a 09 09 20 20 20 28 73 75 62 74 72 61 65 6e )... (subtraen
7360: 64 20 28 63 61 64 72 20 70 61 72 74 73 29 29 0a d (cadr parts)).
7370: 09 09 20 20 20 28 61 64 64 65 64 20 20 20 20 20 .. (added
7380: 28 65 6e 76 3a 67 65 74 2d 61 64 64 65 64 20 20 (env:get-added
7390: 20 64 62 20 6d 69 6e 75 65 6e 64 20 73 75 62 74 db minuend subt
73a0: 72 61 65 6e 64 29 29 0a 09 09 20 20 20 28 72 65 raend))... (re
73b0: 6d 6f 76 65 64 20 20 20 28 65 6e 76 3a 67 65 74 moved (env:get
73c0: 2d 72 65 6d 6f 76 65 64 20 64 62 20 6d 69 6e 75 -removed db minu
73d0: 65 6e 64 20 73 75 62 74 72 61 65 6e 64 29 29 0a end subtraend)).
73e0: 09 09 20 20 20 28 63 68 61 6e 67 65 64 20 20 20 .. (changed
73f0: 28 65 6e 76 3a 67 65 74 2d 63 68 61 6e 67 65 64 (env:get-changed
7400: 20 64 62 20 6d 69 6e 75 65 6e 64 20 73 75 62 74 db minuend subt
7410: 72 61 65 6e 64 29 29 29 0a 09 20 20 20 20 20 20 raend)))..
7420: 3b 3b 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 ;; (pp (hash-tab
7430: 6c 65 2d 3e 61 6c 69 73 74 20 61 64 64 65 64 29 le->alist added)
7440: 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 70 70 20 ).. ;; (pp
7450: 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 (hash-table->ali
7460: 73 74 20 72 65 6d 6f 76 65 64 29 29 0a 09 20 20 st removed))..
7470: 20 20 20 20 3b 3b 20 28 70 70 20 28 68 61 73 68 ;; (pp (hash
7480: 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 63 68 -table->alist ch
7490: 61 6e 67 65 64 29 29 0a 09 20 20 20 20 20 20 28 anged)).. (
74a0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
74b0: 20 22 2d 6f 22 29 0a 09 09 20 20 28 77 69 74 68 "-o")... (with
74c0: 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 0a -output-to-file.
74d0: 09 09 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 .. (args:ge
74e0: 74 2d 61 72 67 20 22 2d 6f 22 29 0a 09 09 20 20 t-arg "-o")...
74f0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 (lambda ()...
7500: 20 20 20 20 20 28 65 6e 76 3a 70 72 69 6e 74 20 (env:print
7510: 61 64 64 65 64 20 72 65 6d 6f 76 65 64 20 63 68 added removed ch
7520: 61 6e 67 65 64 29 29 29 0a 09 09 20 20 28 65 6e anged)))... (en
7530: 76 3a 70 72 69 6e 74 20 61 64 64 65 64 20 72 65 v:print added re
7540: 6d 6f 76 65 64 20 63 68 61 6e 67 65 64 29 29 0a moved changed)).
7550: 09 20 20 20 20 20 20 28 65 6e 76 3a 63 6c 6f 73 . (env:clos
7560: 65 2d 64 61 74 61 62 61 73 65 20 64 62 29 0a 09 e-database db)..
7570: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
7580: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 0a something* #t)).
7590: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
75a0: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
75b0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 50 61 lt-log-port* "Pa
75c0: 72 61 6d 65 74 65 72 20 74 6f 20 2d 65 6e 76 64 rameter to -envd
75d0: 65 6c 74 61 20 73 68 6f 75 6c 64 20 62 65 20 6e elta should be n
75e0: 65 77 3d 73 74 61 72 2d 65 6e 64 22 29 29 29 29 ew=star-end"))))
75f0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
7600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 ===========.;; S
7640: 74 61 72 74 20 74 68 65 20 73 65 72 76 65 72 20 tart the server
7650: 2d 20 63 61 6e 20 62 65 20 64 6f 6e 65 20 69 6e - can be done in
7660: 20 63 6f 6e 6a 75 6e 63 74 69 6f 6e 20 77 69 74 conjunction wit
7670: 68 20 2d 72 75 6e 61 6c 6c 20 6f 72 20 2d 72 75 h -runall or -ru
7680: 6e 74 65 73 74 73 20 28 6f 6e 65 20 64 61 79 2e ntests (one day.
7690: 2e 2e 29 0a 3b 3b 20 20 20 77 65 20 73 74 61 72 ..).;; we star
76a0: 74 20 74 68 65 20 73 65 72 76 65 72 20 69 66 20 t the server if
76b0: 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 65 6c 73 65 not running else
76c0: 20 73 74 61 72 74 20 74 68 65 20 63 6c 69 65 6e start the clien
76d0: 74 20 74 68 72 65 61 64 0a 3b 3b 3d 3d 3d 3d 3d t thread.;;=====
76e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7720: 3d 0a 0a 3b 3b 20 53 65 72 76 65 72 3f 20 53 74 =..;; Server? St
7730: 61 72 74 20 75 70 20 68 65 72 65 2e 0a 3b 3b 0a art up here..;;.
7740: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
7750: 67 20 22 2d 73 65 72 76 65 72 22 29 0a 20 20 20 g "-server").
7760: 20 28 6c 65 74 20 28 28 74 6c 20 20 20 20 20 20 (let ((tl
7770: 20 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 (launch:setup)
7780: 29 0a 20 20 20 20 20 20 20 20 20 20 28 74 72 61 ). (tra
7790: 6e 73 70 6f 72 74 2d 74 79 70 65 20 28 73 74 72 nsport-type (str
77a0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 20 ing->symbol (or
77b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
77c0: 74 72 61 6e 73 70 6f 72 74 22 29 20 22 68 74 74 transport") "htt
77d0: 70 22 29 29 29 29 0a 20 20 20 20 20 20 28 73 65 p")))). (se
77e0: 72 76 65 72 3a 6c 61 75 6e 63 68 20 30 20 74 72 rver:launch 0 tr
77f0: 61 6e 73 70 6f 72 74 2d 74 79 70 65 29 0a 20 20 ansport-type).
7800: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
7810: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
7820: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
7830: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 73 65 72 t-arg "-list-ser
7840: 76 65 72 73 22 29 0a 09 28 61 72 67 73 3a 67 65 vers")..(args:ge
7850: 74 2d 61 72 67 20 22 2d 73 74 6f 70 2d 73 65 72 t-arg "-stop-ser
7860: 76 65 72 22 29 0a 20 20 20 20 20 20 20 20 28 61 ver"). (a
7870: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6b 69 rgs:get-arg "-ki
7880: 6c 6c 2d 73 65 72 76 65 72 22 29 29 0a 20 20 20 ll-server")).
7890: 20 28 6c 65 74 20 28 28 74 6c 20 28 6c 61 75 6e (let ((tl (laun
78a0: 63 68 3a 73 65 74 75 70 29 29 29 0a 20 20 20 20 ch:setup))).
78b0: 20 20 28 69 66 20 74 6c 20 0a 09 20 20 28 6c 65 (if tl .. (le
78c0: 74 2a 20 28 28 73 65 72 76 65 72 73 20 28 73 65 t* ((servers (se
78d0: 72 76 65 72 3a 67 65 74 2d 6c 69 73 74 20 2a 74 rver:get-list *t
78e0: 6f 70 70 61 74 68 2a 29 29 0a 09 09 20 28 66 6d oppath*))... (fm
78f0: 74 73 74 72 20 20 22 7e 35 61 7e 31 32 61 7e 38 tstr "~5a~12a~8
7900: 61 7e 32 30 61 7e 32 34 61 7e 31 30 61 7e 31 30 a~20a~24a~10a~10
7910: 61 7e 31 30 61 7e 31 30 61 5c 6e 22 29 0a 09 09 a~10a~10a\n")...
7920: 20 28 73 65 72 76 65 72 73 2d 74 6f 2d 6b 69 6c (servers-to-kil
7930: 6c 20 27 28 29 29 0a 20 20 20 20 20 20 20 20 20 l '()).
7940: 20 20 20 20 20 20 20 20 28 6b 69 6c 6c 2d 73 77 (kill-sw
7950: 69 74 63 68 20 20 28 69 66 20 28 61 72 67 73 3a itch (if (args:
7960: 67 65 74 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 get-arg "-kill-s
7970: 65 72 76 65 72 22 29 20 22 2d 39 22 20 22 22 29 erver") "-9" "")
7980: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
7990: 20 20 20 28 6b 69 6c 6c 69 6e 66 6f 20 20 20 28 (killinfo (
79a0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
79b0: 20 22 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 29 "-stop-server")
79c0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
79d0: 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 29 20 29 -kill-server") )
79e0: 29 0a 09 09 20 28 6b 68 6f 73 74 2d 70 6f 72 74 )... (khost-port
79f0: 20 28 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 69 (if killinfo (i
7a00: 66 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 f (substring-ind
7a10: 65 78 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f 29 ex ":" killinfo)
7a20: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 22 3a (string-split ":
7a30: 22 29 20 23 66 29 20 23 66 29 29 0a 09 09 20 28 ") #f) #f))... (
7a40: 73 69 64 20 20 20 20 20 20 20 20 28 69 66 20 6b sid (if k
7a50: 69 6c 6c 69 6e 66 6f 20 28 69 66 20 28 73 75 62 illinfo (if (sub
7a60: 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 3a 22 string-index ":"
7a70: 20 6b 69 6c 6c 69 6e 66 6f 29 20 23 66 20 28 73 killinfo) #f (s
7a80: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 6b 69 tring->number ki
7a90: 6c 6c 69 6e 66 6f 29 29 20 23 66 29 29 29 0a 09 llinfo)) #f)))..
7aa0: 20 20 20 20 28 66 6f 72 6d 61 74 20 23 74 20 66 (format #t f
7ab0: 6d 74 73 74 72 20 22 49 64 22 20 22 4d 54 76 65 mtstr "Id" "MTve
7ac0: 72 22 20 22 50 69 64 22 20 22 48 6f 73 74 22 20 r" "Pid" "Host"
7ad0: 22 49 6e 74 65 72 66 61 63 65 3a 4f 75 74 50 6f "Interface:OutPo
7ae0: 72 74 22 20 22 49 6e 50 6f 72 74 22 20 22 4c 61 rt" "InPort" "La
7af0: 73 74 42 65 61 74 22 20 22 53 74 61 74 65 22 20 stBeat" "State"
7b00: 22 54 72 61 6e 73 70 6f 72 74 22 29 0a 09 20 20 "Transport")..
7b10: 20 20 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 (format #t fmt
7b20: 73 74 72 20 22 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 str "==" "====="
7b30: 20 22 3d 3d 3d 22 20 22 3d 3d 3d 3d 22 20 22 3d "===" "====" "=
7b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b50: 22 20 22 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d " "======" "====
7b60: 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d ====" "=====" "=
7b70: 3d 3d 3d 3d 3d 3d 3d 3d 22 29 0a 09 20 20 20 20 ========")..
7b80: 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 20 (for-each ..
7b90: 20 28 6c 61 6d 62 64 61 20 28 73 65 72 76 65 72 (lambda (server
7ba0: 29 0a 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 ).. (let*
7bb0: 28 28 69 64 20 20 20 20 20 20 20 20 20 28 76 65 ((id (ve
7bc0: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
7bd0: 30 29 29 0a 09 09 20 20 20 20 20 20 28 70 69 64 0))... (pid
7be0: 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d (vector-
7bf0: 72 65 66 20 73 65 72 76 65 72 20 31 29 29 0a 09 ref server 1))..
7c00: 09 20 20 20 20 20 20 28 68 6f 73 74 6e 61 6d 65 . (hostname
7c10: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
7c20: 65 72 76 65 72 20 32 29 29 0a 09 09 20 20 20 20 erver 2))...
7c30: 20 20 28 69 6e 74 65 72 66 61 63 65 20 20 28 76 (interface (v
7c40: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
7c50: 20 33 29 29 20 0a 09 09 20 20 20 20 20 20 28 70 3)) ... (p
7c60: 75 6c 6c 70 6f 72 74 20 20 20 28 76 65 63 74 6f ullport (vecto
7c70: 72 2d 72 65 66 20 73 65 72 76 65 72 20 34 29 29 r-ref server 4))
7c80: 0a 09 09 20 20 20 20 20 20 28 70 75 62 70 6f 72 ... (pubpor
7c90: 74 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 t (vector-ref
7ca0: 20 73 65 72 76 65 72 20 35 29 29 0a 09 09 20 20 server 5))...
7cb0: 20 20 20 20 28 73 74 61 72 74 2d 74 69 6d 65 20 (start-time
7cc0: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 (vector-ref serv
7cd0: 65 72 20 36 29 29 0a 09 09 20 20 20 20 20 20 28 er 6))... (
7ce0: 70 72 69 6f 72 69 74 79 20 20 20 28 76 65 63 74 priority (vect
7cf0: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 37 29 or-ref server 7)
7d00: 29 0a 09 09 20 20 20 20 20 20 28 73 74 61 74 65 )... (state
7d10: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re
7d20: 66 20 73 65 72 76 65 72 20 38 29 29 0a 09 09 20 f server 8))...
7d30: 20 20 20 20 20 28 6d 74 2d 76 65 72 20 20 20 20 (mt-ver
7d40: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
7d50: 76 65 72 20 39 29 29 0a 09 09 20 20 20 20 20 20 ver 9))...
7d60: 28 6c 61 73 74 2d 75 70 64 61 74 65 20 28 76 65 (last-update (ve
7d70: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
7d80: 31 30 29 29 20 0a 09 09 20 20 20 20 20 20 28 74 10)) ... (t
7d90: 72 61 6e 73 70 6f 72 74 20 20 28 76 65 63 74 6f ransport (vecto
7da0: 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 31 29 r-ref server 11)
7db0: 29 0a 09 09 20 20 20 20 20 20 28 6b 69 6c 6c 65 )... (kille
7dc0: 64 20 20 20 20 20 23 66 29 0a 09 09 20 20 20 20 d #f)...
7dd0: 20 20 28 73 74 61 74 75 73 20 20 20 20 20 28 3c (status (<
7de0: 20 6c 61 73 74 2d 75 70 64 61 74 65 20 32 30 29 last-update 20)
7df0: 29 29 0a 09 09 20 3b 3b 20 20 20 28 7a 6d 71 2d ))... ;; (zmq-
7e00: 73 6f 63 6b 65 74 73 20 28 69 66 20 73 74 61 74 sockets (if stat
7e10: 75 73 20 28 73 65 72 76 65 72 3a 63 6c 69 65 6e us (server:clien
7e20: 74 2d 63 6f 6e 6e 65 63 74 20 68 6f 73 74 6e 61 t-connect hostna
7e30: 6d 65 20 70 6f 72 74 29 20 23 66 29 29 29 0a 09 me port) #f)))..
7e40: 09 20 3b 3b 20 6e 6f 20 6e 65 65 64 20 74 6f 20 . ;; no need to
7e50: 6c 6f 67 69 6e 20 61 73 20 73 74 61 74 75 73 20 login as status
7e60: 6f 66 20 23 74 20 69 6e 64 69 63 61 74 65 73 20 of #t indicates
7e70: 77 65 20 61 72 65 20 63 6f 6e 6e 65 63 74 69 6e we are connectin
7e80: 67 20 74 6f 20 63 6f 72 72 65 63 74 20 0a 09 09 g to correct ...
7e90: 20 3b 3b 20 73 65 72 76 65 72 0a 09 09 3b 3b 20 ;; server...;;
7ea0: 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 (if (equal? stat
7eb0: 65 20 22 64 65 61 64 22 29 0a 09 09 3b 3b 20 20 e "dead")...;;
7ec0: 20 20 20 28 69 66 20 28 3e 20 6c 61 73 74 2d 75 (if (> last-u
7ed0: 70 64 61 74 65 20 28 2a 20 32 35 20 36 30 20 36 pdate (* 25 60 6
7ee0: 30 29 29 20 3b 3b 20 6b 65 65 70 20 72 65 63 6f 0)) ;; keep reco
7ef0: 72 64 73 20 61 72 6f 75 6e 64 20 66 6f 72 20 73 rds around for s
7f00: 6c 69 67 68 6c 79 20 6f 76 65 72 20 61 20 64 61 lighly over a da
7f10: 79 2e 0a 09 09 3b 3b 20 09 20 28 74 61 73 6b 73 y....;; . (tasks
7f20: 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 :server-deregist
7f30: 65 72 20 28 64 62 3a 64 65 6c 61 79 2d 69 66 2d er (db:delay-if-
7f40: 62 75 73 79 20 74 64 62 64 61 74 29 20 68 6f 73 busy tdbdat) hos
7f50: 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 74 3a 20 tname pullport:
7f60: 70 75 6c 6c 70 6f 72 74 20 70 69 64 3a 20 70 69 pullport pid: pi
7f70: 64 20 61 63 74 69 6f 6e 3a 20 27 64 65 6c 65 74 d action: 'delet
7f80: 65 29 29 0a 09 09 3b 3b 20 20 20 20 20 28 69 66 e))...;; (if
7f90: 20 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 (> last-update
7fa0: 32 30 29 20 20 20 20 20 20 20 20 3b 3b 20 4d 61 20) ;; Ma
7fb0: 72 6b 20 61 73 20 64 65 61 64 20 69 66 20 6e 6f rk as dead if no
7fc0: 74 20 75 70 64 61 74 65 64 20 69 6e 20 6c 61 73 t updated in las
7fd0: 74 20 32 30 20 73 65 63 6f 6e 64 73 0a 09 09 3b t 20 seconds...;
7fe0: 3b 20 09 20 28 74 61 73 6b 73 3a 73 65 72 76 65 ; . (tasks:serve
7ff0: 72 2d 64 65 72 65 67 69 73 74 65 72 20 28 64 62 r-deregister (db
8000: 3a 64 65 6c 61 79 2d 69 66 2d 62 75 73 79 20 74 :delay-if-busy t
8010: 64 62 64 61 74 29 20 68 6f 73 74 6e 61 6d 65 20 dbdat) hostname
8020: 70 75 6c 6c 70 6f 72 74 3a 20 70 75 6c 6c 70 6f pullport: pullpo
8030: 72 74 20 70 69 64 3a 20 70 69 64 29 29 29 0a 09 rt pid: pid)))..
8040: 09 20 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 . (format #t fmt
8050: 73 74 72 20 69 64 20 6d 74 2d 76 65 72 20 70 69 str id mt-ver pi
8060: 64 20 68 6f 73 74 6e 61 6d 65 20 28 63 6f 6e 63 d hostname (conc
8070: 20 69 6e 74 65 72 66 61 63 65 20 22 3a 22 20 70 interface ":" p
8080: 75 6c 6c 70 6f 72 74 29 20 70 75 62 70 6f 72 74 ullport) pubport
8090: 20 6c 61 73 74 2d 75 70 64 61 74 65 0a 09 09 09 last-update....
80a0: 20 28 69 66 20 73 74 61 74 75 73 20 22 61 6c 69 (if status "ali
80b0: 76 65 22 20 22 64 65 61 64 22 29 20 74 72 61 6e ve" "dead") tran
80c0: 73 70 6f 72 74 29 0a 09 09 20 28 69 66 20 28 6f sport)... (if (o
80d0: 72 20 28 65 71 75 61 6c 3f 20 69 64 20 73 69 64 r (equal? id sid
80e0: 29 0a 09 09 09 20 28 65 71 75 61 6c 3f 20 73 69 ).... (equal? si
80f0: 64 20 30 29 29 20 3b 3b 20 6b 69 6c 6c 20 61 6c d 0)) ;; kill al
8100: 6c 2f 61 6e 79 0a 09 09 20 20 20 20 20 28 62 65 l/any... (be
8110: 67 69 6e 0a 09 09 20 20 20 20 20 20 20 28 64 65 gin... (de
8120: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
8130: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
8140: 72 74 2a 20 22 41 74 74 65 6d 70 74 69 6e 67 20 rt* "Attempting
8150: 74 6f 20 6b 69 6c 6c 20 22 6b 69 6c 6c 2d 73 77 to kill "kill-sw
8160: 69 74 63 68 22 20 73 65 72 76 65 72 20 77 69 74 itch" server wit
8170: 68 20 70 69 64 20 22 20 70 69 64 29 0a 09 09 20 h pid " pid)...
8180: 20 20 20 20 20 20 28 74 61 73 6b 73 3a 6b 69 6c (tasks:kil
8190: 6c 2d 73 65 72 76 65 72 20 68 6f 73 74 6e 61 6d l-server hostnam
81a0: 65 20 70 69 64 20 6b 69 6c 6c 2d 73 77 69 74 63 e pid kill-switc
81b0: 68 3a 20 6b 69 6c 6c 2d 73 77 69 74 63 68 29 29 h: kill-switch))
81c0: 29 29 29 0a 09 20 20 20 20 20 73 65 72 76 65 72 ))).. server
81d0: 73 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 s).. (debug:p
81e0: 72 69 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 rint-info 1 *def
81f0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
8200: 44 6f 6e 65 20 77 69 74 68 20 6c 69 73 74 73 65 Done with listse
8210: 72 76 65 72 73 22 29 0a 09 20 20 20 20 28 73 65 rvers").. (se
8220: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
8230: 2a 20 23 74 29 0a 09 20 20 20 20 28 65 78 69 74 * #t).. (exit
8240: 29 29 20 3b 3b 20 6d 75 73 74 20 64 6f 2c 20 77 )) ;; must do, w
8250: 6f 75 6c 64 20 68 61 76 65 20 74 6f 20 61 64 64 ould have to add
8260: 20 63 68 65 63 6b 73 20 74 6f 20 6d 61 6e 79 2f checks to many/
8270: 61 6c 6c 20 63 61 6c 6c 73 20 62 65 6c 6f 77 0a all calls below.
8280: 09 20 20 28 65 78 69 74 29 29 29 29 0a 0a 3b 3b . (exit))))..;;
8290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82d0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 57 65 69 72 64 20 ======.;; Weird
82e0: 73 70 65 63 69 61 6c 20 63 61 6c 6c 73 20 74 68 special calls th
82f0: 61 74 20 6e 65 65 64 20 74 6f 20 72 75 6e 20 2a at need to run *
8300: 61 66 74 65 72 2a 20 74 68 65 20 73 65 72 76 65 after* the serve
8310: 72 20 68 61 73 20 73 74 61 72 74 65 64 3f 0a 3b r has started?.;
8320: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
8330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8360: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
8370: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 gs:get-arg "-lis
8380: 74 2d 74 61 72 67 65 74 73 22 29 0a 20 20 20 20 t-targets").
8390: 28 69 66 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 (if (launch:setu
83a0: 70 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 20 p). (let
83b0: 28 28 74 61 72 67 65 74 73 20 28 63 6f 6d 6d 6f ((targets (commo
83c0: 6e 3a 67 65 74 2d 72 75 6e 63 6f 6e 66 69 67 2d n:get-runconfig-
83d0: 74 61 72 67 65 74 73 29 29 29 0a 20 20 20 20 20 targets))).
83e0: 20 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 ;; (debug:p
83f0: 72 69 6e 74 20 31 20 2a 64 65 66 61 75 6c 74 2d rint 1 *default-
8400: 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 6f 75 6e 64 log-port* "Found
8410: 20 22 28 6c 65 6e 67 74 68 20 74 61 72 67 65 74 "(length target
8420: 73 29 20 22 20 74 61 72 67 65 74 73 22 29 0a 20 s) " targets").
8430: 20 20 20 20 20 20 20 20 20 28 63 61 73 65 20 28 (case (
8440: 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 string->symbol (
8450: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
8460: 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 61 "-dumpmode") "a
8470: 6c 69 73 74 22 29 29 0a 20 20 20 20 20 20 20 20 list")).
8480: 20 20 20 20 28 28 61 6c 69 73 74 29 0a 20 20 20 ((alist).
8490: 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 (for-e
84a0: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 78 29 0a ach (lambda (x).
84b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
84c0: 20 20 20 20 20 20 20 20 20 3b 3b 20 28 70 72 69 ;; (pri
84d0: 6e 74 20 22 5b 22 20 78 20 22 5d 22 29 29 0a 20 nt "[" x "]")).
84e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
84f0: 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 78 (print x
8500: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
8510: 20 20 20 20 20 20 20 20 20 20 74 61 72 67 65 74 target
8520: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
8530: 28 28 6a 73 6f 6e 29 0a 20 20 20 20 20 20 20 20 ((json).
8540: 20 20 20 20 20 28 6a 73 6f 6e 2d 77 72 69 74 65 (json-write
8550: 20 74 61 72 67 65 74 73 29 29 0a 20 20 20 20 20 targets)).
8560: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 (else.
8570: 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
8580: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
8590: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
85a0: 2a 20 22 64 75 6d 70 20 6f 75 74 70 75 74 20 66 * "dump output f
85b0: 6f 72 6d 61 74 20 22 20 28 61 72 67 73 3a 67 65 ormat " (args:ge
85c0: 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 t-arg "-dumpmode
85d0: 22 29 20 22 20 6e 6f 74 20 73 75 70 70 6f 72 74 ") " not support
85e0: 65 64 20 66 6f 72 20 2d 6c 69 73 74 2d 74 61 72 ed for -list-tar
85f0: 67 65 74 73 22 29 29 29 0a 20 20 20 20 20 20 20 gets"))).
8600: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
8610: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a ething* #t))))..
8620: 3b 3b 20 63 61 63 68 65 20 74 68 65 20 72 75 6e ;; cache the run
8630: 63 6f 6e 66 69 67 73 20 69 6e 20 24 4d 54 5f 4c configs in $MT_L
8640: 49 4e 4b 54 52 45 45 2f 24 4d 54 5f 54 41 52 47 INKTREE/$MT_TARG
8650: 45 54 2f 24 4d 54 5f 52 55 4e 4e 41 4d 45 2f 2e ET/$MT_RUNNAME/.
8660: 72 75 6e 63 6f 6e 66 69 67 0a 3b 3b 0a 28 64 65 runconfig.;;.(de
8670: 66 69 6e 65 20 28 66 75 6c 6c 2d 72 75 6e 63 6f fine (full-runco
8680: 6e 66 69 67 73 2d 72 65 61 64 29 0a 3b 3b 20 69 nfigs-read).;; i
8690: 6e 20 74 68 65 20 65 6e 76 70 72 6f 63 65 73 73 n the envprocess
86a0: 69 6e 67 20 62 72 61 6e 63 68 20 74 68 65 20 62 ing branch the b
86b0: 65 6c 6f 77 20 63 6f 64 65 20 72 65 70 6c 61 63 elow code replac
86c0: 65 73 20 74 68 65 20 66 75 72 74 68 65 72 20 62 es the further b
86d0: 65 6c 6f 77 20 63 6f 64 65 0a 3b 3b 20 20 28 69 elow code.;; (i
86e0: 66 20 28 65 71 3f 20 2a 63 6f 6e 66 69 67 73 74 f (eq? *configst
86f0: 61 74 75 73 2a 20 27 66 75 6c 6c 64 61 74 61 29 atus* 'fulldata)
8700: 0a 3b 3b 20 20 20 20 20 20 2a 72 75 6e 63 6f 6e .;; *runcon
8710: 66 69 67 64 61 74 2a 0a 3b 3b 20 20 20 20 20 20 figdat*.;;
8720: 28 62 65 67 69 6e 0a 3b 3b 09 28 6c 61 75 6e 63 (begin.;;.(launc
8730: 68 3a 73 65 74 75 70 29 0a 3b 3b 09 2a 72 75 6e h:setup).;;.*run
8740: 63 6f 6e 66 69 67 64 61 74 2a 29 29 29 0a 0a 20 configdat*)))..
8750: 20 28 6c 65 74 2a 20 28 28 72 75 6e 64 69 72 20 (let* ((rundir
8760: 28 69 66 20 28 61 6e 64 20 28 67 65 74 65 6e 76 (if (and (getenv
8770: 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 29 28 "MT_LINKTREE")(
8780: 67 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 getenv "MT_TARGE
8790: 54 22 29 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 T")(getenv "MT_R
87a0: 55 4e 4e 41 4d 45 22 29 29 0a 09 09 20 20 20 20 UNNAME"))...
87b0: 20 28 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 22 (conc (getenv "
87c0: 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 29 20 22 2f MT_LINKTREE") "/
87d0: 22 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 41 " (getenv "MT_TA
87e0: 52 47 45 54 22 29 20 22 2f 22 20 28 67 65 74 65 RGET") "/" (gete
87f0: 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 29 nv "MT_RUNNAME")
8800: 29 0a 09 09 20 20 20 20 20 23 66 29 29 0a 09 20 )... #f))..
8810: 28 63 66 67 66 20 20 20 28 69 66 20 72 75 6e 64 (cfgf (if rund
8820: 69 72 20 28 63 6f 6e 63 20 72 75 6e 64 69 72 20 ir (conc rundir
8830: 22 2f 2e 72 75 6e 63 6f 6e 66 69 67 2e 22 20 6d "/.runconfig." m
8840: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 egatest-version
8850: 22 2d 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 "-" megatest-fos
8860: 73 69 6c 2d 68 61 73 68 29 20 23 66 29 29 29 0a sil-hash) #f))).
8870: 20 20 20 20 28 69 66 20 28 61 6e 64 20 63 66 67 (if (and cfg
8880: 66 0a 09 20 20 20 20 20 28 66 69 6c 65 2d 65 78 f.. (file-ex
8890: 69 73 74 73 3f 20 63 66 67 66 29 0a 09 20 20 20 ists? cfgf)..
88a0: 20 20 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 (file-write-ac
88b0: 63 65 73 73 3f 20 63 66 67 66 29 29 0a 09 28 63 cess? cfgf))..(c
88c0: 6f 6e 66 69 67 66 3a 72 65 61 64 2d 61 6c 69 73 onfigf:read-alis
88d0: 74 20 63 66 67 66 29 0a 09 28 6c 65 74 2a 20 28 t cfgf)..(let* (
88e0: 28 6b 65 79 73 20 20 20 28 72 6d 74 3a 67 65 74 (keys (rmt:get
88f0: 2d 6b 65 79 73 29 29 0a 09 20 20 20 20 20 20 20 -keys))..
8900: 28 74 61 72 67 65 74 20 28 63 6f 6d 6d 6f 6e 3a (target (common:
8910: 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 args-get-target)
8920: 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 2d 76 ).. (key-v
8930: 61 6c 73 20 28 69 66 20 74 61 72 67 65 74 20 28 als (if target (
8940: 6b 65 79 73 3a 74 61 72 67 65 74 2d 3e 6b 65 79 keys:target->key
8950: 76 61 6c 20 6b 65 79 73 20 74 61 72 67 65 74 29 val keys target)
8960: 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 73 #f)).. (s
8970: 65 63 74 69 6f 6e 73 20 28 69 66 20 74 61 72 67 ections (if targ
8980: 65 74 20 28 6c 69 73 74 20 22 64 65 66 61 75 6c et (list "defaul
8990: 74 22 20 74 61 72 67 65 74 29 20 23 66 29 29 0a t" target) #f)).
89a0: 09 20 20 20 20 20 20 20 28 64 61 74 61 20 20 20 . (data
89b0: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 28 (begin.... (
89c0: 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 setenv "MT_RUN_A
89d0: 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 REA_HOME" *toppa
89e0: 74 68 2a 29 0a 09 09 09 20 20 20 28 69 66 20 6b th*).... (if k
89f0: 65 79 2d 76 61 6c 73 0a 09 09 09 20 20 20 20 20 ey-vals....
8a00: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
8a10: 62 64 61 20 28 6b 74 29 0a 09 09 09 09 09 20 20 bda (kt)......
8a20: 20 28 73 65 74 65 6e 76 20 28 63 61 72 20 6b 74 (setenv (car kt
8a30: 29 20 28 63 61 64 72 20 6b 74 29 29 29 0a 09 09 ) (cadr kt)))...
8a40: 09 09 09 20 6b 65 79 2d 76 61 6c 73 29 29 0a 09 ... key-vals))..
8a50: 09 09 20 20 20 3b 3b 20 28 72 65 61 64 2d 63 6f .. ;; (read-co
8a60: 6e 66 69 67 20 28 63 6f 6e 63 20 2a 74 6f 70 70 nfig (conc *topp
8a70: 61 74 68 2a 20 22 2f 72 75 6e 63 6f 6e 66 69 67 ath* "/runconfig
8a80: 73 2e 63 6f 6e 66 69 67 22 29 20 23 66 20 23 74 s.config") #f #t
8a90: 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 69 sections: secti
8aa0: 6f 6e 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 ons)))).
8ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ac0: 20 20 20 28 72 75 6e 63 6f 6e 66 69 67 3a 72 65 (runconfig:re
8ad0: 61 64 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 ad (conc *toppat
8ae0: 68 2a 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e h* "/runconfigs.
8af0: 63 6f 6e 66 69 67 22 29 20 74 61 72 67 65 74 20 config") target
8b00: 23 66 29 29 29 29 0a 09 20 20 28 69 66 20 28 61 #f)))).. (if (a
8b10: 6e 64 20 72 75 6e 64 69 72 20 3b 3b 20 68 61 76 nd rundir ;; hav
8b20: 65 20 61 6c 6c 20 6e 65 65 64 65 64 20 76 61 72 e all needed var
8b30: 69 61 62 6c 65 73 73 0a 09 09 20 20 20 28 64 69 iabless... (di
8b40: 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 rectory-exists?
8b50: 72 75 6e 64 69 72 29 0a 09 09 20 20 20 28 66 69 rundir)... (fi
8b60: 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f le-write-access?
8b70: 20 72 75 6e 64 69 72 29 29 0a 09 20 20 20 20 20 rundir))..
8b80: 20 28 62 65 67 69 6e 0a 09 09 28 63 6f 6e 66 69 (begin...(confi
8b90: 67 66 3a 77 72 69 74 65 2d 61 6c 69 73 74 20 64 gf:write-alist d
8ba0: 61 74 61 20 63 66 67 66 29 0a 09 09 3b 3b 20 66 ata cfgf)...;; f
8bb0: 6f 72 63 65 20 72 65 2d 72 65 61 64 20 6f 66 20 orce re-read of
8bc0: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 megatest.config
8bd0: 2d 20 74 68 69 73 20 72 65 73 6f 6c 76 65 73 20 - this resolves
8be0: 63 69 72 63 75 6c 61 72 20 72 65 66 65 72 65 6e circular referen
8bf0: 63 65 73 20 62 65 74 77 65 65 6e 20 6d 65 67 61 ces between mega
8c00: 74 65 73 74 2e 63 6f 6e 66 69 67 0a 09 09 28 6c test.config...(l
8c10: 61 75 6e 63 68 3a 73 65 74 75 70 20 66 6f 72 63 aunch:setup forc
8c20: 65 3a 20 23 74 29 0a 09 09 28 6c 61 75 6e 63 68 e: #t)...(launch
8c30: 3a 63 61 63 68 65 2d 63 6f 6e 66 69 67 29 29 29 :cache-config)))
8c40: 20 3b 3b 20 77 65 20 63 61 6e 20 73 61 66 65 6c ;; we can safel
8c50: 79 20 63 61 63 68 65 20 6d 65 67 61 74 65 73 74 y cache megatest
8c60: 2e 63 6f 6e 66 69 67 20 73 69 6e 63 65 20 77 65 .config since we
8c70: 20 68 61 76 65 20 61 20 76 61 6c 69 64 20 72 75 have a valid ru
8c80: 6e 63 6f 6e 66 69 67 0a 09 20 20 64 61 74 61 29 nconfig.. data)
8c90: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
8ca0: 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 72 75 et-arg "-show-ru
8cb0: 6e 63 6f 6e 66 69 67 22 29 0a 20 20 20 20 28 6c nconfig"). (l
8cc0: 65 74 20 28 28 74 6c 20 28 6c 61 75 6e 63 68 3a et ((tl (launch:
8cd0: 73 65 74 75 70 29 29 29 0a 20 20 20 20 20 20 28 setup))). (
8ce0: 70 75 73 68 2d 64 69 72 65 63 74 6f 72 79 20 2a push-directory *
8cf0: 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 20 20 20 toppath*).
8d00: 28 6c 65 74 20 28 28 64 61 74 61 20 28 66 75 6c (let ((data (ful
8d10: 6c 2d 72 75 6e 63 6f 6e 66 69 67 73 2d 72 65 61 l-runconfigs-rea
8d20: 64 29 29 29 0a 09 3b 3b 20 6b 65 65 70 20 74 68 d)))..;; keep th
8d30: 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 09 28 63 is one local..(c
8d40: 6f 6e 64 0a 09 20 28 28 61 6e 64 20 28 61 72 67 ond.. ((and (arg
8d50: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 63 74 s:get-arg "-sect
8d60: 69 6f 6e 22 29 0a 09 20 20 20 20 20 20 20 28 61 ion").. (a
8d70: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 rgs:get-arg "-va
8d80: 72 22 29 29 0a 09 20 20 28 6c 65 74 20 28 28 76 r")).. (let ((v
8d90: 61 6c 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a al (or (configf:
8da0: 6c 6f 6f 6b 75 70 20 64 61 74 61 20 28 61 72 67 lookup data (arg
8db0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 63 74 s:get-arg "-sect
8dc0: 69 6f 6e 22 29 28 61 72 67 73 3a 67 65 74 2d 61 ion")(args:get-a
8dd0: 72 67 20 22 2d 76 61 72 22 29 29 0a 09 09 09 20 rg "-var"))....
8de0: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
8df0: 64 61 74 61 20 22 64 65 66 61 75 6c 74 22 20 28 data "default" (
8e00: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 args:get-arg "-v
8e10: 61 72 22 29 29 29 29 29 0a 09 20 20 20 20 28 69 ar"))))).. (i
8e20: 66 20 76 61 6c 20 28 70 72 69 6e 74 20 76 61 6c f val (print val
8e30: 29 29 29 29 0a 09 20 28 28 6f 72 20 28 6e 6f 74 )))).. ((or (not
8e40: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8e50: 2d 64 75 6d 70 6d 6f 64 65 22 29 29 0a 20 20 20 -dumpmode")).
8e60: 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 69 (stri
8e70: 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 ng=? (args:get-a
8e80: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 rg "-dumpmode")
8e90: 22 69 6e 69 22 29 29 0a 09 20 20 28 63 6f 6e 66 "ini")).. (conf
8ea0: 69 67 66 3a 63 6f 6e 66 69 67 2d 3e 69 6e 69 20 igf:config->ini
8eb0: 64 61 74 61 29 29 0a 09 20 28 28 73 74 72 69 6e data)).. ((strin
8ec0: 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 g=? (args:get-ar
8ed0: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
8ee0: 73 65 78 70 22 29 0a 09 20 20 28 70 70 20 28 68 sexp").. (pp (h
8ef0: 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 ash-table->alist
8f00: 20 64 61 74 61 29 29 29 0a 09 20 28 28 73 74 72 data))).. ((str
8f10: 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d ing=? (args:get-
8f20: 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 arg "-dumpmode")
8f30: 20 22 6a 73 6f 6e 22 29 0a 09 20 20 28 6a 73 6f "json").. (jso
8f40: 6e 2d 77 72 69 74 65 20 64 61 74 61 29 29 0a 09 n-write data))..
8f50: 20 28 65 6c 73 65 0a 09 20 20 28 64 65 62 75 67 (else.. (debug
8f60: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
8f70: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
8f80: 2a 20 22 2d 64 75 6d 70 6d 6f 64 65 20 6f 66 20 * "-dumpmode of
8f90: 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 " (args:get-arg
8fa0: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e "-dumpmode") " n
8fb0: 6f 74 20 72 65 63 6f 67 6e 69 73 65 64 22 29 29 ot recognised"))
8fc0: 29 0a 09 28 73 65 74 21 20 2a 64 69 64 73 6f 6d )..(set! *didsom
8fd0: 65 74 68 69 6e 67 2a 20 23 74 29 29 0a 20 20 20 ething* #t)).
8fe0: 20 20 20 28 70 6f 70 2d 64 69 72 65 63 74 6f 72 (pop-director
8ff0: 79 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a y)))..(if (args:
9000: 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 get-arg "-show-c
9010: 6f 6e 66 69 67 22 29 0a 20 20 20 20 28 6c 65 74 onfig"). (let
9020: 20 28 28 74 6c 20 20 20 28 6c 61 75 6e 63 68 3a ((tl (launch:
9030: 73 65 74 75 70 29 29 0a 09 20 20 28 64 61 74 61 setup)).. (data
9040: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 29 20 3b *configdat*)) ;
9050: 3b 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 22 ; (read-config "
9060: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 megatest.config"
9070: 20 23 66 20 23 74 29 29 29 0a 20 20 20 20 20 20 #f #t))).
9080: 28 70 75 73 68 2d 64 69 72 65 63 74 6f 72 79 20 (push-directory
9090: 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 20 20 *toppath*).
90a0: 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e ;; keep this on
90b0: 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 63 e local. (c
90c0: 6f 6e 64 20 0a 20 20 20 20 20 20 20 28 28 61 6e ond . ((an
90d0: 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
90e0: 22 2d 73 65 63 74 69 6f 6e 22 29 0a 09 20 20 20 "-section")..
90f0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
9100: 22 2d 76 61 72 22 29 29 0a 09 28 6c 65 74 20 28 "-var"))..(let (
9110: 28 76 61 6c 20 28 63 6f 6e 66 69 67 66 3a 6c 6f (val (configf:lo
9120: 6f 6b 75 70 20 64 61 74 61 20 28 61 72 67 73 3a okup data (args:
9130: 67 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f get-arg "-sectio
9140: 6e 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 n")(args:get-arg
9150: 20 22 2d 76 61 72 22 29 29 29 29 0a 09 20 20 28 "-var")))).. (
9160: 69 66 20 76 61 6c 20 28 70 72 69 6e 74 20 76 61 if val (print va
9170: 6c 29 29 29 29 0a 0a 20 20 20 20 20 20 20 3b 3b l)))).. ;;
9180: 20 70 72 69 6e 74 20 6a 75 73 74 20 61 20 73 65 print just a se
9190: 63 74 69 6f 6e 20 69 66 20 6f 6e 6c 79 20 2d 73 ction if only -s
91a0: 65 63 74 69 6f 6e 0a 0a 20 20 20 20 20 20 20 28 ection.. (
91b0: 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 (not (args:get-a
91c0: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 29 rg "-dumpmode"))
91d0: 0a 09 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c ..(pp (hash-tabl
91e0: 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 29 29 29 e->alist data)))
91f0: 0a 20 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 . ((string
9200: 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 =? (args:get-arg
9210: 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a "-dumpmode") "j
9220: 73 6f 6e 22 29 0a 09 28 6a 73 6f 6e 2d 77 72 69 son")..(json-wri
9230: 74 65 20 64 61 74 61 29 29 0a 20 20 20 20 20 20 te data)).
9240: 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 ((string=? (arg
9250: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
9260: 6d 6f 64 65 22 29 20 22 69 6e 69 22 29 0a 09 28 mode") "ini")..(
9270: 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 69 67 2d 3e configf:config->
9280: 69 6e 69 20 64 61 74 61 29 29 0a 20 20 20 20 20 ini data)).
9290: 20 20 28 65 6c 73 65 0a 09 28 64 65 62 75 67 3a (else..(debug:
92a0: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
92b0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
92c0: 20 22 2d 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 "-dumpmode of "
92d0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
92e0: 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f -dumpmode") " no
92f0: 74 20 72 65 63 6f 67 6e 69 73 65 64 22 29 29 29 t recognised")))
9300: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
9310: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a dsomething* #t).
9320: 20 20 20 20 20 20 28 70 6f 70 2d 64 69 72 65 63 (pop-direc
9330: 74 6f 72 79 29 0a 20 20 20 20 20 20 28 73 65 74 tory). (set
9340: 21 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a ! *time-to-exit*
9350: 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
9360: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 s:get-arg "-show
9370: 2d 63 6d 64 69 6e 66 6f 22 29 0a 20 20 20 20 28 -cmdinfo"). (
9380: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
9390: 2d 61 72 67 20 22 3a 76 61 6c 75 65 22 29 28 67 -arg ":value")(g
93a0: 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
93b0: 4f 22 29 29 0a 09 28 6c 65 74 20 28 28 64 61 74 O"))..(let ((dat
93c0: 61 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 a (common:read-e
93d0: 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 6f ncoded-string (o
93e0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
93f0: 22 3a 76 61 6c 75 65 22 29 28 67 65 74 65 6e 76 ":value")(getenv
9400: 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 "MT_CMDINFO")))
9410: 29 29 0a 09 20 20 28 69 66 20 28 65 71 75 61 6c )).. (if (equal
9420: 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ? (args:get-arg
9430: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 "-dumpmode") "js
9440: 6f 6e 22 29 0a 09 20 20 20 20 20 20 28 6a 73 6f on").. (jso
9450: 6e 2d 77 72 69 74 65 20 64 61 74 61 29 0a 09 20 n-write data)..
9460: 20 20 20 20 20 28 70 70 20 64 61 74 61 29 29 0a (pp data)).
9470: 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d . (set! *didsom
9480: 65 74 68 69 6e 67 2a 20 23 74 29 29 0a 09 28 64 ething* #t))..(d
9490: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
94a0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
94b0: 6f 72 74 2a 20 22 65 6e 76 69 72 6f 6e 6d 65 6e ort* "environmen
94c0: 74 20 76 61 72 69 61 62 6c 65 20 4d 54 5f 43 4d t variable MT_CM
94d0: 44 49 4e 46 4f 20 69 73 20 6e 6f 74 20 73 65 74 DINFO is not set
94e0: 22 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ")))..;;========
94f0: 3d 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 0a 3b ==============.;
9530: 3b 20 52 65 6d 6f 76 65 20 6f 6c 64 20 72 75 6e ; Remove old run
9540: 28 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d (s).;;==========
9550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
9590: 20 73 69 6e 63 65 20 73 65 76 65 72 61 6c 20 61 since several a
95a0: 63 74 69 6f 6e 73 20 63 61 6e 20 62 65 20 73 70 ctions can be sp
95b0: 65 63 69 66 69 65 64 20 6f 6e 20 74 68 65 20 63 ecified on the c
95c0: 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 74 68 65 20 ommand line the
95d0: 72 65 6d 6f 76 61 6c 0a 3b 3b 20 69 73 20 64 6f removal.;; is do
95e0: 6e 65 20 66 69 72 73 74 0a 28 64 65 66 69 6e 65 ne first.(define
95f0: 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 61 63 74 (operate-on act
9600: 69 6f 6e 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 ion). (let* ((r
9610: 75 6e 72 65 63 20 28 72 75 6e 73 3a 72 75 6e 72 unrec (runs:runr
9620: 65 63 2d 6d 61 6b 65 2d 72 65 63 6f 72 64 29 29 ec-make-record))
9630: 0a 09 20 28 74 61 72 67 65 74 20 28 63 6f 6d 6d .. (target (comm
9640: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 on:args-get-targ
9650: 65 74 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a et))). (cond.
9660: 20 20 20 20 20 28 28 6e 6f 74 20 74 61 72 67 65 ((not targe
9670: 74 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a t). (debug:
9680: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
9690: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
96a0: 20 22 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 "Missing requir
96b0: 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 ed parameter for
96c0: 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 " action ", you
96d0: 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 2d 74 must specify -t
96e0: 61 72 67 65 74 20 6f 72 20 2d 72 65 71 74 61 72 arget or -reqtar
96f0: 67 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 g"). (exit
9700: 31 29 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 1)). ((not (
9710: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
9720: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 0a 09 20 20 ":runname")..
9730: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
9740: 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 29 29 rg "-runname")))
9750: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
9760: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
9770: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
9780: 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 Missing required
9790: 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 parameter for "
97a0: 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d action ", you m
97b0: 75 73 74 20 73 70 65 63 69 66 79 20 74 68 65 20 ust specify the
97c0: 72 75 6e 20 6e 61 6d 65 20 70 61 74 74 65 72 6e run name pattern
97d0: 20 77 69 74 68 20 2d 72 75 6e 6e 61 6d 65 20 70 with -runname p
97e0: 61 74 74 22 29 0a 20 20 20 20 20 20 28 65 78 69 att"). (exi
97f0: 74 20 32 29 29 0a 20 20 20 20 20 28 28 6e 6f 74 t 2)). ((not
9800: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9810: 2d 74 65 73 74 70 61 74 74 22 29 29 0a 20 20 20 -testpatt")).
9820: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
9830: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
9840: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 -log-port* "Miss
9850: 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 ing required par
9860: 61 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 ameter for " act
9870: 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 ion ", you must
9880: 73 70 65 63 69 66 79 20 74 68 65 20 74 65 73 74 specify the test
9890: 20 70 61 74 74 65 72 6e 20 77 69 74 68 20 2d 74 pattern with -t
98a0: 65 73 74 70 61 74 74 22 29 0a 20 20 20 20 20 20 estpatt").
98b0: 28 65 78 69 74 20 33 29 29 0a 20 20 20 20 20 28 (exit 3)). (
98c0: 65 6c 73 65 0a 20 20 20 20 20 20 28 69 66 20 28 else. (if (
98d0: 6e 6f 74 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 not (car *config
98e0: 69 6e 66 6f 2a 29 29 0a 09 20 20 28 62 65 67 69 info*)).. (begi
98f0: 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 n.. (debug:pr
9900: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
9910: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
9920: 41 74 74 65 6d 70 74 65 64 20 22 20 61 63 74 69 Attempted " acti
9930: 6f 6e 20 22 6f 6e 20 74 65 73 74 28 73 29 20 62 on "on test(s) b
9940: 75 74 20 72 75 6e 20 61 72 65 61 20 63 6f 6e 66 ut run area conf
9950: 69 67 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e ig file not foun
9960: 64 22 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 d").. (exit 1
9970: 29 29 0a 09 20 20 3b 3b 20 70 75 74 20 74 65 73 )).. ;; put tes
9980: 74 20 70 61 72 61 6d 65 74 65 72 73 20 69 6e 74 t parameters int
9990: 6f 20 63 6f 6e 76 65 6e 69 65 6e 74 20 76 61 72 o convenient var
99a0: 69 61 62 6c 65 73 0a 09 20 20 28 62 65 67 69 6e iables.. (begin
99b0: 0a 09 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 66 .. ;; check f
99c0: 6f 72 20 63 6f 72 72 65 63 74 20 76 65 72 73 69 or correct versi
99d0: 6f 6e 2c 20 65 78 69 74 20 77 69 74 68 20 6d 65 on, exit with me
99e0: 73 73 61 67 65 20 69 66 20 6e 6f 74 20 63 6f 72 ssage if not cor
99f0: 72 65 63 74 0a 09 20 20 20 20 28 63 6f 6d 6d 6f rect.. (commo
9a00: 6e 3a 65 78 69 74 2d 6f 6e 2d 76 65 72 73 69 6f n:exit-on-versio
9a10: 6e 2d 63 68 61 6e 67 65 64 29 0a 09 20 20 20 20 n-changed)..
9a20: 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e (runs:operate-on
9a30: 20 20 61 63 74 69 6f 6e 0a 09 09 09 20 20 20 20 action....
9a40: 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 target....
9a50: 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 (common:args-g
9a60: 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 et-runname) ;;
9a70: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
9a80: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 g "-runname")(ar
9a90: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
9aa0: 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 name"))....
9ab0: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
9ac0: 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 20 3b t-testpatt #f) ;
9ad0: 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ; (args:get-arg
9ae0: 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 "-testpatt")....
9af0: 20 20 20 20 20 20 73 74 61 74 65 3a 20 28 63 6f state: (co
9b00: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 73 74 mmon:args-get-st
9b10: 61 74 65 29 0a 09 09 09 20 20 20 20 20 20 73 74 ate).... st
9b20: 61 74 75 73 3a 20 28 63 6f 6d 6d 6f 6e 3a 61 72 atus: (common:ar
9b30: 67 73 2d 67 65 74 2d 73 74 61 74 75 73 29 0a 09 gs-get-status)..
9b40: 09 09 20 20 20 20 20 20 6e 65 77 2d 73 74 61 74 .. new-stat
9b50: 65 2d 73 74 61 74 75 73 3a 20 28 61 72 67 73 3a e-status: (args:
9b60: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 74 get-arg "-set-st
9b70: 61 74 65 2d 73 74 61 74 75 73 22 29 29 29 29 0a ate-status")))).
9b80: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
9b90: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
9ba0: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
9bb0: 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d 72 t-arg "-remove-r
9bc0: 75 6e 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 uns"). (gener
9bd0: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 al-run-call .
9be0: 20 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 "-remove-runs"
9bf0: 0a 20 20 20 20 20 22 72 65 6d 6f 76 65 20 72 75 . "remove ru
9c00: 6e 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ns". (lambda
9c10: 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 (target runname
9c20: 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 keys keyvals).
9c30: 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d 6f (operate-o
9c40: 6e 20 27 72 65 6d 6f 76 65 2d 72 75 6e 73 29 29 n 'remove-runs))
9c50: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
9c60: 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 74 61 74 t-arg "-set-stat
9c70: 65 2d 73 74 61 74 75 73 22 29 0a 20 20 20 20 28 e-status"). (
9c80: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
9c90: 20 0a 20 20 20 20 20 22 2d 73 65 74 2d 73 74 61 . "-set-sta
9ca0: 74 65 2d 73 74 61 74 75 73 22 0a 20 20 20 20 20 te-status".
9cb0: 22 73 65 74 20 73 74 61 74 65 20 61 6e 64 20 73 "set state and s
9cc0: 74 61 74 75 73 22 0a 20 20 20 20 20 28 6c 61 6d tatus". (lam
9cd0: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
9ce0: 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 ame keys keyvals
9cf0: 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 ). (operat
9d00: 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d e-on 'set-state-
9d10: 73 74 61 74 75 73 29 29 29 29 0a 0a 28 69 66 20 status))))..(if
9d20: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
9d30: 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 g "-set-run-stat
9d40: 75 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d us")..(args:get-
9d50: 61 72 67 20 22 2d 67 65 74 2d 72 75 6e 2d 73 74 arg "-get-run-st
9d60: 61 74 75 73 22 29 29 0a 20 20 20 20 28 67 65 6e atus")). (gen
9d70: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 eral-run-call.
9d80: 20 20 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 "-set-run-sta
9d90: 74 75 73 22 0a 20 20 20 20 20 22 73 65 74 20 72 tus". "set r
9da0: 75 6e 20 73 74 61 74 75 73 22 0a 20 20 20 20 20 un status".
9db0: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
9dc0: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
9dd0: 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6c 65 vals). (le
9de0: 74 2a 20 28 28 72 75 6e 73 64 61 74 20 20 28 72 t* ((runsdat (r
9df0: 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 mt:get-runs-by-p
9e00: 61 74 74 20 6b 65 79 73 20 72 75 6e 6e 61 6d 65 att keys runname
9e10: 20 0a 09 09 09 09 09 28 63 6f 6d 6d 6f 6e 3a 61 ......(common:a
9e20: 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 0a rgs-get-target).
9e30: 09 09 09 09 09 23 66 20 23 66 20 23 66 20 23 66 .....#f #f #f #f
9e40: 29 29 0a 09 20 20 20 20 20 20 28 68 65 61 64 65 )).. (heade
9e50: 72 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 r (vector-ref
9e60: 72 75 6e 73 64 61 74 20 30 29 29 0a 09 20 20 20 runsdat 0))..
9e70: 20 20 20 28 72 6f 77 73 20 20 20 20 20 28 76 65 (rows (ve
9e80: 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 ctor-ref runsdat
9e90: 20 31 29 29 29 0a 09 20 28 69 66 20 28 6e 75 6c 1))).. (if (nul
9ea0: 6c 3f 20 72 6f 77 73 29 0a 09 20 20 20 20 20 28 l? rows).. (
9eb0: 62 65 67 69 6e 0a 09 20 20 20 20 20 20 20 28 64 begin.. (d
9ec0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
9ed0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
9ee0: 6f 72 74 2a 20 22 4e 6f 20 6d 61 74 63 68 69 6e ort* "No matchin
9ef0: 67 20 72 75 6e 20 66 6f 75 6e 64 2e 22 29 0a 09 g run found.")..
9f00: 20 20 20 20 20 20 20 28 65 78 69 74 20 31 29 29 (exit 1))
9f10: 0a 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 .. (let* ((r
9f20: 6f 77 20 20 20 20 20 20 28 63 61 72 20 28 76 65 ow (car (ve
9f30: 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 ctor-ref runsdat
9f40: 20 31 29 29 29 0a 09 09 20 20 20 20 28 72 75 6e 1)))... (run
9f50: 2d 69 64 20 20 20 28 64 62 3a 67 65 74 2d 76 61 -id (db:get-va
9f60: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 6f lue-by-header ro
9f70: 77 20 68 65 61 64 65 72 20 22 69 64 22 29 29 29 w header "id")))
9f80: 0a 09 20 20 20 20 20 20 20 28 69 66 20 28 61 72 .. (if (ar
9f90: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
9fa0: 2d 72 75 6e 2d 73 74 61 74 75 73 22 29 0a 09 09 -run-status")...
9fb0: 20 20 20 28 72 6d 74 3a 73 65 74 2d 72 75 6e 2d (rmt:set-run-
9fc0: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 28 61 status run-id (a
9fd0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
9fe0: 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 29 20 6d t-run-status") m
9ff0: 73 67 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 sg: (args:get-ar
a000: 67 20 22 2d 6d 22 29 29 0a 09 09 20 20 20 28 70 g "-m"))... (p
a010: 72 69 6e 74 20 28 72 6d 74 3a 67 65 74 2d 72 75 rint (rmt:get-ru
a020: 6e 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 29 n-status run-id)
a030: 29 0a 09 09 20 20 20 29 29 29 29 29 29 29 0a 0a )... )))))))..
a040: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
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 0a 3b 3b 20 51 75 65 72 ========.;; Quer
a090: 79 20 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d y runs.;;=======
a0a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a0b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a0c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a0d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
a0e0: 0a 3b 3b 20 2d 66 69 65 6c 64 73 20 72 75 6e 73 .;; -fields runs
a0f0: 3a 69 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 :id,target,runna
a100: 6d 65 2c 63 6f 6d 6d 65 6e 74 2b 74 65 73 74 73 me,comment+tests
a110: 3a 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 :id,testname,ite
a120: 6d 5f 70 61 74 68 2b 73 74 65 70 73 0a 3b 3b 0a m_path+steps.;;.
a130: 3b 3b 20 63 73 69 3e 20 28 65 78 74 72 61 63 74 ;; csi> (extract
a140: 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 74 72 61 69 -fields-constrai
a150: 6e 74 73 20 22 72 75 6e 73 3a 69 64 2c 74 61 72 nts "runs:id,tar
a160: 67 65 74 2c 72 75 6e 6e 61 6d 65 2c 63 6f 6d 6d get,runname,comm
a170: 65 6e 74 2b 74 65 73 74 73 3a 69 64 2c 74 65 73 ent+tests:id,tes
a180: 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2b tname,item_path+
a190: 73 74 65 70 73 22 29 0a 3b 3b 20 20 20 20 20 20 steps").;;
a1a0: 20 20 20 3d 3e 20 28 28 22 72 75 6e 73 22 20 22 => (("runs" "
a1b0: 69 64 22 20 22 74 61 72 67 65 74 22 20 22 72 75 id" "target" "ru
a1c0: 6e 6e 61 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 nname" "comment"
a1d0: 29 20 28 22 74 65 73 74 73 22 20 22 69 64 22 20 ) ("tests" "id"
a1e0: 22 74 65 73 74 6e 61 6d 65 22 20 22 69 74 65 6d "testname" "item
a1f0: 5f 70 61 74 68 22 29 20 28 22 73 74 65 70 73 22 _path") ("steps"
a200: 29 29 0a 3b 3b 0a 3b 3b 20 20 20 4e 4f 54 45 3a )).;;.;; NOTE:
a210: 20 72 65 6d 65 6d 62 65 72 20 74 68 61 74 20 74 remember that t
a220: 68 65 20 63 64 72 20 77 69 6c 6c 20 62 65 20 74 he cdr will be t
a230: 68 65 20 6c 69 73 74 20 79 6f 75 20 65 78 70 65 he list you expe
a240: 63 74 20 28 63 64 72 20 28 22 72 75 6e 73 22 20 ct (cdr ("runs"
a250: 22 69 64 22 20 22 74 61 72 67 65 74 22 20 22 72 "id" "target" "r
a260: 75 6e 6e 61 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 unname" "comment
a270: 22 29 29 20 3d 3e 20 28 22 69 64 22 20 22 74 61 ")) => ("id" "ta
a280: 72 67 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 20 rget" "runname"
a290: 22 63 6f 6d 6d 65 6e 74 22 29 0a 3b 3b 20 20 20 "comment").;;
a2a0: 20 20 20 20 20 20 61 6e 64 20 73 6f 20 61 6c 69 and so ali
a2b0: 73 74 2d 72 65 66 20 77 69 6c 6c 20 79 69 65 6c st-ref will yiel
a2c0: 64 20 77 68 61 74 20 79 6f 75 20 65 78 70 65 63 d what you expec
a2d0: 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 65 78 t.;;.(define (ex
a2e0: 74 72 61 63 74 2d 66 69 65 6c 64 73 2d 63 6f 6e tract-fields-con
a2f0: 73 74 72 61 69 6e 74 73 20 66 69 65 6c 64 73 2d straints fields-
a300: 73 70 65 63 29 0a 20 20 28 6d 61 70 20 28 6c 61 spec). (map (la
a310: 6d 62 64 61 20 28 74 61 62 6c 65 2d 73 70 65 63 mbda (table-spec
a320: 29 20 3b 3b 20 72 75 6e 73 3a 69 64 2c 74 61 72 ) ;; runs:id,tar
a330: 67 65 74 2c 72 75 6e 6e 61 6d 65 0a 09 20 28 6c get,runname.. (l
a340: 65 74 20 28 28 64 61 74 20 28 73 74 72 69 6e 67 et ((dat (string
a350: 2d 73 70 6c 69 74 20 74 61 62 6c 65 2d 73 70 65 -split table-spe
a360: 63 20 22 3a 22 29 29 29 20 3b 3b 20 28 22 72 75 c ":"))) ;; ("ru
a370: 6e 73 22 20 22 69 64 2c 74 61 72 67 65 74 2c 72 ns" "id,target,r
a380: 75 6e 6e 61 6d 65 22 29 0a 09 20 20 20 28 69 66 unname").. (if
a390: 20 28 3e 20 28 6c 65 6e 67 74 68 20 64 61 74 29 (> (length dat)
a3a0: 20 31 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 1).. (con
a3b0: 73 20 28 63 61 72 20 64 61 74 29 28 73 74 72 69 s (car dat)(stri
a3c0: 6e 67 2d 73 70 6c 69 74 20 28 63 61 64 72 20 64 ng-split (cadr d
a3d0: 61 74 29 20 22 2c 22 29 29 20 3b 3b 20 22 69 64 at) ",")) ;; "id
a3e0: 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 22 ,target,runname"
a3f0: 0a 09 20 20 20 20 20 20 20 64 61 74 29 29 29 0a .. dat))).
a400: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 (string-s
a410: 70 6c 69 74 20 66 69 65 6c 64 73 2d 73 70 65 63 plit fields-spec
a420: 20 22 2b 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 "+")))..(define
a430: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
a440: 69 65 6c 64 6e 61 6d 65 20 64 61 74 61 76 65 63 ieldname datavec
a450: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
a460: 78 20 66 69 65 6c 64 6e 61 6d 65 29 0a 20 20 28 x fieldname). (
a470: 6c 65 74 20 28 28 69 6e 64 78 20 28 68 61 73 68 let ((indx (hash
a480: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
a490: 6c 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e lt test-field-in
a4a0: 64 65 78 20 66 69 65 6c 64 6e 61 6d 65 20 23 66 dex fieldname #f
a4b0: 29 29 29 0a 20 20 20 20 28 69 66 20 69 6e 64 78 ))). (if indx
a4c0: 0a 09 28 69 66 20 28 3e 3d 20 69 6e 64 78 20 28 ..(if (>= indx (
a4d0: 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 64 61 vector-length da
a4e0: 74 61 76 65 63 29 29 0a 09 20 20 20 20 23 66 20 tavec)).. #f
a4f0: 3b 3b 20 69 6e 64 65 78 20 74 6f 6f 20 68 69 67 ;; index too hig
a500: 68 2c 20 73 68 6f 75 6c 64 20 72 61 69 73 65 20 h, should raise
a510: 61 6e 20 65 72 72 6f 72 20 49 20 73 75 70 70 6f an error I suppo
a520: 73 65 0a 09 20 20 20 20 28 76 65 63 74 6f 72 2d se.. (vector-
a530: 72 65 66 20 64 61 74 61 76 65 63 20 69 6e 64 78 ref datavec indx
a540: 29 29 0a 09 23 66 29 29 29 0a 0a 3b 3b 20 4e 4f ))..#f)))..;; NO
a550: 54 45 3a 20 6c 69 73 74 2d 72 75 6e 73 20 61 6e TE: list-runs an
a560: 64 20 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 d list-db-target
a570: 73 20 6f 70 65 72 61 74 65 20 6f 6e 20 6c 6f 63 s operate on loc
a580: 61 6c 20 64 62 21 21 21 0a 3b 3b 0a 3b 3b 20 49 al db!!!.;;.;; I
a590: 44 45 41 3a 20 6d 65 67 61 74 65 73 74 20 6c 69 DEA: megatest li
a5a0: 73 74 20 2d 72 75 6e 6e 61 6d 65 20 62 6c 61 68 st -runname blah
a5b0: 25 20 2e 2e 2e 0a 3b 3b 0a 28 69 66 20 28 6f 72 % ....;;.(if (or
a5c0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
a5d0: 2d 6c 69 73 74 2d 72 75 6e 73 22 29 0a 09 28 61 -list-runs")..(a
a5e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
a5f0: 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 29 29 st-db-targets"))
a600: 0a 20 20 20 20 28 69 66 20 28 6c 61 75 6e 63 68 . (if (launch
a610: 3a 73 65 74 75 70 29 0a 09 28 6c 65 74 2a 20 28 :setup)..(let* (
a620: 3b 3b 20 28 64 62 73 74 72 75 63 74 20 20 20 20 ;; (dbstruct
a630: 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 (make-dbr:dbstru
a640: 63 74 20 70 61 74 68 3a 20 2a 74 6f 70 70 61 74 ct path: *toppat
a650: 68 2a 20 6c 6f 63 61 6c 3a 20 28 61 72 67 73 3a h* local: (args:
a660: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 61 6c 22 get-arg "-local"
a670: 29 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e ))).. (run
a680: 70 61 74 74 20 20 20 20 20 28 61 72 67 73 3a 67 patt (args:g
a690: 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 et-arg "-list-ru
a6a0: 6e 73 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 ns")).
a6b0: 20 20 20 20 20 28 61 63 63 65 73 73 2d 6d 6f 64 (access-mod
a6c0: 65 20 28 64 62 3a 67 65 74 2d 61 63 63 65 73 73 e (db:get-access
a6d0: 2d 6d 6f 64 65 29 29 0a 09 20 20 20 20 20 20 20 -mode))..
a6e0: 28 74 65 73 74 70 61 74 74 20 20 20 20 28 63 6f (testpatt (co
a6f0: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 mmon:args-get-te
a700: 73 74 70 61 74 74 20 23 66 29 29 0a 09 20 20 20 stpatt #f))..
a710: 20 20 20 20 3b 3b 20 28 69 66 20 28 61 72 67 73 ;; (if (args
a720: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 :get-arg "-testp
a730: 61 74 74 22 29 20 0a 09 20 20 20 20 20 20 20 3b att") .. ;
a740: 3b 20 20 09 20 20 20 20 20 20 20 20 28 61 72 67 ; . (arg
a750: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
a760: 70 61 74 74 22 29 20 0a 09 20 20 20 20 20 20 20 patt") ..
a770: 3b 3b 20 20 09 20 20 20 20 20 20 20 20 22 25 22 ;; . "%"
a780: 29 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 73 )).. (keys
a790: 20 20 20 20 20 20 20 20 28 72 6d 74 3a 67 65 74 (rmt:get
a7a0: 2d 6b 65 79 73 29 29 20 3b 3b 20 28 64 62 3a 67 -keys)) ;; (db:g
a7b0: 65 74 2d 6b 65 79 73 20 64 62 73 74 72 75 63 74 et-keys dbstruct
a7c0: 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 72 )).. ;; (r
a7d0: 75 6e 73 64 61 74 20 20 28 64 62 3a 67 65 74 2d unsdat (db:get-
a7e0: 72 75 6e 73 20 64 62 73 74 72 75 63 74 20 72 75 runs dbstruct ru
a7f0: 6e 70 61 74 74 20 23 66 20 23 66 20 27 28 29 29 npatt #f #f '())
a800: 29 0a 09 3b 3b 20 28 72 75 6e 73 64 61 74 20 20 )..;; (runsdat
a810: 20 20 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 (rmt:get-runs
a820: 2d 62 79 2d 70 61 74 74 20 6b 65 79 73 20 28 6f -by-patt keys (o
a830: 72 20 72 75 6e 70 61 74 74 20 22 25 22 29 20 28 r runpatt "%") (
a840: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
a850: 74 61 72 67 65 74 29 20 3b 3b 20 28 64 62 3a 67 target) ;; (db:g
a860: 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 et-runs-by-patt
a870: 64 62 73 74 72 75 63 74 20 6b 65 79 73 20 28 6f dbstruct keys (o
a880: 72 20 72 75 6e 70 61 74 74 20 22 25 22 29 20 28 r runpatt "%") (
a890: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
a8a0: 74 61 72 67 65 74 29 0a 09 3b 3b 20 09 09 20 20 target)..;; ..
a8b0: 20 20 20 20 20 20 20 20 20 09 20 23 66 20 23 66 . #f #f
a8c0: 20 27 28 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 '("id" "runname
a8d0: 22 20 22 73 74 61 74 65 22 20 22 73 74 61 74 75 " "state" "statu
a8e0: 73 22 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e s" "owner" "even
a8f0: 74 5f 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 t_time" "comment
a900: 22 29 20 30 29 29 0a 09 20 20 20 20 20 20 20 28 ") 0)).. (
a910: 72 75 6e 73 64 61 74 20 20 20 20 20 28 72 6d 74 runsdat (rmt
a920: 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 :get-runs-by-pat
a930: 74 20 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 61 t keys (or runpa
a940: 74 74 20 22 25 22 29 20 0a 20 20 20 20 20 20 20 tt "%") .
a950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a970: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d (comm
a980: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 on:args-get-targ
a990: 65 74 29 20 23 66 20 23 66 20 27 28 22 69 64 22 et) #f #f '("id"
a9a0: 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 "runname" "stat
a9b0: 65 22 20 22 73 74 61 74 75 73 22 20 22 6f 77 6e e" "status" "own
a9c0: 65 72 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 er" "event_time"
a9d0: 20 22 63 6f 6d 6d 65 6e 74 22 29 20 30 29 29 0a "comment") 0)).
a9e0: 09 20 20 20 20 20 20 20 28 72 75 6e 73 74 6d 70 . (runstmp
a9f0: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 (db:get-row
aa00: 73 20 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 s runsdat))..
aa10: 20 20 20 20 28 68 65 61 64 65 72 20 20 20 20 20 (header
aa20: 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 (db:get-header
aa30: 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 runsdat))..
aa40: 20 20 3b 3b 20 74 68 69 73 20 69 73 20 22 2d 73 ;; this is "-s
aa50: 69 6e 63 65 22 20 73 75 70 70 6f 72 74 2e 20 54 ince" support. T
aa60: 68 69 73 20 6c 6f 6f 6b 73 20 61 74 20 6c 61 73 his looks at las
aa70: 74 20 6d 6f 64 20 74 69 6d 65 73 20 6f 66 20 3c t mod times of <
aa80: 72 75 6e 2d 69 64 3e 2e 64 62 20 66 69 6c 65 73 run-id>.db files
aa90: 0a 09 20 20 20 20 20 20 20 3b 3b 20 61 6e 64 20 .. ;; and
aaa0: 63 6f 6c 6c 65 63 74 73 20 74 68 6f 73 65 20 6d collects those m
aab0: 6f 64 69 66 69 65 64 20 73 69 6e 63 65 20 74 68 odified since th
aac0: 65 20 2d 73 69 6e 63 65 20 74 69 6d 65 2e 0a 09 e -since time...
aad0: 20 20 20 20 20 20 20 28 72 75 6e 73 20 20 20 20 (runs
aae0: 20 20 20 20 72 75 6e 73 74 6d 70 29 0a 20 20 20 runstmp).
aaf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ab00: 20 20 20 20 20 3b 3b 20 28 69 66 20 28 61 6e 64 ;; (if (and
ab10: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 75 6e (not (null? run
ab20: 73 74 6d 70 29 29 0a 09 09 09 3b 3b 20 20 20 20 stmp))....;;
ab30: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
ab40: 67 20 22 2d 73 69 6e 63 65 22 29 29 0a 09 09 09 g "-since"))....
ab50: 3b 3b 20 20 20 28 6c 65 74 20 28 28 63 68 61 6e ;; (let ((chan
ab60: 67 65 64 2d 69 64 73 20 28 64 62 3a 67 65 74 2d ged-ids (db:get-
ab70: 63 68 61 6e 67 65 64 2d 72 75 6e 2d 69 64 73 20 changed-run-ids
ab80: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
ab90: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
aba0: 73 69 6e 63 65 22 29 29 29 29 29 0a 09 09 09 3b since")))))....;
abb0: 3b 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 ; (let loop
abc0: 28 28 68 65 64 20 28 63 61 72 20 72 75 6e 73 74 ((hed (car runst
abd0: 6d 70 29 29 0a 09 09 09 3b 3b 20 20 20 09 20 20 mp))....;; .
abe0: 20 20 20 28 74 61 6c 20 28 63 64 72 20 72 75 6e (tal (cdr run
abf0: 73 74 6d 70 29 29 0a 09 09 09 3b 3b 20 20 20 09 stmp))....;; .
ac00: 20 20 20 20 20 28 72 65 73 20 27 28 29 29 29 0a (res '())).
ac10: 09 09 09 3b 3b 20 20 20 20 20 20 20 28 6c 65 74 ...;; (let
ac20: 20 28 28 6e 65 77 2d 72 65 73 20 28 69 66 20 28 ((new-res (if (
ac30: 6d 65 6d 62 65 72 20 28 64 62 3a 67 65 74 2d 76 member (db:get-v
ac40: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 68 alue-by-header h
ac50: 65 64 20 68 65 61 64 65 72 20 22 69 64 22 29 20 ed header "id")
ac60: 63 68 61 6e 67 65 64 2d 69 64 73 29 0a 09 09 09 changed-ids)....
ac70: 3b 3b 20 20 20 09 09 20 20 20 20 20 20 20 28 63 ;; .. (c
ac80: 6f 6e 73 20 68 65 64 20 72 65 73 29 0a 09 09 09 ons hed res)....
ac90: 3b 3b 20 20 20 09 09 20 20 20 20 20 20 20 72 65 ;; .. re
aca0: 73 29 29 29 0a 09 09 09 3b 3b 20 20 20 20 20 20 s)))....;;
acb0: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 (if (null? ta
acc0: 6c 29 0a 09 09 09 3b 3b 20 20 20 09 20 20 28 72 l)....;; . (r
acd0: 65 76 65 72 73 65 20 6e 65 77 2d 72 65 73 29 0a everse new-res).
ace0: 09 09 09 3b 3b 20 20 20 09 20 20 28 6c 6f 6f 70 ...;; . (loop
acf0: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
ad00: 61 6c 29 20 6e 65 77 2d 72 65 73 29 29 29 29 29 al) new-res)))))
ad10: 0a 09 09 09 3b 3b 20 20 20 72 75 6e 73 74 6d 70 ....;; runstmp
ad20: 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d 74 )).. (db-t
ad30: 61 72 67 65 74 73 20 20 28 61 72 67 73 3a 67 65 argets (args:ge
ad40: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d t-arg "-list-db-
ad50: 74 61 72 67 65 74 73 22 29 29 0a 09 20 20 20 20 targets"))..
ad60: 20 20 20 28 73 65 65 6e 20 20 20 20 20 20 20 20 (seen
ad70: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
ad80: 29 29 0a 09 20 20 20 20 20 20 20 28 64 6d 6f 64 )).. (dmod
ad90: 65 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 e (let ((d
ada0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
adb0: 2d 64 75 6d 70 6d 6f 64 65 22 29 29 29 0a 09 09 -dumpmode")))...
adc0: 09 20 20 20 20 20 20 28 69 66 20 64 20 28 73 74 . (if d (st
add0: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 64 29 20 ring->symbol d)
ade0: 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 28 64 #f))).. (d
adf0: 61 74 61 20 20 20 20 20 20 20 20 28 6d 61 6b 65 ata (make
ae00: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 -hash-table))..
ae10: 20 20 20 20 20 20 28 66 69 65 6c 64 73 2d 73 70 (fields-sp
ae20: 65 63 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 ec (if (args:get
ae30: 2d 61 72 67 20 22 2d 66 69 65 6c 64 73 22 29 0a -arg "-fields").
ae40: 09 09 09 09 28 65 78 74 72 61 63 74 2d 66 69 65 ....(extract-fie
ae50: 6c 64 73 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 lds-constraints
ae60: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
ae70: 66 69 65 6c 64 73 22 29 29 0a 09 09 09 09 28 6c fields")).....(l
ae80: 69 73 74 20 28 63 6f 6e 73 20 22 72 75 6e 73 22 ist (cons "runs"
ae90: 20 28 61 70 70 65 6e 64 20 6b 65 79 73 20 28 6c (append keys (l
aea0: 69 73 74 20 22 69 64 22 20 22 72 75 6e 6e 61 6d ist "id" "runnam
aeb0: 65 22 20 22 73 74 61 74 65 22 20 22 73 74 61 74 e" "state" "stat
aec0: 75 73 22 20 22 6f 77 6e 65 72 22 20 22 65 76 65 us" "owner" "eve
aed0: 6e 74 5f 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e nt_time" "commen
aee0: 74 22 20 22 66 61 69 6c 5f 63 6f 75 6e 74 22 20 t" "fail_count"
aef0: 22 70 61 73 73 5f 63 6f 75 6e 74 22 29 29 29 0a "pass_count"))).
af00: 09 09 09 09 20 20 20 20 20 20 28 63 6f 6e 73 20 .... (cons
af10: 22 74 65 73 74 73 22 20 20 64 62 3a 74 65 73 74 "tests" db:test
af20: 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 29 20 -record-fields)
af30: 3b 3b 20 22 69 64 22 20 22 74 65 73 74 6e 61 6d ;; "id" "testnam
af40: 65 22 20 22 74 65 73 74 5f 70 61 74 68 22 29 0a e" "test_path").
af50: 09 09 09 09 20 20 20 20 20 20 28 6c 69 73 74 20 .... (list
af60: 22 73 74 65 70 73 22 20 22 69 64 22 20 22 73 74 "steps" "id" "st
af70: 65 70 6e 61 6d 65 22 29 29 29 29 0a 09 20 20 20 epname"))))..
af80: 20 20 20 20 28 72 75 6e 73 2d 73 70 65 63 20 20 (runs-spec
af90: 20 28 6c 65 74 20 28 28 72 20 28 61 6c 69 73 74 (let ((r (alist
afa0: 2d 72 65 66 20 22 72 75 6e 73 22 20 20 66 69 65 -ref "runs" fie
afb0: 6c 64 73 2d 73 70 65 63 20 65 71 75 61 6c 3f 29 lds-spec equal?)
afc0: 29 29 20 3b 3b 20 74 68 65 20 63 68 65 63 6b 20 )) ;; the check
afd0: 69 73 20 6e 6f 77 20 75 6e 6e 65 63 65 73 73 61 is now unnecessa
afe0: 72 79 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 ry.... (if
aff0: 28 61 6e 64 20 72 20 28 6e 6f 74 20 28 6e 75 6c (and r (not (nul
b000: 6c 3f 20 72 29 29 29 20 72 20 28 6c 69 73 74 20 l? r))) r (list
b010: 22 69 64 22 20 29 29 29 29 0a 09 20 20 20 20 20 "id" ))))..
b020: 20 20 28 74 65 73 74 73 2d 73 70 65 63 20 20 28 (tests-spec (
b030: 6c 65 74 20 28 28 74 20 28 61 6c 69 73 74 2d 72 let ((t (alist-r
b040: 65 66 20 22 74 65 73 74 73 22 20 66 69 65 6c 64 ef "tests" field
b050: 73 2d 73 70 65 63 20 65 71 75 61 6c 3f 29 29 29 s-spec equal?)))
b060: 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 61 .... (if (a
b070: 6e 64 20 74 20 28 6e 75 6c 6c 3f 20 74 29 29 20 nd t (null? t))
b080: 3b 3b 20 61 6c 6c 20 66 69 65 6c 64 73 0a 09 09 ;; all fields...
b090: 09 09 20 20 64 62 3a 74 65 73 74 2d 72 65 63 6f .. db:test-reco
b0a0: 72 64 2d 66 69 65 6c 64 73 0a 09 09 09 09 20 20 rd-fields.....
b0b0: 74 29 29 29 0a 09 20 20 20 20 20 20 20 28 61 64 t))).. (ad
b0c0: 6a 2d 74 65 73 74 73 2d 73 70 65 63 20 28 64 65 j-tests-spec (de
b0d0: 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 lete-duplicates
b0e0: 28 69 66 20 74 65 73 74 73 2d 73 70 65 63 20 28 (if tests-spec (
b0f0: 63 6f 6e 73 20 22 69 64 22 20 74 65 73 74 73 2d cons "id" tests-
b100: 73 70 65 63 29 20 64 62 3a 74 65 73 74 2d 72 65 spec) db:test-re
b110: 63 6f 72 64 2d 66 69 65 6c 64 73 29 29 29 20 3b cord-fields))) ;
b120: 3b 20 27 28 22 69 64 22 29 29 29 29 0a 09 20 20 ; '("id"))))..
b130: 20 20 20 20 20 28 73 74 65 70 73 2d 73 70 65 63 (steps-spec
b140: 20 20 28 61 6c 69 73 74 2d 72 65 66 20 22 73 74 (alist-ref "st
b150: 65 70 73 22 20 66 69 65 6c 64 73 2d 73 70 65 63 eps" fields-spec
b160: 20 65 71 75 61 6c 3f 29 29 0a 09 20 20 20 20 20 equal?))..
b170: 20 20 28 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e (test-field-in
b180: 64 65 78 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 dex (make-hash-t
b190: 61 62 6c 65 29 29 29 0a 09 20 20 28 69 66 20 28 able))).. (if (
b1a0: 61 6e 64 20 74 65 73 74 73 2d 73 70 65 63 20 28 and tests-spec (
b1b0: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 not (null? tests
b1c0: 2d 73 70 65 63 29 29 29 20 3b 3b 20 64 6f 20 73 -spec))) ;; do s
b1d0: 6f 6d 65 20 76 61 6c 69 64 61 74 69 6f 6e 20 61 ome validation a
b1e0: 6e 64 20 70 72 6f 63 65 73 73 69 6e 67 20 6f 66 nd processing of
b1f0: 20 74 68 65 20 74 65 73 74 2d 73 70 65 63 0a 09 the test-spec..
b200: 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 6e 76 (let ((inv
b210: 61 6c 69 64 2d 74 65 73 74 73 2d 73 70 65 63 20 alid-tests-spec
b220: 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 (filter (lambda
b230: 28 78 29 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 (x)(not (member
b240: 78 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 x db:test-record
b250: 2d 66 69 65 6c 64 73 29 29 29 20 74 65 73 74 73 -fields))) tests
b260: 2d 73 70 65 63 29 29 29 0a 09 09 28 69 66 20 28 -spec)))...(if (
b270: 6e 75 6c 6c 3f 20 69 6e 76 61 6c 69 64 2d 74 65 null? invalid-te
b280: 73 74 73 2d 73 70 65 63 29 0a 09 09 20 20 20 20 sts-spec)...
b290: 3b 3b 20 67 65 6e 65 72 61 74 65 20 74 68 65 20 ;; generate the
b2a0: 6c 6f 6f 6b 75 70 20 6d 61 70 20 74 65 73 74 2d lookup map test-
b2b0: 66 69 65 6c 64 2d 6e 61 6d 65 20 3d 3e 20 69 6e field-name => in
b2c0: 64 65 78 2d 6e 75 6d 62 65 72 0a 09 09 20 20 20 dex-number...
b2d0: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 (let loop ((hed
b2e0: 20 28 63 61 72 20 61 64 6a 2d 74 65 73 74 73 2d (car adj-tests-
b2f0: 73 70 65 63 29 29 0a 09 09 09 20 20 20 20 20 20 spec))....
b300: 20 28 74 61 6c 20 28 63 64 72 20 61 64 6a 2d 74 (tal (cdr adj-t
b310: 65 73 74 73 2d 73 70 65 63 29 29 0a 09 09 09 20 ests-spec))....
b320: 20 20 20 20 20 20 28 69 64 78 20 30 29 29 0a 09 (idx 0))..
b330: 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 . (hash-tab
b340: 6c 65 2d 73 65 74 21 20 74 65 73 74 2d 66 69 65 le-set! test-fie
b350: 6c 64 2d 69 6e 64 65 78 20 68 65 64 20 69 64 78 ld-index hed idx
b360: 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 6e )... (if (n
b370: 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 28 ot (null? tal))(
b380: 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 loop (car tal)(c
b390: 64 72 20 74 61 6c 29 28 2b 20 69 64 78 20 31 29 dr tal)(+ idx 1)
b3a0: 29 29 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e )))... (begin
b3b0: 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a ... (debug:
b3c0: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
b3d0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
b3e0: 20 22 49 6e 76 61 6c 69 64 20 74 65 73 74 20 66 "Invalid test f
b3f0: 69 65 6c 64 73 20 73 70 65 63 69 66 69 65 64 3a ields specified:
b400: 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 " (string-inter
b410: 73 70 65 72 73 65 20 69 6e 76 61 6c 69 64 2d 74 sperse invalid-t
b420: 65 73 74 73 2d 73 70 65 63 20 22 2c 20 22 29 29 ests-spec ", "))
b430: 0a 09 09 20 20 20 20 20 20 28 65 78 69 74 29 29 ... (exit))
b440: 29 29 29 0a 09 20 20 3b 3b 20 45 61 63 68 20 72 ))).. ;; Each r
b450: 75 6e 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 20 un.. (for-each
b460: 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 .. (lambda (ru
b470: 6e 29 0a 09 20 20 20 20 20 28 6c 65 74 20 28 28 n).. (let ((
b480: 74 61 72 67 65 74 73 74 72 20 28 73 74 72 69 6e targetstr (strin
b490: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m
b4a0: 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 ap (lambda (x)..
b4b0: 09 09 09 09 09 09 20 28 64 62 3a 67 65 74 2d 76 ...... (db:get-v
b4c0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
b4d0: 75 6e 20 68 65 61 64 65 72 20 78 29 29 0a 09 09 un header x))...
b4e0: 09 09 09 09 20 20 20 20 20 20 20 6b 65 79 73 29 .... keys)
b4f0: 20 22 2f 22 29 29 29 0a 09 20 20 20 20 20 20 20 "/")))..
b500: 28 69 66 20 64 62 2d 74 61 72 67 65 74 73 0a 09 (if db-targets..
b510: 09 20 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 . (if (not (ha
b520: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
b530: 61 75 6c 74 20 73 65 65 6e 20 74 61 72 67 65 74 ault seen target
b540: 73 74 72 20 23 66 29 29 0a 09 09 20 20 20 20 20 str #f))...
b550: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 28 68 61 (begin.... (ha
b560: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 65 sh-table-set! se
b570: 65 6e 20 74 61 72 67 65 74 73 74 72 20 23 74 29 en targetstr #t)
b580: 0a 09 09 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 .... ;; (print "
b590: 5b 22 20 74 61 72 67 65 74 73 74 72 20 22 5d 22 [" targetstr "]"
b5a0: 29 29 29 29 0a 09 09 09 20 28 69 66 20 28 6e 6f )))).... (if (no
b5b0: 74 20 64 6d 6f 64 65 29 0a 09 09 09 20 20 20 20 t dmode)....
b5c0: 20 28 70 72 69 6e 74 20 74 61 72 67 65 74 73 74 (print targetst
b5d0: 72 29 0a 09 09 09 20 20 20 20 20 28 68 61 73 68 r).... (hash
b5e0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 64 61 74 61 -table-set! data
b5f0: 20 22 74 61 72 67 65 74 73 22 20 28 63 6f 6e 73 "targets" (cons
b600: 20 74 61 72 67 65 74 73 74 72 20 28 68 61 73 68 targetstr (hash
b610: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
b620: 6c 74 20 64 61 74 61 20 22 74 61 72 67 65 74 73 lt data "targets
b630: 22 20 27 28 29 29 29 29 0a 09 09 09 20 20 20 20 " '())))....
b640: 20 29 29 29 0a 09 09 20 20 20 28 6c 65 74 2a 20 )))... (let*
b650: 28 28 72 75 6e 2d 69 64 20 20 28 64 62 3a 67 65 ((run-id (db:ge
b660: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
b670: 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 64 r run header "id
b680: 22 29 29 0a 09 09 09 20 20 28 72 75 6e 6e 61 6d ")).... (runnam
b690: 65 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d e (db:get-value-
b6a0: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
b6b0: 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 ader "runname"))
b6c0: 20 0a 09 09 09 20 20 28 73 74 61 74 65 73 20 20 .... (states
b6d0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 6f (string-split (o
b6e0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
b6f0: 22 2d 73 74 61 74 65 22 29 20 22 22 29 20 22 2c "-state") "") ",
b700: 22 29 29 0a 09 09 09 20 20 28 73 74 61 74 75 73 ")).... (status
b710: 65 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 es (string-split
b720: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
b730: 72 67 20 22 2d 73 74 61 74 75 73 22 29 20 22 22 rg "-status") ""
b740: 29 20 22 2c 22 29 29 0a 09 09 09 20 20 28 74 65 ) ",")).... (te
b750: 73 74 73 20 20 20 28 69 66 20 74 65 73 74 73 2d sts (if tests-
b760: 73 70 65 63 0a 09 09 09 09 20 20 20 20 20 20 20 spec.....
b770: 28 64 62 3a 64 69 73 70 61 74 63 68 2d 71 75 65 (db:dispatch-que
b780: 72 79 20 61 63 63 65 73 73 2d 6d 6f 64 65 20 72 ry access-mode r
b790: 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 mt:get-tests-for
b7a0: 2d 72 75 6e 20 64 62 3a 67 65 74 2d 74 65 73 74 -run db:get-test
b7b0: 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 64 s-for-run run-id
b7c0: 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 testpatt states
b7d0: 20 73 74 61 74 75 73 65 73 20 23 66 20 23 66 20 statuses #f #f
b7e0: 23 66 20 27 74 65 73 74 6e 61 6d 65 20 27 61 73 #f 'testname 'as
b7f0: 63 20 3b 3b 20 28 64 62 3a 67 65 74 2d 74 65 73 c ;; (db:get-tes
b800: 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 73 74 72 ts-for-run dbstr
b810: 75 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 70 uct run-id testp
b820: 61 74 74 20 27 28 29 20 27 28 29 20 23 66 20 23 att '() '() #f #
b830: 66 20 23 66 20 27 74 65 73 74 6e 61 6d 65 20 27 f #f 'testname '
b840: 61 73 63 20 0a 09 09 09 09 09 09 09 20 20 20 20 asc ........
b850: 20 3b 3b 20 75 73 65 20 71 72 79 76 61 6c 73 20 ;; use qryvals
b860: 69 66 20 74 65 73 74 2d 73 70 65 63 20 70 72 6f if test-spec pro
b870: 76 69 64 65 64 0a 09 09 09 09 09 09 09 20 20 20 vided........
b880: 20 20 28 69 66 20 74 65 73 74 73 2d 73 70 65 63 (if tests-spec
b890: 0a 09 09 09 09 09 09 09 09 20 28 73 74 72 69 6e ......... (strin
b8a0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 61 64 g-intersperse ad
b8b0: 6a 2d 74 65 73 74 73 2d 73 70 65 63 20 22 2c 22 j-tests-spec ","
b8c0: 29 0a 09 09 09 09 09 09 09 09 20 3b 3b 20 64 62 )......... ;; db
b8d0: 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 :test-record-fie
b8e0: 6c 64 73 0a 09 09 09 09 09 09 09 09 20 23 66 29 lds......... #f)
b8f0: 0a 09 09 09 09 09 09 09 20 20 20 20 20 23 66 0a ........ #f.
b900: 09 09 09 09 09 09 09 20 20 20 20 20 27 6e 6f 72 ....... 'nor
b910: 6d 61 6c 29 0a 09 09 09 09 20 20 20 20 20 20 20 mal).....
b920: 27 28 29 29 29 29 0a 09 09 20 20 20 20 20 28 63 '())))... (c
b930: 61 73 65 20 64 6d 6f 64 65 0a 09 09 20 20 20 20 ase dmode...
b940: 20 20 20 28 28 6a 73 6f 6e 20 6f 64 73 29 0a 09 ((json ods)..
b950: 09 09 28 69 66 20 72 75 6e 73 2d 73 70 65 63 0a ..(if runs-spec.
b960: 09 09 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 ... (for-each
b970: 20 0a 09 09 09 20 20 20 20 20 28 6c 61 6d 62 64 .... (lambd
b980: 61 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 a (field-name)..
b990: 09 09 20 20 20 20 20 20 20 28 6d 75 74 69 6c 73 .. (mutils
b9a0: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
b9b0: 61 74 61 20 28 63 6f 6e 63 20 28 64 62 3a 67 65 ata (conc (db:ge
b9c0: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
b9d0: 72 20 72 75 6e 20 68 65 61 64 65 72 20 66 69 65 r run header fie
b9e0: 6c 64 2d 6e 61 6d 65 29 29 20 74 61 72 67 65 74 ld-name)) target
b9f0: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 str runname "met
ba00: 61 22 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 0a a" field-name)).
ba10: 09 09 09 20 20 20 20 20 72 75 6e 73 2d 73 70 65 ... runs-spe
ba20: 63 29 29 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 c)))....;; (muti
ba30: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
ba40: 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 data (db:get-va
ba50: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
ba60: 6e 20 68 65 61 64 65 72 20 22 73 74 61 74 75 73 n header "status
ba70: 22 29 20 20 20 20 20 74 61 72 67 65 74 73 74 72 ") targetstr
ba80: 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 runname "meta"
ba90: 22 73 74 61 74 75 73 22 20 20 20 20 20 29 0a 09 "status" )..
baa0: 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 ..;; (mutils:hie
bab0: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
bac0: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
bad0: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
bae0: 65 72 20 22 73 74 61 74 65 22 29 20 20 20 20 20 er "state")
baf0: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
bb00: 6d 65 20 22 6d 65 74 61 22 20 22 73 74 61 74 65 me "meta" "state
bb10: 22 20 20 20 20 20 20 29 0a 09 09 09 3b 3b 20 28 " )....;; (
bb20: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
bb30: 73 65 74 21 20 64 61 74 61 20 28 63 6f 6e 63 20 set! data (conc
bb40: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
bb50: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
bb60: 65 72 20 22 69 64 22 29 29 20 20 74 61 72 67 65 er "id")) targe
bb70: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 tstr runname "me
bb80: 74 61 22 20 22 69 64 22 20 20 20 20 20 20 20 20 ta" "id"
bb90: 20 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 )....;; (mutils
bba0: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
bbb0: 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 ata (db:get-valu
bbc0: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
bbd0: 68 65 61 64 65 72 20 22 65 76 65 6e 74 5f 74 69 header "event_ti
bbe0: 6d 65 22 29 20 74 61 72 67 65 74 73 74 72 20 72 me") targetstr r
bbf0: 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 65 unname "meta" "e
bc00: 76 65 6e 74 5f 74 69 6d 65 22 20 29 0a 09 09 09 vent_time" )....
bc10: 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ;; (mutils:hierh
bc20: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 64 ash-set! data (d
bc30: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
bc40: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
bc50: 20 22 63 6f 6d 6d 65 6e 74 22 29 20 20 20 20 74 "comment") t
bc60: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
bc70: 20 22 6d 65 74 61 22 20 22 63 6f 6d 6d 65 6e 74 "meta" "comment
bc80: 22 20 20 20 20 29 0a 09 09 09 3b 3b 20 3b 3b 20 " )....;; ;;
bc90: 61 64 64 20 6c 61 73 74 20 65 6e 74 72 79 20 74 add last entry t
bca0: 77 69 63 65 20 2d 20 73 65 65 6d 73 20 74 6f 20 wice - seems to
bcb0: 62 65 20 61 20 62 75 67 20 69 6e 20 68 69 65 72 be a bug in hier
bcc0: 68 61 73 68 3f 0a 09 09 09 3b 3b 20 28 6d 75 74 hash?....;; (mut
bcd0: 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 ils:hierhash-set
bce0: 21 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 ! data (db:get-v
bcf0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
bd00: 75 6e 20 68 65 61 64 65 72 20 22 63 6f 6d 6d 65 un header "comme
bd10: 6e 74 22 29 20 20 20 20 74 61 72 67 65 74 73 74 nt") targetst
bd20: 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 r runname "meta"
bd30: 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 29 0a "comment" ).
bd40: 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 .. (else..
bd50: 09 09 28 69 66 20 28 6e 75 6c 6c 3f 20 72 75 6e ..(if (null? run
bd60: 73 2d 73 70 65 63 29 0a 09 09 09 20 20 20 20 28 s-spec).... (
bd70: 70 72 69 6e 74 20 22 52 75 6e 3a 20 22 20 74 61 print "Run: " ta
bd80: 72 67 65 74 73 74 72 20 22 2f 22 20 72 75 6e 6e rgetstr "/" runn
bd90: 61 6d 65 20 0a 09 09 09 09 20 20 20 22 20 73 74 ame ..... " st
bda0: 61 74 75 73 3a 20 22 20 28 64 62 3a 67 65 74 2d atus: " (db:get-
bdb0: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
bdc0: 72 75 6e 20 68 65 61 64 65 72 20 22 73 74 61 74 run header "stat
bdd0: 65 22 29 0a 09 09 09 09 20 20 20 22 20 72 75 6e e")..... " run
bde0: 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 2c -id: " run-id ",
bdf0: 20 6e 75 6d 62 65 72 20 74 65 73 74 73 3a 20 22 number tests: "
be00: 20 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 0a (length tests).
be10: 09 09 09 09 20 20 20 22 20 65 76 65 6e 74 5f 74 .... " event_t
be20: 69 6d 65 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 ime: " (db:get-v
be30: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
be40: 75 6e 20 68 65 61 64 65 72 20 22 65 76 65 6e 74 un header "event
be50: 5f 74 69 6d 65 22 29 29 0a 09 09 09 20 20 20 20 _time"))....
be60: 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 (begin....
be70: 28 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 (if (not (member
be80: 20 22 74 61 72 67 65 74 22 20 72 75 6e 73 2d 73 "target" runs-s
be90: 70 65 63 29 29 0a 09 09 09 20 20 20 20 20 20 20 pec))....
bea0: 20 20 20 3b 3b 20 28 64 69 73 70 6c 61 79 20 28 ;; (display (
beb0: 63 6f 6e 63 20 22 54 61 72 67 65 74 3a 20 22 20 conc "Target: "
bec0: 74 61 72 67 65 74 73 74 72 29 29 0a 09 09 09 20 targetstr))....
bed0: 20 20 20 20 20 20 20 20 20 28 64 69 73 70 6c 61 (displa
bee0: 79 20 28 63 6f 6e 63 20 22 52 75 6e 3a 20 22 20 y (conc "Run: "
bef0: 74 61 72 67 65 74 73 74 72 20 22 2f 22 20 72 75 targetstr "/" ru
bf00: 6e 6e 61 6d 65 20 22 20 22 29 29 29 0a 09 09 09 nname " ")))....
bf10: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a (for-each.
bf20: 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 ... (lambd
bf30: 61 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 a (field-name)..
bf40: 09 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f 20 ... (if (equal?
bf50: 66 69 65 6c 64 2d 6e 61 6d 65 20 22 74 61 72 67 field-name "targ
bf60: 65 74 22 29 0a 09 09 09 09 20 20 20 20 20 28 64 et")..... (d
bf70: 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 22 74 61 isplay (conc "ta
bf80: 72 67 65 74 3a 20 22 20 74 61 72 67 65 74 73 74 rget: " targetst
bf90: 72 20 22 20 22 29 29 0a 09 09 09 09 20 20 20 20 r " ")).....
bfa0: 20 28 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 (display (conc
bfb0: 66 69 65 6c 64 2d 6e 61 6d 65 20 22 3a 20 22 20 field-name ": "
bfc0: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
bfd0: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
bfe0: 65 72 20 28 63 6f 6e 63 20 66 69 65 6c 64 2d 6e er (conc field-n
bff0: 61 6d 65 29 29 20 22 20 22 29 29 29 29 0a 09 09 ame)) " "))))...
c000: 09 20 20 20 20 20 20 20 72 75 6e 73 2d 73 70 65 . runs-spe
c010: 63 29 0a 09 09 09 20 20 20 20 20 20 28 6e 65 77 c).... (new
c020: 6c 69 6e 65 29 29 29 29 29 0a 09 09 20 20 20 20 line)))))...
c030: 20 20 20 0a 09 09 20 20 20 20 20 28 66 6f 72 2d ... (for-
c040: 65 61 63 68 20 0a 09 09 20 20 20 20 20 20 28 6c each ... (l
c050: 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 20 ambda (test)...
c060: 20 20 20 20 20 09 28 63 6f 6d 6d 6f 6e 3a 64 65 .(common:de
c070: 62 75 67 2d 68 61 6e 64 6c 65 2d 65 78 63 65 70 bug-handle-excep
c080: 74 69 6f 6e 73 20 23 66 0a 09 09 09 20 65 78 6e tions #f.... exn
c090: 0a 09 09 09 20 28 62 65 67 69 6e 0a 09 09 09 20 .... (begin....
c0a0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
c0b0: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
c0c0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 42 61 64 20 64 log-port* "Bad d
c0d0: 61 74 61 20 69 6e 20 74 65 73 74 20 72 65 63 6f ata in test reco
c0e0: 72 64 3f 20 22 20 74 65 73 74 29 0a 09 09 09 20 rd? " test)....
c0f0: 20 20 28 70 72 69 6e 74 20 22 65 78 6e 3d 22 20 (print "exn="
c100: 28 63 6f 6e 64 69 74 69 6f 6e 2d 3e 6c 69 73 74 (condition->list
c110: 20 65 78 6e 29 29 0a 09 09 09 20 20 20 28 64 65 exn)).... (de
c120: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
c130: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
c140: 20 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f message: " ((co
c150: 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 ndition-property
c160: 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 -accessor 'exn '
c170: 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 message) exn))..
c180: 09 09 20 20 20 28 70 72 69 6e 74 2d 63 61 6c 6c .. (print-call
c190: 2d 63 68 61 69 6e 20 28 63 75 72 72 65 6e 74 2d -chain (current-
c1a0: 65 72 72 6f 72 2d 70 6f 72 74 29 29 29 0a 09 09 error-port)))...
c1b0: 09 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 69 . (let* ((test-i
c1c0: 64 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 d (if (memb
c1d0: 65 72 20 22 69 64 22 20 20 20 20 20 20 20 20 20 er "id"
c1e0: 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 tests-spec)(ge
c1f0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
c200: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
c210: 69 65 6c 64 2d 69 6e 64 65 78 20 22 69 64 22 20 ield-index "id"
c220: 20 20 20 20 20 20 20 20 20 29 20 23 66 29 29 20 ) #f))
c230: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
c240: 69 64 20 20 20 20 20 20 20 20 20 74 65 73 74 29 id test)
c250: 29 0a 09 09 09 09 28 74 65 73 74 6e 61 6d 65 20 ).....(testname
c260: 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 (if (member
c270: 22 74 65 73 74 6e 61 6d 65 22 20 20 20 20 20 74 "testname" t
c280: 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 ests-spec)(get-v
c290: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
c2a0: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
c2b0: 64 2d 69 6e 64 65 78 20 22 74 65 73 74 6e 61 6d d-index "testnam
c2c0: 65 22 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 e" ) #f)) ;;
c2d0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 (db:test-get-tes
c2e0: 74 6e 61 6d 65 20 20 20 74 65 73 74 29 29 0a 09 tname test))..
c2f0: 09 09 09 28 69 74 65 6d 70 61 74 68 20 20 20 20 ...(itempath
c300: 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 69 74 (if (member "it
c310: 65 6d 5f 70 61 74 68 22 20 20 20 20 74 65 73 74 em_path" test
c320: 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 s-spec)(get-valu
c330: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
c340: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
c350: 6e 64 65 78 20 22 69 74 65 6d 5f 70 61 74 68 22 ndex "item_path"
c360: 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 ) #f)) ;; (db
c370: 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 :test-get-item-p
c380: 61 74 68 20 20 74 65 73 74 29 29 0a 09 09 09 09 ath test)).....
c390: 28 63 6f 6d 6d 65 6e 74 20 20 20 20 20 20 28 69 (comment (i
c3a0: 66 20 28 6d 65 6d 62 65 72 20 22 63 6f 6d 6d 65 f (member "comme
c3b0: 6e 74 22 20 20 20 20 20 20 74 65 73 74 73 2d 73 nt" tests-s
c3c0: 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 pec)(get-value-b
c3d0: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
c3e0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
c3f0: 78 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 20 x "comment"
c400: 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 ) #f)) ;; (db:te
c410: 73 74 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 20 st-get-comment
c420: 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 74 73 test)).....(ts
c430: 74 61 74 65 20 20 20 20 20 20 20 28 69 66 20 28 tate (if (
c440: 6d 65 6d 62 65 72 20 22 73 74 61 74 65 22 20 20 member "state"
c450: 20 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 tests-spec
c460: 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 )(get-value-by-f
c470: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
c480: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
c490: 73 74 61 74 65 22 20 20 20 20 20 20 20 29 20 23 state" ) #
c4a0: 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d f)) ;; (db:test-
c4b0: 67 65 74 2d 73 74 61 74 65 20 20 20 20 20 20 74 get-state t
c4c0: 65 73 74 29 29 0a 09 09 09 09 28 74 73 74 61 74 est)).....(tstat
c4d0: 75 73 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d us (if (mem
c4e0: 62 65 72 20 22 73 74 61 74 75 73 22 20 20 20 20 ber "status"
c4f0: 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 tests-spec)(g
c500: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
c510: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
c520: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 field-index "sta
c530: 74 75 73 22 20 20 20 20 20 20 29 20 23 66 29 29 tus" ) #f))
c540: 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ;; (db:test-get
c550: 2d 73 74 61 74 75 73 20 20 20 20 20 74 65 73 74 -status test
c560: 29 29 0a 09 09 09 09 28 65 76 65 6e 74 2d 74 69 )).....(event-ti
c570: 6d 65 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 me (if (member
c580: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 20 20 "event_time"
c590: 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d tests-spec)(get-
c5a0: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
c5b0: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
c5c0: 6c 64 2d 69 6e 64 65 78 20 22 65 76 65 6e 74 5f ld-index "event_
c5d0: 74 69 6d 65 22 20 20 29 20 23 66 29 29 20 3b 3b time" ) #f)) ;;
c5e0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 (db:test-get-ev
c5f0: 65 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 29 0a ent_time test)).
c600: 09 09 09 09 28 72 75 6e 64 69 72 20 20 20 20 20 ....(rundir
c610: 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 72 (if (member "r
c620: 75 6e 64 69 72 22 20 20 20 20 20 20 20 74 65 73 undir" tes
c630: 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c ts-spec)(get-val
c640: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
c650: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
c660: 69 6e 64 65 78 20 22 72 75 6e 64 69 72 22 20 20 index "rundir"
c670: 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 ) #f)) ;; (d
c680: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 b:test-get-rundi
c690: 72 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 r test))....
c6a0: 09 28 66 69 6e 61 6c 5f 6c 6f 67 66 20 20 20 28 .(final_logf (
c6b0: 69 66 20 28 6d 65 6d 62 65 72 20 22 66 69 6e 61 if (member "fina
c6c0: 6c 5f 6c 6f 67 66 22 20 20 20 74 65 73 74 73 2d l_logf" tests-
c6d0: 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d spec)(get-value-
c6e0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
c6f0: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
c700: 65 78 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 ex "final_logf"
c710: 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 ) #f)) ;; (db:t
c720: 65 73 74 2d 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f est-get-final_lo
c730: 67 66 20 74 65 73 74 29 29 0a 09 09 09 09 28 72 gf test)).....(r
c740: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 28 69 66 20 un_duration (if
c750: 28 6d 65 6d 62 65 72 20 22 72 75 6e 5f 64 75 72 (member "run_dur
c760: 61 74 69 6f 6e 22 20 74 65 73 74 73 2d 73 70 65 ation" tests-spe
c770: 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d c)(get-value-by-
c780: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
c790: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
c7a0: 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 20 "run_duration")
c7b0: 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 #f)) ;; (db:test
c7c0: 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f -get-run_duratio
c7d0: 6e 20 74 65 73 74 29 29 0a 09 09 09 09 28 66 75 n test)).....(fu
c7e0: 6c 6c 6e 61 6d 65 20 20 20 20 20 28 63 6f 6e 63 llname (conc
c7f0: 20 74 65 73 74 6e 61 6d 65 0a 09 09 09 09 09 09 testname.......
c800: 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 (if (equal?
c810: 69 74 65 6d 70 61 74 68 20 22 22 29 0a 09 09 09 itempath "")....
c820: 09 09 09 09 22 22 20 0a 09 09 09 09 09 09 09 28 ...."" ........(
c830: 63 6f 6e 63 20 22 28 22 20 69 74 65 6d 70 61 74 conc "(" itempat
c840: 68 20 22 29 22 29 29 29 29 29 0a 09 09 09 20 20 h ")")))))....
c850: 20 28 63 61 73 65 20 64 6d 6f 64 65 0a 09 09 09 (case dmode....
c860: 20 20 20 20 20 28 28 6a 73 6f 6e 20 6f 64 73 29 ((json ods)
c870: 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 74 65 .... (if te
c880: 73 74 73 2d 73 70 65 63 0a 09 09 09 09 20 20 28 sts-spec..... (
c890: 66 6f 72 2d 65 61 63 68 0a 09 09 09 09 20 20 20 for-each.....
c8a0: 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 2d 6e (lambda (field-n
c8b0: 61 6d 65 29 0a 09 09 09 09 20 20 20 20 20 28 6d ame)..... (m
c8c0: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
c8d0: 65 74 21 20 64 61 74 61 20 20 28 67 65 74 2d 76 et! data (get-v
c8e0: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
c8f0: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
c900: 64 2d 69 6e 64 65 78 20 66 69 65 6c 64 2d 6e 61 d-index field-na
c910: 6d 65 29 20 74 61 72 67 65 74 73 74 72 20 72 75 me) targetstr ru
c920: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
c930: 6e 63 20 74 65 73 74 2d 69 64 29 20 66 69 65 6c nc test-id) fiel
c940: 64 2d 6e 61 6d 65 29 29 0a 09 09 09 09 20 20 20 d-name)).....
c950: 74 65 73 74 73 2d 73 70 65 63 29 29 29 0a 09 09 tests-spec)))...
c960: 09 20 20 20 20 20 3b 3b 20 3b 3b 20 28 6d 75 74 . ;; ;; (mut
c970: 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 ils:hierhash-set
c980: 21 20 64 61 74 61 20 20 66 75 6c 6c 6e 61 6d 65 ! data fullname
c990: 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e targetstr run
c9a0: 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e name "data" (con
c9b0: 63 20 74 65 73 74 2d 69 64 29 20 22 74 6e 61 6d c test-id) "tnam
c9c0: 65 22 20 20 20 20 20 29 0a 09 09 09 20 20 20 20 e" )....
c9d0: 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 ;; (mutils:hie
c9e0: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
c9f0: 20 74 65 73 74 6e 61 6d 65 20 20 20 74 61 72 67 testname targ
ca00: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 etstr runname "d
ca10: 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d ata" (conc test-
ca20: 69 64 29 20 22 74 65 73 74 6e 61 6d 65 22 20 20 id) "testname"
ca30: 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d ).... ;; (m
ca40: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
ca50: 65 74 21 20 64 61 74 61 20 20 69 74 65 6d 70 61 et! data itempa
ca60: 74 68 20 20 20 74 61 72 67 65 74 73 74 72 20 72 th targetstr r
ca70: 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 unname "data" (c
ca80: 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 69 74 onc test-id) "it
ca90: 65 6d 70 61 74 68 22 20 20 29 0a 09 09 09 20 20 empath" )....
caa0: 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 ;; (mutils:h
cab0: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
cac0: 61 20 20 63 6f 6d 6d 65 6e 74 20 20 20 20 74 61 a comment ta
cad0: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
cae0: 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 "data" (conc tes
caf0: 74 2d 69 64 29 20 22 63 6f 6d 6d 65 6e 74 22 20 t-id) "comment"
cb00: 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 ).... ;;
cb10: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
cb20: 2d 73 65 74 21 20 64 61 74 61 20 20 74 73 74 61 -set! data tsta
cb30: 74 65 20 20 20 20 20 74 61 72 67 65 74 73 74 72 te targetstr
cb40: 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 runname "data"
cb50: 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 (conc test-id) "
cb60: 73 74 61 74 65 22 20 20 20 20 20 29 0a 09 09 09 state" )....
cb70: 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 ;; (mutils
cb80: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
cb90: 61 74 61 20 20 74 73 74 61 74 75 73 20 20 20 20 ata tstatus
cba0: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
cbb0: 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 e "data" (conc t
cbc0: 65 73 74 2d 69 64 29 20 22 73 74 61 74 75 73 22 est-id) "status"
cbd0: 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b ).... ;;
cbe0: 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 (mutils:hierha
cbf0: 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 72 75 sh-set! data ru
cc00: 6e 64 69 72 20 20 20 20 20 74 61 72 67 65 74 73 ndir targets
cc10: 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 tr runname "data
cc20: 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 " (conc test-id)
cc30: 20 22 72 75 6e 64 69 72 22 20 20 20 20 29 0a 09 "rundir" )..
cc40: 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 .. ;; (muti
cc50: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
cc60: 20 64 61 74 61 20 20 66 69 6e 61 6c 5f 6c 6f 67 data final_log
cc70: 66 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e f targetstr runn
cc80: 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 ame "data" (conc
cc90: 20 74 65 73 74 2d 69 64 29 20 22 66 69 6e 61 6c test-id) "final
cca0: 5f 6c 6f 67 66 22 29 0a 09 09 09 20 20 20 20 20 _logf")....
ccb0: 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 ;; (mutils:hier
ccc0: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 hash-set! data
ccd0: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 61 72 run_duration tar
cce0: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
ccf0: 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 data" (conc test
cd00: 2d 69 64 29 20 22 72 75 6e 5f 64 75 72 61 74 69 -id) "run_durati
cd10: 6f 6e 22 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 on").... ;;
cd20: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
cd30: 68 2d 73 65 74 21 20 64 61 74 61 20 20 65 76 65 h-set! data eve
cd40: 6e 74 2d 74 69 6d 65 20 74 61 72 67 65 74 73 74 nt-time targetst
cd50: 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 r runname "data"
cd60: 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 (conc test-id)
cd70: 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 0a 09 09 "event_time")...
cd80: 09 20 20 20 20 20 3b 3b 20 20 3b 3b 20 61 64 64 . ;; ;; add
cd90: 20 6c 61 73 74 20 65 6e 74 72 79 20 74 77 69 63 last entry twic
cda0: 65 20 2d 20 73 65 65 6d 73 20 74 6f 20 62 65 20 e - seems to be
cdb0: 61 20 62 75 67 20 69 6e 20 68 69 65 72 68 61 73 a bug in hierhas
cdc0: 68 3f 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 h?.... ;; (
cdd0: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
cde0: 73 65 74 21 20 64 61 74 61 20 20 65 76 65 6e 74 set! data event
cdf0: 2d 74 69 6d 65 20 74 61 72 67 65 74 73 74 72 20 -time targetstr
ce00: 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 runname "data" (
ce10: 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 65 conc test-id) "e
ce20: 76 65 6e 74 5f 74 69 6d 65 22 29 0a 09 09 09 20 vent_time")....
ce30: 20 20 20 20 3b 3b 20 20 29 0a 09 09 09 20 20 20 ;; )....
ce40: 20 20 28 65 6c 73 65 0a 09 09 09 20 20 20 20 20 (else....
ce50: 20 28 69 66 20 28 61 6e 64 20 74 73 74 61 74 65 (if (and tstate
ce60: 20 74 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 tstatus event-t
ce70: 69 6d 65 29 0a 09 09 09 09 20 20 28 66 6f 72 6d ime)..... (form
ce80: 61 74 20 23 74 0a 09 09 09 09 09 20 20 22 20 20 at #t...... "
ce90: 54 65 73 74 3a 20 7e 32 35 61 20 53 74 61 74 65 Test: ~25a State
cea0: 3a 20 7e 31 35 61 20 53 74 61 74 75 73 3a 20 7e : ~15a Status: ~
ceb0: 31 35 61 20 52 75 6e 74 69 6d 65 3a 20 7e 35 40 15a Runtime: ~5@
cec0: 61 73 20 54 69 6d 65 3a 20 7e 32 32 61 20 48 6f as Time: ~22a Ho
ced0: 73 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 09 09 st: ~10a\n".....
cee0: 09 20 20 28 69 66 20 66 75 6c 6c 6e 61 6d 65 20 . (if fullname
cef0: 66 75 6c 6c 6e 61 6d 65 20 22 22 29 0a 09 09 09 fullname "")....
cf00: 09 09 20 20 28 69 66 20 74 73 74 61 74 65 20 20 .. (if tstate
cf10: 20 74 73 74 61 74 65 20 20 20 22 22 29 0a 09 09 tstate "")...
cf20: 09 09 09 20 20 28 69 66 20 74 73 74 61 74 75 73 ... (if tstatus
cf30: 20 20 74 73 74 61 74 75 73 20 20 22 22 29 0a 09 tstatus "")..
cf40: 09 09 09 09 20 20 28 67 65 74 2d 76 61 6c 75 65 .... (get-value
cf50: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
cf60: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
cf70: 64 65 78 20 22 72 75 6e 5f 64 75 72 61 74 69 6f dex "run_duratio
cf80: 6e 22 29 3b 3b 28 69 66 20 74 65 73 74 20 20 20 n");;(if test
cf90: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 (db:test-get-r
cfa0: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 un_duration test
cfb0: 29 20 22 22 29 0a 09 09 09 09 09 20 20 28 69 66 ) "")...... (if
cfc0: 20 65 76 65 6e 74 2d 74 69 6d 65 20 65 76 65 6e event-time even
cfd0: 74 2d 74 69 6d 65 20 22 22 29 0a 09 09 09 09 09 t-time "")......
cfe0: 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d (get-value-by-
cff0: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
d000: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
d010: 22 68 6f 73 74 22 29 29 20 3b 3b 28 69 66 20 74 "host")) ;;(if t
d020: 65 73 74 20 28 64 62 3a 74 65 73 74 2d 67 65 74 est (db:test-get
d030: 2d 68 6f 73 74 20 74 65 73 74 29 29 20 22 22 29 -host test)) "")
d040: 0a 09 09 09 09 20 20 28 70 72 69 6e 74 20 22 20 ..... (print "
d050: 20 54 65 73 74 3a 20 22 20 66 75 6c 6c 6e 61 6d Test: " fullnam
d060: 65 0a 09 09 09 09 09 20 28 69 66 20 74 73 74 61 e...... (if tsta
d070: 74 65 20 20 28 63 6f 6e 63 20 22 20 53 74 61 74 te (conc " Stat
d080: 65 3a 20 22 20 20 74 73 74 61 74 65 29 20 20 22 e: " tstate) "
d090: 22 29 0a 09 09 09 09 09 20 28 69 66 20 74 73 74 ")...... (if tst
d0a0: 61 74 75 73 20 28 63 6f 6e 63 20 22 20 53 74 61 atus (conc " Sta
d0b0: 74 75 73 3a 20 22 20 74 73 74 61 74 75 73 29 20 tus: " tstatus)
d0c0: 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 28 67 "")...... (if (g
d0d0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
d0e0: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
d0f0: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e field-index "run
d100: 5f 64 75 72 61 74 69 6f 6e 22 29 0a 09 09 09 09 _duration").....
d110: 09 20 20 20 20 20 28 63 6f 6e 63 20 22 20 52 75 . (conc " Ru
d120: 6e 74 69 6d 65 3a 20 22 20 28 67 65 74 2d 76 61 ntime: " (get-va
d130: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
d140: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
d150: 2d 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 61 -index "run_dura
d160: 74 69 6f 6e 22 29 29 0a 09 09 09 09 09 20 20 20 tion"))......
d170: 20 20 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 "")...... (if
d180: 65 76 65 6e 74 2d 74 69 6d 65 20 28 63 6f 6e 63 event-time (conc
d190: 20 22 20 54 69 6d 65 3a 20 22 20 65 76 65 6e 74 " Time: " event
d1a0: 2d 74 69 6d 65 29 20 22 22 29 0a 09 09 09 09 09 -time) "")......
d1b0: 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d (if (get-value-
d1c0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
d1d0: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
d1e0: 65 78 20 22 68 6f 73 74 22 29 0a 09 09 09 09 09 ex "host")......
d1f0: 20 20 20 20 20 28 63 6f 6e 63 20 22 20 48 6f 73 (conc " Hos
d200: 74 3a 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d t: " (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 68 6f 73 74 22 29 29 0a 09 09 09 09 ex "host")).....
d240: 09 20 20 20 20 20 22 22 29 29 29 0a 09 09 09 20 . "")))....
d250: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6f (if (not (o
d260: 72 20 28 65 71 75 61 6c 3f 20 28 67 65 74 2d 76 r (equal? (get-v
d270: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
d280: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
d290: 64 2d 69 6e 64 65 78 20 22 73 74 61 74 75 73 22 d-index "status"
d2a0: 29 20 22 50 41 53 53 22 29 0a 09 09 09 09 09 20 ) "PASS")......
d2b0: 20 20 28 65 71 75 61 6c 3f 20 28 67 65 74 2d 76 (equal? (get-v
d2c0: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
d2d0: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
d2e0: 64 2d 69 6e 64 65 78 20 22 73 74 61 74 75 73 22 d-index "status"
d2f0: 29 20 22 57 41 52 4e 22 29 0a 09 09 09 09 09 20 ) "WARN")......
d300: 20 20 28 65 71 75 61 6c 3f 20 28 67 65 74 2d 76 (equal? (get-v
d310: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
d320: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
d330: 64 2d 69 6e 64 65 78 20 22 73 74 61 74 65 22 29 d-index "state")
d340: 20 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 "NOT_STARTED")
d350: 29 29 0a 09 09 09 09 20 20 28 62 65 67 69 6e 0a ))..... (begin.
d360: 09 09 09 09 20 20 20 20 28 70 72 69 6e 74 20 20 .... (print
d370: 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d (if (get-value-
d380: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
d390: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
d3a0: 65 78 20 22 63 70 75 6c 6f 61 64 22 29 0a 09 09 ex "cpuload")...
d3b0: 09 09 09 09 20 28 63 6f 6e 63 20 22 20 20 20 20 .... (conc "
d3c0: 20 20 20 20 20 63 70 75 6c 6f 61 64 3a 20 20 22 cpuload: "
d3d0: 20 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 (get-value-by
d3e0: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
d3f0: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
d400: 20 22 63 70 75 6c 6f 61 64 22 29 29 0a 09 09 09 "cpuload"))....
d410: 09 09 09 20 22 22 29 20 3b 3b 20 28 64 62 3a 74 ... "") ;; (db:t
d420: 65 73 74 2d 67 65 74 2d 63 70 75 6c 6f 61 64 20 est-get-cpuload
d430: 74 65 73 74 29 0a 09 09 09 09 09 20 20 20 20 20 test)......
d440: 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 (if (get-value-b
d450: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
d460: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
d470: 78 20 22 64 69 73 6b 66 72 65 65 22 29 0a 09 09 x "diskfree")...
d480: 09 09 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 20 .... (conc "\n
d490: 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 3a diskfree:
d4a0: 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 " (get-value-by
d4b0: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
d4c0: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
d4d0: 20 22 64 69 73 6b 66 72 65 65 22 29 29 20 3b 3b "diskfree")) ;;
d4e0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 64 69 (db:test-get-di
d4f0: 73 6b 66 72 65 65 20 74 65 73 74 29 0a 09 09 09 skfree test)....
d500: 09 09 09 20 22 22 29 0a 09 09 09 09 09 20 20 20 ... "")......
d510: 20 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 (if (get-value
d520: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
d530: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
d540: 64 65 78 20 22 75 6e 61 6d 65 22 29 0a 09 09 09 dex "uname")....
d550: 09 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 20 20 ... (conc "\n
d560: 20 20 20 20 20 20 75 6e 61 6d 65 3a 20 20 20 20 uname:
d570: 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d " (get-value-by-
d580: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
d590: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
d5a0: 22 75 6e 61 6d 65 22 29 29 20 3b 3b 20 28 64 62 "uname")) ;; (db
d5b0: 3a 74 65 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 :test-get-uname
d5c0: 74 65 73 74 29 0a 09 09 09 09 09 09 20 22 22 29 test)....... "")
d5d0: 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 ...... (if (
d5e0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
d5f0: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
d600: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 -field-index "ru
d610: 6e 64 69 72 22 29 0a 09 09 09 09 09 09 20 28 63 ndir")....... (c
d620: 6f 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 20 20 onc "\n
d630: 72 75 6e 64 69 72 3a 20 20 20 22 20 28 67 65 74 rundir: " (get
d640: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
d650: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
d660: 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 64 69 eld-index "rundi
d670: 72 22 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 r")) ;; (db:test
d680: 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 -get-rundir test
d690: 29 0a 09 09 09 09 09 09 20 22 22 29 0a 3b 3b 09 )....... "").;;.
d6a0: 09 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 .... "\n
d6b0: 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 20 22 rundir: "
d6c0: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
d6d0: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
d6e0: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
d6f0: 22 29 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 ") ;; (sdb:qry '
d700: 67 65 74 73 74 72 20 3b 3b 20 28 66 69 6c 65 64 getstr ;; (filed
d710: 62 3a 67 65 74 2d 70 61 74 68 20 2a 66 64 62 2a b:get-path *fdb*
d720: 20 0a 3b 3b 20 09 09 09 09 09 20 20 20 20 20 28 .;; ..... (
d730: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 db:test-get-rund
d740: 69 72 20 74 65 73 74 29 20 3b 3b 20 29 0a 09 09 ir test) ;; )...
d750: 09 09 09 20 20 20 20 20 29 0a 09 09 09 09 20 20 ... ).....
d760: 20 20 3b 3b 20 45 61 63 68 20 74 65 73 74 0a 09 ;; Each test..
d770: 09 09 09 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 ... ;; DO NOT
d780: 20 72 65 6d 6f 74 65 20 72 75 6e 0a 09 09 09 09 remote run.....
d790: 20 20 20 20 28 6c 65 74 20 28 28 73 74 65 70 73 (let ((steps
d7a0: 20 28 64 62 3a 64 69 73 70 61 74 63 68 2d 71 75 (db:dispatch-qu
d7b0: 65 72 79 20 61 63 63 65 73 73 2d 6d 6f 64 65 20 ery access-mode
d7c0: 72 6d 74 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f rmt:get-steps-fo
d7d0: 72 2d 74 65 73 74 20 64 62 3a 67 65 74 2d 73 74 r-test db:get-st
d7e0: 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 72 75 6e eps-for-test run
d7f0: 2d 69 64 20 28 64 62 3a 74 65 73 74 2d 67 65 74 -id (db:test-get
d800: 2d 69 64 20 74 65 73 74 29 29 29 29 20 3b 3b 20 -id test)))) ;;
d810: 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f (db:get-steps-fo
d820: 72 2d 74 65 73 74 20 64 62 73 74 72 75 63 74 20 r-test dbstruct
d830: 72 75 6e 2d 69 64 20 28 64 62 3a 74 65 73 74 2d run-id (db:test-
d840: 67 65 74 2d 69 64 20 74 65 73 74 29 29 29 29 0a get-id test)))).
d850: 09 09 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 .... (for-e
d860: 61 63 68 20 0a 09 09 09 09 20 20 20 20 20 20 20 ach .....
d870: 28 6c 61 6d 62 64 61 20 28 73 74 65 70 29 0a 09 (lambda (step)..
d880: 09 09 09 09 20 28 66 6f 72 6d 61 74 20 23 74 20 .... (format #t
d890: 0a 09 09 09 09 09 09 20 22 20 20 20 20 53 74 65 ....... " Ste
d8a0: 70 3a 20 7e 32 30 61 20 53 74 61 74 65 3a 20 7e p: ~20a State: ~
d8b0: 31 30 61 20 53 74 61 74 75 73 3a 20 7e 31 30 61 10a Status: ~10a
d8c0: 20 54 69 6d 65 20 7e 32 32 61 5c 6e 22 0a 09 09 Time ~22a\n"...
d8d0: 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 2d 67 .... (tdb:step-g
d8e0: 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 70 et-stepname step
d8f0: 29 0a 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 )....... (tdb:st
d900: 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 74 65 ep-get-state ste
d910: 70 29 0a 09 09 09 09 09 09 20 28 74 64 62 3a 73 p)....... (tdb:s
d920: 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 tep-get-status s
d930: 74 65 70 29 0a 09 09 09 09 09 09 20 28 74 64 62 tep)....... (tdb
d940: 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f :step-get-event_
d950: 74 69 6d 65 20 73 74 65 70 29 29 29 0a 09 09 09 time step)))....
d960: 09 20 20 20 20 20 20 20 73 74 65 70 73 29 29 29 . steps)))
d970: 29 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 28 ))))))... (
d980: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
d990: 20 22 2d 73 6f 72 74 22 29 0a 09 09 09 20 20 28 "-sort").... (
d9a0: 73 6f 72 74 20 74 65 73 74 73 0a 09 09 09 09 28 sort tests.....(
d9b0: 6c 61 6d 62 64 61 20 28 61 2d 74 65 73 74 20 62 lambda (a-test b
d9c0: 2d 74 65 73 74 29 0a 09 09 09 09 20 20 28 6c 65 -test)..... (le
d9d0: 74 2a 20 28 28 6b 65 79 20 20 20 20 28 61 72 67 t* ((key (arg
d9e0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f 72 74 s:get-arg "-sort
d9f0: 22 29 29 0a 09 09 09 09 09 20 28 66 69 72 73 74 "))...... (first
da00: 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d (get-value-by-
da10: 66 69 65 6c 64 6e 61 6d 65 20 61 2d 74 65 73 74 fieldname a-test
da20: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
da30: 78 20 6b 65 79 29 29 0a 09 09 09 09 09 20 28 73 x key))...... (s
da40: 65 63 6f 6e 64 20 28 67 65 74 2d 76 61 6c 75 65 econd (get-value
da50: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 62 2d -by-fieldname b-
da60: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
da70: 69 6e 64 65 78 20 6b 65 79 29 29 29 0a 09 09 09 index key)))....
da80: 09 20 20 20 20 28 28 63 6f 6e 64 20 0a 09 09 09 . ((cond ....
da90: 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 6e 75 . ((and (nu
daa0: 6d 62 65 72 3f 20 66 69 72 73 74 29 28 6e 75 6d mber? first)(num
dab0: 62 65 72 3f 20 73 65 63 6f 6e 64 29 29 20 3c 29 ber? second)) <)
dac0: 0a 09 09 09 09 20 20 20 20 20 20 28 28 61 6e 64 ..... ((and
dad0: 20 28 73 74 72 69 6e 67 3f 20 66 69 72 73 74 29 (string? first)
dae0: 28 73 74 72 69 6e 67 3f 20 73 65 63 6f 6e 64 29 (string? second)
daf0: 29 20 73 74 72 69 6e 67 3c 3d 3f 29 0a 09 09 09 ) string<=?)....
db00: 09 20 20 20 20 20 20 28 65 6c 73 65 20 65 71 75 . (else equ
db10: 61 6c 3f 29 29 0a 09 09 09 09 20 20 20 20 20 66 al?))..... f
db20: 69 72 73 74 20 73 65 63 6f 6e 64 29 29 29 29 0a irst second)))).
db30: 09 09 09 20 20 74 65 73 74 73 29 29 29 29 29 29 ... tests))))))
db40: 0a 09 20 20 20 72 75 6e 73 29 0a 09 20 20 28 69 .. runs).. (i
db50: 66 20 28 65 71 3f 20 64 6d 6f 64 65 20 27 6a 73 f (eq? dmode 'js
db60: 6f 6e 29 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 on)(json-write d
db70: 61 74 61 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 ata)).. (let* (
db80: 28 6d 65 74 61 64 61 74 2d 66 69 65 6c 64 73 20 (metadat-fields
db90: 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 (delete-duplicat
dba0: 65 73 0a 09 09 09 09 20 20 28 61 70 70 65 6e 64 es..... (append
dbb0: 20 6b 65 79 73 20 27 28 20 22 72 75 6e 6e 61 6d keys '( "runnam
dbc0: 65 22 20 22 74 69 6d 65 22 20 22 6f 77 6e 65 72 e" "time" "owner
dbd0: 22 20 22 70 61 73 73 5f 63 6f 75 6e 74 22 20 22 " "pass_count" "
dbe0: 66 61 69 6c 5f 63 6f 75 6e 74 22 20 22 73 74 61 fail_count" "sta
dbf0: 74 65 22 20 22 73 74 61 74 75 73 22 20 22 63 6f te" "status" "co
dc00: 6d 6d 65 6e 74 22 20 22 69 64 22 29 29 29 29 0a mment" "id")))).
dc10: 09 09 20 28 72 75 6e 2d 66 69 65 6c 64 73 20 20 .. (run-fields
dc20: 20 20 27 28 0a 09 09 09 09 20 20 22 74 65 73 74 '(..... "test
dc30: 6e 61 6d 65 22 0a 09 09 09 09 20 20 22 69 74 65 name"..... "ite
dc40: 6d 5f 70 61 74 68 22 0a 09 09 09 09 20 20 22 73 m_path"..... "s
dc50: 74 61 74 65 22 0a 09 09 09 09 20 20 22 73 74 61 tate"..... "sta
dc60: 74 75 73 22 0a 09 09 09 09 20 20 22 63 6f 6d 6d tus"..... "comm
dc70: 65 6e 74 22 0a 09 09 09 09 20 20 22 65 76 65 6e ent"..... "even
dc80: 74 5f 74 69 6d 65 22 0a 09 09 09 09 20 20 22 68 t_time"..... "h
dc90: 6f 73 74 22 0a 09 09 09 09 20 20 22 72 75 6e 5f ost"..... "run_
dca0: 69 64 22 0a 09 09 09 09 20 20 22 72 75 6e 5f 64 id"..... "run_d
dcb0: 75 72 61 74 69 6f 6e 22 0a 09 09 09 09 20 20 22 uration"..... "
dcc0: 61 74 74 65 6d 70 74 6e 75 6d 22 0a 09 09 09 09 attemptnum".....
dcd0: 20 20 22 69 64 22 0a 09 09 09 09 20 20 22 61 72 "id"..... "ar
dce0: 63 68 69 76 65 64 22 0a 09 09 09 09 20 20 22 64 chived"..... "d
dcf0: 69 73 6b 66 72 65 65 22 0a 09 09 09 09 20 20 22 iskfree"..... "
dd00: 63 70 75 6c 6f 61 64 22 0a 09 09 09 09 20 20 22 cpuload"..... "
dd10: 66 69 6e 61 6c 5f 6c 6f 67 66 22 0a 09 09 09 09 final_logf".....
dd20: 20 20 22 73 68 6f 72 74 64 69 72 22 0a 09 09 09 "shortdir"....
dd30: 09 20 20 22 72 75 6e 64 69 72 22 0a 09 09 09 09 . "rundir".....
dd40: 20 20 22 75 6e 61 6d 65 22 0a 09 09 09 09 20 20 "uname".....
dd50: 29 0a 09 09 09 09 29 0a 09 09 20 28 6e 65 77 64 ).....)... (newd
dd60: 61 74 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d at (com
dd70: 6d 6f 6e 3a 74 6f 2d 61 6c 69 73 74 20 64 61 74 mon:to-alist dat
dd80: 61 29 29 0a 09 09 20 28 61 6c 6c 72 75 6e 64 61 a))... (allrunda
dd90: 74 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c t (if (nul
dda0: 6c 3f 20 6e 65 77 64 61 74 29 0a 09 09 09 09 20 l? newdat).....
ddb0: 20 20 20 20 20 27 28 29 0a 09 09 09 09 20 20 20 '().....
ddc0: 20 20 20 28 63 61 72 20 28 6d 61 70 20 63 64 72 (car (map cdr
ddd0: 20 6e 65 77 64 61 74 29 29 29 29 20 3b 3b 20 28 newdat)))) ;; (
dde0: 63 61 72 20 28 6d 61 70 20 63 64 72 20 28 63 61 car (map cdr (ca
ddf0: 72 20 28 6d 61 70 20 63 64 72 20 6e 65 77 64 61 r (map cdr newda
de00: 74 29 29 29 29 29 0a 09 09 20 28 72 75 6e 73 20 t)))))... (runs
de10: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 65 (appe
de20: 6e 64 0a 09 09 09 09 20 20 20 28 6c 69 73 74 20 nd..... (list
de30: 22 72 75 6e 73 22 20 3b 3b 20 73 68 65 65 74 6e "runs" ;; sheetn
de40: 61 6d 65 0a 09 09 09 09 09 20 6d 65 74 61 64 61 ame...... metada
de50: 74 2d 66 69 65 6c 64 73 29 0a 09 09 09 09 20 20 t-fields).....
de60: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 (map (lambda (r
de70: 75 6e 29 0a 09 09 09 09 09 20 20 3b 3b 20 28 70 un)...... ;; (p
de80: 72 69 6e 74 20 22 72 75 6e 3a 20 22 20 72 75 6e rint "run: " run
de90: 29 0a 09 09 09 09 09 20 20 28 6c 65 74 2a 20 28 )...... (let* (
dea0: 28 72 75 6e 6e 61 6d 65 20 28 63 61 72 20 72 75 (runname (car ru
deb0: 6e 29 29 0a 09 09 09 09 09 09 20 28 72 75 6e 64 n))....... (rund
dec0: 61 74 20 20 28 63 64 72 20 72 75 6e 29 29 0a 09 at (cdr run))..
ded0: 09 09 09 09 09 20 28 6d 65 74 61 64 61 74 20 28 ..... (metadat (
dee0: 6c 65 74 20 28 28 74 6d 70 20 28 61 73 73 6f 63 let ((tmp (assoc
def0: 20 22 6d 65 74 61 22 20 72 75 6e 64 61 74 29 29 "meta" rundat))
df00: 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 69 66 )........ (if
df10: 20 74 6d 70 20 28 63 64 72 20 74 6d 70 29 20 23 tmp (cdr tmp) #
df20: 66 29 29 29 29 0a 09 09 09 09 09 20 20 20 20 3b f))))...... ;
df30: 3b 20 28 70 72 69 6e 74 20 22 72 75 6e 6e 61 6d ; (print "runnam
df40: 65 3a 20 22 20 72 75 6e 6e 61 6d 65 20 22 5c 6e e: " runname "\n
df50: 5c 6e 72 75 6e 64 61 74 3a 20 22 20 29 28 70 70 \nrundat: " )(pp
df60: 20 72 75 6e 64 61 74 29 28 70 72 69 6e 74 20 22 rundat)(print "
df70: 5c 6e 5c 6e 6d 65 74 61 64 61 74 3a 20 22 29 28 \n\nmetadat: ")(
df80: 70 70 20 6d 65 74 61 64 61 74 29 0a 09 09 09 09 pp metadat).....
df90: 09 20 20 20 20 28 69 66 20 6d 65 74 61 64 61 74 . (if metadat
dfa0: 0a 09 09 09 09 09 09 28 6d 61 70 20 28 6c 61 6d .......(map (lam
dfb0: 62 64 61 20 28 66 69 65 6c 64 29 0a 09 09 09 09 bda (field).....
dfc0: 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 .. (let ((
dfd0: 74 6d 70 20 28 61 73 73 6f 63 20 66 69 65 6c 64 tmp (assoc field
dfe0: 20 6d 65 74 61 64 61 74 29 29 29 0a 09 09 09 09 metadat))).....
dff0: 09 09 09 20 28 69 66 20 74 6d 70 20 28 63 64 72 ... (if tmp (cdr
e000: 20 74 6d 70 29 20 22 22 29 29 29 0a 09 09 09 09 tmp) ""))).....
e010: 09 09 20 20 20 20 20 6d 65 74 61 64 61 74 2d 66 .. metadat-f
e020: 69 65 6c 64 73 29 0a 09 09 09 09 09 09 28 62 65 ields).......(be
e030: 67 69 6e 0a 09 09 09 09 09 09 20 20 28 64 65 62 gin....... (deb
e040: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
e050: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 ult-log-port* "W
e060: 41 52 4e 49 4e 47 3a 20 6d 65 74 61 20 64 61 74 ARNING: meta dat
e070: 61 20 66 6f 72 20 72 75 6e 20 22 20 72 75 6e 6e a for run " runn
e080: 61 6d 65 20 22 20 6e 6f 74 20 66 6f 75 6e 64 22 ame " not found"
e090: 29 0a 09 09 09 09 09 09 20 20 27 28 29 29 29 29 )....... '())))
e0a0: 29 0a 09 09 09 09 09 61 6c 6c 72 75 6e 64 61 74 )......allrundat
e0b0: 29 29 29 0a 09 09 20 3b 3b 20 27 28 20 28 20 22 )))... ;; '( ( "
e0c0: 74 61 72 67 65 74 22 20 28 20 22 72 75 6e 6e 61 target" ( "runna
e0d0: 6d 65 22 20 28 20 22 64 61 74 61 22 20 28 20 22 me" ( "data" ( "
e0e0: 72 75 6e 69 64 22 20 28 20 22 69 64 20 2e 20 22 runid" ( "id . "
e0f0: 33 37 22 20 29 20 28 20 2e 2e 2e 20 29 29 29 29 37" ) ( ... ))))
e100: 0a 09 09 20 28 72 75 6e 2d 70 61 67 65 73 20 20 ... (run-pages
e110: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda
e120: 20 28 74 61 72 67 64 61 74 29 0a 09 09 09 09 09 (targdat)......
e130: 28 6c 65 74 2a 20 28 28 74 61 72 67 65 74 20 20 (let* ((target
e140: 28 63 61 72 20 74 61 72 67 64 61 74 29 29 0a 09 (car targdat))..
e150: 09 09 09 09 20 20 20 20 20 20 20 28 72 75 6e 73 .... (runs
e160: 64 61 74 20 28 63 64 72 20 74 61 72 67 64 61 74 dat (cdr targdat
e170: 29 29 29 0a 09 09 09 09 09 20 20 28 69 66 20 72 )))...... (if r
e180: 75 6e 73 64 61 74 0a 09 09 09 09 09 20 20 20 20 unsdat......
e190: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
e1a0: 72 75 6e 64 61 74 29 0a 09 09 09 09 09 09 20 20 rundat).......
e1b0: 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 6e 61 (let* ((runna
e1c0: 6d 65 20 20 28 63 61 72 20 72 75 6e 64 61 74 29 me (car rundat)
e1d0: 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 72 75 )........ (ru
e1e0: 6e 64 61 74 20 20 20 28 63 64 72 20 72 75 6e 64 ndat (cdr rund
e1f0: 61 74 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 at))........
e200: 28 74 65 73 74 73 64 61 74 20 28 6c 65 74 20 28 (testsdat (let (
e210: 28 74 6d 70 20 28 61 73 73 6f 63 20 22 64 61 74 (tmp (assoc "dat
e220: 61 22 20 72 75 6e 64 61 74 29 29 29 0a 09 09 09 a" rundat)))....
e230: 09 09 09 09 09 09 28 69 66 20 74 6d 70 20 28 63 ......(if tmp (c
e240: 64 72 20 74 6d 70 29 20 23 66 29 29 29 29 0a 09 dr tmp) #f))))..
e250: 09 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ..... (if
e260: 74 65 73 74 73 64 61 74 0a 09 09 09 09 09 09 09 testsdat........
e270: 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 73 20 (let ((tests
e280: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 74 65 (map (lambda (te
e290: 73 74 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 st)..........
e2a0: 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 (let* ((test
e2b0: 2d 69 64 20 20 28 63 61 72 20 74 65 73 74 29 29 -id (car test))
e2c0: 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 ...........
e2d0: 20 28 74 65 73 74 2d 64 61 74 20 28 63 64 72 20 (test-dat (cdr
e2e0: 74 65 73 74 29 29 29 0a 09 09 09 09 09 09 09 09 test))).........
e2f0: 09 09 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 .. (map (lambda
e300: 28 66 69 65 6c 64 29 0a 09 09 09 09 09 09 09 09 (field).........
e310: 09 09 09 28 6c 65 74 20 28 28 74 6d 70 20 28 61 ...(let ((tmp (a
e320: 73 73 6f 63 20 66 69 65 6c 64 20 74 65 73 74 2d ssoc field test-
e330: 64 61 74 29 29 29 0a 09 09 09 09 09 09 09 09 09 dat)))..........
e340: 09 09 20 20 28 69 66 20 74 6d 70 20 28 63 64 72 .. (if tmp (cdr
e350: 20 74 6d 70 29 20 22 22 29 29 29 0a 09 09 09 09 tmp) ""))).....
e360: 09 09 09 09 09 09 20 20 20 20 20 20 72 75 6e 2d ...... run-
e370: 66 69 65 6c 64 73 29 29 29 0a 09 09 09 09 09 09 fields))).......
e380: 09 09 09 20 20 20 20 20 74 65 73 74 73 64 61 74 ... testsdat
e390: 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 )))........
e3a0: 3b 3b 20 28 70 72 69 6e 74 20 22 54 61 72 67 65 ;; (print "Targe
e3b0: 74 3a 20 22 20 74 61 72 67 65 74 20 22 2f 22 20 t: " target "/"
e3c0: 72 75 6e 6e 61 6d 65 20 22 20 74 65 73 74 73 3a runname " tests:
e3d0: 22 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 3b ")........ ;
e3e0: 3b 20 28 70 70 20 74 65 73 74 73 29 0a 09 09 09 ; (pp tests)....
e3f0: 09 09 09 09 20 20 20 20 20 28 63 6f 6e 73 20 28 .... (cons (
e400: 63 6f 6e 63 20 74 61 72 67 65 74 20 22 2f 22 20 conc target "/"
e410: 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 09 09 runname)........
e420: 09 20 20 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 . (cons (list
e430: 28 63 6f 6e 63 20 74 61 72 67 65 74 20 22 2f 22 (conc target "/"
e440: 20 72 75 6e 6e 61 6d 65 29 29 0a 09 09 09 09 09 runname))......
e450: 09 09 09 09 20 28 63 6f 6e 73 20 27 28 29 0a 09 .... (cons '()..
e460: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
e470: 63 6f 6e 73 20 72 75 6e 2d 66 69 65 6c 64 73 20 cons run-fields
e480: 74 65 73 74 73 29 29 29 29 29 0a 09 09 09 09 09 tests)))))......
e490: 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 .. (begin.....
e4a0: 09 09 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 ... (debug:p
e4b0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
e4c0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
e4d0: 4e 47 3a 20 72 75 6e 20 22 20 74 61 72 67 65 74 NG: run " target
e4e0: 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 20 61 "/" runname " a
e4f0: 70 70 65 61 72 73 20 74 6f 20 68 61 76 65 20 6e ppears to have n
e500: 6f 20 64 61 74 61 22 29 0a 09 09 09 09 09 09 09 o data")........
e510: 20 20 20 20 20 3b 3b 20 28 70 70 20 72 75 6e 64 ;; (pp rund
e520: 61 74 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 at)........
e530: 27 28 29 29 29 29 29 0a 09 09 09 09 09 09 20 20 '())))).......
e540: 20 72 75 6e 73 64 61 74 29 0a 09 09 09 09 09 20 runsdat)......
e550: 20 20 20 20 20 27 28 29 29 29 29 0a 09 09 09 09 '()))).....
e560: 20 20 20 20 20 20 6e 65 77 64 61 74 29 29 20 3b newdat)) ;
e570: 3b 20 77 65 20 75 73 65 20 6e 65 77 64 61 74 20 ; we use newdat
e580: 74 6f 20 67 65 74 20 74 61 72 67 65 74 0a 09 09 to get target...
e590: 20 28 73 68 65 65 74 73 20 20 20 20 20 20 20 20 (sheets
e5a0: 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 (filter (lambda
e5b0: 20 28 78 29 0a 09 09 09 09 09 20 20 20 28 6e 6f (x)...... (no
e5c0: 74 20 28 6e 75 6c 6c 3f 20 78 29 29 29 0a 09 09 t (null? x)))...
e5d0: 09 09 09 20 28 63 6f 6e 73 20 72 75 6e 73 20 28 ... (cons runs (
e5e0: 6d 61 70 20 63 61 72 20 72 75 6e 2d 70 61 67 65 map car run-page
e5f0: 73 29 29 29 29 29 0a 09 20 20 20 20 3b 3b 20 28 s))))).. ;; (
e600: 70 72 69 6e 74 20 22 61 6c 6c 72 75 6e 64 61 74 print "allrundat
e610: 3a 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 70 20 :").. ;; (pp
e620: 61 6c 6c 72 75 6e 64 61 74 29 0a 09 20 20 20 20 allrundat)..
e630: 3b 3b 20 28 70 72 69 6e 74 20 22 72 75 6e 73 3a ;; (print "runs:
e640: 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 70 20 72 ").. ;; (pp r
e650: 75 6e 73 29 0a 09 20 20 20 20 3b 28 70 72 69 6e uns).. ;(prin
e660: 74 20 22 73 68 65 65 74 73 3a 20 22 29 0a 09 20 t "sheets: ")..
e670: 20 20 20 3b 3b 20 28 70 70 20 73 68 65 65 74 73 ;; (pp sheets
e680: 29 0a 09 20 20 20 20 28 69 66 20 28 65 71 3f 20 ).. (if (eq?
e690: 64 6d 6f 64 65 20 27 6f 64 73 29 0a 09 09 28 6c dmode 'ods)...(l
e6a0: 65 74 2a 20 28 28 74 65 6d 70 64 69 72 20 20 20 et* ((tempdir
e6b0: 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 28 (conc "/tmp/" (
e6c0: 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 6d current-user-nam
e6d0: 65 29 20 22 2f 22 20 28 72 61 6e 64 6f 6d 20 31 e) "/" (random 1
e6e0: 30 30 30 30 29 20 22 5f 22 20 28 63 75 72 72 65 0000) "_" (curre
e6f0: 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 29 nt-process-id)))
e700: 0a 09 09 20 20 20 20 20 20 20 28 6f 75 74 70 75 ... (outpu
e710: 74 66 69 6c 65 20 28 6f 72 20 28 61 72 67 73 3a tfile (or (args:
e720: 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 20 22 6f get-arg "-o") "o
e730: 75 74 2e 6f 64 73 22 29 29 0a 09 09 20 20 20 20 ut.ods"))...
e740: 20 20 20 28 6f 75 66 20 20 20 20 20 20 20 20 28 (ouf (
e750: 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 if (string-match
e760: 20 28 72 65 67 65 78 70 20 22 5e 5b 2f 7e 5d 2b (regexp "^[/~]+
e770: 2e 2a 22 29 20 6f 75 74 70 75 74 66 69 6c 65 29 .*") outputfile)
e780: 20 3b 3b 20 66 75 6c 6c 20 70 61 74 68 3f 0a 09 ;; full path?..
e790: 09 09 09 20 20 20 20 20 20 20 6f 75 74 70 75 74 ... output
e7a0: 66 69 6c 65 0a 09 09 09 09 20 20 20 20 20 20 20 file.....
e7b0: 28 62 65 67 69 6e 0a 09 09 09 09 09 20 28 64 65 (begin...... (de
e7c0: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
e7d0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
e7e0: 57 41 52 4e 49 4e 47 3a 20 70 61 74 68 20 67 69 WARNING: path gi
e7f0: 76 65 6e 2c 20 22 20 6f 75 74 70 75 74 66 69 6c ven, " outputfil
e800: 65 20 22 20 69 73 20 72 65 6c 61 74 69 76 65 2c e " is relative,
e810: 20 70 72 65 66 69 78 69 6e 67 20 77 69 74 68 20 prefixing with
e820: 63 75 72 72 65 6e 74 20 64 69 72 65 63 74 6f 72 current director
e830: 79 22 29 0a 09 09 09 09 09 20 28 63 6f 6e 63 20 y")...... (conc
e840: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
e850: 72 79 29 20 22 2f 22 20 6f 75 74 70 75 74 66 69 ry) "/" outputfi
e860: 6c 65 29 29 29 29 29 0a 09 09 20 20 28 63 72 65 le)))))... (cre
e870: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 ate-directory te
e880: 6d 70 64 69 72 20 23 74 29 0a 09 09 20 20 28 6f mpdir #t)... (o
e890: 64 73 3a 6c 69 73 74 2d 3e 6f 64 73 20 74 65 6d ds:list->ods tem
e8a0: 70 64 69 72 20 6f 75 66 20 73 68 65 65 74 73 29 pdir ouf sheets)
e8b0: 29 29 29 0a 09 20 20 3b 3b 20 28 73 79 73 74 65 ))).. ;; (syste
e8c0: 6d 20 28 63 6f 6e 63 20 22 72 6d 20 2d 72 66 20 m (conc "rm -rf
e8d0: 22 20 74 65 6d 70 64 69 72 29 29 0a 09 20 20 28 " tempdir)).. (
e8e0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
e8f0: 6e 67 2a 20 23 74 29 0a 20 20 20 20 20 20 20 20 ng* #t).
e900: 20 20 28 73 65 74 21 20 2a 74 69 6d 65 2d 74 6f (set! *time-to
e910: 2d 65 78 69 74 2a 20 23 74 29 0a 20 20 20 20 20 -exit* #t).
e920: 20 20 20 20 20 29 20 3b 3b 20 65 6e 64 20 69 66 ) ;; end if
e930: 20 74 72 75 65 20 62 72 61 6e 63 68 20 28 65 6e true branch (en
e940: 64 20 6f 66 20 61 20 6c 65 74 29 0a 20 20 20 20 d of a let).
e950: 20 20 20 20 29 20 3b 3b 20 65 6e 64 20 69 66 0a ) ;; end if.
e960: 20 20 20 20 29 20 3b 3b 20 65 6e 64 20 69 66 20 ) ;; end if
e970: 2d 6c 69 73 74 2d 72 75 6e 73 0a 0a 3b 3b 20 44 -list-runs..;; D
e980: 6f 6e 27 74 20 74 68 69 6e 6b 20 49 20 6e 65 65 on't think I nee
e990: 64 20 74 68 69 73 2e 20 49 6e 63 6f 72 70 6f 72 d this. Incorpor
e9a0: 61 74 65 64 20 69 6e 74 6f 20 2d 6c 69 73 74 2d ated into -list-
e9b0: 72 75 6e 73 20 69 6e 73 74 65 61 64 0a 3b 3b 0a runs instead.;;.
e9c0: 3b 3b 20 28 69 66 20 28 61 6e 64 20 28 61 72 67 ;; (if (and (arg
e9d0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 s:get-arg "-sinc
e9e0: 65 22 29 0a 3b 3b 20 09 20 28 6c 61 75 6e 63 68 e").;; . (launch
e9f0: 3a 73 65 74 75 70 29 29 0a 3b 3b 20 20 20 20 20 :setup)).;;
ea00: 28 6c 65 74 2a 20 28 28 73 69 6e 63 65 2d 74 69 (let* ((since-ti
ea10: 6d 65 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 me (string->numb
ea20: 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 er (args:get-arg
ea30: 20 22 2d 73 69 6e 63 65 22 29 29 29 0a 3b 3b 20 "-since"))).;;
ea40: 09 20 20 20 28 72 75 6e 2d 69 64 73 20 20 20 20 . (run-ids
ea50: 28 64 62 3a 67 65 74 2d 63 68 61 6e 67 65 64 2d (db:get-changed-
ea60: 72 75 6e 2d 69 64 73 20 73 69 6e 63 65 2d 74 69 run-ids since-ti
ea70: 6d 65 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 3b me))).;; ;
ea80: 3b 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 ; (rmt:get-tests
ea90: 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 -for-runs-mindat
eaa0: 61 20 72 75 6e 2d 69 64 73 20 74 65 73 74 70 61 a run-ids testpa
eab0: 74 74 20 73 74 61 74 65 73 20 73 74 61 74 75 73 tt states status
eac0: 20 6e 6f 74 2d 69 6e 29 0a 3b 3b 20 20 20 20 20 not-in).;;
ead0: 20 20 28 70 72 69 6e 74 20 28 73 6f 72 74 20 72 (print (sort r
eae0: 75 6e 2d 69 64 73 20 3c 29 29 0a 3b 3b 20 20 20 un-ids <)).;;
eaf0: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
eb00: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 20 mething* #t))).
eb10: 20 20 20 20 20 0a 20 20 20 20 20 20 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb60: 3d 3d 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 72 75 =====.;; full ru
eb70: 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d n.;;============
eb80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ebb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 ==========..;; g
ebc0: 65 74 20 6c 6f 63 6b 20 69 6e 20 64 62 20 66 6f et lock in db fo
ebd0: 72 20 66 75 6c 6c 20 72 75 6e 20 66 6f 72 20 74 r full run for t
ebe0: 68 69 73 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b his directory.;;
ebf0: 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 20 77 for all tests w
ec00: 69 74 68 20 64 65 70 73 0a 3b 3b 20 20 20 77 61 ith deps.;; wa
ec10: 6c 6b 20 74 72 65 65 20 6f 66 20 74 65 73 74 73 lk tree of tests
ec20: 20 74 6f 20 66 69 6e 64 20 68 65 61 64 20 74 61 to find head ta
ec30: 73 6b 73 0a 3b 3b 20 20 20 61 64 64 20 68 65 61 sks.;; add hea
ec40: 64 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 d tasks to task
ec50: 71 75 65 75 65 0a 3b 3b 20 20 20 61 64 64 20 64 queue.;; add d
ec60: 65 70 65 6e 64 61 6e 74 20 74 61 73 6b 73 20 74 ependant tasks t
ec70: 6f 20 74 61 73 6b 20 71 75 65 75 65 20 0a 3b 3b o task queue .;;
ec80: 20 20 20 61 64 64 20 72 65 6d 61 69 6e 69 6e 67 add remaining
ec90: 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 tasks to task q
eca0: 75 65 75 65 0a 3b 3b 20 66 6f 72 20 65 61 63 68 ueue.;; for each
ecb0: 20 74 61 73 6b 20 69 6e 20 74 61 73 6b 20 71 75 task in task qu
ecc0: 65 75 65 0a 3b 3b 20 20 20 69 66 20 68 61 76 65 eue.;; if have
ecd0: 20 61 64 65 71 75 61 74 65 20 72 65 73 6f 75 72 adequate resour
ece0: 63 65 73 0a 3b 3b 20 20 20 20 20 6c 61 75 6e 63 ces.;; launc
ecf0: 68 20 74 61 73 6b 0a 3b 3b 20 20 20 65 6c 73 65 h task.;; else
ed00: 0a 3b 3b 20 20 20 20 20 70 75 74 20 74 61 73 6b .;; put task
ed10: 20 69 6e 20 64 65 66 65 72 72 65 64 20 71 75 65 in deferred que
ed20: 75 65 0a 3b 3b 20 69 66 20 73 74 69 6c 6c 20 6f ue.;; if still o
ed30: 6b 20 74 6f 20 72 75 6e 20 74 61 73 6b 73 0a 3b k to run tasks.;
ed40: 3b 20 20 20 70 72 6f 63 65 73 73 20 64 65 66 65 ; process defe
ed50: 72 72 65 64 20 74 61 73 6b 73 20 70 65 72 20 61 rred tasks per a
ed60: 62 6f 76 65 20 73 74 65 70 73 0a 0a 3b 3b 20 72 bove steps..;; r
ed70: 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 61 72 65 un all tests are
ed80: 20 61 72 65 20 4e 6f 74 20 43 4f 4d 50 4c 45 54 are Not COMPLET
ed90: 45 44 20 61 6e 64 20 50 41 53 53 20 6f 72 20 43 ED and PASS or C
eda0: 48 45 43 4b 0a 28 69 66 20 28 6f 72 20 28 61 72 HECK.(if (or (ar
edb0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
edc0: 61 6c 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 all")..(args:get
edd0: 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a 09 28 61 -arg "-run")..(a
ede0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
edf0: 72 75 6e 2d 63 6c 65 61 6e 22 29 0a 09 28 61 72 run-clean")..(ar
ee00: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 72 gs:get-arg "-rer
ee10: 75 6e 2d 61 6c 6c 22 29 0a 09 28 61 72 67 73 3a un-all")..(args:
ee20: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 get-arg "-runtes
ee30: 74 73 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 ts")). (gener
ee40: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 al-run-call .
ee50: 20 20 22 2d 72 75 6e 61 6c 6c 22 0a 20 20 20 20 "-runall".
ee60: 20 22 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 22 "run all tests"
ee70: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 . (lambda (t
ee80: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
ee90: 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 ys keyvals).
eea0: 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 (if (args:get
eeb0: 2d 61 72 67 20 22 2d 72 65 72 75 6e 2d 63 6c 65 -arg "-rerun-cle
eec0: 61 6e 22 29 20 3b 3b 20 66 69 72 73 74 20 73 65 an") ;; first se
eed0: 74 20 73 74 61 74 65 73 2f 73 74 61 74 75 73 65 t states/statuse
eee0: 73 20 63 6f 72 72 65 63 74 0a 09 20 20 20 28 6c s correct.. (l
eef0: 65 74 20 28 28 73 74 61 74 65 73 20 20 20 28 6f et ((states (o
ef00: 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 r (configf:looku
ef10: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 76 p *configdat* "v
ef20: 61 6c 69 64 76 61 6c 75 65 73 22 20 22 63 6c 65 alidvalues" "cle
ef30: 61 6e 72 65 72 75 6e 2d 73 74 61 74 65 73 22 29 anrerun-states")
ef40: 0a 09 09 09 20 20 20 20 20 20 20 22 4b 49 4c 4c .... "KILL
ef50: 52 45 51 2c 4b 49 4c 4c 45 44 2c 55 4e 4b 4e 4f REQ,KILLED,UNKNO
ef60: 57 4e 2c 49 4e 43 4f 4d 50 4c 45 54 45 2c 53 54 WN,INCOMPLETE,ST
ef70: 55 43 4b 2c 4e 4f 54 5f 53 54 41 52 54 45 44 22 UCK,NOT_STARTED"
ef80: 29 29 0a 09 09 20 28 73 74 61 74 75 73 65 73 20 ))... (statuses
ef90: 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (or (configf:loo
efa0: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
efb0: 22 76 61 6c 69 64 76 61 6c 75 65 73 22 20 22 63 "validvalues" "c
efc0: 6c 65 61 6e 72 65 72 75 6e 2d 73 74 61 74 75 73 leanrerun-status
efd0: 65 73 22 29 0a 09 09 09 20 20 20 20 20 20 20 22 es").... "
efe0: 46 41 49 4c 2c 49 4e 43 4f 4d 50 4c 45 54 45 2c FAIL,INCOMPLETE,
eff0: 41 42 4f 52 54 2c 43 48 45 43 4b 22 29 29 29 0a ABORT,CHECK"))).
f000: 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c . (hash-tabl
f010: 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 2d e-set! args:arg-
f020: 68 61 73 68 20 22 2d 70 72 65 63 6c 65 61 6e 22 hash "-preclean"
f030: 20 23 74 29 0a 09 20 20 20 20 20 28 72 75 6e 73 #t).. (runs
f040: 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 :operate-on 'set
f050: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a 09 09 -state-status...
f060: 09 20 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 . target...
f070: 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 . (common:a
f080: 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 rgs-get-runname)
f090: 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 ;; (or (args:g
f0a0: 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 et-arg "-runname
f0b0: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
f0c0: 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 ":runname"))....
f0d0: 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 63 6f "%" ;; (co
f0e0: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 mmon:args-get-te
f0f0: 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 stpatt #f) ;; (a
f100: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
f110: 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 stpatt")....
f120: 20 20 73 74 61 74 65 3a 20 20 73 74 61 74 65 73 state: states
f130: 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 73 74 61 .... ;; sta
f140: 74 75 73 3a 20 73 74 61 74 75 73 65 73 0a 09 09 tus: statuses...
f150: 09 20 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 . new-state
f160: 2d 73 74 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 -status: "NOT_ST
f170: 41 52 54 45 44 2c 6e 2f 61 22 29 0a 09 20 20 20 ARTED,n/a")..
f180: 20 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d (runs:operate-
f190: 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 on 'set-state-st
f1a0: 61 74 75 73 0a 09 09 09 20 20 20 20 20 20 74 61 atus.... ta
f1b0: 72 67 65 74 0a 09 09 09 20 20 20 20 20 20 28 63 rget.... (c
f1c0: 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 ommon:args-get-r
f1d0: 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 unname) ;; (or
f1e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
f1f0: 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 runname")(args:g
f200: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
f210: 22 29 29 0a 09 09 09 20 20 20 20 20 20 22 25 22 ")).... "%"
f220: 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 ;; (common:args
f230: 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 -get-testpatt #f
f240: 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 ) ;; (args:get-a
f250: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a rg "-testpatt").
f260: 09 09 09 20 20 20 20 20 20 3b 3b 20 73 74 61 74 ... ;; stat
f270: 65 3a 20 20 73 74 61 74 65 73 0a 09 09 09 20 20 e: states....
f280: 20 20 20 20 73 74 61 74 75 73 3a 20 73 74 61 74 status: stat
f290: 75 73 65 73 0a 09 09 09 20 20 20 20 20 20 6e 65 uses.... ne
f2a0: 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a 20 w-state-status:
f2b0: 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 "NOT_STARTED,n/a
f2c0: 22 29 29 29 0a 20 20 20 20 20 20 20 3b 3b 20 52 "))). ;; R
f2d0: 45 52 55 4e 20 41 4c 4c 0a 20 20 20 20 20 20 20 ERUN ALL.
f2e0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
f2f0: 67 20 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 29 20 g "-rerun-all")
f300: 3b 3b 20 66 69 72 73 74 20 73 65 74 20 73 74 61 ;; first set sta
f310: 74 65 73 2f 73 74 61 74 75 73 65 73 20 63 6f 72 tes/statuses cor
f320: 72 65 63 74 0a 09 20 20 20 28 62 65 67 69 6e 0a rect.. (begin.
f330: 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c . (hash-tabl
f340: 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 2d e-set! args:arg-
f350: 68 61 73 68 20 22 2d 70 72 65 63 6c 65 61 6e 22 hash "-preclean"
f360: 20 23 74 29 0a 09 20 20 20 20 20 28 72 75 6e 73 #t).. (runs
f370: 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 :operate-on 'set
f380: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a 09 09 -state-status...
f390: 09 20 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 . target...
f3a0: 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 . (common:a
f3b0: 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 rgs-get-runname)
f3c0: 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 ;; (or (args:g
f3d0: 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 et-arg "-runname
f3e0: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
f3f0: 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 ":runname"))....
f400: 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 63 6f "%" ;; (co
f410: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 mmon:args-get-te
f420: 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 stpatt #f) ;; (a
f430: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
f440: 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 stpatt")....
f450: 20 20 73 74 61 74 65 3a 20 20 23 66 0a 09 09 09 state: #f....
f460: 20 20 20 20 20 20 3b 3b 20 73 74 61 74 75 73 3a ;; status:
f470: 20 73 74 61 74 75 73 65 73 0a 09 09 09 20 20 20 statuses....
f480: 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 new-state-sta
f490: 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 tus: "NOT_STARTE
f4a0: 44 2c 6e 2f 61 22 29 0a 09 20 20 20 20 20 28 72 D,n/a").. (r
f4b0: 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 uns:operate-on '
f4c0: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
f4d0: 0a 09 09 09 20 20 20 20 20 20 74 61 72 67 65 74 .... target
f4e0: 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f .... (commo
f4f0: 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 n:args-get-runna
f500: 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 me) ;; (or (arg
f510: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
f520: 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 ame")(args:get-a
f530: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a rg ":runname")).
f540: 09 09 09 20 20 20 20 20 20 22 25 22 20 3b 3b 20 ... "%" ;;
f550: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
f560: 2d 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b -testpatt #f) ;;
f570: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
f580: 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 -testpatt")....
f590: 20 20 20 20 20 3b 3b 20 73 74 61 74 65 3a 20 20 ;; state:
f5a0: 73 74 61 74 65 73 0a 09 09 09 20 20 20 20 20 20 states....
f5b0: 73 74 61 74 75 73 3a 20 23 66 0a 09 09 09 20 20 status: #f....
f5c0: 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 new-state-st
f5d0: 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 atus: "NOT_START
f5e0: 45 44 2c 6e 2f 61 22 29 29 29 0a 20 20 20 20 20 ED,n/a"))).
f5f0: 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 (runs:run-test
f600: 73 20 74 61 72 67 65 74 0a 09 09 20 20 20 20 20 s target...
f610: 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 20 20 runname...
f620: 20 20 20 23 66 20 3b 3b 20 28 63 6f 6d 6d 6f 6e #f ;; (common
f630: 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 :args-get-testpa
f640: 74 74 20 23 66 29 0a 09 09 20 20 20 20 20 20 20 tt #f)...
f650: 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 ;; (or (args:get
f660: 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 -arg "-testpatt"
f670: 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 20 20 )... ;;
f680: 20 20 22 25 22 29 0a 09 09 20 20 20 20 20 20 20 "%")...
f690: 75 73 65 72 0a 09 09 20 20 20 20 20 20 20 61 72 user... ar
f6a0: 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 29 0a gs:arg-hash)))).
f6b0: 0a 3b 3b 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 3d 3d 3d ================
f6f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e =========.;; run
f700: 20 6f 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d 3d 3d one test.;;====
f710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f750: 3d 3d 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 20 74 ==..;; 1. find t
f760: 68 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b he config file.;
f770: 3b 20 32 2e 20 63 68 61 6e 67 65 20 74 6f 20 74 ; 2. change to t
f780: 68 65 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 he test director
f790: 79 0a 3b 3b 20 33 2e 20 75 70 64 61 74 65 20 74 y.;; 3. update t
f7a0: 68 65 20 64 62 20 77 69 74 68 20 22 74 65 73 74 he db with "test
f7b0: 20 73 74 61 72 74 65 64 22 20 73 74 61 74 75 73 started" status
f7c0: 2c 20 73 65 74 20 72 75 6e 6e 69 6e 67 20 68 6f , set running ho
f7d0: 73 74 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 73 73 st.;; 4. process
f7e0: 20 6c 61 75 6e 63 68 20 74 68 65 20 74 65 73 74 launch the test
f7f0: 0a 3b 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 6f 72 .;; - monitor
f800: 20 74 68 65 20 70 72 6f 63 65 73 73 2c 20 75 70 the process, up
f810: 64 61 74 65 20 73 74 61 74 73 20 69 6e 20 74 68 date stats in th
f820: 65 20 64 62 20 65 76 65 72 79 20 32 5e 6e 20 6d e db every 2^n m
f830: 69 6e 75 74 65 73 0a 3b 3b 20 35 2e 20 61 73 20 inutes.;; 5. as
f840: 74 68 65 20 74 65 73 74 20 70 72 6f 63 65 65 64 the test proceed
f850: 73 20 69 6e 74 65 72 6e 61 6c 6c 79 20 69 74 20 s internally it
f860: 63 61 6c 6c 73 20 6d 65 67 61 74 65 73 74 20 61 calls megatest a
f870: 73 20 65 61 63 68 20 73 74 65 70 20 69 73 0a 3b s each step is.;
f880: 3b 20 20 20 20 73 74 61 72 74 65 64 20 61 6e 64 ; started and
f890: 20 63 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 20 20 completed.;;
f8a0: 20 2d 20 73 74 65 70 20 73 74 61 72 74 65 64 2c - step started,
f8b0: 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 20 20 timestamp.;;
f8c0: 20 2d 20 73 74 65 70 20 63 6f 6d 70 6c 65 74 65 - step complete
f8d0: 64 2c 20 65 78 69 74 20 73 74 61 74 75 73 2c 20 d, exit status,
f8e0: 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 2e 20 timestamp.;; 6.
f8f0: 74 65 73 74 20 70 68 6f 6e 65 20 68 6f 6d 65 0a test phone home.
f900: 3b 3b 20 20 20 20 2d 20 69 66 20 74 65 73 74 20 ;; - if test
f910: 72 75 6e 20 74 69 6d 65 20 3e 20 61 6c 6c 6f 77 run time > allow
f920: 65 64 20 72 75 6e 20 74 69 6d 65 20 74 68 65 6e ed run time then
f930: 20 6b 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 20 20 kill job.;;
f940: 2d 20 69 66 20 63 61 6e 6e 6f 74 20 61 63 63 65 - if cannot acce
f950: 73 73 20 64 62 20 3e 20 61 6c 6c 6f 77 65 64 20 ss db > allowed
f960: 64 69 73 63 6f 6e 6e 65 63 74 20 74 69 6d 65 20 disconnect time
f970: 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 0a 3b then kill job..;
f980: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
f990: 3d 3d 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 == (if (or (args
f9a0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 :get-arg "-run")
f9b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
f9c0: 72 75 6e 74 65 73 74 73 22 29 29 0a 3b 3b 20 3d runtests")).;; =
f9d0: 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
f9e0: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
f9f0: 61 6c 6c 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 all .;; == dupli
fa00: 63 61 74 65 64 20 3d 3d 20 20 20 20 22 2d 72 75 cated == "-ru
fa10: 6e 74 65 73 74 73 22 20 0a 3b 3b 20 3d 3d 20 64 ntests" .;; == d
fa20: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
fa30: 22 72 75 6e 20 61 20 74 65 73 74 22 20 0a 3b 3b "run a test" .;;
fa40: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
fa50: 3d 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 = (lambda (ta
fa60: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
fa70: 73 20 6b 65 79 76 61 6c 73 29 0a 3b 3b 20 3d 3d s keyvals).;; ==
fa80: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
fa90: 20 20 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 70 ;;.;; == dup
faa0: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 licated ==
fab0: 3b 3b 20 4d 61 79 20 6f 72 20 6d 61 79 20 6e 6f ;; May or may no
fac0: 74 20 69 6d 70 6c 65 6d 65 6e 74 20 69 74 20 74 t implement it t
fad0: 68 69 73 20 77 61 79 20 2e 2e 2e 0a 3b 3b 20 3d his way ....;; =
fae0: 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
faf0: 20 20 20 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 ;;.;; == du
fb00: 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 plicated ==
fb10: 20 3b 3b 20 49 6e 73 65 72 74 20 74 68 69 73 20 ;; Insert this
fb20: 72 75 6e 20 69 6e 74 6f 20 74 68 65 20 74 61 73 run into the tas
fb30: 6b 73 20 71 75 65 75 65 0a 3b 3b 20 3d 3d 20 64 ks queue.;; == d
fb40: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
fb50: 20 20 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 ;; (open-run-c
fb60: 6c 6f 73 65 20 74 61 73 6b 73 3a 61 64 64 20 74 lose tasks:add t
fb70: 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 0a 3b 3b asks:open-db .;;
fb80: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
fb90: 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 = ;; .
fba0: 20 20 20 22 72 75 6e 74 65 73 74 73 22 20 0a 3b "runtests" .;
fbb0: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
fbc0: 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 == ;; .
fbd0: 20 20 20 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 64 user.;; == d
fbe0: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
fbf0: 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 74 61 ;; . ta
fc00: 72 67 65 74 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 rget.;; == dupli
fc10: 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b cated == ;;
fc20: 20 20 20 20 09 20 20 20 20 20 72 75 6e 6e 61 6d . runnam
fc30: 65 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 e.;; == duplicat
fc40: 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 ed == ;;
fc50: 20 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 . (args:get
fc60: 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 -arg "-runtests"
fc70: 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 ).;; == duplicat
fc80: 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 ed == ;;
fc90: 20 09 20 20 20 20 20 23 66 29 29 29 29 0a 3b 3b . #f)))).;;
fca0: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
fcb0: 3d 20 20 20 20 20 20 28 72 75 6e 73 3a 72 75 6e = (runs:run
fcc0: 2d 74 65 73 74 73 20 74 61 72 67 65 74 0a 3b 3b -tests target.;;
fcd0: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
fce0: 3d 20 09 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 = .. runname
fcf0: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
fd00: 64 20 3d 3d 20 09 09 20 20 20 20 20 28 63 6f 6d d == .. (com
fd10: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 mon:args-get-tes
fd20: 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 tpatt #f) ;; (ar
fd30: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
fd40: 74 65 73 74 73 22 29 0a 3b 3b 20 3d 3d 20 64 75 tests").;; == du
fd50: 70 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 20 20 plicated == ..
fd60: 20 20 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 64 75 user.;; == du
fd70: 70 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 20 20 plicated == ..
fd80: 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 args:arg-hash
fd90: 29 29 29 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
fde0: 3b 20 52 6f 6c 6c 75 70 20 69 6e 74 6f 20 61 20 ; Rollup into a
fdf0: 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;==========
fe00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fe10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fe20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fe30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
fe40: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
fe50: 22 2d 72 6f 6c 6c 75 70 22 29 0a 20 20 20 20 28 "-rollup"). (
fe60: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
fe70: 20 0a 20 20 20 20 20 22 2d 72 6f 6c 6c 75 70 22 . "-rollup"
fe80: 20 0a 20 20 20 20 20 22 72 6f 6c 6c 75 70 20 74 . "rollup t
fe90: 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c 61 6d ests" . (lam
fea0: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
feb0: 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 ame keys keyvals
fec0: 29 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a 72 ). (runs:r
fed0: 6f 6c 6c 75 70 2d 72 75 6e 20 6b 65 79 73 0a 09 ollup-run keys..
fee0: 09 09 6b 65 79 76 61 6c 73 0a 09 09 09 28 6f 72 ..keyvals....(or
fef0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
ff00: 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a -runname")(args:
ff10: 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d get-arg ":runnam
ff20: 65 22 29 20 29 0a 09 09 09 75 73 65 72 29 29 29 e") )....user)))
ff30: 29 0a 0a 3b 3b 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 3d 3d 3d 3d 0a 3b 3b 20 4c ===========.;; L
ff80: 6f 63 6b 20 6f 72 20 75 6e 6c 6f 63 6b 20 61 20 ock or unlock a
ff90: 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;==========
ffa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ffb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ffc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ffd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
ffe0: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
fff0: 61 72 67 20 22 2d 6c 6f 63 6b 22 29 28 61 72 67 arg "-lock")(arg
10000 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f s:get-arg "-unlo
10010 63 6b 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 ck")). (gener
10020 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 al-run-call .
10030 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
10040 61 72 67 20 22 2d 6c 6f 63 6b 22 29 20 22 2d 6c arg "-lock") "-l
10050 6f 63 6b 22 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a ock" "-unlock").
10060 20 20 20 20 20 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 "lock/unloc
10070 6b 20 74 65 73 74 73 22 20 0a 20 20 20 20 20 28 k tests" . (
10080 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 lambda (target r
10090 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 unname keys keyv
100a0 61 6c 73 29 0a 20 20 20 20 20 20 20 28 72 75 6e als). (run
100b0 73 3a 68 61 6e 64 6c 65 2d 6c 6f 63 6b 69 6e 67 s:handle-locking
100c0 20 0a 09 09 20 20 74 61 72 67 65 74 0a 09 09 20 ... target...
100d0 20 6b 65 79 73 0a 09 09 20 20 28 6f 72 20 28 61 keys... (or (a
100e0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
100f0 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 nname")(args:get
10100 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 -arg ":runname")
10110 20 29 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 )... (args:get
10120 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 0a 09 09 -arg "-lock")...
10130 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
10140 22 2d 75 6e 6c 6f 63 6b 22 29 0a 09 09 20 20 75 "-unlock")... u
10150 73 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d ser))))..;;=====
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 3d 3d 3d 3d 3d ================
101a0 3d 0a 3b 3b 20 47 65 74 20 70 61 74 68 73 20 74 =.;; Get paths t
101b0 6f 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d o tests.;;======
101c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
101d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
101e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
101f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10200 0a 3b 3b 20 47 65 74 20 74 65 73 74 20 70 61 74 .;; Get test pat
10210 68 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 hs matching targ
10220 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 et, runname, and
10230 20 74 65 73 74 70 61 74 74 0a 28 69 66 20 28 6f testpatt.(if (o
10240 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
10250 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 29 28 61 "-test-files")(a
10260 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
10270 73 74 2d 70 61 74 68 73 22 29 29 0a 20 20 20 20 st-paths")).
10280 3b 3b 20 69 66 20 77 65 20 61 72 65 20 69 6e 20 ;; if we are in
10290 61 20 74 65 73 74 20 75 73 65 20 74 68 65 20 4d a test use the M
102a0 54 5f 43 4d 44 49 4e 46 4f 20 64 61 74 61 0a 20 T_CMDINFO data.
102b0 20 20 20 28 69 66 20 28 67 65 74 65 6e 76 20 22 (if (getenv "
102c0 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 0a 09 28 6c MT_CMDINFO")..(l
102d0 65 74 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69 et* ((startingdi
102e0 72 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 r (current-direc
102f0 74 6f 72 79 29 29 0a 09 20 20 20 20 20 20 20 28 tory)).. (
10300 63 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f cmdinfo (commo
10310 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 n:read-encoded-s
10320 74 72 69 6e 67 20 28 67 65 74 65 6e 76 20 22 4d tring (getenv "M
10330 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 20 T_CMDINFO")))..
10340 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 (transport
10350 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
10360 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 'transport cmdin
10370 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 fo)).. (te
10380 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 stpath (assoc/d
10390 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 efault 'testpath
103a0 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
103b0 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 (test-name (
103c0 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
103d0 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f est-name cmdinfo
103e0 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 )).. (runs
103f0 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 cript (assoc/def
10400 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 ault 'runscript
10410 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
10420 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 (db-host (as
10430 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d soc/default 'db-
10440 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 host cmdinfo))
10450 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 .. (run-id
10460 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 (assoc/defau
10470 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d lt 'run-id cm
10480 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
10490 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f (itemdat (asso
104a0 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 c/default 'itemd
104b0 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 at cmdinfo))..
104c0 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 (state
104d0 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
104e0 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 ":state"))..
104f0 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 61 (status (a
10500 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
10510 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 atus"))..
10520 28 74 61 72 67 65 74 20 20 20 20 28 61 72 67 73 (target (args
10530 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 :get-arg "-targe
10540 74 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 6f t")).. (to
10550 70 70 61 74 68 20 20 20 28 61 73 73 6f 63 2f 64 ppath (assoc/d
10560 65 66 61 75 6c 74 20 27 74 6f 70 70 61 74 68 20 efault 'toppath
10570 20 20 63 6d 64 69 6e 66 6f 29 29 29 0a 09 20 20 cmdinfo)))..
10580 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
10590 79 20 74 6f 70 70 61 74 68 29 0a 09 20 20 28 69 y toppath).. (i
105a0 66 20 28 6e 6f 74 20 74 61 72 67 65 74 29 0a 09 f (not target)..
105b0 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 (begin...(
105c0 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
105d0 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
105e0 2d 70 6f 72 74 2a 20 22 2d 74 61 72 67 65 74 20 -port* "-target
105f0 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 0a 09 is required.")..
10600 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 .(exit 1))).. (
10610 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a if (not (launch:
10620 73 65 74 75 70 29 29 0a 09 20 20 20 20 20 20 28 setup)).. (
10630 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 begin...(debug:p
10640 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
10650 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 log-port* "Faile
10660 64 20 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 d to setup, givi
10670 6e 67 20 75 70 20 6f 6e 20 2d 74 65 73 74 2d 70 ng up on -test-p
10680 61 74 68 73 20 6f 72 20 2d 74 65 73 74 2d 66 69 aths or -test-fi
10690 6c 65 73 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 les, exiting")..
106a0 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 .(exit 1))).. (
106b0 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 20 20 let* ((keys
106c0 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 0a (rmt:get-keys)).
106d0 09 09 20 3b 3b 20 64 62 3a 74 65 73 74 2d 67 65 .. ;; db:test-ge
106e0 74 2d 70 61 74 68 73 20 6d 75 73 74 20 6e 6f 74 t-paths must not
106f0 20 62 65 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 be run remote..
10700 09 20 28 70 61 74 68 73 20 20 20 20 28 74 65 73 . (paths (tes
10710 74 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 ts:test-get-path
10720 73 2d 6d 61 74 63 68 69 6e 67 20 6b 65 79 73 20 s-matching keys
10730 74 61 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 target (args:get
10740 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 -arg "-test-file
10750 73 22 29 29 29 29 0a 09 20 20 20 20 28 73 65 74 s")))).. (set
10760 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
10770 20 23 74 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 #t).. (for-e
10780 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 74 ach (lambda (pat
10790 68 29 0a 09 09 09 28 69 66 20 28 66 69 6c 65 2d h)....(if (file-
107a0 65 78 69 73 74 73 3f 20 70 61 74 68 29 0a 09 09 exists? path)...
107b0 09 28 70 72 69 6e 74 20 70 61 74 68 29 29 29 09 .(print path))).
107c0 0a 09 09 20 20 20 20 20 20 70 61 74 68 73 29 29 ... paths))
107d0 29 0a 09 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 )..;; else do a
107e0 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
107f0 0a 09 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 ..(general-run-c
10800 61 6c 6c 20 0a 09 20 22 2d 74 65 73 74 2d 66 69 all .. "-test-fi
10810 6c 65 73 22 0a 09 20 22 47 65 74 20 70 61 74 68 les".. "Get path
10820 73 20 74 6f 20 74 65 73 74 22 0a 09 20 28 6c 61 s to test".. (la
10830 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
10840 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c name keys keyval
10850 73 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 64 s).. (let* ((d
10860 62 20 20 20 20 20 20 20 23 66 29 0a 09 09 20 20 b #f)...
10870 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 ;; DO NOT run re
10880 6d 6f 74 65 0a 09 09 20 20 28 70 61 74 68 73 20 mote... (paths
10890 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 67 (tests:test-g
108a0 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e et-paths-matchin
108b0 67 20 6b 65 79 73 20 74 61 72 67 65 74 20 28 61 g keys target (a
108c0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
108d0 73 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 st-files"))))..
108e0 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
108f0 61 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 ambda (path)....
10900 20 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 (print path))..
10910 09 20 20 20 20 20 20 20 70 61 74 68 73 29 29 29 . paths)))
10920 29 29 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
10970 20 41 72 63 68 69 76 65 20 74 65 73 74 73 0a 3b Archive tests.;
10980 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
10990 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109c0 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 =======.;; Archi
109d0 76 65 20 74 65 73 74 73 20 6d 61 74 63 68 69 6e ve tests matchin
109e0 67 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d g target, runnam
109f0 65 2c 20 61 6e 64 20 74 65 73 74 70 61 74 74 0a e, and testpatt.
10a00 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
10a10 67 20 22 2d 61 72 63 68 69 76 65 22 29 0a 20 20 g "-archive").
10a20 20 20 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 67 ;; else do a g
10a30 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a eneral-run-call.
10a40 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e (general-run
10a50 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 61 72 -call . "-ar
10a60 63 68 69 76 65 22 0a 20 20 20 20 20 22 41 72 63 chive". "Arc
10a70 68 69 76 65 22 0a 20 20 20 20 20 28 6c 61 6d 62 hive". (lamb
10a80 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 da (target runna
10a90 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 me keys keyvals)
10aa0 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 . (operate
10ab0 2d 6f 6e 20 27 61 72 63 68 69 76 65 29 29 29 29 -on 'archive))))
10ac0 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
10ad0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 45 78 ==========.;; Ex
10b10 74 72 61 63 74 20 61 20 73 70 72 65 61 64 73 68 tract a spreadsh
10b20 65 65 74 20 66 72 6f 6d 20 74 68 65 20 72 75 6e eet from the run
10b30 73 20 64 61 74 61 62 61 73 65 0a 3b 3b 3d 3d 3d s database.;;===
10b40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b80 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
10b90 65 74 2d 61 72 67 20 22 2d 65 78 74 72 61 63 74 et-arg "-extract
10ba0 2d 6f 64 73 22 29 0a 20 20 20 20 28 67 65 6e 65 -ods"). (gene
10bb0 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 ral-run-call.
10bc0 20 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 "-extract-ods"
10bd0 0a 20 20 20 20 20 22 4d 61 6b 65 20 6f 64 73 20 . "Make ods
10be0 73 70 72 65 61 64 73 68 65 65 74 22 0a 20 20 20 spreadsheet".
10bf0 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 (lambda (targe
10c00 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
10c10 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 eyvals). (
10c20 6c 65 74 20 28 28 64 62 73 74 72 75 63 74 20 20 let ((dbstruct
10c30 20 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 (make-dbr:dbstr
10c40 75 63 74 20 70 61 74 68 3a 20 2a 74 6f 70 70 61 uct path: *toppa
10c50 74 68 2a 20 6c 6f 63 61 6c 3a 20 23 74 29 29 0a th* local: #t)).
10c60 09 20 20 20 20 20 28 6f 75 74 70 75 74 66 69 6c . (outputfil
10c70 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 e (args:get-arg
10c80 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 29 "-extract-ods"))
10c90 0a 09 20 20 20 20 20 28 72 75 6e 73 70 61 74 74 .. (runspatt
10ca0 20 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 (or (args:get
10cb0 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 -arg "-runname")
10cc0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
10cd0 72 75 6e 6e 61 6d 65 22 29 29 29 0a 09 20 20 20 runname")))..
10ce0 20 20 28 70 61 74 68 6d 6f 64 20 20 20 20 28 61 (pathmod (a
10cf0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 61 rgs:get-arg "-pa
10d00 74 68 6d 6f 64 22 29 29 29 0a 09 20 20 20 20 20 thmod")))..
10d10 3b 3b 20 28 6b 65 79 76 61 6c 61 6c 69 73 74 20 ;; (keyvalalist
10d20 28 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 79 (keys->alist key
10d30 73 20 22 25 22 29 29 29 0a 09 20 28 64 65 62 75 s "%"))).. (debu
10d40 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 75 g:print 2 *defau
10d50 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 78 lt-log-port* "Ex
10d60 74 72 61 63 74 20 6f 64 73 2c 20 6f 75 74 70 75 tract ods, outpu
10d70 74 66 69 6c 65 3a 20 22 20 6f 75 74 70 75 74 66 tfile: " outputf
10d80 69 6c 65 20 22 20 72 75 6e 73 70 61 74 74 3a 20 ile " runspatt:
10d90 22 20 72 75 6e 73 70 61 74 74 20 22 20 6b 65 79 " runspatt " key
10da0 76 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 29 vals: " keyvals)
10db0 0a 09 20 28 64 62 3a 65 78 74 72 61 63 74 2d 6f .. (db:extract-o
10dc0 64 73 2d 66 69 6c 65 20 64 62 73 74 72 75 63 74 ds-file dbstruct
10dd0 20 6f 75 74 70 75 74 66 69 6c 65 20 6b 65 79 76 outputfile keyv
10de0 61 6c 73 20 28 69 66 20 72 75 6e 73 70 61 74 74 als (if runspatt
10df0 20 72 75 6e 73 70 61 74 74 20 22 25 22 29 20 70 runspatt "%") p
10e00 61 74 68 6d 6f 64 29 0a 09 20 28 64 62 3a 63 6c athmod).. (db:cl
10e10 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 ose-all dbstruct
10e20 29 0a 09 20 28 73 65 74 21 20 2a 64 69 64 73 6f ).. (set! *didso
10e30 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 29 mething* #t)))))
10e40 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
10e50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10e60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10e70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10e80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 ==========.;; ex
10e90 65 63 75 74 65 20 74 68 65 20 74 65 73 74 0a 3b ecute the test.;
10ea0 3b 20 20 20 20 2d 20 67 65 74 73 20 63 61 6c 6c ; - gets call
10eb0 65 64 20 6f 6e 20 72 65 6d 6f 74 65 20 68 6f 73 ed on remote hos
10ec0 74 0a 3b 3b 20 20 20 20 2d 20 72 65 63 65 69 76 t.;; - receiv
10ed0 65 73 20 69 6e 66 6f 20 66 72 6f 6d 20 74 68 65 es info from the
10ee0 20 2d 65 78 65 63 75 74 65 20 70 61 72 61 6d 0a -execute param.
10ef0 3b 3b 20 20 20 20 2d 20 70 61 73 73 65 73 20 69 ;; - passes i
10f00 6e 66 6f 20 74 6f 20 73 74 65 70 73 20 76 69 61 nfo to steps via
10f10 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 MT_CMDINFO env
10f20 76 61 72 20 28 66 75 74 75 72 65 20 69 73 20 74 var (future is t
10f30 6f 20 75 73 65 20 61 20 64 6f 74 20 66 69 6c 65 o use a dot file
10f40 29 0a 3b 3b 20 20 20 20 2d 20 67 61 74 68 65 72 ).;; - gather
10f50 73 20 68 6f 73 74 20 69 6e 66 6f 20 61 6e 64 20 s host info and
10f60 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
10f70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10f80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10f90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10fa0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
10fb0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
10fc0 78 65 63 75 74 65 22 29 0a 20 20 20 20 28 62 65 xecute"). (be
10fd0 67 69 6e 0a 20 20 20 20 20 20 28 6c 61 75 6e 63 gin. (launc
10fe0 68 3a 65 78 65 63 75 74 65 20 28 61 72 67 73 3a h:execute (args:
10ff0 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 get-arg "-execut
11000 65 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 e")). (set!
11010 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
11020 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d #t)))..;;=======
11030 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11040 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11050 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11060 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
11070 3b 3b 20 72 65 63 6f 76 65 72 20 66 72 6f 6d 20 ;; recover from
11080 61 20 74 65 73 74 20 77 68 65 72 65 20 74 68 65 a test where the
11090 20 6d 61 6e 61 67 69 6e 67 20 6d 74 65 73 74 20 managing mtest
110a0 77 61 73 20 6b 69 6c 6c 65 64 20 62 75 74 20 74 was killed but t
110b0 68 65 20 75 6e 64 65 72 6c 79 69 6e 67 0a 3b 3b he underlying.;;
110c0 20 70 72 6f 63 65 73 73 20 6d 69 67 68 74 20 73 process might s
110d0 74 69 6c 6c 20 62 65 20 73 61 6c 76 61 67 65 61 till be salvagea
110e0 62 6c 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ble.;;==========
110f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11100 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11110 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11120 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
11130 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
11140 22 2d 72 65 63 6f 76 65 72 2d 74 65 73 74 22 29 "-recover-test")
11150 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 70 61 72 . (let* ((par
11160 61 6d 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 ams (string-spli
11170 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
11180 22 2d 72 65 63 6f 76 65 72 2d 74 65 73 74 22 29 "-recover-test")
11190 20 22 2c 22 29 29 29 0a 20 20 20 20 20 20 28 69 ","))). (i
111a0 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 72 f (> (length par
111b0 61 6d 73 29 20 31 29 20 3b 3b 20 72 75 6e 2d 69 ams) 1) ;; run-i
111c0 64 20 61 6e 64 20 74 65 73 74 2d 69 64 0a 09 20 d and test-id..
111d0 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 28 (let ((run-id (
111e0 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
111f0 63 61 72 20 70 61 72 61 6d 73 29 29 29 0a 09 09 car params)))...
11200 28 74 65 73 74 2d 69 64 20 28 73 74 72 69 6e 67 (test-id (string
11210 2d 3e 6e 75 6d 62 65 72 20 28 63 61 64 72 20 70 ->number (cadr p
11220 61 72 61 6d 73 29 29 29 29 0a 09 20 20 20 20 28 arams)))).. (
11230 69 66 20 28 61 6e 64 20 72 75 6e 2d 69 64 20 74 if (and run-id t
11240 65 73 74 2d 69 64 29 0a 09 09 28 62 65 67 69 6e est-id)...(begin
11250 0a 09 09 20 20 28 6c 61 75 6e 63 68 3a 72 65 63 ... (launch:rec
11260 6f 76 65 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 over-test run-id
11270 20 74 65 73 74 2d 69 64 29 0a 09 09 20 20 28 73 test-id)... (s
11280 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
11290 67 2a 20 23 74 29 29 0a 09 09 28 62 65 67 69 6e g* #t))...(begin
112a0 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
112b0 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
112c0 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 62 61 lt-log-port* "ba
112d0 64 20 72 75 6e 2d 69 64 20 6f 72 20 74 65 73 74 d run-id or test
112e0 2d 69 64 2c 20 6d 75 73 74 20 62 65 20 69 6e 74 -id, must be int
112f0 65 67 65 72 73 22 29 0a 09 09 20 20 28 65 78 69 egers")... (exi
11300 74 20 31 29 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d t 1)))))))..;;==
11310 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 54 65 73 74 20 63 6f 6d ====.;; Test com
11360 6d 61 6e 64 73 20 28 69 2e 65 2e 20 66 6f 72 20 mands (i.e. for
11370 75 73 65 20 69 6e 73 69 64 65 20 74 65 73 74 73 use inside tests
11380 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ).;;============
11390 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
113a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
113b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
113c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 ==========..(def
113d0 69 6e 65 20 28 6d 65 67 61 74 65 73 74 3a 73 74 ine (megatest:st
113e0 65 70 20 73 74 65 70 20 73 74 61 74 65 20 73 74 ep step state st
113f0 61 74 75 73 20 6c 6f 67 66 69 6c 65 20 6d 73 67 atus logfile msg
11400 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 ). (if (not (ge
11410 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
11420 22 29 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e ")). (begin
11430 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 ..(debug:print-e
11440 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
11450 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 54 5f 43 4d log-port* "MT_CM
11460 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f DINFO env var no
11470 74 20 73 65 74 2c 20 2d 73 74 65 70 20 6d 75 73 t set, -step mus
11480 74 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 t be called *ins
11490 69 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 ide* a megatest
114a0 69 6e 76 6f 6b 65 64 20 65 6e 76 69 72 6f 6e 6d invoked environm
114b0 65 6e 74 21 22 29 0a 09 28 65 78 69 74 20 35 29 ent!")..(exit 5)
114c0 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ). (let* ((
114d0 63 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f cmdinfo (commo
114e0 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 n:read-encoded-s
114f0 74 72 69 6e 67 20 28 67 65 74 65 6e 76 20 22 4d tring (getenv "M
11500 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 20 T_CMDINFO")))..
11510 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 (transport (
11520 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
11530 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f ransport cmdinfo
11540 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 70 61 )).. (testpa
11550 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 th (assoc/defau
11560 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 6d lt 'testpath cm
11570 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 dinfo)).. (t
11580 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f est-name (assoc/
11590 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 default 'test-na
115a0 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 me cmdinfo))..
115b0 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 (runscript (a
115c0 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
115d0 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 nscript cmdinfo)
115e0 29 0a 09 20 20 20 20 20 28 64 62 2d 68 6f 73 74 ).. (db-host
115f0 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
11600 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 t 'db-host cmd
11610 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 75 info)).. (ru
11620 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 n-id (assoc/d
11630 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 efault 'run-id
11640 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
11650 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 73 (test-id (as
11660 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
11670 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 t-id cmdinfo))
11680 0a 09 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 .. (itemdat
11690 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
116a0 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 'itemdat cmdi
116b0 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 77 6f 72 nfo)).. (wor
116c0 6b 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 65 k-area (assoc/de
116d0 66 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 fault 'work-area
116e0 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
116f0 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 29 (db #f))
11700 0a 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 ..(change-direct
11710 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 28 ory testpath)..(
11720 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a if (not (launch:
11730 73 65 74 75 70 29 29 0a 09 20 20 20 20 28 62 65 setup)).. (be
11740 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 gin.. (debu
11750 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
11760 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 lt-log-port* "Fa
11770 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 iled to setup, e
11780 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 20 xiting")..
11790 28 65 78 69 74 20 31 29 29 29 0a 09 28 69 66 20 (exit 1)))..(if
117a0 28 61 6e 64 20 73 74 61 74 65 20 73 74 61 74 75 (and state statu
117b0 73 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 63 s).. (let ((c
117c0 6f 6d 6d 65 6e 74 20 28 6c 61 75 6e 63 68 3a 6c omment (launch:l
117d0 6f 61 64 2d 6c 6f 67 70 72 6f 2d 64 61 74 20 72 oad-logpro-dat r
117e0 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 un-id test-id st
117f0 65 70 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 ep))).. ;;
11800 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f (rmt:test-set-lo
11810 67 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 g! run-id test-i
11820 64 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 d (conc stepname
11830 20 22 2e 68 74 6d 6c 22 29 29 29 29 0a 09 20 20 ".html"))))..
11840 20 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 65 (rmt:testste
11850 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 p-set-status! ru
11860 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 n-id test-id ste
11870 70 20 73 74 61 74 65 20 73 74 61 74 75 73 20 28 p state status (
11880 6f 72 20 63 6f 6d 6d 65 6e 74 20 6d 73 67 29 20 or comment msg)
11890 6c 6f 67 66 69 6c 65 29 29 0a 09 20 20 20 20 28 logfile)).. (
118a0 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 begin.. (de
118b0 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
118c0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
118d0 6f 72 74 2a 20 22 59 6f 75 20 6d 75 73 74 20 73 ort* "You must s
118e0 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 6e pecify :state an
118f0 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 65 d :status with e
11900 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 73 74 very call to -st
11910 65 70 22 29 0a 09 20 20 20 20 20 20 28 65 78 69 ep").. (exi
11920 74 20 36 29 29 29 29 29 29 0a 0a 28 69 66 20 28 t 6))))))..(if (
11930 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
11940 74 65 70 22 29 0a 20 20 20 20 28 62 65 67 69 6e tep"). (begin
11950 0a 20 20 20 20 20 20 28 6d 65 67 61 74 65 73 74 . (megatest
11960 3a 73 74 65 70 20 0a 20 20 20 20 20 20 20 28 61 :step . (a
11970 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
11980 65 70 22 29 0a 20 20 20 20 20 20 20 28 6f 72 20 ep"). (or
11990 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
119a0 73 74 61 74 65 22 29 28 61 72 67 73 3a 67 65 74 state")(args:get
119b0 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a -arg ":state")).
119c0 20 20 20 20 20 20 20 28 6f 72 20 28 61 72 67 73 (or (args
119d0 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 75 :get-arg "-statu
119e0 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 s")(args:get-arg
119f0 20 22 3a 73 74 61 74 75 73 22 29 29 0a 20 20 20 ":status")).
11a00 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
11a10 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a 20 20 20 g "-setlog").
11a20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
11a30 67 20 22 2d 6d 22 29 29 0a 20 20 20 20 20 20 3b g "-m")). ;
11a40 3b 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 65 ; (if db (sqlite
11a50 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 3:finalize! db))
11a60 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
11a70 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
11a80 29 0a 20 20 20 20 0a 28 69 66 20 28 6f 72 20 28 ). .(if (or (
11a90 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
11aa0 65 74 6c 6f 67 22 29 20 20 20 20 20 20 20 3b 3b etlog") ;;
11ab0 20 73 69 6e 63 65 20 73 65 74 74 69 6e 67 20 75 since setting u
11ac0 70 20 69 73 20 73 6f 20 63 6f 73 74 6c 79 20 6c p is so costly l
11ad0 65 74 73 20 70 69 67 67 79 62 61 63 6b 20 6f 6e ets piggyback on
11ae0 20 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 09 3b -test-status..;
11af0 3b 20 20 20 20 20 28 6e 6f 74 20 28 61 72 67 73 ; (not (args
11b00 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 :get-arg "-step"
11b10 29 29 29 20 20 3b 3b 20 2d 73 65 74 6c 6f 67 20 ))) ;; -setlog
11b20 6d 61 79 20 68 61 76 65 20 62 65 65 6e 20 70 72 may have been pr
11b30 6f 63 65 73 73 65 64 20 61 6c 72 65 61 64 79 20 ocessed already
11b40 69 6e 20 74 68 65 20 22 2d 73 74 65 70 22 20 70 in the "-step" p
11b50 72 65 76 69 6f 75 73 0a 09 3b 3b 20 20 20 20 20 revious..;;
11b60 4e 45 57 20 50 4f 4c 49 43 59 20 2d 20 2d 73 65 NEW POLICY - -se
11b70 74 6c 6f 67 20 73 65 74 73 20 74 65 73 74 20 6f tlog sets test o
11b80 76 65 72 61 6c 6c 20 6c 6f 67 20 6f 6e 20 65 76 verall log on ev
11b90 65 72 79 20 63 61 6c 6c 2e 0a 09 28 61 72 67 73 ery call...(args
11ba0 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 :get-arg "-set-t
11bb0 6f 70 6c 6f 67 22 29 0a 09 28 61 72 67 73 3a 67 oplog")..(args:g
11bc0 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 et-arg "-test-st
11bd0 61 74 75 73 22 29 0a 09 28 61 72 67 73 3a 67 65 atus")..(args:ge
11be0 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 t-arg "-set-valu
11bf0 65 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d es")..(args:get-
11c00 61 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d arg "-load-test-
11c10 64 61 74 61 22 29 0a 09 28 61 72 67 73 3a 67 65 data")..(args:ge
11c20 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 t-arg "-runstep"
11c30 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
11c40 20 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 "-summarize-ite
11c50 6d 73 22 29 29 0a 20 20 20 20 28 69 66 20 28 6e ms")). (if (n
11c60 6f 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 ot (getenv "MT_C
11c70 4d 44 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 MDINFO"))..(begi
11c80 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e n.. (debug:prin
11c90 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
11ca0 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 54 lt-log-port* "MT
11cb0 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 _CMDINFO env var
11cc0 20 6e 6f 74 20 73 65 74 2c 20 63 6f 6d 6d 61 6e not set, comman
11cd0 64 73 20 2d 74 65 73 74 2d 73 74 61 74 75 73 2c ds -test-status,
11ce0 20 2d 72 75 6e 73 74 65 70 20 61 6e 64 20 2d 73 -runstep and -s
11cf0 65 74 6c 6f 67 20 6d 75 73 74 20 62 65 20 63 61 etlog must be ca
11d00 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 lled *inside* a
11d10 6d 65 67 61 74 65 73 74 20 65 6e 76 69 72 6f 6e megatest environ
11d20 6d 65 6e 74 21 22 29 0a 09 20 20 28 65 78 69 74 ment!").. (exit
11d30 20 35 29 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 5))..(let* ((st
11d40 61 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 65 artingdir (curre
11d50 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 nt-directory))..
11d60 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 (cmdinfo
11d70 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 (common:read-e
11d80 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 67 ncoded-string (g
11d90 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
11da0 4f 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 O"))).. (t
11db0 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f ransport (assoc/
11dc0 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f default 'transpo
11dd0 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 rt cmdinfo))..
11de0 20 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 (testpath
11df0 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
11e00 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 testpath cmdinf
11e10 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 o)).. (tes
11e20 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 t-name (assoc/de
11e30 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 fault 'test-name
11e40 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
11e50 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 (runscript (a
11e60 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
11e70 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 nscript cmdinfo)
11e80 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f ).. (db-ho
11e90 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 st (assoc/defa
11ea0 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 ult 'db-host c
11eb0 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
11ec0 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 (run-id (ass
11ed0 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d oc/default 'run-
11ee0 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a id cmdinfo)).
11ef0 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 64 . (test-id
11f00 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
11f10 74 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 t 'test-id cmd
11f20 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
11f30 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 itemdat (assoc
11f40 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 /default 'itemda
11f50 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
11f60 20 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 (work-area
11f70 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
11f80 27 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 'work-area cmdin
11f90 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 fo)).. (db
11fa0 20 20 20 20 20 20 20 20 23 66 29 20 3b 3b 20 28 #f) ;; (
11fb0 6f 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 20 open-db))..
11fc0 20 20 28 73 74 61 74 65 20 20 20 20 20 28 61 72 (state (ar
11fd0 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
11fe0 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 te")).. (s
11ff0 74 61 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 tatus (args:g
12000 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 et-arg ":status"
12010 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 65 70 )).. (step
12020 6e 61 6d 65 20 20 28 61 72 67 73 3a 67 65 74 2d name (args:get-
12030 61 72 67 20 22 2d 73 74 65 70 22 29 29 29 0a 09 arg "-step")))..
12040 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e (if (not (laun
12050 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 20 20 ch:setup))..
12060 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 (begin...(debu
12070 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
12080 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 lt-log-port* "Fa
12090 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 iled to setup, e
120a0 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 xiting")...(exit
120b0 20 31 29 29 29 0a 0a 09 20 20 28 69 66 20 28 61 1)))... (if (a
120c0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
120d0 6e 73 74 65 70 22 29 28 64 65 62 75 67 3a 70 72 nstep")(debug:pr
120e0 69 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 61 int-info 1 *defa
120f0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 ult-log-port* "R
12100 75 6e 6e 69 6e 67 20 2d 72 75 6e 73 74 65 70 2c unning -runstep,
12110 20 66 69 72 73 74 20 63 68 61 6e 67 65 20 74 6f first change to
12120 20 64 69 72 65 63 74 6f 72 79 20 22 20 77 6f 72 directory " wor
12130 6b 2d 61 72 65 61 29 29 0a 09 20 20 28 63 68 61 k-area)).. (cha
12140 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f nge-directory wo
12150 72 6b 2d 61 72 65 61 29 0a 09 20 20 3b 3b 20 63 rk-area).. ;; c
12160 61 6e 20 73 65 74 75 70 20 61 73 20 63 6c 69 65 an setup as clie
12170 6e 74 20 66 6f 72 20 73 65 72 76 65 72 20 6d 6f nt for server mo
12180 64 65 20 6e 6f 77 0a 09 20 20 3b 3b 20 28 63 6c de now.. ;; (cl
12190 69 65 6e 74 3a 73 65 74 75 70 29 0a 0a 09 20 20 ient:setup)...
121a0 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
121b0 67 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 g "-load-test-da
121c0 74 61 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 68 ta").. ;; h
121d0 61 73 20 73 75 62 20 63 6f 6d 6d 61 6e 64 73 20 as sub commands
121e0 74 68 61 74 20 61 72 65 20 72 64 62 3a 0a 09 20 that are rdb:..
121f0 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 70 ;; DO NOT p
12200 75 74 20 74 68 69 73 20 6f 6e 65 20 69 6e 74 6f ut this one into
12210 20 65 69 74 68 65 72 20 72 6d 74 3a 20 6f 72 20 either rmt: or
12220 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 0a 09 open-run-close..
12230 20 20 20 20 20 20 28 74 64 62 3a 6c 6f 61 64 2d (tdb:load-
12240 74 65 73 74 2d 64 61 74 61 20 72 75 6e 2d 69 64 test-data run-id
12250 20 74 65 73 74 2d 69 64 29 29 0a 09 20 20 28 69 test-id)).. (i
12260 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
12270 22 2d 73 65 74 6c 6f 67 22 29 0a 09 20 20 20 20 "-setlog")..
12280 20 20 28 6c 65 74 20 28 28 6c 6f 67 66 6e 61 6d (let ((logfnam
12290 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 e (args:get-arg
122a0 22 2d 73 65 74 6c 6f 67 22 29 29 29 0a 09 09 28 "-setlog")))...(
122b0 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 rmt:test-set-log
122c0 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
122d0 20 6c 6f 67 66 6e 61 6d 65 29 29 29 0a 09 20 20 logfname)))..
122e0 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
122f0 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 g "-set-toplog")
12300 0a 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f .. ;; DO NO
12310 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 T run remote..
12320 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d (tests:test-
12330 73 65 74 2d 74 6f 70 6c 6f 67 21 20 72 75 6e 2d set-toplog! run-
12340 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 28 61 72 id test-name (ar
12350 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
12360 2d 74 6f 70 6c 6f 67 22 29 29 29 0a 09 20 20 28 -toplog"))).. (
12370 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
12380 20 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 "-summarize-ite
12390 6d 73 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 44 ms").. ;; D
123a0 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 O NOT run remote
123b0 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 3a 73 .. (tests:s
123c0 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 72 ummarize-items r
123d0 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 un-id test-id te
123e0 73 74 2d 6e 61 6d 65 20 23 74 29 29 20 3b 3b 20 st-name #t)) ;;
123f0 64 6f 20 66 6f 72 63 65 20 68 65 72 65 0a 09 20 do force here..
12400 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
12410 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 rg "-runstep")..
12420 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f (if (null?
12430 20 72 65 6d 61 72 67 73 29 0a 09 09 20 20 28 62 remargs)... (b
12440 65 67 69 6e 0a 09 09 20 20 20 20 28 64 65 62 75 egin... (debu
12450 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
12460 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
12470 74 2a 20 22 6e 6f 74 68 69 6e 67 20 73 70 65 63 t* "nothing spec
12480 69 66 69 65 64 20 74 6f 20 72 75 6e 21 22 29 0a ified to run!").
12490 09 09 20 20 20 20 28 69 66 20 64 62 20 28 73 71 .. (if db (sq
124a0 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
124b0 64 62 29 29 0a 09 09 20 20 20 20 28 65 78 69 74 db))... (exit
124c0 20 36 29 29 0a 09 09 20 20 28 6c 65 74 2a 20 28 6))... (let* (
124d0 28 73 74 65 70 6e 61 6d 65 20 20 20 28 61 72 67 (stepname (arg
124e0 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 s:get-arg "-runs
124f0 74 65 70 22 29 29 0a 09 09 09 20 28 6c 6f 67 70 tep")).... (logp
12500 72 6f 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 rofile (args:get
12510 2d 61 72 67 20 22 2d 6c 6f 67 70 72 6f 22 29 29 -arg "-logpro"))
12520 0a 09 09 09 20 28 6c 6f 67 66 69 6c 65 20 20 20 .... (logfile
12530 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
12540 22 2e 6c 6f 67 22 29 29 0a 09 09 09 20 28 63 6d ".log")).... (cm
12550 64 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 d (if (nu
12560 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 23 66 20 ll? remargs) #f
12570 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 0a (car remargs))).
12580 09 09 09 20 28 70 61 72 61 6d 73 20 20 20 20 20 ... (params
12590 28 69 66 20 63 6d 64 20 28 63 64 72 20 72 65 6d (if cmd (cdr rem
125a0 61 72 67 73 29 20 27 28 29 29 29 0a 09 09 09 20 args) '()))....
125b0 28 65 78 69 74 73 74 61 74 20 20 20 23 66 29 0a (exitstat #f).
125c0 09 09 09 20 28 73 68 65 6c 6c 20 20 20 20 20 20 ... (shell
125d0 28 6c 65 74 20 28 28 73 68 20 28 67 65 74 2d 65 (let ((sh (get-e
125e0 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
125f0 62 6c 65 20 22 53 48 45 4c 4c 22 29 20 29 29 0a ble "SHELL") )).
12600 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 73 .... (if s
12610 68 20 0a 09 09 09 09 09 20 20 20 28 6c 61 73 74 h ...... (last
12620 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 73 (string-split s
12630 68 20 22 2f 22 29 29 0a 09 09 09 09 09 20 20 20 h "/"))......
12640 22 62 61 73 68 22 29 29 29 0a 09 09 09 20 28 72 "bash"))).... (r
12650 65 64 69 72 20 20 20 20 20 20 28 63 61 73 65 20 edir (case
12660 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
12670 73 68 65 6c 6c 29 0a 09 09 09 09 20 20 20 20 20 shell).....
12680 20 20 28 28 74 63 73 68 20 63 73 68 20 6b 73 68 ((tcsh csh ksh
12690 29 20 20 20 20 22 3e 26 22 29 0a 09 09 09 09 20 ) ">&").....
126a0 20 20 20 20 20 20 28 28 7a 73 68 20 62 61 73 68 ((zsh bash
126b0 20 73 68 20 61 73 68 29 20 22 32 3e 26 31 20 3e sh ash) "2>&1 >
126c0 22 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 65 ")..... (e
126d0 6c 73 65 20 22 3e 26 22 29 29 29 0a 09 09 09 20 lse ">&")))....
126e0 28 66 75 6c 6c 63 6d 64 20 20 20 20 28 63 6f 6e (fullcmd (con
126f0 63 20 22 28 22 20 28 73 74 72 69 6e 67 2d 69 6e c "(" (string-in
12700 74 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 09 tersperse ......
12710 09 28 63 6f 6e 73 20 63 6d 64 20 70 61 72 61 6d .(cons cmd param
12720 73 29 20 22 20 22 29 0a 09 09 09 09 09 20 20 20 s) " ")......
12730 22 29 20 22 20 72 65 64 69 72 20 22 20 22 20 6c ") " redir " " l
12740 6f 67 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 ogfile)))...
12750 3b 3b 20 6d 61 72 6b 20 74 68 65 20 73 74 61 72 ;; mark the star
12760 74 20 6f 66 20 74 68 65 20 74 65 73 74 0a 09 09 t of the test...
12770 20 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 65 (rmt:testste
12780 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 p-set-status! ru
12790 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 n-id test-id ste
127a0 70 6e 61 6d 65 20 22 73 74 61 72 74 22 20 22 6e pname "start" "n
127b0 2f 61 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 /a" (args:get-ar
127c0 67 20 22 2d 6d 22 29 20 6c 6f 67 66 69 6c 65 29 g "-m") logfile)
127d0 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 74 68 ... ;; run th
127e0 65 20 74 65 73 74 20 73 74 65 70 0a 09 09 20 20 e test step...
127f0 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
12800 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 2 *default-l
12810 6f 67 2d 70 6f 72 74 2a 20 22 52 75 6e 6e 69 6e og-port* "Runnin
12820 67 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 5c g \"" fullcmd "\
12830 22 20 69 6e 20 64 69 72 65 63 74 6f 72 79 20 5c " in directory \
12840 22 22 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a "" startingdir).
12850 09 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 .. (change-di
12860 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 rectory starting
12870 64 69 72 29 0a 09 09 20 20 20 20 28 73 65 74 21 dir)... (set!
12880 20 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65 exitstat (syste
12890 6d 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 20 20 m fullcmd))...
128a0 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 (set! *globale
128b0 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 74 73 xitstatus* exits
128c0 74 61 74 29 0a 09 09 20 20 20 20 3b 3b 20 28 63 tat)... ;; (c
128d0 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
128e0 74 65 73 74 70 61 74 68 29 0a 09 09 20 20 20 20 testpath)...
128f0 3b 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 66 ;; run logpro if
12900 20 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b 20 28 applicable ;; (
12910 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c 73 22 process-run "ls"
12920 20 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20 22 32 (list "/foo" "2
12930 3e 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67 22 29 >&1" "blah.log")
12940 29 0a 09 09 20 20 20 20 28 69 66 20 6c 6f 67 70 )... (if logp
12950 72 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74 2a 20 rofile....(let*
12960 28 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 28 63 ((htmllogfile (c
12970 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 onc stepname ".h
12980 74 6d 6c 22 29 29 0a 09 09 09 20 20 20 20 20 20 tml"))....
12990 20 28 6f 6c 64 65 78 69 74 73 74 61 74 20 65 78 (oldexitstat ex
129a0 69 74 73 74 61 74 29 0a 09 09 09 20 20 20 20 20 itstat)....
129b0 20 20 28 63 6d 64 20 20 20 20 20 20 20 20 20 28 (cmd (
129c0 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
129d0 73 65 20 28 6c 69 73 74 20 22 6c 6f 67 70 72 6f se (list "logpro
129e0 22 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68 74 6d " logprofile htm
129f0 6c 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c 6f 67 llogfile "<" log
12a00 66 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63 20 73 file ">" (conc s
12a10 74 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70 72 6f tepname "_logpro
12a20 2e 6c 6f 67 22 29 29 20 22 20 22 29 29 29 0a 09 .log")) " ")))..
12a30 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
12a40 2d 69 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 -info 2 *default
12a50 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 75 6e 6e -log-port* "runn
12a60 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 ing \"" cmd "\""
12a70 29 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 ).... (change-d
12a80 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e irectory startin
12a90 67 64 69 72 29 0a 09 09 09 20 20 28 73 65 74 21 gdir).... (set!
12aa0 20 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65 exitstat (syste
12ab0 6d 20 63 6d 64 29 29 0a 09 09 09 20 20 28 73 65 m cmd)).... (se
12ac0 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 t! *globalexitst
12ad0 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 20 atus* exitstat)
12ae0 3b 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 0a ;; no necessary.
12af0 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 ... (change-dir
12b00 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 ectory testpath)
12b10 0a 09 09 09 20 20 28 72 6d 74 3a 74 65 73 74 2d .... (rmt:test-
12b20 73 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 set-log! run-id
12b30 74 65 73 74 2d 69 64 20 68 74 6d 6c 6c 6f 67 66 test-id htmllogf
12b40 69 6c 65 29 29 29 0a 09 09 20 20 20 20 28 6c 65 ile)))... (le
12b50 74 20 28 28 6d 73 67 20 28 61 72 67 73 3a 67 65 t ((msg (args:ge
12b60 74 2d 61 72 67 20 22 2d 6d 22 29 29 29 0a 09 09 t-arg "-m")))...
12b70 20 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 73 (rmt:tests
12b80 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 tep-set-status!
12b90 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 run-id test-id s
12ba0 74 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 78 tepname "end" ex
12bb0 69 74 73 74 61 74 20 6d 73 67 20 6c 6f 67 66 69 itstat msg logfi
12bc0 6c 65 29 29 0a 09 09 20 20 20 20 29 29 29 0a 09 le))... )))..
12bd0 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a (if (or (args:
12be0 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 get-arg "-test-s
12bf0 74 61 74 75 73 22 29 0a 09 09 20 20 28 61 72 67 tatus")... (arg
12c00 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
12c10 76 61 6c 75 65 73 22 29 29 0a 09 20 20 20 20 20 values"))..
12c20 20 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 75 (let ((newstatu
12c30 73 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e 75 s (cond.....((nu
12c40 6d 62 65 72 3f 20 73 74 61 74 75 73 29 20 20 20 mber? status)
12c50 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 (if (equal?
12c60 73 74 61 74 75 73 20 30 29 20 22 50 41 53 53 22 status 0) "PASS"
12c70 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 28 "FAIL")).....((
12c80 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 74 61 and (string? sta
12c90 74 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 28 tus)..... (
12ca0 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 string->number s
12cb0 74 61 74 75 73 29 29 28 69 66 20 28 65 71 75 61 tatus))(if (equa
12cc0 6c 3f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 l? (string->numb
12cd0 65 72 20 73 74 61 74 75 73 29 20 30 29 20 22 50 er status) 0) "P
12ce0 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 09 ASS" "FAIL"))...
12cf0 09 09 28 65 6c 73 65 20 73 74 61 74 75 73 29 29 ..(else status))
12d00 29 0a 09 09 20 20 20 20 3b 3b 20 74 72 61 6e 73 )... ;; trans
12d10 66 65 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 79 fer relevant key
12d20 73 20 69 6e 74 6f 20 61 20 68 61 73 68 20 74 6f s into a hash to
12d30 20 62 65 20 70 61 73 73 65 64 20 74 6f 20 74 65 be passed to te
12d40 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a 09 st-set-status!..
12d50 09 20 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 73 . ;; could us
12d60 65 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 20 e an assoc list
12d70 49 20 67 75 65 73 73 2e 20 0a 09 09 20 20 20 20 I guess. ...
12d80 28 6f 74 68 65 72 64 61 74 61 20 28 6c 65 74 20 (otherdata (let
12d90 28 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 68 ((res (make-hash
12da0 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 09 20 28 -table)))..... (
12db0 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
12dc0 20 28 6b 65 79 29 0a 09 09 09 09 09 20 20 20 20 (key)......
12dd0 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
12de0 72 67 20 6b 65 79 29 0a 09 09 09 09 09 09 20 28 rg key)....... (
12df0 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
12e00 72 65 73 20 6b 65 79 20 28 61 72 67 73 3a 67 65 res key (args:ge
12e10 74 2d 61 72 67 20 6b 65 79 29 29 29 29 0a 09 09 t-arg key))))...
12e20 09 09 09 20 20 20 28 6c 69 73 74 20 22 3a 76 61 ... (list ":va
12e30 6c 75 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 78 lue" ":tol" ":ex
12e40 70 65 63 74 65 64 22 20 22 3a 66 69 72 73 74 5f pected" ":first_
12e50 65 72 72 22 20 22 3a 66 69 72 73 74 5f 77 61 72 err" ":first_war
12e60 6e 22 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 61 n" ":units" ":ca
12e70 74 65 67 6f 72 79 22 20 22 3a 76 61 72 69 61 62 tegory" ":variab
12e80 6c 65 22 29 29 0a 09 09 09 09 20 72 65 73 29 29 le"))..... res))
12e90 29 0a 09 09 28 69 66 20 28 61 6e 64 20 28 61 72 )...(if (and (ar
12ea0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
12eb0 74 2d 73 74 61 74 75 73 22 29 0a 09 09 09 20 28 t-status").... (
12ec0 6f 72 20 28 6e 6f 74 20 73 74 61 74 65 29 0a 09 or (not state)..
12ed0 09 09 20 20 20 20 20 28 6e 6f 74 20 73 74 61 74 .. (not stat
12ee0 75 73 29 29 29 0a 09 09 20 20 20 20 28 62 65 67 us)))... (beg
12ef0 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 in... (debu
12f00 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
12f10 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
12f20 74 2a 20 22 59 6f 75 20 6d 75 73 74 20 73 70 65 t* "You must spe
12f30 63 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 20 cify :state and
12f40 3a 73 74 61 74 75 73 20 77 69 74 68 20 65 76 65 :status with eve
12f50 72 79 20 63 61 6c 6c 20 74 6f 20 2d 74 65 73 74 ry call to -test
12f60 2d 73 74 61 74 75 73 5c 6e 22 20 68 65 6c 70 29 -status\n" help)
12f70 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 73 71 ... (if (sq
12f80 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 lite3:database?
12f90 64 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 db)(sqlite3:fina
12fa0 6c 69 7a 65 21 20 64 62 29 29 0a 09 09 20 20 20 lize! db))...
12fb0 20 20 20 28 65 78 69 74 20 36 29 29 29 0a 09 09 (exit 6)))...
12fc0 28 6c 65 74 2a 20 28 28 6d 73 67 20 20 20 20 28 (let* ((msg (
12fd0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
12fe0 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 6e 75 "))... (nu
12ff0 6d 6f 74 68 20 28 6c 65 6e 67 74 68 20 28 68 61 moth (length (ha
13000 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 6f 74 sh-table-keys ot
13010 68 65 72 64 61 74 61 29 29 29 29 0a 09 09 20 20 herdata))))...
13020 3b 3b 20 43 6f 6e 76 65 72 74 20 74 6f 20 72 70 ;; Convert to rp
13030 63 20 69 6e 73 69 64 65 20 74 68 65 20 74 65 73 c inside the tes
13040 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ts:test-set-stat
13050 75 73 21 20 63 61 6c 6c 2c 20 6e 6f 74 20 68 65 us! call, not he
13060 72 65 0a 09 09 20 20 28 74 65 73 74 73 3a 74 65 re... (tests:te
13070 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 st-set-status! r
13080 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 un-id test-id st
13090 61 74 65 20 6e 65 77 73 74 61 74 75 73 20 6d 73 ate newstatus ms
130a0 67 20 6f 74 68 65 72 64 61 74 61 20 77 6f 72 6b g otherdata work
130b0 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 61 -area: work-area
130c0 29 29 29 29 0a 09 20 20 28 69 66 20 28 73 71 6c )))).. (if (sql
130d0 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 64 ite3:database? d
130e0 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c b)(sqlite3:final
130f0 69 7a 65 21 20 64 62 29 29 0a 09 20 20 28 73 65 ize! db)).. (se
13100 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
13110 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d * #t))))..;;====
13120 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 56 61 72 69 6f 75 73 20 68 65 ==.;; Various he
13170 6c 70 65 72 20 63 6f 6d 6d 61 6e 64 73 20 63 61 lper commands ca
13180 6e 20 67 6f 20 62 65 6c 6f 77 20 68 65 72 65 0a n go below here.
13190 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
131a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131d0 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f ========..(if (o
131e0 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
131f0 22 2d 73 68 6f 77 6b 65 79 73 22 29 0a 20 20 20 "-showkeys").
13200 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
13210 72 67 20 22 2d 73 68 6f 77 2d 6b 65 79 73 22 29 rg "-show-keys")
13220 29 0a 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 ). (let ((db
13230 23 66 29 0a 09 20 20 28 6b 65 79 73 20 23 66 29 #f).. (keys #f)
13240 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 ). (if (not
13250 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
13260 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
13270 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
13280 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
13290 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
132a0 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 up, exiting")..
132b0 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))).
132c0 20 20 20 20 28 73 65 74 21 20 6b 65 79 73 20 28 (set! keys (
132d0 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 20 3b rmt:get-keys)) ;
132e0 3b 20 20 64 62 29 29 0a 20 20 20 20 20 20 28 64 ; db)). (d
132f0 65 62 75 67 3a 70 72 69 6e 74 20 31 20 2a 64 65 ebug:print 1 *de
13300 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
13310 22 4b 65 79 73 3a 20 22 20 28 73 74 72 69 6e 67 "Keys: " (string
13320 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 -intersperse key
13330 73 20 22 2c 20 22 29 29 0a 20 20 20 20 20 20 28 s ", ")). (
13340 69 66 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 if (sqlite3:data
13350 62 61 73 65 3f 20 64 62 29 28 73 71 6c 69 74 65 base? db)(sqlite
13360 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 3:finalize! db))
13370 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
13380 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
13390 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
133a0 2d 61 72 67 20 22 2d 67 75 69 22 29 0a 20 20 20 -arg "-gui").
133b0 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 64 (begin. (d
133c0 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
133d0 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
133e0 22 4c 6f 6f 6b 20 61 74 20 74 68 65 20 64 61 73 "Look at the das
133f0 68 62 6f 61 72 64 20 66 6f 72 20 6e 6f 77 22 29 hboard for now")
13400 0a 20 20 20 20 20 20 3b 3b 20 28 6d 65 67 61 74 . ;; (megat
13410 65 73 74 2d 67 75 69 29 0a 20 20 20 20 20 20 28 est-gui). (
13420 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
13430 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 ng* #t)))..(if (
13440 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 args:get-arg "-c
13450 72 65 61 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 reate-megatest-a
13460 72 65 61 22 29 0a 20 20 20 20 28 62 65 67 69 6e rea"). (begin
13470 0a 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 . (genexamp
13480 6c 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2e 63 le:mk-megatest.c
13490 6f 6e 66 69 67 29 0a 20 20 20 20 20 20 28 73 65 onfig). (se
134a0 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
134b0 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 * #t)))..(if (ar
134c0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 72 65 gs:get-arg "-cre
134d0 61 74 65 2d 74 65 73 74 22 29 0a 20 20 20 20 28 ate-test"). (
134e0 6c 65 74 20 28 28 74 65 73 74 6e 61 6d 65 20 28 let ((testname (
134f0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 args:get-arg "-c
13500 72 65 61 74 65 2d 74 65 73 74 22 29 29 29 0a 20 reate-test"))).
13510 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 (genexample
13520 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 :mk-megatest-tes
13530 74 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 20 20 t testname).
13540 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
13550 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
13560 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13570 3d 3d 3d 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 0a 3b 3b 20 55 70 64 61 74 65 ======.;; Update
135b0 20 74 68 65 20 64 61 74 61 62 61 73 65 20 73 63 the database sc
135c0 68 65 6d 61 2c 20 63 6c 65 61 6e 20 75 70 20 74 hema, clean up t
135d0 68 65 20 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d he db.;;========
135e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
135f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13600 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13610 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
13620 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
13630 67 20 22 2d 72 65 62 75 69 6c 64 2d 64 62 22 29 g "-rebuild-db")
13640 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
13650 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e (if (not (laun
13660 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 ch:setup)).. (b
13670 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 egin.. (debug
13680 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
13690 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
136a0 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
136b0 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 iting") .. (e
136c0 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 3b xit 1))). ;
136d0 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 ; keep this one
136e0 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 6f 70 65 local. (ope
136f0 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 70 61 74 63 n-run-close patc
13700 68 2d 64 62 20 23 66 29 0a 20 20 20 20 20 20 28 h-db #f). (
13710 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
13720 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 ng* #t)))..(if (
13730 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 args:get-arg "-c
13740 6c 65 61 6e 75 70 2d 64 62 22 29 0a 20 20 20 20 leanup-db").
13750 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 (begin. (if
13760 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
13770 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a tup)).. (begin.
13780 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
13790 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
137a0 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 -port* "Failed t
137b0 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
137c0 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 ") .. (exit 1
137d0 29 29 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 ))). (let (
137e0 28 64 62 73 74 72 75 63 74 20 28 64 62 3a 73 65 (dbstruct (db:se
137f0 74 75 70 20 2a 74 6f 70 70 61 74 68 2a 29 29 29 tup *toppath*)))
13800 0a 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e . (common
13810 3a 63 6c 65 61 6e 75 70 2d 64 62 20 64 62 73 74 :cleanup-db dbst
13820 72 75 63 74 29 29 0a 20 20 20 20 20 20 28 73 65 ruct)). (se
13830 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
13840 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 * #t)))..(if (ar
13850 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 61 72 gs:get-arg "-mar
13860 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 22 29 0a k-incompletes").
13870 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
13880 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 (if (not (launc
13890 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 65 h:setup)).. (be
138a0 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a gin.. (debug:
138b0 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
138c0 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c -log-port* "Fail
138d0 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
138e0 74 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 69 ting").. (exi
138f0 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 6f 70 t 1))). (op
13900 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a en-run-close db:
13910 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e find-and-mark-in
13920 63 6f 6d 70 6c 65 74 65 20 23 66 29 0a 20 20 20 complete #f).
13930 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
13940 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b ething* #t)))..;
13950 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
13960 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 55 70 64 61 74 =======.;; Updat
139a0 65 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 61 e the tests meta
139b0 20 64 61 74 61 20 66 72 6f 6d 20 74 68 65 20 74 data from the t
139c0 65 73 74 63 6f 6e 66 69 67 20 66 69 6c 65 73 0a estconfig files.
139d0 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
139e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
139f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13a00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13a10 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
13a20 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 70 rgs:get-arg "-up
13a30 64 61 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 20 date-meta").
13a40 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 (begin. (if
13a50 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
13a60 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a tup)).. (begin.
13a70 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
13a80 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
13a90 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 -port* "Failed t
13aa0 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
13ab0 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 ") .. (exit 1
13ac0 29 29 29 0a 20 20 20 20 20 20 28 72 75 6e 73 3a ))). (runs:
13ad0 75 70 64 61 74 65 2d 61 6c 6c 2d 74 65 73 74 5f update-all-test_
13ae0 6d 65 74 61 20 23 66 29 0a 20 20 20 20 20 20 28 meta #f). (
13af0 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
13b00 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d ng* #t)))..;;===
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 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b50 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 61 20 72 ===.;; Start a r
13b60 65 70 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d epl.;;==========
13b70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ba0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
13bb0 20 66 61 6b 65 6f 75 74 20 72 65 61 64 6c 69 6e fakeout readlin
13bc0 65 0a 28 69 6e 63 6c 75 64 65 20 22 72 65 61 64 e.(include "read
13bd0 6c 69 6e 65 2d 66 69 78 2e 73 63 6d 22 29 0a 0a line-fix.scm")..
13be0 0a 28 77 68 65 6e 20 28 61 72 67 73 3a 67 65 74 .(when (args:get
13bf0 2d 61 72 67 20 22 2d 64 69 66 66 2d 72 65 70 22 -arg "-diff-rep"
13c00 29 0a 20 20 28 77 68 65 6e 20 28 61 6e 64 0a 20 ). (when (and.
13c10 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 61 72 (not (ar
13c20 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 69 66 gs:get-arg "-dif
13c30 66 2d 68 74 6d 6c 22 29 29 0a 20 20 20 20 20 20 f-html")).
13c40 20 20 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 (not (args:ge
13c50 74 2d 61 72 67 20 22 2d 64 69 66 66 2d 65 6d 61 t-arg "-diff-ema
13c60 69 6c 22 29 29 29 0a 20 20 20 20 28 64 65 62 75 il"))). (debu
13c70 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
13c80 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 75 lt-log-port* "Mu
13c90 73 74 20 73 70 65 63 69 66 79 20 2d 64 69 66 66 st specify -diff
13ca0 2d 68 74 6d 6c 20 6f 72 20 2d 64 69 66 66 2d 65 -html or -diff-e
13cb0 6d 61 69 6c 20 77 69 74 68 20 2d 64 69 66 66 2d mail with -diff-
13cc0 72 65 70 22 29 0a 20 20 20 20 28 73 65 74 21 20 rep"). (set!
13cd0 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 31 *didsomething* 1
13ce0 29 0a 20 20 20 20 28 65 78 69 74 20 31 29 29 0a ). (exit 1)).
13cf0 20 20 0a 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 . (let* ((top
13d00 70 61 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 path (launch:set
13d10 75 70 29 29 29 0a 20 20 20 20 28 64 6f 2d 64 69 up))). (do-di
13d20 66 66 2d 72 65 70 6f 72 74 0a 20 20 20 20 20 28 ff-report. (
13d30 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
13d40 72 63 2d 74 61 72 67 65 74 22 29 0a 20 20 20 20 rc-target").
13d50 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
13d60 2d 73 72 63 2d 72 75 6e 6e 61 6d 65 22 29 0a 20 -src-runname").
13d70 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
13d80 67 20 22 2d 74 61 72 67 65 74 22 29 0a 20 20 20 g "-target").
13d90 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
13da0 22 2d 72 75 6e 6e 61 6d 65 22 29 0a 20 20 20 20 "-runname").
13db0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
13dc0 2d 64 69 66 66 2d 68 74 6d 6c 22 29 0a 20 20 20 -diff-html").
13dd0 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
13de0 22 2d 64 69 66 66 2d 65 6d 61 69 6c 22 29 29 0a "-diff-email")).
13df0 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
13e00 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 20 20 20 mething* #t).
13e10 20 28 65 78 69 74 20 30 29 29 29 0a 0a 28 69 66 (exit 0)))..(if
13e20 20 28 6f 72 20 28 67 65 74 65 6e 76 20 22 4d 54 (or (getenv "MT
13e30 5f 52 55 4e 53 43 52 49 50 54 22 29 0a 09 28 61 _RUNSCRIPT")..(a
13e40 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
13e50 70 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d pl")..(args:get-
13e60 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 0a 20 20 arg "-load")).
13e70 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 (let* ((toppat
13e80 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 h (launch:setup)
13e90 29 0a 09 20 20 20 28 64 62 73 74 72 75 63 74 20 ).. (dbstruct
13ea0 28 69 66 20 28 61 6e 64 20 74 6f 70 70 61 74 68 (if (and toppath
13eb0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
13ec0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
13ed0 63 6f 6d 6d 6f 6e 3a 6f 6e 2d 68 6f 6d 65 68 6f common:on-homeho
13ee0 73 74 3f 29 29 0a 20 20 20 20 20 20 20 20 20 20 st?)).
13ef0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
13f00 64 62 3a 73 65 74 75 70 29 0a 20 20 20 20 20 20 db:setup).
13f10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13f20 20 20 20 23 66 29 29 29 20 3b 3b 20 6d 61 6b 65 #f))) ;; make
13f30 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 -dbr:dbstruct pa
13f40 74 68 3a 20 74 6f 70 70 61 74 68 20 6c 6f 63 61 th: toppath loca
13f50 6c 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 l: (args:get-arg
13f60 20 22 2d 6c 6f 63 61 6c 22 29 29 20 23 66 29 29 "-local")) #f))
13f70 29 0a 20 20 20 20 20 20 28 69 66 20 2a 74 6f 70 ). (if *top
13f80 70 61 74 68 2a 0a 09 20 20 28 63 6f 6e 64 0a 09 path*.. (cond..
13f90 20 20 20 28 28 67 65 74 65 6e 76 20 22 4d 54 5f ((getenv "MT_
13fa0 52 55 4e 53 43 52 49 50 54 22 29 0a 09 20 20 20 RUNSCRIPT")..
13fb0 20 3b 3b 20 48 6f 77 20 74 6f 20 72 75 6e 20 6d ;; How to run m
13fc0 65 67 61 74 65 73 74 20 73 63 72 69 70 74 73 0a egatest scripts.
13fd0 09 20 20 20 20 3b 3b 0a 09 20 20 20 20 3b 3b 20 . ;;.. ;;
13fe0 23 21 2f 62 69 6e 2f 62 61 73 68 0a 09 20 20 20 #!/bin/bash..
13ff0 20 3b 3b 0a 09 20 20 20 20 3b 3b 20 65 78 70 6f ;;.. ;; expo
14000 72 74 20 4d 54 5f 52 55 4e 53 43 52 49 50 54 3d rt MT_RUNSCRIPT=
14010 79 65 73 0a 09 20 20 20 20 3b 3b 20 6d 65 67 61 yes.. ;; mega
14020 74 65 73 74 20 3c 3c 20 45 4f 46 0a 09 20 20 20 test << EOF..
14030 20 3b 3b 20 28 70 72 69 6e 74 20 22 48 65 6c 6c ;; (print "Hell
14040 6f 20 77 6f 72 6c 64 22 29 0a 09 20 20 20 20 3b o world").. ;
14050 3b 20 28 65 78 69 74 29 0a 09 20 20 20 20 3b 3b ; (exit).. ;;
14060 20 45 4f 46 0a 0a 09 20 20 20 20 28 72 65 70 6c EOF... (repl
14070 29 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 20 20 )).. (else..
14080 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
14090 28 73 65 74 21 20 2a 64 62 2a 20 64 62 73 74 72 (set! *db* dbstr
140a0 75 63 74 29 0a 09 20 20 20 20 20 20 28 69 6d 70 uct).. (imp
140b0 6f 72 74 20 65 78 74 72 61 73 29 20 3b 3b 20 6d ort extras) ;; m
140c0 69 67 68 74 20 6e 6f 74 20 62 65 20 6e 65 65 64 ight not be need
140d0 65 64 0a 09 20 20 20 20 20 20 3b 3b 20 28 69 6d ed.. ;; (im
140e0 70 6f 72 74 20 63 73 69 29 0a 09 20 20 20 20 20 port csi)..
140f0 20 28 69 6d 70 6f 72 74 20 72 65 61 64 6c 69 6e (import readlin
14100 65 29 0a 09 20 20 20 20 20 20 28 69 6d 70 6f 72 e).. (impor
14110 74 20 61 70 72 6f 70 6f 73 29 0a 09 20 20 20 20 t apropos)..
14120 20 20 3b 3b 20 28 69 6d 70 6f 72 74 20 28 70 72 ;; (import (pr
14130 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c efix sqlite3 sql
14140 69 74 65 33 3a 29 29 20 3b 3b 20 64 6f 65 73 6e ite3:)) ;; doesn
14150 27 74 20 77 6f 72 6b 20 2e 2e 2e 0a 0a 09 20 20 't work ......
14160 20 20 20 20 28 69 66 20 2a 75 73 65 2d 6e 65 77 (if *use-new
14170 2d 72 65 61 64 6c 69 6e 65 2a 0a 09 09 20 20 28 -readline*... (
14180 62 65 67 69 6e 0a 09 09 20 20 20 20 28 69 6e 73 begin... (ins
14190 74 61 6c 6c 2d 68 69 73 74 6f 72 79 2d 66 69 6c tall-history-fil
141a0 65 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 e (get-environme
141b0 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f 4d nt-variable "HOM
141c0 45 22 29 20 22 2e 6d 65 67 61 74 65 73 74 5f 68 E") ".megatest_h
141d0 69 73 74 6f 72 79 22 29 20 3b 3b 20 20 5b 68 6f istory") ;; [ho
141e0 6d 65 64 69 72 5d 20 5b 66 69 6c 65 6e 61 6d 65 medir] [filename
141f0 5d 20 5b 6e 6c 69 6e 65 73 5d 29 0a 09 09 20 20 ] [nlines])...
14200 20 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 (current-input
14210 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 72 65 61 64 -port (make-read
14220 6c 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 line-port "megat
14230 65 73 74 3e 20 22 29 29 29 0a 09 09 20 20 28 62 est> ")))... (b
14240 65 67 69 6e 0a 09 09 20 20 20 20 28 67 6e 75 2d egin... (gnu-
14250 68 69 73 74 6f 72 79 2d 69 6e 73 74 61 6c 6c 2d history-install-
14260 66 69 6c 65 2d 6d 61 6e 61 67 65 72 0a 09 09 20 file-manager...
14270 20 20 20 20 28 73 74 72 69 6e 67 2d 61 70 70 65 (string-appe
14280 6e 64 0a 09 09 20 20 20 20 20 20 28 6f 72 20 28 nd... (or (
14290 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
142a0 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 variable "HOME")
142b0 20 22 2e 22 29 20 22 2f 2e 6d 65 67 61 74 65 73 ".") "/.megates
142c0 74 5f 68 69 73 74 6f 72 79 22 29 29 0a 09 09 20 t_history"))...
142d0 20 20 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 (current-inpu
142e0 74 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 67 6e 75 t-port (make-gnu
142f0 2d 72 65 61 64 6c 69 6e 65 2d 70 6f 72 74 20 22 -readline-port "
14300 6d 65 67 61 74 65 73 74 3e 20 22 29 29 29 29 0a megatest> ")))).
14310 09 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 . (if (args
14320 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 :get-arg "-repl"
14330 29 0a 09 09 20 20 28 72 65 70 6c 29 0a 09 09 20 )... (repl)...
14340 20 28 6c 6f 61 64 20 28 61 72 67 73 3a 67 65 74 (load (args:get
14350 2d 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 29 0a -arg "-load"))).
14360 09 20 20 20 20 20 20 3b 3b 20 28 64 62 3a 63 6c . ;; (db:cl
14370 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 ose-all dbstruct
14380 29 20 3c 3d 20 74 61 6b 65 6e 20 63 61 72 65 20 ) <= taken care
14390 6f 66 20 62 79 20 6f 6e 2d 65 78 69 74 20 63 61 of by on-exit ca
143a0 6c 6c 0a 09 20 20 20 20 20 20 29 0a 09 20 20 20 ll.. )..
143b0 20 28 65 78 69 74 29 29 29 0a 09 20 20 28 73 65 (exit))).. (se
143c0 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
143d0 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d * #t))))..;;====
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 0a 3b 3b 20 57 61 69 74 20 6f 6e 20 61 20 ==.;; Wait on a
14430 72 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 65 0a run to complete.
14440 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
14450 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14460 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14470 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14480 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
14490 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 nd (args:get-arg
144a0 20 22 2d 72 75 6e 2d 77 61 69 74 22 29 0a 09 20 "-run-wait")..
144b0 28 6e 6f 74 20 28 6f 72 20 28 61 72 67 73 3a 67 (not (or (args:g
144c0 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a 09 et-arg "-run")..
144d0 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 . (args:get-arg
144e0 20 22 2d 72 75 6e 74 65 73 74 73 22 29 29 29 29 "-runtests"))))
144f0 20 3b 3b 20 72 75 6e 2d 77 61 69 74 20 69 73 20 ;; run-wait is
14500 62 75 69 6c 74 20 69 6e 74 6f 20 72 75 6e 74 65 built into runte
14510 73 74 73 20 6e 6f 77 0a 20 20 20 20 28 62 65 67 sts now. (beg
14520 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f in. (if (no
14530 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 t (launch:setup)
14540 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 ).. (begin..
14550 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
14560 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
14570 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 t* "Failed to se
14580 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a tup, exiting") .
14590 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a . (exit 1))).
145a0 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d 6f (operate-o
145b0 6e 20 27 72 75 6e 2d 77 61 69 74 29 0a 20 20 20 n 'run-wait).
145c0 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
145d0 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b ething* #t)))..;
145e0 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
145f0 3b 3b 20 4e 6f 74 20 63 6f 6e 76 65 72 74 65 64 ;; Not converted
14600 20 74 6f 20 75 73 65 20 64 62 73 74 72 75 63 74 to use dbstruct
14610 20 79 65 74 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 yet.;; ;; ;; re
14620 64 6f 20 6d 65 20 3b 3b 0a 3b 3b 20 3b 3b 20 3b do me ;;.;; ;; ;
14630 3b 20 72 65 64 6f 20 6d 65 20 28 69 66 20 28 61 ; redo me (if (a
14640 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f rgs:get-arg "-co
14650 6e 76 65 72 74 2d 74 6f 2d 6e 6f 72 6d 22 29 0a nvert-to-norm").
14660 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
14670 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 (let* ((top
14680 70 61 74 68 20 28 73 65 74 75 70 2d 66 6f 72 2d path (setup-for-
14690 72 75 6e 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 run)).;; ;; ;; r
146a0 65 64 6f 20 6d 65 20 09 20 20 20 28 64 62 73 74 edo me . (dbst
146b0 72 75 63 74 20 28 69 66 20 74 6f 70 70 61 74 68 ruct (if toppath
146c0 20 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 (make-dbr:dbstr
146d0 75 63 74 20 70 61 74 68 3a 20 74 6f 70 70 61 74 uct path: toppat
146e0 68 20 6c 6f 63 61 6c 3a 20 23 74 29 29 29 29 0a h local: #t)))).
146f0 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
14700 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 (for-each
14710 20 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 .;; ;; ;; redo
14720 6d 65 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 me (lambd
14730 61 20 28 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 a (field).;; ;;
14740 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 28 6c 65 ;; redo me . (le
14750 74 20 28 28 64 61 74 20 27 28 29 29 29 0a 3b 3b t ((dat '())).;;
14760 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
14770 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
14780 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
14790 6c 6f 67 2d 70 6f 72 74 2a 20 22 47 65 74 74 69 log-port* "Getti
147a0 6e 67 20 64 61 74 61 20 66 6f 72 20 66 69 65 6c ng data for fiel
147b0 64 20 22 20 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b d " field).;; ;;
147c0 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
147d0 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
147e0 68 2d 72 6f 77 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 h-row.;; ;; ;; r
147f0 65 64 6f 20 6d 65 20 09 20 20 20 20 28 6c 61 6d edo me . (lam
14800 62 64 61 20 28 69 64 20 76 61 6c 29 0a 3b 3b 20 bda (id val).;;
14810 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 ;; ;; redo me .
14820 20 20 20 20 20 28 73 65 74 21 20 64 61 74 20 28 (set! dat (
14830 63 6f 6e 73 20 28 6c 69 73 74 20 69 64 20 76 61 cons (list id va
14840 6c 29 20 64 61 74 29 29 29 0a 3b 3b 20 3b 3b 20 l) dat))).;; ;;
14850 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 ;; redo me .
14860 28 64 62 3a 67 65 74 2d 64 62 20 64 62 20 72 75 (db:get-db db ru
14870 6e 2d 69 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 n-id).;; ;; ;; r
14880 65 64 6f 20 6d 65 20 09 20 20 20 20 28 63 6f 6e edo me . (con
14890 63 20 22 53 45 4c 45 43 54 20 69 64 2c 22 20 66 c "SELECT id," f
148a0 69 65 6c 64 20 22 20 46 52 4f 4d 20 74 65 73 74 ield " FROM test
148b0 73 3b 22 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 s;")).;; ;; ;; r
148c0 65 64 6f 20 6d 65 20 09 20 20 20 28 64 65 62 75 edo me . (debu
148d0 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
148e0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
148f0 2a 20 22 66 6f 75 6e 64 20 22 20 28 6c 65 6e 67 * "found " (leng
14900 74 68 20 64 61 74 29 20 22 20 69 74 65 6d 73 20 th dat) " items
14910 66 6f 72 20 66 69 65 6c 64 20 22 20 66 69 65 6c for field " fiel
14920 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f d).;; ;; ;; redo
14930 20 6d 65 20 09 20 20 20 28 6c 65 74 20 28 28 71 me . (let ((q
14940 72 79 20 28 73 71 6c 69 74 65 33 3a 70 72 65 70 ry (sqlite3:prep
14950 61 72 65 20 64 62 20 28 63 6f 6e 63 20 22 55 50 are db (conc "UP
14960 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 22 DATE tests SET "
14970 20 66 69 65 6c 64 20 22 3d 3f 20 57 48 45 52 45 field "=? WHERE
14980 20 69 64 3d 3f 3b 22 29 29 29 29 0a 3b 3b 20 3b id=?;")))).;; ;
14990 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 ; ;; redo me .
149a0 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 3b 3b 20 (for-each.;;
149b0 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 ;; ;; redo me .
149c0 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 74 (lambda (it
149d0 65 6d 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 em).;; ;; ;; red
149e0 6f 20 6d 65 20 09 09 28 6c 65 74 20 28 28 6e 65 o me ..(let ((ne
149f0 77 76 61 6c 20 3b 3b 20 28 73 64 62 3a 71 72 79 wval ;; (sdb:qry
14a00 20 27 67 65 74 69 64 20 0a 3b 3b 20 3b 3b 20 3b 'getid .;; ;; ;
14a10 3b 20 72 65 64 6f 20 6d 65 20 09 09 20 20 20 20 ; redo me ..
14a20 20 20 20 28 63 61 64 72 20 69 74 65 6d 29 29 29 (cadr item)))
14a30 20 3b 3b 20 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 ;; ).;; ;; ;; r
14a40 65 64 6f 20 6d 65 20 09 09 20 20 28 69 66 20 28 edo me .. (if (
14a50 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 77 76 not (equal? newv
14a60 61 6c 20 28 63 61 64 72 20 69 74 65 6d 29 29 29 al (cadr item)))
14a70 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
14a80 65 20 09 09 20 20 20 20 20 20 28 64 65 62 75 67 e .. (debug
14a90 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 :print-info 0 *d
14aa0 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
14ab0 20 22 43 6f 6e 76 65 72 74 69 6e 67 20 22 20 28 "Converting " (
14ac0 63 61 64 72 20 69 74 65 6d 29 20 22 20 74 6f 20 cadr item) " to
14ad0 22 20 6e 65 77 76 61 6c 20 22 20 66 6f 72 20 74 " newval " for t
14ae0 65 73 74 20 23 22 20 28 63 61 72 20 69 74 65 6d est #" (car item
14af0 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ))).;; ;; ;; red
14b00 6f 20 6d 65 20 09 09 20 20 28 73 71 6c 69 74 65 o me .. (sqlite
14b10 33 3a 65 78 65 63 75 74 65 20 71 72 79 20 6e 65 3:execute qry ne
14b20 77 76 61 6c 20 28 63 61 72 20 69 74 65 6d 29 29 wval (car item))
14b30 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f )).;; ;; ;; redo
14b40 20 6d 65 20 09 20 20 20 20 20 20 64 61 74 29 0a me . dat).
14b50 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
14b60 20 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a . (sqlite3:
14b70 66 69 6e 61 6c 69 7a 65 21 20 71 72 79 29 29 29 finalize! qry)))
14b80 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
14b90 6d 65 20 20 20 20 20 20 20 20 28 64 62 3a 63 6c me (db:cl
14ba0 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 ose-all dbstruct
14bb0 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
14bc0 6d 65 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 me (list
14bd0 22 75 6e 61 6d 65 22 20 22 72 75 6e 64 69 72 22 "uname" "rundir"
14be0 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 22 63 "final_logf" "c
14bf0 6f 6d 6d 65 6e 74 22 29 29 0a 3b 3b 20 3b 3b 20 omment")).;; ;;
14c00 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 20 ;; redo me
14c10 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
14c20 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 hing* #t)))..(if
14c30 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
14c40 2d 69 6d 70 6f 72 74 2d 6d 65 67 61 74 65 73 74 -import-megatest
14c50 2e 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e .db"). (begin
14c60 0a 20 20 20 20 20 20 28 64 62 3a 6d 75 6c 74 69 . (db:multi
14c70 2d 64 62 2d 73 79 6e 63 20 0a 20 20 20 20 20 20 -db-sync .
14c80 20 28 64 62 3a 73 65 74 75 70 29 0a 20 20 20 20 (db:setup).
14c90 20 20 20 27 6b 69 6c 6c 73 65 72 76 65 72 73 0a 'killservers.
14ca0 20 20 20 20 20 20 20 27 64 65 6a 75 6e 6b 0a 20 'dejunk.
14cb0 20 20 20 20 20 20 27 61 64 6a 2d 74 65 73 74 69 'adj-testi
14cc0 64 73 0a 20 20 20 20 20 20 20 27 6f 6c 64 32 6e ds. 'old2n
14cd0 65 77 0a 20 20 20 20 20 20 20 3b 3b 20 27 6e 65 ew. ;; 'ne
14ce0 77 32 6f 6c 64 0a 20 20 20 20 20 20 20 29 0a 20 w2old. ).
14cf0 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
14d00 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
14d10 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
14d20 72 67 20 22 2d 73 79 6e 63 2d 74 6f 2d 6d 65 67 rg "-sync-to-meg
14d30 61 74 65 73 74 2e 64 62 22 29 0a 20 20 20 20 28 atest.db"). (
14d40 62 65 67 69 6e 0a 20 20 20 20 20 20 28 64 62 3a begin. (db:
14d50 6d 75 6c 74 69 2d 64 62 2d 73 79 6e 63 20 0a 20 multi-db-sync .
14d60 20 20 20 20 20 20 28 64 62 3a 73 65 74 75 70 29 (db:setup)
14d70 0a 20 20 20 20 20 20 20 27 6e 65 77 32 6f 6c 64 . 'new2old
14d80 0a 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 20 . ).
14d90 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
14da0 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
14db0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
14dc0 73 79 6e 63 2d 74 6f 22 29 0a 20 20 20 20 28 6c sync-to"). (l
14dd0 65 74 20 28 28 74 6f 70 70 61 74 68 20 28 6c 61 et ((toppath (la
14de0 75 6e 63 68 3a 73 65 74 75 70 29 29 29 0a 20 20 unch:setup))).
14df0 20 20 20 20 28 74 61 73 6b 73 3a 73 79 6e 63 2d (tasks:sync-
14e00 74 6f 2d 70 6f 73 74 67 72 65 73 20 2a 63 6f 6e to-postgres *con
14e10 66 69 67 64 61 74 2a 20 28 61 72 67 73 3a 67 65 figdat* (args:ge
14e20 74 2d 61 72 67 20 22 2d 73 79 6e 63 2d 74 6f 22 t-arg "-sync-to"
14e30 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
14e40 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
14e50 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
14e60 65 74 2d 61 72 67 20 22 2d 67 65 6e 65 72 61 74 et-arg "-generat
14e70 65 2d 68 74 6d 6c 22 29 0a 20 20 20 20 28 6c 65 e-html"). (le
14e80 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 6c 61 t* ((toppath (la
14e90 75 6e 63 68 3a 73 65 74 75 70 29 29 29 0a 20 20 unch:setup))).
14ea0 20 20 20 20 28 69 66 20 28 74 65 73 74 73 3a 63 (if (tests:c
14eb0 72 65 61 74 65 2d 68 74 6d 6c 2d 74 72 65 65 20 reate-html-tree
14ec0 23 66 29 0a 20 20 20 20 20 20 20 20 20 20 28 64 #f). (d
14ed0 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
14ee0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
14ef0 6f 72 74 2a 20 22 48 54 4d 4c 20 6f 75 74 70 75 ort* "HTML outpu
14f00 74 20 63 72 65 61 74 65 64 20 69 6e 20 22 20 74 t created in " t
14f10 6f 70 70 61 74 68 20 22 2f 6c 74 2f 70 61 67 65 oppath "/lt/page
14f20 23 2e 68 74 6d 6c 22 29 0a 20 20 20 20 20 20 20 #.html").
14f30 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
14f40 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
14f50 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 ort* "Failed to
14f60 63 72 65 61 74 65 20 48 54 4d 4c 20 6f 75 74 70 create HTML outp
14f70 75 74 20 69 6e 20 22 20 74 6f 70 70 61 74 68 20 ut in " toppath
14f80 22 2f 6c 74 2f 72 75 6e 73 2d 69 6e 64 65 78 2e "/lt/runs-index.
14f90 68 74 6d 6c 22 29 29 0a 20 20 20 20 20 20 28 73 html")). (s
14fa0 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
14fb0 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d g* #t)))..;;====
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 3d 3d 3d 3d 3d ================
15000 3d 3d 0a 3b 3b 20 45 78 69 74 20 61 6e 64 20 63 ==.;; Exit and c
15010 6c 65 61 6e 20 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d lean up.;;======
15020 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15030 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15040 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15050 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15060 0a 0a 28 69 66 20 28 6e 6f 74 20 2a 64 69 64 73 ..(if (not *dids
15070 6f 6d 65 74 68 69 6e 67 2a 29 0a 20 20 20 20 28 omething*). (
15080 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
15090 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
150a0 20 68 65 6c 70 29 0a 20 20 20 20 28 73 65 74 21 help). (set!
150b0 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a 20 *time-to-exit*
150c0 23 74 29 0a 20 20 20 20 29 0a 3b 3b 28 64 65 62 #t). ).;;(deb
150d0 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 33 ug:print-info 13
150e0 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
150f0 72 74 2a 20 22 74 68 72 65 61 64 2d 6a 6f 69 6e rt* "thread-join
15100 21 20 77 61 74 63 68 64 6f 67 22 29 0a 0a 3b 3b ! watchdog")..;;
15110 20 6a 6f 69 6e 20 74 68 65 20 77 61 74 63 68 64 join the watchd
15120 6f 67 20 74 68 72 65 61 64 20 69 66 20 69 74 20 og thread if it
15130 68 61 73 20 62 65 65 6e 20 74 68 72 65 61 64 2d has been thread-
15140 73 74 61 72 74 21 65 64 20 20 28 69 74 20 6d 61 start!ed (it ma
15150 79 20 6e 6f 74 20 68 61 76 65 20 62 65 65 6e 20 y not have been
15160 73 74 61 72 74 65 64 20 69 6e 20 74 68 65 20 63 started in the c
15170 61 73 65 20 6f 66 20 61 20 73 65 72 76 65 72 20 ase of a server
15180 74 68 61 74 20 6e 65 76 65 72 20 65 6e 74 65 72 that never enter
15190 73 20 72 75 6e 6e 69 6e 67 20 73 74 61 74 65 29 s running state)
151a0 0a 3b 3b 20 20 20 28 73 79 6d 62 6f 6c 73 20 72 .;; (symbols r
151b0 65 74 75 72 6e 65 64 20 62 79 20 74 68 72 65 61 eturned by threa
151c0 64 2d 73 74 61 74 65 3a 20 63 72 65 61 74 65 64 d-state: created
151d0 20 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 20 62 ready running b
151e0 6c 6f 63 6b 65 64 20 73 75 73 70 65 6e 64 65 64 locked suspended
151f0 20 73 6c 65 65 70 69 6e 67 20 74 65 72 6d 69 6e sleeping termin
15200 61 74 65 64 20 64 65 61 64 29 0a 3b 3b 20 54 4f ated dead).;; TO
15210 44 4f 3a 20 66 6f 72 20 6d 75 6c 74 69 70 6c 65 DO: for multiple
15220 20 61 72 65 61 73 2c 20 77 65 20 77 69 6c 6c 20 areas, we will
15230 68 61 76 65 20 6d 75 6c 74 69 70 6c 65 20 77 61 have multiple wa
15240 74 63 68 64 6f 67 73 3b 20 61 6e 64 20 6d 75 6c tchdogs; and mul
15250 74 69 70 6c 65 20 74 68 72 65 61 64 73 20 74 6f tiple threads to
15260 20 6d 61 6e 61 67 65 0a 28 69 66 20 28 74 68 72 manage.(if (thr
15270 65 61 64 3f 20 2a 77 61 74 63 68 64 6f 67 2a 29 ead? *watchdog*)
15280 0a 20 20 20 20 28 63 61 73 65 20 28 74 68 72 65 . (case (thre
15290 61 64 2d 73 74 61 74 65 20 2a 77 61 74 63 68 64 ad-state *watchd
152a0 6f 67 2a 29 0a 20 20 20 20 20 20 28 28 72 65 61 og*). ((rea
152b0 64 79 20 72 75 6e 6e 69 6e 67 20 62 6c 6f 63 6b dy running block
152c0 65 64 20 73 6c 65 65 70 69 6e 67 20 74 65 72 6d ed sleeping term
152d0 69 6e 61 74 65 64 20 64 65 61 64 29 0a 20 20 20 inated dead).
152e0 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e (thread-join
152f0 21 20 2a 77 61 74 63 68 64 6f 67 2a 29 29 29 29 ! *watchdog*))))
15300 0a 0a 28 73 65 74 21 20 2a 74 69 6d 65 2d 74 6f ..(set! *time-to
15310 2d 65 78 69 74 2a 20 23 74 29 0a 0a 28 69 66 20 -exit* #t)..(if
15320 28 6e 6f 74 20 28 65 71 3f 20 2a 67 6c 6f 62 61 (not (eq? *globa
15330 6c 65 78 69 74 73 74 61 74 75 73 2a 20 30 29 29 lexitstatus* 0))
15340 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 61 72 . (if (or (ar
15350 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
15360 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
15370 22 2d 72 75 6e 74 65 73 74 73 22 29 28 61 72 67 "-runtests")(arg
15380 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 s:get-arg "-runa
15390 6c 6c 22 29 29 0a 20 20 20 20 20 20 20 20 28 62 ll")). (b
153a0 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 egin.
153b0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
153c0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
153d0 2a 20 22 4e 4f 54 45 3a 20 53 75 62 70 72 6f 63 * "NOTE: Subproc
153e0 65 73 73 65 73 20 77 69 74 68 20 6e 6f 6e 2d 7a esses with non-z
153f0 65 72 6f 20 65 78 69 74 20 63 6f 64 65 20 64 65 ero exit code de
15400 74 65 63 74 65 64 3a 20 22 20 2a 67 6c 6f 62 61 tected: " *globa
15410 6c 65 78 69 74 73 74 61 74 75 73 2a 29 0a 20 20 lexitstatus*).
15420 20 20 20 20 20 20 20 20 20 28 65 78 69 74 20 30 (exit 0
15430 29 29 0a 20 20 20 20 20 20 20 20 28 63 61 73 65 )). (case
15440 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 *globalexitstat
15450 75 73 2a 0a 20 20 20 20 20 20 20 20 20 28 28 30 us*. ((0
15460 29 28 65 78 69 74 20 30 29 29 0a 20 20 20 20 20 )(exit 0)).
15470 20 20 20 20 28 28 31 29 28 65 78 69 74 20 31 29 ((1)(exit 1)
15480 29 0a 20 20 20 20 20 20 20 20 20 28 28 32 29 28 ). ((2)(
15490 65 78 69 74 20 32 29 29 0a 20 20 20 20 20 20 20 exit 2)).
154a0 20 20 28 65 6c 73 65 20 28 65 78 69 74 20 33 29 (else (exit 3)
154b0 29 29 29 29 0a )))).