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 61 6c 6c 20 20 20 20 20 20 20 20 20 20 20 20 nall
0910: 20 20 20 20 20 3a 20 72 75 6e 20 61 6c 6c 20 74 : run all t
0920: 65 73 74 73 20 6f 72 20 61 73 20 73 70 65 63 69 ests or as speci
0930: 66 69 65 64 20 62 79 20 2d 74 65 73 74 70 61 74 fied by -testpat
0940: 74 0a 20 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 t. -remove-runs
0950: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 : re
0960: 6d 6f 76 65 20 74 68 65 20 64 61 74 61 20 66 6f move the data fo
0970: 72 20 61 20 72 75 6e 2c 20 72 65 71 75 69 72 65 r a run, require
0980: 73 20 2d 72 75 6e 6e 61 6d 65 20 61 6e 64 20 2d s -runname and -
0990: 74 65 73 74 70 61 74 74 0a 20 20 20 20 20 20 20 testpatt.
09a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09b0: 20 20 20 20 20 4f 70 74 69 6f 6e 61 6c 6c 79 20 Optionally
09c0: 75 73 65 20 3a 73 74 61 74 65 20 61 6e 64 20 3a use :state and :
09d0: 73 74 61 74 75 73 0a 20 20 2d 73 65 74 2d 73 74 status. -set-st
09e0: 61 74 65 2d 73 74 61 74 75 73 20 58 2c 59 20 20 ate-status X,Y
09f0: 20 3a 20 73 65 74 20 73 74 61 74 65 20 74 6f 20 : set state to
0a00: 58 20 61 6e 64 20 73 74 61 74 75 73 20 74 6f 20 X and status to
0a10: 59 2c 20 72 65 71 75 69 72 65 73 20 63 6f 6e 74 Y, requires cont
0a20: 72 6f 6c 73 20 70 65 72 20 2d 72 65 6d 6f 76 65 rols per -remove
0a30: 2d 72 75 6e 73 0a 20 20 2d 72 65 72 75 6e 20 46 -runs. -rerun F
0a40: 41 49 4c 2c 57 41 52 4e 2e 2e 2e 20 20 20 20 20 AIL,WARN...
0a50: 3a 20 66 6f 72 63 65 20 72 65 2d 72 75 6e 20 66 : force re-run f
0a60: 6f 72 20 74 65 73 74 73 20 77 69 74 68 20 73 70 or tests with sp
0a70: 65 63 69 66 69 63 65 64 20 73 74 61 74 75 73 28 ecificed status(
0a80: 73 29 0a 20 20 2d 72 65 72 75 6e 2d 63 6c 65 61 s). -rerun-clea
0a90: 6e 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 n : s
0aa0: 65 74 20 61 6c 6c 20 74 65 73 74 73 20 6e 6f 74 et all tests not
0ab0: 20 43 4f 4d 50 4c 45 54 45 44 2b 50 41 53 53 2c COMPLETED+PASS,
0ac0: 57 41 52 4e 2c 57 41 49 56 45 44 20 74 6f 20 4e WARN,WAIVED to N
0ad0: 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 0a 20 OT_STARTED,n/a.
0ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0af0: 20 20 20 20 20 20 20 20 20 20 20 61 6e 64 20 74 and t
0b00: 68 65 6e 20 72 75 6e 20 74 68 65 20 73 70 65 63 hen run the spec
0b10: 69 66 69 65 64 20 74 65 73 74 70 61 74 74 20 77 ified testpatt w
0b20: 69 74 68 20 2d 70 72 65 63 6c 65 61 6e 0a 20 20 ith -preclean.
0b30: 2d 72 65 72 75 6e 2d 61 6c 6c 20 20 20 20 20 20 -rerun-all
0b40: 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 61 6c : set al
0b50: 6c 20 74 65 73 74 73 20 74 6f 20 4e 4f 54 5f 53 l tests to NOT_S
0b60: 54 41 52 54 45 44 2c 6e 2f 61 20 61 6e 64 20 72 TARTED,n/a and r
0b70: 75 6e 20 77 69 74 68 20 2d 70 72 65 63 6c 65 61 un with -preclea
0b80: 6e 0a 20 20 2d 6c 6f 63 6b 20 20 20 20 20 20 20 n. -lock
0b90: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 6f : lo
0ba0: 63 6b 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 ck run specified
0bb0: 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 by target and r
0bc0: 75 6e 6e 61 6d 65 0a 20 20 2d 75 6e 6c 6f 63 6b unname. -unlock
0bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0be0: 20 3a 20 75 6e 6c 6f 63 6b 20 72 75 6e 20 73 70 : unlock run sp
0bf0: 65 63 69 66 69 65 64 20 62 79 20 74 61 72 67 65 ecified by targe
0c00: 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 20 t and runname.
0c10: 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 -set-run-status
0c20: 73 74 61 74 75 73 20 20 3a 20 73 65 74 73 20 73 status : sets s
0c30: 74 61 74 75 73 20 66 6f 72 20 72 75 6e 20 74 6f tatus for run to
0c40: 20 73 74 61 74 75 73 2c 20 72 65 71 75 69 72 65 status, require
0c50: 73 20 2d 74 61 72 67 65 74 20 61 6e 64 20 2d 72 s -target and -r
0c60: 75 6e 6e 61 6d 65 0a 20 20 2d 67 65 74 2d 72 75 unname. -get-ru
0c70: 6e 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 20 n-status
0c80: 20 3a 20 67 65 74 73 20 73 74 61 74 75 73 20 66 : gets status f
0c90: 6f 72 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 or run specified
0ca0: 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 by target and r
0cb0: 75 6e 6e 61 6d 65 0a 20 20 2d 72 75 6e 2d 77 61 unname. -run-wa
0cc0: 69 74 20 20 20 20 20 20 20 20 20 20 20 20 20 20 it
0cd0: 20 3a 20 77 61 69 74 20 6f 6e 20 72 75 6e 20 73 : wait on run s
0ce0: 70 65 63 69 66 69 65 64 20 62 79 20 74 61 72 67 pecified by targ
0cf0: 65 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 et and runname.
0d00: 20 2d 70 72 65 63 6c 65 61 6e 20 20 20 20 20 20 -preclean
0d10: 20 20 20 20 20 20 20 20 20 3a 20 72 65 6d 6f 76 : remov
0d20: 65 20 74 68 65 20 65 78 69 73 74 69 6e 67 20 74 e the existing t
0d30: 65 73 74 20 64 69 72 65 63 74 6f 72 79 20 62 65 est directory be
0d40: 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 74 68 65 fore running the
0d50: 20 74 65 73 74 0a 20 20 2d 63 6c 65 61 6e 2d 63 test. -clean-c
0d60: 61 63 68 65 20 20 20 20 20 20 20 20 20 20 20 20 ache
0d70: 3a 20 72 65 6d 6f 76 65 20 74 68 65 20 63 61 63 : remove the cac
0d80: 68 65 64 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e hed megatest.con
0d90: 66 69 67 20 61 6e 64 20 72 75 6e 63 6f 6e 66 69 fig and runconfi
0da0: 67 2e 63 6f 6e 66 69 67 20 66 69 6c 65 73 0a 0a g.config files..
0db0: 53 65 6c 65 63 74 6f 72 73 20 28 65 2e 67 2e 20 Selectors (e.g.
0dc0: 75 73 65 20 66 6f 72 20 2d 72 75 6e 74 65 73 74 use for -runtest
0dd0: 73 2c 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 2c s, -remove-runs,
0de0: 20 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 -set-state-stat
0df0: 75 73 2c 20 2d 6c 69 73 74 2d 72 75 6e 73 20 65 us, -list-runs e
0e00: 74 63 2e 29 0a 20 20 2d 74 61 72 67 65 74 20 6b tc.). -target k
0e10: 65 79 31 2f 6b 65 79 32 2f 2e 2e 2e 20 20 20 3a ey1/key2/... :
0e20: 20 72 75 6e 20 66 6f 72 20 6b 65 79 31 2c 20 6b run for key1, k
0e30: 65 79 32 2c 20 65 74 63 2e 0a 20 20 2d 72 65 71 ey2, etc.. -req
0e40: 74 61 72 67 20 6b 65 79 31 2f 6b 65 79 32 2f 2e targ key1/key2/.
0e50: 2e 2e 20 20 3a 20 72 75 6e 20 66 6f 72 20 6b 65 .. : run for ke
0e60: 79 31 2c 20 6b 65 79 32 2c 20 65 74 63 2e 20 62 y1, key2, etc. b
0e70: 75 74 20 6b 65 79 31 2f 6b 65 79 32 20 6d 75 73 ut key1/key2 mus
0e80: 74 20 62 65 20 69 6e 20 72 75 6e 63 6f 6e 66 69 t be in runconfi
0e90: 67 0a 20 20 2d 74 65 73 74 70 61 74 74 20 70 61 g. -testpatt pa
0ea0: 74 74 31 2f 70 61 74 74 32 2c 70 61 74 74 33 2f tt1/patt2,patt3/
0eb0: 2e 2e 2e 20 20 3a 20 25 20 69 73 20 77 69 6c 64 ... : % is wild
0ec0: 63 61 72 64 0a 20 20 2d 72 75 6e 6e 61 6d 65 20 card. -runname
0ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0ee0: 20 72 65 71 75 69 72 65 64 2c 20 6e 61 6d 65 20 required, name
0ef0: 66 6f 72 20 74 68 69 73 20 70 61 72 74 69 63 75 for this particu
0f00: 6c 61 72 20 74 65 73 74 20 72 75 6e 0a 20 20 2d lar test run. -
0f10: 73 74 61 74 65 20 20 20 20 20 20 20 20 20 20 20 state
0f20: 20 20 20 20 20 20 20 3a 20 41 70 70 6c 69 65 73 : Applies
0f30: 20 74 6f 20 72 75 6e 73 2c 20 74 65 73 74 73 20 to runs, tests
0f40: 6f 72 20 73 74 65 70 73 20 64 65 70 65 6e 64 69 or steps dependi
0f50: 6e 67 20 6f 6e 20 63 6f 6e 74 65 78 74 0a 20 20 ng on context.
0f60: 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 20 20 -status
0f70: 20 20 20 20 20 20 20 20 3a 20 41 70 70 6c 69 65 : Applie
0f80: 73 20 74 6f 20 72 75 6e 73 2c 20 74 65 73 74 73 s to runs, tests
0f90: 20 6f 72 20 73 74 65 70 73 20 64 65 70 65 6e 64 or steps depend
0fa0: 69 6e 67 20 6f 6e 20 63 6f 6e 74 65 78 74 0a 20 ing on context.
0fb0: 20 2d 2d 6d 6f 64 65 70 61 74 74 20 6b 65 79 20 --modepatt key
0fc0: 20 20 20 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 : load
0fd0: 74 65 73 74 70 61 74 74 20 66 72 6f 6d 20 3c 6b testpatt from <k
0fe0: 65 79 3e 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 ey> in runconfig
0ff0: 73 20 69 6e 73 74 65 61 64 20 6f 66 20 64 65 66 s instead of def
1000: 61 75 6c 74 20 54 45 53 54 50 41 54 54 20 69 66 ault TESTPATT if
1010: 20 2d 74 65 73 74 70 61 74 74 20 61 6e 64 20 2d -testpatt and -
1020: 74 61 67 65 78 70 72 20 61 72 65 20 6e 6f 74 20 tagexpr are not
1030: 73 70 65 63 69 66 69 65 64 0a 20 20 2d 74 61 67 specified. -tag
1040: 65 78 70 72 20 74 61 67 31 2c 74 61 67 32 25 2c expr tag1,tag2%,
1050: 2e 2e 20 20 3a 20 73 65 6c 65 63 74 20 74 65 73 .. : select tes
1060: 74 73 20 77 69 74 68 20 74 61 67 73 20 6d 61 74 ts with tags mat
1070: 63 68 69 6e 67 20 65 78 70 72 65 73 73 69 6f 6e ching expression
1080: 0a 0a 54 65 73 74 20 68 65 6c 70 65 72 73 20 28 ..Test helpers (
1090: 66 6f 72 20 75 73 65 20 69 6e 73 69 64 65 20 74 for use inside t
10a0: 65 73 74 73 29 0a 20 20 2d 73 74 65 70 20 73 74 ests). -step st
10b0: 65 70 6e 61 6d 65 0a 20 20 2d 74 65 73 74 2d 73 epname. -test-s
10c0: 74 61 74 75 73 20 20 20 20 20 20 20 20 20 20 20 tatus
10d0: 20 3a 20 73 65 74 20 74 68 65 20 73 74 61 74 65 : set the state
10e0: 20 61 6e 64 20 73 74 61 74 75 73 20 6f 66 20 61 and status of a
10f0: 20 74 65 73 74 20 28 75 73 65 20 3a 73 74 61 74 test (use :stat
1100: 65 20 61 6e 64 20 3a 73 74 61 74 75 73 29 0a 20 e and :status).
1110: 20 2d 73 65 74 6c 6f 67 20 6c 6f 67 66 6e 61 6d -setlog logfnam
1120: 65 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 e : set t
1130: 68 65 20 70 61 74 68 2f 66 69 6c 65 6e 61 6d 65 he path/filename
1140: 20 74 6f 20 74 68 65 20 66 69 6e 61 6c 20 6c 6f to the final lo
1150: 67 20 72 65 6c 61 74 69 76 65 20 74 6f 20 74 68 g relative to th
1160: 65 20 74 65 73 74 0a 20 20 20 20 20 20 20 20 20 e test.
1170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1180: 20 20 20 64 69 72 65 63 74 6f 72 79 2e 20 6d 61 directory. ma
1190: 79 20 62 65 20 75 73 65 64 20 77 69 74 68 20 2d y be used with -
11a0: 74 65 73 74 2d 73 74 61 74 75 73 0a 20 20 2d 73 test-status. -s
11b0: 65 74 2d 74 6f 70 6c 6f 67 20 6c 6f 67 66 6e 61 et-toplog logfna
11c0: 6d 65 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 me : set the
11d0: 6f 76 65 72 61 6c 6c 20 6c 6f 67 20 66 6f 72 20 overall log for
11e0: 61 20 73 75 69 74 65 20 6f 66 20 73 75 62 2d 74 a suite of sub-t
11f0: 65 73 74 73 0a 20 20 2d 73 75 6d 6d 61 72 69 7a ests. -summariz
1200: 65 2d 69 74 65 6d 73 20 20 20 20 20 20 20 20 3a e-items :
1210: 20 66 6f 72 20 61 6e 20 69 74 65 6d 69 7a 65 64 for an itemized
1220: 20 74 65 73 74 20 63 72 65 61 74 65 20 61 20 73 test create a s
1230: 75 6d 6d 61 72 79 20 68 74 6d 6c 20 0a 20 20 2d ummary html . -
1240: 6d 20 63 6f 6d 6d 65 6e 74 20 20 20 20 20 20 20 m comment
1250: 20 20 20 20 20 20 20 3a 20 69 6e 73 65 72 74 20 : insert
1260: 61 20 63 6f 6d 6d 65 6e 74 20 66 6f 72 20 74 68 a comment for th
1270: 69 73 20 74 65 73 74 0a 0a 54 65 73 74 20 64 61 is test..Test da
1280: 74 61 20 63 61 70 74 75 72 65 0a 20 20 2d 73 65 ta capture. -se
1290: 74 2d 76 61 6c 75 65 73 20 20 20 20 20 20 20 20 t-values
12a0: 20 20 20 20 20 3a 20 75 70 64 61 74 65 20 6f 72 : update or
12b0: 20 73 65 74 20 76 61 6c 75 65 73 20 69 6e 20 74 set values in t
12c0: 68 65 20 74 65 73 74 64 61 74 61 20 74 61 62 6c he testdata tabl
12d0: 65 0a 20 20 3a 63 61 74 65 67 6f 72 79 20 20 20 e. :category
12e0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 : se
12f0: 74 20 74 68 65 20 63 61 74 65 67 6f 72 79 20 66 t the category f
1300: 69 65 6c 64 20 28 6f 70 74 69 6f 6e 61 6c 29 0a ield (optional).
1310: 20 20 3a 76 61 72 69 61 62 6c 65 20 20 20 20 20 :variable
1320: 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 : set
1330: 74 68 65 20 76 61 72 69 61 62 6c 65 20 6e 61 6d the variable nam
1340: 65 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a e (optional). :
1350: 76 61 6c 75 65 20 20 20 20 20 20 20 20 20 20 20 value
1360: 20 20 20 20 20 20 20 3a 20 76 61 6c 75 65 20 6d : value m
1370: 65 61 73 75 72 65 64 20 28 72 65 71 75 69 72 65 easured (require
1380: 64 29 0a 20 20 3a 65 78 70 65 63 74 65 64 20 20 d). :expected
1390: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 76 : v
13a0: 61 6c 75 65 20 65 78 70 65 63 74 65 64 20 28 72 alue expected (r
13b0: 65 71 75 69 72 65 64 29 0a 20 20 3a 74 6f 6c 20 equired). :tol
13c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13d0: 20 20 20 3a 20 7c 76 61 6c 75 65 2d 65 78 70 65 : |value-expe
13e0: 63 74 7c 20 3c 3d 20 74 6f 6c 20 28 72 65 71 75 ct| <= tol (requ
13f0: 69 72 65 64 2c 20 63 61 6e 20 62 65 20 3c 2c 20 ired, can be <,
1400: 3e 2c 20 3e 3d 2c 20 3c 3d 20 6f 72 20 6e 75 6d >, >=, <= or num
1410: 62 65 72 29 0a 20 20 3a 75 6e 69 74 73 20 20 20 ber). :units
1420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
1430: 20 6e 61 6d 65 20 6f 66 20 74 68 65 20 75 6e 69 name of the uni
1440: 74 73 20 66 6f 72 20 76 61 6c 75 65 2c 20 65 78 ts for value, ex
1450: 70 65 63 74 65 64 5f 76 61 6c 75 65 20 65 74 63 pected_value etc
1460: 2e 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 2d . (optional). -
1470: 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 20 20 load-test-data
1480: 20 20 20 20 20 20 20 3a 20 72 65 61 64 20 74 65 : read te
1490: 73 74 20 73 70 65 63 69 66 69 63 20 64 61 74 61 st specific data
14a0: 20 66 6f 72 20 73 74 6f 72 61 67 65 20 69 6e 20 for storage in
14b0: 74 68 65 20 74 65 73 74 5f 64 61 74 61 20 74 61 the test_data ta
14c0: 62 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ble.
14d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14e0: 66 72 6f 6d 20 73 74 61 6e 64 61 72 64 20 69 6e from standard in
14f0: 2e 20 45 61 63 68 20 6c 69 6e 65 20 69 73 20 63 . Each line is c
1500: 6f 6d 6d 61 20 64 65 6c 69 6d 69 74 65 64 20 77 omma delimited w
1510: 69 74 68 20 66 6f 75 72 0a 20 20 20 20 20 20 20 ith four.
1520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1530: 20 20 20 20 20 66 69 65 6c 64 73 20 63 61 74 65 fields cate
1540: 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 gory,variable,va
1550: 6c 75 65 2c 63 6f 6d 6d 65 6e 74 0a 0a 51 75 65 lue,comment..Que
1560: 72 69 65 73 0a 20 20 2d 6c 69 73 74 2d 72 75 6e ries. -list-run
1570: 73 20 70 61 74 74 20 20 20 20 20 20 20 20 20 3a s patt :
1580: 20 6c 69 73 74 20 72 75 6e 73 20 6d 61 74 63 68 list runs match
1590: 69 6e 67 20 70 61 74 74 65 72 6e 20 5c 22 70 61 ing pattern \"pa
15a0: 74 74 5c 22 2c 20 25 20 69 73 20 74 68 65 20 77 tt\", % is the w
15b0: 69 6c 64 63 61 72 64 0a 20 20 2d 73 68 6f 77 2d ildcard. -show-
15c0: 6b 65 79 73 20 20 20 20 20 20 20 20 20 20 20 20 keys
15d0: 20 20 3a 20 73 68 6f 77 20 74 68 65 20 6b 65 79 : show the key
15e0: 73 20 75 73 65 64 20 69 6e 20 74 68 69 73 20 6d s used in this m
15f0: 65 67 61 74 65 73 74 20 73 65 74 75 70 0a 20 20 egatest setup.
1600: 2d 74 65 73 74 2d 66 69 6c 65 73 20 74 61 72 67 -test-files targ
1610: 70 61 74 74 20 20 20 20 3a 20 67 65 74 20 74 68 patt : get th
1620: 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 20 74 65 e most recent te
1630: 73 74 20 70 61 74 68 2f 66 69 6c 65 20 6d 61 74 st path/file mat
1640: 63 68 69 6e 67 20 74 61 72 67 70 61 74 74 20 65 ching targpatt e
1650: 2e 67 2e 20 25 2f 25 20 6f 72 20 27 2a 2e 6c 6f .g. %/% or '*.lo
1660: 67 27 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 g'.
1670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
1680: 65 74 75 72 6e 73 20 6c 69 73 74 20 73 6f 72 74 eturns list sort
1690: 65 64 20 62 79 20 61 67 65 20 61 73 63 65 6e 64 ed by age ascend
16a0: 69 6e 67 2c 20 73 65 65 20 65 78 61 6d 70 6c 65 ing, see example
16b0: 73 20 62 65 6c 6f 77 0a 20 20 2d 74 65 73 74 2d s below. -test-
16c0: 70 61 74 68 73 20 20 20 20 20 20 20 20 20 20 20 paths
16d0: 20 20 3a 20 67 65 74 20 74 68 65 20 74 65 73 74 : get the test
16e0: 20 70 61 74 68 73 20 6d 61 74 63 68 69 6e 67 20 paths matching
16f0: 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c target, runname,
1700: 20 69 74 65 6d 20 61 6e 64 20 74 65 73 74 0a 20 item and test.
1710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1720: 20 20 20 20 20 20 20 20 20 20 20 70 61 74 74 65 patte
1730: 72 6e 73 2e 0a 20 20 2d 6c 69 73 74 2d 64 69 73 rns.. -list-dis
1740: 6b 73 20 20 20 20 20 20 20 20 20 20 20 20 20 3a ks :
1750: 20 6c 69 73 74 20 74 68 65 20 64 69 73 6b 73 20 list the disks
1760: 61 76 61 69 6c 61 62 6c 65 20 66 6f 72 20 73 74 available for st
1770: 6f 72 69 6e 67 20 72 75 6e 73 0a 20 20 2d 6c 69 oring runs. -li
1780: 73 74 2d 74 61 72 67 65 74 73 20 20 20 20 20 20 st-targets
1790: 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 65 20 : list the
17a0: 74 61 72 67 65 74 73 20 69 6e 20 72 75 6e 63 6f targets in runco
17b0: 6e 66 69 67 73 2e 63 6f 6e 66 69 67 0a 20 20 2d nfigs.config. -
17c0: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 20 list-db-targets
17d0: 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 : list th
17e0: 65 20 74 61 72 67 65 74 20 63 6f 6d 62 69 6e 61 e target combina
17f0: 74 69 6f 6e 73 20 75 73 65 64 20 69 6e 20 74 68 tions used in th
1800: 65 20 64 62 0a 20 20 2d 73 68 6f 77 2d 63 6f 6e e db. -show-con
1810: 66 69 67 20 20 20 20 20 20 20 20 20 20 20 20 3a fig :
1820: 20 64 75 6d 70 20 74 68 65 20 69 6e 74 65 72 6e dump the intern
1830: 61 6c 20 72 65 70 72 65 73 65 6e 74 61 74 69 6f al representatio
1840: 6e 20 6f 66 20 74 68 65 20 6d 65 67 61 74 65 73 n of the megates
1850: 74 2e 63 6f 6e 66 69 67 20 66 69 6c 65 0a 20 20 t.config file.
1860: 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 20 -show-runconfig
1870: 20 20 20 20 20 20 20 20 3a 20 64 75 6d 70 20 74 : dump t
1880: 68 65 20 69 6e 74 65 72 6e 61 6c 20 72 65 70 72 he internal repr
1890: 65 73 65 6e 74 61 74 69 6f 6e 20 6f 66 20 74 68 esentation of th
18a0: 65 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e e runconfigs.con
18b0: 66 69 67 20 66 69 6c 65 0a 20 20 2d 64 75 6d 70 fig file. -dump
18c0: 6d 6f 64 65 20 4d 4f 44 45 20 20 20 20 20 20 20 mode MODE
18d0: 20 20 20 3a 20 64 75 6d 70 20 69 6e 20 4d 4f 44 : dump in MOD
18e0: 45 20 66 6f 72 6d 61 74 20 69 6e 73 74 65 61 64 E format instead
18f0: 20 6f 66 20 73 65 78 70 72 2c 20 4d 4f 44 45 3d of sexpr, MODE=
1900: 6a 73 6f 6e 2c 69 6e 69 2c 73 65 78 70 20 65 74 json,ini,sexp et
1910: 63 2e 0a 20 20 2d 73 68 6f 77 2d 63 6d 64 69 6e c.. -show-cmdin
1920: 66 6f 20 20 20 20 20 20 20 20 20 20 20 3a 20 64 fo : d
1930: 75 6d 70 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 ump the command
1940: 69 6e 66 6f 20 66 6f 72 20 61 20 74 65 73 74 20 info for a test
1950: 28 72 75 6e 20 69 6e 20 74 65 73 74 20 65 6e 76 (run in test env
1960: 69 72 6f 6e 6d 65 6e 74 29 0a 20 20 2d 73 65 63 ironment). -sec
1970: 74 69 6f 6e 20 73 65 63 74 69 6f 6e 4e 61 6d 65 tion sectionName
1980: 0a 20 20 2d 76 61 72 20 76 61 72 4e 61 6d 65 20 . -var varName
1990: 20 20 20 20 20 20 20 20 20 20 20 3a 20 66 6f 72 : for
19a0: 20 63 6f 6e 66 69 67 20 61 6e 64 20 72 75 6e 63 config and runc
19b0: 6f 6e 66 69 67 20 6c 6f 6f 6b 75 70 20 76 61 6c onfig lookup val
19c0: 75 65 20 66 6f 72 20 73 65 63 74 69 6f 6e 4e 61 ue for sectionNa
19d0: 6d 65 20 76 61 72 4e 61 6d 65 0a 20 20 2d 73 69 me varName. -si
19e0: 6e 63 65 20 4e 20 20 20 20 20 20 20 20 20 20 20 nce N
19f0: 20 20 20 20 20 3a 20 67 65 74 20 6c 69 73 74 20 : get list
1a00: 6f 66 20 72 75 6e 73 20 63 68 61 6e 67 65 64 20 of runs changed
1a10: 73 69 6e 63 65 20 74 69 6d 65 20 4e 20 28 55 6e since time N (Un
1a20: 69 78 20 73 65 63 6f 6e 64 73 29 0a 20 20 2d 66 ix seconds). -f
1a30: 69 65 6c 64 73 20 66 69 65 6c 64 73 70 65 63 20 ields fieldspec
1a40: 20 20 20 20 20 20 3a 20 66 69 65 6c 64 73 20 74 : fields t
1a50: 6f 20 69 6e 63 6c 75 64 65 20 69 6e 20 6a 73 6f o include in jso
1a60: 6e 20 64 75 6d 70 3b 20 72 75 6e 73 3a 69 64 2c n dump; runs:id,
1a70: 72 75 6e 61 6d 65 2b 74 65 73 74 73 3a 74 65 73 runame+tests:tes
1a80: 74 6e 61 6d 65 2b 73 74 65 70 73 0a 20 20 2d 73 tname+steps. -s
1a90: 6f 72 74 20 66 69 65 6c 64 6e 61 6d 65 20 20 20 ort fieldname
1aa0: 20 20 20 20 20 20 3a 20 69 6e 20 2d 6c 69 73 74 : in -list
1ab0: 2d 72 75 6e 73 20 73 6f 72 74 20 74 65 73 74 73 -runs sort tests
1ac0: 20 62 79 20 74 68 69 73 20 66 69 65 6c 64 0a 0a by this field..
1ad0: 4d 69 73 63 20 0a 20 20 2d 73 74 61 72 74 2d 64 Misc . -start-d
1ae0: 69 72 20 70 61 74 68 20 20 20 20 20 20 20 20 20 ir path
1af0: 3a 20 73 77 69 74 63 68 20 74 6f 20 74 68 69 73 : switch to this
1b00: 20 64 69 72 65 63 74 6f 72 79 20 62 65 66 6f 72 directory befor
1b10: 65 20 72 75 6e 6e 69 6e 67 20 6d 65 67 61 74 65 e running megate
1b20: 73 74 0a 20 20 2d 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 6d 69 67 72 61 74 65 20 61 : migrate a
1c20: 20 64 61 74 61 62 61 73 65 20 66 72 6f 6d 20 76 database from v
1c30: 31 2e 35 35 20 73 65 72 69 65 73 20 74 6f 20 76 1.55 series to v
1c40: 31 2e 36 30 20 73 65 72 69 65 73 0a 20 20 2d 73 1.60 series. -s
1c50: 79 6e 63 2d 74 6f 2d 6d 65 67 61 74 65 73 74 2e ync-to-megatest.
1c60: 64 62 20 20 20 20 3a 20 6d 69 67 72 61 74 65 20 db : migrate
1c70: 64 61 74 61 20 62 61 63 6b 20 74 6f 20 6d 65 67 data back to meg
1c80: 61 74 65 73 74 2e 64 62 0a 20 20 2d 75 73 65 2d atest.db. -use-
1c90: 64 62 2d 63 61 63 68 65 20 20 20 20 20 20 20 20 db-cache
1ca0: 20 20 20 3a 20 75 73 65 20 63 61 63 68 65 64 20 : use cached
1cb0: 61 63 63 65 73 73 20 74 6f 20 64 62 20 74 6f 20 access to db to
1cc0: 72 65 64 75 63 65 20 6c 6f 61 64 0a 20 20 2d 75 reduce load. -u
1cd0: 70 64 61 74 65 2d 6d 65 74 61 20 20 20 20 20 20 pdate-meta
1ce0: 20 20 20 20 20 20 3a 20 75 70 64 61 74 65 20 74 : update t
1cf0: 68 65 20 74 65 73 74 73 20 6d 65 74 61 64 61 74 he tests metadat
1d00: 61 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 0a a for all tests.
1d10: 20 20 2d 73 65 74 76 61 72 73 20 56 41 52 31 3d -setvars VAR1=
1d20: 76 61 6c 31 2c 56 41 52 32 3d 76 61 6c 32 20 3a val1,VAR2=val2 :
1d30: 20 41 64 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 Add environment
1d40: 20 76 61 72 69 61 62 6c 65 73 20 74 6f 20 61 20 variables to a
1d50: 72 75 6e 20 4e 42 2f 2f 20 74 68 65 73 65 20 61 run NB// these a
1d60: 72 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 re.
1d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d80: 20 20 20 20 6f 76 65 72 77 72 69 74 74 65 6e 20 overwritten
1d90: 62 79 20 76 61 6c 75 65 73 20 73 65 74 20 69 6e by values set in
1da0: 20 63 6f 6e 66 69 67 20 66 69 6c 65 73 2e 0a 20 config files..
1db0: 20 2d 73 65 72 76 65 72 20 2d 7c 68 6f 73 74 6e -server -|hostn
1dc0: 61 6d 65 20 20 20 20 20 20 3a 20 73 74 61 72 74 ame : start
1dd0: 20 74 68 65 20 73 65 72 76 65 72 20 28 72 65 64 the server (red
1de0: 75 63 65 73 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 uces contention
1df0: 6f 6e 20 6d 65 67 61 74 65 73 74 2e 64 62 29 2c on megatest.db),
1e00: 20 75 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 use.
1e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e20: 20 2d 20 74 6f 20 61 75 74 6f 6d 61 74 69 63 61 - to automatica
1e30: 6c 6c 79 20 66 69 67 75 72 65 20 6f 75 74 20 68 lly figure out h
1e40: 6f 73 74 6e 61 6d 65 0a 20 20 2d 74 72 61 6e 73 ostname. -trans
1e50: 70 6f 72 74 20 68 74 74 70 7c 72 70 63 20 20 20 port http|rpc
1e60: 20 20 3a 20 75 73 65 20 68 74 74 70 20 6f 72 20 : use http or
1e70: 72 70 63 20 66 6f 72 20 74 72 61 6e 73 70 6f 72 rpc for transpor
1e80: 74 20 28 64 65 66 61 75 6c 74 20 69 73 20 68 74 t (default is ht
1e90: 74 70 29 20 0a 20 20 2d 64 61 65 6d 6f 6e 69 7a tp) . -daemoniz
1ea0: 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a e :
1eb0: 20 66 6f 72 6b 20 69 6e 74 6f 20 62 61 63 6b 67 fork into backg
1ec0: 72 6f 75 6e 64 20 61 6e 64 20 64 69 73 63 6f 6e round and discon
1ed0: 6e 65 63 74 20 66 72 6f 6d 20 73 74 64 69 6e 2f nect from stdin/
1ee0: 6f 75 74 0a 20 20 2d 6c 6f 67 20 6c 6f 67 66 69 out. -log logfi
1ef0: 6c 65 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 le :
1f00: 73 65 6e 64 20 73 74 64 6f 75 74 20 61 6e 64 20 send stdout and
1f10: 73 74 64 65 72 72 20 74 6f 20 6c 6f 67 66 69 6c stderr to logfil
1f20: 65 0a 20 20 2d 6c 69 73 74 2d 73 65 72 76 65 72 e. -list-server
1f30: 73 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 69 s : li
1f40: 73 74 20 74 68 65 20 73 65 72 76 65 72 73 20 0a st the servers .
1f50: 20 20 2d 73 74 6f 70 2d 73 65 72 76 65 72 20 69 -stop-server i
1f60: 64 20 20 20 20 20 20 20 20 20 3a 20 73 74 6f 70 d : stop
1f70: 20 73 65 72 76 65 72 20 73 70 65 63 69 66 69 65 server specifie
1f80: 64 20 62 79 20 69 64 20 28 73 65 65 20 6f 75 74 d by id (see out
1f90: 70 75 74 20 6f 66 20 2d 6c 69 73 74 2d 73 65 72 put of -list-ser
1fa0: 76 65 72 73 29 2c 20 75 73 65 0a 20 20 20 20 20 vers), use.
1fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fc0: 20 20 20 20 20 20 20 30 20 74 6f 20 6b 69 6c 6c 0 to kill
1fd0: 20 61 6c 6c 0a 20 20 2d 72 65 70 6c 20 20 20 20 all. -repl
1fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
1ff0: 20 73 74 61 72 74 20 61 20 72 65 70 6c 20 28 75 start a repl (u
2000: 73 65 66 75 6c 20 66 6f 72 20 65 78 74 65 6e 64 seful for extend
2010: 69 6e 67 20 6d 65 67 61 74 65 73 74 29 0a 20 20 ing megatest).
2020: 2d 6c 6f 61 64 20 66 69 6c 65 2e 73 63 6d 20 20 -load file.scm
2030: 20 20 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 61 : load a
2040: 6e 64 20 72 75 6e 20 66 69 6c 65 2e 73 63 6d 0a nd run file.scm.
2050: 20 20 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 -mark-incomple
2060: 74 65 73 20 20 20 20 20 20 20 3a 20 66 69 6e 64 tes : find
2070: 20 61 6e 64 20 6d 61 72 6b 20 69 6e 63 6f 6d 70 and mark incomp
2080: 6c 65 74 65 20 74 65 73 74 73 0a 20 20 2d 70 69 lete tests. -pi
2090: 6e 67 20 72 75 6e 2d 69 64 7c 68 6f 73 74 3a 70 ng run-id|host:p
20a0: 6f 72 74 20 20 3a 20 70 69 6e 67 20 73 65 72 76 ort : ping serv
20b0: 65 72 2c 20 65 78 69 74 20 77 69 74 68 20 30 20 er, exit with 0
20c0: 69 66 20 66 6f 75 6e 64 0a 20 20 2d 64 65 62 75 if found. -debu
20d0: 67 20 4e 7c 4e 2c 4d 2c 4f 2e 2e 2e 20 20 20 20 g N|N,M,O...
20e0: 20 20 20 3a 20 65 6e 61 62 6c 65 20 64 65 62 75 : enable debu
20f0: 67 20 30 2d 4e 20 6f 72 20 4e 20 61 6e 64 20 4d g 0-N or N and M
2100: 20 61 6e 64 20 4f 20 2e 2e 2e 0a 0a 55 74 69 6c and O .....Util
2110: 69 74 69 65 73 0a 20 20 2d 65 6e 76 32 66 69 6c ities. -env2fil
2120: 65 20 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 e fname
2130: 3a 20 77 72 69 74 65 20 74 68 65 20 65 6e 76 69 : write the envi
2140: 72 6f 6e 6d 65 6e 74 20 74 6f 20 66 6e 61 6d 65 ronment to fname
2150: 2e 63 73 68 20 61 6e 64 20 66 6e 61 6d 65 2e 73 .csh and fname.s
2160: 68 0a 20 20 2d 65 6e 76 63 61 70 20 66 6e 61 6d h. -envcap fnam
2170: 65 3d 63 6f 6e 74 65 78 74 20 20 20 3a 20 73 61 e=context : sa
2180: 76 65 20 63 75 72 72 65 6e 74 20 76 61 72 69 61 ve current varia
2190: 62 6c 65 73 20 6c 61 62 65 6c 65 64 20 61 73 20 bles labeled as
21a0: 63 6f 6e 74 65 78 74 20 69 6e 20 66 69 6c 65 20 context in file
21b0: 66 6e 61 6d 65 0a 20 20 2d 72 65 66 64 62 32 64 fname. -refdb2d
21c0: 61 74 20 72 65 66 64 62 20 20 20 20 20 20 20 20 at refdb
21d0: 3a 20 63 6f 6e 76 65 72 74 20 72 65 66 64 62 20 : convert refdb
21e0: 74 6f 20 73 65 78 70 20 6f 72 20 74 6f 20 66 6f to sexp or to fo
21f0: 72 6d 61 74 20 73 70 65 63 69 66 69 65 64 20 62 rmat specified b
2200: 79 20 2d 64 75 6d 70 6d 6f 64 65 0a 20 20 20 20 y -dumpmode.
2210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2220: 20 20 20 20 20 20 20 20 66 6f 72 6d 61 74 73 3a formats:
2230: 20 70 65 72 6c 2c 20 72 75 62 79 2c 20 73 71 6c perl, ruby, sql
2240: 69 74 65 33 2c 20 63 73 76 20 28 66 6f 72 20 63 ite3, csv (for c
2250: 73 76 20 74 68 65 20 2d 6f 20 70 61 72 61 6d 0a sv the -o param.
2260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2270: 20 20 20 20 20 20 20 20 20 20 20 20 77 69 6c 6c will
2280: 20 73 75 62 73 74 69 74 75 74 65 20 25 73 20 66 substitute %s f
2290: 6f 72 20 74 68 65 20 73 68 65 65 74 20 6e 61 6d or the sheet nam
22a0: 65 20 69 6e 20 67 65 6e 65 72 61 74 69 6e 67 20 e in generating
22b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
22c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 6d 75 6c mul
22d0: 74 69 70 6c 65 20 73 68 65 65 74 73 29 0a 20 20 tiple sheets).
22e0: 2d 6f 20 20 20 20 20 20 20 20 20 20 20 20 20 20 -o
22f0: 20 20 20 20 20 20 20 20 3a 20 6f 75 74 70 75 74 : output
2300: 20 66 69 6c 65 20 66 6f 72 20 72 65 66 64 62 32 file for refdb2
2310: 64 61 74 20 28 64 65 66 61 75 6c 74 73 20 74 6f dat (defaults to
2320: 20 73 74 64 6f 75 74 29 0a 20 20 2d 61 72 63 68 stdout). -arch
2330: 69 76 65 20 63 6d 64 20 20 20 20 20 20 20 20 20 ive cmd
2340: 20 20 20 3a 20 61 72 63 68 69 76 65 20 72 75 6e : archive run
2350: 73 20 73 70 65 63 69 66 69 65 64 20 62 79 20 73 s specified by s
2360: 65 6c 65 63 74 6f 72 73 20 74 6f 20 6f 6e 65 20 electors to one
2370: 6f 66 20 64 69 73 6b 73 20 73 70 65 63 69 66 69 of disks specifi
2380: 65 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ed.
2390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 i
23a0: 6e 20 74 68 65 20 5b 61 72 63 68 69 76 65 2d 64 n the [archive-d
23b0: 69 73 6b 73 5d 20 73 65 63 74 69 6f 6e 2e 0a 20 isks] section..
23c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23d0: 20 20 20 20 20 20 20 20 20 20 20 63 6d 64 3a 20 cmd:
23e0: 6b 65 65 70 2d 68 74 6d 6c 2c 20 72 65 73 74 6f keep-html, resto
23f0: 72 65 2c 20 73 61 76 65 2c 20 73 61 76 65 2d 72 re, save, save-r
2400: 65 6d 6f 76 65 0a 20 20 2d 67 65 6e 65 72 61 74 emove. -generat
2410: 65 2d 68 74 6d 6c 20 20 20 20 20 20 20 20 20 20 e-html
2420: 3a 20 63 72 65 61 74 65 20 61 20 73 69 6d 70 6c : create a simpl
2430: 65 20 68 74 6d 6c 20 74 72 65 65 20 66 6f 72 20 e html tree for
2440: 62 72 6f 77 73 69 6e 67 20 79 6f 75 72 20 72 75 browsing your ru
2450: 6e 73 0a 0a 44 69 66 66 20 72 65 70 6f 72 74 0a ns..Diff report.
2460: 20 20 2d 64 69 66 66 2d 72 65 70 20 20 20 20 20 -diff-rep
2470: 20 20 20 20 20 20 20 20 20 20 3a 20 67 65 6e 65 : gene
2480: 72 61 74 65 20 64 69 66 66 20 72 65 70 6f 72 74 rate diff report
2490: 20 28 6d 75 73 74 20 69 6e 63 6c 75 64 65 20 2d (must include -
24a0: 73 72 63 2d 74 61 72 67 65 74 2c 20 2d 73 72 63 src-target, -src
24b0: 2d 72 75 6e 6e 61 6d 65 2c 20 2d 74 61 72 67 65 -runname, -targe
24c0: 74 2c 20 2d 72 75 6e 6e 61 6d 65 0a 20 20 20 20 t, -runname.
24d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 6e an
2500: 64 20 65 69 74 68 65 72 20 2d 64 69 66 66 2d 65 d either -diff-e
2510: 6d 61 69 6c 20 6f 72 20 2d 64 69 66 66 2d 68 74 mail or -diff-ht
2520: 6d 6c 29 0a 20 20 2d 73 72 63 2d 74 61 72 67 65 ml). -src-targe
2530: 74 20 3c 74 61 72 67 65 74 3e 0a 20 20 2d 73 72 t <target>. -sr
2540: 63 2d 72 75 6e 6e 61 6d 65 20 3c 74 61 72 67 65 c-runname <targe
2550: 74 3e 0a 20 20 2d 64 69 66 66 2d 65 6d 61 69 6c t>. -diff-email
2560: 20 3c 65 6d 61 69 6c 73 3e 20 20 20 20 3a 20 63 <emails> : c
2570: 6f 6d 6d 61 20 73 65 70 61 72 61 74 65 64 20 6c omma separated l
2580: 69 73 74 20 6f 66 20 65 6d 61 69 6c 20 61 64 64 ist of email add
2590: 72 65 73 73 65 73 20 74 6f 20 73 65 6e 64 20 64 resses to send d
25a0: 69 66 66 20 72 65 70 6f 72 74 0a 20 20 2d 64 69 iff report. -di
25b0: 66 66 2d 68 74 6d 6c 20 20 3c 72 65 70 2e 68 74 ff-html <rep.ht
25c0: 6d 6c 3e 20 20 3a 20 70 61 74 68 20 74 6f 20 68 ml> : path to h
25d0: 74 6d 6c 20 66 69 6c 65 20 74 6f 20 67 65 6e 65 tml file to gene
25e0: 72 61 74 65 0a 0a 53 70 72 65 61 64 73 68 65 65 rate..Spreadshee
25f0: 74 20 67 65 6e 65 72 61 74 69 6f 6e 0a 20 20 2d t generation. -
2600: 65 78 74 72 61 63 74 2d 6f 64 73 20 66 6e 61 6d extract-ods fnam
2610: 65 2e 6f 64 73 20 20 3a 20 65 78 74 72 61 63 74 e.ods : extract
2620: 20 61 6e 20 6f 70 65 6e 20 64 6f 63 75 6d 65 6e an open documen
2630: 74 20 73 70 72 65 61 64 73 68 65 65 74 20 66 72 t spreadsheet fr
2640: 6f 6d 20 74 68 65 20 64 61 74 61 62 61 73 65 0a om the database.
2650: 20 20 2d 70 61 74 68 6d 6f 64 20 70 61 74 68 20 -pathmod path
2660: 20 20 20 20 20 20 20 20 20 20 3a 20 69 6e 73 65 : inse
2670: 72 74 20 70 61 74 68 2c 20 69 2e 65 2e 20 70 61 rt path, i.e. pa
2680: 74 68 2f 72 75 6e 61 6d 65 2f 69 74 65 6d 70 61 th/runame/itempa
2690: 74 68 2f 6c 6f 67 66 69 6c 65 2e 68 74 6d 6c 0a th/logfile.html.
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 77 69 6c 6c will
26c0: 20 63 6c 65 61 72 20 74 68 65 20 66 69 65 6c 64 clear the field
26d0: 20 69 66 20 6e 6f 20 72 75 6e 64 69 72 2f 74 65 if no rundir/te
26e0: 73 74 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f stname/itempath/
26f0: 6c 6f 67 66 69 6c 65 0a 20 20 20 20 20 20 20 20 logfile.
2700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2710: 20 20 20 20 69 66 20 69 74 20 63 6f 6e 74 61 69 if it contai
2720: 6e 73 20 66 6f 72 77 61 72 64 20 73 6c 61 73 68 ns forward slash
2730: 65 73 20 74 68 65 20 70 61 74 68 20 77 69 6c 6c es the path will
2740: 20 62 65 20 63 6f 6e 76 65 72 74 65 64 0a 20 20 be converted.
2750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2760: 20 20 20 20 20 20 20 20 20 20 74 6f 20 77 69 6e to win
2770: 64 6f 77 73 20 73 74 79 6c 65 0a 47 65 74 74 69 dows style.Getti
2780: 6e 67 20 73 74 61 72 74 65 64 0a 20 20 2d 63 72 ng started. -cr
2790: 65 61 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 72 eate-megatest-ar
27a0: 65 61 20 20 20 20 20 20 20 3a 20 63 72 65 61 74 ea : creat
27b0: 65 20 61 20 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 e a skeleton meg
27c0: 61 74 65 73 74 20 61 72 65 61 2e 20 59 6f 75 20 atest area. You
27d0: 77 69 6c 6c 20 62 65 20 70 72 6f 6d 70 74 65 64 will be prompted
27e0: 20 66 6f 72 20 70 61 74 68 73 0a 20 20 2d 63 72 for paths. -cr
27f0: 65 61 74 65 2d 74 65 73 74 20 74 65 73 74 6e 61 eate-test testna
2800: 6d 65 20 20 20 20 20 20 20 3a 20 63 72 65 61 74 me : creat
2810: 65 20 61 20 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 e a skeleton meg
2820: 61 74 65 73 74 20 74 65 73 74 2e 20 59 6f 75 20 atest test. You
2830: 77 69 6c 6c 20 62 65 20 70 72 6f 6d 70 74 65 64 will be prompted
2840: 20 66 6f 72 20 69 6e 66 6f 0a 0a 45 78 61 6d 70 for info..Examp
2850: 6c 65 73 0a 0a 23 20 47 65 74 20 74 65 73 74 20 les..# Get test
2860: 70 61 74 68 2c 20 75 73 65 20 27 2e 27 20 74 6f path, use '.' to
2870: 20 67 65 74 20 61 20 73 69 6e 67 6c 65 20 70 61 get a single pa
2880: 74 68 20 6f 72 20 61 20 73 70 65 63 69 66 69 63 th or a specific
2890: 20 70 61 74 68 2f 66 69 6c 65 20 70 61 74 74 65 path/file patte
28a0: 72 6e 0a 6d 65 67 61 74 65 73 74 20 2d 74 65 73 rn.megatest -tes
28b0: 74 2d 66 69 6c 65 73 20 27 6c 6f 67 73 2f 2a 2e t-files 'logs/*.
28c0: 6c 6f 67 27 20 2d 74 61 72 67 65 74 20 75 62 75 log' -target ubu
28d0: 6e 74 75 2f 6e 25 2f 6e 6f 25 20 2d 72 75 6e 6e ntu/n%/no% -runn
28e0: 61 6d 65 20 77 34 39 25 20 2d 74 65 73 74 70 61 ame w49% -testpa
28f0: 74 74 20 74 65 73 74 5f 6d 74 25 0a 0a 43 61 6c tt test_mt%..Cal
2900: 6c 65 64 20 61 73 20 22 20 28 73 74 72 69 6e 67 led as " (string
2910: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 61 72 -intersperse (ar
2920: 67 76 29 20 22 20 22 29 20 22 0a 56 65 72 73 69 gv) " ") ".Versi
2930: 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 on " megatest-ve
2940: 72 73 69 6f 6e 20 22 2c 20 62 75 69 6c 74 20 66 rsion ", built f
2950: 72 6f 6d 20 22 20 6d 65 67 61 74 65 73 74 2d 66 rom " megatest-f
2960: 6f 73 73 69 6c 2d 68 61 73 68 20 29 29 0a 0a 3b ossil-hash ))..;
2970: 3b 20 20 2d 67 75 69 20 20 20 20 20 20 20 20 20 ; -gui
2980: 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 74 61 : sta
2990: 72 74 20 61 20 67 75 69 20 69 6e 74 65 72 66 61 rt a gui interfa
29a0: 63 65 0a 3b 3b 20 20 2d 63 6f 6e 66 69 67 20 66 ce.;; -config f
29b0: 6e 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 3a name :
29c0: 20 6f 76 65 72 72 69 64 65 20 74 68 65 20 72 75 override the ru
29d0: 6e 63 6f 6e 66 69 67 20 66 69 6c 65 20 77 69 74 nconfig file wit
29e0: 68 20 66 6e 61 6d 65 0a 0a 3b 3b 20 70 72 6f 63 h fname..;; proc
29f0: 65 73 73 20 61 72 67 73 0a 28 64 65 66 69 6e 65 ess args.(define
2a00: 20 72 65 6d 61 72 67 73 20 28 61 72 67 73 3a 67 remargs (args:g
2a10: 65 74 2d 61 72 67 73 20 0a 09 09 20 28 61 72 67 et-args ... (arg
2a20: 76 29 0a 09 09 20 28 6c 69 73 74 20 20 22 2d 72 v)... (list "-r
2a30: 75 6e 74 65 73 74 73 22 20 20 3b 3b 20 72 75 6e untests" ;; run
2a40: 20 61 20 73 70 65 63 69 66 69 63 20 74 65 73 74 a specific test
2a50: 0a 09 09 09 22 2d 63 6f 6e 66 69 67 22 20 20 20 ...."-config"
2a60: 20 3b 3b 20 6f 76 65 72 72 69 64 65 20 74 68 65 ;; override the
2a70: 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e 61 6d config file nam
2a80: 65 0a 09 09 09 22 2d 65 78 65 63 75 74 65 22 20 e...."-execute"
2a90: 20 20 3b 3b 20 72 75 6e 20 74 68 65 20 63 6f 6d ;; run the com
2aa0: 6d 61 6e 64 20 65 6e 63 6f 64 65 64 20 69 6e 20 mand encoded in
2ab0: 74 68 65 20 62 61 73 65 36 34 20 70 61 72 61 6d the base64 param
2ac0: 65 74 65 72 0a 09 09 09 22 2d 73 74 65 70 22 0a eter...."-step".
2ad0: 09 09 09 22 2d 74 61 72 67 65 74 22 0a 09 09 09 ..."-target"....
2ae0: 22 2d 72 65 71 74 61 72 67 22 0a 09 09 09 22 3a "-reqtarg"....":
2af0: 72 75 6e 6e 61 6d 65 22 0a 09 09 09 22 2d 72 75 runname"...."-ru
2b00: 6e 6e 61 6d 65 22 0a 09 09 09 22 3a 73 74 61 74 nname"....":stat
2b10: 65 22 20 20 0a 09 09 09 22 2d 73 74 61 74 65 22 e" ...."-state"
2b20: 0a 09 09 09 22 3a 73 74 61 74 75 73 22 0a 09 09 ....":status"...
2b30: 09 22 2d 73 74 61 74 75 73 22 0a 09 09 09 22 2d ."-status"...."-
2b40: 6c 69 73 74 2d 72 75 6e 73 22 0a 09 09 09 22 2d list-runs"...."-
2b50: 74 65 73 74 70 61 74 74 22 0a 20 20 20 20 20 20 testpatt".
2b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b70: 20 20 22 2d 2d 6d 6f 64 65 70 61 74 74 22 0a 20 "--modepatt".
2b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b90: 20 20 20 20 20 20 20 22 2d 74 61 67 65 78 70 72 "-tagexpr
2ba0: 22 0a 09 09 09 22 2d 69 74 65 6d 70 61 74 74 22 "...."-itempatt"
2bb0: 0a 09 09 09 22 2d 73 65 74 6c 6f 67 22 0a 09 09 ...."-setlog"...
2bc0: 09 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 0a 09 ."-set-toplog"..
2bd0: 09 09 22 2d 72 75 6e 73 74 65 70 22 0a 09 09 09 .."-runstep"....
2be0: 22 2d 6c 6f 67 70 72 6f 22 0a 09 09 09 22 2d 6d "-logpro"...."-m
2bf0: 22 0a 09 09 09 22 2d 72 65 72 75 6e 22 0a 09 09 "...."-rerun"...
2c00: 09 22 2d 64 61 79 73 22 0a 09 09 09 22 2d 72 65 ."-days"...."-re
2c10: 6e 61 6d 65 2d 72 75 6e 22 0a 09 09 09 22 2d 74 name-run"...."-t
2c20: 6f 22 0a 09 09 09 3b 3b 20 76 61 6c 75 65 73 20 o"....;; values
2c30: 61 6e 64 20 6d 65 73 73 61 67 65 73 0a 09 09 09 and messages....
2c40: 22 3a 63 61 74 65 67 6f 72 79 22 0a 09 09 09 22 ":category"...."
2c50: 3a 76 61 72 69 61 62 6c 65 22 0a 09 09 09 22 3a :variable"....":
2c60: 76 61 6c 75 65 22 0a 09 09 09 22 3a 65 78 70 65 value"....":expe
2c70: 63 74 65 64 22 0a 09 09 09 22 3a 74 6f 6c 22 0a cted"....":tol".
2c80: 09 09 09 22 3a 75 6e 69 74 73 22 0a 09 09 09 3b ...":units"....;
2c90: 3b 20 6d 69 73 63 0a 09 09 09 22 2d 73 74 61 72 ; misc...."-star
2ca0: 74 2d 64 69 72 22 0a 09 09 09 22 2d 63 6f 6e 74 t-dir"...."-cont
2cb0: 6f 75 72 22 0a 09 09 09 22 2d 73 65 72 76 65 72 our"...."-server
2cc0: 22 0a 09 09 09 22 2d 73 74 6f 70 2d 73 65 72 76 "...."-stop-serv
2cd0: 65 72 22 0a 09 09 09 22 2d 74 72 61 6e 73 70 6f er"...."-transpo
2ce0: 72 74 22 0a 09 09 09 22 2d 6b 69 6c 6c 2d 73 65 rt"...."-kill-se
2cf0: 72 76 65 72 22 0a 09 09 09 22 2d 70 6f 72 74 22 rver"...."-port"
2d00: 0a 09 09 09 22 2d 65 78 74 72 61 63 74 2d 6f 64 ...."-extract-od
2d10: 73 22 0a 09 09 09 22 2d 70 61 74 68 6d 6f 64 22 s"...."-pathmod"
2d20: 0a 09 09 09 22 2d 65 6e 76 32 66 69 6c 65 22 0a ...."-env2file".
2d30: 09 09 09 22 2d 65 6e 76 63 61 70 22 0a 09 09 09 ..."-envcap"....
2d40: 22 2d 65 6e 76 64 65 6c 74 61 22 0a 09 09 09 22 "-envdelta"...."
2d50: 2d 73 65 74 76 61 72 73 22 0a 09 09 09 22 2d 73 -setvars"...."-s
2d60: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 et-state-status"
2d70: 0a 09 09 09 22 2d 73 65 74 2d 72 75 6e 2d 73 74 ...."-set-run-st
2d80: 61 74 75 73 22 0a 09 09 09 22 2d 64 65 62 75 67 atus"...."-debug
2d90: 22 20 3b 3b 20 66 6f 72 20 2a 76 65 72 62 6f 73 " ;; for *verbos
2da0: 69 74 79 2a 20 3e 20 32 0a 09 09 09 22 2d 63 72 ity* > 2...."-cr
2db0: 65 61 74 65 2d 74 65 73 74 22 0a 09 09 09 22 2d eate-test"...."-
2dc0: 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 74 override-timeout
2dd0: 22 0a 09 09 09 22 2d 74 65 73 74 2d 66 69 6c 65 "...."-test-file
2de0: 73 22 20 20 3b 3b 20 2d 74 65 73 74 2d 70 61 74 s" ;; -test-pat
2df0: 68 73 20 69 73 20 66 6f 72 20 6c 69 73 74 69 6e hs is for listin
2e00: 67 20 61 6c 6c 0a 09 09 09 22 2d 6c 6f 61 64 22 g all...."-load"
2e10: 20 20 20 20 20 20 20 20 3b 3b 20 6c 6f 61 64 20 ;; load
2e20: 61 6e 64 20 65 78 65 63 74 75 74 65 20 61 20 73 and exectute a s
2e30: 63 68 65 6d 65 20 66 69 6c 65 0a 09 09 09 22 2d cheme file...."-
2e40: 73 65 63 74 69 6f 6e 22 0a 09 09 09 22 2d 76 61 section"...."-va
2e50: 72 22 0a 09 09 09 22 2d 64 75 6d 70 6d 6f 64 65 r"...."-dumpmode
2e60: 22 0a 09 09 09 22 2d 72 75 6e 2d 69 64 22 0a 09 "...."-run-id"..
2e70: 09 09 22 2d 70 69 6e 67 22 0a 09 09 09 22 2d 72 .."-ping"...."-r
2e80: 65 66 64 62 32 64 61 74 22 0a 09 09 09 22 2d 6f efdb2dat"...."-o
2e90: 22 0a 09 09 09 22 2d 6c 6f 67 22 0a 09 09 09 22 "...."-log"...."
2ea0: 2d 61 72 63 68 69 76 65 22 0a 09 09 09 22 2d 73 -archive"...."-s
2eb0: 69 6e 63 65 22 0a 09 09 09 22 2d 66 69 65 6c 64 ince"...."-field
2ec0: 73 22 0a 09 09 09 22 2d 72 65 63 6f 76 65 72 2d s"...."-recover-
2ed0: 74 65 73 74 22 20 3b 3b 20 72 75 6e 2d 69 64 2c test" ;; run-id,
2ee0: 74 65 73 74 2d 69 64 20 2d 20 75 73 65 64 20 69 test-id - used i
2ef0: 6e 74 65 72 6e 61 6c 6c 79 20 74 6f 20 72 65 63 nternally to rec
2f00: 6f 76 65 72 20 61 20 74 65 73 74 20 73 74 75 63 over a test stuc
2f10: 6b 20 69 6e 20 52 55 4e 4e 49 4e 47 20 73 74 61 k in RUNNING sta
2f20: 74 65 0a 09 09 09 22 2d 73 6f 72 74 22 0a 09 09 te...."-sort"...
2f30: 09 22 2d 74 61 72 67 65 74 2d 64 62 22 0a 09 09 ."-target-db"...
2f40: 09 22 2d 73 6f 75 72 63 65 2d 64 62 22 0a 0a 20 ."-source-db"..
2f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f60: 20 20 20 20 20 20 20 22 2d 73 72 63 2d 74 61 72 "-src-tar
2f70: 67 65 74 22 0a 20 20 20 20 20 20 20 20 20 20 20 get".
2f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 2d 73 "-s
2f90: 72 63 2d 72 75 6e 6e 61 6d 65 22 0a 20 20 20 20 rc-runname".
2fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2fb0: 20 20 20 20 22 2d 64 69 66 66 2d 65 6d 61 69 6c "-diff-email
2fc0: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ".
2fd0: 20 20 20 20 20 20 20 20 20 20 22 2d 64 69 66 66 "-diff
2fe0: 2d 68 74 6d 6c 22 0a 09 09 09 29 0a 20 09 09 20 -html"....). ..
2ff0: 28 6c 69 73 74 20 20 22 2d 68 22 20 22 2d 68 65 (list "-h" "-he
3000: 6c 70 22 20 22 2d 2d 68 65 6c 70 22 0a 09 09 09 lp" "--help"....
3010: 22 2d 6d 61 6e 75 61 6c 22 0a 09 09 09 22 2d 76 "-manual"...."-v
3020: 65 72 73 69 6f 6e 22 0a 09 09 20 20 20 20 20 20 ersion"...
3030: 20 20 22 2d 66 6f 72 63 65 22 0a 09 09 20 20 20 "-force"...
3040: 20 20 20 20 20 22 2d 78 74 65 72 6d 22 0a 09 09 "-xterm"...
3050: 20 20 20 20 20 20 20 20 22 2d 73 68 6f 77 6b 65 "-showke
3060: 79 73 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d ys"... "-
3070: 73 68 6f 77 2d 6b 65 79 73 22 0a 09 09 20 20 20 show-keys"...
3080: 20 20 20 20 20 22 2d 74 65 73 74 2d 73 74 61 74 "-test-stat
3090: 75 73 22 0a 09 09 09 22 2d 73 65 74 2d 76 61 6c us"...."-set-val
30a0: 75 65 73 22 0a 09 09 09 22 2d 6c 6f 61 64 2d 74 ues"...."-load-t
30b0: 65 73 74 2d 64 61 74 61 22 0a 09 09 09 22 2d 73 est-data"...."-s
30c0: 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 0a ummarize-items".
30d0: 09 09 20 20 20 20 20 20 20 20 22 2d 67 75 69 22 .. "-gui"
30e0: 0a 09 09 09 22 2d 64 61 65 6d 6f 6e 69 7a 65 22 ...."-daemonize"
30f0: 0a 09 09 09 22 2d 70 72 65 63 6c 65 61 6e 22 0a ...."-preclean".
3100: 09 09 09 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e ..."-rerun-clean
3110: 22 0a 09 09 09 22 2d 72 65 72 75 6e 2d 61 6c 6c "...."-rerun-all
3120: 22 0a 09 09 09 22 2d 63 6c 65 61 6e 2d 63 61 63 "...."-clean-cac
3130: 68 65 22 0a 09 09 09 22 2d 63 61 63 68 65 2d 64 he"...."-cache-d
3140: 62 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 b".
3150: 20 20 20 20 20 20 20 20 20 20 20 22 2d 75 73 65 "-use
3160: 2d 64 62 2d 63 61 63 68 65 22 0a 09 09 09 3b 3b -db-cache"....;;
3170: 20 6d 69 73 63 0a 09 09 09 22 2d 72 65 70 6c 22 misc...."-repl"
3180: 0a 09 09 09 22 2d 6c 6f 63 6b 22 0a 09 09 09 22 ...."-lock"...."
3190: 2d 75 6e 6c 6f 63 6b 22 0a 09 09 09 22 2d 6c 69 -unlock"...."-li
31a0: 73 74 2d 73 65 72 76 65 72 73 22 0a 20 20 20 20 st-servers".
31b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
31c0: 20 20 20 20 22 2d 72 75 6e 2d 77 61 69 74 22 20 "-run-wait"
31d0: 20 20 20 20 20 3b 3b 20 77 61 69 74 20 6f 6e 20 ;; wait on
31e0: 61 20 72 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 a run to complet
31f0: 65 20 28 69 2e 65 2e 20 6e 6f 20 52 55 4e 4e 49 e (i.e. no RUNNI
3200: 4e 47 29 0a 09 09 09 22 2d 6c 6f 63 61 6c 22 20 NG)...."-local"
3210: 20 20 20 20 20 20 20 20 3b 3b 20 72 75 6e 20 73 ;; run s
3220: 6f 6d 65 20 63 6f 6d 6d 61 6e 64 73 20 75 73 69 ome commands usi
3230: 6e 67 20 6c 6f 63 61 6c 20 64 62 20 61 63 63 65 ng local db acce
3240: 73 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ss.
3250: 20 20 20 20 20 20 20 20 20 20 20 22 2d 67 65 6e "-gen
3260: 65 72 61 74 65 2d 68 74 6d 6c 22 0a 0a 09 09 09 erate-html".....
3270: 3b 3b 20 6d 69 73 63 20 71 75 65 72 69 65 73 0a ;; misc queries.
3280: 09 09 09 22 2d 6c 69 73 74 2d 64 69 73 6b 73 22 ..."-list-disks"
3290: 0a 09 09 09 22 2d 6c 69 73 74 2d 74 61 72 67 65 ...."-list-targe
32a0: 74 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d 64 62 ts"...."-list-db
32b0: 2d 74 61 72 67 65 74 73 22 0a 09 09 09 22 2d 73 -targets"...."-s
32c0: 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 22 0a 09 how-runconfig"..
32d0: 09 09 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 22 .."-show-config"
32e0: 0a 09 09 09 22 2d 73 68 6f 77 2d 63 6d 64 69 6e ...."-show-cmdin
32f0: 66 6f 22 0a 09 09 09 22 2d 67 65 74 2d 72 75 6e fo"...."-get-run
3300: 2d 73 74 61 74 75 73 22 0a 0a 09 09 09 3b 3b 20 -status".....;;
3310: 71 75 65 72 69 65 73 0a 09 09 09 22 2d 74 65 73 queries...."-tes
3320: 74 2d 70 61 74 68 73 22 20 3b 3b 20 67 65 74 20 t-paths" ;; get
3330: 70 61 74 68 28 73 29 20 74 6f 20 61 20 74 65 73 path(s) to a tes
3340: 74 2c 20 6f 72 64 65 72 65 64 20 62 79 20 79 6f t, ordered by yo
3350: 75 6e 67 65 73 74 20 66 69 72 73 74 0a 0a 09 09 ungest first....
3360: 09 22 2d 72 75 6e 61 6c 6c 22 20 20 20 20 3b 3b ."-runall" ;;
3370: 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 2c 20 run all tests,
3380: 72 65 73 70 65 63 74 73 20 2d 74 65 73 74 70 61 respects -testpa
3390: 74 74 2c 20 64 65 66 61 75 6c 74 73 20 74 6f 20 tt, defaults to
33a0: 25 0a 09 09 09 22 2d 72 75 6e 22 20 20 20 20 20 %...."-run"
33b0: 20 20 3b 3b 20 61 6c 69 61 73 20 66 6f 72 20 2d ;; alias for -
33c0: 72 75 6e 61 6c 6c 0a 09 09 09 22 2d 72 65 6d 6f runall...."-remo
33d0: 76 65 2d 72 75 6e 73 22 0a 09 09 09 22 2d 72 65 ve-runs"...."-re
33e0: 62 75 69 6c 64 2d 64 62 22 0a 09 09 09 22 2d 63 build-db"...."-c
33f0: 6c 65 61 6e 75 70 2d 64 62 22 0a 09 09 09 22 2d leanup-db"...."-
3400: 72 6f 6c 6c 75 70 22 0a 09 09 09 22 2d 75 70 64 rollup"...."-upd
3410: 61 74 65 2d 6d 65 74 61 22 0a 09 09 09 22 2d 63 ate-meta"...."-c
3420: 72 65 61 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 reate-megatest-a
3430: 72 65 61 22 0a 09 09 09 22 2d 6d 61 72 6b 2d 69 rea"...."-mark-i
3440: 6e 63 6f 6d 70 6c 65 74 65 73 22 0a 0a 09 09 09 ncompletes".....
3450: 22 2d 63 6f 6e 76 65 72 74 2d 74 6f 2d 6e 6f 72 "-convert-to-nor
3460: 6d 22 0a 09 09 09 22 2d 63 6f 6e 76 65 72 74 2d m"...."-convert-
3470: 74 6f 2d 6f 6c 64 22 0a 09 09 09 22 2d 69 6d 70 to-old"...."-imp
3480: 6f 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 ort-megatest.db"
3490: 0a 09 09 09 22 2d 73 79 6e 63 2d 74 6f 2d 6d 65 ...."-sync-to-me
34a0: 67 61 74 65 73 74 2e 64 62 22 0a 09 09 09 22 2d gatest.db"...."-
34b0: 73 79 6e 63 2d 74 6f 2d 63 6f 6e 66 69 67 64 62 sync-to-configdb
34c0: 22 0a 0a 09 09 09 22 2d 6c 6f 67 67 69 6e 67 22 "....."-logging"
34d0: 0a 09 09 09 22 2d 76 22 20 3b 3b 20 76 65 72 62 ...."-v" ;; verb
34e0: 6f 73 65 20 32 2c 20 6d 6f 72 65 20 74 68 61 6e ose 2, more than
34f0: 20 6e 6f 72 6d 61 6c 20 28 6e 6f 72 6d 61 6c 20 normal (normal
3500: 69 73 20 31 29 0a 09 09 09 22 2d 71 22 20 3b 3b is 1)...."-q" ;;
3510: 20 71 75 69 65 74 20 30 2c 20 65 72 72 6f 72 73 quiet 0, errors
3520: 2f 77 61 72 6e 69 6e 67 73 20 6f 6e 6c 79 0a 0a /warnings only..
3530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3540: 20 20 20 20 20 20 20 20 22 2d 64 69 66 66 2d 72 "-diff-r
3550: 65 70 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 ep".
3560: 20 20 20 20 20 20 20 20 20 20 20 20 29 0a 09 09 )...
3570: 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 0a 09 args:arg-hash..
3580: 09 20 30 29 29 0a 0a 3b 3b 20 41 64 64 20 61 72 . 0))..;; Add ar
3590: 67 73 20 74 68 61 74 20 75 73 65 20 72 65 6d 61 gs that use rema
35a0: 72 67 73 20 68 65 72 65 0a 3b 3b 0a 28 69 66 20 rgs here.;;.(if
35b0: 28 61 6e 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (and (not (null?
35c0: 20 72 65 6d 61 72 67 73 29 29 0a 09 20 28 6e 6f remargs)).. (no
35d0: 74 20 28 6f 72 0a 09 20 20 20 20 20 20 20 28 61 t (or.. (a
35e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
35f0: 6e 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 20 nstep")..
3600: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3610: 65 6e 76 63 61 70 22 29 0a 09 20 20 20 20 20 20 envcap")..
3620: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3630: 2d 65 6e 76 64 65 6c 74 61 22 29 0a 09 20 20 20 -envdelta")..
3640: 20 20 20 20 29 0a 09 20 20 20 20 20 20 29 29 0a ).. )).
3650: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
3660: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
3670: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 6e 72 t-log-port* "Unr
3680: 65 63 6f 67 6e 69 73 65 64 20 61 72 67 75 6d 65 ecognised argume
3690: 6e 74 73 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 nts: " (string-i
36a0: 6e 74 65 72 73 70 65 72 73 65 20 28 69 66 20 28 ntersperse (if (
36b0: 6c 69 73 74 3f 20 72 65 6d 61 72 67 73 29 20 72 list? remargs) r
36c0: 65 6d 61 72 67 73 20 28 61 72 67 76 29 29 20 20 emargs (argv))
36d0: 22 20 22 29 29 29 0a 0a 3b 3b 20 69 6d 6d 65 64 " ")))..;; immed
36e0: 69 61 74 65 6c 79 20 73 65 74 20 4d 54 5f 54 41 iately set MT_TA
36f0: 52 47 45 54 20 69 66 20 2d 72 65 71 74 61 72 67 RGET if -reqtarg
3700: 20 6f 72 20 2d 74 61 72 67 65 74 20 61 72 65 20 or -target are
3710: 61 76 61 69 6c 61 62 6c 65 0a 3b 3b 0a 28 6c 65 available.;;.(le
3720: 74 20 28 28 74 61 72 67 20 28 6f 72 20 28 61 72 t ((targ (or (ar
3730: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 71 gs:get-arg "-req
3740: 74 61 72 67 22 29 28 61 72 67 73 3a 67 65 74 2d targ")(args:get-
3750: 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 29 29 arg "-target")))
3760: 29 0a 20 20 28 69 66 20 74 61 72 67 20 28 73 65 ). (if targ (se
3770: 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 tenv "MT_TARGET"
3780: 20 74 61 72 67 29 29 29 0a 0a 3b 3b 20 54 68 65 targ)))..;; The
3790: 20 77 61 74 63 68 64 6f 67 20 69 73 20 74 6f 20 watchdog is to
37a0: 6b 65 65 70 20 61 6e 20 65 79 65 20 6f 6e 20 74 keep an eye on t
37b0: 68 69 6e 67 73 20 6c 69 6b 65 20 64 62 20 73 79 hings like db sy
37c0: 6e 63 20 65 74 63 2e 0a 3b 3b 0a 28 64 65 66 69 nc etc..;;.(defi
37d0: 6e 65 20 2a 77 61 74 63 68 64 6f 67 2a 20 28 6d ne *watchdog* (m
37e0: 61 6b 65 2d 74 68 72 65 61 64 20 63 6f 6d 6d 6f ake-thread commo
37f0: 6e 3a 77 61 74 63 68 64 6f 67 20 22 57 61 74 63 n:watchdog "Watc
3800: 68 64 6f 67 20 74 68 72 65 61 64 22 29 29 0a 0a hdog thread"))..
3810: 28 69 66 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 (if (not (args:g
3820: 65 74 2d 61 72 67 20 22 2d 73 65 72 76 65 72 22 et-arg "-server"
3830: 29 29 0a 20 20 20 20 28 74 68 72 65 61 64 2d 73 )). (thread-s
3840: 74 61 72 74 21 20 2a 77 61 74 63 68 64 6f 67 2a tart! *watchdog*
3850: 29 29 20 3b 3b 20 69 66 20 73 74 61 72 74 69 6e )) ;; if startin
3860: 67 20 61 20 73 65 72 76 65 72 3b 20 77 61 69 74 g a server; wait
3870: 20 74 69 6c 6c 20 77 65 20 67 65 74 20 74 6f 20 till we get to
3880: 72 75 6e 6e 69 6e 67 20 73 74 61 74 65 20 62 65 running state be
3890: 66 6f 72 65 20 6b 69 63 6b 69 6e 67 20 6f 66 66 fore kicking off
38a0: 20 77 61 74 63 68 64 6f 67 0a 0a 3b 3b 20 62 72 watchdog..;; br
38b0: 61 63 6b 65 74 20 6f 70 65 6e 2d 6f 75 74 70 75 acket open-outpu
38c0: 74 2d 66 69 6c 65 20 77 69 74 68 20 63 6f 64 65 t-file with code
38d0: 20 74 6f 20 6d 61 6b 65 20 6c 65 61 64 69 6e 67 to make leading
38e0: 20 64 69 72 65 63 74 6f 72 79 20 69 66 20 69 74 directory if it
38f0: 20 64 6f 65 73 20 6e 6f 74 20 65 78 69 73 74 20 does not exist
3900: 61 6e 64 20 68 61 6e 64 6c 65 20 65 78 63 65 70 and handle excep
3910: 74 69 6f 6e 73 0a 28 64 65 66 69 6e 65 20 28 6f tions.(define (o
3920: 70 65 6e 2d 6c 6f 67 66 69 6c 65 20 6c 6f 67 70 pen-logfile logp
3930: 61 74 68 29 0a 20 20 28 63 6f 6e 64 69 74 69 6f ath). (conditio
3940: 6e 2d 63 61 73 65 0a 20 20 20 28 6c 65 74 2a 20 n-case. (let*
3950: 28 28 6c 6f 67 2d 64 69 72 20 28 6f 72 20 28 70 ((log-dir (or (p
3960: 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 athname-director
3970: 79 20 6c 6f 67 70 61 74 68 29 20 22 2e 22 29 29 y logpath) "."))
3980: 29 0a 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 ). (if (not
3990: 28 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 (directory-exist
39a0: 73 3f 20 6c 6f 67 2d 64 69 72 29 29 0a 20 20 20 s? log-dir)).
39b0: 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 (system (c
39c0: 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 20 22 20 onc "mkdir -p "
39d0: 6c 6f 67 2d 64 69 72 29 29 29 0a 20 20 20 20 20 log-dir))).
39e0: 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c (open-output-fil
39f0: 65 20 6c 6f 67 70 61 74 68 29 29 0a 20 20 20 28 e logpath)). (
3a00: 65 78 6e 20 28 29 0a 20 20 20 20 20 20 20 20 28 exn (). (
3a10: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
3a20: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
3a30: 2d 70 6f 72 74 2a 20 22 43 6f 75 6c 64 20 6e 6f -port* "Could no
3a40: 74 20 6f 70 65 6e 20 6c 6f 67 20 66 69 6c 65 20 t open log file
3a50: 66 6f 72 20 77 72 69 74 65 3a 20 22 6c 6f 67 70 for write: "logp
3a60: 61 74 68 29 0a 20 20 20 20 20 20 20 20 28 64 65 ath). (de
3a70: 66 69 6e 65 20 2a 64 69 64 73 6f 6d 65 74 68 69 fine *didsomethi
3a80: 6e 67 2a 20 23 74 29 20 20 0a 20 20 20 20 20 20 ng* #t) .
3a90: 20 20 28 65 78 69 74 20 31 29 29 29 29 0a 0a 20 (exit 1))))..
3aa0: 20 20 20 0a 28 69 66 20 28 6f 72 20 28 61 72 67 .(if (or (arg
3ab0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 s:get-arg "-log"
3ac0: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
3ad0: 2d 73 65 72 76 65 72 22 29 29 20 3b 3b 20 72 65 -server")) ;; re
3ae0: 64 69 72 65 63 74 20 74 68 65 20 6c 6f 67 20 61 direct the log a
3af0: 6c 77 61 79 73 20 77 68 65 6e 20 61 20 73 65 72 lways when a ser
3b00: 76 65 72 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 ver. (let* ((
3b10: 74 6c 20 20 20 28 6f 72 20 28 61 72 67 73 3a 67 tl (or (args:g
3b20: 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 28 6c et-arg "-log")(l
3b30: 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 20 20 aunch:setup)))
3b40: 20 3b 3b 20 72 75 6e 20 6c 61 75 6e 63 68 3a 73 ;; run launch:s
3b50: 65 74 75 70 20 69 66 20 2d 73 65 72 76 65 72 0a etup if -server.
3b60: 09 20 20 20 28 6c 6f 67 66 20 28 6f 72 20 28 61 . (logf (or (a
3b70: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
3b80: 67 22 29 20 3b 3b 20 75 73 65 20 2d 6c 6f 67 20 g") ;; use -log
3b90: 75 6e 6c 65 73 73 20 77 65 20 61 72 65 20 61 20 unless we are a
3ba0: 73 65 72 76 65 72 2c 20 74 68 65 6e 20 63 72 61 server, then cra
3bb0: 66 74 20 61 20 6c 6f 67 66 69 6c 65 20 6e 61 6d ft a logfile nam
3bc0: 65 0a 09 09 20 20 20 20 20 28 63 6f 6e 63 20 74 e... (conc t
3bd0: 6c 20 22 2f 6c 6f 67 73 2f 73 65 72 76 65 72 2d l "/logs/server-
3be0: 22 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 " (current-proce
3bf0: 73 73 2d 69 64 29 20 22 2d 22 20 28 67 65 74 2d ss-id) "-" (get-
3c00: 68 6f 73 74 2d 6e 61 6d 65 29 20 22 2e 6c 6f 67 host-name) ".log
3c10: 22 29 29 29 0a 09 20 20 20 28 6f 75 70 20 20 28 "))).. (oup (
3c20: 6f 70 65 6e 2d 6c 6f 67 66 69 6c 65 20 6c 6f 67 open-logfile log
3c30: 66 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 f))). (if (
3c40: 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 not (args:get-ar
3c50: 67 20 22 2d 6c 6f 67 22 29 29 0a 09 20 20 28 68 g "-log")).. (h
3c60: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 ash-table-set! a
3c70: 72 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 6c rgs:arg-hash "-l
3c80: 6f 67 22 20 6c 6f 67 66 29 29 20 3b 3b 20 66 61 og" logf)) ;; fa
3c90: 6b 65 20 6f 75 74 20 66 75 74 75 72 65 20 71 75 ke out future qu
3ca0: 65 72 69 65 73 20 6f 66 20 2d 6c 6f 67 0a 20 20 eries of -log.
3cb0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
3cc0: 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
3cd0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 65 6e 64 -log-port* "Send
3ce0: 69 6e 67 20 6c 6f 67 20 6f 75 74 70 75 74 20 74 ing log output t
3cf0: 6f 20 22 20 6c 6f 67 66 29 0a 20 20 20 20 20 20 o " logf).
3d00: 28 73 65 74 21 20 2a 64 65 66 61 75 6c 74 2d 6c (set! *default-l
3d10: 6f 67 2d 70 6f 72 74 2a 20 6f 75 70 29 29 29 0a og-port* oup))).
3d20: 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 .(if (or (args:g
3d30: 65 74 2d 61 72 67 20 22 2d 68 22 29 0a 09 28 61 et-arg "-h")..(a
3d40: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 65 rgs:get-arg "-he
3d50: 6c 70 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d lp")..(args:get-
3d60: 61 72 67 20 22 2d 2d 68 65 6c 70 22 29 29 0a 20 arg "--help")).
3d70: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
3d80: 28 70 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 20 (print help).
3d90: 20 20 20 28 65 78 69 74 29 29 29 0a 0a 28 69 66 (exit)))..(if
3da0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3db0: 2d 6d 61 6e 75 61 6c 22 29 0a 20 20 20 20 28 6c -manual"). (l
3dc0: 65 74 2a 20 28 28 68 74 6d 6c 76 69 65 77 65 72 et* ((htmlviewer
3dd0: 63 6d 64 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 cmd (or (configf
3de0: 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 :lookup *configd
3df0: 61 74 2a 20 22 73 65 74 75 70 22 20 22 68 74 6d at* "setup" "htm
3e00: 6c 76 69 65 77 65 72 63 6d 64 22 29 0a 09 09 09 lviewercmd")....
3e10: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 77 68 (common:wh
3e20: 69 63 68 20 27 28 22 66 69 72 65 66 6f 78 22 20 ich '("firefox"
3e30: 22 61 72 6f 72 61 22 29 29 29 29 0a 09 20 20 20 "arora"))))..
3e40: 28 69 6e 73 74 61 6c 6c 2d 68 6f 6d 65 20 20 28 (install-home (
3e50: 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 69 6e 73 74 61 common:get-insta
3e60: 6c 6c 2d 61 72 65 61 29 29 0a 09 20 20 20 28 6d ll-area)).. (m
3e70: 61 6e 75 61 6c 2d 68 74 6d 6c 20 20 20 28 63 6f anual-html (co
3e80: 6e 63 20 69 6e 73 74 61 6c 6c 2d 68 6f 6d 65 20 nc install-home
3e90: 22 2f 73 68 61 72 65 2f 64 6f 63 73 2f 6d 65 67 "/share/docs/meg
3ea0: 61 74 65 73 74 5f 6d 61 6e 75 61 6c 2e 68 74 6d atest_manual.htm
3eb0: 6c 22 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 l"))). (if
3ec0: 28 61 6e 64 20 69 6e 73 74 61 6c 6c 2d 68 6f 6d (and install-hom
3ed0: 65 0a 09 20 20 20 20 20 20 20 28 66 69 6c 65 2d e.. (file-
3ee0: 65 78 69 73 74 73 3f 20 6d 61 6e 75 61 6c 2d 68 exists? manual-h
3ef0: 74 6d 6c 29 29 0a 09 20 20 28 73 79 73 74 65 6d tml)).. (system
3f00: 20 28 63 6f 6e 63 20 22 28 22 20 68 74 6d 6c 76 (conc "(" htmlv
3f10: 69 65 77 65 72 63 6d 64 20 22 20 22 20 6d 61 6e iewercmd " " man
3f20: 75 61 6c 2d 68 74 6d 6c 20 22 20 29 20 26 22 29 ual-html " ) &")
3f30: 29 0a 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f ).. (system (co
3f40: 6e 63 20 22 28 22 20 68 74 6d 6c 76 69 65 77 65 nc "(" htmlviewe
3f50: 72 63 6d 64 20 22 20 68 74 74 70 3a 2f 2f 77 77 rcmd " http://ww
3f60: 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 63 67 69 w.kiatoa.com/cgi
3f70: 2d 62 69 6e 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 -bin/fossils/meg
3f80: 61 74 65 73 74 2f 64 6f 63 2f 74 69 70 2f 64 6f atest/doc/tip/do
3f90: 63 73 2f 6d 61 6e 75 61 6c 2f 6d 65 67 61 74 65 cs/manual/megate
3fa0: 73 74 5f 6d 61 6e 75 61 6c 2e 68 74 6d 6c 20 29 st_manual.html )
3fb0: 20 26 22 29 29 29 0a 20 20 20 20 20 20 28 65 78 &"))). (ex
3fc0: 69 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 it)))..(if (args
3fd0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 74 :get-arg "-start
3fe0: 2d 64 69 72 22 29 0a 20 20 20 20 28 69 66 20 28 -dir"). (if (
3ff0: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 61 72 file-exists? (ar
4000: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 gs:get-arg "-sta
4010: 72 74 2d 64 69 72 22 29 29 0a 09 28 63 68 61 6e rt-dir"))..(chan
4020: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 28 61 72 ge-directory (ar
4030: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 gs:get-arg "-sta
4040: 72 74 2d 64 69 72 22 29 29 0a 09 28 62 65 67 69 rt-dir"))..(begi
4050: 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e n.. (debug:prin
4060: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
4070: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6e 6f lt-log-port* "no
4080: 6e 2d 65 78 69 73 74 61 6e 74 20 73 74 61 72 74 n-existant start
4090: 20 64 69 72 20 22 20 28 61 72 67 73 3a 67 65 74 dir " (args:get
40a0: 2d 61 72 67 20 22 2d 73 74 61 72 74 2d 64 69 72 -arg "-start-dir
40b0: 22 29 20 22 20 73 70 65 63 69 66 69 65 64 2c 20 ") " specified,
40c0: 65 78 69 74 69 6e 67 2e 22 29 0a 09 20 20 28 65 exiting.").. (e
40d0: 78 69 74 20 31 29 29 29 29 0a 0a 28 69 66 20 28 xit 1))))..(if (
40e0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 args:get-arg "-v
40f0: 65 72 73 69 6f 6e 22 29 0a 20 20 20 20 28 62 65 ersion"). (be
4100: 67 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 gin. (print
4110: 20 28 63 6f 6d 6d 6f 6e 3a 76 65 72 73 69 6f 6e (common:version
4120: 2d 73 69 67 6e 61 74 75 72 65 29 29 20 3b 3b 20 -signature)) ;;
4130: 28 70 72 69 6e 74 20 6d 65 67 61 74 65 73 74 2d (print megatest-
4140: 76 65 72 73 69 6f 6e 29 0a 20 20 20 20 20 20 28 version). (
4150: 65 78 69 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 exit)))..(define
4160: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
4170: 23 66 29 0a 0a 3b 3b 20 4f 76 65 72 61 6c 6c 20 #f)..;; Overall
4180: 65 78 69 74 20 68 61 6e 64 6c 69 6e 67 20 73 65 exit handling se
4190: 74 75 70 20 69 6d 6d 65 64 69 61 74 65 6c 79 0a tup immediately.
41a0: 3b 3b 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 ;;.(if (or (args
41b0: 3a 67 65 74 2d 61 72 67 20 22 2d 70 72 6f 63 65 :get-arg "-proce
41c0: 73 73 2d 72 65 61 70 22 29 29 0a 20 20 20 20 20 ss-reap")).
41d0: 20 20 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d ;; (args:get-
41e0: 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
41f0: 0a 09 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 ..;; (args:get-a
4200: 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 0a 09 rg "-execute")..
4210: 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ;; (args:get-arg
4220: 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 "-remove-runs")
4230: 0a 09 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 ..;; (args:get-a
4240: 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 29 0a rg "-runstep")).
4250: 20 20 20 20 28 6c 65 74 20 28 28 6f 72 69 67 69 (let ((origi
4260: 6e 61 6c 2d 65 78 69 74 20 28 65 78 69 74 2d 68 nal-exit (exit-h
4270: 61 6e 64 6c 65 72 29 29 29 0a 20 20 20 20 20 20 andler))).
4280: 28 65 78 69 74 2d 68 61 6e 64 6c 65 72 20 28 6c (exit-handler (l
4290: 61 6d 62 64 61 20 28 23 21 6f 70 74 69 6f 6e 61 ambda (#!optiona
42a0: 6c 20 28 65 78 69 74 2d 63 6f 64 65 20 30 29 29 l (exit-code 0))
42b0: 0a 09 09 20 20 20 20 20 20 28 70 72 69 6e 74 66 ... (printf
42c0: 20 22 50 72 65 70 61 72 69 6e 67 20 74 6f 20 65 "Preparing to e
42d0: 78 69 74 20 77 69 74 68 20 65 78 69 74 20 63 6f xit with exit co
42e0: 64 65 20 7e 41 20 2e 2e 2e 5c 6e 22 20 65 78 69 de ~A ...\n" exi
42f0: 74 2d 63 6f 64 65 29 0a 09 09 20 20 20 20 20 20 t-code)...
4300: 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 20 20 20 (for-each ...
4310: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 69 64 (lambda (pid
4320: 29 0a 09 09 09 20 28 68 61 6e 64 6c 65 2d 65 78 ).... (handle-ex
4330: 63 65 70 74 69 6f 6e 73 0a 09 09 09 20 20 65 78 ceptions.... ex
4340: 6e 0a 09 09 09 20 20 23 74 0a 09 09 09 20 20 28 n.... #t.... (
4350: 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 70 69 let-values (((pi
4360: 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 75 d-val exit-statu
4370: 73 20 65 78 69 74 2d 63 6f 64 65 29 20 28 70 72 s exit-code) (pr
4380: 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 ocess-wait pid #
4390: 74 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 t)))..... (
43a0: 69 66 20 28 6f 72 20 28 65 71 3f 20 70 69 64 2d if (or (eq? pid-
43b0: 76 61 6c 20 70 69 64 29 0a 09 09 09 09 09 20 20 val pid)......
43c0: 20 20 20 20 28 65 71 3f 20 70 69 64 2d 76 61 6c (eq? pid-val
43d0: 20 30 29 29 0a 09 09 09 09 09 20 20 28 62 65 67 0))...... (beg
43e0: 69 6e 0a 09 09 09 09 09 20 20 20 20 28 70 72 69 in...... (pri
43f0: 6e 74 66 20 22 53 65 6e 64 69 6e 67 20 73 69 67 ntf "Sending sig
4400: 6e 61 6c 2f 74 65 72 6d 20 74 6f 20 7e 41 5c 6e nal/term to ~A\n
4410: 22 20 70 69 64 29 0a 09 09 09 09 09 20 20 20 20 " pid)......
4420: 28 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 (process-signal
4430: 70 69 64 20 73 69 67 6e 61 6c 2f 74 65 72 6d 29 pid signal/term)
4440: 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 )))))... (
4450: 70 72 6f 63 65 73 73 3a 63 68 69 6c 64 72 65 6e process:children
4460: 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 28 6f #f))... (o
4470: 72 69 67 69 6e 61 6c 2d 65 78 69 74 20 65 78 69 riginal-exit exi
4480: 74 2d 63 6f 64 65 29 29 29 29 29 0a 0a 3b 3b 3d t-code)))))..;;=
4490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44d0: 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 20 73 65 =====.;; Misc se
44e0: 74 75 70 20 73 74 75 66 66 0a 3b 3b 3d 3d 3d 3d tup stuff.;;====
44f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4530: 3d 3d 0a 0a 28 64 65 62 75 67 3a 73 65 74 75 70 ==..(debug:setup
4540: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
4550: 2d 61 72 67 20 22 2d 6c 6f 67 67 69 6e 67 22 29 -arg "-logging")
4560: 28 73 65 74 21 20 2a 6c 6f 67 67 69 6e 67 2a 20 (set! *logging*
4570: 23 74 29 29 0a 0a 28 69 66 20 28 64 65 62 75 67 #t))..(if (debug
4580: 3a 64 65 62 75 67 2d 6d 6f 64 65 20 33 29 20 3b :debug-mode 3) ;
4590: 3b 20 77 65 20 61 72 65 20 6f 62 76 69 6f 75 73 ; we are obvious
45a0: 6c 79 20 64 65 62 75 67 67 69 6e 67 0a 20 20 20 ly debugging.
45b0: 20 28 73 65 74 21 20 6f 70 65 6e 2d 72 75 6e 2d (set! open-run-
45c0: 63 6c 6f 73 65 20 6f 70 65 6e 2d 72 75 6e 2d 63 close open-run-c
45d0: 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f lose-no-exceptio
45e0: 6e 2d 68 61 6e 64 6c 69 6e 67 29 29 0a 0a 28 69 n-handling))..(i
45f0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
4600: 22 2d 69 74 65 6d 70 61 74 74 22 29 0a 20 20 20 "-itempatt").
4610: 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 28 (let ((newval (
4620: 63 6f 6e 63 20 28 61 72 67 73 3a 67 65 74 2d 61 conc (args:get-a
4630: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 20 rg "-testpatt")
4640: 22 2f 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 "/" (args:get-ar
4650: 67 20 22 2d 69 74 65 6d 70 61 74 74 22 29 29 29 g "-itempatt")))
4660: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
4670: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
4680: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
4690: 4e 47 3a 20 2d 69 74 65 6d 70 61 74 74 20 68 61 NG: -itempatt ha
46a0: 73 20 62 65 65 6e 20 64 65 70 72 65 63 61 74 65 s been deprecate
46b0: 64 2c 20 70 6c 65 61 73 65 20 75 73 65 20 2d 74 d, please use -t
46c0: 65 73 74 70 61 74 74 20 74 65 73 74 70 61 74 74 estpatt testpatt
46d0: 2f 69 74 65 6d 70 61 74 74 20 6d 65 74 68 6f 64 /itempatt method
46e0: 2c 20 6e 65 77 20 74 65 73 74 70 61 74 74 20 69 , new testpatt i
46f0: 73 20 22 6e 65 77 76 61 6c 29 0a 20 20 20 20 20 s "newval).
4700: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
4710: 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 ! args:arg-hash
4720: 22 2d 74 65 73 74 70 61 74 74 22 20 6e 65 77 76 "-testpatt" newv
4730: 61 6c 29 0a 20 20 20 20 20 20 28 68 61 73 68 2d al). (hash-
4740: 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 61 72 table-delete! ar
4750: 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 69 74 gs:arg-hash "-it
4760: 65 6d 70 61 74 74 22 29 29 29 0a 0a 28 69 66 20 empatt")))..(if
4770: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4780: 72 75 6e 74 65 73 74 73 22 29 0a 20 20 20 20 28 runtests"). (
4790: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
47a0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
47b0: 20 22 57 41 52 4e 49 4e 47 3a 20 5c 22 2d 72 75 "WARNING: \"-ru
47c0: 6e 74 65 73 74 73 5c 22 20 69 73 20 64 65 70 72 ntests\" is depr
47d0: 65 63 61 74 65 64 2e 20 55 73 65 20 5c 22 2d 72 ecated. Use \"-r
47e0: 75 6e 5c 22 20 77 69 74 68 20 5c 22 2d 74 65 73 un\" with \"-tes
47f0: 74 70 61 74 74 5c 22 20 69 6e 73 74 65 61 64 22 tpatt\" instead"
4800: 29 29 0a 0a 28 6f 6e 2d 65 78 69 74 20 73 74 64 ))..(on-exit std
4810: 2d 65 78 69 74 2d 70 72 6f 63 65 64 75 72 65 29 -exit-procedure)
4820: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
4830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 ==========.;; Mi
4870: 73 63 20 67 65 6e 65 72 61 6c 20 63 61 6c 6c 73 sc general calls
4880: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
4890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
48a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
48b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
48c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
48d0: 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 and (args:get-ar
48e0: 67 20 22 2d 63 61 63 68 65 2d 64 62 22 29 0a 20 g "-cache-db").
48f0: 20 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 (args:ge
4900: 74 2d 61 72 67 20 22 2d 73 6f 75 72 63 65 2d 64 t-arg "-source-d
4910: 62 22 29 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 b")). (let* (
4920: 28 74 65 6d 70 2d 64 69 72 20 28 6f 72 20 28 61 (temp-dir (or (a
4930: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 rgs:get-arg "-ta
4940: 72 67 65 74 2d 64 62 22 29 20 28 63 72 65 61 74 rget-db") (creat
4950: 65 2d 64 69 72 65 63 74 6f 72 79 20 28 63 6f 6e e-directory (con
4960: 63 20 22 2f 74 6d 70 2f 22 20 28 67 65 74 65 6e c "/tmp/" (geten
4970: 76 20 22 55 53 45 52 22 29 20 22 2f 22 20 28 73 v "USER") "/" (s
4980: 74 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 tring-translate
4990: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
49a0: 72 79 29 20 22 2f 22 20 22 5f 22 29 29 29 29 29 ry) "/" "_")))))
49b0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 74 61 72 . (tar
49c0: 67 65 74 2d 64 62 20 28 63 6f 6e 63 20 74 65 6d get-db (conc tem
49d0: 70 2d 64 69 72 20 22 2f 63 61 63 68 65 64 2e 64 p-dir "/cached.d
49e0: 62 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 b")).
49f0: 28 73 6f 75 72 63 65 2d 64 62 20 28 61 72 67 73 (source-db (args
4a00: 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f 75 72 63 :get-arg "-sourc
4a10: 65 2d 64 62 22 29 29 29 20 20 20 20 20 20 20 20 e-db")))
4a20: 0a 20 20 20 20 20 20 28 64 62 3a 63 61 63 68 65 . (db:cache
4a30: 2d 66 6f 72 2d 72 65 61 64 2d 6f 6e 6c 79 20 73 -for-read-only s
4a40: 6f 75 72 63 65 2d 64 62 20 74 61 72 67 65 74 2d ource-db target-
4a50: 64 62 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 db). (set!
4a60: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
4a70: 74 29 29 29 0a 0a 3b 3b 20 68 61 6e 64 6c 65 20 t)))..;; handle
4a80: 61 20 63 6c 65 61 6e 2d 63 61 63 68 65 20 72 65 a clean-cache re
4a90: 71 75 65 73 74 20 61 73 20 65 61 72 6c 79 20 61 quest as early a
4aa0: 73 20 70 6f 73 73 69 62 6c 65 0a 3b 3b 0a 28 69 s possible.;;.(i
4ab0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
4ac0: 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 22 29 0a "-clean-cache").
4ad0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
4ae0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
4af0: 68 69 6e 67 2a 20 23 74 29 20 3b 3b 20 73 75 70 hing* #t) ;; sup
4b00: 70 72 65 73 73 20 74 68 65 20 68 65 6c 70 20 6f press the help o
4b10: 75 74 70 75 74 2e 0a 20 20 20 20 20 20 28 69 66 utput.. (if
4b20: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 (getenv "MT_TAR
4b30: 47 45 54 22 29 20 3b 3b 20 6e 6f 20 70 6f 69 6e GET") ;; no poin
4b40: 74 20 69 6e 20 74 72 79 69 6e 67 20 69 66 20 6e t in trying if n
4b50: 6f 20 74 61 72 67 65 74 0a 09 20 20 28 69 66 20 o target.. (if
4b60: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4b70: 72 75 6e 6e 61 6d 65 22 29 0a 09 20 20 20 20 20 runname")..
4b80: 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 (let* ((toppath
4b90: 20 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 (launch:setup)
4ba0: 29 0a 09 09 20 20 20 20 20 28 6c 69 6e 6b 74 72 )... (linktr
4bb0: 65 65 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 ee (if toppath (
4bc0: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a configf:lookup *
4bd0: 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 configdat* "setu
4be0: 70 22 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 29 p" "linktree")))
4bf0: 0a 09 09 20 20 20 20 20 28 72 75 6e 74 6f 70 20 ... (runtop
4c00: 20 20 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 (conc linktree
4c10: 20 22 2f 22 20 28 67 65 74 65 6e 76 20 22 4d 54 "/" (getenv "MT
4c20: 5f 54 41 52 47 45 54 22 29 20 22 2f 22 20 28 61 _TARGET") "/" (a
4c30: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
4c40: 6e 6e 61 6d 65 22 29 29 29 0a 09 09 20 20 20 20 nname")))...
4c50: 20 28 66 69 6c 65 73 20 20 20 20 28 69 66 20 28 (files (if (
4c60: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 72 75 6e file-exists? run
4c70: 74 6f 70 29 0a 09 09 09 09 20 20 20 28 61 70 70 top)..... (app
4c80: 65 6e 64 20 28 67 6c 6f 62 20 28 63 6f 6e 63 20 end (glob (conc
4c90: 72 75 6e 74 6f 70 20 22 2f 2e 6d 65 67 61 74 65 runtop "/.megate
4ca0: 73 74 2a 22 29 29 0a 09 09 09 09 09 20 20 20 28 st*"))...... (
4cb0: 67 6c 6f 62 20 28 63 6f 6e 63 20 72 75 6e 74 6f glob (conc runto
4cc0: 70 20 22 2f 2e 72 75 6e 63 6f 6e 66 69 67 2a 22 p "/.runconfig*"
4cd0: 29 29 29 0a 09 09 09 09 20 20 20 27 28 29 29 29 )))..... '()))
4ce0: 29 0a 09 09 28 69 66 20 28 6e 75 6c 6c 3f 20 66 )...(if (null? f
4cf0: 69 6c 65 73 29 0a 09 09 20 20 20 20 28 64 65 62 iles)... (deb
4d00: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
4d10: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
4d20: 74 2a 20 22 4e 6f 20 63 61 63 68 65 64 20 6d 65 t* "No cached me
4d30: 67 61 74 65 73 74 20 6f 72 20 72 75 6e 63 6f 6e gatest or runcon
4d40: 66 69 67 73 20 66 69 6c 65 73 20 66 6f 75 6e 64 figs files found
4d50: 2e 20 4e 6f 6e 65 20 72 65 6d 6f 76 65 64 2e 22 . None removed."
4d60: 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 )... (begin..
4d70: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
4d80: 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
4d90: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 ult-log-port* "R
4da0: 65 6d 6f 76 69 6e 67 20 63 61 63 68 65 64 20 66 emoving cached f
4db0: 69 6c 65 73 3a 5c 6e 20 20 20 20 22 20 28 73 74 iles:\n " (st
4dc0: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
4dd0: 20 66 69 6c 65 73 20 22 5c 6e 20 20 20 20 22 29 files "\n ")
4de0: 29 0a 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 )... (for-e
4df0: 61 63 68 20 0a 09 09 20 20 20 20 20 20 20 28 6c ach ... (l
4e00: 61 6d 62 64 61 20 28 66 29 0a 09 09 09 20 28 68 ambda (f).... (h
4e10: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
4e20: 0a 09 09 09 20 20 20 20 20 65 78 6e 0a 09 09 09 .... exn....
4e30: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
4e40: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
4e50: 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a -port* "WARNING:
4e60: 20 46 61 69 6c 65 64 20 74 6f 20 72 65 6d 6f 76 Failed to remov
4e70: 65 20 66 69 6c 65 20 22 20 66 29 0a 09 09 09 20 e file " f)....
4e80: 20 20 28 64 65 6c 65 74 65 2d 66 69 6c 65 20 66 (delete-file f
4e90: 29 29 29 0a 09 09 20 20 20 20 20 20 20 66 69 6c )))... fil
4ea0: 65 73 29 29 29 29 0a 09 20 20 20 20 20 20 28 64 es)))).. (d
4eb0: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
4ec0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
4ed0: 70 6f 72 74 2a 20 22 2d 63 6c 65 61 6e 2d 63 61 port* "-clean-ca
4ee0: 63 68 65 20 72 65 71 75 69 72 65 73 20 2d 72 75 che requires -ru
4ef0: 6e 6e 61 6d 65 2e 22 29 29 0a 09 20 20 28 64 65 nname.")).. (de
4f00: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
4f10: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
4f20: 6f 72 74 2a 20 22 2d 63 6c 65 61 6e 2d 63 61 63 ort* "-clean-cac
4f30: 68 65 20 72 65 71 75 69 72 65 73 20 2d 74 61 72 he requires -tar
4f40: 67 65 74 20 6f 72 20 2d 72 65 71 74 61 72 67 22 get or -reqtarg"
4f50: 29 29 29 29 0a 09 20 20 20 20 0a 09 20 20 0a 28 )))).. .. .(
4f60: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
4f70: 20 22 2d 65 6e 76 32 66 69 6c 65 22 29 0a 20 20 "-env2file").
4f80: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
4f90: 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 save-environment
4fa0: 2d 61 73 2d 66 69 6c 65 73 20 28 61 72 67 73 3a -as-files (args:
4fb0: 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 32 66 69 get-arg "-env2fi
4fc0: 6c 65 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 le")). (set
4fd0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
4fe0: 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
4ff0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
5000: 2d 64 69 73 6b 73 22 29 0a 20 20 20 20 28 6c 65 -disks"). (le
5010: 74 20 28 28 74 6f 70 70 61 74 68 20 28 6c 61 75 t ((toppath (lau
5020: 6e 63 68 3a 73 65 74 75 70 29 29 29 0a 20 20 20 nch:setup))).
5030: 20 20 20 28 70 72 69 6e 74 20 0a 20 20 20 20 20 (print .
5040: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
5050: 70 65 72 73 65 20 0a 09 28 6d 61 70 20 28 6c 61 perse ..(map (la
5060: 6d 62 64 61 20 28 78 29 0a 09 20 20 20 20 20 20 mbda (x)..
5070: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
5080: 65 72 73 65 20 0a 09 09 78 0a 09 09 22 20 3d 3e erse ...x..." =>
5090: 20 22 29 29 0a 09 20 20 20 20 20 28 63 6f 6d 6d ")).. (comm
50a0: 6f 6e 3a 67 65 74 2d 64 69 73 6b 73 20 2a 63 6f on:get-disks *co
50b0: 6e 66 69 67 64 61 74 2a 29 29 0a 09 22 5c 6e 22 nfigdat*)).."\n"
50c0: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
50d0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
50e0: 29 29 29 0a 0a 3b 3b 20 63 73 76 20 70 72 6f 63 )))..;; csv proc
50f0: 65 73 73 69 6e 67 20 72 65 63 6f 72 64 0a 28 64 essing record.(d
5100: 65 66 69 6e 65 20 28 6d 61 6b 65 2d 72 65 66 64 efine (make-refd
5110: 62 3a 63 73 76 29 0a 20 20 28 76 65 63 74 6f 72 b:csv). (vector
5120: 20 0a 20 20 20 28 6d 61 6b 65 2d 73 70 61 72 73 . (make-spars
5130: 65 2d 61 72 72 61 79 29 0a 20 20 20 28 6d 61 6b e-array). (mak
5140: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 e-hash-table).
5150: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
5160: 65 29 0a 20 20 20 30 0a 20 20 20 30 29 29 0a 28 e). 0. 0)).(
5170: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 define-inline (r
5180: 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 73 76 65 efdb:csv-get-sve
5190: 63 20 20 20 20 20 76 65 63 29 20 20 20 20 28 76 c vec) (v
51a0: 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 30 ector-ref vec 0
51b0: 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e )).(define-inlin
51c0: 65 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 e (refdb:csv-get
51d0: 2d 72 6f 77 73 20 20 20 20 20 76 65 63 29 20 20 -rows vec)
51e0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 (vector-ref v
51f0: 65 63 20 31 29 29 0a 28 64 65 66 69 6e 65 2d 69 ec 1)).(define-i
5200: 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 nline (refdb:csv
5210: 2d 67 65 74 2d 63 6f 6c 73 20 20 20 20 20 76 65 -get-cols ve
5220: 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 c) (vector-re
5230: 66 20 20 76 65 63 20 32 29 29 0a 28 64 65 66 69 f vec 2)).(defi
5240: 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 ne-inline (refdb
5250: 3a 63 73 76 2d 67 65 74 2d 6d 61 78 72 6f 77 20 :csv-get-maxrow
5260: 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f vec) (vecto
5270: 72 2d 72 65 66 20 20 76 65 63 20 33 29 29 0a 28 r-ref vec 3)).(
5280: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 define-inline (r
5290: 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 efdb:csv-get-max
52a0: 63 6f 6c 20 20 20 76 65 63 29 20 20 20 20 28 76 col vec) (v
52b0: 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 34 ector-ref vec 4
52c0: 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e )).(define-inlin
52d0: 65 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 e (refdb:csv-set
52e0: 2d 73 76 65 63 21 20 20 20 20 76 65 63 20 76 61 -svec! vec va
52f0: 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 l)(vector-set! v
5300: 65 63 20 30 20 76 61 6c 29 29 0a 28 64 65 66 69 ec 0 val)).(defi
5310: 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 ne-inline (refdb
5320: 3a 63 73 76 2d 73 65 74 2d 72 6f 77 73 21 20 20 :csv-set-rows!
5330: 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f vec val)(vecto
5340: 72 2d 73 65 74 21 20 76 65 63 20 31 20 76 61 6c r-set! vec 1 val
5350: 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e )).(define-inlin
5360: 65 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 e (refdb:csv-set
5370: 2d 63 6f 6c 73 21 20 20 20 20 76 65 63 20 76 61 -cols! vec va
5380: 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 l)(vector-set! v
5390: 65 63 20 32 20 76 61 6c 29 29 0a 28 64 65 66 69 ec 2 val)).(defi
53a0: 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 ne-inline (refdb
53b0: 3a 63 73 76 2d 73 65 74 2d 6d 61 78 72 6f 77 21 :csv-set-maxrow!
53c0: 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f vec val)(vecto
53d0: 72 2d 73 65 74 21 20 76 65 63 20 33 20 76 61 6c r-set! vec 3 val
53e0: 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e )).(define-inlin
53f0: 65 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 e (refdb:csv-set
5400: 2d 6d 61 78 63 6f 6c 21 20 20 76 65 63 20 76 61 -maxcol! vec va
5410: 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 l)(vector-set! v
5420: 65 63 20 34 20 76 61 6c 29 29 0a 0a 28 64 65 66 ec 4 val))..(def
5430: 69 6e 65 20 28 67 65 74 2d 64 61 74 20 72 65 73 ine (get-dat res
5440: 75 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 29 0a ults sheetname).
5450: 20 20 28 6f 72 20 28 68 61 73 68 2d 74 61 62 6c (or (hash-tabl
5460: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 e-ref/default re
5470: 73 75 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 20 sults sheetname
5480: 23 66 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 #f). (let (
5490: 28 74 6d 70 2d 76 65 63 20 20 28 6d 61 6b 65 2d (tmp-vec (make-
54a0: 72 65 66 64 62 3a 63 73 76 29 29 29 0a 09 28 68 refdb:csv)))..(h
54b0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 ash-table-set! r
54c0: 65 73 75 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 esults sheetname
54d0: 20 74 6d 70 2d 76 65 63 29 0a 09 74 6d 70 2d 76 tmp-vec)..tmp-v
54e0: 65 63 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 ec)))..(if (args
54f0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 66 64 62 :get-arg "-refdb
5500: 32 64 61 74 22 29 0a 20 20 20 20 28 6c 65 74 2a 2dat"). (let*
5510: 20 28 28 69 6e 70 75 74 2d 64 62 20 28 61 72 67 ((input-db (arg
5520: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 66 64 s:get-arg "-refd
5530: 62 32 64 61 74 22 29 29 0a 09 20 20 20 28 6f 75 b2dat")).. (ou
5540: 74 2d 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 t-file (args:get
5550: 2d 61 72 67 20 22 2d 6f 22 29 29 0a 09 20 20 20 -arg "-o"))..
5560: 28 6f 75 74 2d 66 6d 74 20 20 28 6f 72 20 28 61 (out-fmt (or (a
5570: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
5580: 6d 70 6d 6f 64 65 22 29 20 22 73 63 68 65 6d 65 mpmode") "scheme
5590: 22 29 29 0a 09 20 20 20 28 6f 75 74 2d 70 6f 72 ")).. (out-por
55a0: 74 20 28 69 66 20 28 61 6e 64 20 6f 75 74 2d 66 t (if (and out-f
55b0: 69 6c 65 20 0a 09 09 09 20 20 20 20 20 20 28 6e ile .... (n
55c0: 6f 74 20 28 6d 65 6d 62 65 72 20 6f 75 74 2d 66 ot (member out-f
55d0: 6d 74 20 27 28 22 73 71 6c 69 74 65 33 22 20 22 mt '("sqlite3" "
55e0: 63 73 76 22 29 29 29 29 0a 09 09 09 20 28 6f 70 csv")))).... (op
55f0: 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 6f en-output-file o
5600: 75 74 2d 66 69 6c 65 29 0a 09 09 09 20 28 63 75 ut-file).... (cu
5610: 72 72 65 6e 74 2d 6f 75 74 70 75 74 2d 70 6f 72 rrent-output-por
5620: 74 29 29 29 0a 09 20 20 20 28 72 65 73 2d 64 61 t))).. (res-da
5630: 74 61 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 ta (configf:read
5640: 2d 72 65 66 64 62 20 69 6e 70 75 74 2d 64 62 29 -refdb input-db)
5650: 29 0a 09 20 20 20 28 64 61 74 61 20 20 20 20 20 ).. (data
5660: 28 63 61 72 20 72 65 73 2d 64 61 74 61 29 29 0a (car res-data)).
5670: 09 20 20 20 28 6d 73 67 20 20 20 20 20 20 28 63 . (msg (c
5680: 61 64 72 20 72 65 73 2d 64 61 74 61 29 29 29 0a adr res-data))).
5690: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 64 (if (not d
56a0: 61 74 61 29 0a 09 20 20 28 64 65 62 75 67 3a 70 ata).. (debug:p
56b0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
56c0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 42 61 64 20 69 log-port* "Bad i
56d0: 6e 70 75 74 3f 20 64 61 74 61 3d 22 20 64 61 74 nput? data=" dat
56e0: 61 29 20 3b 3b 20 73 6f 6d 65 20 65 72 72 6f 72 a) ;; some error
56f0: 20 6f 63 63 75 72 72 65 64 0a 09 20 20 28 77 69 occurred.. (wi
5700: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 70 6f 72 th-output-to-por
5710: 74 20 6f 75 74 2d 70 6f 72 74 0a 09 20 20 20 20 t out-port..
5720: 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 20 20 (lambda ()..
5730: 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d (case (string-
5740: 3e 73 79 6d 62 6f 6c 20 6f 75 74 2d 66 6d 74 29 >symbol out-fmt)
5750: 0a 09 09 28 28 73 63 68 65 6d 65 29 28 70 70 20 ...((scheme)(pp
5760: 64 61 74 61 29 29 0a 09 09 28 28 70 65 72 6c 29 data))...((perl)
5770: 0a 09 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 25 ... ;; (print "%
5780: 68 61 73 68 20 3d 20 28 22 29 0a 09 09 20 3b 3b hash = (")... ;;
5790: 20 20 20 20 20 20 20 20 6b 65 79 31 20 3d 3e 20 key1 =>
57a0: 27 76 61 6c 75 65 31 27 2c 0a 09 09 20 3b 3b 20 'value1',... ;;
57b0: 20 20 20 20 20 20 20 6b 65 79 32 20 3d 3e 20 27 key2 => '
57c0: 76 61 6c 75 65 32 27 2c 0a 09 09 20 3b 3b 20 20 value2',... ;;
57d0: 20 20 20 20 20 20 6b 65 79 33 20 3d 3e 20 27 76 key3 => 'v
57e0: 61 6c 75 65 33 27 2c 0a 09 09 20 3b 3b 20 29 3b alue3',... ;; );
57f0: 0a 09 09 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 ... (configf:map
5800: 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 20 -all-hier-alist
5810: 0a 09 09 20 20 64 61 74 61 20 0a 09 09 20 20 28 ... data ... (
5820: 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d lambda (sheetnam
5830: 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 e sectionname va
5840: 72 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 rname val)...
5850: 20 28 70 72 69 6e 74 20 22 24 64 61 74 61 7b 5c (print "$data{\
5860: 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 "" sheetname "\"
5870: 7d 7b 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d }{\"" sectionnam
5880: 65 20 22 5c 22 7d 7b 5c 22 22 20 76 61 72 6e 61 e "\"}{\"" varna
5890: 6d 65 20 22 5c 22 7d 20 3d 20 5c 22 22 20 76 61 me "\"} = \"" va
58a0: 6c 20 22 5c 22 3b 22 29 29 29 29 0a 09 09 28 28 l "\";"))))...((
58b0: 70 79 74 68 6f 6e 20 72 75 62 79 29 0a 09 09 20 python ruby)...
58c0: 28 70 72 69 6e 74 20 22 64 61 74 61 3d 7b 7d 22 (print "data={}"
58d0: 29 0a 09 09 20 28 63 6f 6e 66 69 67 66 3a 6d 61 )... (configf:ma
58e0: 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 p-all-hier-alist
58f0: 0a 09 09 20 20 64 61 74 61 0a 09 09 20 20 28 6c ... data... (l
5900: 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 ambda (sheetname
5910: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 sectionname var
5920: 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 name val)...
5930: 28 70 72 69 6e 74 20 22 64 61 74 61 5b 5c 22 22 (print "data[\""
5940: 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 5d 5b sheetname "\"][
5950: 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 \"" sectionname
5960: 22 5c 22 5d 5b 5c 22 22 20 76 61 72 6e 61 6d 65 "\"][\"" varname
5970: 20 22 5c 22 5d 20 3d 20 5c 22 22 20 76 61 6c 20 "\"] = \"" val
5980: 22 5c 22 22 29 29 0a 09 09 20 20 69 6e 69 74 70 "\""))... initp
5990: 72 6f 63 31 3a 0a 09 09 20 20 28 6c 61 6d 62 64 roc1:... (lambd
59a0: 61 20 28 73 68 65 65 74 6e 61 6d 65 29 0a 09 09 a (sheetname)...
59b0: 20 20 20 20 28 70 72 69 6e 74 20 22 64 61 74 61 (print "data
59c0: 5b 5c 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 [\"" sheetname "
59d0: 5c 22 5d 20 3d 20 7b 7d 22 29 29 0a 09 09 20 20 \"] = {}"))...
59e0: 69 6e 69 74 70 72 6f 63 32 3a 0a 09 09 20 20 28 initproc2:... (
59f0: 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d lambda (sheetnam
5a00: 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 29 0a 09 e sectionname)..
5a10: 09 20 20 20 20 28 70 72 69 6e 74 20 22 64 61 74 . (print "dat
5a20: 61 5b 5c 22 22 20 73 68 65 65 74 6e 61 6d 65 20 a[\"" sheetname
5a30: 22 5c 22 5d 5b 5c 22 22 20 73 65 63 74 69 6f 6e "\"][\"" section
5a40: 6e 61 6d 65 20 22 5c 22 5d 20 3d 20 7b 7d 22 29 name "\"] = {}")
5a50: 29 29 29 0a 09 09 28 28 63 73 76 29 0a 09 09 20 )))...((csv)...
5a60: 28 6c 65 74 2a 20 28 28 72 65 73 75 6c 74 73 20 (let* ((results
5a70: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
5a80: 65 29 29 20 3b 3b 20 28 6d 61 6b 65 2d 73 70 61 e)) ;; (make-spa
5a90: 72 73 65 2d 61 72 72 61 79 29 29 29 0a 09 09 09 rse-array)))....
5aa0: 28 72 6f 77 2d 63 6f 6c 73 20 28 6d 61 6b 65 2d (row-cols (make-
5ab0: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 20 3b 3b hash-table))) ;;
5ac0: 20 68 61 73 68 20 6f 66 20 68 61 73 68 65 73 20 hash of hashes
5ad0: 77 68 65 72 65 20 73 65 63 74 69 6f 6e 20 3d 3e where section =>
5ae0: 20 68 74 20 7b 20 72 6f 77 2d 3c 6e 61 6d 65 3e ht { row-<name>
5af0: 20 3d 3e 20 6e 75 6d 20 6f 72 20 63 6f 6c 2d 3c => num or col-<
5b00: 6e 61 6d 65 3e 20 3d 3e 20 6e 75 6d 0a 09 09 20 name> => num...
5b10: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 64 61 74 ;; (print "dat
5b20: 61 3d 22 29 0a 09 09 20 20 20 3b 3b 20 28 70 70 a=")... ;; (pp
5b30: 20 64 61 74 61 29 0a 09 09 20 20 20 28 63 6f 6e data)... (con
5b40: 66 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 figf:map-all-hie
5b50: 72 2d 61 6c 69 73 74 0a 09 09 20 20 20 20 64 61 r-alist... da
5b60: 74 61 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 61 ta... (lambda
5b70: 20 28 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 (sheetname sect
5b80: 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 ionname varname
5b90: 76 61 6c 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 val)... ;;
5ba0: 28 70 72 69 6e 74 20 22 73 68 65 65 74 6e 61 6d (print "sheetnam
5bb0: 65 3a 20 22 20 73 68 65 65 74 6e 61 6d 65 20 22 e: " sheetname "
5bc0: 2c 20 73 65 63 74 69 6f 6e 6e 61 6d 65 3a 20 22 , sectionname: "
5bd0: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 2c 20 sectionname ",
5be0: 76 61 72 6e 61 6d 65 3a 20 22 20 76 61 72 6e 61 varname: " varna
5bf0: 6d 65 20 22 2c 20 76 61 6c 3a 20 22 20 76 61 6c me ", val: " val
5c00: 29 0a 09 09 20 20 20 20 20 20 28 6c 65 74 2a 20 )... (let*
5c10: 28 28 64 61 74 20 20 20 20 20 20 28 67 65 74 2d ((dat (get-
5c20: 64 61 74 20 72 65 73 75 6c 74 73 20 73 68 65 65 dat results shee
5c30: 74 6e 61 6d 65 29 29 0a 09 09 09 20 20 20 20 20 tname))....
5c40: 28 76 65 63 20 20 20 20 20 20 28 72 65 66 64 62 (vec (refdb
5c50: 3a 63 73 76 2d 67 65 74 2d 73 76 65 63 20 64 61 :csv-get-svec da
5c60: 74 29 29 0a 09 09 09 20 20 20 20 20 28 72 6f 77 t)).... (row
5c70: 6e 61 6d 65 73 20 28 72 65 66 64 62 3a 63 73 76 names (refdb:csv
5c80: 2d 67 65 74 2d 72 6f 77 73 20 64 61 74 29 29 0a -get-rows dat)).
5c90: 09 09 09 20 20 20 20 20 28 63 6f 6c 6e 61 6d 65 ... (colname
5ca0: 73 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 s (refdb:csv-get
5cb0: 2d 63 6f 6c 73 20 64 61 74 29 29 0a 09 09 09 20 -cols dat))....
5cc0: 20 20 20 20 28 63 75 72 72 72 6f 77 6e 20 28 68 (currrown (h
5cd0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
5ce0: 66 61 75 6c 74 20 72 6f 77 6e 61 6d 65 73 20 76 fault rownames v
5cf0: 61 72 6e 61 6d 65 20 23 66 29 29 0a 09 09 09 20 arname #f))....
5d00: 20 20 20 20 28 63 75 72 72 63 6f 6c 6e 20 28 68 (currcoln (h
5d10: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
5d20: 66 61 75 6c 74 20 63 6f 6c 6e 61 6d 65 73 20 73 fault colnames s
5d30: 65 63 74 69 6f 6e 6e 61 6d 65 20 23 66 29 29 0a ectionname #f)).
5d40: 09 09 09 20 20 20 20 20 28 72 6f 77 6e 20 20 20 ... (rown
5d50: 20 20 28 6f 72 20 63 75 72 72 72 6f 77 6e 20 0a (or currrown .
5d60: 09 09 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 ..... (let* ((
5d70: 6c 61 73 74 6e 20 20 20 28 72 65 66 64 62 3a 63 lastn (refdb:c
5d80: 73 76 2d 67 65 74 2d 6d 61 78 72 6f 77 20 64 61 sv-get-maxrow da
5d90: 74 29 29 0a 09 09 09 09 09 09 20 20 28 6e 65 77 t))....... (new
5da0: 72 6f 77 6e 20 28 2b 20 6c 61 73 74 6e 20 31 29 rown (+ lastn 1)
5db0: 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 72 65 ))...... (re
5dc0: 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d 61 78 72 fdb:csv-set-maxr
5dd0: 6f 77 21 20 64 61 74 20 6e 65 77 72 6f 77 6e 29 ow! dat newrown)
5de0: 0a 09 09 09 09 09 20 20 20 20 20 6e 65 77 72 6f ...... newro
5df0: 77 6e 29 29 29 0a 09 09 09 20 20 20 20 20 28 63 wn))).... (c
5e00: 6f 6c 6e 20 20 20 20 20 28 6f 72 20 63 75 72 72 oln (or curr
5e10: 63 6f 6c 6e 20 0a 09 09 09 09 09 20 20 20 28 6c coln ...... (l
5e20: 65 74 2a 20 28 28 6c 61 73 74 6e 20 20 20 28 72 et* ((lastn (r
5e30: 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 efdb:csv-get-max
5e40: 63 6f 6c 20 64 61 74 29 29 0a 09 09 09 09 09 09 col dat)).......
5e50: 20 20 28 6e 65 77 63 6f 6c 6e 20 28 2b 20 6c 61 (newcoln (+ la
5e60: 73 74 6e 20 31 29 29 29 0a 09 09 09 09 09 20 20 stn 1)))......
5e70: 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 (refdb:csv-se
5e80: 74 2d 6d 61 78 63 6f 6c 21 20 64 61 74 20 6e 65 t-maxcol! dat ne
5e90: 77 63 6f 6c 6e 29 0a 09 09 09 09 09 20 20 20 20 wcoln)......
5ea0: 20 6e 65 77 63 6f 6c 6e 29 29 29 29 0a 09 09 09 newcoln))))....
5eb0: 28 69 66 20 28 6e 6f 74 20 28 73 70 61 72 73 65 (if (not (sparse
5ec0: 2d 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 30 -array-ref vec 0
5ed0: 20 63 6f 6c 6e 29 29 20 3b 3b 20 28 65 71 3f 20 coln)) ;; (eq?
5ee0: 72 6f 77 6e 20 30 29 0a 09 09 09 20 20 20 20 28 rown 0).... (
5ef0: 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 begin.... (
5f00: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 sparse-array-set
5f10: 21 20 76 65 63 20 30 20 63 6f 6c 6e 20 73 65 63 ! vec 0 coln sec
5f20: 74 69 6f 6e 6e 61 6d 65 29 0a 09 09 09 20 20 20 tionname)....
5f30: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 70 ;; (print "sp
5f40: 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 22 arse-array-ref "
5f50: 20 30 20 22 2c 22 20 63 6f 6c 6e 20 22 3d 22 20 0 "," coln "="
5f60: 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 (sparse-array-re
5f70: 66 20 76 65 63 20 30 20 63 6f 6c 6e 29 29 0a 09 f vec 0 coln))..
5f80: 09 09 20 20 20 20 20 20 29 29 0a 09 09 09 28 69 .. ))....(i
5f90: 66 20 28 6e 6f 74 20 28 73 70 61 72 73 65 2d 61 f (not (sparse-a
5fa0: 72 72 61 79 2d 72 65 66 20 76 65 63 20 72 6f 77 rray-ref vec row
5fb0: 6e 20 30 29 29 20 3b 3b 20 28 65 71 3f 20 63 6f n 0)) ;; (eq? co
5fc0: 6c 6e 20 30 29 0a 09 09 09 20 20 20 20 28 62 65 ln 0).... (be
5fd0: 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 73 70 gin.... (sp
5fe0: 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 21 20 arse-array-set!
5ff0: 76 65 63 20 72 6f 77 6e 20 30 20 76 61 72 6e 61 vec rown 0 varna
6000: 6d 65 29 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 me).... ;;
6010: 28 70 72 69 6e 74 20 22 73 70 61 72 73 65 2d 61 (print "sparse-a
6020: 72 72 61 79 2d 72 65 66 20 22 20 72 6f 77 6e 20 rray-ref " rown
6030: 22 2c 22 20 30 20 22 3d 22 20 28 73 70 61 72 73 "," 0 "=" (spars
6040: 65 2d 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 e-array-ref vec
6050: 72 6f 77 6e 20 30 29 29 0a 09 09 09 20 20 20 20 rown 0))....
6060: 20 20 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 ))....(if (not
6070: 20 63 75 72 72 72 6f 77 6e 29 28 68 61 73 68 2d currrown)(hash-
6080: 74 61 62 6c 65 2d 73 65 74 21 20 72 6f 77 6e 61 table-set! rowna
6090: 6d 65 73 20 76 61 72 6e 61 6d 65 20 72 6f 77 6e mes varname rown
60a0: 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 63 ))....(if (not c
60b0: 75 72 72 63 6f 6c 6e 29 28 68 61 73 68 2d 74 61 urrcoln)(hash-ta
60c0: 62 6c 65 2d 73 65 74 21 20 63 6f 6c 6e 61 6d 65 ble-set! colname
60d0: 73 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 63 6f s sectionname co
60e0: 6c 6e 29 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e ln))....;; (prin
60f0: 74 20 22 64 61 74 3d 22 20 64 61 74 20 22 2c 20 t "dat=" dat ",
6100: 72 6f 77 6e 3d 22 20 72 6f 77 6e 20 22 2c 20 63 rown=" rown ", c
6110: 6f 6c 6e 3d 22 20 63 6f 6c 6e 29 0a 09 09 09 28 oln=" coln)....(
6120: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 sparse-array-set
6130: 21 20 76 65 63 20 72 6f 77 6e 20 63 6f 6c 6e 20 ! vec rown coln
6140: 76 61 6c 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e val)....;; (prin
6150: 74 20 22 73 70 61 72 73 65 2d 61 72 72 61 79 2d t "sparse-array-
6160: 72 65 66 20 22 20 72 6f 77 6e 20 22 2c 22 20 63 ref " rown "," c
6170: 6f 6c 6e 20 22 3d 22 20 28 73 70 61 72 73 65 2d oln "=" (sparse-
6180: 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 72 6f array-ref vec ro
6190: 77 6e 20 63 6f 6c 6e 29 29 0a 09 09 09 29 29 29 wn coln))....)))
61a0: 0a 09 09 20 20 20 28 66 6f 72 2d 65 61 63 68 0a ... (for-each.
61b0: 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 .. (lambda (s
61c0: 68 65 65 74 6e 61 6d 65 29 0a 09 09 20 20 20 20 heetname)...
61d0: 20 20 28 6c 65 74 2a 20 28 28 73 68 65 65 74 64 (let* ((sheetd
61e0: 61 74 20 28 67 65 74 2d 64 61 74 20 72 65 73 75 at (get-dat resu
61f0: 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 29 29 0a lts sheetname)).
6200: 09 09 09 20 20 20 20 20 28 73 76 65 63 20 20 20 ... (svec
6210: 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 (refdb:csv-get
6220: 2d 73 76 65 63 20 73 68 65 65 74 64 61 74 29 29 -svec sheetdat))
6230: 0a 09 09 09 20 20 20 20 20 28 6d 61 78 72 6f 77 .... (maxrow
6240: 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 (refdb:csv-ge
6250: 74 2d 6d 61 78 72 6f 77 20 73 68 65 65 74 64 61 t-maxrow sheetda
6260: 74 29 29 0a 09 09 09 20 20 20 20 20 28 6d 61 78 t)).... (max
6270: 63 6f 6c 20 20 20 28 72 65 66 64 62 3a 63 73 76 col (refdb:csv
6280: 2d 67 65 74 2d 6d 61 78 63 6f 6c 20 73 68 65 65 -get-maxcol shee
6290: 74 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 tdat)).... (
62a0: 66 6e 61 6d 65 20 20 20 20 28 69 66 20 6f 75 74 fname (if out
62b0: 2d 66 69 6c 65 20 0a 09 09 09 09 09 20 20 20 28 -file ...... (
62c0: 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 string-substitut
62d0: 65 20 22 25 73 22 20 73 68 65 65 74 6e 61 6d 65 e "%s" sheetname
62e0: 20 6f 75 74 2d 66 69 6c 65 29 20 3b 3b 20 22 2f out-file) ;; "/
62f0: 66 6f 6f 2f 62 61 72 2f 25 73 2e 63 73 76 22 29 foo/bar/%s.csv")
6300: 0a 09 09 09 09 09 20 20 20 28 63 6f 6e 63 20 73 ...... (conc s
6310: 68 65 65 74 6e 61 6d 65 20 22 2e 63 73 76 22 29 heetname ".csv")
6320: 29 29 29 0a 09 09 09 28 77 69 74 68 2d 6f 75 74 )))....(with-out
6330: 70 75 74 2d 74 6f 2d 66 69 6c 65 20 66 6e 61 6d put-to-file fnam
6340: 65 0a 09 09 09 20 20 28 6c 61 6d 62 64 61 20 28 e.... (lambda (
6350: 29 0a 09 09 09 20 20 20 20 3b 3b 20 28 70 72 69 ).... ;; (pri
6360: 6e 74 20 22 53 68 65 65 74 6e 61 6d 65 3a 20 22 nt "Sheetname: "
6370: 20 73 68 65 65 74 6e 61 6d 65 29 0a 09 09 09 20 sheetname)....
6380: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 (let loop ((r
6390: 6f 77 20 20 20 20 20 20 20 30 29 0a 09 09 09 09 ow 0).....
63a0: 20 20 20 20 20 20 20 28 63 6f 6c 20 20 20 20 20 (col
63b0: 20 20 30 29 0a 09 09 09 09 20 20 20 20 20 20 20 0).....
63c0: 28 63 75 72 72 2d 72 6f 77 20 27 28 29 29 0a 09 (curr-row '())..
63d0: 09 09 09 20 20 20 20 20 20 20 28 72 65 73 75 6c ... (resul
63e0: 74 20 20 20 27 28 29 29 29 0a 09 09 09 20 20 20 t '()))....
63f0: 20 20 20 28 6c 65 74 2a 20 28 28 76 61 6c 20 28 (let* ((val (
6400: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 sparse-array-ref
6410: 20 73 76 65 63 20 72 6f 77 20 63 6f 6c 29 29 0a svec row col)).
6420: 09 09 09 09 20 20 20 20 20 28 64 69 73 70 2d 76 .... (disp-v
6430: 61 6c 20 28 69 66 20 76 61 6c 0a 09 09 09 09 09 al (if val......
6440: 09 20 20 20 28 63 6f 6e 63 20 22 5c 22 22 20 76 . (conc "\"" v
6450: 61 6c 20 22 5c 22 22 29 0a 09 09 09 09 09 09 20 al "\"").......
6460: 20 20 22 22 29 29 29 0a 09 09 09 09 28 69 66 20 ""))).....(if
6470: 28 3e 20 63 6f 6c 20 30 29 28 64 69 73 70 6c 61 (> col 0)(displa
6480: 79 20 22 2c 22 29 29 0a 09 09 09 09 28 64 69 73 y ",")).....(dis
6490: 70 6c 61 79 20 64 69 73 70 2d 76 61 6c 29 0a 09 play disp-val)..
64a0: 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 20 28 28 ...(cond..... ((
64b0: 3e 20 72 6f 77 20 6d 61 78 72 6f 77 29 28 64 69 > row maxrow)(di
64c0: 73 70 6c 61 79 20 22 5c 6e 22 29 20 72 65 73 75 splay "\n") resu
64d0: 6c 74 29 0a 09 09 09 09 20 28 28 3e 3d 20 63 6f lt)..... ((>= co
64e0: 6c 20 6d 61 78 63 6f 6c 29 0a 09 09 09 09 20 20 l maxcol).....
64f0: 28 64 69 73 70 6c 61 79 20 22 5c 6e 22 29 0a 09 (display "\n")..
6500: 09 09 09 20 20 28 6c 6f 6f 70 20 28 2b 20 72 6f ... (loop (+ ro
6510: 77 20 31 29 20 30 20 27 28 29 20 28 61 70 70 65 w 1) 0 '() (appe
6520: 6e 64 20 72 65 73 75 6c 74 20 28 6c 69 73 74 20 nd result (list
6530: 63 75 72 72 2d 72 6f 77 29 29 29 29 0a 09 09 09 curr-row))))....
6540: 09 20 28 65 6c 73 65 0a 09 09 09 09 20 20 28 6c . (else..... (l
6550: 6f 6f 70 20 72 6f 77 20 28 2b 20 63 6f 6c 20 31 oop row (+ col 1
6560: 29 20 28 61 70 70 65 6e 64 20 63 75 72 72 2d 72 ) (append curr-r
6570: 6f 77 20 28 6c 69 73 74 20 76 61 6c 29 29 20 72 ow (list val)) r
6580: 65 73 75 6c 74 29 29 29 29 29 29 29 29 29 0a 09 esult)))))))))..
6590: 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
65a0: 2d 6b 65 79 73 20 72 65 73 75 6c 74 73 29 29 29 -keys results)))
65b0: 29 0a 09 09 28 28 73 71 6c 69 74 65 33 29 0a 09 )...((sqlite3)..
65c0: 09 20 28 6c 65 74 2a 20 28 28 64 62 2d 66 69 6c . (let* ((db-fil
65d0: 65 20 20 20 28 6f 72 20 6f 75 74 2d 66 69 6c 65 e (or out-file
65e0: 20 28 70 61 74 68 6e 61 6d 65 2d 66 69 6c 65 20 (pathname-file
65f0: 69 6e 70 75 74 2d 64 62 29 29 29 0a 09 09 09 28 input-db)))....(
6600: 64 62 2d 65 78 69 73 74 73 20 28 66 69 6c 65 2d db-exists (file-
6610: 65 78 69 73 74 73 3f 20 64 62 2d 66 69 6c 65 29 exists? db-file)
6620: 29 0a 09 09 09 28 64 62 20 20 20 20 20 20 20 20 )....(db
6630: 28 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 (sqlite3:open-da
6640: 74 61 62 61 73 65 20 64 62 2d 66 69 6c 65 29 29 tabase db-file))
6650: 29 0a 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 )... (if (not
6660: 64 62 2d 65 78 69 73 74 73 29 28 73 71 6c 69 74 db-exists)(sqlit
6670: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 e3:execute db "C
6680: 52 45 41 54 45 20 54 41 42 4c 45 20 64 61 74 61 REATE TABLE data
6690: 20 28 73 68 65 65 74 2c 73 65 63 74 69 6f 6e 2c (sheet,section,
66a0: 76 61 72 2c 76 61 6c 29 3b 22 29 29 0a 09 09 20 var,val);"))...
66b0: 20 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 (configf:map-a
66c0: 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 0a 09 09 ll-hier-alist...
66d0: 20 20 20 20 64 61 74 61 0a 09 09 20 20 20 20 28 data... (
66e0: 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d lambda (sheetnam
66f0: 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 e sectionname va
6700: 72 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 rname val)...
6710: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
6720: 75 74 65 20 64 62 0a 09 09 09 09 20 20 20 20 20 ute db.....
6730: 20 20 22 49 4e 53 45 52 54 20 4f 52 20 52 45 50 "INSERT OR REP
6740: 4c 41 43 45 20 49 4e 54 4f 20 64 61 74 61 20 28 LACE INTO data (
6750: 73 68 65 65 74 2c 73 65 63 74 69 6f 6e 2c 76 61 sheet,section,va
6760: 72 2c 76 61 6c 29 20 56 41 4c 55 45 53 20 28 3f r,val) VALUES (?
6770: 2c 3f 2c 3f 2c 3f 29 3b 22 0a 09 09 09 09 20 20 ,?,?,?);".....
6780: 20 20 20 20 20 73 68 65 65 74 6e 61 6d 65 20 73 sheetname s
6790: 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 ectionname varna
67a0: 6d 65 20 76 61 6c 29 29 29 0a 09 09 20 20 20 28 me val)))... (
67b0: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
67c0: 21 20 64 62 29 29 29 0a 09 09 28 65 6c 73 65 0a ! db)))...(else.
67d0: 09 09 20 28 70 70 20 64 61 74 61 29 29 29 29 29 .. (pp data)))))
67e0: 29 0a 20 20 20 20 20 20 28 69 66 20 6f 75 74 2d ). (if out-
67f0: 66 69 6c 65 20 28 63 6c 6f 73 65 2d 6f 75 74 70 file (close-outp
6800: 75 74 2d 70 6f 72 74 20 6f 75 74 2d 70 6f 72 74 ut-port out-port
6810: 29 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 20 )). (exit)
6820: 3b 3b 20 79 65 73 2c 20 62 65 6e 64 69 6e 67 20 ;; yes, bending
6830: 74 68 65 20 72 75 6c 65 73 20 68 65 72 65 20 2d the rules here -
6840: 20 6e 65 65 64 20 74 6f 20 65 78 69 74 20 73 69 need to exit si
6850: 6e 63 65 20 74 68 69 73 20 69 73 20 61 20 75 74 nce this is a ut
6860: 69 6c 69 74 79 0a 20 20 20 20 20 20 29 29 0a 0a ility. ))..
6870: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
6880: 67 20 22 2d 70 69 6e 67 22 29 0a 20 20 20 20 28 g "-ping"). (
6890: 6c 65 74 2a 20 28 28 73 65 72 76 65 72 2d 69 64 let* ((server-id
68a0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 (string->nu
68b0: 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 mber (args:get-a
68c0: 72 67 20 22 2d 70 69 6e 67 22 29 29 29 20 3b 3b rg "-ping"))) ;;
68d0: 20 65 78 74 72 61 63 74 20 72 75 6e 2d 69 64 20 extract run-id
68e0: 28 69 2e 65 2e 20 6e 6f 20 22 3a 22 0a 09 20 20 (i.e. no ":"..
68f0: 20 28 68 6f 73 74 3a 70 6f 72 74 20 20 20 20 20 (host:port
6900: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6910: 70 69 6e 67 22 29 29 29 0a 20 20 20 20 20 20 28 ping"))). (
6920: 73 65 72 76 65 72 3a 70 69 6e 67 20 28 6f 72 20 server:ping (or
6930: 73 65 72 76 65 72 2d 69 64 20 68 6f 73 74 3a 70 server-id host:p
6940: 6f 72 74 29 20 64 6f 2d 65 78 69 74 3a 20 23 74 ort) do-exit: #t
6950: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
6960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
69a0: 20 43 61 70 74 75 72 65 2c 20 73 61 76 65 20 61 Capture, save a
69b0: 6e 64 20 6d 61 6e 69 70 75 6c 61 74 65 20 65 6e nd manipulate en
69c0: 76 69 72 6f 6e 6d 65 6e 74 73 0a 3b 3b 3d 3d 3d vironments.;;===
69d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
69e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
69f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a10: 3d 3d 3d 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 4b 65 ===..;; NOTE: Ke
6a20: 65 70 20 74 68 65 73 65 20 61 62 6f 76 65 20 74 ep these above t
6a30: 68 65 20 73 65 63 74 69 6f 6e 20 77 68 65 72 65 he section where
6a40: 20 74 68 65 20 73 65 72 76 65 72 20 6f 72 20 63 the server or c
6a50: 6c 69 65 6e 74 20 63 6f 64 65 20 69 73 20 73 65 lient code is se
6a60: 74 75 70 0a 0a 28 6c 65 74 20 28 28 65 6e 76 63 tup..(let ((envc
6a70: 61 70 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ap (args:get-arg
6a80: 20 22 2d 65 6e 76 63 61 70 22 29 29 29 0a 20 20 "-envcap"))).
6a90: 28 69 66 20 65 6e 76 63 61 70 0a 20 20 20 20 20 (if envcap.
6aa0: 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 (let* ((db
6ab0: 20 28 65 6e 76 3a 6f 70 65 6e 2d 64 62 20 28 69 (env:open-db (i
6ac0: 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 f (null? remargs
6ad0: 29 20 22 65 6e 76 64 61 74 2e 64 62 22 20 28 63 ) "envdat.db" (c
6ae0: 61 72 20 72 65 6d 61 72 67 73 29 29 29 29 29 0a ar remargs))))).
6af0: 09 28 65 6e 76 3a 73 61 76 65 2d 65 6e 76 2d 76 .(env:save-env-v
6b00: 61 72 73 20 64 62 20 65 6e 76 63 61 70 29 0a 09 ars db envcap)..
6b10: 28 65 6e 76 3a 63 6c 6f 73 65 2d 64 61 74 61 62 (env:close-datab
6b20: 61 73 65 20 64 62 29 0a 09 28 73 65 74 21 20 2a ase db)..(set! *
6b30: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
6b40: 29 29 29 29 0a 0a 3b 3b 20 64 65 6c 74 61 20 22 ))))..;; delta "
6b50: 6c 61 6e 67 75 61 67 65 22 20 77 69 6c 6c 20 65 language" will e
6b60: 76 65 6e 74 75 61 6c 6c 79 20 62 65 20 72 65 73 ventually be res
6b70: 3d 61 2b 62 2d 63 20 62 75 74 20 66 6f 72 20 6e =a+b-c but for n
6b80: 6f 77 20 69 74 20 69 73 20 6a 75 73 74 20 72 65 ow it is just re
6b90: 73 3d 61 2d 62 20 0a 3b 3b 0a 28 6c 65 74 20 28 s=a-b .;;.(let (
6ba0: 28 65 6e 76 64 65 6c 74 61 20 28 61 72 67 73 3a (envdelta (args:
6bb0: 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 64 65 6c get-arg "-envdel
6bc0: 74 61 22 29 29 29 0a 20 20 28 69 66 20 65 6e 76 ta"))). (if env
6bd0: 64 65 6c 74 61 0a 20 20 20 20 20 20 28 6c 65 74 delta. (let
6be0: 20 28 28 6d 61 74 63 68 20 28 73 74 72 69 6e 67 ((match (string
6bf0: 2d 73 70 6c 69 74 20 65 6e 76 64 65 6c 74 61 20 -split envdelta
6c00: 22 2d 22 29 29 29 3b 3b 20 28 73 74 72 69 6e 67 "-")));; (string
6c10: 2d 6d 61 74 63 68 20 22 28 5b 61 2d 7a 30 2d 39 -match "([a-z0-9
6c20: 5f 5d 2b 29 3d 28 5b 61 2d 7a 30 2d 39 5f 5c 5c _]+)=([a-z0-9_\\
6c30: 2d 2c 5d 2b 29 22 20 65 6e 76 64 65 6c 74 61 29 -,]+)" envdelta)
6c40: 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 6e 75 ))..(if (not (nu
6c50: 6c 6c 3f 20 6d 61 74 63 68 29 29 0a 09 20 20 20 ll? match))..
6c60: 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 (let* ((db
6c70: 20 20 20 28 65 6e 76 3a 6f 70 65 6e 2d 64 62 20 (env:open-db
6c80: 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 (if (null? remar
6c90: 67 73 29 20 22 65 6e 76 64 61 74 2e 64 62 22 20 gs) "envdat.db"
6ca0: 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 29 (car remargs))))
6cb0: 0a 09 09 20 20 20 3b 3b 20 28 72 65 73 63 74 78 ... ;; (resctx
6cc0: 20 20 20 20 28 63 61 64 72 20 6d 61 74 63 68 29 (cadr match)
6cd0: 29 0a 09 09 20 20 20 3b 3b 20 28 65 71 75 6e 20 )... ;; (equn
6ce0: 20 20 20 20 20 28 63 61 64 64 72 20 6d 61 74 63 (caddr matc
6cf0: 68 29 29 0a 09 09 20 20 20 28 70 61 72 74 73 20 h))... (parts
6d00: 20 20 20 20 6d 61 74 63 68 29 20 3b 3b 20 28 73 match) ;; (s
6d10: 74 72 69 6e 67 2d 73 70 6c 69 74 20 65 71 75 6e tring-split equn
6d20: 20 22 2d 22 29 29 0a 09 09 20 20 20 28 6d 69 6e "-"))... (min
6d30: 75 65 6e 64 20 20 20 28 63 61 72 20 70 61 72 74 uend (car part
6d40: 73 29 29 0a 09 09 20 20 20 28 73 75 62 74 72 61 s))... (subtra
6d50: 65 6e 64 20 28 63 61 64 72 20 70 61 72 74 73 29 end (cadr parts)
6d60: 29 0a 09 09 20 20 20 28 61 64 64 65 64 20 20 20 )... (added
6d70: 20 20 28 65 6e 76 3a 67 65 74 2d 61 64 64 65 64 (env:get-added
6d80: 20 20 20 64 62 20 6d 69 6e 75 65 6e 64 20 73 75 db minuend su
6d90: 62 74 72 61 65 6e 64 29 29 0a 09 09 20 20 20 28 btraend))... (
6da0: 72 65 6d 6f 76 65 64 20 20 20 28 65 6e 76 3a 67 removed (env:g
6db0: 65 74 2d 72 65 6d 6f 76 65 64 20 64 62 20 6d 69 et-removed db mi
6dc0: 6e 75 65 6e 64 20 73 75 62 74 72 61 65 6e 64 29 nuend subtraend)
6dd0: 29 0a 09 09 20 20 20 28 63 68 61 6e 67 65 64 20 )... (changed
6de0: 20 20 28 65 6e 76 3a 67 65 74 2d 63 68 61 6e 67 (env:get-chang
6df0: 65 64 20 64 62 20 6d 69 6e 75 65 6e 64 20 73 75 ed db minuend su
6e00: 62 74 72 61 65 6e 64 29 29 29 0a 09 20 20 20 20 btraend)))..
6e10: 20 20 3b 3b 20 28 70 70 20 28 68 61 73 68 2d 74 ;; (pp (hash-t
6e20: 61 62 6c 65 2d 3e 61 6c 69 73 74 20 61 64 64 65 able->alist adde
6e30: 64 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 70 d)).. ;; (p
6e40: 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 p (hash-table->a
6e50: 6c 69 73 74 20 72 65 6d 6f 76 65 64 29 29 0a 09 list removed))..
6e60: 20 20 20 20 20 20 3b 3b 20 28 70 70 20 28 68 61 ;; (pp (ha
6e70: 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 sh-table->alist
6e80: 63 68 61 6e 67 65 64 29 29 0a 09 20 20 20 20 20 changed))..
6e90: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
6ea0: 72 67 20 22 2d 6f 22 29 0a 09 09 20 20 28 77 69 rg "-o")... (wi
6eb0: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
6ec0: 65 0a 09 09 20 20 20 20 20 20 28 61 72 67 73 3a e... (args:
6ed0: 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 0a 09 09 get-arg "-o")...
6ee0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 (lambda ()..
6ef0: 09 20 20 20 20 20 20 28 65 6e 76 3a 70 72 69 6e . (env:prin
6f00: 74 20 61 64 64 65 64 20 72 65 6d 6f 76 65 64 20 t added removed
6f10: 63 68 61 6e 67 65 64 29 29 29 0a 09 09 20 20 28 changed)))... (
6f20: 65 6e 76 3a 70 72 69 6e 74 20 61 64 64 65 64 20 env:print added
6f30: 72 65 6d 6f 76 65 64 20 63 68 61 6e 67 65 64 29 removed changed)
6f40: 29 0a 09 20 20 20 20 20 20 28 65 6e 76 3a 63 6c ).. (env:cl
6f50: 6f 73 65 2d 64 61 74 61 62 61 73 65 20 64 62 29 ose-database db)
6f60: 0a 09 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 .. (set! *d
6f70: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
6f80: 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ).. (debug:pr
6f90: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
6fa0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
6fb0: 50 61 72 61 6d 65 74 65 72 20 74 6f 20 2d 65 6e Parameter to -en
6fc0: 76 64 65 6c 74 61 20 73 68 6f 75 6c 64 20 62 65 vdelta should be
6fd0: 20 6e 65 77 3d 73 74 61 72 2d 65 6e 64 22 29 29 new=star-end"))
6fe0: 29 29 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
7030: 20 53 74 61 72 74 20 74 68 65 20 73 65 72 76 65 Start the serve
7040: 72 20 2d 20 63 61 6e 20 62 65 20 64 6f 6e 65 20 r - can be done
7050: 69 6e 20 63 6f 6e 6a 75 6e 63 74 69 6f 6e 20 77 in conjunction w
7060: 69 74 68 20 2d 72 75 6e 61 6c 6c 20 6f 72 20 2d ith -runall or -
7070: 72 75 6e 74 65 73 74 73 20 28 6f 6e 65 20 64 61 runtests (one da
7080: 79 2e 2e 2e 29 0a 3b 3b 20 20 20 77 65 20 73 74 y...).;; we st
7090: 61 72 74 20 74 68 65 20 73 65 72 76 65 72 20 69 art the server i
70a0: 66 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 65 6c f not running el
70b0: 73 65 20 73 74 61 72 74 20 74 68 65 20 63 6c 69 se start the cli
70c0: 65 6e 74 20 74 68 72 65 61 64 0a 3b 3b 3d 3d 3d ent thread.;;===
70d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7110: 3d 3d 3d 0a 0a 3b 3b 20 53 65 72 76 65 72 3f 20 ===..;; Server?
7120: 53 74 61 72 74 20 75 70 20 68 65 72 65 2e 0a 3b Start up here..;
7130: 3b 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ;.(if (args:get-
7140: 61 72 67 20 22 2d 73 65 72 76 65 72 22 29 0a 20 arg "-server").
7150: 20 20 20 28 6c 65 74 20 28 28 74 6c 20 20 20 20 (let ((tl
7160: 20 20 20 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 (launch:setu
7170: 70 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 74 p)). (t
7180: 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 20 28 73 ransport-type (s
7190: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f tring->symbol (o
71a0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
71b0: 22 2d 74 72 61 6e 73 70 6f 72 74 22 29 20 22 68 "-transport") "h
71c0: 74 74 70 22 29 29 29 29 0a 20 20 20 20 20 20 28 ttp")))). (
71d0: 73 65 72 76 65 72 3a 6c 61 75 6e 63 68 20 30 20 server:launch 0
71e0: 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 29 0a transport-type).
71f0: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
7200: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
7210: 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a ..(if (or (args:
7220: 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 73 get-arg "-list-s
7230: 65 72 76 65 72 73 22 29 0a 09 28 61 72 67 73 3a ervers")..(args:
7240: 67 65 74 2d 61 72 67 20 22 2d 73 74 6f 70 2d 73 get-arg "-stop-s
7250: 65 72 76 65 72 22 29 0a 20 20 20 20 20 20 20 20 erver").
7260: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7270: 6b 69 6c 6c 2d 73 65 72 76 65 72 22 29 29 0a 20 kill-server")).
7280: 20 20 20 28 6c 65 74 20 28 28 74 6c 20 28 6c 61 (let ((tl (la
7290: 75 6e 63 68 3a 73 65 74 75 70 29 29 29 0a 20 20 unch:setup))).
72a0: 20 20 20 20 28 69 66 20 74 6c 20 0a 09 20 20 28 (if tl .. (
72b0: 6c 65 74 2a 20 28 28 74 64 62 64 61 74 20 20 28 let* ((tdbdat (
72c0: 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 29 0a tasks:open-db)).
72d0: 09 09 20 28 73 65 72 76 65 72 73 20 28 74 61 73 .. (servers (tas
72e0: 6b 73 3a 67 65 74 2d 61 6c 6c 2d 73 65 72 76 65 ks:get-all-serve
72f0: 72 73 20 28 64 62 3a 64 65 6c 61 79 2d 69 66 2d rs (db:delay-if-
7300: 62 75 73 79 20 74 64 62 64 61 74 29 29 29 0a 09 busy tdbdat)))..
7310: 09 20 28 66 6d 74 73 74 72 20 20 22 7e 35 61 7e . (fmtstr "~5a~
7320: 31 32 61 7e 38 61 7e 32 30 61 7e 32 34 61 7e 31 12a~8a~20a~24a~1
7330: 30 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 5c 6e 0a~10a~10a~10a\n
7340: 22 29 0a 09 09 20 28 73 65 72 76 65 72 73 2d 74 ")... (servers-t
7350: 6f 2d 6b 69 6c 6c 20 27 28 29 29 0a 20 20 20 20 o-kill '()).
7360: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6b 69 (ki
7370: 6c 6c 2d 73 77 69 74 63 68 20 20 28 69 66 20 28 ll-switch (if (
7380: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6b args:get-arg "-k
7390: 69 6c 6c 2d 73 65 72 76 65 72 22 29 20 22 2d 39 ill-server") "-9
73a0: 22 20 22 22 29 29 0a 20 20 20 20 20 20 20 20 20 " "")).
73b0: 20 20 20 20 20 20 20 20 28 6b 69 6c 6c 69 6e 66 (killinf
73c0: 6f 20 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 o (or (args:ge
73d0: 74 2d 61 72 67 20 22 2d 73 74 6f 70 2d 73 65 72 t-arg "-stop-ser
73e0: 76 65 72 22 29 20 28 61 72 67 73 3a 67 65 74 2d ver") (args:get-
73f0: 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 arg "-kill-serve
7400: 72 22 29 20 29 29 0a 09 09 20 28 6b 68 6f 73 74 r") ))... (khost
7410: 2d 70 6f 72 74 20 28 69 66 20 6b 69 6c 6c 69 6e -port (if killin
7420: 66 6f 20 28 69 66 20 28 73 75 62 73 74 72 69 6e fo (if (substrin
7430: 67 2d 69 6e 64 65 78 20 22 3a 22 20 6b 69 6c 6c g-index ":" kill
7440: 69 6e 66 6f 29 28 73 74 72 69 6e 67 2d 73 70 6c info)(string-spl
7450: 69 74 20 22 3a 22 29 20 23 66 29 20 23 66 29 29 it ":") #f) #f))
7460: 0a 09 09 20 28 73 69 64 20 20 20 20 20 20 20 20 ... (sid
7470: 28 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 69 66 (if killinfo (if
7480: 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 (substring-inde
7490: 78 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f 29 20 x ":" killinfo)
74a0: 23 66 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 #f (string->numb
74b0: 65 72 20 6b 69 6c 6c 69 6e 66 6f 29 29 20 23 66 er killinfo)) #f
74c0: 29 29 29 0a 09 20 20 20 20 28 66 6f 72 6d 61 74 ))).. (format
74d0: 20 23 74 20 66 6d 74 73 74 72 20 22 49 64 22 20 #t fmtstr "Id"
74e0: 22 4d 54 76 65 72 22 20 22 50 69 64 22 20 22 48 "MTver" "Pid" "H
74f0: 6f 73 74 22 20 22 49 6e 74 65 72 66 61 63 65 3a ost" "Interface:
7500: 4f 75 74 50 6f 72 74 22 20 22 49 6e 50 6f 72 74 OutPort" "InPort
7510: 22 20 22 4c 61 73 74 42 65 61 74 22 20 22 53 74 " "LastBeat" "St
7520: 61 74 65 22 20 22 54 72 61 6e 73 70 6f 72 74 22 ate" "Transport"
7530: 29 0a 09 20 20 20 20 28 66 6f 72 6d 61 74 20 23 ).. (format #
7540: 74 20 66 6d 74 73 74 72 20 22 3d 3d 22 20 22 3d t fmtstr "==" "=
7550: 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 20 22 3d 3d 3d ====" "===" "===
7560: 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d =" "============
7570: 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 22 20 =====" "======"
7580: 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d "========" "====
7590: 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 29 0a =" "=========").
75a0: 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a . (for-each .
75b0: 09 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 . (lambda (s
75c0: 65 72 76 65 72 29 0a 09 20 20 20 20 20 20 20 28 erver).. (
75d0: 6c 65 74 2a 20 28 28 69 64 20 20 20 20 20 20 20 let* ((id
75e0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
75f0: 72 76 65 72 20 30 29 29 0a 09 09 20 20 20 20 20 rver 0))...
7600: 20 28 70 69 64 20 20 20 20 20 20 20 20 28 76 65 (pid (ve
7610: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
7620: 31 29 29 0a 09 09 20 20 20 20 20 20 28 68 6f 73 1))... (hos
7630: 74 6e 61 6d 65 20 20 20 28 76 65 63 74 6f 72 2d tname (vector-
7640: 72 65 66 20 73 65 72 76 65 72 20 32 29 29 0a 09 ref server 2))..
7650: 09 20 20 20 20 20 20 28 69 6e 74 65 72 66 61 63 . (interfac
7660: 65 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 e (vector-ref s
7670: 65 72 76 65 72 20 33 29 29 20 0a 09 09 20 20 20 erver 3)) ...
7680: 20 20 20 28 70 75 6c 6c 70 6f 72 74 20 20 20 28 (pullport (
7690: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
76a0: 72 20 34 29 29 0a 09 09 20 20 20 20 20 20 28 70 r 4))... (p
76b0: 75 62 70 6f 72 74 20 20 20 20 28 76 65 63 74 6f ubport (vecto
76c0: 72 2d 72 65 66 20 73 65 72 76 65 72 20 35 29 29 r-ref server 5))
76d0: 0a 09 09 20 20 20 20 20 20 28 73 74 61 72 74 2d ... (start-
76e0: 74 69 6d 65 20 28 76 65 63 74 6f 72 2d 72 65 66 time (vector-ref
76f0: 20 73 65 72 76 65 72 20 36 29 29 0a 09 09 20 20 server 6))...
7700: 20 20 20 20 28 70 72 69 6f 72 69 74 79 20 20 20 (priority
7710: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 (vector-ref serv
7720: 65 72 20 37 29 29 0a 09 09 20 20 20 20 20 20 28 er 7))... (
7730: 73 74 61 74 65 20 20 20 20 20 20 28 76 65 63 74 state (vect
7740: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 38 29 or-ref server 8)
7750: 29 0a 09 09 20 20 20 20 20 20 28 6d 74 2d 76 65 )... (mt-ve
7760: 72 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 r (vector-re
7770: 66 20 73 65 72 76 65 72 20 39 29 29 0a 09 09 20 f server 9))...
7780: 20 20 20 20 20 28 6c 61 73 74 2d 75 70 64 61 74 (last-updat
7790: 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 e (vector-ref se
77a0: 72 76 65 72 20 31 30 29 29 20 0a 09 09 20 20 20 rver 10)) ...
77b0: 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 20 28 (transport (
77c0: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
77d0: 72 20 31 31 29 29 0a 09 09 20 20 20 20 20 20 28 r 11))... (
77e0: 6b 69 6c 6c 65 64 20 20 20 20 20 23 66 29 0a 09 killed #f)..
77f0: 09 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 . (status
7800: 20 20 20 28 3c 20 6c 61 73 74 2d 75 70 64 61 74 (< last-updat
7810: 65 20 32 30 29 29 29 0a 09 09 20 3b 3b 20 20 20 e 20)))... ;;
7820: 28 7a 6d 71 2d 73 6f 63 6b 65 74 73 20 28 69 66 (zmq-sockets (if
7830: 20 73 74 61 74 75 73 20 28 73 65 72 76 65 72 3a status (server:
7840: 63 6c 69 65 6e 74 2d 63 6f 6e 6e 65 63 74 20 68 client-connect h
7850: 6f 73 74 6e 61 6d 65 20 70 6f 72 74 29 20 23 66 ostname port) #f
7860: 29 29 29 0a 09 09 20 3b 3b 20 6e 6f 20 6e 65 65 )))... ;; no nee
7870: 64 20 74 6f 20 6c 6f 67 69 6e 20 61 73 20 73 74 d to login as st
7880: 61 74 75 73 20 6f 66 20 23 74 20 69 6e 64 69 63 atus of #t indic
7890: 61 74 65 73 20 77 65 20 61 72 65 20 63 6f 6e 6e ates we are conn
78a0: 65 63 74 69 6e 67 20 74 6f 20 63 6f 72 72 65 63 ecting to correc
78b0: 74 20 0a 09 09 20 3b 3b 20 73 65 72 76 65 72 0a t ... ;; server.
78c0: 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 .. (if (equal? s
78d0: 74 61 74 65 20 22 64 65 61 64 22 29 0a 09 09 20 tate "dead")...
78e0: 20 20 20 20 28 69 66 20 28 3e 20 6c 61 73 74 2d (if (> last-
78f0: 75 70 64 61 74 65 20 28 2a 20 32 35 20 36 30 20 update (* 25 60
7900: 36 30 29 29 20 3b 3b 20 6b 65 65 70 20 72 65 63 60)) ;; keep rec
7910: 6f 72 64 73 20 61 72 6f 75 6e 64 20 66 6f 72 20 ords around for
7920: 73 6c 69 67 68 6c 79 20 6f 76 65 72 20 61 20 64 slighly over a d
7930: 61 79 2e 0a 09 09 09 20 28 74 61 73 6b 73 3a 73 ay..... (tasks:s
7940: 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 65 72 erver-deregister
7950: 20 28 64 62 3a 64 65 6c 61 79 2d 69 66 2d 62 75 (db:delay-if-bu
7960: 73 79 20 74 64 62 64 61 74 29 20 68 6f 73 74 6e sy tdbdat) hostn
7970: 61 6d 65 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 ame pullport: pu
7980: 6c 6c 70 6f 72 74 20 70 69 64 3a 20 70 69 64 20 llport pid: pid
7990: 61 63 74 69 6f 6e 3a 20 27 64 65 6c 65 74 65 29 action: 'delete)
79a0: 29 0a 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 )... (if (>
79b0: 6c 61 73 74 2d 75 70 64 61 74 65 20 32 30 29 20 last-update 20)
79c0: 20 20 20 20 20 20 20 3b 3b 20 4d 61 72 6b 20 61 ;; Mark a
79d0: 73 20 64 65 61 64 20 69 66 20 6e 6f 74 20 75 70 s dead if not up
79e0: 64 61 74 65 64 20 69 6e 20 6c 61 73 74 20 32 30 dated in last 20
79f0: 20 73 65 63 6f 6e 64 73 0a 09 09 09 20 28 74 61 seconds.... (ta
7a00: 73 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 65 67 sks:server-dereg
7a10: 69 73 74 65 72 20 28 64 62 3a 64 65 6c 61 79 2d ister (db:delay-
7a20: 69 66 2d 62 75 73 79 20 74 64 62 64 61 74 29 20 if-busy tdbdat)
7a30: 68 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 hostname pullpor
7a40: 74 3a 20 70 75 6c 6c 70 6f 72 74 20 70 69 64 3a t: pullport pid:
7a50: 20 70 69 64 29 29 29 0a 09 09 20 28 66 6f 72 6d pid)))... (form
7a60: 61 74 20 23 74 20 66 6d 74 73 74 72 20 69 64 20 at #t fmtstr id
7a70: 6d 74 2d 76 65 72 20 70 69 64 20 68 6f 73 74 6e mt-ver pid hostn
7a80: 61 6d 65 20 28 63 6f 6e 63 20 69 6e 74 65 72 66 ame (conc interf
7a90: 61 63 65 20 22 3a 22 20 70 75 6c 6c 70 6f 72 74 ace ":" pullport
7aa0: 29 20 70 75 62 70 6f 72 74 20 6c 61 73 74 2d 75 ) pubport last-u
7ab0: 70 64 61 74 65 0a 09 09 09 20 28 69 66 20 73 74 pdate.... (if st
7ac0: 61 74 75 73 20 22 61 6c 69 76 65 22 20 22 64 65 atus "alive" "de
7ad0: 61 64 22 29 20 74 72 61 6e 73 70 6f 72 74 29 0a ad") transport).
7ae0: 09 09 20 28 69 66 20 28 6f 72 20 28 65 71 75 61 .. (if (or (equa
7af0: 6c 3f 20 69 64 20 73 69 64 29 0a 09 09 09 20 28 l? id sid).... (
7b00: 65 71 75 61 6c 3f 20 73 69 64 20 30 29 29 20 3b equal? sid 0)) ;
7b10: 3b 20 6b 69 6c 6c 20 61 6c 6c 2f 61 6e 79 0a 09 ; kill all/any..
7b20: 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 . (begin...
7b30: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
7b40: 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
7b50: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 41 74 lt-log-port* "At
7b60: 74 65 6d 70 74 69 6e 67 20 74 6f 20 6b 69 6c 6c tempting to kill
7b70: 20 22 6b 69 6c 6c 2d 73 77 69 74 63 68 22 20 73 "kill-switch" s
7b80: 65 72 76 65 72 20 77 69 74 68 20 70 69 64 20 22 erver with pid "
7b90: 20 70 69 64 29 0a 09 09 20 20 20 20 20 20 20 28 pid)... (
7ba0: 74 61 73 6b 73 3a 6b 69 6c 6c 2d 73 65 72 76 65 tasks:kill-serve
7bb0: 72 20 68 6f 73 74 6e 61 6d 65 20 70 69 64 20 6b r hostname pid k
7bc0: 69 6c 6c 2d 73 77 69 74 63 68 3a 20 6b 69 6c 6c ill-switch: kill
7bd0: 2d 73 77 69 74 63 68 29 29 29 29 29 0a 09 20 20 -switch)))))..
7be0: 20 20 20 73 65 72 76 65 72 73 29 0a 09 20 20 20 servers)..
7bf0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
7c00: 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 1 *default-lo
7c10: 67 2d 70 6f 72 74 2a 20 22 44 6f 6e 65 20 77 69 g-port* "Done wi
7c20: 74 68 20 6c 69 73 74 73 65 72 76 65 72 73 22 29 th listservers")
7c30: 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 .. (set! *did
7c40: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 something* #t)..
7c50: 20 20 20 20 28 65 78 69 74 29 29 20 3b 3b 20 6d (exit)) ;; m
7c60: 75 73 74 20 64 6f 2c 20 77 6f 75 6c 64 20 68 61 ust do, would ha
7c70: 76 65 20 74 6f 20 61 64 64 20 63 68 65 63 6b 73 ve to add checks
7c80: 20 74 6f 20 6d 61 6e 79 2f 61 6c 6c 20 63 61 6c to many/all cal
7c90: 6c 73 20 62 65 6c 6f 77 0a 09 20 20 28 65 78 69 ls below.. (exi
7ca0: 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d t))))..;;=======
7cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
7cf0: 3b 3b 20 57 65 69 72 64 20 73 70 65 63 69 61 6c ;; Weird special
7d00: 20 63 61 6c 6c 73 20 74 68 61 74 20 6e 65 65 64 calls that need
7d10: 20 74 6f 20 72 75 6e 20 2a 61 66 74 65 72 2a 20 to run *after*
7d20: 74 68 65 20 73 65 72 76 65 72 20 68 61 73 20 73 the server has s
7d30: 74 61 72 74 65 64 3f 0a 3b 3b 3d 3d 3d 3d 3d 3d tarted?.;;======
7d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d80: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
7d90: 61 72 67 20 22 2d 6c 69 73 74 2d 74 61 72 67 65 arg "-list-targe
7da0: 74 73 22 29 0a 20 20 20 20 28 69 66 20 28 6c 61 ts"). (if (la
7db0: 75 6e 63 68 3a 73 65 74 75 70 29 0a 20 20 20 20 unch:setup).
7dc0: 20 20 20 20 28 6c 65 74 20 28 28 74 61 72 67 65 (let ((targe
7dd0: 74 73 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 72 ts (common:get-r
7de0: 75 6e 63 6f 6e 66 69 67 2d 74 61 72 67 65 74 73 unconfig-targets
7df0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 3b 3b ))). ;;
7e00: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 (debug:print 1
7e10: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
7e20: 74 2a 20 22 46 6f 75 6e 64 20 22 28 6c 65 6e 67 t* "Found "(leng
7e30: 74 68 20 74 61 72 67 65 74 73 29 20 22 20 74 61 th targets) " ta
7e40: 72 67 65 74 73 22 29 0a 20 20 20 20 20 20 20 20 rgets").
7e50: 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d (case (string-
7e60: 3e 73 79 6d 62 6f 6c 20 28 6f 72 20 28 61 72 67 >symbol (or (arg
7e70: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
7e80: 6d 6f 64 65 22 29 20 22 61 6c 69 73 74 22 29 29 mode") "alist"))
7e90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 61 . ((a
7ea0: 6c 69 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 list).
7eb0: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
7ec0: 6d 62 64 61 20 28 78 29 0a 20 20 20 20 20 20 20 mbda (x).
7ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ee0: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 5b 22 20 ;; (print "["
7ef0: 78 20 22 5d 22 29 29 0a 20 20 20 20 20 20 20 20 x "]")).
7f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f10: 20 28 70 72 69 6e 74 20 78 29 29 0a 20 20 20 20 (print x)).
7f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f30: 20 20 20 74 61 72 67 65 74 73 29 29 0a 20 20 20 targets)).
7f40: 20 20 20 20 20 20 20 20 20 28 28 6a 73 6f 6e 29 ((json)
7f50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6a . (j
7f60: 73 6f 6e 2d 77 72 69 74 65 20 74 61 72 67 65 74 son-write target
7f70: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
7f80: 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 (else.
7f90: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
7fa0: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
7fb0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 64 75 6d 70 -log-port* "dump
7fc0: 20 6f 75 74 70 75 74 20 66 6f 72 6d 61 74 20 22 output format "
7fd0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7fe0: 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f -dumpmode") " no
7ff0: 74 20 73 75 70 70 6f 72 74 65 64 20 66 6f 72 20 t supported for
8000: 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 22 29 29 -list-targets"))
8010: 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 74 ). (set
8020: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
8030: 20 23 74 29 29 29 29 0a 0a 3b 3b 20 63 61 63 68 #t))))..;; cach
8040: 65 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 73 e the runconfigs
8050: 20 69 6e 20 24 4d 54 5f 4c 49 4e 4b 54 52 45 45 in $MT_LINKTREE
8060: 2f 24 4d 54 5f 54 41 52 47 45 54 2f 24 4d 54 5f /$MT_TARGET/$MT_
8070: 52 55 4e 4e 41 4d 45 2f 2e 72 75 6e 63 6f 6e 66 RUNNAME/.runconf
8080: 69 67 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 66 ig.;;.(define (f
8090: 75 6c 6c 2d 72 75 6e 63 6f 6e 66 69 67 73 2d 72 ull-runconfigs-r
80a0: 65 61 64 29 0a 3b 3b 20 69 6e 20 74 68 65 20 65 ead).;; in the e
80b0: 6e 76 70 72 6f 63 65 73 73 69 6e 67 20 62 72 61 nvprocessing bra
80c0: 6e 63 68 20 74 68 65 20 62 65 6c 6f 77 20 63 6f nch the below co
80d0: 64 65 20 72 65 70 6c 61 63 65 73 20 74 68 65 20 de replaces the
80e0: 66 75 72 74 68 65 72 20 62 65 6c 6f 77 20 63 6f further below co
80f0: 64 65 0a 3b 3b 20 20 28 69 66 20 28 65 71 3f 20 de.;; (if (eq?
8100: 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 2a 20 27 *configstatus* '
8110: 66 75 6c 6c 64 61 74 61 29 0a 3b 3b 20 20 20 20 fulldata).;;
8120: 20 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a *runconfigdat*
8130: 0a 3b 3b 20 20 20 20 20 20 28 62 65 67 69 6e 0a .;; (begin.
8140: 3b 3b 09 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 ;;.(launch:setup
8150: 29 0a 3b 3b 09 2a 72 75 6e 63 6f 6e 66 69 67 64 ).;;.*runconfigd
8160: 61 74 2a 29 29 29 0a 0a 20 20 28 6c 65 74 2a 20 at*))).. (let*
8170: 28 28 72 75 6e 64 69 72 20 28 69 66 20 28 61 6e ((rundir (if (an
8180: 64 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 4c 49 d (getenv "MT_LI
8190: 4e 4b 54 52 45 45 22 29 28 67 65 74 65 6e 76 20 NKTREE")(getenv
81a0: 22 4d 54 5f 54 41 52 47 45 54 22 29 28 67 65 74 "MT_TARGET")(get
81b0: 65 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 env "MT_RUNNAME"
81c0: 29 29 0a 09 09 20 20 20 20 20 28 63 6f 6e 63 20 ))... (conc
81d0: 28 67 65 74 65 6e 76 20 22 4d 54 5f 4c 49 4e 4b (getenv "MT_LINK
81e0: 54 52 45 45 22 29 20 22 2f 22 20 28 67 65 74 65 TREE") "/" (gete
81f0: 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 20 nv "MT_TARGET")
8200: 22 2f 22 20 28 67 65 74 65 6e 76 20 22 4d 54 5f "/" (getenv "MT_
8210: 52 55 4e 4e 41 4d 45 22 29 29 0a 09 09 20 20 20 RUNNAME"))...
8220: 20 20 23 66 29 29 0a 09 20 28 63 66 67 66 20 20 #f)).. (cfgf
8230: 20 28 69 66 20 72 75 6e 64 69 72 20 28 63 6f 6e (if rundir (con
8240: 63 20 72 75 6e 64 69 72 20 22 2f 2e 72 75 6e 63 c rundir "/.runc
8250: 6f 6e 66 69 67 2e 22 20 6d 65 67 61 74 65 73 74 onfig." megatest
8260: 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 -version "-" meg
8270: 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 atest-fossil-has
8280: 68 29 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 h) #f))). (if
8290: 20 28 61 6e 64 20 63 66 67 66 0a 09 20 20 20 20 (and cfgf..
82a0: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 63 (file-exists? c
82b0: 66 67 66 29 0a 09 20 20 20 20 20 28 66 69 6c 65 fgf).. (file
82c0: 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 63 -write-access? c
82d0: 66 67 66 29 29 0a 09 28 63 6f 6e 66 69 67 66 3a fgf))..(configf:
82e0: 72 65 61 64 2d 61 6c 69 73 74 20 63 66 67 66 29 read-alist cfgf)
82f0: 0a 09 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 ..(let* ((keys
8300: 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 (rmt:get-keys))
8310: 0a 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 .. (target
8320: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
8330: 74 2d 74 61 72 67 65 74 29 29 0a 09 20 20 20 20 t-target))..
8340: 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 28 69 66 (key-vals (if
8350: 20 74 61 72 67 65 74 20 28 6b 65 79 73 3a 74 61 target (keys:ta
8360: 72 67 65 74 2d 3e 6b 65 79 76 61 6c 20 6b 65 79 rget->keyval key
8370: 73 20 74 61 72 67 65 74 29 20 23 66 29 29 0a 09 s target) #f))..
8380: 20 20 20 20 20 20 20 28 73 65 63 74 69 6f 6e 73 (sections
8390: 20 28 69 66 20 74 61 72 67 65 74 20 28 6c 69 73 (if target (lis
83a0: 74 20 22 64 65 66 61 75 6c 74 22 20 74 61 72 67 t "default" targ
83b0: 65 74 29 20 23 66 29 29 0a 09 20 20 20 20 20 20 et) #f))..
83c0: 20 28 64 61 74 61 20 20 20 20 20 28 62 65 67 69 (data (begi
83d0: 6e 0a 09 09 09 20 20 20 28 73 65 74 65 6e 76 20 n.... (setenv
83e0: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
83f0: 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 09 E" *toppath*)...
8400: 09 20 20 20 28 69 66 20 6b 65 79 2d 76 61 6c 73 . (if key-vals
8410: 0a 09 09 09 20 20 20 20 20 20 20 28 66 6f 72 2d .... (for-
8420: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 74 each (lambda (kt
8430: 29 0a 09 09 09 09 09 20 20 20 28 73 65 74 65 6e )...... (seten
8440: 76 20 28 63 61 72 20 6b 74 29 20 28 63 61 64 72 v (car kt) (cadr
8450: 20 6b 74 29 29 29 0a 09 09 09 09 09 20 6b 65 79 kt)))...... key
8460: 2d 76 61 6c 73 29 29 0a 09 09 09 20 20 20 3b 3b -vals)).... ;;
8470: 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 (read-config (c
8480: 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f onc *toppath* "/
8490: 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 runconfigs.confi
84a0: 67 22 29 20 23 66 20 23 74 20 73 65 63 74 69 6f g") #f #t sectio
84b0: 6e 73 3a 20 73 65 63 74 69 6f 6e 73 29 29 29 29 ns: sections))))
84c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
84d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 72 75 6e (run
84e0: 63 6f 6e 66 69 67 3a 72 65 61 64 20 28 63 6f 6e config:read (con
84f0: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 c *toppath* "/ru
8500: 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 nconfigs.config"
8510: 29 20 74 61 72 67 65 74 20 23 66 29 29 29 29 0a ) target #f)))).
8520: 09 20 20 28 69 66 20 28 61 6e 64 20 72 75 6e 64 . (if (and rund
8530: 69 72 20 3b 3b 20 68 61 76 65 20 61 6c 6c 20 6e ir ;; have all n
8540: 65 65 64 65 64 20 76 61 72 69 61 62 6c 65 73 73 eeded variabless
8550: 0a 09 09 20 20 20 28 64 69 72 65 63 74 6f 72 79 ... (directory
8560: 2d 65 78 69 73 74 73 3f 20 72 75 6e 64 69 72 29 -exists? rundir)
8570: 0a 09 09 20 20 20 28 66 69 6c 65 2d 77 72 69 74 ... (file-writ
8580: 65 2d 61 63 63 65 73 73 3f 20 72 75 6e 64 69 72 e-access? rundir
8590: 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e )).. (begin
85a0: 0a 09 09 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 ...(configf:writ
85b0: 65 2d 61 6c 69 73 74 20 64 61 74 61 20 63 66 67 e-alist data cfg
85c0: 66 29 0a 09 09 3b 3b 20 66 6f 72 63 65 20 72 65 f)...;; force re
85d0: 2d 72 65 61 64 20 6f 66 20 6d 65 67 61 74 65 73 -read of megates
85e0: 74 2e 63 6f 6e 66 69 67 20 2d 20 74 68 69 73 20 t.config - this
85f0: 72 65 73 6f 6c 76 65 73 20 63 69 72 63 75 6c 61 resolves circula
8600: 72 20 72 65 66 65 72 65 6e 63 65 73 20 62 65 74 r references bet
8610: 77 65 65 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f ween megatest.co
8620: 6e 66 69 67 0a 09 09 28 6c 61 75 6e 63 68 3a 73 nfig...(launch:s
8630: 65 74 75 70 20 66 6f 72 63 65 3a 20 23 74 29 0a etup force: #t).
8640: 09 09 28 6c 61 75 6e 63 68 3a 63 61 63 68 65 2d ..(launch:cache-
8650: 63 6f 6e 66 69 67 29 29 29 20 3b 3b 20 77 65 20 config))) ;; we
8660: 63 61 6e 20 73 61 66 65 6c 79 20 63 61 63 68 65 can safely cache
8670: 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 megatest.config
8680: 20 73 69 6e 63 65 20 77 65 20 68 61 76 65 20 61 since we have a
8690: 20 76 61 6c 69 64 20 72 75 6e 63 6f 6e 66 69 67 valid runconfig
86a0: 0a 09 20 20 64 61 74 61 29 29 29 29 0a 0a 28 69 .. data))))..(i
86b0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
86c0: 22 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 "-show-runconfig
86d0: 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c "). (let ((tl
86e0: 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
86f0: 29 0a 20 20 20 20 20 20 28 70 75 73 68 2d 64 69 ). (push-di
8700: 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 rectory *toppath
8710: 2a 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 *). (let ((
8720: 64 61 74 61 20 28 66 75 6c 6c 2d 72 75 6e 63 6f data (full-runco
8730: 6e 66 69 67 73 2d 72 65 61 64 29 29 29 0a 09 3b nfigs-read)))..;
8740: 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 ; keep this one
8750: 6c 6f 63 61 6c 0a 09 28 63 6f 6e 64 0a 09 20 28 local..(cond.. (
8760: 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 (and (args:get-a
8770: 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 0a 09 rg "-section")..
8780: 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 (args:get
8790: 2d 61 72 67 20 22 2d 76 61 72 22 29 29 0a 09 20 -arg "-var"))..
87a0: 20 28 6c 65 74 20 28 28 76 61 6c 20 28 6f 72 20 (let ((val (or
87b0: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
87c0: 64 61 74 61 20 28 61 72 67 73 3a 67 65 74 2d 61 data (args:get-a
87d0: 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 28 61 rg "-section")(a
87e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 rgs:get-arg "-va
87f0: 72 22 29 29 0a 09 09 09 20 28 63 6f 6e 66 69 67 r")).... (config
8800: 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 61 20 22 64 f:lookup data "d
8810: 65 66 61 75 6c 74 22 20 28 61 72 67 73 3a 67 65 efault" (args:ge
8820: 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 29 29 t-arg "-var"))))
8830: 29 0a 09 20 20 20 20 28 69 66 20 76 61 6c 20 28 ).. (if val (
8840: 70 72 69 6e 74 20 76 61 6c 29 29 29 29 0a 09 20 print val))))..
8850: 28 28 6f 72 20 28 6e 6f 74 20 28 61 72 67 73 3a ((or (not (args:
8860: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
8870: 64 65 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 de")).
8880: 20 20 20 20 28 73 74 72 69 6e 67 3d 3f 20 28 61 (string=? (a
8890: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
88a0: 6d 70 6d 6f 64 65 22 29 20 22 69 6e 69 22 29 29 mpmode") "ini"))
88b0: 0a 09 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6e .. (configf:con
88c0: 66 69 67 2d 3e 69 6e 69 20 64 61 74 61 29 29 0a fig->ini data)).
88d0: 09 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 . ((string=? (ar
88e0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d gs:get-arg "-dum
88f0: 70 6d 6f 64 65 22 29 20 22 73 65 78 70 22 29 0a pmode") "sexp").
8900: 09 20 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 . (pp (hash-tab
8910: 6c 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 29 29 le->alist data))
8920: 29 0a 09 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 ).. ((string=? (
8930: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
8940: 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 umpmode") "json"
8950: 29 0a 09 20 20 28 6a 73 6f 6e 2d 77 72 69 74 65 ).. (json-write
8960: 20 64 61 74 61 29 29 0a 09 20 28 65 6c 73 65 0a data)).. (else.
8970: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
8980: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
8990: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 64 75 6d -log-port* "-dum
89a0: 70 6d 6f 64 65 20 6f 66 20 22 20 28 61 72 67 73 pmode of " (args
89b0: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
89c0: 6f 64 65 22 29 20 22 20 6e 6f 74 20 72 65 63 6f ode") " not reco
89d0: 67 6e 69 73 65 64 22 29 29 29 0a 09 28 73 65 74 gnised")))..(set
89e0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
89f0: 20 23 74 29 29 0a 20 20 20 20 20 20 28 70 6f 70 #t)). (pop
8a00: 2d 64 69 72 65 63 74 6f 72 79 29 29 29 0a 0a 28 -directory)))..(
8a10: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
8a20: 20 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 22 29 "-show-config")
8a30: 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 20 . (let ((tl
8a40: 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
8a50: 0a 09 20 20 28 64 61 74 61 20 2a 63 6f 6e 66 69 .. (data *confi
8a60: 67 64 61 74 2a 29 29 20 3b 3b 20 28 72 65 61 64 gdat*)) ;; (read
8a70: 2d 63 6f 6e 66 69 67 20 22 6d 65 67 61 74 65 73 -config "megates
8a80: 74 2e 63 6f 6e 66 69 67 22 20 23 66 20 23 74 29 t.config" #f #t)
8a90: 29 29 0a 20 20 20 20 20 20 28 70 75 73 68 2d 64 )). (push-d
8aa0: 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 irectory *toppat
8ab0: 68 2a 29 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 h*). ;; kee
8ac0: 70 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c p this one local
8ad0: 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 0a 20 20 . (cond .
8ae0: 20 20 20 20 20 28 28 61 6e 64 20 28 61 72 67 73 ((and (args
8af0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 :get-arg "-secti
8b00: 6f 6e 22 29 0a 09 20 20 20 20 20 28 61 72 67 73 on").. (args
8b10: 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 :get-arg "-var")
8b20: 29 0a 09 28 6c 65 74 20 28 28 76 61 6c 20 28 63 )..(let ((val (c
8b30: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 onfigf:lookup da
8b40: 74 61 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ta (args:get-arg
8b50: 20 22 2d 73 65 63 74 69 6f 6e 22 29 28 61 72 67 "-section")(arg
8b60: 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 s:get-arg "-var"
8b70: 29 29 29 29 0a 09 20 20 28 69 66 20 76 61 6c 20 )))).. (if val
8b80: 28 70 72 69 6e 74 20 76 61 6c 29 29 29 29 0a 0a (print val))))..
8b90: 20 20 20 20 20 20 20 3b 3b 20 70 72 69 6e 74 20 ;; print
8ba0: 6a 75 73 74 20 61 20 73 65 63 74 69 6f 6e 20 69 just a section i
8bb0: 66 20 6f 6e 6c 79 20 2d 73 65 63 74 69 6f 6e 0a f only -section.
8bc0: 0a 20 20 20 20 20 20 20 28 28 6e 6f 74 20 28 61 . ((not (a
8bd0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
8be0: 6d 70 6d 6f 64 65 22 29 29 0a 09 28 70 70 20 28 mpmode"))..(pp (
8bf0: 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 hash-table->alis
8c00: 74 20 64 61 74 61 29 29 29 0a 20 20 20 20 20 20 t data))).
8c10: 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 ((string=? (arg
8c20: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
8c30: 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 mode") "json")..
8c40: 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 (json-write data
8c50: 29 29 0a 20 20 20 20 20 20 20 28 28 73 74 72 69 )). ((stri
8c60: 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 ng=? (args:get-a
8c70: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 rg "-dumpmode")
8c80: 22 69 6e 69 22 29 0a 09 28 63 6f 6e 66 69 67 66 "ini")..(configf
8c90: 3a 63 6f 6e 66 69 67 2d 3e 69 6e 69 20 64 61 74 :config->ini dat
8ca0: 61 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65 a)). (else
8cb0: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 ..(debug:print-e
8cc0: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
8cd0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 64 75 6d 70 log-port* "-dump
8ce0: 6d 6f 64 65 20 6f 66 20 22 20 28 61 72 67 73 3a mode of " (args:
8cf0: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
8d00: 64 65 22 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 de") " not recog
8d10: 6e 69 73 65 64 22 29 29 29 0a 20 20 20 20 20 20 nised"))).
8d20: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
8d30: 69 6e 67 2a 20 23 74 29 0a 20 20 20 20 20 20 28 ing* #t). (
8d40: 70 6f 70 2d 64 69 72 65 63 74 6f 72 79 29 29 29 pop-directory)))
8d50: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
8d60: 61 72 67 20 22 2d 73 68 6f 77 2d 63 6d 64 69 6e arg "-show-cmdin
8d70: 66 6f 22 29 0a 20 20 20 20 28 69 66 20 28 6f 72 fo"). (if (or
8d80: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8d90: 3a 76 61 6c 75 65 22 29 28 67 65 74 65 6e 76 20 :value")(getenv
8da0: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 "MT_CMDINFO"))..
8db0: 28 6c 65 74 20 28 28 64 61 74 61 20 28 63 6f 6d (let ((data (com
8dc0: 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 mon:read-encoded
8dd0: 2d 73 74 72 69 6e 67 20 28 6f 72 20 28 61 72 67 -string (or (arg
8de0: 73 3a 67 65 74 2d 61 72 67 20 22 3a 76 61 6c 75 s:get-arg ":valu
8df0: 65 22 29 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 e")(getenv "MT_C
8e00: 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 MDINFO")))))..
8e10: 28 69 66 20 28 65 71 75 61 6c 3f 20 28 61 72 67 (if (equal? (arg
8e20: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
8e30: 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 mode") "json")..
8e40: 20 20 20 20 20 20 28 6a 73 6f 6e 2d 77 72 69 74 (json-writ
8e50: 65 20 64 61 74 61 29 0a 09 20 20 20 20 20 20 28 e data).. (
8e60: 70 70 20 64 61 74 61 29 29 0a 09 20 20 28 73 65 pp data)).. (se
8e70: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
8e80: 2a 20 23 74 29 29 0a 09 28 64 65 62 75 67 3a 70 * #t))..(debug:p
8e90: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
8ea0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
8eb0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 environment vari
8ec0: 61 62 6c 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 able MT_CMDINFO
8ed0: 69 73 20 6e 6f 74 20 73 65 74 22 29 29 29 0a 0a is not set")))..
8ee0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
8ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f20: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 65 6d 6f ========.;; Remo
8f30: 76 65 20 6f 6c 64 20 72 75 6e 28 73 29 0a 3b 3b ve old run(s).;;
8f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f80: 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 69 6e 63 65 ======..;; since
8f90: 20 73 65 76 65 72 61 6c 20 61 63 74 69 6f 6e 73 several actions
8fa0: 20 63 61 6e 20 62 65 20 73 70 65 63 69 66 69 65 can be specifie
8fb0: 64 20 6f 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 d on the command
8fc0: 20 6c 69 6e 65 20 74 68 65 20 72 65 6d 6f 76 61 line the remova
8fd0: 6c 0a 3b 3b 20 69 73 20 64 6f 6e 65 20 66 69 72 l.;; is done fir
8fe0: 73 74 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 72 st.(define (oper
8ff0: 61 74 65 2d 6f 6e 20 61 63 74 69 6f 6e 29 0a 20 ate-on action).
9000: 20 28 6c 65 74 2a 20 28 28 72 75 6e 72 65 63 20 (let* ((runrec
9010: 28 72 75 6e 73 3a 72 75 6e 72 65 63 2d 6d 61 6b (runs:runrec-mak
9020: 65 2d 72 65 63 6f 72 64 29 29 0a 09 20 28 74 61 e-record)).. (ta
9030: 72 67 65 74 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 rget (common:arg
9040: 73 2d 67 65 74 2d 74 61 72 67 65 74 29 29 29 0a s-get-target))).
9050: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 (cond. (
9060: 28 6e 6f 74 20 74 61 72 67 65 74 29 0a 20 20 20 (not target).
9070: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
9080: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
9090: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 -log-port* "Miss
90a0: 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 ing required par
90b0: 61 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 ameter for " act
90c0: 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 ion ", you must
90d0: 73 70 65 63 69 66 79 20 2d 74 61 72 67 65 74 20 specify -target
90e0: 6f 72 20 2d 72 65 71 74 61 72 67 22 29 0a 20 20 or -reqtarg").
90f0: 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 20 20 (exit 1)).
9100: 20 20 20 28 28 6e 6f 74 20 28 6f 72 20 28 61 72 ((not (or (ar
9110: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
9120: 6e 61 6d 65 22 29 0a 09 20 20 20 20 20 20 20 28 name").. (
9130: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
9140: 75 6e 6e 61 6d 65 22 29 29 29 0a 20 20 20 20 20 unname"))).
9150: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
9160: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
9170: 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 69 6e og-port* "Missin
9180: 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d g required param
9190: 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f eter for " actio
91a0: 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 n ", you must sp
91b0: 65 63 69 66 79 20 74 68 65 20 72 75 6e 20 6e 61 ecify the run na
91c0: 6d 65 20 70 61 74 74 65 72 6e 20 77 69 74 68 20 me pattern with
91d0: 2d 72 75 6e 6e 61 6d 65 20 70 61 74 74 22 29 0a -runname patt").
91e0: 20 20 20 20 20 20 28 65 78 69 74 20 32 29 29 0a (exit 2)).
91f0: 20 20 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 ((not (args
9200: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 :get-arg "-testp
9210: 61 74 74 22 29 29 0a 20 20 20 20 20 20 28 64 65 att")). (de
9220: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
9230: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
9240: 6f 72 74 2a 20 22 4d 69 73 73 69 6e 67 20 72 65 ort* "Missing re
9250: 71 75 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 quired parameter
9260: 20 66 6f 72 20 22 20 61 63 74 69 6f 6e 20 22 2c for " action ",
9270: 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 you must specif
9280: 79 20 74 68 65 20 74 65 73 74 20 70 61 74 74 65 y the test patte
9290: 72 6e 20 77 69 74 68 20 2d 74 65 73 74 70 61 74 rn with -testpat
92a0: 74 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 t"). (exit
92b0: 33 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 3)). (else.
92c0: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 63 (if (not (c
92d0: 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 ar *configinfo*)
92e0: 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 ).. (begin..
92f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
9300: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
9310: 6f 67 2d 70 6f 72 74 2a 20 22 41 74 74 65 6d 70 og-port* "Attemp
9320: 74 65 64 20 22 20 61 63 74 69 6f 6e 20 22 6f 6e ted " action "on
9330: 20 74 65 73 74 28 73 29 20 62 75 74 20 72 75 6e test(s) but run
9340: 20 61 72 65 61 20 63 6f 6e 66 69 67 20 66 69 6c area config fil
9350: 65 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 09 20 e not found")..
9360: 20 20 20 28 65 78 69 74 20 31 29 29 0a 09 20 20 (exit 1))..
9370: 3b 3b 20 70 75 74 20 74 65 73 74 20 70 61 72 61 ;; put test para
9380: 6d 65 74 65 72 73 20 69 6e 74 6f 20 63 6f 6e 76 meters into conv
9390: 65 6e 69 65 6e 74 20 76 61 72 69 61 62 6c 65 73 enient variables
93a0: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
93b0: 3b 3b 20 63 68 65 63 6b 20 66 6f 72 20 63 6f 72 ;; check for cor
93c0: 72 65 63 74 20 76 65 72 73 69 6f 6e 2c 20 65 78 rect version, ex
93d0: 69 74 20 77 69 74 68 20 6d 65 73 73 61 67 65 20 it with message
93e0: 69 66 20 6e 6f 74 20 63 6f 72 72 65 63 74 0a 09 if not correct..
93f0: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 65 78 69 74 (common:exit
9400: 2d 6f 6e 2d 76 65 72 73 69 6f 6e 2d 63 68 61 6e -on-version-chan
9410: 67 65 64 29 0a 09 20 20 20 20 28 72 75 6e 73 3a ged).. (runs:
9420: 6f 70 65 72 61 74 65 2d 6f 6e 20 20 61 63 74 69 operate-on acti
9430: 6f 6e 0a 09 09 09 20 20 20 20 20 20 74 61 72 67 on.... targ
9440: 65 74 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d et.... (com
9450: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e mon:args-get-run
9460: 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 name) ;; (or (a
9470: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
9480: 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 nname")(args:get
9490: 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 -arg ":runname")
94a0: 29 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d ).... (comm
94b0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
94c0: 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 patt #f) ;; (arg
94d0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
94e0: 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 20 patt")....
94f0: 73 74 61 74 65 3a 20 28 63 6f 6d 6d 6f 6e 3a 61 state: (common:a
9500: 72 67 73 2d 67 65 74 2d 73 74 61 74 65 29 0a 09 rgs-get-state)..
9510: 09 09 20 20 20 20 20 20 73 74 61 74 75 73 3a 20 .. status:
9520: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
9530: 2d 73 74 61 74 75 73 29 0a 09 09 09 20 20 20 20 -status)....
9540: 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 new-state-stat
9550: 75 73 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 us: (args:get-ar
9560: 67 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 g "-set-state-st
9570: 61 74 75 73 22 29 29 29 29 0a 20 20 20 20 20 20 atus")))).
9580: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
9590: 69 6e 67 2a 20 23 74 29 29 29 29 29 0a 0a 28 69 ing* #t)))))..(i
95a0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
95b0: 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a "-remove-runs").
95c0: 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e (general-run
95d0: 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 65 -call . "-re
95e0: 6d 6f 76 65 2d 72 75 6e 73 22 0a 20 20 20 20 20 move-runs".
95f0: 22 72 65 6d 6f 76 65 20 72 75 6e 73 22 0a 20 20 "remove runs".
9600: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
9610: 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
9620: 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 keyvals).
9630: 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 72 65 6d (operate-on 'rem
9640: 6f 76 65 2d 72 75 6e 73 29 29 29 29 0a 0a 28 69 ove-runs))))..(i
9650: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
9660: 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 "-set-state-stat
9670: 75 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 us"). (genera
9680: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 l-run-call .
9690: 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 "-set-state-sta
96a0: 74 75 73 22 0a 20 20 20 20 20 22 73 65 74 20 73 tus". "set s
96b0: 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 73 22 tate and status"
96c0: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 . (lambda (t
96d0: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
96e0: 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 ys keyvals).
96f0: 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 (operate-on '
9700: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
9710: 29 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 ))))..(if (or (a
9720: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
9730: 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 29 0a 09 t-run-status")..
9740: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
9750: 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 29 get-run-status")
9760: 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 ). (general-r
9770: 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 20 22 2d 73 un-call. "-s
9780: 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 0a 20 et-run-status".
9790: 20 20 20 20 22 73 65 74 20 72 75 6e 20 73 74 61 "set run sta
97a0: 74 75 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 tus". (lambd
97b0: 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
97c0: 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a e keys keyvals).
97d0: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 (let* ((r
97e0: 75 6e 73 64 61 74 20 20 28 72 6d 74 3a 67 65 74 unsdat (rmt:get
97f0: 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 6b 65 -runs-by-patt ke
9800: 79 73 20 72 75 6e 6e 61 6d 65 20 0a 09 09 09 09 ys runname .....
9810: 09 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 .(common:args-ge
9820: 74 2d 74 61 72 67 65 74 29 0a 09 09 09 09 09 23 t-target)......#
9830: 66 20 23 66 20 23 66 20 23 66 29 29 0a 09 20 20 f #f #f #f))..
9840: 20 20 20 20 28 68 65 61 64 65 72 20 20 20 28 76 (header (v
9850: 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 ector-ref runsda
9860: 74 20 30 29 29 0a 09 20 20 20 20 20 20 28 72 6f t 0)).. (ro
9870: 77 73 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 ws (vector-r
9880: 65 66 20 72 75 6e 73 64 61 74 20 31 29 29 29 0a ef runsdat 1))).
9890: 09 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 6f 77 . (if (null? row
98a0: 73 29 0a 09 20 20 20 20 20 28 62 65 67 69 6e 0a s).. (begin.
98b0: 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
98c0: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
98d0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
98e0: 4e 6f 20 6d 61 74 63 68 69 6e 67 20 72 75 6e 20 No matching run
98f0: 66 6f 75 6e 64 2e 22 29 0a 09 20 20 20 20 20 20 found.")..
9900: 20 28 65 78 69 74 20 31 29 29 0a 09 20 20 20 20 (exit 1))..
9910: 20 28 6c 65 74 2a 20 28 28 72 6f 77 20 20 20 20 (let* ((row
9920: 20 20 28 63 61 72 20 28 76 65 63 74 6f 72 2d 72 (car (vector-r
9930: 65 66 20 72 75 6e 73 64 61 74 20 31 29 29 29 0a ef runsdat 1))).
9940: 09 09 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 .. (run-id
9950: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
9960: 2d 68 65 61 64 65 72 20 72 6f 77 20 68 65 61 64 -header row head
9970: 65 72 20 22 69 64 22 29 29 29 0a 09 20 20 20 20 er "id")))..
9980: 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 (if (args:get
9990: 2d 61 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 -arg "-set-run-s
99a0: 74 61 74 75 73 22 29 0a 09 09 20 20 20 28 72 6d tatus")... (rm
99b0: 74 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 t:set-run-status
99c0: 20 72 75 6e 2d 69 64 20 28 61 72 67 73 3a 67 65 run-id (args:ge
99d0: 74 2d 61 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d t-arg "-set-run-
99e0: 73 74 61 74 75 73 22 29 20 6d 73 67 3a 20 28 61 status") msg: (a
99f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
9a00: 29 29 0a 09 09 20 20 20 28 70 72 69 6e 74 20 28 ))... (print (
9a10: 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 rmt:get-run-stat
9a20: 75 73 20 72 75 6e 2d 69 64 29 29 0a 09 09 20 20 us run-id))...
9a30: 20 29 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d )))))))..;;====
9a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a80: 3d 3d 0a 3b 3b 20 51 75 65 72 79 20 72 75 6e 73 ==.;; Query runs
9a90: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
9aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 2d 66 =========..;; -f
9ae0: 69 65 6c 64 73 20 72 75 6e 73 3a 69 64 2c 74 61 ields runs:id,ta
9af0: 72 67 65 74 2c 72 75 6e 6e 61 6d 65 2c 63 6f 6d rget,runname,com
9b00: 6d 65 6e 74 2b 74 65 73 74 73 3a 69 64 2c 74 65 ment+tests:id,te
9b10: 73 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 stname,item_path
9b20: 2b 73 74 65 70 73 0a 3b 3b 0a 3b 3b 20 63 73 69 +steps.;;.;; csi
9b30: 3e 20 28 65 78 74 72 61 63 74 2d 66 69 65 6c 64 > (extract-field
9b40: 73 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 22 72 s-constraints "r
9b50: 75 6e 73 3a 69 64 2c 74 61 72 67 65 74 2c 72 75 uns:id,target,ru
9b60: 6e 6e 61 6d 65 2c 63 6f 6d 6d 65 6e 74 2b 74 65 nname,comment+te
9b70: 73 74 73 3a 69 64 2c 74 65 73 74 6e 61 6d 65 2c sts:id,testname,
9b80: 69 74 65 6d 5f 70 61 74 68 2b 73 74 65 70 73 22 item_path+steps"
9b90: 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 3d 3e 20 ).;; =>
9ba0: 28 28 22 72 75 6e 73 22 20 22 69 64 22 20 22 74 (("runs" "id" "t
9bb0: 61 72 67 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 arget" "runname"
9bc0: 20 22 63 6f 6d 6d 65 6e 74 22 29 20 28 22 74 65 "comment") ("te
9bd0: 73 74 73 22 20 22 69 64 22 20 22 74 65 73 74 6e sts" "id" "testn
9be0: 61 6d 65 22 20 22 69 74 65 6d 5f 70 61 74 68 22 ame" "item_path"
9bf0: 29 20 28 22 73 74 65 70 73 22 29 29 0a 3b 3b 0a ) ("steps")).;;.
9c00: 3b 3b 20 20 20 4e 4f 54 45 3a 20 72 65 6d 65 6d ;; NOTE: remem
9c10: 62 65 72 20 74 68 61 74 20 74 68 65 20 63 64 72 ber that the cdr
9c20: 20 77 69 6c 6c 20 62 65 20 74 68 65 20 6c 69 73 will be the lis
9c30: 74 20 79 6f 75 20 65 78 70 65 63 74 20 28 63 64 t you expect (cd
9c40: 72 20 28 22 72 75 6e 73 22 20 22 69 64 22 20 22 r ("runs" "id" "
9c50: 74 61 72 67 65 74 22 20 22 72 75 6e 6e 61 6d 65 target" "runname
9c60: 22 20 22 63 6f 6d 6d 65 6e 74 22 29 29 20 3d 3e " "comment")) =>
9c70: 20 28 22 69 64 22 20 22 74 61 72 67 65 74 22 20 ("id" "target"
9c80: 22 72 75 6e 6e 61 6d 65 22 20 22 63 6f 6d 6d 65 "runname" "comme
9c90: 6e 74 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 nt").;;
9ca0: 61 6e 64 20 73 6f 20 61 6c 69 73 74 2d 72 65 66 and so alist-ref
9cb0: 20 77 69 6c 6c 20 79 69 65 6c 64 20 77 68 61 74 will yield what
9cc0: 20 79 6f 75 20 65 78 70 65 63 74 0a 3b 3b 0a 28 you expect.;;.(
9cd0: 64 65 66 69 6e 65 20 28 65 78 74 72 61 63 74 2d define (extract-
9ce0: 66 69 65 6c 64 73 2d 63 6f 6e 73 74 72 61 69 6e fields-constrain
9cf0: 74 73 20 66 69 65 6c 64 73 2d 73 70 65 63 29 0a ts fields-spec).
9d00: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
9d10: 74 61 62 6c 65 2d 73 70 65 63 29 20 3b 3b 20 72 table-spec) ;; r
9d20: 75 6e 73 3a 69 64 2c 74 61 72 67 65 74 2c 72 75 uns:id,target,ru
9d30: 6e 6e 61 6d 65 0a 09 20 28 6c 65 74 20 28 28 64 nname.. (let ((d
9d40: 61 74 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 at (string-split
9d50: 20 74 61 62 6c 65 2d 73 70 65 63 20 22 3a 22 29 table-spec ":")
9d60: 29 29 20 3b 3b 20 28 22 72 75 6e 73 22 20 22 69 )) ;; ("runs" "i
9d70: 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 d,target,runname
9d80: 22 29 0a 09 20 20 20 28 69 66 20 28 3e 20 28 6c ").. (if (> (l
9d90: 65 6e 67 74 68 20 64 61 74 29 20 31 29 0a 09 20 ength dat) 1)..
9da0: 20 20 20 20 20 20 28 63 6f 6e 73 20 28 63 61 72 (cons (car
9db0: 20 64 61 74 29 28 73 74 72 69 6e 67 2d 73 70 6c dat)(string-spl
9dc0: 69 74 20 28 63 61 64 72 20 64 61 74 29 20 22 2c it (cadr dat) ",
9dd0: 22 29 29 20 3b 3b 20 22 69 64 2c 74 61 72 67 65 ")) ;; "id,targe
9de0: 74 2c 72 75 6e 6e 61 6d 65 22 0a 09 20 20 20 20 t,runname"..
9df0: 20 20 20 64 61 74 29 29 29 0a 20 20 20 20 20 20 dat))).
9e00: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 66 (string-split f
9e10: 69 65 6c 64 73 2d 73 70 65 63 20 22 2b 22 29 29 ields-spec "+"))
9e20: 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d )..(define (get-
9e30: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
9e40: 6d 65 20 64 61 74 61 76 65 63 20 74 65 73 74 2d me datavec test-
9e50: 66 69 65 6c 64 2d 69 6e 64 65 78 20 66 69 65 6c field-index fiel
9e60: 64 6e 61 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 dname). (let ((
9e70: 69 6e 64 78 20 28 68 61 73 68 2d 74 61 62 6c 65 indx (hash-table
9e80: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 -ref/default tes
9e90: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 66 69 t-field-index fi
9ea0: 65 6c 64 6e 61 6d 65 20 23 66 29 29 29 0a 20 20 eldname #f))).
9eb0: 20 20 28 69 66 20 69 6e 64 78 0a 09 28 69 66 20 (if indx..(if
9ec0: 28 3e 3d 20 69 6e 64 78 20 28 76 65 63 74 6f 72 (>= indx (vector
9ed0: 2d 6c 65 6e 67 74 68 20 64 61 74 61 76 65 63 29 -length datavec)
9ee0: 29 0a 09 20 20 20 20 23 66 20 3b 3b 20 69 6e 64 ).. #f ;; ind
9ef0: 65 78 20 74 6f 6f 20 68 69 67 68 2c 20 73 68 6f ex too high, sho
9f00: 75 6c 64 20 72 61 69 73 65 20 61 6e 20 65 72 72 uld raise an err
9f10: 6f 72 20 49 20 73 75 70 70 6f 73 65 0a 09 20 20 or I suppose..
9f20: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 64 61 (vector-ref da
9f30: 74 61 76 65 63 20 69 6e 64 78 29 29 0a 09 23 66 tavec indx))..#f
9f40: 29 29 29 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 6c 69 )))..;; NOTE: li
9f50: 73 74 2d 72 75 6e 73 20 61 6e 64 20 6c 69 73 74 st-runs and list
9f60: 2d 64 62 2d 74 61 72 67 65 74 73 20 6f 70 65 72 -db-targets oper
9f70: 61 74 65 20 6f 6e 20 6c 6f 63 61 6c 20 64 62 21 ate on local db!
9f80: 21 21 0a 3b 3b 0a 3b 3b 20 49 44 45 41 3a 20 6d !!.;;.;; IDEA: m
9f90: 65 67 61 74 65 73 74 20 6c 69 73 74 20 2d 72 75 egatest list -ru
9fa0: 6e 6e 61 6d 65 20 62 6c 61 68 25 20 2e 2e 2e 0a nname blah% ....
9fb0: 3b 3b 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 ;;.(if (or (args
9fc0: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d :get-arg "-list-
9fd0: 72 75 6e 73 22 29 0a 09 28 61 72 67 73 3a 67 65 runs")..(args:ge
9fe0: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d t-arg "-list-db-
9ff0: 74 61 72 67 65 74 73 22 29 29 0a 20 20 20 20 28 targets")). (
a000: 69 66 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 if (launch:setup
a010: 29 0a 09 28 6c 65 74 2a 20 28 3b 3b 20 28 64 62 )..(let* (;; (db
a020: 73 74 72 75 63 74 20 20 20 20 28 6d 61 6b 65 2d struct (make-
a030: 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 dbr:dbstruct pat
a040: 68 3a 20 2a 74 6f 70 70 61 74 68 2a 20 6c 6f 63 h: *toppath* loc
a050: 61 6c 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 al: (args:get-ar
a060: 67 20 22 2d 6c 6f 63 61 6c 22 29 29 29 0a 09 20 g "-local")))..
a070: 20 20 20 20 20 20 28 72 75 6e 70 61 74 74 20 20 (runpatt
a080: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
a090: 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 29 0a "-list-runs")).
a0a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
a0b0: 61 63 63 65 73 73 2d 6d 6f 64 65 20 28 64 62 3a access-mode (db:
a0c0: 67 65 74 2d 61 63 63 65 73 73 2d 6d 6f 64 65 29 get-access-mode)
a0d0: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 ).. (testp
a0e0: 61 74 74 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 att (common:a
a0f0: 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 rgs-get-testpatt
a100: 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 3b 3b #f)).. ;;
a110: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
a120: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 20 rg "-testpatt")
a130: 0a 09 20 20 20 20 20 20 20 3b 3b 20 20 09 20 20 .. ;; .
a140: 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
a150: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
a160: 20 0a 09 20 20 20 20 20 20 20 3b 3b 20 20 09 20 .. ;; .
a170: 20 20 20 20 20 20 20 22 25 22 29 29 0a 09 20 20 "%"))..
a180: 20 20 20 20 20 28 6b 65 79 73 20 20 20 20 20 20 (keys
a190: 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 (rmt:get-keys)
a1a0: 29 20 3b 3b 20 28 64 62 3a 67 65 74 2d 6b 65 79 ) ;; (db:get-key
a1b0: 73 20 64 62 73 74 72 75 63 74 29 29 0a 09 20 20 s dbstruct))..
a1c0: 20 20 20 20 20 3b 3b 20 28 72 75 6e 73 64 61 74 ;; (runsdat
a1d0: 20 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 20 64 (db:get-runs d
a1e0: 62 73 74 72 75 63 74 20 72 75 6e 70 61 74 74 20 bstruct runpatt
a1f0: 23 66 20 23 66 20 27 28 29 29 29 0a 09 3b 3b 20 #f #f '()))..;;
a200: 28 72 75 6e 73 64 61 74 20 20 20 20 20 28 72 6d (runsdat (rm
a210: 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 t:get-runs-by-pa
a220: 74 74 20 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 tt keys (or runp
a230: 61 74 74 20 22 25 22 29 20 28 63 6f 6d 6d 6f 6e att "%") (common
a240: 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 :args-get-target
a250: 29 20 3b 3b 20 28 64 62 3a 67 65 74 2d 72 75 6e ) ;; (db:get-run
a260: 73 2d 62 79 2d 70 61 74 74 20 64 62 73 74 72 75 s-by-patt dbstru
a270: 63 74 20 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 ct keys (or runp
a280: 61 74 74 20 22 25 22 29 20 28 63 6f 6d 6d 6f 6e att "%") (common
a290: 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 :args-get-target
a2a0: 29 0a 09 3b 3b 20 09 09 20 20 20 20 20 20 20 20 )..;; ..
a2b0: 20 20 20 09 20 23 66 20 23 66 20 27 28 22 69 64 . #f #f '("id
a2c0: 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 " "runname" "sta
a2d0: 74 65 22 20 22 73 74 61 74 75 73 22 20 22 6f 77 te" "status" "ow
a2e0: 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 ner" "event_time
a2f0: 22 20 22 63 6f 6d 6d 65 6e 74 22 29 20 30 29 29 " "comment") 0))
a300: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 64 61 .. (runsda
a310: 74 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 72 t (rmt:get-r
a320: 75 6e 73 2d 62 79 2d 70 61 74 74 20 6b 65 79 73 uns-by-patt keys
a330: 20 28 6f 72 20 72 75 6e 70 61 74 74 20 22 25 22 (or runpatt "%"
a340: 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ) .
a350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a370: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 (common:arg
a380: 73 2d 67 65 74 2d 74 61 72 67 65 74 29 20 23 66 s-get-target) #f
a390: 20 23 66 20 27 28 22 69 64 22 20 22 72 75 6e 6e #f '("id" "runn
a3a0: 61 6d 65 22 20 22 73 74 61 74 65 22 20 22 73 74 ame" "state" "st
a3b0: 61 74 75 73 22 20 22 6f 77 6e 65 72 22 20 22 65 atus" "owner" "e
a3c0: 76 65 6e 74 5f 74 69 6d 65 22 20 22 63 6f 6d 6d vent_time" "comm
a3d0: 65 6e 74 22 29 20 30 29 29 0a 09 20 20 20 20 20 ent") 0))..
a3e0: 20 20 28 72 75 6e 73 74 6d 70 20 20 20 20 20 28 (runstmp (
a3f0: 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e 73 db:get-rows runs
a400: 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 28 68 dat)).. (h
a410: 65 61 64 65 72 20 20 20 20 20 20 28 64 62 3a 67 eader (db:g
a420: 65 74 2d 68 65 61 64 65 72 20 72 75 6e 73 64 61 et-header runsda
a430: 74 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 74 t)).. ;; t
a440: 68 69 73 20 69 73 20 22 2d 73 69 6e 63 65 22 20 his is "-since"
a450: 73 75 70 70 6f 72 74 2e 20 54 68 69 73 20 6c 6f support. This lo
a460: 6f 6b 73 20 61 74 20 6c 61 73 74 20 6d 6f 64 20 oks at last mod
a470: 74 69 6d 65 73 20 6f 66 20 3c 72 75 6e 2d 69 64 times of <run-id
a480: 3e 2e 64 62 20 66 69 6c 65 73 0a 09 20 20 20 20 >.db files..
a490: 20 20 20 3b 3b 20 61 6e 64 20 63 6f 6c 6c 65 63 ;; and collec
a4a0: 74 73 20 74 68 6f 73 65 20 6d 6f 64 69 66 69 65 ts those modifie
a4b0: 64 20 73 69 6e 63 65 20 74 68 65 20 2d 73 69 6e d since the -sin
a4c0: 63 65 20 74 69 6d 65 2e 0a 09 20 20 20 20 20 20 ce time...
a4d0: 20 28 72 75 6e 73 20 20 20 20 20 20 20 20 72 75 (runs ru
a4e0: 6e 73 74 6d 70 29 0a 20 20 20 20 20 20 20 20 20 nstmp).
a4f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
a500: 3b 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 ; (if (and (not
a510: 28 6e 75 6c 6c 3f 20 72 75 6e 73 74 6d 70 29 29 (null? runstmp))
a520: 0a 09 09 09 3b 3b 20 20 20 20 20 20 20 20 28 61 ....;; (a
a530: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 rgs:get-arg "-si
a540: 6e 63 65 22 29 29 0a 09 09 09 3b 3b 20 20 20 28 nce"))....;; (
a550: 6c 65 74 20 28 28 63 68 61 6e 67 65 64 2d 69 64 let ((changed-id
a560: 73 20 28 64 62 3a 67 65 74 2d 63 68 61 6e 67 65 s (db:get-change
a570: 64 2d 72 75 6e 2d 69 64 73 20 28 73 74 72 69 6e d-run-ids (strin
a580: 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a g->number (args:
a590: 67 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 22 get-arg "-since"
a5a0: 29 29 29 29 29 0a 09 09 09 3b 3b 20 20 20 20 20 )))))....;;
a5b0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 (let loop ((hed
a5c0: 28 63 61 72 20 72 75 6e 73 74 6d 70 29 29 0a 09 (car runstmp))..
a5d0: 09 09 3b 3b 20 20 20 09 20 20 20 20 20 28 74 61 ..;; . (ta
a5e0: 6c 20 28 63 64 72 20 72 75 6e 73 74 6d 70 29 29 l (cdr runstmp))
a5f0: 0a 09 09 09 3b 3b 20 20 20 09 20 20 20 20 20 28 ....;; . (
a600: 72 65 73 20 27 28 29 29 29 0a 09 09 09 3b 3b 20 res '()))....;;
a610: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 (let ((new
a620: 2d 72 65 73 20 28 69 66 20 28 6d 65 6d 62 65 72 -res (if (member
a630: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
a640: 79 2d 68 65 61 64 65 72 20 68 65 64 20 68 65 61 y-header hed hea
a650: 64 65 72 20 22 69 64 22 29 20 63 68 61 6e 67 65 der "id") change
a660: 64 2d 69 64 73 29 0a 09 09 09 3b 3b 20 20 20 09 d-ids)....;; .
a670: 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 68 65 . (cons he
a680: 64 20 72 65 73 29 0a 09 09 09 3b 3b 20 20 20 09 d res)....;; .
a690: 09 20 20 20 20 20 20 20 72 65 73 29 29 29 0a 09 . res)))..
a6a0: 09 09 3b 3b 20 20 20 20 20 20 20 20 20 28 69 66 ..;; (if
a6b0: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 09 (null? tal)....
a6c0: 3b 3b 20 20 20 09 20 20 28 72 65 76 65 72 73 65 ;; . (reverse
a6d0: 20 6e 65 77 2d 72 65 73 29 0a 09 09 09 3b 3b 20 new-res)....;;
a6e0: 20 20 09 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 . (loop (car
a6f0: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 tal)(cdr tal) ne
a700: 77 2d 72 65 73 29 29 29 29 29 0a 09 09 09 3b 3b w-res)))))....;;
a710: 20 20 20 72 75 6e 73 74 6d 70 29 29 0a 09 20 20 runstmp))..
a720: 20 20 20 20 20 28 64 62 2d 74 61 72 67 65 74 73 (db-targets
a730: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
a740: 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 "-list-db-target
a750: 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 65 s")).. (se
a760: 65 6e 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d en (make-
a770: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 hash-table))..
a780: 20 20 20 20 20 28 64 6d 6f 64 65 20 20 20 20 20 (dmode
a790: 20 20 28 6c 65 74 20 28 28 64 20 28 61 72 67 73 (let ((d (args
a7a0: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
a7b0: 6f 64 65 22 29 29 29 0a 09 09 09 20 20 20 20 20 ode")))....
a7c0: 20 28 69 66 20 64 20 28 73 74 72 69 6e 67 2d 3e (if d (string->
a7d0: 73 79 6d 62 6f 6c 20 64 29 20 23 66 29 29 29 0a symbol d) #f))).
a7e0: 09 20 20 20 20 20 20 20 28 64 61 74 61 20 20 20 . (data
a7f0: 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d (make-hash-
a800: 74 61 62 6c 65 29 29 0a 09 20 20 20 20 20 20 20 table))..
a810: 28 66 69 65 6c 64 73 2d 73 70 65 63 20 28 69 66 (fields-spec (if
a820: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
a830: 2d 66 69 65 6c 64 73 22 29 0a 09 09 09 09 28 65 -fields").....(e
a840: 78 74 72 61 63 74 2d 66 69 65 6c 64 73 2d 63 6f xtract-fields-co
a850: 6e 73 74 72 61 69 6e 74 73 20 28 61 72 67 73 3a nstraints (args:
a860: 67 65 74 2d 61 72 67 20 22 2d 66 69 65 6c 64 73 get-arg "-fields
a870: 22 29 29 0a 09 09 09 09 28 6c 69 73 74 20 28 63 ")).....(list (c
a880: 6f 6e 73 20 22 72 75 6e 73 22 20 28 61 70 70 65 ons "runs" (appe
a890: 6e 64 20 6b 65 79 73 20 28 6c 69 73 74 20 22 69 nd keys (list "i
a8a0: 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 d" "runname" "st
a8b0: 61 74 65 22 20 22 73 74 61 74 75 73 22 20 22 6f ate" "status" "o
a8c0: 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 69 6d wner" "event_tim
a8d0: 65 22 20 22 63 6f 6d 6d 65 6e 74 22 20 22 66 61 e" "comment" "fa
a8e0: 69 6c 5f 63 6f 75 6e 74 22 20 22 70 61 73 73 5f il_count" "pass_
a8f0: 63 6f 75 6e 74 22 29 29 29 0a 09 09 09 09 20 20 count"))).....
a900: 20 20 20 20 28 63 6f 6e 73 20 22 74 65 73 74 73 (cons "tests
a910: 22 20 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 " db:test-recor
a920: 64 2d 66 69 65 6c 64 73 29 20 3b 3b 20 22 69 64 d-fields) ;; "id
a930: 22 20 22 74 65 73 74 6e 61 6d 65 22 20 22 74 65 " "testname" "te
a940: 73 74 5f 70 61 74 68 22 29 0a 09 09 09 09 20 20 st_path").....
a950: 20 20 20 20 28 6c 69 73 74 20 22 73 74 65 70 73 (list "steps
a960: 22 20 22 69 64 22 20 22 73 74 65 70 6e 61 6d 65 " "id" "stepname
a970: 22 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 72 ")))).. (r
a980: 75 6e 73 2d 73 70 65 63 20 20 20 28 6c 65 74 20 uns-spec (let
a990: 28 28 72 20 28 61 6c 69 73 74 2d 72 65 66 20 22 ((r (alist-ref "
a9a0: 72 75 6e 73 22 20 20 66 69 65 6c 64 73 2d 73 70 runs" fields-sp
a9b0: 65 63 20 65 71 75 61 6c 3f 29 29 29 20 3b 3b 20 ec equal?))) ;;
a9c0: 74 68 65 20 63 68 65 63 6b 20 69 73 20 6e 6f 77 the check is now
a9d0: 20 75 6e 6e 65 63 65 73 73 61 72 79 0a 09 09 09 unnecessary....
a9e0: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 72 (if (and r
a9f0: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 29 29 (not (null? r))
aa00: 29 20 72 20 28 6c 69 73 74 20 22 69 64 22 20 29 ) r (list "id" )
aa10: 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 ))).. (tes
aa20: 74 73 2d 73 70 65 63 20 20 28 6c 65 74 20 28 28 ts-spec (let ((
aa30: 74 20 28 61 6c 69 73 74 2d 72 65 66 20 22 74 65 t (alist-ref "te
aa40: 73 74 73 22 20 66 69 65 6c 64 73 2d 73 70 65 63 sts" fields-spec
aa50: 20 65 71 75 61 6c 3f 29 29 29 0a 09 09 09 20 20 equal?)))....
aa60: 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 20 28 (if (and t (
aa70: 6e 75 6c 6c 3f 20 74 29 29 20 3b 3b 20 61 6c 6c null? t)) ;; all
aa80: 20 66 69 65 6c 64 73 0a 09 09 09 09 20 20 64 62 fields..... db
aa90: 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 :test-record-fie
aaa0: 6c 64 73 0a 09 09 09 09 20 20 74 29 29 29 0a 09 lds..... t)))..
aab0: 20 20 20 20 20 20 20 28 61 64 6a 2d 74 65 73 74 (adj-test
aac0: 73 2d 73 70 65 63 20 28 64 65 6c 65 74 65 2d 64 s-spec (delete-d
aad0: 75 70 6c 69 63 61 74 65 73 20 28 69 66 20 74 65 uplicates (if te
aae0: 73 74 73 2d 73 70 65 63 20 28 63 6f 6e 73 20 22 sts-spec (cons "
aaf0: 69 64 22 20 74 65 73 74 73 2d 73 70 65 63 29 20 id" tests-spec)
ab00: 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 db:test-record-f
ab10: 69 65 6c 64 73 29 29 29 20 3b 3b 20 27 28 22 69 ields))) ;; '("i
ab20: 64 22 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 d")))).. (
ab30: 73 74 65 70 73 2d 73 70 65 63 20 20 28 61 6c 69 steps-spec (ali
ab40: 73 74 2d 72 65 66 20 22 73 74 65 70 73 22 20 66 st-ref "steps" f
ab50: 69 65 6c 64 73 2d 73 70 65 63 20 65 71 75 61 6c ields-spec equal
ab60: 3f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 ?)).. (tes
ab70: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 28 6d t-field-index (m
ab80: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
ab90: 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 74 65 ).. (if (and te
aba0: 73 74 73 2d 73 70 65 63 20 28 6e 6f 74 20 28 6e sts-spec (not (n
abb0: 75 6c 6c 3f 20 74 65 73 74 73 2d 73 70 65 63 29 ull? tests-spec)
abc0: 29 29 20 3b 3b 20 64 6f 20 73 6f 6d 65 20 76 61 )) ;; do some va
abd0: 6c 69 64 61 74 69 6f 6e 20 61 6e 64 20 70 72 6f lidation and pro
abe0: 63 65 73 73 69 6e 67 20 6f 66 20 74 68 65 20 74 cessing of the t
abf0: 65 73 74 2d 73 70 65 63 0a 09 20 20 20 20 20 20 est-spec..
ac00: 28 6c 65 74 20 28 28 69 6e 76 61 6c 69 64 2d 74 (let ((invalid-t
ac10: 65 73 74 73 2d 73 70 65 63 20 28 66 69 6c 74 65 ests-spec (filte
ac20: 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 6f r (lambda (x)(no
ac30: 74 20 28 6d 65 6d 62 65 72 20 78 20 64 62 3a 74 t (member x db:t
ac40: 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 est-record-field
ac50: 73 29 29 29 20 74 65 73 74 73 2d 73 70 65 63 29 s))) tests-spec)
ac60: 29 29 0a 09 09 28 69 66 20 28 6e 75 6c 6c 3f 20 ))...(if (null?
ac70: 69 6e 76 61 6c 69 64 2d 74 65 73 74 73 2d 73 70 invalid-tests-sp
ac80: 65 63 29 0a 09 09 20 20 20 20 3b 3b 20 67 65 6e ec)... ;; gen
ac90: 65 72 61 74 65 20 74 68 65 20 6c 6f 6f 6b 75 70 erate the lookup
aca0: 20 6d 61 70 20 74 65 73 74 2d 66 69 65 6c 64 2d map test-field-
acb0: 6e 61 6d 65 20 3d 3e 20 69 6e 64 65 78 2d 6e 75 name => index-nu
acc0: 6d 62 65 72 0a 09 09 20 20 20 20 28 6c 65 74 20 mber... (let
acd0: 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 loop ((hed (car
ace0: 61 64 6a 2d 74 65 73 74 73 2d 73 70 65 63 29 29 adj-tests-spec))
acf0: 0a 09 09 09 20 20 20 20 20 20 20 28 74 61 6c 20 .... (tal
ad00: 28 63 64 72 20 61 64 6a 2d 74 65 73 74 73 2d 73 (cdr adj-tests-s
ad10: 70 65 63 29 29 0a 09 09 09 20 20 20 20 20 20 20 pec))....
ad20: 28 69 64 78 20 30 29 29 0a 09 09 20 20 20 20 20 (idx 0))...
ad30: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
ad40: 21 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 ! test-field-ind
ad50: 65 78 20 68 65 64 20 69 64 78 29 0a 09 09 20 20 ex hed idx)...
ad60: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 (if (not (nu
ad70: 6c 6c 3f 20 74 61 6c 29 29 28 6c 6f 6f 70 20 28 ll? tal))(loop (
ad80: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal
ad90: 29 28 2b 20 69 64 78 20 31 29 29 29 29 0a 09 09 )(+ idx 1))))...
ada0: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 (begin...
adb0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
adc0: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
add0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 6e 76 61 -log-port* "Inva
ade0: 6c 69 64 20 74 65 73 74 20 66 69 65 6c 64 73 20 lid test fields
adf0: 73 70 65 63 69 66 69 65 64 3a 20 22 20 28 73 74 specified: " (st
ae00: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
ae10: 20 69 6e 76 61 6c 69 64 2d 74 65 73 74 73 2d 73 invalid-tests-s
ae20: 70 65 63 20 22 2c 20 22 29 29 0a 09 09 20 20 20 pec ", "))...
ae30: 20 20 20 28 65 78 69 74 29 29 29 29 29 0a 0a 09 (exit)))))...
ae40: 20 20 3b 3b 20 45 61 63 68 20 72 75 6e 0a 09 20 ;; Each run..
ae50: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 (for-each ..
ae60: 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 20 (lambda (run)..
ae70: 20 20 20 20 28 6c 65 74 20 28 28 74 61 72 67 65 (let ((targe
ae80: 74 73 74 72 20 28 73 74 72 69 6e 67 2d 69 6e 74 tstr (string-int
ae90: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c ersperse (map (l
aea0: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 ambda (x).......
aeb0: 09 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d . (db:get-value-
aec0: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
aed0: 61 64 65 72 20 78 29 29 0a 09 09 09 09 09 09 20 ader x)).......
aee0: 20 20 20 20 20 20 6b 65 79 73 29 20 22 2f 22 29 keys) "/")
aef0: 29 29 0a 09 20 20 20 20 20 20 20 28 69 66 20 64 )).. (if d
af00: 62 2d 74 61 72 67 65 74 73 0a 09 09 20 20 20 28 b-targets... (
af10: 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 if (not (hash-ta
af20: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
af30: 73 65 65 6e 20 74 61 72 67 65 74 73 74 72 20 23 seen targetstr #
af40: 66 29 29 0a 09 09 20 20 20 20 20 20 20 28 62 65 f))... (be
af50: 67 69 6e 0a 09 09 09 20 28 68 61 73 68 2d 74 61 gin.... (hash-ta
af60: 62 6c 65 2d 73 65 74 21 20 73 65 65 6e 20 74 61 ble-set! seen ta
af70: 72 67 65 74 73 74 72 20 23 74 29 0a 09 09 09 20 rgetstr #t)....
af80: 3b 3b 20 28 70 72 69 6e 74 20 22 5b 22 20 74 61 ;; (print "[" ta
af90: 72 67 65 74 73 74 72 20 22 5d 22 29 29 29 29 0a rgetstr "]")))).
afa0: 09 09 09 20 28 69 66 20 28 6e 6f 74 20 64 6d 6f ... (if (not dmo
afb0: 64 65 29 0a 09 09 09 20 20 20 20 20 28 70 72 69 de).... (pri
afc0: 6e 74 20 74 61 72 67 65 74 73 74 72 29 0a 09 09 nt targetstr)...
afd0: 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c . (hash-tabl
afe0: 65 2d 73 65 74 21 20 64 61 74 61 20 22 74 61 72 e-set! data "tar
aff0: 67 65 74 73 22 20 28 63 6f 6e 73 20 74 61 72 67 gets" (cons targ
b000: 65 74 73 74 72 20 28 68 61 73 68 2d 74 61 62 6c etstr (hash-tabl
b010: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 64 61 e-ref/default da
b020: 74 61 20 22 74 61 72 67 65 74 73 22 20 27 28 29 ta "targets" '()
b030: 29 29 29 0a 09 09 09 20 20 20 20 20 29 29 29 0a ))).... ))).
b040: 09 09 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e .. (let* ((run
b050: 2d 69 64 20 20 28 64 62 3a 67 65 74 2d 76 61 6c -id (db:get-val
b060: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
b070: 20 68 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 header "id"))..
b080: 09 09 20 20 28 72 75 6e 6e 61 6d 65 20 28 64 62 .. (runname (db
b090: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
b0a0: 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 ader run header
b0b0: 22 72 75 6e 6e 61 6d 65 22 29 29 20 0a 09 09 09 "runname")) ....
b0c0: 20 20 28 73 74 61 74 65 73 20 20 28 73 74 72 69 (states (stri
b0d0: 6e 67 2d 73 70 6c 69 74 20 28 6f 72 20 28 61 72 ng-split (or (ar
b0e0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 gs:get-arg "-sta
b0f0: 74 65 22 29 20 22 22 29 20 22 2c 22 29 29 0a 09 te") "") ","))..
b100: 09 09 20 20 28 73 74 61 74 75 73 65 73 20 28 73 .. (statuses (s
b110: 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 6f 72 20 tring-split (or
b120: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
b130: 73 74 61 74 75 73 22 29 20 22 22 29 20 22 2c 22 status") "") ","
b140: 29 29 0a 09 09 09 20 20 28 74 65 73 74 73 20 20 )).... (tests
b150: 20 28 69 66 20 74 65 73 74 73 2d 73 70 65 63 0a (if tests-spec.
b160: 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a 64 .... (db:d
b170: 69 73 70 61 74 63 68 2d 71 75 65 72 79 20 61 63 ispatch-query ac
b180: 63 65 73 73 2d 6d 6f 64 65 20 72 6d 74 3a 67 65 cess-mode rmt:ge
b190: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
b1a0: 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 db:get-tests-for
b1b0: 2d 72 75 6e 20 72 75 6e 2d 69 64 20 74 65 73 74 -run run-id test
b1c0: 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 patt states stat
b1d0: 75 73 65 73 20 23 66 20 23 66 20 23 66 20 27 74 uses #f #f #f 't
b1e0: 65 73 74 6e 61 6d 65 20 27 61 73 63 20 3b 3b 20 estname 'asc ;;
b1f0: 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f (db:get-tests-fo
b200: 72 2d 72 75 6e 20 64 62 73 74 72 75 63 74 20 72 r-run dbstruct r
b210: 75 6e 2d 69 64 20 74 65 73 74 70 61 74 74 20 27 un-id testpatt '
b220: 28 29 20 27 28 29 20 23 66 20 23 66 20 23 66 20 () '() #f #f #f
b230: 27 74 65 73 74 6e 61 6d 65 20 27 61 73 63 20 0a 'testname 'asc .
b240: 09 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 75 ....... ;; u
b250: 73 65 20 71 72 79 76 61 6c 73 20 69 66 20 74 65 se qryvals if te
b260: 73 74 2d 73 70 65 63 20 70 72 6f 76 69 64 65 64 st-spec provided
b270: 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 69 66 ........ (if
b280: 20 74 65 73 74 73 2d 73 70 65 63 0a 09 09 09 09 tests-spec.....
b290: 09 09 09 09 20 28 73 74 72 69 6e 67 2d 69 6e 74 .... (string-int
b2a0: 65 72 73 70 65 72 73 65 20 61 64 6a 2d 74 65 73 ersperse adj-tes
b2b0: 74 73 2d 73 70 65 63 20 22 2c 22 29 0a 09 09 09 ts-spec ",")....
b2c0: 09 09 09 09 09 20 3b 3b 20 64 62 3a 74 65 73 74 ..... ;; db:test
b2d0: 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 0a 09 -record-fields..
b2e0: 09 09 09 09 09 09 09 20 23 66 29 0a 09 09 09 09 ....... #f).....
b2f0: 09 09 09 20 20 20 20 20 23 66 0a 09 09 09 09 09 ... #f......
b300: 09 09 20 20 20 20 20 27 6e 6f 72 6d 61 6c 29 0a .. 'normal).
b310: 09 09 09 09 20 20 20 20 20 20 20 27 28 29 29 29 .... '()))
b320: 29 0a 09 09 20 20 20 20 20 28 63 61 73 65 20 64 )... (case d
b330: 6d 6f 64 65 0a 09 09 20 20 20 20 20 20 20 28 28 mode... ((
b340: 6a 73 6f 6e 20 6f 64 73 29 0a 09 09 09 28 69 66 json ods)....(if
b350: 20 72 75 6e 73 2d 73 70 65 63 0a 09 09 09 20 20 runs-spec....
b360: 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 (for-each ....
b370: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 69 (lambda (fi
b380: 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 20 20 20 eld-name)....
b390: 20 20 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 (mutils:hier
b3a0: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 hash-set! data (
b3b0: 63 6f 6e 63 20 28 64 62 3a 67 65 74 2d 76 61 6c conc (db:get-val
b3c0: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
b3d0: 20 68 65 61 64 65 72 20 66 69 65 6c 64 2d 6e 61 header field-na
b3e0: 6d 65 29 29 20 74 61 72 67 65 74 73 74 72 20 72 me)) targetstr r
b3f0: 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 66 69 unname "meta" fi
b400: 65 6c 64 2d 6e 61 6d 65 29 29 0a 09 09 09 20 20 eld-name))....
b410: 20 20 20 72 75 6e 73 2d 73 70 65 63 29 29 29 0a runs-spec))).
b420: 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 ...;; (mutils:hi
b430: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
b440: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
b450: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
b460: 64 65 72 20 22 73 74 61 74 75 73 22 29 20 20 20 der "status")
b470: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
b480: 61 6d 65 20 22 6d 65 74 61 22 20 22 73 74 61 74 ame "meta" "stat
b490: 75 73 22 20 20 20 20 20 29 0a 09 09 09 3b 3b 20 us" )....;;
b4a0: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
b4b0: 2d 73 65 74 21 20 64 61 74 61 20 28 64 62 3a 67 -set! data (db:g
b4c0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
b4d0: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 73 er run header "s
b4e0: 74 61 74 65 22 29 20 20 20 20 20 20 74 61 72 67 tate") targ
b4f0: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d etstr runname "m
b500: 65 74 61 22 20 22 73 74 61 74 65 22 20 20 20 20 eta" "state"
b510: 20 20 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c )....;; (mutil
b520: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
b530: 64 61 74 61 20 28 63 6f 6e 63 20 28 64 62 3a 67 data (conc (db:g
b540: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
b550: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 er run header "i
b560: 64 22 29 29 20 20 74 61 72 67 65 74 73 74 72 20 d")) targetstr
b570: 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 runname "meta" "
b580: 69 64 22 20 20 20 20 20 20 20 20 20 29 0a 09 09 id" )...
b590: 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 .;; (mutils:hier
b5a0: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 hash-set! data (
b5b0: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
b5c0: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
b5d0: 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 20 r "event_time")
b5e0: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
b5f0: 65 20 22 6d 65 74 61 22 20 22 65 76 65 6e 74 5f e "meta" "event_
b600: 74 69 6d 65 22 20 29 0a 09 09 09 3b 3b 20 28 6d time" )....;; (m
b610: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
b620: 65 74 21 20 64 61 74 61 20 28 64 62 3a 67 65 74 et! data (db:get
b630: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
b640: 20 72 75 6e 20 68 65 61 64 65 72 20 22 63 6f 6d run header "com
b650: 6d 65 6e 74 22 29 20 20 20 20 74 61 72 67 65 74 ment") target
b660: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 str runname "met
b670: 61 22 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 a" "comment"
b680: 29 0a 09 09 09 3b 3b 20 3b 3b 20 61 64 64 20 6c )....;; ;; add l
b690: 61 73 74 20 65 6e 74 72 79 20 74 77 69 63 65 20 ast entry twice
b6a0: 2d 20 73 65 65 6d 73 20 74 6f 20 62 65 20 61 20 - seems to be a
b6b0: 62 75 67 20 69 6e 20 68 69 65 72 68 61 73 68 3f bug in hierhash?
b6c0: 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 ....;; (mutils:h
b6d0: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
b6e0: 61 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d a (db:get-value-
b6f0: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
b700: 61 64 65 72 20 22 63 6f 6d 6d 65 6e 74 22 29 20 ader "comment")
b710: 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e targetstr run
b720: 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 63 6f 6d name "meta" "com
b730: 6d 65 6e 74 22 20 20 20 20 29 0a 09 09 20 20 20 ment" )...
b740: 20 20 20 20 28 65 6c 73 65 0a 09 09 09 28 69 66 (else....(if
b750: 20 28 6e 75 6c 6c 3f 20 72 75 6e 73 2d 73 70 65 (null? runs-spe
b760: 63 29 0a 09 09 09 20 20 20 20 28 70 72 69 6e 74 c).... (print
b770: 20 22 52 75 6e 3a 20 22 20 74 61 72 67 65 74 73 "Run: " targets
b780: 74 72 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 0a tr "/" runname .
b790: 09 09 09 09 20 20 20 22 20 73 74 61 74 75 73 3a .... " status:
b7a0: 20 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 " (db:get-value
b7b0: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
b7c0: 65 61 64 65 72 20 22 73 74 61 74 65 22 29 0a 09 eader "state")..
b7d0: 09 09 09 20 20 20 22 20 72 75 6e 2d 69 64 3a 20 ... " run-id:
b7e0: 22 20 72 75 6e 2d 69 64 20 22 2c 20 6e 75 6d 62 " run-id ", numb
b7f0: 65 72 20 74 65 73 74 73 3a 20 22 20 28 6c 65 6e er tests: " (len
b800: 67 74 68 20 74 65 73 74 73 29 0a 09 09 09 09 20 gth tests).....
b810: 20 20 22 20 65 76 65 6e 74 5f 74 69 6d 65 3a 20 " event_time:
b820: 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d " (db:get-value-
b830: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
b840: 61 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 ader "event_time
b850: 22 29 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 ")).... (begi
b860: 6e 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 n.... (if (
b870: 6e 6f 74 20 28 6d 65 6d 62 65 72 20 22 74 61 72 not (member "tar
b880: 67 65 74 22 20 72 75 6e 73 2d 73 70 65 63 29 29 get" runs-spec))
b890: 0a 09 09 09 20 20 20 20 20 20 20 20 20 20 3b 3b .... ;;
b8a0: 20 28 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 (display (conc
b8b0: 22 54 61 72 67 65 74 3a 20 22 20 74 61 72 67 65 "Target: " targe
b8c0: 74 73 74 72 29 29 0a 09 09 09 20 20 20 20 20 20 tstr))....
b8d0: 20 20 20 20 28 64 69 73 70 6c 61 79 20 28 63 6f (display (co
b8e0: 6e 63 20 22 52 75 6e 3a 20 22 20 74 61 72 67 65 nc "Run: " targe
b8f0: 74 73 74 72 20 22 2f 22 20 72 75 6e 6e 61 6d 65 tstr "/" runname
b900: 20 22 20 22 29 29 29 0a 09 09 09 20 20 20 20 20 " ")))....
b910: 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 20 20 (for-each....
b920: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 69 (lambda (fi
b930: 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 09 20 28 eld-name)..... (
b940: 69 66 20 28 65 71 75 61 6c 3f 20 66 69 65 6c 64 if (equal? field
b950: 2d 6e 61 6d 65 20 22 74 61 72 67 65 74 22 29 0a -name "target").
b960: 09 09 09 09 20 20 20 20 20 28 64 69 73 70 6c 61 .... (displa
b970: 79 20 28 63 6f 6e 63 20 22 74 61 72 67 65 74 3a y (conc "target:
b980: 20 22 20 74 61 72 67 65 74 73 74 72 20 22 20 22 " targetstr " "
b990: 29 29 0a 09 09 09 09 20 20 20 20 20 28 64 69 73 ))..... (dis
b9a0: 70 6c 61 79 20 28 63 6f 6e 63 20 66 69 65 6c 64 play (conc field
b9b0: 2d 6e 61 6d 65 20 22 3a 20 22 20 28 64 62 3a 67 -name ": " (db:g
b9c0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
b9d0: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 28 63 er run header (c
b9e0: 6f 6e 63 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 onc field-name))
b9f0: 20 22 20 22 29 29 29 29 0a 09 09 09 20 20 20 20 " "))))....
ba00: 20 20 20 72 75 6e 73 2d 73 70 65 63 29 0a 09 09 runs-spec)...
ba10: 09 20 20 20 20 20 20 28 6e 65 77 6c 69 6e 65 29 . (newline)
ba20: 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 0a 09 ))))... ..
ba30: 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 . (for-each
ba40: 0a 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 ... (lambda
ba50: 20 28 74 65 73 74 29 0a 09 09 20 20 20 20 20 20 (test)...
ba60: 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 .(handle-excepti
ba70: 6f 6e 73 0a 09 09 09 20 65 78 6e 0a 09 09 09 20 ons.... exn....
ba80: 28 62 65 67 69 6e 0a 09 09 09 20 20 20 28 64 65 (begin.... (de
ba90: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
baa0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
bab0: 6f 72 74 2a 20 22 42 61 64 20 64 61 74 61 20 69 ort* "Bad data i
bac0: 6e 20 74 65 73 74 20 72 65 63 6f 72 64 3f 20 22 n test record? "
bad0: 20 74 65 73 74 29 0a 09 09 09 20 20 20 28 70 72 test).... (pr
bae0: 69 6e 74 20 22 65 78 6e 3d 22 20 28 63 6f 6e 64 int "exn=" (cond
baf0: 69 74 69 6f 6e 2d 3e 6c 69 73 74 20 65 78 6e 29 ition->list exn)
bb00: 29 0a 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 ).... (debug:p
bb10: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
bb20: 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 73 log-port* " mess
bb30: 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 age: " ((conditi
bb40: 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 on-property-acce
bb50: 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 ssor 'exn 'messa
bb60: 67 65 29 20 65 78 6e 29 29 0a 09 09 09 20 20 20 ge) exn))....
bb70: 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 (print-call-chai
bb80: 6e 20 28 63 75 72 72 65 6e 74 2d 65 72 72 6f 72 n (current-error
bb90: 2d 70 6f 72 74 29 29 29 0a 09 09 09 20 28 6c 65 -port))).... (le
bba0: 74 2a 20 28 28 74 65 73 74 2d 69 64 20 20 20 20 t* ((test-id
bbb0: 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 69 (if (member "i
bbc0: 64 22 20 20 20 20 20 20 20 20 20 20 20 74 65 73 d" tes
bbd0: 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c ts-spec)(get-val
bbe0: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
bbf0: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
bc00: 69 6e 64 65 78 20 22 69 64 22 20 20 20 20 20 20 index "id"
bc10: 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 ) #f)) ;; (d
bc20: 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 20 20 b:test-get-id
bc30: 20 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 test))....
bc40: 09 28 74 65 73 74 6e 61 6d 65 20 20 20 20 20 28 .(testname (
bc50: 69 66 20 28 6d 65 6d 62 65 72 20 22 74 65 73 74 if (member "test
bc60: 6e 61 6d 65 22 20 20 20 20 20 74 65 73 74 73 2d name" tests-
bc70: 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d spec)(get-value-
bc80: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
bc90: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
bca0: 65 78 20 22 74 65 73 74 6e 61 6d 65 22 20 20 20 ex "testname"
bcb0: 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 ) #f)) ;; (db:t
bcc0: 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 est-get-testname
bcd0: 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 69 test)).....(i
bce0: 74 65 6d 70 61 74 68 20 20 20 20 20 28 69 66 20 tempath (if
bcf0: 28 6d 65 6d 62 65 72 20 22 69 74 65 6d 5f 70 61 (member "item_pa
bd00: 74 68 22 20 20 20 20 74 65 73 74 73 2d 73 70 65 th" tests-spe
bd10: 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d c)(get-value-by-
bd20: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
bd30: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
bd40: 22 69 74 65 6d 5f 70 61 74 68 22 20 20 20 29 20 "item_path" )
bd50: 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 #f)) ;; (db:test
bd60: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 20 -get-item-path
bd70: 74 65 73 74 29 29 0a 09 09 09 09 28 63 6f 6d 6d test)).....(comm
bd80: 65 6e 74 20 20 20 20 20 20 28 69 66 20 28 6d 65 ent (if (me
bd90: 6d 62 65 72 20 22 63 6f 6d 6d 65 6e 74 22 20 20 mber "comment"
bda0: 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 tests-spec)(
bdb0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
bdc0: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
bdd0: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 63 6f -field-index "co
bde0: 6d 6d 65 6e 74 22 20 20 20 20 20 29 20 23 66 29 mment" ) #f)
bdf0: 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 ) ;; (db:test-ge
be00: 74 2d 63 6f 6d 6d 65 6e 74 20 20 20 20 74 65 73 t-comment tes
be10: 74 29 29 0a 09 09 09 09 28 74 73 74 61 74 65 20 t)).....(tstate
be20: 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 (if (membe
be30: 72 20 22 73 74 61 74 65 22 20 20 20 20 20 20 20 r "state"
be40: 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 tests-spec)(get
be50: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
be60: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
be70: 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 65 eld-index "state
be80: 22 20 20 20 20 20 20 20 29 20 23 66 29 29 20 3b " ) #f)) ;
be90: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ; (db:test-get-s
bea0: 74 61 74 65 20 20 20 20 20 20 74 65 73 74 29 29 tate test))
beb0: 0a 09 09 09 09 28 74 73 74 61 74 75 73 20 20 20 .....(tstatus
bec0: 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 (if (member "
bed0: 73 74 61 74 75 73 22 20 20 20 20 20 20 20 74 65 status" te
bee0: 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 sts-spec)(get-va
bef0: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
bf00: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
bf10: 2d 69 6e 64 65 78 20 22 73 74 61 74 75 73 22 20 -index "status"
bf20: 20 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 ) #f)) ;; (
bf30: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
bf40: 75 73 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 us test))...
bf50: 09 09 28 65 76 65 6e 74 2d 74 69 6d 65 20 20 20 ..(event-time
bf60: 28 69 66 20 28 6d 65 6d 62 65 72 20 22 65 76 65 (if (member "eve
bf70: 6e 74 5f 74 69 6d 65 22 20 20 20 74 65 73 74 73 nt_time" tests
bf80: 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 -spec)(get-value
bf90: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
bfa0: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
bfb0: 64 65 78 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 dex "event_time"
bfc0: 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a ) #f)) ;; (db:
bfd0: 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 test-get-event_t
bfe0: 69 6d 65 20 74 65 73 74 29 29 0a 09 09 09 09 28 ime test)).....(
bff0: 72 75 6e 64 69 72 20 20 20 20 20 20 20 28 69 66 rundir (if
c000: 20 28 6d 65 6d 62 65 72 20 22 72 75 6e 64 69 72 (member "rundir
c010: 22 20 20 20 20 20 20 20 74 65 73 74 73 2d 73 70 " tests-sp
c020: 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 ec)(get-value-by
c030: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
c040: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
c050: 20 22 72 75 6e 64 69 72 22 20 20 20 20 20 20 29 "rundir" )
c060: 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 #f)) ;; (db:tes
c070: 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 20 20 20 t-get-rundir
c080: 20 74 65 73 74 29 29 0a 09 09 09 09 28 66 69 6e test)).....(fin
c090: 61 6c 5f 6c 6f 67 66 20 20 20 28 69 66 20 28 6d al_logf (if (m
c0a0: 65 6d 62 65 72 20 22 66 69 6e 61 6c 5f 6c 6f 67 ember "final_log
c0b0: 66 22 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 f" tests-spec)
c0c0: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
c0d0: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
c0e0: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 66 t-field-index "f
c0f0: 69 6e 61 6c 5f 6c 6f 67 66 22 20 20 29 20 23 66 inal_logf" ) #f
c100: 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 )) ;; (db:test-g
c110: 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 et-final_logf te
c120: 73 74 29 29 0a 09 09 09 09 28 72 75 6e 5f 64 75 st)).....(run_du
c130: 72 61 74 69 6f 6e 20 28 69 66 20 28 6d 65 6d 62 ration (if (memb
c140: 65 72 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e er "run_duration
c150: 22 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 " tests-spec)(ge
c160: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
c170: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
c180: 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 5f ield-index "run_
c190: 64 75 72 61 74 69 6f 6e 22 29 20 23 66 29 29 20 duration") #f))
c1a0: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
c1b0: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 run_duration tes
c1c0: 74 29 29 0a 09 09 09 09 28 66 75 6c 6c 6e 61 6d t)).....(fullnam
c1d0: 65 20 20 20 20 20 28 63 6f 6e 63 20 74 65 73 74 e (conc test
c1e0: 6e 61 6d 65 0a 09 09 09 09 09 09 20 20 20 20 28 name....... (
c1f0: 69 66 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 70 if (equal? itemp
c200: 61 74 68 20 22 22 29 0a 09 09 09 09 09 09 09 22 ath "")........"
c210: 22 20 0a 09 09 09 09 09 09 09 28 63 6f 6e 63 20 " ........(conc
c220: 22 28 22 20 69 74 65 6d 70 61 74 68 20 22 29 22 "(" itempath ")"
c230: 29 29 29 29 29 0a 09 09 09 20 20 20 28 63 61 73 ))))).... (cas
c240: 65 20 64 6d 6f 64 65 0a 09 09 09 20 20 20 20 20 e dmode....
c250: 28 28 6a 73 6f 6e 20 6f 64 73 29 0a 09 09 09 20 ((json ods)....
c260: 20 20 20 20 20 28 69 66 20 74 65 73 74 73 2d 73 (if tests-s
c270: 70 65 63 0a 09 09 09 09 20 20 28 66 6f 72 2d 65 pec..... (for-e
c280: 61 63 68 0a 09 09 09 09 20 20 20 28 6c 61 6d 62 ach..... (lamb
c290: 64 61 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a da (field-name).
c2a0: 09 09 09 09 20 20 20 20 20 28 6d 75 74 69 6c 73 .... (mutils
c2b0: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
c2c0: 61 74 61 20 20 28 67 65 74 2d 76 61 6c 75 65 2d ata (get-value-
c2d0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
c2e0: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
c2f0: 65 78 20 66 69 65 6c 64 2d 6e 61 6d 65 29 20 74 ex field-name) t
c300: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
c310: 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 "data" (conc te
c320: 73 74 2d 69 64 29 20 66 69 65 6c 64 2d 6e 61 6d st-id) field-nam
c330: 65 29 29 0a 09 09 09 09 20 20 20 74 65 73 74 73 e))..... tests
c340: 2d 73 70 65 63 29 29 29 0a 09 09 09 20 20 20 20 -spec)))....
c350: 20 3b 3b 20 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 ;; ;; (mutils:h
c360: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
c370: 61 20 20 66 75 6c 6c 6e 61 6d 65 20 20 20 74 61 a fullname ta
c380: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
c390: 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 "data" (conc tes
c3a0: 74 2d 69 64 29 20 22 74 6e 61 6d 65 22 20 20 20 t-id) "tname"
c3b0: 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 ).... ;;
c3c0: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
c3d0: 2d 73 65 74 21 20 64 61 74 61 20 20 74 65 73 74 -set! data test
c3e0: 6e 61 6d 65 20 20 20 74 61 72 67 65 74 73 74 72 name targetstr
c3f0: 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 runname "data"
c400: 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 (conc test-id) "
c410: 74 65 73 74 6e 61 6d 65 22 20 20 29 0a 09 09 09 testname" )....
c420: 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 ;; (mutils
c430: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
c440: 61 74 61 20 20 69 74 65 6d 70 61 74 68 20 20 20 ata itempath
c450: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
c460: 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 e "data" (conc t
c470: 65 73 74 2d 69 64 29 20 22 69 74 65 6d 70 61 74 est-id) "itempat
c480: 68 22 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b h" ).... ;;
c490: 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 (mutils:hierha
c4a0: 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 63 6f sh-set! data co
c4b0: 6d 6d 65 6e 74 20 20 20 20 74 61 72 67 65 74 73 mment targets
c4c0: 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 tr runname "data
c4d0: 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 " (conc test-id)
c4e0: 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 29 0a 09 "comment" )..
c4f0: 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 .. ;; (muti
c500: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
c510: 20 64 61 74 61 20 20 74 73 74 61 74 65 20 20 20 data tstate
c520: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
c530: 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 ame "data" (conc
c540: 20 74 65 73 74 2d 69 64 29 20 22 73 74 61 74 65 test-id) "state
c550: 22 20 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 " )....
c560: 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 ;; (mutils:hier
c570: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 hash-set! data
c580: 74 73 74 61 74 75 73 20 20 20 20 74 61 72 67 65 tstatus targe
c590: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 tstr runname "da
c5a0: 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 ta" (conc test-i
c5b0: 64 29 20 22 73 74 61 74 75 73 22 20 20 20 20 29 d) "status" )
c5c0: 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 .... ;; (mu
c5d0: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
c5e0: 74 21 20 64 61 74 61 20 20 72 75 6e 64 69 72 20 t! data rundir
c5f0: 20 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 targetstr ru
c600: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
c610: 6e 63 20 74 65 73 74 2d 69 64 29 20 22 72 75 6e nc test-id) "run
c620: 64 69 72 22 20 20 20 20 29 0a 09 09 09 20 20 20 dir" )....
c630: 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 ;; (mutils:hi
c640: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
c650: 20 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 61 72 final_logf tar
c660: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
c670: 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 data" (conc test
c680: 2d 69 64 29 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 -id) "final_logf
c690: 22 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 ").... ;; (
c6a0: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
c6b0: 73 65 74 21 20 64 61 74 61 20 20 72 75 6e 5f 64 set! data run_d
c6c0: 75 72 61 74 69 6f 6e 20 74 61 72 67 65 74 73 74 uration targetst
c6d0: 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 r runname "data"
c6e0: 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 (conc test-id)
c6f0: 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 0a "run_duration").
c700: 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 ... ;; (mut
c710: 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 ils:hierhash-set
c720: 21 20 64 61 74 61 20 20 65 76 65 6e 74 2d 74 69 ! data event-ti
c730: 6d 65 20 74 61 72 67 65 74 73 74 72 20 72 75 6e me targetstr run
c740: 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e name "data" (con
c750: 63 20 74 65 73 74 2d 69 64 29 20 22 65 76 65 6e c test-id) "even
c760: 74 5f 74 69 6d 65 22 29 0a 09 09 09 20 20 20 20 t_time")....
c770: 20 3b 3b 20 20 3b 3b 20 61 64 64 20 6c 61 73 74 ;; ;; add last
c780: 20 65 6e 74 72 79 20 74 77 69 63 65 20 2d 20 73 entry twice - s
c790: 65 65 6d 73 20 74 6f 20 62 65 20 61 20 62 75 67 eems to be a bug
c7a0: 20 69 6e 20 68 69 65 72 68 61 73 68 3f 0a 09 09 in hierhash?...
c7b0: 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c . ;; (mutil
c7c0: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
c7d0: 64 61 74 61 20 20 65 76 65 6e 74 2d 74 69 6d 65 data event-time
c7e0: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
c7f0: 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 me "data" (conc
c800: 74 65 73 74 2d 69 64 29 20 22 65 76 65 6e 74 5f test-id) "event_
c810: 74 69 6d 65 22 29 0a 09 09 09 20 20 20 20 20 3b time").... ;
c820: 3b 20 20 29 0a 09 09 09 20 20 20 20 20 28 65 6c ; ).... (el
c830: 73 65 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 se.... (if
c840: 28 61 6e 64 20 74 73 74 61 74 65 20 74 73 74 61 (and tstate tsta
c850: 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 29 0a tus event-time).
c860: 09 09 09 09 20 20 28 66 6f 72 6d 61 74 20 23 74 .... (format #t
c870: 0a 09 09 09 09 09 20 20 22 20 20 54 65 73 74 3a ...... " Test:
c880: 20 7e 32 35 61 20 53 74 61 74 65 3a 20 7e 31 35 ~25a State: ~15
c890: 61 20 53 74 61 74 75 73 3a 20 7e 31 35 61 20 52 a Status: ~15a R
c8a0: 75 6e 74 69 6d 65 3a 20 7e 35 40 61 73 20 54 69 untime: ~5@as Ti
c8b0: 6d 65 3a 20 7e 32 32 61 20 48 6f 73 74 3a 20 7e me: ~22a Host: ~
c8c0: 31 30 61 5c 6e 22 0a 09 09 09 09 09 20 20 28 69 10a\n"...... (i
c8d0: 66 20 66 75 6c 6c 6e 61 6d 65 20 66 75 6c 6c 6e f fullname fulln
c8e0: 61 6d 65 20 22 22 29 0a 09 09 09 09 09 20 20 28 ame "")...... (
c8f0: 69 66 20 74 73 74 61 74 65 20 20 20 74 73 74 61 if tstate tsta
c900: 74 65 20 20 20 22 22 29 0a 09 09 09 09 09 20 20 te "")......
c910: 28 69 66 20 74 73 74 61 74 75 73 20 20 74 73 74 (if tstatus tst
c920: 61 74 75 73 20 20 22 22 29 0a 09 09 09 09 09 20 atus "")......
c930: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
c940: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
c950: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
c960: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 3b 3b run_duration");;
c970: 28 69 66 20 74 65 73 74 20 20 20 20 20 28 64 62 (if test (db
c980: 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 :test-get-run_du
c990: 72 61 74 69 6f 6e 20 74 65 73 74 29 20 22 22 29 ration test) "")
c9a0: 0a 09 09 09 09 09 20 20 28 69 66 20 65 76 65 6e ...... (if even
c9b0: 74 2d 74 69 6d 65 20 65 76 65 6e 74 2d 74 69 6d t-time event-tim
c9c0: 65 20 22 22 29 0a 09 09 09 09 09 20 20 28 67 65 e "")...... (ge
c9d0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
c9e0: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
c9f0: 69 65 6c 64 2d 69 6e 64 65 78 20 22 68 6f 73 74 ield-index "host
ca00: 22 29 29 20 3b 3b 28 69 66 20 74 65 73 74 20 28 ")) ;;(if test (
ca10: 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 db:test-get-host
ca20: 20 74 65 73 74 29 29 20 22 22 29 0a 09 09 09 09 test)) "").....
ca30: 20 20 28 70 72 69 6e 74 20 22 20 20 54 65 73 74 (print " Test
ca40: 3a 20 22 20 66 75 6c 6c 6e 61 6d 65 0a 09 09 09 : " fullname....
ca50: 09 09 20 28 69 66 20 74 73 74 61 74 65 20 20 28 .. (if tstate (
ca60: 63 6f 6e 63 20 22 20 53 74 61 74 65 3a 20 22 20 conc " State: "
ca70: 20 74 73 74 61 74 65 29 20 20 22 22 29 0a 09 09 tstate) "")...
ca80: 09 09 09 20 28 69 66 20 74 73 74 61 74 75 73 20 ... (if tstatus
ca90: 28 63 6f 6e 63 20 22 20 53 74 61 74 75 73 3a 20 (conc " Status:
caa0: 22 20 74 73 74 61 74 75 73 29 20 22 22 29 0a 09 " tstatus) "")..
cab0: 09 09 09 09 20 28 69 66 20 28 67 65 74 2d 76 61 .... (if (get-va
cac0: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
cad0: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
cae0: 2d 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 61 -index "run_dura
caf0: 74 69 6f 6e 22 29 0a 09 09 09 09 09 20 20 20 20 tion")......
cb00: 20 28 63 6f 6e 63 20 22 20 52 75 6e 74 69 6d 65 (conc " Runtime
cb10: 3a 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 : " (get-value-b
cb20: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
cb30: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
cb40: 78 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 x "run_duration"
cb50: 29 29 0a 09 09 09 09 09 20 20 20 20 20 22 22 29 ))...... "")
cb60: 0a 09 09 09 09 09 20 28 69 66 20 65 76 65 6e 74 ...... (if event
cb70: 2d 74 69 6d 65 20 28 63 6f 6e 63 20 22 20 54 69 -time (conc " Ti
cb80: 6d 65 3a 20 22 20 65 76 65 6e 74 2d 74 69 6d 65 me: " event-time
cb90: 29 20 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 ) "")...... (if
cba0: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
cbb0: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
cbc0: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 68 t-field-index "h
cbd0: 6f 73 74 22 29 0a 09 09 09 09 09 20 20 20 20 20 ost")......
cbe0: 28 63 6f 6e 63 20 22 20 48 6f 73 74 3a 20 22 20 (conc " Host: "
cbf0: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
cc00: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
cc10: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 68 t-field-index "h
cc20: 6f 73 74 22 29 29 0a 09 09 09 09 09 20 20 20 20 ost"))......
cc30: 20 22 22 29 29 29 0a 09 09 09 20 20 20 20 20 20 "")))....
cc40: 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 65 71 (if (not (or (eq
cc50: 75 61 6c 3f 20 28 67 65 74 2d 76 61 6c 75 65 2d ual? (get-value-
cc60: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
cc70: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
cc80: 65 78 20 22 73 74 61 74 75 73 22 29 20 22 50 41 ex "status") "PA
cc90: 53 53 22 29 0a 09 09 09 09 09 20 20 20 28 65 71 SS")...... (eq
cca0: 75 61 6c 3f 20 28 67 65 74 2d 76 61 6c 75 65 2d ual? (get-value-
ccb0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
ccc0: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
ccd0: 65 78 20 22 73 74 61 74 75 73 22 29 20 22 57 41 ex "status") "WA
cce0: 52 4e 22 29 0a 09 09 09 09 09 20 20 20 28 65 71 RN")...... (eq
ccf0: 75 61 6c 3f 20 28 67 65 74 2d 76 61 6c 75 65 2d ual? (get-value-
cd00: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
cd10: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
cd20: 65 78 20 22 73 74 61 74 65 22 29 20 20 22 4e 4f ex "state") "NO
cd30: 54 5f 53 54 41 52 54 45 44 22 29 29 29 0a 09 09 T_STARTED")))...
cd40: 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 .. (begin.....
cd50: 20 20 20 28 70 72 69 6e 74 20 20 20 28 69 66 20 (print (if
cd60: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
cd70: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
cd80: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 63 t-field-index "c
cd90: 70 75 6c 6f 61 64 22 29 0a 09 09 09 09 09 09 20 puload").......
cda0: 28 63 6f 6e 63 20 22 20 20 20 20 20 20 20 20 20 (conc "
cdb0: 63 70 75 6c 6f 61 64 3a 20 20 22 20 20 20 28 67 cpuload: " (g
cdc0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
cdd0: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
cde0: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 63 70 75 field-index "cpu
cdf0: 6c 6f 61 64 22 29 29 0a 09 09 09 09 09 09 20 22 load"))....... "
ce00: 22 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 ") ;; (db:test-g
ce10: 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 73 74 29 et-cpuload test)
ce20: 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 ...... (if (
ce30: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
ce40: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
ce50: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 64 69 -field-index "di
ce60: 73 6b 66 72 65 65 22 29 0a 09 09 09 09 09 09 20 skfree").......
ce70: 28 63 6f 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 (conc "\n
ce80: 20 20 64 69 73 6b 66 72 65 65 3a 20 22 20 28 67 diskfree: " (g
ce90: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
cea0: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
ceb0: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 64 69 73 field-index "dis
cec0: 6b 66 72 65 65 22 29 29 20 3b 3b 20 28 64 62 3a kfree")) ;; (db:
ced0: 74 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 test-get-diskfre
cee0: 65 20 74 65 73 74 29 0a 09 09 09 09 09 09 20 22 e test)....... "
cef0: 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 ")...... (if
cf00: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
cf10: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
cf20: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
cf30: 75 6e 61 6d 65 22 29 0a 09 09 09 09 09 09 20 28 uname")....... (
cf40: 63 6f 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 20 conc "\n
cf50: 20 75 6e 61 6d 65 3a 20 20 20 20 22 20 28 67 65 uname: " (ge
cf60: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
cf70: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
cf80: 69 65 6c 64 2d 69 6e 64 65 78 20 22 75 6e 61 6d ield-index "unam
cf90: 65 22 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 e")) ;; (db:test
cfa0: 2d 67 65 74 2d 75 6e 61 6d 65 20 74 65 73 74 29 -get-uname test)
cfb0: 0a 09 09 09 09 09 09 20 22 22 29 0a 09 09 09 09 ....... "").....
cfc0: 09 20 20 20 20 20 28 69 66 20 28 67 65 74 2d 76 . (if (get-v
cfd0: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
cfe0: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
cff0: 64 2d 69 6e 64 65 78 20 22 72 75 6e 64 69 72 22 d-index "rundir"
d000: 29 0a 09 09 09 09 09 09 20 28 63 6f 6e 63 20 22 )....... (conc "
d010: 5c 6e 20 20 20 20 20 20 20 20 20 72 75 6e 64 69 \n rundi
d020: 72 3a 20 20 20 22 20 28 67 65 74 2d 76 61 6c 75 r: " (get-valu
d030: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
d040: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
d050: 6e 64 65 78 20 22 72 75 6e 64 69 72 22 29 29 20 ndex "rundir"))
d060: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
d070: 72 75 6e 64 69 72 20 74 65 73 74 29 0a 09 09 09 rundir test)....
d080: 09 09 09 20 22 22 29 0a 3b 3b 09 09 09 09 09 20 ... "").;;.....
d090: 20 20 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 "\n
d0a0: 72 75 6e 64 69 72 3a 20 20 20 22 20 28 67 65 74 rundir: " (get
d0b0: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
d0c0: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
d0d0: 65 6c 64 2d 69 6e 64 65 78 20 22 22 29 20 3b 3b eld-index "") ;;
d0e0: 20 28 73 64 62 3a 71 72 79 20 27 67 65 74 73 74 (sdb:qry 'getst
d0f0: 72 20 3b 3b 20 28 66 69 6c 65 64 62 3a 67 65 74 r ;; (filedb:get
d100: 2d 70 61 74 68 20 2a 66 64 62 2a 20 0a 3b 3b 20 -path *fdb* .;;
d110: 09 09 09 09 09 20 20 20 20 20 28 64 62 3a 74 65 ..... (db:te
d120: 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 st-get-rundir te
d130: 73 74 29 20 3b 3b 20 29 0a 09 09 09 09 09 20 20 st) ;; )......
d140: 20 20 20 29 0a 09 09 09 09 20 20 20 20 3b 3b 20 )..... ;;
d150: 45 61 63 68 20 74 65 73 74 0a 09 09 09 09 20 20 Each test.....
d160: 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 65 6d 6f ;; DO NOT remo
d170: 74 65 20 72 75 6e 0a 09 09 09 09 20 20 20 20 28 te run..... (
d180: 6c 65 74 20 28 28 73 74 65 70 73 20 28 64 62 3a let ((steps (db:
d190: 64 69 73 70 61 74 63 68 2d 71 75 65 72 79 20 61 dispatch-query a
d1a0: 63 63 65 73 73 2d 6d 6f 64 65 20 72 6d 74 3a 67 ccess-mode rmt:g
d1b0: 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 et-steps-for-tes
d1c0: 74 20 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 t db:get-steps-f
d1d0: 6f 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 28 or-test run-id (
d1e0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 db:test-get-id t
d1f0: 65 73 74 29 29 29 29 20 3b 3b 20 28 64 62 3a 67 est)))) ;; (db:g
d200: 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 et-steps-for-tes
d210: 74 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 t dbstruct run-i
d220: 64 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 d (db:test-get-i
d230: 64 20 74 65 73 74 29 29 29 29 0a 09 09 09 09 20 d test)))).....
d240: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
d250: 09 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 .... (lamb
d260: 64 61 20 28 73 74 65 70 29 0a 09 09 09 09 09 20 da (step)......
d270: 28 66 6f 72 6d 61 74 20 23 74 20 0a 09 09 09 09 (format #t .....
d280: 09 09 20 22 20 20 20 20 53 74 65 70 3a 20 7e 32 .. " Step: ~2
d290: 30 61 20 53 74 61 74 65 3a 20 7e 31 30 61 20 53 0a State: ~10a S
d2a0: 74 61 74 75 73 3a 20 7e 31 30 61 20 54 69 6d 65 tatus: ~10a Time
d2b0: 20 7e 32 32 61 5c 6e 22 0a 09 09 09 09 09 09 20 ~22a\n".......
d2c0: 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 (tdb:step-get-st
d2d0: 65 70 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 09 epname step)....
d2e0: 09 09 09 20 28 74 64 62 3a 73 74 65 70 2d 67 65 ... (tdb:step-ge
d2f0: 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 09 t-state step)...
d300: 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 2d 67 .... (tdb:step-g
d310: 65 74 2d 73 74 61 74 75 73 20 73 74 65 70 29 0a et-status step).
d320: 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 ...... (tdb:step
d330: 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -get-event_time
d340: 73 74 65 70 29 29 29 0a 09 09 09 09 20 20 20 20 step))).....
d350: 20 20 20 73 74 65 70 73 29 29 29 29 29 29 29 29 steps))))))))
d360: 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 61 )... (if (a
d370: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f rgs:get-arg "-so
d380: 72 74 22 29 0a 09 09 09 20 20 28 73 6f 72 74 20 rt").... (sort
d390: 74 65 73 74 73 0a 09 09 09 09 28 6c 61 6d 62 64 tests.....(lambd
d3a0: 61 20 28 61 2d 74 65 73 74 20 62 2d 74 65 73 74 a (a-test b-test
d3b0: 29 0a 09 09 09 09 20 20 28 6c 65 74 2a 20 28 28 )..... (let* ((
d3c0: 6b 65 79 20 20 20 20 28 61 72 67 73 3a 67 65 74 key (args:get
d3d0: 2d 61 72 67 20 22 2d 73 6f 72 74 22 29 29 0a 09 -arg "-sort"))..
d3e0: 09 09 09 09 20 28 66 69 72 73 74 20 20 28 67 65 .... (first (ge
d3f0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
d400: 6e 61 6d 65 20 61 2d 74 65 73 74 20 74 65 73 74 name a-test test
d410: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 6b 65 79 -field-index key
d420: 29 29 0a 09 09 09 09 09 20 28 73 65 63 6f 6e 64 ))...... (second
d430: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
d440: 69 65 6c 64 6e 61 6d 65 20 62 2d 74 65 73 74 20 ieldname b-test
d450: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
d460: 20 6b 65 79 29 29 29 0a 09 09 09 09 20 20 20 20 key))).....
d470: 28 28 63 6f 6e 64 20 0a 09 09 09 09 20 20 20 20 ((cond .....
d480: 20 20 28 28 61 6e 64 20 28 6e 75 6d 62 65 72 3f ((and (number?
d490: 20 66 69 72 73 74 29 28 6e 75 6d 62 65 72 3f 20 first)(number?
d4a0: 73 65 63 6f 6e 64 29 29 20 3c 29 0a 09 09 09 09 second)) <).....
d4b0: 20 20 20 20 20 20 28 28 61 6e 64 20 28 73 74 72 ((and (str
d4c0: 69 6e 67 3f 20 66 69 72 73 74 29 28 73 74 72 69 ing? first)(stri
d4d0: 6e 67 3f 20 73 65 63 6f 6e 64 29 29 20 73 74 72 ng? second)) str
d4e0: 69 6e 67 3c 3d 3f 29 0a 09 09 09 09 20 20 20 20 ing<=?).....
d4f0: 20 20 28 65 6c 73 65 20 65 71 75 61 6c 3f 29 29 (else equal?))
d500: 0a 09 09 09 09 20 20 20 20 20 66 69 72 73 74 20 ..... first
d510: 73 65 63 6f 6e 64 29 29 29 29 0a 09 09 09 20 20 second))))....
d520: 74 65 73 74 73 29 29 29 29 29 29 0a 09 20 20 20 tests))))))..
d530: 72 75 6e 73 29 0a 09 20 20 28 69 66 20 28 65 71 runs).. (if (eq
d540: 3f 20 64 6d 6f 64 65 20 27 6a 73 6f 6e 29 28 6a ? dmode 'json)(j
d550: 73 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 29 29 son-write data))
d560: 0a 09 20 20 28 6c 65 74 2a 20 28 28 6d 65 74 61 .. (let* ((meta
d570: 64 61 74 2d 66 69 65 6c 64 73 20 28 64 65 6c 65 dat-fields (dele
d580: 74 65 2d 64 75 70 6c 69 63 61 74 65 73 0a 09 09 te-duplicates...
d590: 09 09 20 20 28 61 70 70 65 6e 64 20 6b 65 79 73 .. (append keys
d5a0: 20 27 28 20 22 72 75 6e 6e 61 6d 65 22 20 22 74 '( "runname" "t
d5b0: 69 6d 65 22 20 22 6f 77 6e 65 72 22 20 22 70 61 ime" "owner" "pa
d5c0: 73 73 5f 63 6f 75 6e 74 22 20 22 66 61 69 6c 5f ss_count" "fail_
d5d0: 63 6f 75 6e 74 22 20 22 73 74 61 74 65 22 20 22 count" "state" "
d5e0: 73 74 61 74 75 73 22 20 22 63 6f 6d 6d 65 6e 74 status" "comment
d5f0: 22 20 22 69 64 22 29 29 29 29 0a 09 09 20 28 72 " "id"))))... (r
d600: 75 6e 2d 66 69 65 6c 64 73 20 20 20 20 27 28 0a un-fields '(.
d610: 09 09 09 09 20 20 22 74 65 73 74 6e 61 6d 65 22 .... "testname"
d620: 0a 09 09 09 09 20 20 22 69 74 65 6d 5f 70 61 74 ..... "item_pat
d630: 68 22 0a 09 09 09 09 20 20 22 73 74 61 74 65 22 h"..... "state"
d640: 0a 09 09 09 09 20 20 22 73 74 61 74 75 73 22 0a ..... "status".
d650: 09 09 09 09 20 20 22 63 6f 6d 6d 65 6e 74 22 0a .... "comment".
d660: 09 09 09 09 20 20 22 65 76 65 6e 74 5f 74 69 6d .... "event_tim
d670: 65 22 0a 09 09 09 09 20 20 22 68 6f 73 74 22 0a e"..... "host".
d680: 09 09 09 09 20 20 22 72 75 6e 5f 69 64 22 0a 09 .... "run_id"..
d690: 09 09 09 20 20 22 72 75 6e 5f 64 75 72 61 74 69 ... "run_durati
d6a0: 6f 6e 22 0a 09 09 09 09 20 20 22 61 74 74 65 6d on"..... "attem
d6b0: 70 74 6e 75 6d 22 0a 09 09 09 09 20 20 22 69 64 ptnum"..... "id
d6c0: 22 0a 09 09 09 09 20 20 22 61 72 63 68 69 76 65 "..... "archive
d6d0: 64 22 0a 09 09 09 09 20 20 22 64 69 73 6b 66 72 d"..... "diskfr
d6e0: 65 65 22 0a 09 09 09 09 20 20 22 63 70 75 6c 6f ee"..... "cpulo
d6f0: 61 64 22 0a 09 09 09 09 20 20 22 66 69 6e 61 6c ad"..... "final
d700: 5f 6c 6f 67 66 22 0a 09 09 09 09 20 20 22 73 68 _logf"..... "sh
d710: 6f 72 74 64 69 72 22 0a 09 09 09 09 20 20 22 72 ortdir"..... "r
d720: 75 6e 64 69 72 22 0a 09 09 09 09 20 20 22 75 6e undir"..... "un
d730: 61 6d 65 22 0a 09 09 09 09 20 20 29 0a 09 09 09 ame"..... )....
d740: 09 29 0a 09 09 20 28 6e 65 77 64 61 74 20 20 20 .)... (newdat
d750: 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 74 (common:t
d760: 6f 2d 61 6c 69 73 74 20 64 61 74 61 29 29 0a 09 o-alist data))..
d770: 09 20 28 61 6c 6c 72 75 6e 64 61 74 20 20 20 20 . (allrundat
d780: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6e 65 (if (null? ne
d790: 77 64 61 74 29 0a 09 09 09 09 20 20 20 20 20 20 wdat).....
d7a0: 27 28 29 0a 09 09 09 09 20 20 20 20 20 20 28 63 '()..... (c
d7b0: 61 72 20 28 6d 61 70 20 63 64 72 20 6e 65 77 64 ar (map cdr newd
d7c0: 61 74 29 29 29 29 20 3b 3b 20 28 63 61 72 20 28 at)))) ;; (car (
d7d0: 6d 61 70 20 63 64 72 20 28 63 61 72 20 28 6d 61 map cdr (car (ma
d7e0: 70 20 63 64 72 20 6e 65 77 64 61 74 29 29 29 29 p cdr newdat))))
d7f0: 29 0a 09 09 20 28 72 75 6e 73 20 20 20 20 20 20 )... (runs
d800: 20 20 20 20 20 20 28 61 70 70 65 6e 64 0a 09 09 (append...
d810: 09 09 20 20 20 28 6c 69 73 74 20 22 72 75 6e 73 .. (list "runs
d820: 22 20 3b 3b 20 73 68 65 65 74 6e 61 6d 65 0a 09 " ;; sheetname..
d830: 09 09 09 09 20 6d 65 74 61 64 61 74 2d 66 69 65 .... metadat-fie
d840: 6c 64 73 29 0a 09 09 09 09 20 20 20 28 6d 61 70 lds)..... (map
d850: 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 (lambda (run)..
d860: 09 09 09 09 20 20 3b 3b 20 28 70 72 69 6e 74 20 .... ;; (print
d870: 22 72 75 6e 3a 20 22 20 72 75 6e 29 0a 09 09 09 "run: " run)....
d880: 09 09 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 6e .. (let* ((runn
d890: 61 6d 65 20 28 63 61 72 20 72 75 6e 29 29 0a 09 ame (car run))..
d8a0: 09 09 09 09 09 20 28 72 75 6e 64 61 74 20 20 28 ..... (rundat (
d8b0: 63 64 72 20 72 75 6e 29 29 0a 09 09 09 09 09 09 cdr run)).......
d8c0: 20 28 6d 65 74 61 64 61 74 20 28 6c 65 74 20 28 (metadat (let (
d8d0: 28 74 6d 70 20 28 61 73 73 6f 63 20 22 6d 65 74 (tmp (assoc "met
d8e0: 61 22 20 72 75 6e 64 61 74 29 29 29 0a 09 09 09 a" rundat)))....
d8f0: 09 09 09 09 20 20 20 20 28 69 66 20 74 6d 70 20 .... (if tmp
d900: 28 63 64 72 20 74 6d 70 29 20 23 66 29 29 29 29 (cdr tmp) #f))))
d910: 0a 09 09 09 09 09 20 20 20 20 3b 3b 20 28 70 72 ...... ;; (pr
d920: 69 6e 74 20 22 72 75 6e 6e 61 6d 65 3a 20 22 20 int "runname: "
d930: 72 75 6e 6e 61 6d 65 20 22 5c 6e 5c 6e 72 75 6e runname "\n\nrun
d940: 64 61 74 3a 20 22 20 29 28 70 70 20 72 75 6e 64 dat: " )(pp rund
d950: 61 74 29 28 70 72 69 6e 74 20 22 5c 6e 5c 6e 6d at)(print "\n\nm
d960: 65 74 61 64 61 74 3a 20 22 29 28 70 70 20 6d 65 etadat: ")(pp me
d970: 74 61 64 61 74 29 0a 09 09 09 09 09 20 20 20 20 tadat)......
d980: 28 69 66 20 6d 65 74 61 64 61 74 0a 09 09 09 09 (if metadat.....
d990: 09 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 ..(map (lambda (
d9a0: 66 69 65 6c 64 29 0a 09 09 09 09 09 09 20 20 20 field).......
d9b0: 20 20 20 20 28 6c 65 74 20 28 28 74 6d 70 20 28 (let ((tmp (
d9c0: 61 73 73 6f 63 20 66 69 65 6c 64 20 6d 65 74 61 assoc field meta
d9d0: 64 61 74 29 29 29 0a 09 09 09 09 09 09 09 20 28 dat)))........ (
d9e0: 69 66 20 74 6d 70 20 28 63 64 72 20 74 6d 70 29 if tmp (cdr tmp)
d9f0: 20 22 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 ""))).......
da00: 20 20 6d 65 74 61 64 61 74 2d 66 69 65 6c 64 73 metadat-fields
da10: 29 0a 09 09 09 09 09 09 28 62 65 67 69 6e 0a 09 ).......(begin..
da20: 09 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 ..... (debug:pr
da30: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
da40: 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e og-port* "WARNIN
da50: 47 3a 20 6d 65 74 61 20 64 61 74 61 20 66 6f 72 G: meta data for
da60: 20 72 75 6e 20 22 20 72 75 6e 6e 61 6d 65 20 22 run " runname "
da70: 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 09 09 09 not found")....
da80: 09 09 09 20 20 27 28 29 29 29 29 29 0a 09 09 09 ... '()))))....
da90: 09 09 61 6c 6c 72 75 6e 64 61 74 29 29 29 0a 09 ..allrundat)))..
daa0: 09 20 3b 3b 20 27 28 20 28 20 22 74 61 72 67 65 . ;; '( ( "targe
dab0: 74 22 20 28 20 22 72 75 6e 6e 61 6d 65 22 20 28 t" ( "runname" (
dac0: 20 22 64 61 74 61 22 20 28 20 22 72 75 6e 69 64 "data" ( "runid
dad0: 22 20 28 20 22 69 64 20 2e 20 22 33 37 22 20 29 " ( "id . "37" )
dae0: 20 28 20 2e 2e 2e 20 29 29 29 29 0a 09 09 20 28 ( ... ))))... (
daf0: 72 75 6e 2d 70 61 67 65 73 20 20 20 20 20 20 28 run-pages (
db00: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 74 61 72 map (lambda (tar
db10: 67 64 61 74 29 0a 09 09 09 09 09 28 6c 65 74 2a gdat)......(let*
db20: 20 28 28 74 61 72 67 65 74 20 20 28 63 61 72 20 ((target (car
db30: 74 61 72 67 64 61 74 29 29 0a 09 09 09 09 09 20 targdat))......
db40: 20 20 20 20 20 20 28 72 75 6e 73 64 61 74 20 28 (runsdat (
db50: 63 64 72 20 74 61 72 67 64 61 74 29 29 29 0a 09 cdr targdat)))..
db60: 09 09 09 09 20 20 28 69 66 20 72 75 6e 73 64 61 .... (if runsda
db70: 74 0a 09 09 09 09 09 20 20 20 20 20 20 28 6d 61 t...... (ma
db80: 70 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 64 61 p (lambda (runda
db90: 74 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 6c t)....... (l
dba0: 65 74 2a 20 28 28 72 75 6e 6e 61 6d 65 20 20 28 et* ((runname (
dbb0: 63 61 72 20 72 75 6e 64 61 74 29 29 0a 09 09 09 car rundat))....
dbc0: 09 09 09 09 20 20 20 20 28 72 75 6e 64 61 74 20 .... (rundat
dbd0: 20 20 28 63 64 72 20 72 75 6e 64 61 74 29 29 0a (cdr rundat)).
dbe0: 09 09 09 09 09 09 09 20 20 20 20 28 74 65 73 74 ....... (test
dbf0: 73 64 61 74 20 28 6c 65 74 20 28 28 74 6d 70 20 sdat (let ((tmp
dc00: 28 61 73 73 6f 63 20 22 64 61 74 61 22 20 72 75 (assoc "data" ru
dc10: 6e 64 61 74 29 29 29 0a 09 09 09 09 09 09 09 09 ndat))).........
dc20: 09 28 69 66 20 74 6d 70 20 28 63 64 72 20 74 6d .(if tmp (cdr tm
dc30: 70 29 20 23 66 29 29 29 29 0a 09 09 09 09 09 09 p) #f)))).......
dc40: 20 20 20 20 20 20 20 28 69 66 20 74 65 73 74 73 (if tests
dc50: 64 61 74 0a 09 09 09 09 09 09 09 20 20 20 28 6c dat........ (l
dc60: 65 74 20 28 28 74 65 73 74 73 20 28 6d 61 70 20 et ((tests (map
dc70: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 (lambda (test)..
dc80: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
dc90: 6c 65 74 2a 20 28 28 74 65 73 74 2d 69 64 20 20 let* ((test-id
dca0: 28 63 61 72 20 74 65 73 74 29 29 0a 09 09 09 09 (car test)).....
dcb0: 09 09 09 09 09 09 20 20 20 20 20 20 28 74 65 73 ...... (tes
dcc0: 74 2d 64 61 74 20 28 63 64 72 20 74 65 73 74 29 t-dat (cdr test)
dcd0: 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 28 6d ))........... (m
dce0: 61 70 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c ap (lambda (fiel
dcf0: 64 29 0a 09 09 09 09 09 09 09 09 09 09 09 28 6c d)............(l
dd00: 65 74 20 28 28 74 6d 70 20 28 61 73 73 6f 63 20 et ((tmp (assoc
dd10: 66 69 65 6c 64 20 74 65 73 74 2d 64 61 74 29 29 field test-dat))
dd20: 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 28 )............ (
dd30: 69 66 20 74 6d 70 20 28 63 64 72 20 74 6d 70 29 if tmp (cdr tmp)
dd40: 20 22 22 29 29 29 0a 09 09 09 09 09 09 09 09 09 "")))..........
dd50: 09 20 20 20 20 20 20 72 75 6e 2d 66 69 65 6c 64 . run-field
dd60: 73 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 s)))..........
dd70: 20 20 20 74 65 73 74 73 64 61 74 29 29 29 0a 09 testsdat)))..
dd80: 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 28 70 ...... ;; (p
dd90: 72 69 6e 74 20 22 54 61 72 67 65 74 3a 20 22 20 rint "Target: "
dda0: 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 target "/" runna
ddb0: 6d 65 20 22 20 74 65 73 74 73 3a 22 29 0a 09 09 me " tests:")...
ddc0: 09 09 09 09 09 20 20 20 20 20 3b 3b 20 28 70 70 ..... ;; (pp
ddd0: 20 74 65 73 74 73 29 0a 09 09 09 09 09 09 09 20 tests)........
dde0: 20 20 20 20 28 63 6f 6e 73 20 28 63 6f 6e 63 20 (cons (conc
ddf0: 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 target "/" runna
de00: 6d 65 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 me)......... (
de10: 63 6f 6e 73 20 28 6c 69 73 74 20 28 63 6f 6e 63 cons (list (conc
de20: 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e target "/" runn
de30: 61 6d 65 29 29 0a 09 09 09 09 09 09 09 09 09 20 ame))..........
de40: 28 63 6f 6e 73 20 27 28 29 0a 09 09 09 09 09 09 (cons '().......
de50: 09 09 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 ... (cons
de60: 72 75 6e 2d 66 69 65 6c 64 73 20 74 65 73 74 73 run-fields tests
de70: 29 29 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 )))))........
de80: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 20 20 (begin........
de90: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
dea0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
deb0: 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 72 ort* "WARNING: r
dec0: 75 6e 20 22 20 74 61 72 67 65 74 20 22 2f 22 20 un " target "/"
ded0: 72 75 6e 6e 61 6d 65 20 22 20 61 70 70 65 61 72 runname " appear
dee0: 73 20 74 6f 20 68 61 76 65 20 6e 6f 20 64 61 74 s to have no dat
def0: 61 22 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 a")........
df00: 3b 3b 20 28 70 70 20 72 75 6e 64 61 74 29 0a 09 ;; (pp rundat)..
df10: 09 09 09 09 09 09 20 20 20 20 20 27 28 29 29 29 ...... '()))
df20: 29 29 0a 09 09 09 09 09 09 20 20 20 72 75 6e 73 ))....... runs
df30: 64 61 74 29 0a 09 09 09 09 09 20 20 20 20 20 20 dat)......
df40: 27 28 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 '()))).....
df50: 20 6e 65 77 64 61 74 29 29 20 3b 3b 20 77 65 20 newdat)) ;; we
df60: 75 73 65 20 6e 65 77 64 61 74 20 74 6f 20 67 65 use newdat to ge
df70: 74 20 74 61 72 67 65 74 0a 09 09 20 28 73 68 65 t target... (she
df80: 65 74 73 20 20 20 20 20 20 20 20 20 28 66 69 6c ets (fil
df90: 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 0a ter (lambda (x).
dfa0: 09 09 09 09 09 20 20 20 28 6e 6f 74 20 28 6e 75 ..... (not (nu
dfb0: 6c 6c 3f 20 78 29 29 29 0a 09 09 09 09 09 20 28 ll? x)))...... (
dfc0: 63 6f 6e 73 20 72 75 6e 73 20 28 6d 61 70 20 63 cons runs (map c
dfd0: 61 72 20 72 75 6e 2d 70 61 67 65 73 29 29 29 29 ar run-pages))))
dfe0: 29 0a 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 ).. ;; (print
dff0: 20 22 61 6c 6c 72 75 6e 64 61 74 3a 22 29 0a 09 "allrundat:")..
e000: 20 20 20 20 3b 3b 20 28 70 70 20 61 6c 6c 72 75 ;; (pp allru
e010: 6e 64 61 74 29 0a 09 20 20 20 20 3b 3b 20 28 70 ndat).. ;; (p
e020: 72 69 6e 74 20 22 72 75 6e 73 3a 22 29 0a 09 20 rint "runs:")..
e030: 20 20 20 3b 3b 20 28 70 70 20 72 75 6e 73 29 0a ;; (pp runs).
e040: 09 20 20 20 20 3b 28 70 72 69 6e 74 20 22 73 68 . ;(print "sh
e050: 65 65 74 73 3a 20 22 29 0a 09 20 20 20 20 3b 3b eets: ").. ;;
e060: 20 28 70 70 20 73 68 65 65 74 73 29 0a 09 20 20 (pp sheets)..
e070: 20 20 28 69 66 20 28 65 71 3f 20 64 6d 6f 64 65 (if (eq? dmode
e080: 20 27 6f 64 73 29 0a 09 09 28 6c 65 74 2a 20 28 'ods)...(let* (
e090: 28 74 65 6d 70 64 69 72 20 20 20 20 28 63 6f 6e (tempdir (con
e0a0: 63 20 22 2f 74 6d 70 2f 22 20 28 63 75 72 72 65 c "/tmp/" (curre
e0b0: 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 29 20 22 2f nt-user-name) "/
e0c0: 22 20 28 72 61 6e 64 6f 6d 20 31 30 30 30 30 29 " (random 10000)
e0d0: 20 22 5f 22 20 28 63 75 72 72 65 6e 74 2d 70 72 "_" (current-pr
e0e0: 6f 63 65 73 73 2d 69 64 29 29 29 0a 09 09 20 20 ocess-id)))...
e0f0: 20 20 20 20 20 28 6f 75 74 70 75 74 66 69 6c 65 (outputfile
e100: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
e110: 72 67 20 22 2d 6f 22 29 20 22 6f 75 74 2e 6f 64 rg "-o") "out.od
e120: 73 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 6f s"))... (o
e130: 75 66 20 20 20 20 20 20 20 20 28 69 66 20 28 73 uf (if (s
e140: 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 tring-match (reg
e150: 65 78 70 20 22 5e 5b 2f 7e 5d 2b 2e 2a 22 29 20 exp "^[/~]+.*")
e160: 6f 75 74 70 75 74 66 69 6c 65 29 20 3b 3b 20 66 outputfile) ;; f
e170: 75 6c 6c 20 70 61 74 68 3f 0a 09 09 09 09 20 20 ull path?.....
e180: 20 20 20 20 20 6f 75 74 70 75 74 66 69 6c 65 0a outputfile.
e190: 09 09 09 09 20 20 20 20 20 20 20 28 62 65 67 69 .... (begi
e1a0: 6e 0a 09 09 09 09 09 20 28 64 65 62 75 67 3a 70 n...... (debug:p
e1b0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
e1c0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
e1d0: 4e 47 3a 20 70 61 74 68 20 67 69 76 65 6e 2c 20 NG: path given,
e1e0: 22 20 6f 75 74 70 75 74 66 69 6c 65 20 22 20 69 " outputfile " i
e1f0: 73 20 72 65 6c 61 74 69 76 65 2c 20 70 72 65 66 s relative, pref
e200: 69 78 69 6e 67 20 77 69 74 68 20 63 75 72 72 65 ixing with curre
e210: 6e 74 20 64 69 72 65 63 74 6f 72 79 22 29 0a 09 nt directory")..
e220: 09 09 09 09 20 28 63 6f 6e 63 20 28 63 75 72 72 .... (conc (curr
e230: 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 20 22 ent-directory) "
e240: 2f 22 20 6f 75 74 70 75 74 66 69 6c 65 29 29 29 /" outputfile)))
e250: 29 29 0a 09 09 20 20 28 63 72 65 61 74 65 2d 64 ))... (create-d
e260: 69 72 65 63 74 6f 72 79 20 74 65 6d 70 64 69 72 irectory tempdir
e270: 20 23 74 29 0a 09 09 20 20 28 6f 64 73 3a 6c 69 #t)... (ods:li
e280: 73 74 2d 3e 6f 64 73 20 74 65 6d 70 64 69 72 20 st->ods tempdir
e290: 6f 75 66 20 73 68 65 65 74 73 29 29 29 29 0a 09 ouf sheets))))..
e2a0: 20 20 3b 3b 20 28 73 79 73 74 65 6d 20 28 63 6f ;; (system (co
e2b0: 6e 63 20 22 72 6d 20 2d 72 66 20 22 20 74 65 6d nc "rm -rf " tem
e2c0: 70 64 69 72 29 29 0a 09 20 20 28 73 65 74 21 20 pdir)).. (set!
e2d0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
e2e0: 74 29 29 29 29 0a 0a 3b 3b 20 44 6f 6e 27 74 20 t))))..;; Don't
e2f0: 74 68 69 6e 6b 20 49 20 6e 65 65 64 20 74 68 69 think I need thi
e300: 73 2e 20 49 6e 63 6f 72 70 6f 72 61 74 65 64 20 s. Incorporated
e310: 69 6e 74 6f 20 2d 6c 69 73 74 2d 72 75 6e 73 20 into -list-runs
e320: 69 6e 73 74 65 61 64 0a 3b 3b 0a 3b 3b 20 28 69 instead.;;.;; (i
e330: 66 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 f (and (args:get
e340: 2d 61 72 67 20 22 2d 73 69 6e 63 65 22 29 0a 3b -arg "-since").;
e350: 3b 20 09 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 ; . (launch:setu
e360: 70 29 29 0a 3b 3b 20 20 20 20 20 28 6c 65 74 2a p)).;; (let*
e370: 20 28 28 73 69 6e 63 65 2d 74 69 6d 65 20 28 73 ((since-time (s
e380: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 tring->number (a
e390: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 rgs:get-arg "-si
e3a0: 6e 63 65 22 29 29 29 0a 3b 3b 20 09 20 20 20 28 nce"))).;; . (
e3b0: 72 75 6e 2d 69 64 73 20 20 20 20 28 64 62 3a 67 run-ids (db:g
e3c0: 65 74 2d 63 68 61 6e 67 65 64 2d 72 75 6e 2d 69 et-changed-run-i
e3d0: 64 73 20 73 69 6e 63 65 2d 74 69 6d 65 29 29 29 ds since-time)))
e3e0: 0a 3b 3b 20 20 20 20 20 20 20 3b 3b 20 28 72 6d .;; ;; (rm
e3f0: 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d t:get-tests-for-
e400: 72 75 6e 73 2d 6d 69 6e 64 61 74 61 20 72 75 6e runs-mindata run
e410: 2d 69 64 73 20 74 65 73 74 70 61 74 74 20 73 74 -ids testpatt st
e420: 61 74 65 73 20 73 74 61 74 75 73 20 6e 6f 74 2d ates status not-
e430: 69 6e 29 0a 3b 3b 20 20 20 20 20 20 20 28 70 72 in).;; (pr
e440: 69 6e 74 20 28 73 6f 72 74 20 72 75 6e 2d 69 64 int (sort run-id
e450: 73 20 3c 29 29 0a 3b 3b 20 20 20 20 20 20 20 28 s <)).;; (
e460: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
e470: 6e 67 2a 20 23 74 29 29 29 0a 20 20 20 20 20 20 ng* #t))).
e480: 0a 20 20 20 20 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d . .;;======
e490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4d0: 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e 0a 3b 3b 3d .;; full run.;;=
e4e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e520: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 20 6c 6f =====..;; get lo
e530: 63 6b 20 69 6e 20 64 62 20 66 6f 72 20 66 75 6c ck in db for ful
e540: 6c 20 72 75 6e 20 66 6f 72 20 74 68 69 73 20 64 l run for this d
e550: 69 72 65 63 74 6f 72 79 0a 3b 3b 20 66 6f 72 20 irectory.;; for
e560: 61 6c 6c 20 74 65 73 74 73 20 77 69 74 68 20 64 all tests with d
e570: 65 70 73 0a 3b 3b 20 20 20 77 61 6c 6b 20 74 72 eps.;; walk tr
e580: 65 65 20 6f 66 20 74 65 73 74 73 20 74 6f 20 66 ee of tests to f
e590: 69 6e 64 20 68 65 61 64 20 74 61 73 6b 73 0a 3b ind head tasks.;
e5a0: 3b 20 20 20 61 64 64 20 68 65 61 64 20 74 61 73 ; add head tas
e5b0: 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 ks to task queue
e5c0: 0a 3b 3b 20 20 20 61 64 64 20 64 65 70 65 6e 64 .;; add depend
e5d0: 61 6e 74 20 74 61 73 6b 73 20 74 6f 20 74 61 73 ant tasks to tas
e5e0: 6b 20 71 75 65 75 65 20 0a 3b 3b 20 20 20 61 64 k queue .;; ad
e5f0: 64 20 72 65 6d 61 69 6e 69 6e 67 20 74 61 73 6b d remaining task
e600: 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 0a s to task queue.
e610: 3b 3b 20 66 6f 72 20 65 61 63 68 20 74 61 73 6b ;; for each task
e620: 20 69 6e 20 74 61 73 6b 20 71 75 65 75 65 0a 3b in task queue.;
e630: 3b 20 20 20 69 66 20 68 61 76 65 20 61 64 65 71 ; if have adeq
e640: 75 61 74 65 20 72 65 73 6f 75 72 63 65 73 0a 3b uate resources.;
e650: 3b 20 20 20 20 20 6c 61 75 6e 63 68 20 74 61 73 ; launch tas
e660: 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b 20 20 k.;; else.;;
e670: 20 20 20 70 75 74 20 74 61 73 6b 20 69 6e 20 64 put task in d
e680: 65 66 65 72 72 65 64 20 71 75 65 75 65 0a 3b 3b eferred queue.;;
e690: 20 69 66 20 73 74 69 6c 6c 20 6f 6b 20 74 6f 20 if still ok to
e6a0: 72 75 6e 20 74 61 73 6b 73 0a 3b 3b 20 20 20 70 run tasks.;; p
e6b0: 72 6f 63 65 73 73 20 64 65 66 65 72 72 65 64 20 rocess deferred
e6c0: 74 61 73 6b 73 20 70 65 72 20 61 62 6f 76 65 20 tasks per above
e6d0: 73 74 65 70 73 0a 0a 3b 3b 20 72 75 6e 20 61 6c steps..;; run al
e6e0: 6c 20 74 65 73 74 73 20 61 72 65 20 61 72 65 20 l tests are are
e6f0: 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e Not COMPLETED an
e700: 64 20 50 41 53 53 20 6f 72 20 43 48 45 43 4b 0a d PASS or CHECK.
e710: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
e720: 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 t-arg "-runall")
e730: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
e740: 22 2d 72 75 6e 22 29 0a 09 28 61 72 67 73 3a 67 "-run")..(args:g
e750: 65 74 2d 61 72 67 20 22 2d 72 65 72 75 6e 2d 63 et-arg "-rerun-c
e760: 6c 65 61 6e 22 29 0a 09 28 61 72 67 73 3a 67 65 lean")..(args:ge
e770: 74 2d 61 72 67 20 22 2d 72 65 72 75 6e 2d 61 6c t-arg "-rerun-al
e780: 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 l")..(args:get-a
e790: 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 29 rg "-runtests"))
e7a0: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
e7b0: 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 n-call . "-r
e7c0: 75 6e 61 6c 6c 22 0a 20 20 20 20 20 22 72 75 6e unall". "run
e7d0: 20 61 6c 6c 20 74 65 73 74 73 22 0a 20 20 20 20 all tests".
e7e0: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
e7f0: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
e800: 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 69 yvals). (i
e810: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
e820: 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 22 29 20 "-rerun-clean")
e830: 3b 3b 20 66 69 72 73 74 20 73 65 74 20 73 74 61 ;; first set sta
e840: 74 65 73 2f 73 74 61 74 75 73 65 73 20 63 6f 72 tes/statuses cor
e850: 72 65 63 74 0a 09 20 20 20 28 6c 65 74 20 28 28 rect.. (let ((
e860: 73 74 61 74 65 73 20 20 20 28 6f 72 20 28 63 6f states (or (co
e870: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f nfigf:lookup *co
e880: 6e 66 69 67 64 61 74 2a 20 22 76 61 6c 69 64 76 nfigdat* "validv
e890: 61 6c 75 65 73 22 20 22 63 6c 65 61 6e 72 65 72 alues" "cleanrer
e8a0: 75 6e 2d 73 74 61 74 65 73 22 29 0a 09 09 09 20 un-states")....
e8b0: 20 20 20 20 20 20 22 4b 49 4c 4c 52 45 51 2c 4b "KILLREQ,K
e8c0: 49 4c 4c 45 44 2c 55 4e 4b 4e 4f 57 4e 2c 49 4e ILLED,UNKNOWN,IN
e8d0: 43 4f 4d 50 4c 45 54 45 2c 53 54 55 43 4b 2c 4e COMPLETE,STUCK,N
e8e0: 4f 54 5f 53 54 41 52 54 45 44 22 29 29 0a 09 09 OT_STARTED"))...
e8f0: 20 28 73 74 61 74 75 73 65 73 20 28 6f 72 20 28 (statuses (or (
e900: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a configf:lookup *
e910: 63 6f 6e 66 69 67 64 61 74 2a 20 22 76 61 6c 69 configdat* "vali
e920: 64 76 61 6c 75 65 73 22 20 22 63 6c 65 61 6e 72 dvalues" "cleanr
e930: 65 72 75 6e 2d 73 74 61 74 75 73 65 73 22 29 0a erun-statuses").
e940: 09 09 09 20 20 20 20 20 20 20 22 46 41 49 4c 2c ... "FAIL,
e950: 49 4e 43 4f 4d 50 4c 45 54 45 2c 41 42 4f 52 54 INCOMPLETE,ABORT
e960: 2c 43 48 45 43 4b 22 29 29 29 0a 09 20 20 20 20 ,CHECK")))..
e970: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
e980: 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 ! args:arg-hash
e990: 22 2d 70 72 65 63 6c 65 61 6e 22 20 23 74 29 0a "-preclean" #t).
e9a0: 09 20 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 . (runs:oper
e9b0: 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 ate-on 'set-stat
e9c0: 65 2d 73 74 61 74 75 73 0a 09 09 09 20 20 20 20 e-status....
e9d0: 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 target....
e9e0: 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 (common:args-g
e9f0: 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 et-runname) ;;
ea00: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
ea10: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 g "-runname")(ar
ea20: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
ea30: 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 name"))....
ea40: 20 22 25 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a "%" ;; (common:
ea50: 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 args-get-testpat
ea60: 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 t #f) ;; (args:g
ea70: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
ea80: 74 22 29 0a 09 09 09 20 20 20 20 20 20 73 74 61 t").... sta
ea90: 74 65 3a 20 20 73 74 61 74 65 73 0a 09 09 09 20 te: states....
eaa0: 20 20 20 20 20 3b 3b 20 73 74 61 74 75 73 3a 20 ;; status:
eab0: 73 74 61 74 75 73 65 73 0a 09 09 09 20 20 20 20 statuses....
eac0: 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 new-state-stat
ead0: 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 us: "NOT_STARTED
eae0: 2c 6e 2f 61 22 29 0a 09 20 20 20 20 20 28 72 75 ,n/a").. (ru
eaf0: 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 ns:operate-on 's
eb00: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a et-state-status.
eb10: 09 09 09 20 20 20 20 20 20 74 61 72 67 65 74 0a ... target.
eb20: 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e ... (common
eb30: 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d :args-get-runnam
eb40: 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 e) ;; (or (args
eb50: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 :get-arg "-runna
eb60: 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 me")(args:get-ar
eb70: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g ":runname"))..
eb80: 09 09 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 .. "%" ;; (
eb90: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
eba0: 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 testpatt #f) ;;
ebb0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
ebc0: 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 testpatt")....
ebd0: 20 20 20 20 3b 3b 20 73 74 61 74 65 3a 20 20 73 ;; state: s
ebe0: 74 61 74 65 73 0a 09 09 09 20 20 20 20 20 20 73 tates.... s
ebf0: 74 61 74 75 73 3a 20 73 74 61 74 75 73 65 73 0a tatus: statuses.
ec00: 09 09 09 20 20 20 20 20 20 6e 65 77 2d 73 74 61 ... new-sta
ec10: 74 65 2d 73 74 61 74 75 73 3a 20 22 4e 4f 54 5f te-status: "NOT_
ec20: 53 54 41 52 54 45 44 2c 6e 2f 61 22 29 29 29 0a STARTED,n/a"))).
ec30: 20 20 20 20 20 20 20 3b 3b 20 52 45 52 55 4e 20 ;; RERUN
ec40: 41 4c 4c 0a 20 20 20 20 20 20 20 28 69 66 20 28 ALL. (if (
ec50: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
ec60: 65 72 75 6e 2d 61 6c 6c 22 29 20 3b 3b 20 66 69 erun-all") ;; fi
ec70: 72 73 74 20 73 65 74 20 73 74 61 74 65 73 2f 73 rst set states/s
ec80: 74 61 74 75 73 65 73 20 63 6f 72 72 65 63 74 0a tatuses correct.
ec90: 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 . (begin..
eca0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
ecb0: 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 ! args:arg-hash
ecc0: 22 2d 70 72 65 63 6c 65 61 6e 22 20 23 74 29 0a "-preclean" #t).
ecd0: 09 20 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 . (runs:oper
ece0: 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 ate-on 'set-stat
ecf0: 65 2d 73 74 61 74 75 73 0a 09 09 09 20 20 20 20 e-status....
ed00: 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 target....
ed10: 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 (common:args-g
ed20: 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 et-runname) ;;
ed30: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
ed40: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 g "-runname")(ar
ed50: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
ed60: 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 name"))....
ed70: 20 22 25 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a "%" ;; (common:
ed80: 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 args-get-testpat
ed90: 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 t #f) ;; (args:g
eda0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
edb0: 74 22 29 0a 09 09 09 20 20 20 20 20 20 73 74 61 t").... sta
edc0: 74 65 3a 20 20 23 66 0a 09 09 09 20 20 20 20 20 te: #f....
edd0: 20 3b 3b 20 73 74 61 74 75 73 3a 20 73 74 61 74 ;; status: stat
ede0: 75 73 65 73 0a 09 09 09 20 20 20 20 20 20 6e 65 uses.... ne
edf0: 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a 20 w-state-status:
ee00: 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 "NOT_STARTED,n/a
ee10: 22 29 0a 09 20 20 20 20 20 28 72 75 6e 73 3a 6f ").. (runs:o
ee20: 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 perate-on 'set-s
ee30: 74 61 74 65 2d 73 74 61 74 75 73 0a 09 09 09 20 tate-status....
ee40: 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 20 target....
ee50: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 (common:arg
ee60: 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 s-get-runname)
ee70: 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 ;; (or (args:get
ee80: 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 -arg "-runname")
ee90: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
eea0: 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 runname"))....
eeb0: 20 20 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d 6d "%" ;; (comm
eec0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
eed0: 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 patt #f) ;; (arg
eee0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
eef0: 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 20 patt")....
ef00: 3b 3b 20 73 74 61 74 65 3a 20 20 73 74 61 74 65 ;; state: state
ef10: 73 0a 09 09 09 20 20 20 20 20 20 73 74 61 74 75 s.... statu
ef20: 73 3a 20 23 66 0a 09 09 09 20 20 20 20 20 20 6e s: #f.... n
ef30: 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a ew-state-status:
ef40: 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f "NOT_STARTED,n/
ef50: 61 22 29 29 29 0a 20 20 20 20 20 20 20 28 72 75 a"))). (ru
ef60: 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 72 ns:run-tests tar
ef70: 67 65 74 0a 09 09 20 20 20 20 20 20 20 72 75 6e get... run
ef80: 6e 61 6d 65 0a 09 09 20 20 20 20 20 20 20 23 66 name... #f
ef90: 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 ;; (common:args
efa0: 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 -get-testpatt #f
efb0: 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 28 6f )... ;; (o
efc0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
efd0: 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 20 "-testpatt")...
efe0: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 22 25 22 ;; "%"
eff0: 29 0a 09 09 20 20 20 20 20 20 20 75 73 65 72 0a )... user.
f000: 09 09 20 20 20 20 20 20 20 61 72 67 73 3a 61 72 .. args:ar
f010: 67 2d 68 61 73 68 29 29 29 29 0a 0a 3b 3b 3d 3d g-hash))))..;;==
f020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f060: 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e 20 6f 6e 65 20 ====.;; run one
f070: 74 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d test.;;=========
f080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f0a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f0b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
f0c0: 3b 20 31 2e 20 66 69 6e 64 20 74 68 65 20 63 6f ; 1. find the co
f0d0: 6e 66 69 67 20 66 69 6c 65 0a 3b 3b 20 32 2e 20 nfig file.;; 2.
f0e0: 63 68 61 6e 67 65 20 74 6f 20 74 68 65 20 74 65 change to the te
f0f0: 73 74 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 st directory.;;
f100: 33 2e 20 75 70 64 61 74 65 20 74 68 65 20 64 62 3. update the db
f110: 20 77 69 74 68 20 22 74 65 73 74 20 73 74 61 72 with "test star
f120: 74 65 64 22 20 73 74 61 74 75 73 2c 20 73 65 74 ted" status, set
f130: 20 72 75 6e 6e 69 6e 67 20 68 6f 73 74 0a 3b 3b running host.;;
f140: 20 34 2e 20 70 72 6f 63 65 73 73 20 6c 61 75 6e 4. process laun
f150: 63 68 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 ch the test.;;
f160: 20 20 2d 20 6d 6f 6e 69 74 6f 72 20 74 68 65 20 - monitor the
f170: 70 72 6f 63 65 73 73 2c 20 75 70 64 61 74 65 20 process, update
f180: 73 74 61 74 73 20 69 6e 20 74 68 65 20 64 62 20 stats in the db
f190: 65 76 65 72 79 20 32 5e 6e 20 6d 69 6e 75 74 65 every 2^n minute
f1a0: 73 0a 3b 3b 20 35 2e 20 61 73 20 74 68 65 20 74 s.;; 5. as the t
f1b0: 65 73 74 20 70 72 6f 63 65 65 64 73 20 69 6e 74 est proceeds int
f1c0: 65 72 6e 61 6c 6c 79 20 69 74 20 63 61 6c 6c 73 ernally it calls
f1d0: 20 6d 65 67 61 74 65 73 74 20 61 73 20 65 61 63 megatest as eac
f1e0: 68 20 73 74 65 70 20 69 73 0a 3b 3b 20 20 20 20 h step is.;;
f1f0: 73 74 61 72 74 65 64 20 61 6e 64 20 63 6f 6d 70 started and comp
f200: 6c 65 74 65 64 0a 3b 3b 20 20 20 20 2d 20 73 74 leted.;; - st
f210: 65 70 20 73 74 61 72 74 65 64 2c 20 74 69 6d 65 ep started, time
f220: 73 74 61 6d 70 0a 3b 3b 20 20 20 20 2d 20 73 74 stamp.;; - st
f230: 65 70 20 63 6f 6d 70 6c 65 74 65 64 2c 20 65 78 ep completed, ex
f240: 69 74 20 73 74 61 74 75 73 2c 20 74 69 6d 65 73 it status, times
f250: 74 61 6d 70 0a 3b 3b 20 36 2e 20 74 65 73 74 20 tamp.;; 6. test
f260: 70 68 6f 6e 65 20 68 6f 6d 65 0a 3b 3b 20 20 20 phone home.;;
f270: 20 2d 20 69 66 20 74 65 73 74 20 72 75 6e 20 74 - if test run t
f280: 69 6d 65 20 3e 20 61 6c 6c 6f 77 65 64 20 72 75 ime > allowed ru
f290: 6e 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c n time then kill
f2a0: 20 6a 6f 62 0a 3b 3b 20 20 20 20 2d 20 69 66 20 job.;; - if
f2b0: 63 61 6e 6e 6f 74 20 61 63 63 65 73 73 20 64 62 cannot access db
f2c0: 20 3e 20 61 6c 6c 6f 77 65 64 20 64 69 73 63 6f > allowed disco
f2d0: 6e 6e 65 63 74 20 74 69 6d 65 20 74 68 65 6e 20 nnect time then
f2e0: 6b 69 6c 6c 20 6a 6f 62 0a 0a 3b 3b 20 3d 3d 20 kill job..;; ==
f2f0: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 28 69 duplicated == (i
f300: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
f310: 61 72 67 20 22 2d 72 75 6e 22 29 28 61 72 67 73 arg "-run")(args
f320: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
f330: 73 74 73 22 29 29 0a 3b 3b 20 3d 3d 20 64 75 70 sts")).;; == dup
f340: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 28 67 65 licated == (ge
f350: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
f360: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f370: 20 3d 3d 20 20 20 20 22 2d 72 75 6e 74 65 73 74 == "-runtest
f380: 73 22 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 s" .;; == duplic
f390: 61 74 65 64 20 3d 3d 20 20 20 20 22 72 75 6e 20 ated == "run
f3a0: 61 20 74 65 73 74 22 20 0a 3b 3b 20 3d 3d 20 64 a test" .;; == d
f3b0: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
f3c0: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
f3d0: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
f3e0: 76 61 6c 73 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c vals).;; == dupl
f3f0: 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b icated == ;
f400: 3b 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 ;.;; == duplicat
f410: 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 4d 61 ed == ;; Ma
f420: 79 20 6f 72 20 6d 61 79 20 6e 6f 74 20 69 6d 70 y or may not imp
f430: 6c 65 6d 65 6e 74 20 69 74 20 74 68 69 73 20 77 lement it this w
f440: 61 79 20 2e 2e 2e 0a 3b 3b 20 3d 3d 20 64 75 70 ay ....;; == dup
f450: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 licated ==
f460: 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 ;;.;; == duplica
f470: 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 49 ted == ;; I
f480: 6e 73 65 72 74 20 74 68 69 73 20 72 75 6e 20 69 nsert this run i
f490: 6e 74 6f 20 74 68 65 20 74 61 73 6b 73 20 71 75 nto the tasks qu
f4a0: 65 75 65 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 eue.;; == duplic
f4b0: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 ated == ;;
f4c0: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
f4d0: 74 61 73 6b 73 3a 61 64 64 20 74 61 73 6b 73 3a tasks:add tasks:
f4e0: 6f 70 65 6e 2d 64 62 20 0a 3b 3b 20 3d 3d 20 64 open-db .;; == d
f4f0: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
f500: 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 22 72 ;; . "r
f510: 75 6e 74 65 73 74 73 22 20 0a 3b 3b 20 3d 3d 20 untests" .;; ==
f520: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
f530: 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 75 ;; . u
f540: 73 65 72 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 ser.;; == duplic
f550: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 ated == ;;
f560: 20 20 20 09 20 20 20 20 20 74 61 72 67 65 74 0a . target.
f570: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f580: 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 == ;; .
f590: 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a 3b 3b 20 runname.;;
f5a0: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f5b0: 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 ;; .
f5c0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
f5d0: 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 3b 3b 20 "-runtests").;;
f5e0: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f5f0: 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 ;; .
f600: 20 20 23 66 29 29 29 29 0a 3b 3b 20 3d 3d 20 64 #f)))).;; == d
f610: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
f620: 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 (runs:run-test
f630: 73 20 74 61 72 67 65 74 0a 3b 3b 20 3d 3d 20 64 s target.;; == d
f640: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 20 uplicated == ..
f650: 20 20 20 20 72 75 6e 6e 61 6d 65 0a 3b 3b 20 3d runname.;; =
f660: 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
f670: 09 09 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 .. (common:a
f680: 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 rgs-get-testpatt
f690: 20 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 #f) ;; (args:ge
f6a0: 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 t-arg "-runtests
f6b0: 22 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 ").;; == duplica
f6c0: 74 65 64 20 3d 3d 20 09 09 20 20 20 20 20 75 73 ted == .. us
f6d0: 65 72 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 er.;; == duplica
f6e0: 74 65 64 20 3d 3d 20 09 09 20 20 20 20 20 61 72 ted == .. ar
f6f0: 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 29 0a gs:arg-hash)))).
f700: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
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 0a 3b 3b 20 52 6f 6c =========.;; Rol
f750: 6c 75 70 20 69 6e 74 6f 20 61 20 72 75 6e 0a 3b lup into a run.;
f760: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
f770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f7a0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
f7b0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 6f 6c gs:get-arg "-rol
f7c0: 6c 75 70 22 29 0a 20 20 20 20 28 67 65 6e 65 72 lup"). (gener
f7d0: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 al-run-call .
f7e0: 20 20 22 2d 72 6f 6c 6c 75 70 22 20 0a 20 20 20 "-rollup" .
f7f0: 20 20 22 72 6f 6c 6c 75 70 20 74 65 73 74 73 22 "rollup tests"
f800: 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
f810: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
f820: 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 eys keyvals).
f830: 20 20 20 20 28 72 75 6e 73 3a 72 6f 6c 6c 75 70 (runs:rollup
f840: 2d 72 75 6e 20 6b 65 79 73 0a 09 09 09 6b 65 79 -run keys....key
f850: 76 61 6c 73 0a 09 09 09 28 6f 72 20 28 61 72 67 vals....(or (arg
f860: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
f870: 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 ame")(args:get-a
f880: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 29 rg ":runname") )
f890: 0a 09 09 09 75 73 65 72 29 29 29 29 0a 0a 3b 3b ....user))))..;;
f8a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8e0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 6f 63 6b 20 6f ======.;; Lock o
f8f0: 72 20 75 6e 6c 6f 63 6b 20 61 20 72 75 6e 0a 3b r unlock a run.;
f900: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
f910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f940: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 =======..(if (or
f950: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
f960: 2d 6c 6f 63 6b 22 29 28 61 72 67 73 3a 67 65 74 -lock")(args:get
f970: 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b 22 29 29 -arg "-unlock"))
f980: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
f990: 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 28 69 66 n-call . (if
f9a0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
f9b0: 2d 6c 6f 63 6b 22 29 20 22 2d 6c 6f 63 6b 22 20 -lock") "-lock"
f9c0: 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 20 20 20 20 "-unlock").
f9d0: 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 20 74 65 73 "lock/unlock tes
f9e0: 74 73 22 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 ts" . (lambd
f9f0: 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
fa00: 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a e keys keyvals).
fa10: 20 20 20 20 20 20 20 28 72 75 6e 73 3a 68 61 6e (runs:han
fa20: 64 6c 65 2d 6c 6f 63 6b 69 6e 67 20 0a 09 09 20 dle-locking ...
fa30: 20 74 61 72 67 65 74 0a 09 09 20 20 6b 65 79 73 target... keys
fa40: 0a 09 09 20 20 28 6f 72 20 28 61 72 67 73 3a 67 ... (or (args:g
fa50: 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 et-arg "-runname
fa60: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
fa70: 22 3a 72 75 6e 6e 61 6d 65 22 29 20 29 0a 09 09 ":runname") )...
fa80: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
fa90: 22 2d 6c 6f 63 6b 22 29 0a 09 09 20 20 28 61 72 "-lock")... (ar
faa0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c gs:get-arg "-unl
fab0: 6f 63 6b 22 29 0a 09 09 20 20 75 73 65 72 29 29 ock")... user))
fac0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
fad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
faf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
fb10: 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 Get paths to tes
fb20: 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ts.;;===========
fb30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 ===========.;; G
fb70: 65 74 20 74 65 73 74 20 70 61 74 68 73 20 6d 61 et test paths ma
fb80: 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 tching target, r
fb90: 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 65 73 74 unname, and test
fba0: 70 61 74 74 0a 28 69 66 20 28 6f 72 20 28 61 72 patt.(if (or (ar
fbb0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
fbc0: 74 2d 66 69 6c 65 73 22 29 28 61 72 67 73 3a 67 t-files")(args:g
fbd0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 70 61 et-arg "-test-pa
fbe0: 74 68 73 22 29 29 0a 20 20 20 20 3b 3b 20 69 66 ths")). ;; if
fbf0: 20 77 65 20 61 72 65 20 69 6e 20 61 20 74 65 73 we are in a tes
fc00: 74 20 75 73 65 20 74 68 65 20 4d 54 5f 43 4d 44 t use the MT_CMD
fc10: 49 4e 46 4f 20 64 61 74 61 0a 20 20 20 20 28 69 INFO data. (i
fc20: 66 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d f (getenv "MT_CM
fc30: 44 49 4e 46 4f 22 29 0a 09 28 6c 65 74 2a 20 28 DINFO")..(let* (
fc40: 28 73 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 (startingdir (cu
fc50: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
fc60: 29 0a 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e ).. (cmdin
fc70: 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 fo (common:rea
fc80: 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 d-encoded-string
fc90: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
fca0: 49 4e 46 4f 22 29 29 29 0a 09 20 20 20 20 20 20 INFO")))..
fcb0: 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 (transport (ass
fcc0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e oc/default 'tran
fcd0: 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a sport cmdinfo)).
fce0: 09 20 20 20 20 20 20 20 28 74 65 73 74 70 61 74 . (testpat
fcf0: 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c h (assoc/defaul
fd00: 74 20 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 t 'testpath cmd
fd10: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
fd20: 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 test-name (assoc
fd30: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e /default 'test-n
fd40: 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ame cmdinfo))..
fd50: 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 (runscript
fd60: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
fd70: 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 'runscript cmdin
fd80: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 fo)).. (db
fd90: 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 -host (assoc/d
fda0: 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 efault 'db-host
fdb0: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
fdc0: 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 (run-id (
fdd0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
fde0: 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f un-id cmdinfo
fdf0: 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d )).. (item
fe00: 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 dat (assoc/def
fe10: 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 ault 'itemdat
fe20: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
fe30: 20 20 28 73 74 61 74 65 20 20 20 20 20 28 61 72 (state (ar
fe40: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
fe50: 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 te")).. (s
fe60: 74 61 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 tatus (args:g
fe70: 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 et-arg ":status"
fe80: 29 29 0a 09 20 20 20 20 20 20 20 28 74 61 72 67 )).. (targ
fe90: 65 74 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d et (args:get-
fea0: 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 29 0a arg "-target")).
feb0: 09 20 20 20 20 20 20 20 28 74 6f 70 70 61 74 68 . (toppath
fec0: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
fed0: 74 20 27 74 6f 70 70 61 74 68 20 20 20 63 6d 64 t 'toppath cmd
fee0: 69 6e 66 6f 29 29 29 0a 09 20 20 28 63 68 61 6e info))).. (chan
fef0: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 ge-directory top
ff00: 70 61 74 68 29 0a 09 20 20 28 69 66 20 28 6e 6f path).. (if (no
ff10: 74 20 74 61 72 67 65 74 29 0a 09 20 20 20 20 20 t target)..
ff20: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
ff30: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
ff40: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
ff50: 2a 20 22 2d 74 61 72 67 65 74 20 69 73 20 72 65 * "-target is re
ff60: 71 75 69 72 65 64 2e 22 29 0a 09 09 28 65 78 69 quired.")...(exi
ff70: 74 20 31 29 29 29 0a 09 20 20 28 69 66 20 28 6e t 1))).. (if (n
ff80: 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 ot (launch:setup
ff90: 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e )).. (begin
ffa0: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
ffb0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
ffc0: 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 ort* "Failed to
ffd0: 73 65 74 75 70 2c 20 67 69 76 69 6e 67 20 75 70 setup, giving up
ffe0: 20 6f 6e 20 2d 74 65 73 74 2d 70 61 74 68 73 20 on -test-paths
fff0: 6f 72 20 2d 74 65 73 74 2d 66 69 6c 65 73 2c 20 or -test-files,
10000 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 69 exiting")...(exi
10010 74 20 31 29 29 29 0a 09 20 20 28 6c 65 74 2a 20 t 1))).. (let*
10020 28 28 6b 65 79 73 20 20 20 20 20 28 72 6d 74 3a ((keys (rmt:
10030 67 65 74 2d 6b 65 79 73 29 29 0a 09 09 20 3b 3b get-keys))... ;;
10040 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 db:test-get-pat
10050 68 73 20 6d 75 73 74 20 6e 6f 74 20 62 65 20 72 hs must not be r
10060 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 28 70 61 un remote... (pa
10070 74 68 73 20 20 20 20 28 74 65 73 74 73 3a 74 65 ths (tests:te
10080 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 st-get-paths-mat
10090 63 68 69 6e 67 20 6b 65 79 73 20 74 61 72 67 65 ching keys targe
100a0 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
100b0 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 29 29 29 "-test-files")))
100c0 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 69 ).. (set! *di
100d0 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a dsomething* #t).
100e0 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 . (for-each (
100f0 6c 61 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 lambda (path)...
10100 09 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 .(if (file-exist
10110 73 3f 20 70 61 74 68 29 0a 09 09 09 28 70 72 69 s? path)....(pri
10120 6e 74 20 70 61 74 68 29 29 29 09 0a 09 09 20 20 nt path)))....
10130 20 20 20 20 70 61 74 68 73 29 29 29 0a 09 3b 3b paths)))..;;
10140 20 65 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 72 else do a gener
10150 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 al-run-call..(ge
10160 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
10170 09 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 0a . "-test-files".
10180 09 20 22 47 65 74 20 70 61 74 68 73 20 74 6f 20 . "Get paths to
10190 74 65 73 74 22 0a 09 20 28 6c 61 6d 62 64 61 20 test".. (lambda
101a0 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 (target runname
101b0 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 09 20 keys keyvals)..
101c0 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 20 (let* ((db
101d0 20 20 20 23 66 29 0a 09 09 20 20 3b 3b 20 44 4f #f)... ;; DO
101e0 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a NOT run remote.
101f0 09 09 20 20 28 70 61 74 68 73 20 20 20 20 28 74 .. (paths (t
10200 65 73 74 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 ests:test-get-pa
10210 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 6b 65 79 ths-matching key
10220 73 20 74 61 72 67 65 74 20 28 61 72 67 73 3a 67 s target (args:g
10230 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 et-arg "-test-fi
10240 6c 65 73 22 29 29 29 29 0a 09 20 20 20 20 20 28 les")))).. (
10250 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
10260 20 28 70 61 74 68 29 0a 09 09 09 20 28 70 72 69 (path).... (pri
10270 6e 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 nt path))...
10280 20 20 20 70 61 74 68 73 29 29 29 29 29 29 0a 0a paths))))))..
10290 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
102a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
102b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
102c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
102d0 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 ========.;; Arch
102e0 69 76 65 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d ive tests.;;====
102f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10300 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10310 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10320 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10330 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 20 74 65 ==.;; Archive te
10340 73 74 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 sts matching tar
10350 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e get, runname, an
10360 64 20 74 65 73 74 70 61 74 74 0a 28 69 66 20 28 d testpatt.(if (
10370 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 61 args:get-arg "-a
10380 72 63 68 69 76 65 22 29 0a 20 20 20 20 3b 3b 20 rchive"). ;;
10390 65 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 else do a genera
103a0 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 28 l-run-call. (
103b0 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
103c0 20 0a 20 20 20 20 20 22 2d 61 72 63 68 69 76 65 . "-archive
103d0 22 0a 20 20 20 20 20 22 41 72 63 68 69 76 65 22 ". "Archive"
103e0 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 . (lambda (t
103f0 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
10400 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 ys keyvals).
10410 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 (operate-on '
10420 61 72 63 68 69 76 65 29 29 29 29 0a 0a 3b 3b 3d archive))))..;;=
10430 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10440 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10450 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10460 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10470 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 74 72 61 63 74 =====.;; Extract
10480 20 61 20 73 70 72 65 61 64 73 68 65 65 74 20 66 a spreadsheet f
10490 72 6f 6d 20 74 68 65 20 72 75 6e 73 20 64 61 74 rom the runs dat
104a0 61 62 61 73 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d abase.;;========
104b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
104f0 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
10500 67 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 g "-extract-ods"
10510 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 ). (general-r
10520 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 20 22 2d 65 un-call. "-e
10530 78 74 72 61 63 74 2d 6f 64 73 22 0a 20 20 20 20 xtract-ods".
10540 20 22 4d 61 6b 65 20 6f 64 73 20 73 70 72 65 61 "Make ods sprea
10550 64 73 68 65 65 74 22 0a 20 20 20 20 20 28 6c 61 dsheet". (la
10560 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
10570 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c name keys keyval
10580 73 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 s). (let (
10590 28 64 62 73 74 72 75 63 74 20 20 20 28 6d 61 6b (dbstruct (mak
105a0 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 e-dbr:dbstruct p
105b0 61 74 68 3a 20 2a 74 6f 70 70 61 74 68 2a 20 6c ath: *toppath* l
105c0 6f 63 61 6c 3a 20 23 74 29 29 0a 09 20 20 20 20 ocal: #t))..
105d0 20 28 6f 75 74 70 75 74 66 69 6c 65 20 28 61 72 (outputfile (ar
105e0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 74 gs:get-arg "-ext
105f0 72 61 63 74 2d 6f 64 73 22 29 29 0a 09 20 20 20 ract-ods"))..
10600 20 20 28 72 75 6e 73 70 61 74 74 20 20 20 28 6f (runspatt (o
10610 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
10620 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 "-runname")(args
10630 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
10640 6d 65 22 29 29 29 0a 09 20 20 20 20 20 28 70 61 me"))).. (pa
10650 74 68 6d 6f 64 20 20 20 20 28 61 72 67 73 3a 67 thmod (args:g
10660 65 74 2d 61 72 67 20 22 2d 70 61 74 68 6d 6f 64 et-arg "-pathmod
10670 22 29 29 29 0a 09 20 20 20 20 20 3b 3b 20 28 6b "))).. ;; (k
10680 65 79 76 61 6c 61 6c 69 73 74 20 28 6b 65 79 73 eyvalalist (keys
10690 2d 3e 61 6c 69 73 74 20 6b 65 79 73 20 22 25 22 ->alist keys "%"
106a0 29 29 29 0a 09 20 28 64 65 62 75 67 3a 70 72 69 ))).. (debug:pri
106b0 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 2 *default-lo
106c0 67 2d 70 6f 72 74 2a 20 22 45 78 74 72 61 63 74 g-port* "Extract
106d0 20 6f 64 73 2c 20 6f 75 74 70 75 74 66 69 6c 65 ods, outputfile
106e0 3a 20 22 20 6f 75 74 70 75 74 66 69 6c 65 20 22 : " outputfile "
106f0 20 72 75 6e 73 70 61 74 74 3a 20 22 20 72 75 6e runspatt: " run
10700 73 70 61 74 74 20 22 20 6b 65 79 76 61 6c 73 3a spatt " keyvals:
10710 20 22 20 6b 65 79 76 61 6c 73 29 0a 09 20 28 64 " keyvals).. (d
10720 62 3a 65 78 74 72 61 63 74 2d 6f 64 73 2d 66 69 b:extract-ods-fi
10730 6c 65 20 64 62 73 74 72 75 63 74 20 6f 75 74 70 le dbstruct outp
10740 75 74 66 69 6c 65 20 6b 65 79 76 61 6c 73 20 28 utfile keyvals (
10750 69 66 20 72 75 6e 73 70 61 74 74 20 72 75 6e 73 if runspatt runs
10760 70 61 74 74 20 22 25 22 29 20 70 61 74 68 6d 6f patt "%") pathmo
10770 64 29 0a 09 20 28 64 62 3a 63 6c 6f 73 65 2d 61 d).. (db:close-a
10780 6c 6c 20 64 62 73 74 72 75 63 74 29 0a 09 20 28 ll dbstruct).. (
10790 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
107a0 6e 67 2a 20 23 74 29 29 29 29 29 0a 0a 3b 3b 3d ng* #t)))))..;;=
107b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107f0 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 63 75 74 65 =====.;; execute
10800 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 the test.;;
10810 2d 20 67 65 74 73 20 63 61 6c 6c 65 64 20 6f 6e - gets called on
10820 20 72 65 6d 6f 74 65 20 68 6f 73 74 0a 3b 3b 20 remote host.;;
10830 20 20 20 2d 20 72 65 63 65 69 76 65 73 20 69 6e - receives in
10840 66 6f 20 66 72 6f 6d 20 74 68 65 20 2d 65 78 65 fo from the -exe
10850 63 75 74 65 20 70 61 72 61 6d 0a 3b 3b 20 20 20 cute param.;;
10860 20 2d 20 70 61 73 73 65 73 20 69 6e 66 6f 20 74 - passes info t
10870 6f 20 73 74 65 70 73 20 76 69 61 20 4d 54 5f 43 o steps via MT_C
10880 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 28 MDINFO env var (
10890 66 75 74 75 72 65 20 69 73 20 74 6f 20 75 73 65 future is to use
108a0 20 61 20 64 6f 74 20 66 69 6c 65 29 0a 3b 3b 20 a dot file).;;
108b0 20 20 20 2d 20 67 61 74 68 65 72 73 20 68 6f 73 - gathers hos
108c0 74 20 69 6e 66 6f 20 61 6e 64 20 0a 3b 3b 3d 3d t info and .;;==
108d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10900 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10910 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
10920 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 get-arg "-execut
10930 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 e"). (begin.
10940 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 65 78 65 (launch:exe
10950 63 75 74 65 20 28 61 72 67 73 3a 67 65 74 2d 61 cute (args:get-a
10960 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 29 0a rg "-execute")).
10970 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
10980 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
10990 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 65 ==========.;; re
109e0 63 6f 76 65 72 20 66 72 6f 6d 20 61 20 74 65 73 cover from a tes
109f0 74 20 77 68 65 72 65 20 74 68 65 20 6d 61 6e 61 t where the mana
10a00 67 69 6e 67 20 6d 74 65 73 74 20 77 61 73 20 6b ging mtest was k
10a10 69 6c 6c 65 64 20 62 75 74 20 74 68 65 20 75 6e illed but the un
10a20 64 65 72 6c 79 69 6e 67 0a 3b 3b 20 70 72 6f 63 derlying.;; proc
10a30 65 73 73 20 6d 69 67 68 74 20 73 74 69 6c 6c 20 ess might still
10a40 62 65 20 73 61 6c 76 61 67 65 61 62 6c 65 0a 3b be salvageable.;
10a50 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
10a60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a90 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
10aa0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 63 gs:get-arg "-rec
10ab0 6f 76 65 72 2d 74 65 73 74 22 29 0a 20 20 20 20 over-test").
10ac0 28 6c 65 74 2a 20 28 28 70 61 72 61 6d 73 20 28 (let* ((params (
10ad0 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 61 72 string-split (ar
10ae0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 63 gs:get-arg "-rec
10af0 6f 76 65 72 2d 74 65 73 74 22 29 20 22 2c 22 29 over-test") ",")
10b00 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 3e 20 )). (if (>
10b10 28 6c 65 6e 67 74 68 20 70 61 72 61 6d 73 29 20 (length params)
10b20 31 29 20 3b 3b 20 72 75 6e 2d 69 64 20 61 6e 64 1) ;; run-id and
10b30 20 74 65 73 74 2d 69 64 0a 09 20 20 28 6c 65 74 test-id.. (let
10b40 20 28 28 72 75 6e 2d 69 64 20 28 73 74 72 69 6e ((run-id (strin
10b50 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 72 20 70 g->number (car p
10b60 61 72 61 6d 73 29 29 29 0a 09 09 28 74 65 73 74 arams)))...(test
10b70 2d 69 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d -id (string->num
10b80 62 65 72 20 28 63 61 64 72 20 70 61 72 61 6d 73 ber (cadr params
10b90 29 29 29 29 0a 09 20 20 20 20 28 69 66 20 28 61 )))).. (if (a
10ba0 6e 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 nd run-id test-i
10bb0 64 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 d)...(begin...
10bc0 28 6c 61 75 6e 63 68 3a 72 65 63 6f 76 65 72 2d (launch:recover-
10bd0 74 65 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 test run-id test
10be0 2d 69 64 29 0a 09 09 20 20 28 73 65 74 21 20 2a -id)... (set! *
10bf0 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
10c00 29 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 ))...(begin...
10c10 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
10c20 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
10c30 67 2d 70 6f 72 74 2a 20 22 62 61 64 20 72 75 6e g-port* "bad run
10c40 2d 69 64 20 6f 72 20 74 65 73 74 2d 69 64 2c 20 -id or test-id,
10c50 6d 75 73 74 20 62 65 20 69 6e 74 65 67 65 72 73 must be integers
10c60 22 29 0a 09 09 20 20 28 65 78 69 74 20 31 29 29 ")... (exit 1))
10c70 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d )))))..;;=======
10c80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10ca0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10cb0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
10cc0 3b 3b 20 54 65 73 74 20 63 6f 6d 6d 61 6e 64 73 ;; Test commands
10cd0 20 28 69 2e 65 2e 20 66 6f 72 20 75 73 65 20 69 (i.e. for use i
10ce0 6e 73 69 64 65 20 74 65 73 74 73 29 0a 3b 3b 3d nside tests).;;=
10cf0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d30 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
10d40 6d 65 67 61 74 65 73 74 3a 73 74 65 70 20 73 74 megatest:step st
10d50 65 70 20 73 74 61 74 65 20 73 74 61 74 75 73 20 ep state status
10d60 6c 6f 67 66 69 6c 65 20 6d 73 67 29 0a 20 20 28 logfile msg). (
10d70 69 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 if (not (getenv
10d80 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 20 "MT_CMDINFO")).
10d90 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 (begin..(de
10da0 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
10db0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
10dc0 6f 72 74 2a 20 22 4d 54 5f 43 4d 44 49 4e 46 4f ort* "MT_CMDINFO
10dd0 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 env var not set
10de0 2c 20 2d 73 74 65 70 20 6d 75 73 74 20 62 65 20 , -step must be
10df0 63 61 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 called *inside*
10e00 61 20 6d 65 67 61 74 65 73 74 20 69 6e 76 6f 6b a megatest invok
10e10 65 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 ed environment!"
10e20 29 0a 09 28 65 78 69 74 20 35 29 29 0a 20 20 20 )..(exit 5)).
10e30 20 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e (let* ((cmdin
10e40 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 fo (common:rea
10e50 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 d-encoded-string
10e60 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
10e70 49 4e 46 4f 22 29 29 29 0a 09 20 20 20 20 20 28 INFO"))).. (
10e80 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 transport (assoc
10e90 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 /default 'transp
10ea0 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ort cmdinfo))..
10eb0 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 (testpath (
10ec0 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
10ed0 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
10ee0 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 2d 6e )).. (test-n
10ef0 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ame (assoc/defau
10f00 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d lt 'test-name cm
10f10 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 dinfo)).. (r
10f20 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f unscript (assoc/
10f30 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 default 'runscri
10f40 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 pt cmdinfo))..
10f50 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 (db-host (a
10f60 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 ssoc/default 'db
10f70 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 -host cmdinfo)
10f80 29 0a 09 20 20 20 20 20 28 72 75 6e 2d 69 64 20 ).. (run-id
10f90 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
10fa0 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 t 'run-id cmd
10fb0 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 info)).. (te
10fc0 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 st-id (assoc/d
10fd0 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 efault 'test-id
10fe0 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
10ff0 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
11000 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
11010 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
11020 0a 09 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 .. (work-are
11030 61 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 a (assoc/default
11040 20 27 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 'work-area cmdi
11050 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 64 62 20 nfo)).. (db
11060 20 20 20 20 20 20 20 23 66 29 29 0a 09 28 63 68 #f))..(ch
11070 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
11080 65 73 74 70 61 74 68 29 0a 09 28 69 66 20 28 6e estpath)..(if (n
11090 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 ot (launch:setup
110a0 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 )).. (begin..
110b0 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
110c0 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
110d0 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 g-port* "Failed
110e0 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
110f0 67 22 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 g").. (exit
11100 20 31 29 29 29 0a 09 28 69 66 20 28 61 6e 64 20 1)))..(if (and
11110 73 74 61 74 65 20 73 74 61 74 75 73 29 0a 09 20 state status)..
11120 20 20 20 28 6c 65 74 20 28 28 63 6f 6d 6d 65 6e (let ((commen
11130 74 20 28 6c 61 75 6e 63 68 3a 6c 6f 61 64 2d 6c t (launch:load-l
11140 6f 67 70 72 6f 2d 64 61 74 20 72 75 6e 2d 69 64 ogpro-dat run-id
11150 20 74 65 73 74 2d 69 64 20 73 74 65 70 29 29 29 test-id step)))
11160 0a 09 20 20 20 20 20 20 3b 3b 20 28 72 6d 74 3a .. ;; (rmt:
11170 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 test-set-log! ru
11180 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 28 63 6f n-id test-id (co
11190 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 nc stepname ".ht
111a0 6d 6c 22 29 29 29 29 0a 09 20 20 20 20 20 20 28 ml")))).. (
111b0 72 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 74 rmt:teststep-set
111c0 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 -status! run-id
111d0 74 65 73 74 2d 69 64 20 73 74 65 70 20 73 74 61 test-id step sta
111e0 74 65 20 73 74 61 74 75 73 20 28 6f 72 20 63 6f te status (or co
111f0 6d 6d 65 6e 74 20 6d 73 67 29 20 6c 6f 67 66 69 mment msg) logfi
11200 6c 65 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e le)).. (begin
11210 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
11220 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
11230 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
11240 22 59 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 "You must specif
11250 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 y :state and :st
11260 61 74 75 73 20 77 69 74 68 20 65 76 65 72 79 20 atus with every
11270 63 61 6c 6c 20 74 6f 20 2d 73 74 65 70 22 29 0a call to -step").
11280 09 20 20 20 20 20 20 28 65 78 69 74 20 36 29 29 . (exit 6))
11290 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a ))))..(if (args:
112a0 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 get-arg "-step")
112b0 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
112c0 20 20 28 6d 65 67 61 74 65 73 74 3a 73 74 65 70 (megatest:step
112d0 20 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 . (args:g
112e0 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a et-arg "-step").
112f0 20 20 20 20 20 20 20 28 6f 72 20 28 61 72 67 73 (or (args
11300 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 65 :get-arg "-state
11310 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
11320 22 3a 73 74 61 74 65 22 29 29 0a 20 20 20 20 20 ":state")).
11330 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d (or (args:get-
11340 61 72 67 20 22 2d 73 74 61 74 75 73 22 29 28 61 arg "-status")(a
11350 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
11360 61 74 75 73 22 29 29 0a 20 20 20 20 20 20 20 28 atus")). (
11370 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
11380 65 74 6c 6f 67 22 29 0a 20 20 20 20 20 20 20 28 etlog"). (
11390 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
113a0 22 29 29 0a 20 20 20 20 20 20 3b 3b 20 28 69 66 ")). ;; (if
113b0 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e db (sqlite3:fin
113c0 61 6c 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 alize! db)).
113d0 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
113e0 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 20 20 20 thing* #t))).
113f0 20 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a .(if (or (args:
11400 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 get-arg "-setlog
11410 22 29 20 20 20 20 20 20 20 3b 3b 20 73 69 6e 63 ") ;; sinc
11420 65 20 73 65 74 74 69 6e 67 20 75 70 20 69 73 20 e setting up is
11430 73 6f 20 63 6f 73 74 6c 79 20 6c 65 74 73 20 70 so costly lets p
11440 69 67 67 79 62 61 63 6b 20 6f 6e 20 2d 74 65 73 iggyback on -tes
11450 74 2d 73 74 61 74 75 73 0a 09 3b 3b 20 20 20 20 t-status..;;
11460 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d (not (args:get-
11470 61 72 67 20 22 2d 73 74 65 70 22 29 29 29 20 20 arg "-step")))
11480 3b 3b 20 2d 73 65 74 6c 6f 67 20 6d 61 79 20 68 ;; -setlog may h
11490 61 76 65 20 62 65 65 6e 20 70 72 6f 63 65 73 73 ave been process
114a0 65 64 20 61 6c 72 65 61 64 79 20 69 6e 20 74 68 ed already in th
114b0 65 20 22 2d 73 74 65 70 22 20 70 72 65 76 69 6f e "-step" previo
114c0 75 73 0a 09 3b 3b 20 20 20 20 20 4e 45 57 20 50 us..;; NEW P
114d0 4f 4c 49 43 59 20 2d 20 2d 73 65 74 6c 6f 67 20 OLICY - -setlog
114e0 73 65 74 73 20 74 65 73 74 20 6f 76 65 72 61 6c sets test overal
114f0 6c 20 6c 6f 67 20 6f 6e 20 65 76 65 72 79 20 63 l log on every c
11500 61 6c 6c 2e 0a 09 28 61 72 67 73 3a 67 65 74 2d all...(args:get-
11510 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 arg "-set-toplog
11520 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
11530 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 g "-test-status"
11540 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
11550 20 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 0a "-set-values").
11560 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
11570 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 -load-test-data"
11580 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
11590 20 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 28 61 "-runstep")..(a
115a0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 rgs:get-arg "-su
115b0 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 29 mmarize-items"))
115c0 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 67 . (if (not (g
115d0 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
115e0 4f 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 O"))..(begin..
115f0 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
11600 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
11610 67 2d 70 6f 72 74 2a 20 22 4d 54 5f 43 4d 44 49 g-port* "MT_CMDI
11620 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 NFO env var not
11630 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 set, commands -t
11640 65 73 74 2d 73 74 61 74 75 73 2c 20 2d 72 75 6e est-status, -run
11650 73 74 65 70 20 61 6e 64 20 2d 73 65 74 6c 6f 67 step and -setlog
11660 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 20 must be called
11670 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 74 *inside* a megat
11680 65 73 74 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 est environment!
11690 22 29 0a 09 20 20 28 65 78 69 74 20 35 29 29 0a ").. (exit 5)).
116a0 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e .(let* ((startin
116b0 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 gdir (current-di
116c0 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 rectory))..
116d0 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 63 6f (cmdinfo (co
116e0 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 mmon:read-encode
116f0 64 2d 73 74 72 69 6e 67 20 28 67 65 74 65 6e 76 d-string (getenv
11700 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 "MT_CMDINFO")))
11710 0a 09 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 .. (transp
11720 6f 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ort (assoc/defau
11730 6c 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d lt 'transport cm
11740 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
11750 28 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f (testpath (asso
11760 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 c/default 'testp
11770 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 ath cmdinfo))..
11780 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d (test-nam
11790 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 e (assoc/default
117a0 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 'test-name cmdi
117b0 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 nfo)).. (r
117c0 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f unscript (assoc/
117d0 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 default 'runscri
117e0 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 pt cmdinfo))..
117f0 20 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 (db-host
11800 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
11810 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 db-host cmdinf
11820 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
11830 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 -id (assoc/de
11840 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 fault 'run-id
11850 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
11860 20 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 (test-id (a
11870 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
11880 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 st-id cmdinfo)
11890 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 ).. (itemd
118a0 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 at (assoc/defa
118b0 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 ult 'itemdat c
118c0 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
118d0 20 28 77 6f 72 6b 2d 61 72 65 61 20 28 61 73 73 (work-area (ass
118e0 6f 63 2f 64 65 66 61 75 6c 74 20 27 77 6f 72 6b oc/default 'work
118f0 2d 61 72 65 61 20 63 6d 64 69 6e 66 6f 29 29 0a -area cmdinfo)).
11900 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 20 . (db
11910 20 20 20 23 66 29 20 3b 3b 20 28 6f 70 65 6e 2d #f) ;; (open-
11920 64 62 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 db)).. (st
11930 61 74 65 20 20 20 20 20 28 61 72 67 73 3a 67 65 ate (args:ge
11940 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 t-arg ":state"))
11950 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 .. (status
11960 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
11970 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a 09 20 g ":status"))..
11980 20 20 20 20 20 20 28 73 74 65 70 6e 61 6d 65 20 (stepname
11990 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
119a0 2d 73 74 65 70 22 29 29 29 0a 09 20 20 28 69 66 -step"))).. (if
119b0 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
119c0 74 75 70 29 29 0a 09 20 20 20 20 20 20 28 62 65 tup)).. (be
119d0 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 gin...(debug:pri
119e0 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
119f0 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 g-port* "Failed
11a00 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
11a10 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 g")...(exit 1)))
11a20 0a 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 ... (if (args:g
11a30 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 et-arg "-runstep
11a40 22 29 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ")(debug:print-i
11a50 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 1 *default-l
11a60 6f 67 2d 70 6f 72 74 2a 20 22 52 75 6e 6e 69 6e og-port* "Runnin
11a70 67 20 2d 72 75 6e 73 74 65 70 2c 20 66 69 72 73 g -runstep, firs
11a80 74 20 63 68 61 6e 67 65 20 74 6f 20 64 69 72 65 t change to dire
11a90 63 74 6f 72 79 20 22 20 77 6f 72 6b 2d 61 72 65 ctory " work-are
11aa0 61 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 a)).. (change-d
11ab0 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 irectory work-ar
11ac0 65 61 29 0a 09 20 20 3b 3b 20 63 61 6e 20 73 65 ea).. ;; can se
11ad0 74 75 70 20 61 73 20 63 6c 69 65 6e 74 20 66 6f tup as client fo
11ae0 72 20 73 65 72 76 65 72 20 6d 6f 64 65 20 6e 6f r server mode no
11af0 77 0a 09 20 20 3b 3b 20 28 63 6c 69 65 6e 74 3a w.. ;; (client:
11b00 73 65 74 75 70 29 0a 0a 09 20 20 28 69 66 20 28 setup)... (if (
11b10 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
11b20 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a oad-test-data").
11b30 09 20 20 20 20 20 20 3b 3b 20 68 61 73 20 73 75 . ;; has su
11b40 62 20 63 6f 6d 6d 61 6e 64 73 20 74 68 61 74 20 b commands that
11b50 61 72 65 20 72 64 62 3a 0a 09 20 20 20 20 20 20 are rdb:..
11b60 3b 3b 20 44 4f 20 4e 4f 54 20 70 75 74 20 74 68 ;; DO NOT put th
11b70 69 73 20 6f 6e 65 20 69 6e 74 6f 20 65 69 74 68 is one into eith
11b80 65 72 20 72 6d 74 3a 20 6f 72 20 6f 70 65 6e 2d er rmt: or open-
11b90 72 75 6e 2d 63 6c 6f 73 65 0a 09 20 20 20 20 20 run-close..
11ba0 20 28 74 64 62 3a 6c 6f 61 64 2d 74 65 73 74 2d (tdb:load-test-
11bb0 64 61 74 61 20 72 75 6e 2d 69 64 20 74 65 73 74 data run-id test
11bc0 2d 69 64 29 29 0a 09 20 20 28 69 66 20 28 61 72 -id)).. (if (ar
11bd0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
11be0 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 28 6c 65 log").. (le
11bf0 74 20 28 28 6c 6f 67 66 6e 61 6d 65 20 28 61 72 t ((logfname (ar
11c00 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
11c10 6c 6f 67 22 29 29 29 0a 09 09 28 72 6d 74 3a 74 log")))...(rmt:t
11c20 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e est-set-log! run
11c30 2d 69 64 20 74 65 73 74 2d 69 64 20 6c 6f 67 66 -id test-id logf
11c40 6e 61 6d 65 29 29 29 0a 09 20 20 28 69 66 20 28 name))).. (if (
11c50 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
11c60 65 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 20 20 20 et-toplog")..
11c70 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e ;; DO NOT run
11c80 20 72 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 28 remote.. (
11c90 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 74 tests:test-set-t
11ca0 6f 70 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 oplog! run-id te
11cb0 73 74 2d 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 st-name (args:ge
11cc0 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c t-arg "-set-topl
11cd0 6f 67 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 og"))).. (if (a
11ce0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 rgs:get-arg "-su
11cf0 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 0a mmarize-items").
11d00 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 . ;; DO NOT
11d10 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 run remote..
11d20 20 20 20 28 74 65 73 74 73 3a 73 75 6d 6d 61 72 (tests:summar
11d30 69 7a 65 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 ize-items run-id
11d40 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d 6e 61 test-id test-na
11d50 6d 65 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 6f me #t)) ;; do fo
11d60 72 63 65 20 68 65 72 65 0a 09 20 20 28 69 66 20 rce here.. (if
11d70 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11d80 72 75 6e 73 74 65 70 22 29 0a 09 20 20 20 20 20 runstep")..
11d90 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 (if (null? rema
11da0 72 67 73 29 0a 09 09 20 20 28 62 65 67 69 6e 0a rgs)... (begin.
11db0 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
11dc0 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
11dd0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6e ult-log-port* "n
11de0 6f 74 68 69 6e 67 20 73 70 65 63 69 66 69 65 64 othing specified
11df0 20 74 6f 20 72 75 6e 21 22 29 0a 09 09 20 20 20 to run!")...
11e00 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 (if db (sqlite3
11e10 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
11e20 09 09 20 20 20 20 28 65 78 69 74 20 36 29 29 0a .. (exit 6)).
11e30 09 09 20 20 28 6c 65 74 2a 20 28 28 73 74 65 70 .. (let* ((step
11e40 6e 61 6d 65 20 20 20 28 61 72 67 73 3a 67 65 74 name (args:get
11e50 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 -arg "-runstep")
11e60 29 0a 09 09 09 20 28 6c 6f 67 70 72 6f 66 69 6c ).... (logprofil
11e70 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 e (args:get-arg
11e80 22 2d 6c 6f 67 70 72 6f 22 29 29 0a 09 09 09 20 "-logpro"))....
11e90 28 6c 6f 67 66 69 6c 65 20 20 20 20 28 63 6f 6e (logfile (con
11ea0 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 c stepname ".log
11eb0 22 29 29 0a 09 09 09 20 28 63 6d 64 20 20 20 20 ")).... (cmd
11ec0 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 (if (null? r
11ed0 65 6d 61 72 67 73 29 20 23 66 20 28 63 61 72 20 emargs) #f (car
11ee0 72 65 6d 61 72 67 73 29 29 29 0a 09 09 09 20 28 remargs))).... (
11ef0 70 61 72 61 6d 73 20 20 20 20 20 28 69 66 20 63 params (if c
11f00 6d 64 20 28 63 64 72 20 72 65 6d 61 72 67 73 29 md (cdr remargs)
11f10 20 27 28 29 29 29 0a 09 09 09 20 28 65 78 69 74 '())).... (exit
11f20 73 74 61 74 20 20 20 23 66 29 0a 09 09 09 20 28 stat #f).... (
11f30 73 68 65 6c 6c 20 20 20 20 20 20 28 6c 65 74 20 shell (let
11f40 28 28 73 68 20 28 67 65 74 2d 65 6e 76 69 72 6f ((sh (get-enviro
11f50 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
11f60 53 48 45 4c 4c 22 29 20 29 29 0a 09 09 09 09 20 SHELL") )).....
11f70 20 20 20 20 20 20 28 69 66 20 73 68 20 0a 09 09 (if sh ...
11f80 09 09 09 20 20 20 28 6c 61 73 74 20 28 73 74 72 ... (last (str
11f90 69 6e 67 2d 73 70 6c 69 74 20 73 68 20 22 2f 22 ing-split sh "/"
11fa0 29 29 0a 09 09 09 09 09 20 20 20 22 62 61 73 68 ))...... "bash
11fb0 22 29 29 29 0a 09 09 09 20 28 72 65 64 69 72 20 "))).... (redir
11fc0 20 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 (case (stri
11fd0 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 68 65 6c 6c ng->symbol shell
11fe0 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 74 )..... ((t
11ff0 63 73 68 20 63 73 68 20 6b 73 68 29 20 20 20 20 csh csh ksh)
12000 22 3e 26 22 29 0a 09 09 09 09 20 20 20 20 20 20 ">&").....
12010 20 28 28 7a 73 68 20 62 61 73 68 20 73 68 20 61 ((zsh bash sh a
12020 73 68 29 20 22 32 3e 26 31 20 3e 22 29 0a 09 09 sh) "2>&1 >")...
12030 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 22 .. (else "
12040 3e 26 22 29 29 29 0a 09 09 09 20 28 66 75 6c 6c >&"))).... (full
12050 63 6d 64 20 20 20 20 28 63 6f 6e 63 20 22 28 22 cmd (conc "("
12060 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
12070 65 72 73 65 20 0a 09 09 09 09 09 09 28 63 6f 6e erse .......(con
12080 73 20 63 6d 64 20 70 61 72 61 6d 73 29 20 22 20 s cmd params) "
12090 22 29 0a 09 09 09 09 09 20 20 20 22 29 20 22 20 ")...... ") "
120a0 72 65 64 69 72 20 22 20 22 20 6c 6f 67 66 69 6c redir " " logfil
120b0 65 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 6d 61 e)))... ;; ma
120c0 72 6b 20 74 68 65 20 73 74 61 72 74 20 6f 66 20 rk the start of
120d0 74 68 65 20 74 65 73 74 0a 09 09 20 20 20 20 28 the test... (
120e0 72 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 74 rmt:teststep-set
120f0 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 -status! run-id
12100 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 test-id stepname
12110 20 22 73 74 61 72 74 22 20 22 6e 2f 61 22 20 28 "start" "n/a" (
12120 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
12130 22 29 20 6c 6f 67 66 69 6c 65 29 0a 09 09 20 20 ") logfile)...
12140 20 20 3b 3b 20 72 75 6e 20 74 68 65 20 74 65 73 ;; run the tes
12150 74 20 73 74 65 70 0a 09 09 20 20 20 20 28 64 65 t step... (de
12160 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 bug:print-info 2
12170 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
12180 72 74 2a 20 22 52 75 6e 6e 69 6e 67 20 5c 22 22 rt* "Running \""
12190 20 66 75 6c 6c 63 6d 64 20 22 5c 22 20 69 6e 20 fullcmd "\" in
121a0 64 69 72 65 63 74 6f 72 79 20 5c 22 22 20 73 74 directory \"" st
121b0 61 72 74 69 6e 67 64 69 72 29 0a 09 09 20 20 20 artingdir)...
121c0 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
121d0 72 79 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a ry startingdir).
121e0 09 09 20 20 20 20 28 73 65 74 21 20 65 78 69 74 .. (set! exit
121f0 73 74 61 74 20 28 73 79 73 74 65 6d 20 66 75 6c stat (system ful
12200 6c 63 6d 64 29 29 0a 09 09 20 20 20 20 28 73 65 lcmd))... (se
12210 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 t! *globalexitst
12220 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 0a atus* exitstat).
12230 09 09 20 20 20 20 3b 3b 20 28 63 68 61 6e 67 65 .. ;; (change
12240 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 -directory testp
12250 61 74 68 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 ath)... ;; ru
12260 6e 20 6c 6f 67 70 72 6f 20 69 66 20 61 70 70 6c n logpro if appl
12270 69 63 61 62 6c 65 20 3b 3b 20 28 70 72 6f 63 65 icable ;; (proce
12280 73 73 2d 72 75 6e 20 22 6c 73 22 20 28 6c 69 73 ss-run "ls" (lis
12290 74 20 22 2f 66 6f 6f 22 20 22 32 3e 26 31 22 20 t "/foo" "2>&1"
122a0 22 62 6c 61 68 2e 6c 6f 67 22 29 29 0a 09 09 20 "blah.log"))...
122b0 20 20 20 28 69 66 20 6c 6f 67 70 72 6f 66 69 6c (if logprofil
122c0 65 0a 09 09 09 28 6c 65 74 2a 20 28 28 68 74 6d e....(let* ((htm
122d0 6c 6c 6f 67 66 69 6c 65 20 28 63 6f 6e 63 20 73 llogfile (conc s
122e0 74 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 tepname ".html")
122f0 29 0a 09 09 09 20 20 20 20 20 20 20 28 6f 6c 64 ).... (old
12300 65 78 69 74 73 74 61 74 20 65 78 69 74 73 74 61 exitstat exitsta
12310 74 29 0a 09 09 09 20 20 20 20 20 20 20 28 63 6d t).... (cm
12320 64 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e d (strin
12330 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6c g-intersperse (l
12340 69 73 74 20 22 6c 6f 67 70 72 6f 22 20 6c 6f 67 ist "logpro" log
12350 70 72 6f 66 69 6c 65 20 68 74 6d 6c 6c 6f 67 66 profile htmllogf
12360 69 6c 65 20 22 3c 22 20 6c 6f 67 66 69 6c 65 20 ile "<" logfile
12370 22 3e 22 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 ">" (conc stepna
12380 6d 65 20 22 5f 6c 6f 67 70 72 6f 2e 6c 6f 67 22 me "_logpro.log"
12390 29 29 20 22 20 22 29 29 29 0a 09 09 09 20 20 28 )) " "))).... (
123a0 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
123b0 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 2 *default-log-
123c0 70 6f 72 74 2a 20 22 72 75 6e 6e 69 6e 67 20 5c port* "running \
123d0 22 22 20 63 6d 64 20 22 5c 22 22 29 0a 09 09 09 "" cmd "\"")....
123e0 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
123f0 6f 72 79 20 73 74 61 72 74 69 6e 67 64 69 72 29 ory startingdir)
12400 0a 09 09 09 20 20 28 73 65 74 21 20 65 78 69 74 .... (set! exit
12410 73 74 61 74 20 28 73 79 73 74 65 6d 20 63 6d 64 stat (system cmd
12420 29 29 0a 09 09 09 20 20 28 73 65 74 21 20 2a 67 )).... (set! *g
12430 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
12440 20 65 78 69 74 73 74 61 74 29 20 3b 3b 20 6e 6f exitstat) ;; no
12450 20 6e 65 63 65 73 73 61 72 79 0a 09 09 09 20 20 necessary....
12460 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
12470 79 20 74 65 73 74 70 61 74 68 29 0a 09 09 09 20 y testpath)....
12480 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c (rmt:test-set-l
12490 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d og! run-id test-
124a0 69 64 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 29 29 id htmllogfile))
124b0 29 0a 09 09 20 20 20 20 28 6c 65 74 20 28 28 6d )... (let ((m
124c0 73 67 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 sg (args:get-arg
124d0 20 22 2d 6d 22 29 29 29 0a 09 09 20 20 20 20 20 "-m")))...
124e0 20 28 72 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 (rmt:teststep-s
124f0 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 et-status! run-i
12500 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 d test-id stepna
12510 6d 65 20 22 65 6e 64 22 20 65 78 69 74 73 74 61 me "end" exitsta
12520 74 20 6d 73 67 20 6c 6f 67 66 69 6c 65 29 29 0a t msg logfile)).
12530 09 09 20 20 20 20 29 29 29 0a 09 20 20 28 69 66 .. ))).. (if
12540 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
12550 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 rg "-test-status
12560 22 29 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 ")... (args:get
12570 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 -arg "-set-value
12580 73 22 29 29 0a 09 20 20 20 20 20 20 28 6c 65 74 s")).. (let
12590 20 28 28 6e 65 77 73 74 61 74 75 73 20 28 63 6f ((newstatus (co
125a0 6e 64 0a 09 09 09 09 28 28 6e 75 6d 62 65 72 3f nd.....((number?
125b0 20 73 74 61 74 75 73 29 20 20 20 20 20 20 20 28 status) (
125c0 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75 if (equal? statu
125d0 73 20 30 29 20 22 50 41 53 53 22 20 22 46 41 49 s 0) "PASS" "FAI
125e0 4c 22 29 29 0a 09 09 09 09 28 28 61 6e 64 20 28 L")).....((and (
125f0 73 74 72 69 6e 67 3f 20 73 74 61 74 75 73 29 0a string? status).
12600 09 09 09 09 20 20 20 20 20 20 28 73 74 72 69 6e .... (strin
12610 67 2d 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 73 g->number status
12620 29 29 28 69 66 20 28 65 71 75 61 6c 3f 20 28 73 ))(if (equal? (s
12630 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 tring->number st
12640 61 74 75 73 29 20 30 29 20 22 50 41 53 53 22 20 atus) 0) "PASS"
12650 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 65 6c "FAIL")).....(el
12660 73 65 20 73 74 61 74 75 73 29 29 29 0a 09 09 20 se status)))...
12670 20 20 20 3b 3b 20 74 72 61 6e 73 66 65 72 20 72 ;; transfer r
12680 65 6c 65 76 61 6e 74 20 6b 65 79 73 20 69 6e 74 elevant keys int
12690 6f 20 61 20 68 61 73 68 20 74 6f 20 62 65 20 70 o a hash to be p
126a0 61 73 73 65 64 20 74 6f 20 74 65 73 74 2d 73 65 assed to test-se
126b0 74 2d 73 74 61 74 75 73 21 0a 09 09 20 20 20 20 t-status!...
126c0 3b 3b 20 63 6f 75 6c 64 20 75 73 65 20 61 6e 20 ;; could use an
126d0 61 73 73 6f 63 20 6c 69 73 74 20 49 20 67 75 65 assoc list I gue
126e0 73 73 2e 20 0a 09 09 20 20 20 20 28 6f 74 68 65 ss. ... (othe
126f0 72 64 61 74 61 20 28 6c 65 74 20 28 28 72 65 73 rdata (let ((res
12700 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
12710 65 29 29 29 0a 09 09 09 09 20 28 66 6f 72 2d 65 e)))..... (for-e
12720 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 ach (lambda (key
12730 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 )...... (if
12740 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 (args:get-arg ke
12750 79 29 0a 09 09 09 09 09 09 20 28 68 61 73 68 2d y)....... (hash-
12760 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 6b table-set! res k
12770 65 79 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ey (args:get-arg
12780 20 6b 65 79 29 29 29 29 0a 09 09 09 09 09 20 20 key))))......
12790 20 28 6c 69 73 74 20 22 3a 76 61 6c 75 65 22 20 (list ":value"
127a0 22 3a 74 6f 6c 22 20 22 3a 65 78 70 65 63 74 65 ":tol" ":expecte
127b0 64 22 20 22 3a 66 69 72 73 74 5f 65 72 72 22 20 d" ":first_err"
127c0 22 3a 66 69 72 73 74 5f 77 61 72 6e 22 20 22 3a ":first_warn" ":
127d0 75 6e 69 74 73 22 20 22 3a 63 61 74 65 67 6f 72 units" ":categor
127e0 79 22 20 22 3a 76 61 72 69 61 62 6c 65 22 29 29 y" ":variable"))
127f0 0a 09 09 09 09 20 72 65 73 29 29 29 0a 09 09 28 ..... res)))...(
12800 69 66 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 if (and (args:ge
12810 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 t-arg "-test-sta
12820 74 75 73 22 29 0a 09 09 09 20 28 6f 72 20 28 6e tus").... (or (n
12830 6f 74 20 73 74 61 74 65 29 0a 09 09 09 20 20 20 ot state)....
12840 20 20 28 6e 6f 74 20 73 74 61 74 75 73 29 29 29 (not status)))
12850 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ... (begin...
12860 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
12870 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
12880 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 59 ult-log-port* "Y
12890 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 ou must specify
128a0 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 :state and :stat
128b0 75 73 20 77 69 74 68 20 65 76 65 72 79 20 63 61 us with every ca
128c0 6c 6c 20 74 6f 20 2d 74 65 73 74 2d 73 74 61 74 ll to -test-stat
128d0 75 73 5c 6e 22 20 68 65 6c 70 29 0a 09 09 20 20 us\n" help)...
128e0 20 20 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 (if (sqlite3
128f0 3a 64 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 :database? db)(s
12900 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
12910 20 64 62 29 29 0a 09 09 20 20 20 20 20 20 28 65 db))... (e
12920 78 69 74 20 36 29 29 29 0a 09 09 28 6c 65 74 2a xit 6)))...(let*
12930 20 28 28 6d 73 67 20 20 20 20 28 61 72 67 73 3a ((msg (args:
12940 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 get-arg "-m"))..
12950 09 20 20 20 20 20 20 20 28 6e 75 6d 6f 74 68 20 . (numoth
12960 28 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 (length (hash-ta
12970 62 6c 65 2d 6b 65 79 73 20 6f 74 68 65 72 64 61 ble-keys otherda
12980 74 61 29 29 29 29 0a 09 09 20 20 3b 3b 20 43 6f ta))))... ;; Co
12990 6e 76 65 72 74 20 74 6f 20 72 70 63 20 69 6e 73 nvert to rpc ins
129a0 69 64 65 20 74 68 65 20 74 65 73 74 73 3a 74 65 ide the tests:te
129b0 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 63 st-set-status! c
129c0 61 6c 6c 2c 20 6e 6f 74 20 68 65 72 65 0a 09 09 all, not here...
129d0 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 (tests:test-se
129e0 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 t-status! run-id
129f0 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 6e test-id state n
12a00 65 77 73 74 61 74 75 73 20 6d 73 67 20 6f 74 68 ewstatus msg oth
12a10 65 72 64 61 74 61 20 77 6f 72 6b 2d 61 72 65 61 erdata work-area
12a20 3a 20 77 6f 72 6b 2d 61 72 65 61 29 29 29 29 0a : work-area)))).
12a30 09 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 3a . (if (sqlite3:
12a40 64 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 71 database? db)(sq
12a50 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
12a60 64 62 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 db)).. (set! *d
12a70 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
12a80 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
12a90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12aa0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ab0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ac0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
12ad0 20 56 61 72 69 6f 75 73 20 68 65 6c 70 65 72 20 Various helper
12ae0 63 6f 6d 6d 61 6e 64 73 20 63 61 6e 20 67 6f 20 commands can go
12af0 62 65 6c 6f 77 20 68 65 72 65 0a 3b 3b 3d 3d 3d below here.;;===
12b00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b40 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 ===..(if (or (ar
12b50 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f gs:get-arg "-sho
12b60 77 6b 65 79 73 22 29 0a 20 20 20 20 20 20 20 20 wkeys").
12b70 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
12b80 73 68 6f 77 2d 6b 65 79 73 22 29 29 0a 20 20 20 show-keys")).
12b90 20 28 6c 65 74 20 28 28 64 62 20 23 66 29 0a 09 (let ((db #f)..
12ba0 20 20 28 6b 65 79 73 20 23 66 29 29 0a 20 20 20 (keys #f)).
12bb0 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 (if (not (lau
12bc0 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 nch:setup)).. (
12bd0 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 begin.. (debu
12be0 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
12bf0 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 lt-log-port* "Fa
12c00 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 iled to setup, e
12c10 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 28 65 xiting").. (e
12c20 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 xit 1))). (
12c30 73 65 74 21 20 6b 65 79 73 20 28 72 6d 74 3a 67 set! keys (rmt:g
12c40 65 74 2d 6b 65 79 73 29 29 20 3b 3b 20 20 64 62 et-keys)) ;; db
12c50 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a )). (debug:
12c60 70 72 69 6e 74 20 31 20 2a 64 65 66 61 75 6c 74 print 1 *default
12c70 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4b 65 79 73 -log-port* "Keys
12c80 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 : " (string-inte
12c90 72 73 70 65 72 73 65 20 6b 65 79 73 20 22 2c 20 rsperse keys ",
12ca0 22 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 73 ")). (if (s
12cb0 71 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f qlite3:database?
12cc0 20 64 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e db)(sqlite3:fin
12cd0 61 6c 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 alize! db)).
12ce0 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
12cf0 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
12d00 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
12d10 22 2d 67 75 69 22 29 0a 20 20 20 20 28 62 65 67 "-gui"). (beg
12d20 69 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a in. (debug:
12d30 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
12d40 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4c 6f 6f 6b -log-port* "Look
12d50 20 61 74 20 74 68 65 20 64 61 73 68 62 6f 61 72 at the dashboar
12d60 64 20 66 6f 72 20 6e 6f 77 22 29 0a 20 20 20 20 d for now").
12d70 20 20 3b 3b 20 28 6d 65 67 61 74 65 73 74 2d 67 ;; (megatest-g
12d80 75 69 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ui). (set!
12d90 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
12da0 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a t)))..(if (args:
12db0 67 65 74 2d 61 72 67 20 22 2d 63 72 65 61 74 65 get-arg "-create
12dc0 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 22 29 -megatest-area")
12dd0 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
12de0 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b (genexample:mk
12df0 2d 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 -megatest.config
12e00 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
12e10 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
12e20 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
12e30 74 2d 61 72 67 20 22 2d 63 72 65 61 74 65 2d 74 t-arg "-create-t
12e40 65 73 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 est"). (let (
12e50 28 74 65 73 74 6e 61 6d 65 20 28 61 72 67 73 3a (testname (args:
12e60 67 65 74 2d 61 72 67 20 22 2d 63 72 65 61 74 65 get-arg "-create
12e70 2d 74 65 73 74 22 29 29 29 0a 20 20 20 20 20 20 -test"))).
12e80 28 67 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d (genexample:mk-m
12e90 65 67 61 74 65 73 74 2d 74 65 73 74 20 74 65 73 egatest-test tes
12ea0 74 6e 61 6d 65 29 0a 20 20 20 20 20 20 28 73 65 tname). (se
12eb0 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
12ec0 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d * #t)))..;;=====
12ed0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ee0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ef0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f10 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 =.;; Update the
12f20 64 61 74 61 62 61 73 65 20 73 63 68 65 6d 61 2c database schema,
12f30 20 63 6c 65 61 6e 20 75 70 20 74 68 65 20 64 62 clean up the db
12f40 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
12f50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f80 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
12f90 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
12fa0 65 62 75 69 6c 64 2d 64 62 22 29 0a 20 20 20 20 ebuild-db").
12fb0 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 (begin. (if
12fc0 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
12fd0 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a tup)).. (begin.
12fe0 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
12ff0 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
13000 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 -port* "Failed t
13010 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
13020 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 ") .. (exit 1
13030 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 ))). ;; kee
13040 70 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c p this one local
13050 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e . (open-run
13060 2d 63 6c 6f 73 65 20 70 61 74 63 68 2d 64 62 20 -close patch-db
13070 23 66 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 #f). (set!
13080 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
13090 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a t)))..(if (args:
130a0 67 65 74 2d 61 72 67 20 22 2d 63 6c 65 61 6e 75 get-arg "-cleanu
130b0 70 2d 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 p-db"). (begi
130c0 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 n. (if (not
130d0 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
130e0 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
130f0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
13100 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
13110 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
13120 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 up, exiting") ..
13130 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
13140 20 20 20 20 20 28 6c 65 74 20 28 28 64 62 73 74 (let ((dbst
13150 72 75 63 74 20 28 64 62 3a 73 65 74 75 70 20 2a ruct (db:setup *
13160 74 6f 70 70 61 74 68 2a 29 29 29 0a 20 20 20 20 toppath*))).
13170 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 63 6c 65 61 (common:clea
13180 6e 75 70 2d 64 62 20 64 62 73 74 72 75 63 74 29 nup-db dbstruct)
13190 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
131a0 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
131b0 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
131c0 74 2d 61 72 67 20 22 2d 6d 61 72 6b 2d 69 6e 63 t-arg "-mark-inc
131d0 6f 6d 70 6c 65 74 65 73 22 29 0a 20 20 20 20 28 ompletes"). (
131e0 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 begin. (if
131f0 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 (not (launch:set
13200 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 up)).. (begin..
13210 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
13220 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
13230 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f port* "Failed to
13240 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
13250 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 ).. (exit 1))
13260 29 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 ). (open-ru
13270 6e 2d 63 6c 6f 73 65 20 64 62 3a 66 69 6e 64 2d n-close db:find-
13280 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c and-mark-incompl
13290 65 74 65 20 23 66 29 0a 20 20 20 20 20 20 28 73 ete #f). (s
132a0 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
132b0 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d g* #t)))..;;====
132c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
132d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
132e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
132f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13300 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 ==.;; Update the
13310 20 74 65 73 74 73 20 6d 65 74 61 20 64 61 74 61 tests meta data
13320 20 66 72 6f 6d 20 74 68 65 20 74 65 73 74 63 6f from the testco
13330 6e 66 69 67 20 66 69 6c 65 73 0a 3b 3b 3d 3d 3d nfig files.;;===
13340 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13350 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13360 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13370 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13380 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
13390 65 74 2d 61 72 67 20 22 2d 75 70 64 61 74 65 2d et-arg "-update-
133a0 6d 65 74 61 22 29 0a 20 20 20 20 28 62 65 67 69 meta"). (begi
133b0 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 n. (if (not
133c0 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
133d0 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
133e0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
133f0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
13400 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
13410 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 up, exiting") ..
13420 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
13430 20 20 20 20 20 28 72 75 6e 73 3a 75 70 64 61 74 (runs:updat
13440 65 2d 61 6c 6c 2d 74 65 73 74 5f 6d 65 74 61 20 e-all-test_meta
13450 23 66 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 #f). (set!
13460 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
13470 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
13480 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13490 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
134a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
134b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
134c0 3b 20 53 74 61 72 74 20 61 20 72 65 70 6c 0a 3b ; Start a repl.;
134d0 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
134e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
134f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13500 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13510 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 66 61 6b 65 =======..;; fake
13520 6f 75 74 20 72 65 61 64 6c 69 6e 65 0a 28 69 6e out readline.(in
13530 63 6c 75 64 65 20 22 72 65 61 64 6c 69 6e 65 2d clude "readline-
13540 66 69 78 2e 73 63 6d 22 29 0a 0a 0a 28 77 68 65 fix.scm")...(whe
13550 6e 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 n (args:get-arg
13560 22 2d 64 69 66 66 2d 72 65 70 22 29 0a 20 20 28 "-diff-rep"). (
13570 77 68 65 6e 20 28 61 6e 64 0a 20 20 20 20 20 20 when (and.
13580 20 20 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 (not (args:ge
13590 74 2d 61 72 67 20 22 2d 64 69 66 66 2d 68 74 6d t-arg "-diff-htm
135a0 6c 22 29 29 0a 20 20 20 20 20 20 20 20 20 28 6e l")). (n
135b0 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
135c0 20 22 2d 64 69 66 66 2d 65 6d 61 69 6c 22 29 29 "-diff-email"))
135d0 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
135e0 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
135f0 67 2d 70 6f 72 74 2a 20 22 4d 75 73 74 20 73 70 g-port* "Must sp
13600 65 63 69 66 79 20 2d 64 69 66 66 2d 68 74 6d 6c ecify -diff-html
13610 20 6f 72 20 2d 64 69 66 66 2d 65 6d 61 69 6c 20 or -diff-email
13620 77 69 74 68 20 2d 64 69 66 66 2d 72 65 70 22 29 with -diff-rep")
13630 0a 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 . (set! *dids
13640 6f 6d 65 74 68 69 6e 67 2a 20 31 29 0a 20 20 20 omething* 1).
13650 20 28 65 78 69 74 20 31 29 29 0a 20 20 0a 20 20 (exit 1)). .
13660 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 (let* ((toppath
13670 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 (launch:setup)))
13680 0a 20 20 20 20 28 64 6f 2d 64 69 66 66 2d 72 65 . (do-diff-re
13690 70 6f 72 74 0a 20 20 20 20 20 28 61 72 67 73 3a port. (args:
136a0 67 65 74 2d 61 72 67 20 22 2d 73 72 63 2d 74 61 get-arg "-src-ta
136b0 72 67 65 74 22 29 0a 20 20 20 20 20 28 61 72 67 rget"). (arg
136c0 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 72 63 2d s:get-arg "-src-
136d0 72 75 6e 6e 61 6d 65 22 29 0a 20 20 20 20 20 28 runname"). (
136e0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
136f0 61 72 67 65 74 22 29 0a 20 20 20 20 20 28 61 72 arget"). (ar
13700 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
13710 6e 61 6d 65 22 29 0a 20 20 20 20 20 28 61 72 67 name"). (arg
13720 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 69 66 66 s:get-arg "-diff
13730 2d 68 74 6d 6c 22 29 0a 20 20 20 20 20 28 61 72 -html"). (ar
13740 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 69 66 gs:get-arg "-dif
13750 66 2d 65 6d 61 69 6c 22 29 29 0a 20 20 20 20 28 f-email")). (
13760 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
13770 6e 67 2a 20 23 74 29 0a 20 20 20 20 28 65 78 69 ng* #t). (exi
13780 74 20 30 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 t 0)))..(if (or
13790 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 53 (getenv "MT_RUNS
137a0 43 52 49 50 54 22 29 0a 09 28 61 72 67 73 3a 67 CRIPT")..(args:g
137b0 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 29 0a et-arg "-repl").
137c0 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
137d0 2d 6c 6f 61 64 22 29 29 0a 20 20 20 20 28 6c 65 -load")). (le
137e0 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 6c 61 t* ((toppath (la
137f0 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 unch:setup))..
13800 20 28 64 62 73 74 72 75 63 74 20 28 69 66 20 28 (dbstruct (if (
13810 61 6e 64 20 74 6f 70 70 61 74 68 0a 20 20 20 20 and toppath.
13820 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13830 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f (commo
13840 6e 3a 6f 6e 2d 68 6f 6d 65 68 6f 73 74 3f 29 29 n:on-homehost?))
13850 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
13860 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 73 65 (db:se
13870 74 75 70 29 0a 20 20 20 20 20 20 20 20 20 20 20 tup).
13880 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 #f
13890 29 29 29 20 3b 3b 20 6d 61 6b 65 2d 64 62 72 3a ))) ;; make-dbr:
138a0 64 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 74 dbstruct path: t
138b0 6f 70 70 61 74 68 20 6c 6f 63 61 6c 3a 20 28 61 oppath local: (a
138c0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
138d0 63 61 6c 22 29 29 20 23 66 29 29 29 0a 20 20 20 cal")) #f))).
138e0 20 20 20 28 69 66 20 2a 74 6f 70 70 61 74 68 2a (if *toppath*
138f0 0a 09 20 20 28 63 6f 6e 64 0a 09 20 20 20 28 28 .. (cond.. ((
13900 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 53 43 getenv "MT_RUNSC
13910 52 49 50 54 22 29 0a 09 20 20 20 20 3b 3b 20 48 RIPT").. ;; H
13920 6f 77 20 74 6f 20 72 75 6e 20 6d 65 67 61 74 65 ow to run megate
13930 73 74 20 73 63 72 69 70 74 73 0a 09 20 20 20 20 st scripts..
13940 3b 3b 0a 09 20 20 20 20 3b 3b 20 23 21 2f 62 69 ;;.. ;; #!/bi
13950 6e 2f 62 61 73 68 0a 09 20 20 20 20 3b 3b 0a 09 n/bash.. ;;..
13960 20 20 20 20 3b 3b 20 65 78 70 6f 72 74 20 4d 54 ;; export MT
13970 5f 52 55 4e 53 43 52 49 50 54 3d 79 65 73 0a 09 _RUNSCRIPT=yes..
13980 20 20 20 20 3b 3b 20 6d 65 67 61 74 65 73 74 20 ;; megatest
13990 3c 3c 20 45 4f 46 0a 09 20 20 20 20 3b 3b 20 28 << EOF.. ;; (
139a0 70 72 69 6e 74 20 22 48 65 6c 6c 6f 20 77 6f 72 print "Hello wor
139b0 6c 64 22 29 0a 09 20 20 20 20 3b 3b 20 28 65 78 ld").. ;; (ex
139c0 69 74 29 0a 09 20 20 20 20 3b 3b 20 45 4f 46 0a it).. ;; EOF.
139d0 0a 09 20 20 20 20 28 72 65 70 6c 29 29 0a 09 20 .. (repl))..
139e0 20 20 28 65 6c 73 65 0a 09 20 20 20 20 28 62 65 (else.. (be
139f0 67 69 6e 0a 09 20 20 20 20 20 20 28 73 65 74 21 gin.. (set!
13a00 20 2a 64 62 2a 20 64 62 73 74 72 75 63 74 29 0a *db* dbstruct).
13a10 09 20 20 20 20 20 20 28 69 6d 70 6f 72 74 20 65 . (import e
13a20 78 74 72 61 73 29 20 3b 3b 20 6d 69 67 68 74 20 xtras) ;; might
13a30 6e 6f 74 20 62 65 20 6e 65 65 64 65 64 0a 09 20 not be needed..
13a40 20 20 20 20 20 3b 3b 20 28 69 6d 70 6f 72 74 20 ;; (import
13a50 63 73 69 29 0a 09 20 20 20 20 20 20 28 69 6d 70 csi).. (imp
13a60 6f 72 74 20 72 65 61 64 6c 69 6e 65 29 0a 09 20 ort readline)..
13a70 20 20 20 20 20 28 69 6d 70 6f 72 74 20 61 70 72 (import apr
13a80 6f 70 6f 73 29 0a 09 20 20 20 20 20 20 3b 3b 20 opos).. ;;
13a90 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 (import (prefix
13aa0 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a sqlite3 sqlite3:
13ab0 29 29 20 3b 3b 20 64 6f 65 73 6e 27 74 20 77 6f )) ;; doesn't wo
13ac0 72 6b 20 2e 2e 2e 0a 0a 09 20 20 20 20 20 20 28 rk ...... (
13ad0 69 66 20 2a 75 73 65 2d 6e 65 77 2d 72 65 61 64 if *use-new-read
13ae0 6c 69 6e 65 2a 0a 09 09 20 20 28 62 65 67 69 6e line*... (begin
13af0 0a 09 09 20 20 20 20 28 69 6e 73 74 61 6c 6c 2d ... (install-
13b00 68 69 73 74 6f 72 79 2d 66 69 6c 65 20 28 67 65 history-file (ge
13b10 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
13b20 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 riable "HOME") "
13b30 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 74 6f 72 .megatest_histor
13b40 79 22 29 20 3b 3b 20 20 5b 68 6f 6d 65 64 69 72 y") ;; [homedir
13b50 5d 20 5b 66 69 6c 65 6e 61 6d 65 5d 20 5b 6e 6c ] [filename] [nl
13b60 69 6e 65 73 5d 29 0a 09 09 20 20 20 20 28 63 75 ines])... (cu
13b70 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 rrent-input-port
13b80 20 28 6d 61 6b 65 2d 72 65 61 64 6c 69 6e 65 2d (make-readline-
13b90 70 6f 72 74 20 22 6d 65 67 61 74 65 73 74 3e 20 port "megatest>
13ba0 22 29 29 29 0a 09 09 20 20 28 62 65 67 69 6e 0a ")))... (begin.
13bb0 09 09 20 20 20 20 28 67 6e 75 2d 68 69 73 74 6f .. (gnu-histo
13bc0 72 79 2d 69 6e 73 74 61 6c 6c 2d 66 69 6c 65 2d ry-install-file-
13bd0 6d 61 6e 61 67 65 72 0a 09 09 20 20 20 20 20 28 manager... (
13be0 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 0a 09 09 string-append...
13bf0 20 20 20 20 20 20 28 6f 72 20 28 67 65 74 2d 65 (or (get-e
13c00 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
13c10 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2e 22 29 ble "HOME") ".")
13c20 20 22 2f 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 "/.megatest_his
13c30 74 6f 72 79 22 29 29 0a 09 09 20 20 20 20 28 63 tory"))... (c
13c40 75 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 urrent-input-por
13c50 74 20 28 6d 61 6b 65 2d 67 6e 75 2d 72 65 61 64 t (make-gnu-read
13c60 6c 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 line-port "megat
13c70 65 73 74 3e 20 22 29 29 29 29 0a 09 20 20 20 20 est> "))))..
13c80 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
13c90 61 72 67 20 22 2d 72 65 70 6c 22 29 0a 09 09 20 arg "-repl")...
13ca0 20 28 72 65 70 6c 29 0a 09 09 20 20 28 6c 6f 61 (repl)... (loa
13cb0 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
13cc0 22 2d 6c 6f 61 64 22 29 29 29 0a 09 20 20 20 20 "-load")))..
13cd0 20 20 3b 3b 20 28 64 62 3a 63 6c 6f 73 65 2d 61 ;; (db:close-a
13ce0 6c 6c 20 64 62 73 74 72 75 63 74 29 20 3c 3d 20 ll dbstruct) <=
13cf0 74 61 6b 65 6e 20 63 61 72 65 20 6f 66 20 62 79 taken care of by
13d00 20 6f 6e 2d 65 78 69 74 20 63 61 6c 6c 0a 09 20 on-exit call..
13d10 20 20 20 20 20 29 0a 09 20 20 20 20 28 65 78 69 ).. (exi
13d20 74 29 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 t))).. (set! *d
13d30 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
13d40 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
13d50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13d60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13d70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13d80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
13d90 20 57 61 69 74 20 6f 6e 20 61 20 72 75 6e 20 74 Wait on a run t
13da0 6f 20 63 6f 6d 70 6c 65 74 65 0a 3b 3b 3d 3d 3d o complete.;;===
13db0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13dc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13dd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13de0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13df0 3d 3d 3d 0a 0a 28 69 66 20 28 61 6e 64 20 28 61 ===..(if (and (a
13e00 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
13e10 6e 2d 77 61 69 74 22 29 0a 09 20 28 6e 6f 74 20 n-wait").. (not
13e20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
13e30 67 20 22 2d 72 75 6e 22 29 0a 09 09 20 20 28 61 g "-run")... (a
13e40 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
13e50 6e 74 65 73 74 73 22 29 29 29 29 20 3b 3b 20 72 ntests")))) ;; r
13e60 75 6e 2d 77 61 69 74 20 69 73 20 62 75 69 6c 74 un-wait is built
13e70 20 69 6e 74 6f 20 72 75 6e 74 65 73 74 73 20 6e into runtests n
13e80 6f 77 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 ow. (begin.
13e90 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 (if (not (la
13ea0 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 unch:setup))..
13eb0 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 (begin.. (deb
13ec0 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
13ed0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 ult-log-port* "F
13ee0 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 ailed to setup,
13ef0 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 exiting") ..
13f00 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 (exit 1))).
13f10 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 72 75 (operate-on 'ru
13f20 6e 2d 77 61 69 74 29 0a 20 20 20 20 20 20 28 73 n-wait). (s
13f30 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
13f40 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 3b 3b 20 g* #t)))..;; ;;
13f50 3b 3b 20 72 65 64 6f 20 6d 65 20 3b 3b 20 4e 6f ;; redo me ;; No
13f60 74 20 63 6f 6e 76 65 72 74 65 64 20 74 6f 20 75 t converted to u
13f70 73 65 20 64 62 73 74 72 75 63 74 20 79 65 74 0a se dbstruct yet.
13f80 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
13f90 20 3b 3b 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ;;.;; ;; ;; red
13fa0 6f 20 6d 65 20 28 69 66 20 28 61 72 67 73 3a 67 o me (if (args:g
13fb0 65 74 2d 61 72 67 20 22 2d 63 6f 6e 76 65 72 74 et-arg "-convert
13fc0 2d 74 6f 2d 6e 6f 72 6d 22 29 0a 3b 3b 20 3b 3b -to-norm").;; ;;
13fd0 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 ;; redo me
13fe0 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 (let* ((toppath
13ff0 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
14000 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
14010 65 20 09 20 20 20 28 64 62 73 74 72 75 63 74 20 e . (dbstruct
14020 28 69 66 20 74 6f 70 70 61 74 68 20 28 6d 61 6b (if toppath (mak
14030 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 e-dbr:dbstruct p
14040 61 74 68 3a 20 74 6f 70 70 61 74 68 20 6c 6f 63 ath: toppath loc
14050 61 6c 3a 20 23 74 29 29 29 29 0a 3b 3b 20 3b 3b al: #t)))).;; ;;
14060 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 ;; redo me
14070 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 3b 3b 20 (for-each .;;
14080 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
14090 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 69 (lambda (fi
140a0 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 eld).;; ;; ;; re
140b0 64 6f 20 6d 65 20 09 20 28 6c 65 74 20 28 28 64 do me . (let ((d
140c0 61 74 20 27 28 29 29 29 0a 3b 3b 20 3b 3b 20 3b at '())).;; ;; ;
140d0 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 64 ; redo me . (d
140e0 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
140f0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
14100 6f 72 74 2a 20 22 47 65 74 74 69 6e 67 20 64 61 ort* "Getting da
14110 74 61 20 66 6f 72 20 66 69 65 6c 64 20 22 20 66 ta for field " f
14120 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 ield).;; ;; ;; r
14130 65 64 6f 20 6d 65 20 09 20 20 20 28 73 71 6c 69 edo me . (sqli
14140 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
14150 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
14160 65 20 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 e . (lambda (
14170 69 64 20 76 61 6c 29 0a 3b 3b 20 3b 3b 20 3b 3b id val).;; ;; ;;
14180 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 20 redo me .
14190 28 73 65 74 21 20 64 61 74 20 28 63 6f 6e 73 20 (set! dat (cons
141a0 28 6c 69 73 74 20 69 64 20 76 61 6c 29 20 64 61 (list id val) da
141b0 74 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 t))).;; ;; ;; re
141c0 64 6f 20 6d 65 20 09 20 20 20 20 28 64 62 3a 67 do me . (db:g
141d0 65 74 2d 64 62 20 64 62 20 72 75 6e 2d 69 64 29 et-db db run-id)
141e0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
141f0 65 20 09 20 20 20 20 28 63 6f 6e 63 20 22 53 45 e . (conc "SE
14200 4c 45 43 54 20 69 64 2c 22 20 66 69 65 6c 64 20 LECT id," field
14210 22 20 46 52 4f 4d 20 74 65 73 74 73 3b 22 29 29 " FROM tests;"))
14220 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
14230 65 20 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 e . (debug:pri
14240 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
14250 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 6f lt-log-port* "fo
14260 75 6e 64 20 22 20 28 6c 65 6e 67 74 68 20 64 61 und " (length da
14270 74 29 20 22 20 69 74 65 6d 73 20 66 6f 72 20 66 t) " items for f
14280 69 65 6c 64 20 22 20 66 69 65 6c 64 29 0a 3b 3b ield " field).;;
14290 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
142a0 20 20 20 28 6c 65 74 20 28 28 71 72 79 20 28 73 (let ((qry (s
142b0 71 6c 69 74 65 33 3a 70 72 65 70 61 72 65 20 64 qlite3:prepare d
142c0 62 20 28 63 6f 6e 63 20 22 55 50 44 41 54 45 20 b (conc "UPDATE
142d0 74 65 73 74 73 20 53 45 54 20 22 20 66 69 65 6c tests SET " fiel
142e0 64 20 22 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f d "=? WHERE id=?
142f0 3b 22 29 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 ;")))).;; ;; ;;
14300 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 28 66 redo me . (f
14310 6f 72 2d 65 61 63 68 0a 3b 3b 20 3b 3b 20 3b 3b or-each.;; ;; ;;
14320 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 20 redo me .
14330 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 3b (lambda (item).;
14340 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
14350 09 09 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 ..(let ((newval
14360 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 67 65 74 ;; (sdb:qry 'get
14370 69 64 20 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 id .;; ;; ;; red
14380 6f 20 6d 65 20 09 09 20 20 20 20 20 20 20 28 63 o me .. (c
14390 61 64 72 20 69 74 65 6d 29 29 29 20 3b 3b 20 29 adr item))) ;; )
143a0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
143b0 65 20 09 09 20 20 28 69 66 20 28 6e 6f 74 20 28 e .. (if (not (
143c0 65 71 75 61 6c 3f 20 6e 65 77 76 61 6c 20 28 63 equal? newval (c
143d0 61 64 72 20 69 74 65 6d 29 29 29 0a 3b 3b 20 3b adr item))).;; ;
143e0 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 20 ; ;; redo me ..
143f0 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
14400 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
14410 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 6f 6e t-log-port* "Con
14420 76 65 72 74 69 6e 67 20 22 20 28 63 61 64 72 20 verting " (cadr
14430 69 74 65 6d 29 20 22 20 74 6f 20 22 20 6e 65 77 item) " to " new
14440 76 61 6c 20 22 20 66 6f 72 20 74 65 73 74 20 23 val " for test #
14450 22 20 28 63 61 72 20 69 74 65 6d 29 29 29 0a 3b " (car item))).;
14460 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
14470 09 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 .. (sqlite3:exe
14480 63 75 74 65 20 71 72 79 20 6e 65 77 76 61 6c 20 cute qry newval
14490 28 63 61 72 20 69 74 65 6d 29 29 29 29 0a 3b 3b (car item)))).;;
144a0 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
144b0 20 20 20 20 20 20 64 61 74 29 0a 3b 3b 20 3b 3b dat).;; ;;
144c0 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
144d0 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
144e0 69 7a 65 21 20 71 72 79 29 29 29 29 0a 3b 3b 20 ize! qry)))).;;
144f0 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
14500 20 20 20 20 20 28 64 62 3a 63 6c 6f 73 65 2d 61 (db:close-a
14510 6c 6c 20 64 62 73 74 72 75 63 74 29 0a 3b 3b 20 ll dbstruct).;;
14520 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
14530 20 20 20 20 20 28 6c 69 73 74 20 22 75 6e 61 6d (list "unam
14540 65 22 20 22 72 75 6e 64 69 72 22 20 22 66 69 6e e" "rundir" "fin
14550 61 6c 5f 6c 6f 67 66 22 20 22 63 6f 6d 6d 65 6e al_logf" "commen
14560 74 22 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 t")).;; ;; ;; re
14570 64 6f 20 6d 65 20 20 20 20 20 20 20 28 73 65 74 do me (set
14580 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
14590 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
145a0 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 6d 70 6f s:get-arg "-impo
145b0 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 29 rt-megatest.db")
145c0 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
145d0 20 20 28 64 62 3a 6d 75 6c 74 69 2d 64 62 2d 73 (db:multi-db-s
145e0 79 6e 63 20 0a 20 20 20 20 20 20 20 28 64 62 3a ync . (db:
145f0 73 65 74 75 70 29 0a 20 20 20 20 20 20 20 27 6b setup). 'k
14600 69 6c 6c 73 65 72 76 65 72 73 0a 20 20 20 20 20 illservers.
14610 20 20 27 64 65 6a 75 6e 6b 0a 20 20 20 20 20 20 'dejunk.
14620 20 27 61 64 6a 2d 74 65 73 74 69 64 73 0a 20 20 'adj-testids.
14630 20 20 20 20 20 27 6f 6c 64 32 6e 65 77 0a 20 20 'old2new.
14640 20 20 20 20 20 3b 3b 20 27 6e 65 77 32 6f 6c 64 ;; 'new2old
14650 0a 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 20 . ).
14660 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
14670 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
14680 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
14690 73 79 6e 63 2d 74 6f 2d 6d 65 67 61 74 65 73 74 sync-to-megatest
146a0 2e 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e .db"). (begin
146b0 0a 20 20 20 20 20 20 28 64 62 3a 6d 75 6c 74 69 . (db:multi
146c0 2d 64 62 2d 73 79 6e 63 20 0a 20 20 20 20 20 20 -db-sync .
146d0 20 28 64 62 3a 73 65 74 75 70 29 0a 20 20 20 20 (db:setup).
146e0 20 20 20 27 6e 65 77 32 6f 6c 64 0a 20 20 20 20 'new2old.
146f0 20 20 20 29 0a 20 20 20 20 20 20 28 73 65 74 21 ). (set!
14700 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
14710 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 #t)))..(if (args
14720 3a 67 65 74 2d 61 72 67 20 22 2d 73 79 6e 63 2d :get-arg "-sync-
14730 74 6f 2d 63 6f 6e 66 69 67 64 62 22 29 0a 20 20 to-configdb").
14740 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
14750 64 62 3a 6d 75 6c 74 69 2d 64 62 2d 73 79 6e 63 db:multi-db-sync
14760 20 0a 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 . (db:set
14770 75 70 29 0a 20 20 20 20 20 20 20 27 73 79 6e 63 up). 'sync
14780 74 6f 63 6f 6e 66 69 67 0a 20 20 20 20 20 20 20 toconfig.
14790 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
147a0 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
147b0 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
147c0 74 2d 61 72 67 20 22 2d 67 65 6e 65 72 61 74 65 t-arg "-generate
147d0 2d 68 74 6d 6c 22 29 0a 20 20 20 20 28 6c 65 74 -html"). (let
147e0 2a 20 28 28 74 6f 70 70 61 74 68 20 28 6c 61 75 * ((toppath (lau
147f0 6e 63 68 3a 73 65 74 75 70 29 29 29 0a 20 20 20 nch:setup))).
14800 20 20 20 28 69 66 20 28 74 65 73 74 73 3a 63 72 (if (tests:cr
14810 65 61 74 65 2d 68 74 6d 6c 2d 74 72 65 65 20 23 eate-html-tree #
14820 66 29 0a 20 20 20 20 20 20 20 20 20 20 28 64 65 f). (de
14830 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
14840 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
14850 72 74 2a 20 22 48 54 4d 4c 20 6f 75 74 70 75 74 rt* "HTML output
14860 20 63 72 65 61 74 65 64 20 69 6e 20 22 20 74 6f created in " to
14870 70 70 61 74 68 20 22 2f 6c 74 2f 70 61 67 65 23 ppath "/lt/page#
14880 2e 68 74 6d 6c 22 29 0a 20 20 20 20 20 20 20 20 .html").
14890 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
148a0 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
148b0 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 63 rt* "Failed to c
148c0 72 65 61 74 65 20 48 54 4d 4c 20 6f 75 74 70 75 reate HTML outpu
148d0 74 20 69 6e 20 22 20 74 6f 70 70 61 74 68 20 22 t in " toppath "
148e0 2f 6c 74 2f 72 75 6e 73 2d 69 6e 64 65 78 2e 68 /lt/runs-index.h
148f0 74 6d 6c 22 29 29 0a 20 20 20 20 20 20 28 73 65 tml")). (se
14900 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
14910 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d * #t)))..;;=====
14920 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14930 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14940 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14950 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14960 3d 0a 3b 3b 20 45 78 69 74 20 61 6e 64 20 63 6c =.;; Exit and cl
14970 65 61 6e 20 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d ean up.;;=======
14980 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14990 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
149a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
149b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
149c0 0a 28 69 66 20 28 6e 6f 74 20 2a 64 69 64 73 6f .(if (not *didso
149d0 6d 65 74 68 69 6e 67 2a 29 0a 20 20 20 20 28 64 mething*). (d
149e0 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
149f0 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
14a00 68 65 6c 70 29 29 0a 3b 3b 28 42 42 3e 20 22 74 help)).;;(BB> "t
14a10 68 72 65 61 64 2d 6a 6f 69 6e 21 20 77 61 74 63 hread-join! watc
14a20 68 64 6f 67 22 29 0a 0a 3b 3b 20 6a 6f 69 6e 20 hdog")..;; join
14a30 74 68 65 20 77 61 74 63 68 64 6f 67 20 74 68 72 the watchdog thr
14a40 65 61 64 20 69 66 20 69 74 20 68 61 73 20 62 65 ead if it has be
14a50 65 6e 20 74 68 72 65 61 64 2d 73 74 61 72 74 21 en thread-start!
14a60 65 64 20 20 28 69 74 20 6d 61 79 20 6e 6f 74 20 ed (it may not
14a70 68 61 76 65 20 62 65 65 6e 20 73 74 61 72 74 65 have been starte
14a80 64 20 69 6e 20 74 68 65 20 63 61 73 65 20 6f 66 d in the case of
14a90 20 61 20 73 65 72 76 65 72 20 74 68 61 74 20 6e a server that n
14aa0 65 76 65 72 20 65 6e 74 65 72 73 20 72 75 6e 6e ever enters runn
14ab0 69 6e 67 20 73 74 61 74 65 29 0a 3b 3b 20 20 20 ing state).;;
14ac0 28 73 79 6d 62 6f 6c 73 20 72 65 74 75 72 6e 65 (symbols returne
14ad0 64 20 62 79 20 74 68 72 65 61 64 2d 73 74 61 74 d by thread-stat
14ae0 65 3a 20 63 72 65 61 74 65 64 20 72 65 61 64 79 e: created ready
14af0 20 72 75 6e 6e 69 6e 67 20 62 6c 6f 63 6b 65 64 running blocked
14b00 20 73 75 73 70 65 6e 64 65 64 20 73 6c 65 65 70 suspended sleep
14b10 69 6e 67 20 74 65 72 6d 69 6e 61 74 65 64 20 64 ing terminated d
14b20 65 61 64 29 0a 28 69 66 20 28 74 68 72 65 61 64 ead).(if (thread
14b30 3f 20 2a 77 61 74 63 68 64 6f 67 2a 29 0a 20 20 ? *watchdog*).
14b40 20 20 28 63 61 73 65 20 28 74 68 72 65 61 64 2d (case (thread-
14b50 73 74 61 74 65 20 2a 77 61 74 63 68 64 6f 67 2a state *watchdog*
14b60 29 0a 20 20 20 20 20 20 28 28 72 65 61 64 79 20 ). ((ready
14b70 72 75 6e 6e 69 6e 67 20 62 6c 6f 63 6b 65 64 20 running blocked
14b80 73 6c 65 65 70 69 6e 67 20 74 65 72 6d 69 6e 61 sleeping termina
14b90 74 65 64 20 64 65 61 64 29 0a 20 20 20 20 20 20 ted dead).
14ba0 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 2a (thread-join! *
14bb0 77 61 74 63 68 64 6f 67 2a 29 29 29 29 0a 0a 28 watchdog*))))..(
14bc0 73 65 74 21 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 set! *time-to-ex
14bd0 69 74 2a 20 23 74 29 0a 0a 28 69 66 20 28 6e 6f it* #t)..(if (no
14be0 74 20 28 65 71 3f 20 2a 67 6c 6f 62 61 6c 65 78 t (eq? *globalex
14bf0 69 74 73 74 61 74 75 73 2a 20 30 29 29 0a 20 20 itstatus* 0)).
14c00 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a (if (or (args:
14c10 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 28 get-arg "-run")(
14c20 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
14c30 75 6e 74 65 73 74 73 22 29 28 61 72 67 73 3a 67 untests")(args:g
14c40 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 et-arg "-runall"
14c50 29 29 0a 20 20 20 20 20 20 20 20 28 62 65 67 69 )). (begi
14c60 6e 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 65 n. (de
14c70 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
14c80 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
14c90 4e 4f 54 45 3a 20 53 75 62 70 72 6f 63 65 73 73 NOTE: Subprocess
14ca0 65 73 20 77 69 74 68 20 6e 6f 6e 2d 7a 65 72 6f es with non-zero
14cb0 20 65 78 69 74 20 63 6f 64 65 20 64 65 74 65 63 exit code detec
14cc0 74 65 64 3a 20 22 20 2a 67 6c 6f 62 61 6c 65 78 ted: " *globalex
14cd0 69 74 73 74 61 74 75 73 2a 29 0a 20 20 20 20 20 itstatus*).
14ce0 20 20 20 20 20 20 28 65 78 69 74 20 30 29 29 0a (exit 0)).
14cf0 20 20 20 20 20 20 20 20 28 63 61 73 65 20 2a 67 (case *g
14d00 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
14d10 0a 20 20 20 20 20 20 20 20 20 28 28 30 29 28 65 . ((0)(e
14d20 78 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 xit 0)).
14d30 20 28 28 31 29 28 65 78 69 74 20 31 29 29 0a 20 ((1)(exit 1)).
14d40 20 20 20 20 20 20 20 20 28 28 32 29 28 65 78 69 ((2)(exi
14d50 74 20 32 29 29 0a 20 20 20 20 20 20 20 20 20 28 t 2)). (
14d60 65 6c 73 65 20 28 65 78 69 74 20 33 29 29 29 29 else (exit 3))))
14d70 29 0a ).