0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 20 6-2012, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 made available
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 .;; greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 ng file COPYING
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 for details..;;
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 .;; This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c ven the.;; impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 ied warranty of
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 PARTICULAR.;;
0140: 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 20 28 69 6e PURPOSE...;; (in
0150: 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 2e 73 63 clude "common.sc
0160: 6d 22 29 0a 3b 3b 20 28 69 6e 63 6c 75 64 65 20 m").;; (include
0170: 22 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f "megatest-versio
0180: 6e 2e 73 63 6d 22 29 0a 0a 3b 3b 20 66 61 6b 65 n.scm")..;; fake
0190: 20 6f 75 74 20 72 65 61 64 6c 69 6e 65 20 75 73 out readline us
01a0: 61 67 65 20 6f 66 20 74 6f 70 6c 65 76 65 6c 2d age of toplevel-
01b0: 63 6f 6d 6d 61 6e 64 0a 28 64 65 66 69 6e 65 20 command.(define
01c0: 28 74 6f 70 6c 65 76 65 6c 2d 63 6f 6d 6d 61 6e (toplevel-comman
01d0: 64 20 2e 20 61 29 20 23 66 29 0a 0a 28 75 73 65 d . a) #f)..(use
01e0: 20 73 71 6c 69 74 65 33 20 73 72 66 69 2d 31 20 sqlite3 srfi-1
01f0: 70 6f 73 69 78 20 72 65 67 65 78 20 72 65 67 65 posix regex rege
0200: 78 2d 63 61 73 65 20 73 72 66 69 2d 36 39 20 62 x-case srfi-69 b
0210: 61 73 65 36 34 20 72 65 61 64 6c 69 6e 65 20 61 ase64 readline a
0220: 70 72 6f 70 6f 73 20 6a 73 6f 6e 20 68 74 74 70 propos json http
0230: 2d 63 6c 69 65 6e 74 20 64 69 72 65 63 74 6f 72 -client director
0240: 79 2d 75 74 69 6c 73 20 72 70 63 20 74 79 70 65 y-utils rpc type
0250: 64 2d 72 65 63 6f 72 64 73 3b 3b 20 28 73 72 66 d-records;; (srf
0260: 69 20 31 38 29 20 65 78 74 72 61 73 29 0a 20 20 i 18) extras).
0270: 20 20 20 68 74 74 70 2d 63 6c 69 65 6e 74 20 73 http-client s
0280: 72 66 69 2d 31 38 20 65 78 74 72 61 73 20 66 6f rfi-18 extras fo
0290: 72 6d 61 74 29 20 3b 3b 20 20 7a 6d 71 20 65 78 rmat) ;; zmq ex
02a0: 74 72 61 73 29 0a 0a 3b 3b 20 41 64 64 65 64 20 tras)..;; Added
02b0: 66 6f 72 20 63 73 76 20 73 74 75 66 66 20 2d 20 for csv stuff -
02c0: 77 69 6c 6c 20 62 65 20 72 65 6d 6f 76 65 64 0a will be removed.
02d0: 3b 3b 0a 28 75 73 65 20 73 70 61 72 73 65 2d 76 ;;.(use sparse-v
02e0: 65 63 74 6f 72 73 29 0a 0a 28 69 6d 70 6f 72 74 ectors)..(import
02f0: 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 (prefix sqlite3
0300: 20 73 71 6c 69 74 65 33 3a 29 29 0a 28 69 6d 70 sqlite3:)).(imp
0310: 6f 72 74 20 28 70 72 65 66 69 78 20 62 61 73 65 ort (prefix base
0320: 36 34 20 62 61 73 65 36 34 3a 29 29 0a 28 69 6d 64 base64:)).(im
0330: 70 6f 72 74 20 28 70 72 65 66 69 78 20 72 70 63 port (prefix rpc
0340: 20 72 70 63 3a 29 29 0a 28 72 65 71 75 69 72 65 rpc:)).(require
0350: 2d 6c 69 62 72 61 72 79 20 6d 75 74 69 6c 73 29 -library mutils)
0360: 0a 0a 3b 3b 20 28 75 73 65 20 7a 6d 71 29 0a 0a ..;; (use zmq)..
0370: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 (declare (uses c
0380: 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 ommon)).(declare
0390: 20 28 75 73 65 73 20 6d 65 67 61 74 65 73 74 2d (uses megatest-
03a0: 76 65 72 73 69 6f 6e 29 29 0a 28 64 65 63 6c 61 version)).(decla
03b0: 72 65 20 28 75 73 65 73 20 6d 61 72 67 73 29 29 re (uses margs))
03c0: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
03d0: 72 75 6e 73 29 29 0a 28 64 65 63 6c 61 72 65 20 runs)).(declare
03e0: 28 75 73 65 73 20 6c 61 75 6e 63 68 29 29 0a 28 (uses launch)).(
03f0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 73 65 declare (uses se
0400: 72 76 65 72 29 29 0a 28 64 65 63 6c 61 72 65 20 rver)).(declare
0410: 28 75 73 65 73 20 63 6c 69 65 6e 74 29 29 0a 28 (uses client)).(
0420: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 74 65 declare (uses te
0430: 73 74 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 sts)).(declare (
0440: 75 73 65 73 20 67 65 6e 65 78 61 6d 70 6c 65 29 uses genexample)
0450: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0460: 20 64 61 65 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 daemon)).(decla
0470: 72 65 20 28 75 73 65 73 20 64 62 29 29 0a 3b 3b re (uses db)).;;
0480: 20 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 (declare (uses
0490: 64 63 6f 6d 6d 6f 6e 29 29 0a 0a 28 64 65 63 6c dcommon))..(decl
04a0: 61 72 65 20 28 75 73 65 73 20 74 64 62 29 29 0a are (uses tdb)).
04b0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
04c0: 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 t)).(declare (us
04d0: 65 73 20 61 70 69 29 29 0a 28 64 65 63 6c 61 72 es api)).(declar
04e0: 65 20 28 75 73 65 73 20 74 61 73 6b 73 29 29 20 e (uses tasks))
04f0: 3b 3b 20 6f 6e 6c 79 20 75 73 65 64 20 66 6f 72 ;; only used for
0500: 20 64 65 62 75 67 67 69 6e 67 2e 0a 28 64 65 63 debugging..(dec
0510: 6c 61 72 65 20 28 75 73 65 73 20 65 6e 76 29 29 lare (uses env))
0520: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0530: 64 69 66 66 2d 72 65 70 6f 72 74 29 29 0a 0a 28 diff-report))..(
0540: 64 65 66 69 6e 65 20 2a 64 62 2a 20 23 66 29 20 define *db* #f)
0550: 3b 3b 20 74 68 69 73 20 69 73 20 6f 6e 6c 79 20 ;; this is only
0560: 66 6f 72 20 74 68 65 20 72 65 70 6c 2c 20 64 6f for the repl, do
0570: 20 6e 6f 74 20 75 73 65 20 69 6e 20 67 65 6e 65 not use in gene
0580: 72 61 6c 21 21 21 21 0a 0a 28 69 6e 63 6c 75 64 ral!!!!..(includ
0590: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
05a0: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
05b0: 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 "key_records.sc
05c0: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 m").(include "db
05d0: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 _records.scm").(
05e0: 69 6e 63 6c 75 64 65 20 22 72 75 6e 5f 72 65 63 include "run_rec
05f0: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl
0600: 75 64 65 20 22 6d 65 67 61 74 65 73 74 2d 66 6f ude "megatest-fo
0610: 73 73 69 6c 2d 68 61 73 68 2e 73 63 6d 22 29 0a ssil-hash.scm").
0620: 0a 28 6c 65 74 20 28 28 64 65 62 75 67 63 6f 6e .(let ((debugcon
0630: 74 72 6f 6c 66 20 28 63 6f 6e 63 20 28 67 65 74 trolf (conc (get
0640: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
0650: 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2f iable "HOME") "/
0660: 2e 6d 65 67 61 74 65 73 74 72 63 22 29 29 29 0a .megatestrc"))).
0670: 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 (if (file-exis
0680: 74 73 3f 20 64 65 62 75 67 63 6f 6e 74 72 6f 6c ts? debugcontrol
0690: 66 29 0a 20 20 20 20 20 20 28 6c 6f 61 64 20 64 f). (load d
06a0: 65 62 75 67 63 6f 6e 74 72 6f 6c 66 29 29 29 0a ebugcontrolf))).
06b0: 0a 3b 3b 20 44 69 73 61 62 6c 65 64 20 68 65 6c .;; Disabled hel
06c0: 70 20 69 74 65 6d 73 0a 3b 3b 20 20 2d 72 6f 6c p items.;; -rol
06d0: 6c 75 70 20 20 20 20 20 20 20 20 20 20 20 20 20 lup
06e0: 20 20 20 20 3a 20 28 63 75 72 72 65 6e 74 6c 79 : (currently
06f0: 20 64 69 73 61 62 6c 65 64 29 20 66 69 6c 6c 20 disabled) fill
0700: 72 75 6e 20 28 73 65 74 20 62 79 20 3a 72 75 6e run (set by :run
0710: 6e 61 6d 65 29 20 20 77 69 74 68 20 6c 61 74 65 name) with late
0720: 73 74 20 74 65 73 74 28 73 29 0a 3b 3b 20 20 20 st test(s).;;
0730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0740: 20 20 20 20 20 20 20 20 20 66 72 6f 6d 20 70 72 from pr
0750: 69 6f 72 20 72 75 6e 73 20 77 69 74 68 20 73 61 ior runs with sa
0760: 6d 65 20 6b 65 79 73 0a 0a 28 64 65 66 69 6e 65 me keys..(define
0770: 20 68 65 6c 70 20 28 63 6f 6e 63 20 22 0a 4d 65 help (conc ".Me
0780: 67 61 74 65 73 74 2c 20 64 6f 63 75 6d 65 6e 74 gatest, document
0790: 61 74 69 6f 6e 20 61 74 20 68 74 74 70 3a 2f 2f ation at http://
07a0: 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 www.kiatoa.com/f
07b0: 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 0a ossils/megatest.
07c0: 20 20 76 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 version " mega
07d0: 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 0a 20 test-version ".
07e0: 20 6c 69 63 65 6e 73 65 20 47 50 4c 2c 20 43 6f license GPL, Co
07f0: 70 79 72 69 67 68 74 20 4d 61 74 74 20 57 65 6c pyright Matt Wel
0800: 6c 61 6e 64 20 32 30 30 36 2d 32 30 31 35 0a 0a land 2006-2015..
0810: 55 73 61 67 65 3a 20 6d 65 67 61 74 65 73 74 20 Usage: megatest
0820: 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 2d 68 20 20 [options]. -h
0830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0840: 20 20 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a : this help.
0850: 20 20 2d 6d 61 6e 75 61 6c 20 20 20 20 20 20 20 -manual
0860: 20 20 20 20 20 20 20 20 20 20 3a 20 73 68 6f 77 : show
0870: 20 74 68 65 20 4d 65 67 61 74 65 73 74 20 75 73 the Megatest us
0880: 65 72 20 6d 61 6e 75 61 6c 0a 20 20 2d 76 65 72 er manual. -ver
0890: 73 69 6f 6e 20 20 20 20 20 20 20 20 20 20 20 20 sion
08a0: 20 20 20 20 3a 20 70 72 69 6e 74 20 6d 65 67 61 : print mega
08b0: 74 65 73 74 20 76 65 72 73 69 6f 6e 20 28 63 75 test version (cu
08c0: 72 72 65 6e 74 6c 79 20 22 20 6d 65 67 61 74 65 rrently " megate
08d0: 73 74 2d 76 65 72 73 69 6f 6e 20 22 29 0a 0a 4c st-version ")..L
08e0: 61 75 6e 63 68 69 6e 67 20 61 6e 64 20 6d 61 6e aunching and man
08f0: 61 67 69 6e 67 20 72 75 6e 73 0a 20 20 2d 72 75 aging runs. -ru
0900: 6e 61 6c 6c 20 20 20 20 20 20 20 20 20 20 20 20 nall
0910: 20 20 20 20 20 3a 20 72 75 6e 20 61 6c 6c 20 74 : run all t
0920: 65 73 74 73 20 6f 72 20 61 73 20 73 70 65 63 69 ests or as speci
0930: 66 69 65 64 20 62 79 20 2d 74 65 73 74 70 61 74 fied by -testpat
0940: 74 0a 20 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 t. -remove-runs
0950: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 : re
0960: 6d 6f 76 65 20 74 68 65 20 64 61 74 61 20 66 6f move the data fo
0970: 72 20 61 20 72 75 6e 2c 20 72 65 71 75 69 72 65 r a run, require
0980: 73 20 2d 72 75 6e 6e 61 6d 65 20 61 6e 64 20 2d s -runname and -
0990: 74 65 73 74 70 61 74 74 0a 20 20 20 20 20 20 20 testpatt.
09a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09b0: 20 20 20 20 20 4f 70 74 69 6f 6e 61 6c 6c 79 20 Optionally
09c0: 75 73 65 20 3a 73 74 61 74 65 20 61 6e 64 20 3a use :state and :
09d0: 73 74 61 74 75 73 0a 20 20 2d 73 65 74 2d 73 74 status. -set-st
09e0: 61 74 65 2d 73 74 61 74 75 73 20 58 2c 59 20 20 ate-status X,Y
09f0: 20 3a 20 73 65 74 20 73 74 61 74 65 20 74 6f 20 : set state to
0a00: 58 20 61 6e 64 20 73 74 61 74 75 73 20 74 6f 20 X and status to
0a10: 59 2c 20 72 65 71 75 69 72 65 73 20 63 6f 6e 74 Y, requires cont
0a20: 72 6f 6c 73 20 70 65 72 20 2d 72 65 6d 6f 76 65 rols per -remove
0a30: 2d 72 75 6e 73 0a 20 20 2d 72 65 72 75 6e 20 46 -runs. -rerun F
0a40: 41 49 4c 2c 57 41 52 4e 2e 2e 2e 20 20 20 20 20 AIL,WARN...
0a50: 3a 20 66 6f 72 63 65 20 72 65 2d 72 75 6e 20 66 : force re-run f
0a60: 6f 72 20 74 65 73 74 73 20 77 69 74 68 20 73 70 or tests with sp
0a70: 65 63 69 66 69 63 65 64 20 73 74 61 74 75 73 28 ecificed status(
0a80: 73 29 0a 20 20 2d 72 65 72 75 6e 2d 63 6c 65 61 s). -rerun-clea
0a90: 6e 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 n : s
0aa0: 65 74 20 61 6c 6c 20 74 65 73 74 73 20 6e 6f 74 et all tests not
0ab0: 20 43 4f 4d 50 4c 45 54 45 44 2b 50 41 53 53 2c COMPLETED+PASS,
0ac0: 57 41 52 4e 2c 57 41 49 56 45 44 20 74 6f 20 4e WARN,WAIVED to N
0ad0: 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 0a 20 OT_STARTED,n/a.
0ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0af0: 20 20 20 20 20 20 20 20 20 20 20 61 6e 64 20 74 and t
0b00: 68 65 6e 20 72 75 6e 20 74 68 65 20 73 70 65 63 hen run the spec
0b10: 69 66 69 65 64 20 74 65 73 74 70 61 74 74 20 77 ified testpatt w
0b20: 69 74 68 20 2d 70 72 65 63 6c 65 61 6e 0a 20 20 ith -preclean.
0b30: 2d 72 65 72 75 6e 2d 61 6c 6c 20 20 20 20 20 20 -rerun-all
0b40: 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 61 6c : set al
0b50: 6c 20 74 65 73 74 73 20 74 6f 20 4e 4f 54 5f 53 l tests to NOT_S
0b60: 54 41 52 54 45 44 2c 6e 2f 61 20 61 6e 64 20 72 TARTED,n/a and r
0b70: 75 6e 20 77 69 74 68 20 2d 70 72 65 63 6c 65 61 un with -preclea
0b80: 6e 0a 20 20 2d 6c 6f 63 6b 20 20 20 20 20 20 20 n. -lock
0b90: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 6f : lo
0ba0: 63 6b 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 ck run specified
0bb0: 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 by target and r
0bc0: 75 6e 6e 61 6d 65 0a 20 20 2d 75 6e 6c 6f 63 6b unname. -unlock
0bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0be0: 20 3a 20 75 6e 6c 6f 63 6b 20 72 75 6e 20 73 70 : unlock run sp
0bf0: 65 63 69 66 69 65 64 20 62 79 20 74 61 72 67 65 ecified by targe
0c00: 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 20 t and runname.
0c10: 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 -set-run-status
0c20: 73 74 61 74 75 73 20 20 3a 20 73 65 74 73 20 73 status : sets s
0c30: 74 61 74 75 73 20 66 6f 72 20 72 75 6e 20 74 6f tatus for run to
0c40: 20 73 74 61 74 75 73 2c 20 72 65 71 75 69 72 65 status, require
0c50: 73 20 2d 74 61 72 67 65 74 20 61 6e 64 20 2d 72 s -target and -r
0c60: 75 6e 6e 61 6d 65 0a 20 20 2d 67 65 74 2d 72 75 unname. -get-ru
0c70: 6e 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 20 n-status
0c80: 20 3a 20 67 65 74 73 20 73 74 61 74 75 73 20 66 : gets status f
0c90: 6f 72 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 or run specified
0ca0: 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 by target and r
0cb0: 75 6e 6e 61 6d 65 0a 20 20 2d 72 75 6e 2d 77 61 unname. -run-wa
0cc0: 69 74 20 20 20 20 20 20 20 20 20 20 20 20 20 20 it
0cd0: 20 3a 20 77 61 69 74 20 6f 6e 20 72 75 6e 20 73 : wait on run s
0ce0: 70 65 63 69 66 69 65 64 20 62 79 20 74 61 72 67 pecified by targ
0cf0: 65 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 et and runname.
0d00: 20 2d 70 72 65 63 6c 65 61 6e 20 20 20 20 20 20 -preclean
0d10: 20 20 20 20 20 20 20 20 20 3a 20 72 65 6d 6f 76 : remov
0d20: 65 20 74 68 65 20 65 78 69 73 74 69 6e 67 20 74 e the existing t
0d30: 65 73 74 20 64 69 72 65 63 74 6f 72 79 20 62 65 est directory be
0d40: 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 74 68 65 fore running the
0d50: 20 74 65 73 74 0a 20 20 2d 63 6c 65 61 6e 2d 63 test. -clean-c
0d60: 61 63 68 65 20 20 20 20 20 20 20 20 20 20 20 20 ache
0d70: 3a 20 72 65 6d 6f 76 65 20 74 68 65 20 63 61 63 : remove the cac
0d80: 68 65 64 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e hed megatest.con
0d90: 66 69 67 20 61 6e 64 20 72 75 6e 63 6f 6e 66 69 fig and runconfi
0da0: 67 2e 63 6f 6e 66 69 67 20 66 69 6c 65 73 0a 0a g.config files..
0db0: 53 65 6c 65 63 74 6f 72 73 20 28 65 2e 67 2e 20 Selectors (e.g.
0dc0: 75 73 65 20 66 6f 72 20 2d 72 75 6e 74 65 73 74 use for -runtest
0dd0: 73 2c 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 2c s, -remove-runs,
0de0: 20 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 -set-state-stat
0df0: 75 73 2c 20 2d 6c 69 73 74 2d 72 75 6e 73 20 65 us, -list-runs e
0e00: 74 63 2e 29 0a 20 20 2d 74 61 72 67 65 74 20 6b tc.). -target k
0e10: 65 79 31 2f 6b 65 79 32 2f 2e 2e 2e 20 20 20 3a ey1/key2/... :
0e20: 20 72 75 6e 20 66 6f 72 20 6b 65 79 31 2c 20 6b run for key1, k
0e30: 65 79 32 2c 20 65 74 63 2e 0a 20 20 2d 72 65 71 ey2, etc.. -req
0e40: 74 61 72 67 20 6b 65 79 31 2f 6b 65 79 32 2f 2e targ key1/key2/.
0e50: 2e 2e 20 20 3a 20 72 75 6e 20 66 6f 72 20 6b 65 .. : run for ke
0e60: 79 31 2c 20 6b 65 79 32 2c 20 65 74 63 2e 20 62 y1, key2, etc. b
0e70: 75 74 20 6b 65 79 31 2f 6b 65 79 32 20 6d 75 73 ut key1/key2 mus
0e80: 74 20 62 65 20 69 6e 20 72 75 6e 63 6f 6e 66 69 t be in runconfi
0e90: 67 0a 20 20 2d 74 65 73 74 70 61 74 74 20 70 61 g. -testpatt pa
0ea0: 74 74 31 2f 70 61 74 74 32 2c 70 61 74 74 33 2f tt1/patt2,patt3/
0eb0: 2e 2e 2e 20 20 3a 20 25 20 69 73 20 77 69 6c 64 ... : % is wild
0ec0: 63 61 72 64 0a 20 20 2d 72 75 6e 6e 61 6d 65 20 card. -runname
0ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0ee0: 20 72 65 71 75 69 72 65 64 2c 20 6e 61 6d 65 20 required, name
0ef0: 66 6f 72 20 74 68 69 73 20 70 61 72 74 69 63 75 for this particu
0f00: 6c 61 72 20 74 65 73 74 20 72 75 6e 0a 20 20 2d lar test run. -
0f10: 73 74 61 74 65 20 20 20 20 20 20 20 20 20 20 20 state
0f20: 20 20 20 20 20 20 20 3a 20 41 70 70 6c 69 65 73 : Applies
0f30: 20 74 6f 20 72 75 6e 73 2c 20 74 65 73 74 73 20 to runs, tests
0f40: 6f 72 20 73 74 65 70 73 20 64 65 70 65 6e 64 69 or steps dependi
0f50: 6e 67 20 6f 6e 20 63 6f 6e 74 65 78 74 0a 20 20 ng on context.
0f60: 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 20 20 -status
0f70: 20 20 20 20 20 20 20 20 3a 20 41 70 70 6c 69 65 : Applie
0f80: 73 20 74 6f 20 72 75 6e 73 2c 20 74 65 73 74 73 s to runs, tests
0f90: 20 6f 72 20 73 74 65 70 73 20 64 65 70 65 6e 64 or steps depend
0fa0: 69 6e 67 20 6f 6e 20 63 6f 6e 74 65 78 74 0a 20 ing on context.
0fb0: 20 2d 2d 6d 6f 64 65 70 61 74 74 20 6b 65 79 20 --modepatt key
0fc0: 20 20 20 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 : load
0fd0: 74 65 73 74 70 61 74 74 20 66 72 6f 6d 20 3c 6b testpatt from <k
0fe0: 65 79 3e 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 ey> in runconfig
0ff0: 73 20 69 6e 73 74 65 61 64 20 6f 66 20 64 65 66 s instead of def
1000: 61 75 6c 74 20 54 45 53 54 50 41 54 54 20 69 66 ault TESTPATT if
1010: 20 2d 74 65 73 74 70 61 74 74 20 61 6e 64 20 2d -testpatt and -
1020: 74 61 67 65 78 70 72 20 61 72 65 20 6e 6f 74 20 tagexpr are not
1030: 73 70 65 63 69 66 69 65 64 0a 20 20 2d 74 61 67 specified. -tag
1040: 65 78 70 72 20 74 61 67 31 2c 74 61 67 32 25 2c expr tag1,tag2%,
1050: 2e 2e 20 20 3a 20 73 65 6c 65 63 74 20 74 65 73 .. : select tes
1060: 74 73 20 77 69 74 68 20 74 61 67 73 20 6d 61 74 ts with tags mat
1070: 63 68 69 6e 67 20 65 78 70 72 65 73 73 69 6f 6e ching expression
1080: 0a 0a 54 65 73 74 20 68 65 6c 70 65 72 73 20 28 ..Test helpers (
1090: 66 6f 72 20 75 73 65 20 69 6e 73 69 64 65 20 74 for use inside t
10a0: 65 73 74 73 29 0a 20 20 2d 73 74 65 70 20 73 74 ests). -step st
10b0: 65 70 6e 61 6d 65 0a 20 20 2d 74 65 73 74 2d 73 epname. -test-s
10c0: 74 61 74 75 73 20 20 20 20 20 20 20 20 20 20 20 tatus
10d0: 20 3a 20 73 65 74 20 74 68 65 20 73 74 61 74 65 : set the state
10e0: 20 61 6e 64 20 73 74 61 74 75 73 20 6f 66 20 61 and status of a
10f0: 20 74 65 73 74 20 28 75 73 65 20 3a 73 74 61 74 test (use :stat
1100: 65 20 61 6e 64 20 3a 73 74 61 74 75 73 29 0a 20 e and :status).
1110: 20 2d 73 65 74 6c 6f 67 20 6c 6f 67 66 6e 61 6d -setlog logfnam
1120: 65 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 e : set t
1130: 68 65 20 70 61 74 68 2f 66 69 6c 65 6e 61 6d 65 he path/filename
1140: 20 74 6f 20 74 68 65 20 66 69 6e 61 6c 20 6c 6f to the final lo
1150: 67 20 72 65 6c 61 74 69 76 65 20 74 6f 20 74 68 g relative to th
1160: 65 20 74 65 73 74 0a 20 20 20 20 20 20 20 20 20 e test.
1170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1180: 20 20 20 64 69 72 65 63 74 6f 72 79 2e 20 6d 61 directory. ma
1190: 79 20 62 65 20 75 73 65 64 20 77 69 74 68 20 2d y be used with -
11a0: 74 65 73 74 2d 73 74 61 74 75 73 0a 20 20 2d 73 test-status. -s
11b0: 65 74 2d 74 6f 70 6c 6f 67 20 6c 6f 67 66 6e 61 et-toplog logfna
11c0: 6d 65 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 me : set the
11d0: 6f 76 65 72 61 6c 6c 20 6c 6f 67 20 66 6f 72 20 overall log for
11e0: 61 20 73 75 69 74 65 20 6f 66 20 73 75 62 2d 74 a suite of sub-t
11f0: 65 73 74 73 0a 20 20 2d 73 75 6d 6d 61 72 69 7a ests. -summariz
1200: 65 2d 69 74 65 6d 73 20 20 20 20 20 20 20 20 3a e-items :
1210: 20 66 6f 72 20 61 6e 20 69 74 65 6d 69 7a 65 64 for an itemized
1220: 20 74 65 73 74 20 63 72 65 61 74 65 20 61 20 73 test create a s
1230: 75 6d 6d 61 72 79 20 68 74 6d 6c 20 0a 20 20 2d ummary html . -
1240: 6d 20 63 6f 6d 6d 65 6e 74 20 20 20 20 20 20 20 m comment
1250: 20 20 20 20 20 20 20 3a 20 69 6e 73 65 72 74 20 : insert
1260: 61 20 63 6f 6d 6d 65 6e 74 20 66 6f 72 20 74 68 a comment for th
1270: 69 73 20 74 65 73 74 0a 0a 54 65 73 74 20 64 61 is test..Test da
1280: 74 61 20 63 61 70 74 75 72 65 0a 20 20 2d 73 65 ta capture. -se
1290: 74 2d 76 61 6c 75 65 73 20 20 20 20 20 20 20 20 t-values
12a0: 20 20 20 20 20 3a 20 75 70 64 61 74 65 20 6f 72 : update or
12b0: 20 73 65 74 20 76 61 6c 75 65 73 20 69 6e 20 74 set values in t
12c0: 68 65 20 74 65 73 74 64 61 74 61 20 74 61 62 6c he testdata tabl
12d0: 65 0a 20 20 3a 63 61 74 65 67 6f 72 79 20 20 20 e. :category
12e0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 : se
12f0: 74 20 74 68 65 20 63 61 74 65 67 6f 72 79 20 66 t the category f
1300: 69 65 6c 64 20 28 6f 70 74 69 6f 6e 61 6c 29 0a ield (optional).
1310: 20 20 3a 76 61 72 69 61 62 6c 65 20 20 20 20 20 :variable
1320: 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 : set
1330: 74 68 65 20 76 61 72 69 61 62 6c 65 20 6e 61 6d the variable nam
1340: 65 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a e (optional). :
1350: 76 61 6c 75 65 20 20 20 20 20 20 20 20 20 20 20 value
1360: 20 20 20 20 20 20 20 3a 20 76 61 6c 75 65 20 6d : value m
1370: 65 61 73 75 72 65 64 20 28 72 65 71 75 69 72 65 easured (require
1380: 64 29 0a 20 20 3a 65 78 70 65 63 74 65 64 20 20 d). :expected
1390: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 76 : v
13a0: 61 6c 75 65 20 65 78 70 65 63 74 65 64 20 28 72 alue expected (r
13b0: 65 71 75 69 72 65 64 29 0a 20 20 3a 74 6f 6c 20 equired). :tol
13c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13d0: 20 20 20 3a 20 7c 76 61 6c 75 65 2d 65 78 70 65 : |value-expe
13e0: 63 74 7c 20 3c 3d 20 74 6f 6c 20 28 72 65 71 75 ct| <= tol (requ
13f0: 69 72 65 64 2c 20 63 61 6e 20 62 65 20 3c 2c 20 ired, can be <,
1400: 3e 2c 20 3e 3d 2c 20 3c 3d 20 6f 72 20 6e 75 6d >, >=, <= or num
1410: 62 65 72 29 0a 20 20 3a 75 6e 69 74 73 20 20 20 ber). :units
1420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
1430: 20 6e 61 6d 65 20 6f 66 20 74 68 65 20 75 6e 69 name of the uni
1440: 74 73 20 66 6f 72 20 76 61 6c 75 65 2c 20 65 78 ts for value, ex
1450: 70 65 63 74 65 64 5f 76 61 6c 75 65 20 65 74 63 pected_value etc
1460: 2e 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 2d . (optional). -
1470: 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 20 20 load-test-data
1480: 20 20 20 20 20 20 20 3a 20 72 65 61 64 20 74 65 : read te
1490: 73 74 20 73 70 65 63 69 66 69 63 20 64 61 74 61 st specific data
14a0: 20 66 6f 72 20 73 74 6f 72 61 67 65 20 69 6e 20 for storage in
14b0: 74 68 65 20 74 65 73 74 5f 64 61 74 61 20 74 61 the test_data ta
14c0: 62 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ble.
14d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14e0: 66 72 6f 6d 20 73 74 61 6e 64 61 72 64 20 69 6e from standard in
14f0: 2e 20 45 61 63 68 20 6c 69 6e 65 20 69 73 20 63 . Each line is c
1500: 6f 6d 6d 61 20 64 65 6c 69 6d 69 74 65 64 20 77 omma delimited w
1510: 69 74 68 20 66 6f 75 72 0a 20 20 20 20 20 20 20 ith four.
1520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1530: 20 20 20 20 20 66 69 65 6c 64 73 20 63 61 74 65 fields cate
1540: 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 gory,variable,va
1550: 6c 75 65 2c 63 6f 6d 6d 65 6e 74 0a 0a 51 75 65 lue,comment..Que
1560: 72 69 65 73 0a 20 20 2d 6c 69 73 74 2d 72 75 6e ries. -list-run
1570: 73 20 70 61 74 74 20 20 20 20 20 20 20 20 20 3a s patt :
1580: 20 6c 69 73 74 20 72 75 6e 73 20 6d 61 74 63 68 list runs match
1590: 69 6e 67 20 70 61 74 74 65 72 6e 20 5c 22 70 61 ing pattern \"pa
15a0: 74 74 5c 22 2c 20 25 20 69 73 20 74 68 65 20 77 tt\", % is the w
15b0: 69 6c 64 63 61 72 64 0a 20 20 2d 73 68 6f 77 2d ildcard. -show-
15c0: 6b 65 79 73 20 20 20 20 20 20 20 20 20 20 20 20 keys
15d0: 20 20 3a 20 73 68 6f 77 20 74 68 65 20 6b 65 79 : show the key
15e0: 73 20 75 73 65 64 20 69 6e 20 74 68 69 73 20 6d s used in this m
15f0: 65 67 61 74 65 73 74 20 73 65 74 75 70 0a 20 20 egatest setup.
1600: 2d 74 65 73 74 2d 66 69 6c 65 73 20 74 61 72 67 -test-files targ
1610: 70 61 74 74 20 20 20 20 3a 20 67 65 74 20 74 68 patt : get th
1620: 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 20 74 65 e most recent te
1630: 73 74 20 70 61 74 68 2f 66 69 6c 65 20 6d 61 74 st path/file mat
1640: 63 68 69 6e 67 20 74 61 72 67 70 61 74 74 20 65 ching targpatt e
1650: 2e 67 2e 20 25 2f 25 20 6f 72 20 27 2a 2e 6c 6f .g. %/% or '*.lo
1660: 67 27 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 g'.
1670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
1680: 65 74 75 72 6e 73 20 6c 69 73 74 20 73 6f 72 74 eturns list sort
1690: 65 64 20 62 79 20 61 67 65 20 61 73 63 65 6e 64 ed by age ascend
16a0: 69 6e 67 2c 20 73 65 65 20 65 78 61 6d 70 6c 65 ing, see example
16b0: 73 20 62 65 6c 6f 77 0a 20 20 2d 74 65 73 74 2d s below. -test-
16c0: 70 61 74 68 73 20 20 20 20 20 20 20 20 20 20 20 paths
16d0: 20 20 3a 20 67 65 74 20 74 68 65 20 74 65 73 74 : get the test
16e0: 20 70 61 74 68 73 20 6d 61 74 63 68 69 6e 67 20 paths matching
16f0: 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c target, runname,
1700: 20 69 74 65 6d 20 61 6e 64 20 74 65 73 74 0a 20 item and test.
1710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1720: 20 20 20 20 20 20 20 20 20 20 20 70 61 74 74 65 patte
1730: 72 6e 73 2e 0a 20 20 2d 6c 69 73 74 2d 64 69 73 rns.. -list-dis
1740: 6b 73 20 20 20 20 20 20 20 20 20 20 20 20 20 3a ks :
1750: 20 6c 69 73 74 20 74 68 65 20 64 69 73 6b 73 20 list the disks
1760: 61 76 61 69 6c 61 62 6c 65 20 66 6f 72 20 73 74 available for st
1770: 6f 72 69 6e 67 20 72 75 6e 73 0a 20 20 2d 6c 69 oring runs. -li
1780: 73 74 2d 74 61 72 67 65 74 73 20 20 20 20 20 20 st-targets
1790: 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 65 20 : list the
17a0: 74 61 72 67 65 74 73 20 69 6e 20 72 75 6e 63 6f targets in runco
17b0: 6e 66 69 67 73 2e 63 6f 6e 66 69 67 0a 20 20 2d nfigs.config. -
17c0: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 20 list-db-targets
17d0: 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 : list th
17e0: 65 20 74 61 72 67 65 74 20 63 6f 6d 62 69 6e 61 e target combina
17f0: 74 69 6f 6e 73 20 75 73 65 64 20 69 6e 20 74 68 tions used in th
1800: 65 20 64 62 0a 20 20 2d 73 68 6f 77 2d 63 6f 6e e db. -show-con
1810: 66 69 67 20 20 20 20 20 20 20 20 20 20 20 20 3a fig :
1820: 20 64 75 6d 70 20 74 68 65 20 69 6e 74 65 72 6e dump the intern
1830: 61 6c 20 72 65 70 72 65 73 65 6e 74 61 74 69 6f al representatio
1840: 6e 20 6f 66 20 74 68 65 20 6d 65 67 61 74 65 73 n of the megates
1850: 74 2e 63 6f 6e 66 69 67 20 66 69 6c 65 0a 20 20 t.config file.
1860: 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 20 -show-runconfig
1870: 20 20 20 20 20 20 20 20 3a 20 64 75 6d 70 20 74 : dump t
1880: 68 65 20 69 6e 74 65 72 6e 61 6c 20 72 65 70 72 he internal repr
1890: 65 73 65 6e 74 61 74 69 6f 6e 20 6f 66 20 74 68 esentation of th
18a0: 65 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e e runconfigs.con
18b0: 66 69 67 20 66 69 6c 65 0a 20 20 2d 64 75 6d 70 fig file. -dump
18c0: 6d 6f 64 65 20 4d 4f 44 45 20 20 20 20 20 20 20 mode MODE
18d0: 20 20 20 3a 20 64 75 6d 70 20 69 6e 20 4d 4f 44 : dump in MOD
18e0: 45 20 66 6f 72 6d 61 74 20 69 6e 73 74 65 61 64 E format instead
18f0: 20 6f 66 20 73 65 78 70 72 2c 20 4d 4f 44 45 3d of sexpr, MODE=
1900: 6a 73 6f 6e 2c 69 6e 69 2c 73 65 78 70 20 65 74 json,ini,sexp et
1910: 63 2e 0a 20 20 2d 73 68 6f 77 2d 63 6d 64 69 6e c.. -show-cmdin
1920: 66 6f 20 20 20 20 20 20 20 20 20 20 20 3a 20 64 fo : d
1930: 75 6d 70 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 ump the command
1940: 69 6e 66 6f 20 66 6f 72 20 61 20 74 65 73 74 20 info for a test
1950: 28 72 75 6e 20 69 6e 20 74 65 73 74 20 65 6e 76 (run in test env
1960: 69 72 6f 6e 6d 65 6e 74 29 0a 20 20 2d 73 65 63 ironment). -sec
1970: 74 69 6f 6e 20 73 65 63 74 69 6f 6e 4e 61 6d 65 tion sectionName
1980: 0a 20 20 2d 76 61 72 20 76 61 72 4e 61 6d 65 20 . -var varName
1990: 20 20 20 20 20 20 20 20 20 20 20 3a 20 66 6f 72 : for
19a0: 20 63 6f 6e 66 69 67 20 61 6e 64 20 72 75 6e 63 config and runc
19b0: 6f 6e 66 69 67 20 6c 6f 6f 6b 75 70 20 76 61 6c onfig lookup val
19c0: 75 65 20 66 6f 72 20 73 65 63 74 69 6f 6e 4e 61 ue for sectionNa
19d0: 6d 65 20 76 61 72 4e 61 6d 65 0a 20 20 2d 73 69 me varName. -si
19e0: 6e 63 65 20 4e 20 20 20 20 20 20 20 20 20 20 20 nce N
19f0: 20 20 20 20 20 3a 20 67 65 74 20 6c 69 73 74 20 : get list
1a00: 6f 66 20 72 75 6e 73 20 63 68 61 6e 67 65 64 20 of runs changed
1a10: 73 69 6e 63 65 20 74 69 6d 65 20 4e 20 28 55 6e since time N (Un
1a20: 69 78 20 73 65 63 6f 6e 64 73 29 0a 20 20 2d 66 ix seconds). -f
1a30: 69 65 6c 64 73 20 66 69 65 6c 64 73 70 65 63 20 ields fieldspec
1a40: 20 20 20 20 20 20 3a 20 66 69 65 6c 64 73 20 74 : fields t
1a50: 6f 20 69 6e 63 6c 75 64 65 20 69 6e 20 6a 73 6f o include in jso
1a60: 6e 20 64 75 6d 70 3b 20 72 75 6e 73 3a 69 64 2c n dump; runs:id,
1a70: 72 75 6e 61 6d 65 2b 74 65 73 74 73 3a 74 65 73 runame+tests:tes
1a80: 74 6e 61 6d 65 2b 73 74 65 70 73 0a 20 20 2d 73 tname+steps. -s
1a90: 6f 72 74 20 66 69 65 6c 64 6e 61 6d 65 20 20 20 ort fieldname
1aa0: 20 20 20 20 20 20 3a 20 69 6e 20 2d 6c 69 73 74 : in -list
1ab0: 2d 72 75 6e 73 20 73 6f 72 74 20 74 65 73 74 73 -runs sort tests
1ac0: 20 62 79 20 74 68 69 73 20 66 69 65 6c 64 0a 0a by this field..
1ad0: 4d 69 73 63 20 0a 20 20 2d 73 74 61 72 74 2d 64 Misc . -start-d
1ae0: 69 72 20 70 61 74 68 20 20 20 20 20 20 20 20 20 ir path
1af0: 3a 20 73 77 69 74 63 68 20 74 6f 20 74 68 69 73 : switch to this
1b00: 20 64 69 72 65 63 74 6f 72 79 20 62 65 66 6f 72 directory befor
1b10: 65 20 72 75 6e 6e 69 6e 67 20 6d 65 67 61 74 65 e running megate
1b20: 73 74 0a 20 20 2d 72 65 62 75 69 6c 64 2d 64 62 st. -rebuild-db
1b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 62 : b
1b40: 72 69 6e 67 20 74 68 65 20 64 61 74 61 62 61 73 ring the databas
1b50: 65 20 73 63 68 65 6d 61 20 75 70 20 74 6f 20 64 e schema up to d
1b60: 61 74 65 0a 20 20 2d 63 6c 65 61 6e 75 70 2d 64 ate. -cleanup-d
1b70: 62 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 b :
1b80: 72 65 6d 6f 76 65 20 61 6e 79 20 6f 72 70 68 61 remove any orpha
1b90: 6e 20 72 65 63 6f 72 64 73 2c 20 76 61 63 75 75 n records, vacuu
1ba0: 6d 20 74 68 65 20 64 62 0a 20 20 2d 69 6d 70 6f m the db. -impo
1bb0: 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 20 20 rt-megatest.db
1bc0: 20 20 20 3a 20 6d 69 67 72 61 74 65 20 61 20 64 : migrate a d
1bd0: 61 74 61 62 61 73 65 20 66 72 6f 6d 20 76 31 2e atabase from v1.
1be0: 35 35 20 73 65 72 69 65 73 20 74 6f 20 76 31 2e 55 series to v1.
1bf0: 36 30 20 73 65 72 69 65 73 0a 20 20 2d 73 79 6e 60 series. -syn
1c00: 63 2d 74 6f 2d 6d 65 67 61 74 65 73 74 2e 64 62 c-to-megatest.db
1c10: 20 20 20 20 3a 20 6d 69 67 72 61 74 65 20 64 61 : migrate da
1c20: 74 61 20 62 61 63 6b 20 74 6f 20 6d 65 67 61 74 ta back to megat
1c30: 65 73 74 2e 64 62 0a 20 20 2d 75 73 65 2d 64 62 est.db. -use-db
1c40: 2d 63 61 63 68 65 20 20 20 20 20 20 20 20 20 20 -cache
1c50: 20 3a 20 75 73 65 20 63 61 63 68 65 64 20 61 63 : use cached ac
1c60: 63 65 73 73 20 74 6f 20 64 62 20 74 6f 20 72 65 cess to db to re
1c70: 64 75 63 65 20 6c 6f 61 64 0a 20 20 2d 75 70 64 duce load. -upd
1c80: 61 74 65 2d 6d 65 74 61 20 20 20 20 20 20 20 20 ate-meta
1c90: 20 20 20 20 3a 20 75 70 64 61 74 65 20 74 68 65 : update the
1ca0: 20 74 65 73 74 73 20 6d 65 74 61 64 61 74 61 20 tests metadata
1cb0: 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 0a 20 20 for all tests.
1cc0: 2d 73 65 74 76 61 72 73 20 56 41 52 31 3d 76 61 -setvars VAR1=va
1cd0: 6c 31 2c 56 41 52 32 3d 76 61 6c 32 20 3a 20 41 l1,VAR2=val2 : A
1ce0: 64 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 dd environment v
1cf0: 61 72 69 61 62 6c 65 73 20 74 6f 20 61 20 72 75 ariables to a ru
1d00: 6e 20 4e 42 2f 2f 20 74 68 65 73 65 20 61 72 65 n NB// these are
1d10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d30: 20 20 6f 76 65 72 77 72 69 74 74 65 6e 20 62 79 overwritten by
1d40: 20 76 61 6c 75 65 73 20 73 65 74 20 69 6e 20 63 values set in c
1d50: 6f 6e 66 69 67 20 66 69 6c 65 73 2e 0a 20 20 2d onfig files.. -
1d60: 73 65 72 76 65 72 20 2d 7c 68 6f 73 74 6e 61 6d server -|hostnam
1d70: 65 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 74 e : start t
1d80: 68 65 20 73 65 72 76 65 72 20 28 72 65 64 75 63 he server (reduc
1d90: 65 73 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 6f 6e es contention on
1da0: 20 6d 65 67 61 74 65 73 74 2e 64 62 29 2c 20 75 megatest.db), u
1db0: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
1dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d -
1dd0: 20 74 6f 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c to automaticall
1de0: 79 20 66 69 67 75 72 65 20 6f 75 74 20 68 6f 73 y figure out hos
1df0: 74 6e 61 6d 65 0a 20 20 2d 74 72 61 6e 73 70 6f tname. -transpo
1e00: 72 74 20 68 74 74 70 7c 72 70 63 20 20 20 20 20 rt http|rpc
1e10: 3a 20 75 73 65 20 68 74 74 70 20 6f 72 20 72 70 : use http or rp
1e20: 63 20 66 6f 72 20 74 72 61 6e 73 70 6f 72 74 20 c for transport
1e30: 28 64 65 66 61 75 6c 74 20 69 73 20 68 74 74 70 (default is http
1e40: 29 20 0a 20 20 2d 64 61 65 6d 6f 6e 69 7a 65 20 ) . -daemonize
1e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 66 : f
1e60: 6f 72 6b 20 69 6e 74 6f 20 62 61 63 6b 67 72 6f ork into backgro
1e70: 75 6e 64 20 61 6e 64 20 64 69 73 63 6f 6e 6e 65 und and disconne
1e80: 63 74 20 66 72 6f 6d 20 73 74 64 69 6e 2f 6f 75 ct from stdin/ou
1e90: 74 0a 20 20 2d 6c 6f 67 20 6c 6f 67 66 69 6c 65 t. -log logfile
1ea0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 : se
1eb0: 6e 64 20 73 74 64 6f 75 74 20 61 6e 64 20 73 74 nd stdout and st
1ec0: 64 65 72 72 20 74 6f 20 6c 6f 67 66 69 6c 65 0a derr to logfile.
1ed0: 20 20 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 20 -list-servers
1ee0: 20 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 : list
1ef0: 20 74 68 65 20 73 65 72 76 65 72 73 20 0a 20 20 the servers .
1f00: 2d 73 74 6f 70 2d 73 65 72 76 65 72 20 69 64 20 -stop-server id
1f10: 20 20 20 20 20 20 20 20 3a 20 73 74 6f 70 20 73 : stop s
1f20: 65 72 76 65 72 20 73 70 65 63 69 66 69 65 64 20 erver specified
1f30: 62 79 20 69 64 20 28 73 65 65 20 6f 75 74 70 75 by id (see outpu
1f40: 74 20 6f 66 20 2d 6c 69 73 74 2d 73 65 72 76 65 t of -list-serve
1f50: 72 73 29 2c 20 75 73 65 0a 20 20 20 20 20 20 20 rs), use.
1f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f70: 20 20 20 20 20 30 20 74 6f 20 6b 69 6c 6c 20 61 0 to kill a
1f80: 6c 6c 0a 20 20 2d 72 65 70 6c 20 20 20 20 20 20 ll. -repl
1f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 : s
1fa0: 74 61 72 74 20 61 20 72 65 70 6c 20 28 75 73 65 tart a repl (use
1fb0: 66 75 6c 20 66 6f 72 20 65 78 74 65 6e 64 69 6e ful for extendin
1fc0: 67 20 6d 65 67 61 74 65 73 74 29 0a 20 20 2d 6c g megatest). -l
1fd0: 6f 61 64 20 66 69 6c 65 2e 73 63 6d 20 20 20 20 oad file.scm
1fe0: 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 61 6e 64 : load and
1ff0: 20 72 75 6e 20 66 69 6c 65 2e 73 63 6d 0a 20 20 run file.scm.
2000: 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 -mark-incomplete
2010: 73 20 20 20 20 20 20 20 3a 20 66 69 6e 64 20 61 s : find a
2020: 6e 64 20 6d 61 72 6b 20 69 6e 63 6f 6d 70 6c 65 nd mark incomple
2030: 74 65 20 74 65 73 74 73 0a 20 20 2d 70 69 6e 67 te tests. -ping
2040: 20 72 75 6e 2d 69 64 7c 68 6f 73 74 3a 70 6f 72 run-id|host:por
2050: 74 20 20 3a 20 70 69 6e 67 20 73 65 72 76 65 72 t : ping server
2060: 2c 20 65 78 69 74 20 77 69 74 68 20 30 20 69 66 , exit with 0 if
2070: 20 66 6f 75 6e 64 0a 20 20 2d 64 65 62 75 67 20 found. -debug
2080: 4e 7c 4e 2c 4d 2c 4f 2e 2e 2e 20 20 20 20 20 20 N|N,M,O...
2090: 20 3a 20 65 6e 61 62 6c 65 20 64 65 62 75 67 20 : enable debug
20a0: 30 2d 4e 20 6f 72 20 4e 20 61 6e 64 20 4d 20 61 0-N or N and M a
20b0: 6e 64 20 4f 20 2e 2e 2e 0a 0a 55 74 69 6c 69 74 nd O .....Utilit
20c0: 69 65 73 0a 20 20 2d 65 6e 76 32 66 69 6c 65 20 ies. -env2file
20d0: 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 3a 20 fname :
20e0: 77 72 69 74 65 20 74 68 65 20 65 6e 76 69 72 6f write the enviro
20f0: 6e 6d 65 6e 74 20 74 6f 20 66 6e 61 6d 65 2e 63 nment to fname.c
2100: 73 68 20 61 6e 64 20 66 6e 61 6d 65 2e 73 68 0a sh and fname.sh.
2110: 20 20 2d 65 6e 76 63 61 70 20 66 6e 61 6d 65 3d -envcap fname=
2120: 63 6f 6e 74 65 78 74 20 20 20 3a 20 73 61 76 65 context : save
2130: 20 63 75 72 72 65 6e 74 20 76 61 72 69 61 62 6c current variabl
2140: 65 73 20 6c 61 62 65 6c 65 64 20 61 73 20 63 6f es labeled as co
2150: 6e 74 65 78 74 20 69 6e 20 66 69 6c 65 20 66 6e ntext in file fn
2160: 61 6d 65 0a 20 20 2d 72 65 66 64 62 32 64 61 74 ame. -refdb2dat
2170: 20 72 65 66 64 62 20 20 20 20 20 20 20 20 3a 20 refdb :
2180: 63 6f 6e 76 65 72 74 20 72 65 66 64 62 20 74 6f convert refdb to
2190: 20 73 65 78 70 20 6f 72 20 74 6f 20 66 6f 72 6d sexp or to form
21a0: 61 74 20 73 70 65 63 69 66 69 65 64 20 62 79 20 at specified by
21b0: 2d 64 75 6d 70 6d 6f 64 65 0a 20 20 20 20 20 20 -dumpmode.
21c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21d0: 20 20 20 20 20 20 66 6f 72 6d 61 74 73 3a 20 70 formats: p
21e0: 65 72 6c 2c 20 72 75 62 79 2c 20 73 71 6c 69 74 erl, ruby, sqlit
21f0: 65 33 2c 20 63 73 76 20 28 66 6f 72 20 63 73 76 e3, csv (for csv
2200: 20 74 68 65 20 2d 6f 20 70 61 72 61 6d 0a 20 20 the -o param.
2210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2220: 20 20 20 20 20 20 20 20 20 20 77 69 6c 6c 20 73 will s
2230: 75 62 73 74 69 74 75 74 65 20 25 73 20 66 6f 72 ubstitute %s for
2240: 20 74 68 65 20 73 68 65 65 74 20 6e 61 6d 65 20 the sheet name
2250: 69 6e 20 67 65 6e 65 72 61 74 69 6e 67 20 0a 20 in generating .
2260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2270: 20 20 20 20 20 20 20 20 20 20 20 6d 75 6c 74 69 multi
2280: 70 6c 65 20 73 68 65 65 74 73 29 0a 20 20 2d 6f ple sheets). -o
2290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22a0: 20 20 20 20 20 20 3a 20 6f 75 74 70 75 74 20 66 : output f
22b0: 69 6c 65 20 66 6f 72 20 72 65 66 64 62 32 64 61 ile for refdb2da
22c0: 74 20 28 64 65 66 61 75 6c 74 73 20 74 6f 20 73 t (defaults to s
22d0: 74 64 6f 75 74 29 0a 20 20 2d 61 72 63 68 69 76 tdout). -archiv
22e0: 65 20 63 6d 64 20 20 20 20 20 20 20 20 20 20 20 e cmd
22f0: 20 3a 20 61 72 63 68 69 76 65 20 72 75 6e 73 20 : archive runs
2300: 73 70 65 63 69 66 69 65 64 20 62 79 20 73 65 6c specified by sel
2310: 65 63 74 6f 72 73 20 74 6f 20 6f 6e 65 20 6f 66 ectors to one of
2320: 20 64 69 73 6b 73 20 73 70 65 63 69 66 69 65 64 disks specified
2330: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2340: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 6e 20 in
2350: 74 68 65 20 5b 61 72 63 68 69 76 65 2d 64 69 73 the [archive-dis
2360: 6b 73 5d 20 73 65 63 74 69 6f 6e 2e 0a 20 20 20 ks] section..
2370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2380: 20 20 20 20 20 20 20 20 20 63 6d 64 3a 20 6b 65 cmd: ke
2390: 65 70 2d 68 74 6d 6c 2c 20 72 65 73 74 6f 72 65 ep-html, restore
23a0: 2c 20 73 61 76 65 2c 20 73 61 76 65 2d 72 65 6d , save, save-rem
23b0: 6f 76 65 0a 20 20 2d 67 65 6e 65 72 61 74 65 2d ove. -generate-
23c0: 68 74 6d 6c 20 20 20 20 20 20 20 20 20 20 3a 20 html :
23d0: 63 72 65 61 74 65 20 61 20 73 69 6d 70 6c 65 20 create a simple
23e0: 68 74 6d 6c 20 74 72 65 65 20 66 6f 72 20 62 72 html tree for br
23f0: 6f 77 73 69 6e 67 20 79 6f 75 72 20 72 75 6e 73 owsing your runs
2400: 0a 0a 44 69 66 66 20 72 65 70 6f 72 74 0a 20 20 ..Diff report.
2410: 2d 64 69 66 66 2d 72 65 70 20 20 20 20 20 20 20 -diff-rep
2420: 20 20 20 20 20 20 20 20 3a 20 67 65 6e 65 72 61 : genera
2430: 74 65 20 64 69 66 66 20 72 65 70 6f 72 74 20 28 te diff report (
2440: 6d 75 73 74 20 69 6e 63 6c 75 64 65 20 2d 73 72 must include -sr
2450: 63 2d 74 61 72 67 65 74 2c 20 2d 73 72 63 2d 72 c-target, -src-r
2460: 75 6e 6e 61 6d 65 2c 20 2d 74 61 72 67 65 74 2c unname, -target,
2470: 20 2d 72 75 6e 6e 61 6d 65 0a 20 20 20 20 20 20 -runname.
2480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24a0: 20 20 20 20 20 20 20 20 20 20 20 20 61 6e 64 20 and
24b0: 65 69 74 68 65 72 20 2d 64 69 66 66 2d 65 6d 61 either -diff-ema
24c0: 69 6c 20 6f 72 20 2d 64 69 66 66 2d 68 74 6d 6c il or -diff-html
24d0: 29 0a 20 20 2d 73 72 63 2d 74 61 72 67 65 74 20 ). -src-target
24e0: 3c 74 61 72 67 65 74 3e 0a 20 20 2d 73 72 63 2d <target>. -src-
24f0: 72 75 6e 6e 61 6d 65 20 3c 74 61 72 67 65 74 3e runname <target>
2500: 0a 20 20 2d 64 69 66 66 2d 65 6d 61 69 6c 20 3c . -diff-email <
2510: 65 6d 61 69 6c 73 3e 20 20 20 20 3a 20 63 6f 6d emails> : com
2520: 6d 61 20 73 65 70 61 72 61 74 65 64 20 6c 69 73 ma separated lis
2530: 74 20 6f 66 20 65 6d 61 69 6c 20 61 64 64 72 65 t of email addre
2540: 73 73 65 73 20 74 6f 20 73 65 6e 64 20 64 69 66 sses to send dif
2550: 66 20 72 65 70 6f 72 74 0a 20 20 2d 64 69 66 66 f report. -diff
2560: 2d 68 74 6d 6c 20 20 3c 72 65 70 2e 68 74 6d 6c -html <rep.html
2570: 3e 20 20 3a 20 70 61 74 68 20 74 6f 20 68 74 6d > : path to htm
2580: 6c 20 66 69 6c 65 20 74 6f 20 67 65 6e 65 72 61 l file to genera
2590: 74 65 0a 0a 53 70 72 65 61 64 73 68 65 65 74 20 te..Spreadsheet
25a0: 67 65 6e 65 72 61 74 69 6f 6e 0a 20 20 2d 65 78 generation. -ex
25b0: 74 72 61 63 74 2d 6f 64 73 20 66 6e 61 6d 65 2e tract-ods fname.
25c0: 6f 64 73 20 20 3a 20 65 78 74 72 61 63 74 20 61 ods : extract a
25d0: 6e 20 6f 70 65 6e 20 64 6f 63 75 6d 65 6e 74 20 n open document
25e0: 73 70 72 65 61 64 73 68 65 65 74 20 66 72 6f 6d spreadsheet from
25f0: 20 74 68 65 20 64 61 74 61 62 61 73 65 0a 20 20 the database.
2600: 2d 70 61 74 68 6d 6f 64 20 70 61 74 68 20 20 20 -pathmod path
2610: 20 20 20 20 20 20 20 20 3a 20 69 6e 73 65 72 74 : insert
2620: 20 70 61 74 68 2c 20 69 2e 65 2e 20 70 61 74 68 path, i.e. path
2630: 2f 72 75 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 /runame/itempath
2640: 2f 6c 6f 67 66 69 6c 65 2e 68 74 6d 6c 0a 20 20 /logfile.html.
2650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2660: 20 20 20 20 20 20 20 20 20 20 77 69 6c 6c 20 63 will c
2670: 6c 65 61 72 20 74 68 65 20 66 69 65 6c 64 20 69 lear the field i
2680: 66 20 6e 6f 20 72 75 6e 64 69 72 2f 74 65 73 74 f no rundir/test
2690: 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f name/itempath/lo
26a0: 67 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 gfile.
26b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26c0: 20 20 69 66 20 69 74 20 63 6f 6e 74 61 69 6e 73 if it contains
26d0: 20 66 6f 72 77 61 72 64 20 73 6c 61 73 68 65 73 forward slashes
26e0: 20 74 68 65 20 70 61 74 68 20 77 69 6c 6c 20 62 the path will b
26f0: 65 20 63 6f 6e 76 65 72 74 65 64 0a 20 20 20 20 e converted.
2700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2710: 20 20 20 20 20 20 20 20 74 6f 20 77 69 6e 64 6f to windo
2720: 77 73 20 73 74 79 6c 65 0a 47 65 74 74 69 6e 67 ws style.Getting
2730: 20 73 74 61 72 74 65 64 0a 20 20 2d 63 72 65 61 started. -crea
2740: 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 te-megatest-area
2750: 20 20 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 : create
2760: 61 20 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 a skeleton megat
2770: 65 73 74 20 61 72 65 61 2e 20 59 6f 75 20 77 69 est area. You wi
2780: 6c 6c 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 ll be prompted f
2790: 6f 72 20 70 61 74 68 73 0a 20 20 2d 63 72 65 61 or paths. -crea
27a0: 74 65 2d 74 65 73 74 20 74 65 73 74 6e 61 6d 65 te-test testname
27b0: 20 20 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 : create
27c0: 61 20 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 a skeleton megat
27d0: 65 73 74 20 74 65 73 74 2e 20 59 6f 75 20 77 69 est test. You wi
27e0: 6c 6c 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 ll be prompted f
27f0: 6f 72 20 69 6e 66 6f 0a 0a 45 78 61 6d 70 6c 65 or info..Example
2800: 73 0a 0a 23 20 47 65 74 20 74 65 73 74 20 70 61 s..# Get test pa
2810: 74 68 2c 20 75 73 65 20 27 2e 27 20 74 6f 20 67 th, use '.' to g
2820: 65 74 20 61 20 73 69 6e 67 6c 65 20 70 61 74 68 et a single path
2830: 20 6f 72 20 61 20 73 70 65 63 69 66 69 63 20 70 or a specific p
2840: 61 74 68 2f 66 69 6c 65 20 70 61 74 74 65 72 6e ath/file pattern
2850: 0a 6d 65 67 61 74 65 73 74 20 2d 74 65 73 74 2d .megatest -test-
2860: 66 69 6c 65 73 20 27 6c 6f 67 73 2f 2a 2e 6c 6f files 'logs/*.lo
2870: 67 27 20 2d 74 61 72 67 65 74 20 75 62 75 6e 74 g' -target ubunt
2880: 75 2f 6e 25 2f 6e 6f 25 20 2d 72 75 6e 6e 61 6d u/n%/no% -runnam
2890: 65 20 77 34 39 25 20 2d 74 65 73 74 70 61 74 74 e w49% -testpatt
28a0: 20 74 65 73 74 5f 6d 74 25 0a 0a 43 61 6c 6c 65 test_mt%..Calle
28b0: 64 20 61 73 20 22 20 28 73 74 72 69 6e 67 2d 69 d as " (string-i
28c0: 6e 74 65 72 73 70 65 72 73 65 20 28 61 72 67 76 ntersperse (argv
28d0: 29 20 22 20 22 29 20 22 0a 56 65 72 73 69 6f 6e ) " ") ".Version
28e0: 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 " megatest-vers
28f0: 69 6f 6e 20 22 2c 20 62 75 69 6c 74 20 66 72 6f ion ", built fro
2900: 6d 20 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 m " megatest-fos
2910: 73 69 6c 2d 68 61 73 68 20 29 29 0a 0a 3b 3b 20 sil-hash ))..;;
2920: 20 2d 67 75 69 20 20 20 20 20 20 20 20 20 20 20 -gui
2930: 20 20 20 20 20 20 20 20 20 3a 20 73 74 61 72 74 : start
2940: 20 61 20 67 75 69 20 69 6e 74 65 72 66 61 63 65 a gui interface
2950: 0a 3b 3b 20 20 2d 63 6f 6e 66 69 67 20 66 6e 61 .;; -config fna
2960: 6d 65 20 20 20 20 20 20 20 20 20 20 20 3a 20 6f me : o
2970: 76 65 72 72 69 64 65 20 74 68 65 20 72 75 6e 63 verride the runc
2980: 6f 6e 66 69 67 20 66 69 6c 65 20 77 69 74 68 20 onfig file with
2990: 66 6e 61 6d 65 0a 0a 3b 3b 20 70 72 6f 63 65 73 fname..;; proces
29a0: 73 20 61 72 67 73 0a 28 64 65 66 69 6e 65 20 72 s args.(define r
29b0: 65 6d 61 72 67 73 20 28 61 72 67 73 3a 67 65 74 emargs (args:get
29c0: 2d 61 72 67 73 20 0a 09 09 20 28 61 72 67 76 29 -args ... (argv)
29d0: 0a 09 09 20 28 6c 69 73 74 20 20 22 2d 72 75 6e ... (list "-run
29e0: 74 65 73 74 73 22 20 20 3b 3b 20 72 75 6e 20 61 tests" ;; run a
29f0: 20 73 70 65 63 69 66 69 63 20 74 65 73 74 0a 09 specific test..
2a00: 09 09 22 2d 63 6f 6e 66 69 67 22 20 20 20 20 3b .."-config" ;
2a10: 3b 20 6f 76 65 72 72 69 64 65 20 74 68 65 20 63 ; override the c
2a20: 6f 6e 66 69 67 20 66 69 6c 65 20 6e 61 6d 65 0a onfig file name.
2a30: 09 09 09 22 2d 65 78 65 63 75 74 65 22 20 20 20 ..."-execute"
2a40: 3b 3b 20 72 75 6e 20 74 68 65 20 63 6f 6d 6d 61 ;; run the comma
2a50: 6e 64 20 65 6e 63 6f 64 65 64 20 69 6e 20 74 68 nd encoded in th
2a60: 65 20 62 61 73 65 36 34 20 70 61 72 61 6d 65 74 e base64 paramet
2a70: 65 72 0a 09 09 09 22 2d 73 74 65 70 22 0a 09 09 er...."-step"...
2a80: 09 22 2d 74 61 72 67 65 74 22 0a 09 09 09 22 2d ."-target"...."-
2a90: 72 65 71 74 61 72 67 22 0a 09 09 09 22 3a 72 75 reqtarg"....":ru
2aa0: 6e 6e 61 6d 65 22 0a 09 09 09 22 2d 72 75 6e 6e nname"...."-runn
2ab0: 61 6d 65 22 0a 09 09 09 22 3a 73 74 61 74 65 22 ame"....":state"
2ac0: 20 20 0a 09 09 09 22 2d 73 74 61 74 65 22 0a 09 ...."-state"..
2ad0: 09 09 22 3a 73 74 61 74 75 73 22 0a 09 09 09 22 ..":status"...."
2ae0: 2d 73 74 61 74 75 73 22 0a 09 09 09 22 2d 6c 69 -status"...."-li
2af0: 73 74 2d 72 75 6e 73 22 0a 09 09 09 22 2d 74 65 st-runs"...."-te
2b00: 73 74 70 61 74 74 22 0a 20 20 20 20 20 20 20 20 stpatt".
2b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b20: 22 2d 2d 6d 6f 64 65 70 61 74 74 22 0a 20 20 20 "--modepatt".
2b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b40: 20 20 20 20 20 22 2d 74 61 67 65 78 70 72 22 0a "-tagexpr".
2b50: 09 09 09 22 2d 69 74 65 6d 70 61 74 74 22 0a 09 ..."-itempatt"..
2b60: 09 09 22 2d 73 65 74 6c 6f 67 22 0a 09 09 09 22 .."-setlog"...."
2b70: 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 0a 09 09 09 -set-toplog"....
2b80: 22 2d 72 75 6e 73 74 65 70 22 0a 09 09 09 22 2d "-runstep"...."-
2b90: 6c 6f 67 70 72 6f 22 0a 09 09 09 22 2d 6d 22 0a logpro"...."-m".
2ba0: 09 09 09 22 2d 72 65 72 75 6e 22 0a 09 09 09 22 ..."-rerun"...."
2bb0: 2d 64 61 79 73 22 0a 09 09 09 22 2d 72 65 6e 61 -days"...."-rena
2bc0: 6d 65 2d 72 75 6e 22 0a 09 09 09 22 2d 74 6f 22 me-run"...."-to"
2bd0: 0a 09 09 09 3b 3b 20 76 61 6c 75 65 73 20 61 6e ....;; values an
2be0: 64 20 6d 65 73 73 61 67 65 73 0a 09 09 09 22 3a d messages....":
2bf0: 63 61 74 65 67 6f 72 79 22 0a 09 09 09 22 3a 76 category"....":v
2c00: 61 72 69 61 62 6c 65 22 0a 09 09 09 22 3a 76 61 ariable"....":va
2c10: 6c 75 65 22 0a 09 09 09 22 3a 65 78 70 65 63 74 lue"....":expect
2c20: 65 64 22 0a 09 09 09 22 3a 74 6f 6c 22 0a 09 09 ed"....":tol"...
2c30: 09 22 3a 75 6e 69 74 73 22 0a 09 09 09 3b 3b 20 .":units"....;;
2c40: 6d 69 73 63 0a 09 09 09 22 2d 73 74 61 72 74 2d misc...."-start-
2c50: 64 69 72 22 0a 09 09 09 22 2d 73 65 72 76 65 72 dir"...."-server
2c60: 22 0a 09 09 09 22 2d 73 74 6f 70 2d 73 65 72 76 "...."-stop-serv
2c70: 65 72 22 0a 09 09 09 22 2d 74 72 61 6e 73 70 6f er"...."-transpo
2c80: 72 74 22 0a 09 09 09 22 2d 6b 69 6c 6c 2d 73 65 rt"...."-kill-se
2c90: 72 76 65 72 22 0a 09 09 09 22 2d 70 6f 72 74 22 rver"...."-port"
2ca0: 0a 09 09 09 22 2d 65 78 74 72 61 63 74 2d 6f 64 ...."-extract-od
2cb0: 73 22 0a 09 09 09 22 2d 70 61 74 68 6d 6f 64 22 s"...."-pathmod"
2cc0: 0a 09 09 09 22 2d 65 6e 76 32 66 69 6c 65 22 0a ...."-env2file".
2cd0: 09 09 09 22 2d 65 6e 76 63 61 70 22 0a 09 09 09 ..."-envcap"....
2ce0: 22 2d 65 6e 76 64 65 6c 74 61 22 0a 09 09 09 22 "-envdelta"...."
2cf0: 2d 73 65 74 76 61 72 73 22 0a 09 09 09 22 2d 73 -setvars"...."-s
2d00: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 et-state-status"
2d10: 0a 09 09 09 22 2d 73 65 74 2d 72 75 6e 2d 73 74 ...."-set-run-st
2d20: 61 74 75 73 22 0a 09 09 09 22 2d 64 65 62 75 67 atus"...."-debug
2d30: 22 20 3b 3b 20 66 6f 72 20 2a 76 65 72 62 6f 73 " ;; for *verbos
2d40: 69 74 79 2a 20 3e 20 32 0a 09 09 09 22 2d 63 72 ity* > 2...."-cr
2d50: 65 61 74 65 2d 74 65 73 74 22 0a 09 09 09 22 2d eate-test"...."-
2d60: 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 74 override-timeout
2d70: 22 0a 09 09 09 22 2d 74 65 73 74 2d 66 69 6c 65 "...."-test-file
2d80: 73 22 20 20 3b 3b 20 2d 74 65 73 74 2d 70 61 74 s" ;; -test-pat
2d90: 68 73 20 69 73 20 66 6f 72 20 6c 69 73 74 69 6e hs is for listin
2da0: 67 20 61 6c 6c 0a 09 09 09 22 2d 6c 6f 61 64 22 g all...."-load"
2db0: 20 20 20 20 20 20 20 20 3b 3b 20 6c 6f 61 64 20 ;; load
2dc0: 61 6e 64 20 65 78 65 63 74 75 74 65 20 61 20 73 and exectute a s
2dd0: 63 68 65 6d 65 20 66 69 6c 65 0a 09 09 09 22 2d cheme file...."-
2de0: 73 65 63 74 69 6f 6e 22 0a 09 09 09 22 2d 76 61 section"...."-va
2df0: 72 22 0a 09 09 09 22 2d 64 75 6d 70 6d 6f 64 65 r"...."-dumpmode
2e00: 22 0a 09 09 09 22 2d 72 75 6e 2d 69 64 22 0a 09 "...."-run-id"..
2e10: 09 09 22 2d 70 69 6e 67 22 0a 09 09 09 22 2d 72 .."-ping"...."-r
2e20: 65 66 64 62 32 64 61 74 22 0a 09 09 09 22 2d 6f efdb2dat"...."-o
2e30: 22 0a 09 09 09 22 2d 6c 6f 67 22 0a 09 09 09 22 "...."-log"...."
2e40: 2d 61 72 63 68 69 76 65 22 0a 09 09 09 22 2d 73 -archive"...."-s
2e50: 69 6e 63 65 22 0a 09 09 09 22 2d 66 69 65 6c 64 ince"...."-field
2e60: 73 22 0a 09 09 09 22 2d 72 65 63 6f 76 65 72 2d s"...."-recover-
2e70: 74 65 73 74 22 20 3b 3b 20 72 75 6e 2d 69 64 2c test" ;; run-id,
2e80: 74 65 73 74 2d 69 64 20 2d 20 75 73 65 64 20 69 test-id - used i
2e90: 6e 74 65 72 6e 61 6c 6c 79 20 74 6f 20 72 65 63 nternally to rec
2ea0: 6f 76 65 72 20 61 20 74 65 73 74 20 73 74 75 63 over a test stuc
2eb0: 6b 20 69 6e 20 52 55 4e 4e 49 4e 47 20 73 74 61 k in RUNNING sta
2ec0: 74 65 0a 09 09 09 22 2d 73 6f 72 74 22 0a 09 09 te...."-sort"...
2ed0: 09 22 2d 74 61 72 67 65 74 2d 64 62 22 0a 09 09 ."-target-db"...
2ee0: 09 22 2d 73 6f 75 72 63 65 2d 64 62 22 0a 0a 20 ."-source-db"..
2ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f00: 20 20 20 20 20 20 20 22 2d 73 72 63 2d 74 61 72 "-src-tar
2f10: 67 65 74 22 0a 20 20 20 20 20 20 20 20 20 20 20 get".
2f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 2d 73 "-s
2f30: 72 63 2d 72 75 6e 6e 61 6d 65 22 0a 20 20 20 20 rc-runname".
2f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f50: 20 20 20 20 22 2d 64 69 66 66 2d 65 6d 61 69 6c "-diff-email
2f60: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ".
2f70: 20 20 20 20 20 20 20 20 20 20 22 2d 64 69 66 66 "-diff
2f80: 2d 68 74 6d 6c 22 0a 09 09 09 29 0a 20 09 09 20 -html"....). ..
2f90: 28 6c 69 73 74 20 20 22 2d 68 22 20 22 2d 68 65 (list "-h" "-he
2fa0: 6c 70 22 20 22 2d 2d 68 65 6c 70 22 0a 09 09 09 lp" "--help"....
2fb0: 22 2d 6d 61 6e 75 61 6c 22 0a 09 09 09 22 2d 76 "-manual"...."-v
2fc0: 65 72 73 69 6f 6e 22 0a 09 09 20 20 20 20 20 20 ersion"...
2fd0: 20 20 22 2d 66 6f 72 63 65 22 0a 09 09 20 20 20 "-force"...
2fe0: 20 20 20 20 20 22 2d 78 74 65 72 6d 22 0a 09 09 "-xterm"...
2ff0: 20 20 20 20 20 20 20 20 22 2d 73 68 6f 77 6b 65 "-showke
3000: 79 73 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d ys"... "-
3010: 73 68 6f 77 2d 6b 65 79 73 22 0a 09 09 20 20 20 show-keys"...
3020: 20 20 20 20 20 22 2d 74 65 73 74 2d 73 74 61 74 "-test-stat
3030: 75 73 22 0a 09 09 09 22 2d 73 65 74 2d 76 61 6c us"...."-set-val
3040: 75 65 73 22 0a 09 09 09 22 2d 6c 6f 61 64 2d 74 ues"...."-load-t
3050: 65 73 74 2d 64 61 74 61 22 0a 09 09 09 22 2d 73 est-data"...."-s
3060: 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 0a ummarize-items".
3070: 09 09 20 20 20 20 20 20 20 20 22 2d 67 75 69 22 .. "-gui"
3080: 0a 09 09 09 22 2d 64 61 65 6d 6f 6e 69 7a 65 22 ...."-daemonize"
3090: 0a 09 09 09 22 2d 70 72 65 63 6c 65 61 6e 22 0a ...."-preclean".
30a0: 09 09 09 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e ..."-rerun-clean
30b0: 22 0a 09 09 09 22 2d 72 65 72 75 6e 2d 61 6c 6c "...."-rerun-all
30c0: 22 0a 09 09 09 22 2d 63 6c 65 61 6e 2d 63 61 63 "...."-clean-cac
30d0: 68 65 22 0a 09 09 09 22 2d 63 61 63 68 65 2d 64 he"...."-cache-d
30e0: 62 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 b".
30f0: 20 20 20 20 20 20 20 20 20 20 20 22 2d 75 73 65 "-use
3100: 2d 64 62 2d 63 61 63 68 65 22 0a 09 09 09 3b 3b -db-cache"....;;
3110: 20 6d 69 73 63 0a 09 09 09 22 2d 72 65 70 6c 22 misc...."-repl"
3120: 0a 09 09 09 22 2d 6c 6f 63 6b 22 0a 09 09 09 22 ...."-lock"...."
3130: 2d 75 6e 6c 6f 63 6b 22 0a 09 09 09 22 2d 6c 69 -unlock"...."-li
3140: 73 74 2d 73 65 72 76 65 72 73 22 0a 20 20 20 20 st-servers".
3150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3160: 20 20 20 20 22 2d 72 75 6e 2d 77 61 69 74 22 20 "-run-wait"
3170: 20 20 20 20 20 3b 3b 20 77 61 69 74 20 6f 6e 20 ;; wait on
3180: 61 20 72 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 a run to complet
3190: 65 20 28 69 2e 65 2e 20 6e 6f 20 52 55 4e 4e 49 e (i.e. no RUNNI
31a0: 4e 47 29 0a 09 09 09 22 2d 6c 6f 63 61 6c 22 20 NG)...."-local"
31b0: 20 20 20 20 20 20 20 20 3b 3b 20 72 75 6e 20 73 ;; run s
31c0: 6f 6d 65 20 63 6f 6d 6d 61 6e 64 73 20 75 73 69 ome commands usi
31d0: 6e 67 20 6c 6f 63 61 6c 20 64 62 20 61 63 63 65 ng local db acce
31e0: 73 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ss.
31f0: 20 20 20 20 20 20 20 20 20 20 20 22 2d 67 65 6e "-gen
3200: 65 72 61 74 65 2d 68 74 6d 6c 22 0a 0a 09 09 09 erate-html".....
3210: 3b 3b 20 6d 69 73 63 20 71 75 65 72 69 65 73 0a ;; misc queries.
3220: 09 09 09 22 2d 6c 69 73 74 2d 64 69 73 6b 73 22 ..."-list-disks"
3230: 0a 09 09 09 22 2d 6c 69 73 74 2d 74 61 72 67 65 ...."-list-targe
3240: 74 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d 64 62 ts"...."-list-db
3250: 2d 74 61 72 67 65 74 73 22 0a 09 09 09 22 2d 73 -targets"...."-s
3260: 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 22 0a 09 how-runconfig"..
3270: 09 09 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 22 .."-show-config"
3280: 0a 09 09 09 22 2d 73 68 6f 77 2d 63 6d 64 69 6e ...."-show-cmdin
3290: 66 6f 22 0a 09 09 09 22 2d 67 65 74 2d 72 75 6e fo"...."-get-run
32a0: 2d 73 74 61 74 75 73 22 0a 0a 09 09 09 3b 3b 20 -status".....;;
32b0: 71 75 65 72 69 65 73 0a 09 09 09 22 2d 74 65 73 queries...."-tes
32c0: 74 2d 70 61 74 68 73 22 20 3b 3b 20 67 65 74 20 t-paths" ;; get
32d0: 70 61 74 68 28 73 29 20 74 6f 20 61 20 74 65 73 path(s) to a tes
32e0: 74 2c 20 6f 72 64 65 72 65 64 20 62 79 20 79 6f t, ordered by yo
32f0: 75 6e 67 65 73 74 20 66 69 72 73 74 0a 0a 09 09 ungest first....
3300: 09 22 2d 72 75 6e 61 6c 6c 22 20 20 20 20 3b 3b ."-runall" ;;
3310: 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 2c 20 run all tests,
3320: 72 65 73 70 65 63 74 73 20 2d 74 65 73 74 70 61 respects -testpa
3330: 74 74 2c 20 64 65 66 61 75 6c 74 73 20 74 6f 20 tt, defaults to
3340: 25 0a 09 09 09 22 2d 72 75 6e 22 20 20 20 20 20 %...."-run"
3350: 20 20 3b 3b 20 61 6c 69 61 73 20 66 6f 72 20 2d ;; alias for -
3360: 72 75 6e 61 6c 6c 0a 09 09 09 22 2d 72 65 6d 6f runall...."-remo
3370: 76 65 2d 72 75 6e 73 22 0a 09 09 09 22 2d 72 65 ve-runs"...."-re
3380: 62 75 69 6c 64 2d 64 62 22 0a 09 09 09 22 2d 63 build-db"...."-c
3390: 6c 65 61 6e 75 70 2d 64 62 22 0a 09 09 09 22 2d leanup-db"...."-
33a0: 72 6f 6c 6c 75 70 22 0a 09 09 09 22 2d 75 70 64 rollup"...."-upd
33b0: 61 74 65 2d 6d 65 74 61 22 0a 09 09 09 22 2d 63 ate-meta"...."-c
33c0: 72 65 61 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 reate-megatest-a
33d0: 72 65 61 22 0a 09 09 09 22 2d 6d 61 72 6b 2d 69 rea"...."-mark-i
33e0: 6e 63 6f 6d 70 6c 65 74 65 73 22 0a 0a 09 09 09 ncompletes".....
33f0: 22 2d 63 6f 6e 76 65 72 74 2d 74 6f 2d 6e 6f 72 "-convert-to-nor
3400: 6d 22 0a 09 09 09 22 2d 63 6f 6e 76 65 72 74 2d m"...."-convert-
3410: 74 6f 2d 6f 6c 64 22 0a 09 09 09 22 2d 69 6d 70 to-old"...."-imp
3420: 6f 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 ort-megatest.db"
3430: 0a 09 09 09 22 2d 73 79 6e 63 2d 74 6f 2d 6d 65 ...."-sync-to-me
3440: 67 61 74 65 73 74 2e 64 62 22 0a 0a 09 09 09 22 gatest.db"....."
3450: 2d 6c 6f 67 67 69 6e 67 22 0a 09 09 09 22 2d 76 -logging"...."-v
3460: 22 20 3b 3b 20 76 65 72 62 6f 73 65 20 32 2c 20 " ;; verbose 2,
3470: 6d 6f 72 65 20 74 68 61 6e 20 6e 6f 72 6d 61 6c more than normal
3480: 20 28 6e 6f 72 6d 61 6c 20 69 73 20 31 29 0a 09 (normal is 1)..
3490: 09 09 22 2d 71 22 20 3b 3b 20 71 75 69 65 74 20 .."-q" ;; quiet
34a0: 30 2c 20 65 72 72 6f 72 73 2f 77 61 72 6e 69 6e 0, errors/warnin
34b0: 67 73 20 6f 6e 6c 79 0a 0a 20 20 20 20 20 20 20 gs only..
34c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34d0: 20 22 2d 64 69 66 66 2d 72 65 70 22 0a 20 20 20 "-diff-rep".
34e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34f0: 20 20 20 20 20 29 0a 09 09 20 61 72 67 73 3a 61 )... args:a
3500: 72 67 2d 68 61 73 68 0a 09 09 20 30 29 29 0a 0a rg-hash... 0))..
3510: 3b 3b 20 41 64 64 20 61 72 67 73 20 74 68 61 74 ;; Add args that
3520: 20 75 73 65 20 72 65 6d 61 72 67 73 20 68 65 72 use remargs her
3530: 65 0a 3b 3b 0a 28 69 66 20 28 61 6e 64 20 28 6e e.;;.(if (and (n
3540: 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 ot (null? remarg
3550: 73 29 29 0a 09 20 28 6e 6f 74 20 28 6f 72 0a 09 s)).. (not (or..
3560: 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 (args:get
3570: 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 -arg "-runstep")
3580: 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 .. (args:g
3590: 65 74 2d 61 72 67 20 22 2d 65 6e 76 63 61 70 22 et-arg "-envcap"
35a0: 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 3a ).. (args:
35b0: 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 64 65 6c get-arg "-envdel
35c0: 74 61 22 29 0a 09 20 20 20 20 20 20 20 29 0a 09 ta").. )..
35d0: 20 20 20 20 20 20 29 29 0a 20 20 20 20 28 64 65 )). (de
35e0: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
35f0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
3600: 6f 72 74 2a 20 22 55 6e 72 65 63 6f 67 6e 69 73 ort* "Unrecognis
3610: 65 64 20 61 72 67 75 6d 65 6e 74 73 3a 20 22 20 ed arguments: "
3620: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
3630: 72 73 65 20 28 69 66 20 28 6c 69 73 74 3f 20 72 rse (if (list? r
3640: 65 6d 61 72 67 73 29 20 72 65 6d 61 72 67 73 20 emargs) remargs
3650: 28 61 72 67 76 29 29 20 20 22 20 22 29 29 29 0a (argv)) " "))).
3660: 0a 3b 3b 20 69 6d 6d 65 64 69 61 74 65 6c 79 20 .;; immediately
3670: 73 65 74 20 4d 54 5f 54 41 52 47 45 54 20 69 66 set MT_TARGET if
3680: 20 2d 72 65 71 74 61 72 67 20 6f 72 20 2d 74 61 -reqtarg or -ta
3690: 72 67 65 74 20 61 72 65 20 61 76 61 69 6c 61 62 rget are availab
36a0: 6c 65 0a 3b 3b 0a 28 6c 65 74 20 28 28 74 61 72 le.;;.(let ((tar
36b0: 67 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d g (or (args:get-
36c0: 61 72 67 20 22 2d 72 65 71 74 61 72 67 22 29 28 arg "-reqtarg")(
36d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
36e0: 61 72 67 65 74 22 29 29 29 29 0a 20 20 28 69 66 arget")))). (if
36f0: 20 74 61 72 67 20 28 73 65 74 65 6e 76 20 22 4d targ (setenv "M
3700: 54 5f 54 41 52 47 45 54 22 20 74 61 72 67 29 29 T_TARGET" targ))
3710: 29 0a 0a 3b 3b 20 54 68 65 20 77 61 74 63 68 64 )..;; The watchd
3720: 6f 67 20 69 73 20 74 6f 20 6b 65 65 70 20 61 6e og is to keep an
3730: 20 65 79 65 20 6f 6e 20 74 68 69 6e 67 73 20 6c eye on things l
3740: 69 6b 65 20 64 62 20 73 79 6e 63 20 65 74 63 2e ike db sync etc.
3750: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 2a 77 61 74 .;;.(define *wat
3760: 63 68 64 6f 67 2a 20 28 6d 61 6b 65 2d 74 68 72 chdog* (make-thr
3770: 65 61 64 20 63 6f 6d 6d 6f 6e 3a 77 61 74 63 68 ead common:watch
3780: 64 6f 67 20 22 57 61 74 63 68 64 6f 67 20 74 68 dog "Watchdog th
3790: 72 65 61 64 22 29 29 0a 0a 28 69 66 20 28 6e 6f read"))..(if (no
37a0: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
37b0: 22 2d 73 65 72 76 65 72 22 29 29 0a 20 20 20 20 "-server")).
37c0: 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 2a (thread-start! *
37d0: 77 61 74 63 68 64 6f 67 2a 29 29 20 3b 3b 20 69 watchdog*)) ;; i
37e0: 66 20 73 74 61 72 74 69 6e 67 20 61 20 73 65 72 f starting a ser
37f0: 76 65 72 3b 20 77 61 69 74 20 74 69 6c 6c 20 77 ver; wait till w
3800: 65 20 67 65 74 20 74 6f 20 72 75 6e 6e 69 6e 67 e get to running
3810: 20 73 74 61 74 65 20 62 65 66 6f 72 65 20 6b 69 state before ki
3820: 63 6b 69 6e 67 20 6f 66 66 20 77 61 74 63 68 64 cking off watchd
3830: 6f 67 0a 0a 3b 3b 20 62 72 61 63 6b 65 74 20 6f og..;; bracket o
3840: 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 pen-output-file
3850: 77 69 74 68 20 63 6f 64 65 20 74 6f 20 6d 61 6b with code to mak
3860: 65 20 6c 65 61 64 69 6e 67 20 64 69 72 65 63 74 e leading direct
3870: 6f 72 79 20 69 66 20 69 74 20 64 6f 65 73 20 6e ory if it does n
3880: 6f 74 20 65 78 69 73 74 20 61 6e 64 20 68 61 6e ot exist and han
3890: 64 6c 65 20 65 78 63 65 70 74 69 6f 6e 73 0a 28 dle exceptions.(
38a0: 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 6c 6f 67 define (open-log
38b0: 66 69 6c 65 20 6c 6f 67 70 61 74 68 29 0a 20 20 file logpath).
38c0: 28 63 6f 6e 64 69 74 69 6f 6e 2d 63 61 73 65 0a (condition-case.
38d0: 20 20 20 28 6c 65 74 2a 20 28 28 6c 6f 67 2d 64 (let* ((log-d
38e0: 69 72 20 28 6f 72 20 28 70 61 74 68 6e 61 6d 65 ir (or (pathname
38f0: 2d 64 69 72 65 63 74 6f 72 79 20 6c 6f 67 70 61 -directory logpa
3900: 74 68 29 20 22 2e 22 29 29 29 0a 20 20 20 20 20 th) "."))).
3910: 28 69 66 20 28 6e 6f 74 20 28 64 69 72 65 63 74 (if (not (direct
3920: 6f 72 79 2d 65 78 69 73 74 73 3f 20 6c 6f 67 2d ory-exists? log-
3930: 64 69 72 29 29 0a 20 20 20 20 20 20 20 20 20 28 dir)). (
3940: 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d 6b system (conc "mk
3950: 64 69 72 20 2d 70 20 22 20 6c 6f 67 2d 64 69 72 dir -p " log-dir
3960: 29 29 29 0a 20 20 20 20 20 28 6f 70 65 6e 2d 6f ))). (open-o
3970: 75 74 70 75 74 2d 66 69 6c 65 20 6c 6f 67 70 61 utput-file logpa
3980: 74 68 29 29 0a 20 20 20 28 65 78 6e 20 28 29 0a th)). (exn ().
3990: 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 (debug:p
39a0: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
39b0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
39c0: 22 43 6f 75 6c 64 20 6e 6f 74 20 6f 70 65 6e 20 "Could not open
39d0: 6c 6f 67 20 66 69 6c 65 20 66 6f 72 20 77 72 69 log file for wri
39e0: 74 65 3a 20 22 6c 6f 67 70 61 74 68 29 0a 20 20 te: "logpath).
39f0: 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 2a 64 (define *d
3a00: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
3a10: 20 20 0a 20 20 20 20 20 20 20 20 28 65 78 69 74 . (exit
3a20: 20 31 29 29 29 29 0a 0a 20 20 20 20 0a 28 69 66 1)))).. .(if
3a30: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
3a40: 72 67 20 22 2d 6c 6f 67 22 29 28 61 72 67 73 3a rg "-log")(args:
3a50: 67 65 74 2d 61 72 67 20 22 2d 73 65 72 76 65 72 get-arg "-server
3a60: 22 29 29 20 3b 3b 20 72 65 64 69 72 65 63 74 20 ")) ;; redirect
3a70: 74 68 65 20 6c 6f 67 20 61 6c 77 61 79 73 20 77 the log always w
3a80: 68 65 6e 20 61 20 73 65 72 76 65 72 0a 20 20 20 hen a server.
3a90: 20 28 6c 65 74 2a 20 28 28 74 6c 20 20 20 28 6f (let* ((tl (o
3aa0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
3ab0: 22 2d 6c 6f 67 22 29 28 6c 61 75 6e 63 68 3a 73 "-log")(launch:s
3ac0: 65 74 75 70 29 29 29 20 20 20 3b 3b 20 72 75 6e etup))) ;; run
3ad0: 20 6c 61 75 6e 63 68 3a 73 65 74 75 70 20 69 66 launch:setup if
3ae0: 20 2d 73 65 72 76 65 72 0a 09 20 20 20 28 6c 6f -server.. (lo
3af0: 67 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 gf (or (args:get
3b00: 2d 61 72 67 20 22 2d 6c 6f 67 22 29 20 3b 3b 20 -arg "-log") ;;
3b10: 75 73 65 20 2d 6c 6f 67 20 75 6e 6c 65 73 73 20 use -log unless
3b20: 77 65 20 61 72 65 20 61 20 73 65 72 76 65 72 2c we are a server,
3b30: 20 74 68 65 6e 20 63 72 61 66 74 20 61 20 6c 6f then craft a lo
3b40: 67 66 69 6c 65 20 6e 61 6d 65 0a 09 09 20 20 20 gfile name...
3b50: 20 20 28 63 6f 6e 63 20 74 6c 20 22 2f 6c 6f 67 (conc tl "/log
3b60: 73 2f 73 65 72 76 65 72 2d 22 20 28 63 75 72 72 s/server-" (curr
3b70: 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 20 ent-process-id)
3b80: 22 2d 22 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 "-" (get-host-na
3b90: 6d 65 29 20 22 2e 6c 6f 67 22 29 29 29 0a 09 20 me) ".log")))..
3ba0: 20 20 28 6f 75 70 20 20 28 6f 70 65 6e 2d 6c 6f (oup (open-lo
3bb0: 67 66 69 6c 65 20 6c 6f 67 66 29 29 29 0a 20 20 gfile logf))).
3bc0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 61 72 (if (not (ar
3bd0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 gs:get-arg "-log
3be0: 22 29 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 ")).. (hash-tab
3bf0: 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 le-set! args:arg
3c00: 2d 68 61 73 68 20 22 2d 6c 6f 67 22 20 6c 6f 67 -hash "-log" log
3c10: 66 29 29 20 3b 3b 20 66 61 6b 65 20 6f 75 74 20 f)) ;; fake out
3c20: 66 75 74 75 72 65 20 71 75 65 72 69 65 73 20 6f future queries o
3c30: 66 20 2d 6c 6f 67 0a 20 20 20 20 20 20 28 64 65 f -log. (de
3c40: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
3c50: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
3c60: 72 74 2a 20 22 53 65 6e 64 69 6e 67 20 6c 6f 67 rt* "Sending log
3c70: 20 6f 75 74 70 75 74 20 74 6f 20 22 20 6c 6f 67 output to " log
3c80: 66 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a f). (set! *
3c90: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
3ca0: 2a 20 6f 75 70 29 29 29 0a 0a 28 69 66 20 28 6f * oup)))..(if (o
3cb0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
3cc0: 22 2d 68 22 29 0a 09 28 61 72 67 73 3a 67 65 74 "-h")..(args:get
3cd0: 2d 61 72 67 20 22 2d 68 65 6c 70 22 29 0a 09 28 -arg "-help")..(
3ce0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 2d args:get-arg "--
3cf0: 68 65 6c 70 22 29 29 0a 20 20 20 20 28 62 65 67 help")). (beg
3d00: 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 in. (print
3d10: 68 65 6c 70 29 0a 20 20 20 20 20 20 28 65 78 69 help). (exi
3d20: 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a t)))..(if (args:
3d30: 67 65 74 2d 61 72 67 20 22 2d 6d 61 6e 75 61 6c get-arg "-manual
3d40: 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 68 "). (let* ((h
3d50: 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 28 6f 72 tmlviewercmd (or
3d60: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
3d70: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
3d80: 74 75 70 22 20 22 68 74 6d 6c 76 69 65 77 65 72 tup" "htmlviewer
3d90: 63 6d 64 22 29 0a 09 09 09 20 20 20 20 20 20 28 cmd").... (
3da0: 63 6f 6d 6d 6f 6e 3a 77 68 69 63 68 20 27 28 22 common:which '("
3db0: 66 69 72 65 66 6f 78 22 20 22 61 72 6f 72 61 22 firefox" "arora"
3dc0: 29 29 29 29 0a 09 20 20 20 28 69 6e 73 74 61 6c )))).. (instal
3dd0: 6c 2d 68 6f 6d 65 20 20 28 63 6f 6d 6d 6f 6e 3a l-home (common:
3de0: 67 65 74 2d 69 6e 73 74 61 6c 6c 2d 61 72 65 61 get-install-area
3df0: 29 29 0a 09 20 20 20 28 6d 61 6e 75 61 6c 2d 68 )).. (manual-h
3e00: 74 6d 6c 20 20 20 28 63 6f 6e 63 20 69 6e 73 74 tml (conc inst
3e10: 61 6c 6c 2d 68 6f 6d 65 20 22 2f 73 68 61 72 65 all-home "/share
3e20: 2f 64 6f 63 73 2f 6d 65 67 61 74 65 73 74 5f 6d /docs/megatest_m
3e30: 61 6e 75 61 6c 2e 68 74 6d 6c 22 29 29 29 0a 20 anual.html"))).
3e40: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 69 6e (if (and in
3e50: 73 74 61 6c 6c 2d 68 6f 6d 65 0a 09 20 20 20 20 stall-home..
3e60: 20 20 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f (file-exists?
3e70: 20 6d 61 6e 75 61 6c 2d 68 74 6d 6c 29 29 0a 09 manual-html))..
3e80: 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 (system (conc
3e90: 22 28 22 20 68 74 6d 6c 76 69 65 77 65 72 63 6d "(" htmlviewercm
3ea0: 64 20 22 20 22 20 6d 61 6e 75 61 6c 2d 68 74 6d d " " manual-htm
3eb0: 6c 20 22 20 29 20 26 22 29 29 0a 09 20 20 28 73 l " ) &")).. (s
3ec0: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 28 22 20 ystem (conc "("
3ed0: 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 22 20 htmlviewercmd "
3ee0: 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f http://www.kiato
3ef0: 61 2e 63 6f 6d 2f 63 67 69 2d 62 69 6e 2f 66 6f a.com/cgi-bin/fo
3f00: 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 2f 64 ssils/megatest/d
3f10: 6f 63 2f 74 69 70 2f 64 6f 63 73 2f 6d 61 6e 75 oc/tip/docs/manu
3f20: 61 6c 2f 6d 65 67 61 74 65 73 74 5f 6d 61 6e 75 al/megatest_manu
3f30: 61 6c 2e 68 74 6d 6c 20 29 20 26 22 29 29 29 0a al.html ) &"))).
3f40: 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a (exit)))..
3f50: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
3f60: 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 0a g "-start-dir").
3f70: 20 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 (if (file-ex
3f80: 69 73 74 73 3f 20 28 61 72 67 73 3a 67 65 74 2d ists? (args:get-
3f90: 61 72 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 arg "-start-dir"
3fa0: 29 29 0a 09 28 63 68 61 6e 67 65 2d 64 69 72 65 ))..(change-dire
3fb0: 63 74 6f 72 79 20 28 61 72 67 73 3a 67 65 74 2d ctory (args:get-
3fc0: 61 72 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 arg "-start-dir"
3fd0: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
3fe0: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
3ff0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
4000: 70 6f 72 74 2a 20 22 6e 6f 6e 2d 65 78 69 73 74 port* "non-exist
4010: 61 6e 74 20 73 74 61 72 74 20 64 69 72 20 22 20 ant start dir "
4020: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4030: 73 74 61 72 74 2d 64 69 72 22 29 20 22 20 73 70 start-dir") " sp
4040: 65 63 69 66 69 65 64 2c 20 65 78 69 74 69 6e 67 ecified, exiting
4050: 2e 22 29 0a 09 20 20 28 65 78 69 74 20 31 29 29 .").. (exit 1))
4060: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
4070: 74 2d 61 72 67 20 22 2d 76 65 72 73 69 6f 6e 22 t-arg "-version"
4080: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
4090: 20 20 20 28 70 72 69 6e 74 20 28 63 6f 6d 6d 6f (print (commo
40a0: 6e 3a 76 65 72 73 69 6f 6e 2d 73 69 67 6e 61 74 n:version-signat
40b0: 75 72 65 29 29 20 3b 3b 20 28 70 72 69 6e 74 20 ure)) ;; (print
40c0: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
40d0: 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 29 ). (exit)))
40e0: 0a 0a 28 64 65 66 69 6e 65 20 2a 64 69 64 73 6f ..(define *didso
40f0: 6d 65 74 68 69 6e 67 2a 20 23 66 29 0a 0a 3b 3b mething* #f)..;;
4100: 20 4f 76 65 72 61 6c 6c 20 65 78 69 74 20 68 61 Overall exit ha
4110: 6e 64 6c 69 6e 67 20 73 65 74 75 70 20 69 6d 6d ndling setup imm
4120: 65 64 69 61 74 65 6c 79 0a 3b 3b 0a 28 69 66 20 ediately.;;.(if
4130: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
4140: 67 20 22 2d 70 72 6f 63 65 73 73 2d 72 65 61 70 g "-process-reap
4150: 22 29 29 0a 20 20 20 20 20 20 20 20 3b 3b 20 28 ")). ;; (
4160: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
4170: 75 6e 74 65 73 74 73 22 29 0a 09 3b 3b 20 28 61 untests")..;; (a
4180: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 rgs:get-arg "-ex
4190: 65 63 75 74 65 22 29 0a 09 3b 3b 20 28 61 72 67 ecute")..;; (arg
41a0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 6d 6f s:get-arg "-remo
41b0: 76 65 2d 72 75 6e 73 22 29 0a 09 3b 3b 20 28 61 ve-runs")..;; (a
41c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
41d0: 6e 73 74 65 70 22 29 29 0a 20 20 20 20 28 6c 65 nstep")). (le
41e0: 74 20 28 28 6f 72 69 67 69 6e 61 6c 2d 65 78 69 t ((original-exi
41f0: 74 20 28 65 78 69 74 2d 68 61 6e 64 6c 65 72 29 t (exit-handler)
4200: 29 29 0a 20 20 20 20 20 20 28 65 78 69 74 2d 68 )). (exit-h
4210: 61 6e 64 6c 65 72 20 28 6c 61 6d 62 64 61 20 28 andler (lambda (
4220: 23 21 6f 70 74 69 6f 6e 61 6c 20 28 65 78 69 74 #!optional (exit
4230: 2d 63 6f 64 65 20 30 29 29 0a 09 09 20 20 20 20 -code 0))...
4240: 20 20 28 70 72 69 6e 74 66 20 22 50 72 65 70 61 (printf "Prepa
4250: 72 69 6e 67 20 74 6f 20 65 78 69 74 20 77 69 74 ring to exit wit
4260: 68 20 65 78 69 74 20 63 6f 64 65 20 7e 41 20 2e h exit code ~A .
4270: 2e 2e 5c 6e 22 20 65 78 69 74 2d 63 6f 64 65 29 ..\n" exit-code)
4280: 0a 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 ... (for-ea
4290: 63 68 20 0a 09 09 20 20 20 20 20 20 20 28 6c 61 ch ... (la
42a0: 6d 62 64 61 20 28 70 69 64 29 0a 09 09 09 20 28 mbda (pid).... (
42b0: 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e handle-exception
42c0: 73 0a 09 09 09 20 20 65 78 6e 0a 09 09 09 20 20 s.... exn....
42d0: 23 74 0a 09 09 09 20 20 28 6c 65 74 2d 76 61 6c #t.... (let-val
42e0: 75 65 73 20 28 28 28 70 69 64 2d 76 61 6c 20 65 ues (((pid-val e
42f0: 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d xit-status exit-
4300: 63 6f 64 65 29 20 28 70 72 6f 63 65 73 73 2d 77 code) (process-w
4310: 61 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 09 ait pid #t)))...
4320: 09 09 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 .. (if (or
4330: 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 70 69 64 (eq? pid-val pid
4340: 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 65 71 )...... (eq
4350: 3f 20 70 69 64 2d 76 61 6c 20 30 29 29 0a 09 09 ? pid-val 0))...
4360: 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 ... (begin.....
4370: 09 20 20 20 20 28 70 72 69 6e 74 66 20 22 53 65 . (printf "Se
4380: 6e 64 69 6e 67 20 73 69 67 6e 61 6c 2f 74 65 72 nding signal/ter
4390: 6d 20 74 6f 20 7e 41 5c 6e 22 20 70 69 64 29 0a m to ~A\n" pid).
43a0: 09 09 09 09 09 20 20 20 20 28 70 72 6f 63 65 73 ..... (proces
43b0: 73 2d 73 69 67 6e 61 6c 20 70 69 64 20 73 69 67 s-signal pid sig
43c0: 6e 61 6c 2f 74 65 72 6d 29 29 29 29 29 29 0a 09 nal/term))))))..
43d0: 09 20 20 20 20 20 20 20 28 70 72 6f 63 65 73 73 . (process
43e0: 3a 63 68 69 6c 64 72 65 6e 20 23 66 29 29 0a 09 :children #f))..
43f0: 09 20 20 20 20 20 20 28 6f 72 69 67 69 6e 61 6c . (original
4400: 2d 65 78 69 74 20 65 78 69 74 2d 63 6f 64 65 29 -exit exit-code)
4410: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
4420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
4460: 3b 20 4d 69 73 63 20 73 65 74 75 70 20 73 74 75 ; Misc setup stu
4470: 66 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ff.;;===========
4480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 64 65 ===========..(de
44c0: 62 75 67 3a 73 65 74 75 70 29 0a 0a 28 69 66 20 bug:setup)..(if
44d0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
44e0: 6c 6f 67 67 69 6e 67 22 29 28 73 65 74 21 20 2a logging")(set! *
44f0: 6c 6f 67 67 69 6e 67 2a 20 23 74 29 29 0a 0a 28 logging* #t))..(
4500: 69 66 20 28 64 65 62 75 67 3a 64 65 62 75 67 2d if (debug:debug-
4510: 6d 6f 64 65 20 33 29 20 3b 3b 20 77 65 20 61 72 mode 3) ;; we ar
4520: 65 20 6f 62 76 69 6f 75 73 6c 79 20 64 65 62 75 e obviously debu
4530: 67 67 69 6e 67 0a 20 20 20 20 28 73 65 74 21 20 gging. (set!
4540: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 6f open-run-close o
4550: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f pen-run-close-no
4560: 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c -exception-handl
4570: 69 6e 67 29 29 0a 0a 28 69 66 20 28 61 72 67 73 ing))..(if (args
4580: 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 :get-arg "-itemp
4590: 61 74 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 att"). (let (
45a0: 28 6e 65 77 76 61 6c 20 28 63 6f 6e 63 20 28 61 (newval (conc (a
45b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
45c0: 73 74 70 61 74 74 22 29 20 22 2f 22 20 28 61 72 stpatt") "/" (ar
45d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 gs:get-arg "-ite
45e0: 6d 70 61 74 74 22 29 29 29 29 0a 20 20 20 20 20 mpatt")))).
45f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
4600: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
4610: 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 2d 69 74 t* "WARNING: -it
4620: 65 6d 70 61 74 74 20 68 61 73 20 62 65 65 6e 20 empatt has been
4630: 64 65 70 72 65 63 61 74 65 64 2c 20 70 6c 65 61 deprecated, plea
4640: 73 65 20 75 73 65 20 2d 74 65 73 74 70 61 74 74 se use -testpatt
4650: 20 74 65 73 74 70 61 74 74 2f 69 74 65 6d 70 61 testpatt/itempa
4660: 74 74 20 6d 65 74 68 6f 64 2c 20 6e 65 77 20 74 tt method, new t
4670: 65 73 74 70 61 74 74 20 69 73 20 22 6e 65 77 76 estpatt is "newv
4680: 61 6c 29 0a 20 20 20 20 20 20 28 68 61 73 68 2d al). (hash-
4690: 74 61 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a table-set! args:
46a0: 61 72 67 2d 68 61 73 68 20 22 2d 74 65 73 74 70 arg-hash "-testp
46b0: 61 74 74 22 20 6e 65 77 76 61 6c 29 0a 20 20 20 att" newval).
46c0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 (hash-table-d
46d0: 65 6c 65 74 65 21 20 61 72 67 73 3a 61 72 67 2d elete! args:arg-
46e0: 68 61 73 68 20 22 2d 69 74 65 6d 70 61 74 74 22 hash "-itempatt"
46f0: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
4700: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
4710: 73 22 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 s"). (debug:p
4720: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
4730: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
4740: 4e 47 3a 20 5c 22 2d 72 75 6e 74 65 73 74 73 5c NG: \"-runtests\
4750: 22 20 69 73 20 64 65 70 72 65 63 61 74 65 64 2e " is deprecated.
4760: 20 55 73 65 20 5c 22 2d 72 75 6e 5c 22 20 77 69 Use \"-run\" wi
4770: 74 68 20 5c 22 2d 74 65 73 74 70 61 74 74 5c 22 th \"-testpatt\"
4780: 20 69 6e 73 74 65 61 64 22 29 29 0a 0a 28 6f 6e instead"))..(on
4790: 2d 65 78 69 74 20 73 74 64 2d 65 78 69 74 2d 70 -exit std-exit-p
47a0: 72 6f 63 65 64 75 72 65 29 0a 0a 3b 3b 3d 3d 3d rocedure)..;;===
47b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
47c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
47d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
47e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
47f0: 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 20 67 65 6e 65 ===.;; Misc gene
4800: 72 61 6c 20 63 61 6c 6c 73 0a 3b 3b 3d 3d 3d 3d ral calls.;;====
4810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4820: 3d 3d 3d 3d 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 0a 0a 28 69 66 20 28 61 6e 64 20 28 61 72 ==..(if (and (ar
4860: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 61 63 gs:get-arg "-cac
4870: 68 65 2d 64 62 22 29 0a 20 20 20 20 20 20 20 20 he-db").
4880: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4890: 2d 73 6f 75 72 63 65 2d 64 62 22 29 29 0a 20 20 -source-db")).
48a0: 20 20 28 6c 65 74 2a 20 28 28 74 65 6d 70 2d 64 (let* ((temp-d
48b0: 69 72 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 ir (or (args:get
48c0: 2d 61 72 67 20 22 2d 74 61 72 67 65 74 2d 64 62 -arg "-target-db
48d0: 22 29 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 ") (create-direc
48e0: 74 6f 72 79 20 28 63 6f 6e 63 20 22 2f 74 6d 70 tory (conc "/tmp
48f0: 2f 22 20 28 67 65 74 65 6e 76 20 22 55 53 45 52 /" (getenv "USER
4900: 22 29 20 22 2f 22 20 28 73 74 72 69 6e 67 2d 74 ") "/" (string-t
4910: 72 61 6e 73 6c 61 74 65 20 28 63 75 72 72 65 6e ranslate (curren
4920: 74 2d 64 69 72 65 63 74 6f 72 79 29 20 22 2f 22 t-directory) "/"
4930: 20 22 5f 22 29 29 29 29 29 0a 20 20 20 20 20 20 "_"))))).
4940: 20 20 20 20 20 28 74 61 72 67 65 74 2d 64 62 20 (target-db
4950: 28 63 6f 6e 63 20 74 65 6d 70 2d 64 69 72 20 22 (conc temp-dir "
4960: 2f 63 61 63 68 65 64 2e 64 62 22 29 29 0a 20 20 /cached.db")).
4970: 20 20 20 20 20 20 20 20 20 28 73 6f 75 72 63 65 (source
4980: 2d 64 62 20 28 61 72 67 73 3a 67 65 74 2d 61 72 -db (args:get-ar
4990: 67 20 22 2d 73 6f 75 72 63 65 2d 64 62 22 29 29 g "-source-db"))
49a0: 29 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 ) .
49b0: 28 64 62 3a 63 61 63 68 65 2d 66 6f 72 2d 72 65 (db:cache-for-re
49c0: 61 64 2d 6f 6e 6c 79 20 73 6f 75 72 63 65 2d 64 ad-only source-d
49d0: 62 20 74 61 72 67 65 74 2d 64 62 29 0a 20 20 20 b target-db).
49e0: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
49f0: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b ething* #t)))..;
4a00: 3b 20 68 61 6e 64 6c 65 20 61 20 63 6c 65 61 6e ; handle a clean
4a10: 2d 63 61 63 68 65 20 72 65 71 75 65 73 74 20 61 -cache request a
4a20: 73 20 65 61 72 6c 79 20 61 73 20 70 6f 73 73 69 s early as possi
4a30: 62 6c 65 0a 3b 3b 0a 28 69 66 20 28 61 72 67 73 ble.;;.(if (args
4a40: 3a 67 65 74 2d 61 72 67 20 22 2d 63 6c 65 61 6e :get-arg "-clean
4a50: 2d 63 61 63 68 65 22 29 0a 20 20 20 20 28 62 65 -cache"). (be
4a60: 67 69 6e 0a 20 20 20 20 20 20 28 73 65 74 21 20 gin. (set!
4a70: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
4a80: 74 29 20 3b 3b 20 73 75 70 70 72 65 73 73 20 74 t) ;; suppress t
4a90: 68 65 20 68 65 6c 70 20 6f 75 74 70 75 74 2e 0a he help output..
4aa0: 20 20 20 20 20 20 28 69 66 20 28 67 65 74 65 6e (if (geten
4ab0: 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 20 3b v "MT_TARGET") ;
4ac0: 3b 20 6e 6f 20 70 6f 69 6e 74 20 69 6e 20 74 72 ; no point in tr
4ad0: 79 69 6e 67 20 69 66 20 6e 6f 20 74 61 72 67 65 ying if no targe
4ae0: 74 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 t.. (if (args:g
4af0: 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 et-arg "-runname
4b00: 22 29 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 ").. (let*
4b10: 28 28 74 6f 70 70 61 74 68 20 20 28 6c 61 75 6e ((toppath (laun
4b20: 63 68 3a 73 65 74 75 70 29 29 0a 09 09 20 20 20 ch:setup))...
4b30: 20 20 28 6c 69 6e 6b 74 72 65 65 20 28 69 66 20 (linktree (if
4b40: 74 6f 70 70 61 74 68 20 28 63 6f 6e 66 69 67 66 toppath (configf
4b50: 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 :lookup *configd
4b60: 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c 69 6e at* "setup" "lin
4b70: 6b 74 72 65 65 22 29 29 29 0a 09 09 20 20 20 20 ktree")))...
4b80: 20 28 72 75 6e 74 6f 70 20 20 20 28 63 6f 6e 63 (runtop (conc
4b90: 20 6c 69 6e 6b 74 72 65 65 20 22 2f 22 20 28 67 linktree "/" (g
4ba0: 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 etenv "MT_TARGET
4bb0: 22 29 20 22 2f 22 20 28 61 72 67 73 3a 67 65 74 ") "/" (args:get
4bc0: 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 -arg "-runname")
4bd0: 29 29 0a 09 09 20 20 20 20 20 28 66 69 6c 65 73 ))... (files
4be0: 20 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 (if (file-ex
4bf0: 69 73 74 73 3f 20 72 75 6e 74 6f 70 29 0a 09 09 ists? runtop)...
4c00: 09 09 20 20 20 28 61 70 70 65 6e 64 20 28 67 6c .. (append (gl
4c10: 6f 62 20 28 63 6f 6e 63 20 72 75 6e 74 6f 70 20 ob (conc runtop
4c20: 22 2f 2e 6d 65 67 61 74 65 73 74 2a 22 29 29 0a "/.megatest*")).
4c30: 09 09 09 09 09 20 20 20 28 67 6c 6f 62 20 28 63 ..... (glob (c
4c40: 6f 6e 63 20 72 75 6e 74 6f 70 20 22 2f 2e 72 75 onc runtop "/.ru
4c50: 6e 63 6f 6e 66 69 67 2a 22 29 29 29 0a 09 09 09 nconfig*")))....
4c60: 09 20 20 20 27 28 29 29 29 29 0a 09 09 28 69 66 . '())))...(if
4c70: 20 28 6e 75 6c 6c 3f 20 66 69 6c 65 73 29 0a 09 (null? files)..
4c80: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
4c90: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
4ca0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f 20 t-log-port* "No
4cb0: 63 61 63 68 65 64 20 6d 65 67 61 74 65 73 74 20 cached megatest
4cc0: 6f 72 20 72 75 6e 63 6f 6e 66 69 67 73 20 66 69 or runconfigs fi
4cd0: 6c 65 73 20 66 6f 75 6e 64 2e 20 4e 6f 6e 65 20 les found. None
4ce0: 72 65 6d 6f 76 65 64 2e 22 29 0a 09 09 20 20 20 removed.")...
4cf0: 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 (begin...
4d00: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
4d10: 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 0 *default-log
4d20: 2d 70 6f 72 74 2a 20 22 52 65 6d 6f 76 69 6e 67 -port* "Removing
4d30: 20 63 61 63 68 65 64 20 66 69 6c 65 73 3a 5c 6e cached files:\n
4d40: 20 20 20 20 22 20 28 73 74 72 69 6e 67 2d 69 6e " (string-in
4d50: 74 65 72 73 70 65 72 73 65 20 66 69 6c 65 73 20 tersperse files
4d60: 22 5c 6e 20 20 20 20 22 29 29 0a 09 09 20 20 20 "\n "))...
4d70: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 (for-each ...
4d80: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
4d90: 66 29 0a 09 09 09 20 28 68 61 6e 64 6c 65 2d 65 f).... (handle-e
4da0: 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 20 20 20 xceptions....
4db0: 20 20 65 78 6e 0a 09 09 09 20 20 20 20 20 28 64 exn.... (d
4dc0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
4dd0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
4de0: 22 57 41 52 4e 49 4e 47 3a 20 46 61 69 6c 65 64 "WARNING: Failed
4df0: 20 74 6f 20 72 65 6d 6f 76 65 20 66 69 6c 65 20 to remove file
4e00: 22 20 66 29 0a 09 09 09 20 20 20 28 64 65 6c 65 " f).... (dele
4e10: 74 65 2d 66 69 6c 65 20 66 29 29 29 0a 09 09 20 te-file f)))...
4e20: 20 20 20 20 20 20 66 69 6c 65 73 29 29 29 29 0a files)))).
4e30: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
4e40: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
4e50: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4e60: 2d 63 6c 65 61 6e 2d 63 61 63 68 65 20 72 65 71 -clean-cache req
4e70: 75 69 72 65 73 20 2d 72 75 6e 6e 61 6d 65 2e 22 uires -runname."
4e80: 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 )).. (debug:pri
4e90: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
4ea0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d ult-log-port* "-
4eb0: 63 6c 65 61 6e 2d 63 61 63 68 65 20 72 65 71 75 clean-cache requ
4ec0: 69 72 65 73 20 2d 74 61 72 67 65 74 20 6f 72 20 ires -target or
4ed0: 2d 72 65 71 74 61 72 67 22 29 29 29 29 0a 09 20 -reqtarg"))))..
4ee0: 20 20 20 0a 09 20 20 0a 28 69 66 20 28 61 72 67 .. .(if (arg
4ef0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 32 s:get-arg "-env2
4f00: 66 69 6c 65 22 29 0a 20 20 20 20 28 62 65 67 69 file"). (begi
4f10: 6e 0a 20 20 20 20 20 20 28 73 61 76 65 2d 65 6e n. (save-en
4f20: 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c vironment-as-fil
4f30: 65 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 es (args:get-arg
4f40: 20 22 2d 65 6e 76 32 66 69 6c 65 22 29 29 0a 20 "-env2file")).
4f50: 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
4f60: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
4f70: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
4f80: 72 67 20 22 2d 6c 69 73 74 2d 64 69 73 6b 73 22 rg "-list-disks"
4f90: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6f 70 ). (let ((top
4fa0: 70 61 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 path (launch:set
4fb0: 75 70 29 29 29 0a 20 20 20 20 20 20 28 70 72 69 up))). (pri
4fc0: 6e 74 20 0a 20 20 20 20 20 20 20 28 73 74 72 69 nt . (stri
4fd0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a ng-intersperse .
4fe0: 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 .(map (lambda (x
4ff0: 29 0a 09 20 20 20 20 20 20 20 28 73 74 72 69 6e ).. (strin
5000: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 g-intersperse ..
5010: 09 78 0a 09 09 22 20 3d 3e 20 22 29 29 0a 09 20 .x..." => "))..
5020: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d (common:get-
5030: 64 69 73 6b 73 20 2a 63 6f 6e 66 69 67 64 61 74 disks *configdat
5040: 2a 29 29 0a 09 22 5c 6e 22 29 29 0a 20 20 20 20 *)).."\n")).
5050: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
5060: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
5070: 20 63 73 76 20 70 72 6f 63 65 73 73 69 6e 67 20 csv processing
5080: 72 65 63 6f 72 64 0a 28 64 65 66 69 6e 65 20 28 record.(define (
5090: 6d 61 6b 65 2d 72 65 66 64 62 3a 63 73 76 29 0a make-refdb:csv).
50a0: 20 20 28 76 65 63 74 6f 72 20 0a 20 20 20 28 6d (vector . (m
50b0: 61 6b 65 2d 73 70 61 72 73 65 2d 61 72 72 61 79 ake-sparse-array
50c0: 29 0a 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d ). (make-hash-
50d0: 74 61 62 6c 65 29 0a 20 20 20 28 6d 61 6b 65 2d table). (make-
50e0: 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 20 30 hash-table). 0
50f0: 0a 20 20 20 30 29 29 0a 28 64 65 66 69 6e 65 2d . 0)).(define-
5100: 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 inline (refdb:cs
5110: 76 2d 67 65 74 2d 73 76 65 63 20 20 20 20 20 76 v-get-svec v
5120: 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 ec) (vector-r
5130: 65 66 20 20 76 65 63 20 30 29 29 0a 28 64 65 66 ef vec 0)).(def
5140: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 ine-inline (refd
5150: 62 3a 63 73 76 2d 67 65 74 2d 72 6f 77 73 20 20 b:csv-get-rows
5160: 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 vec) (vect
5170: 6f 72 2d 72 65 66 20 20 76 65 63 20 31 29 29 0a or-ref vec 1)).
5180: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
5190: 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 63 6f refdb:csv-get-co
51a0: 6c 73 20 20 20 20 20 76 65 63 29 20 20 20 20 28 ls vec) (
51b0: 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 vector-ref vec
51c0: 32 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 2)).(define-inli
51d0: 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 ne (refdb:csv-ge
51e0: 74 2d 6d 61 78 72 6f 77 20 20 20 76 65 63 29 20 t-maxrow vec)
51f0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 (vector-ref
5200: 76 65 63 20 33 29 29 0a 28 64 65 66 69 6e 65 2d vec 3)).(define-
5210: 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 inline (refdb:cs
5220: 76 2d 67 65 74 2d 6d 61 78 63 6f 6c 20 20 20 76 v-get-maxcol v
5230: 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 ec) (vector-r
5240: 65 66 20 20 76 65 63 20 34 29 29 0a 28 64 65 66 ef vec 4)).(def
5250: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 ine-inline (refd
5260: 62 3a 63 73 76 2d 73 65 74 2d 73 76 65 63 21 20 b:csv-set-svec!
5270: 20 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 vec val)(vect
5280: 6f 72 2d 73 65 74 21 20 76 65 63 20 30 20 76 61 or-set! vec 0 va
5290: 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 l)).(define-inli
52a0: 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 ne (refdb:csv-se
52b0: 74 2d 72 6f 77 73 21 20 20 20 20 76 65 63 20 76 t-rows! vec v
52c0: 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 al)(vector-set!
52d0: 76 65 63 20 31 20 76 61 6c 29 29 0a 28 64 65 66 vec 1 val)).(def
52e0: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 ine-inline (refd
52f0: 62 3a 63 73 76 2d 73 65 74 2d 63 6f 6c 73 21 20 b:csv-set-cols!
5300: 20 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 vec val)(vect
5310: 6f 72 2d 73 65 74 21 20 76 65 63 20 32 20 76 61 or-set! vec 2 va
5320: 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 l)).(define-inli
5330: 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 ne (refdb:csv-se
5340: 74 2d 6d 61 78 72 6f 77 21 20 20 76 65 63 20 76 t-maxrow! vec v
5350: 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 al)(vector-set!
5360: 76 65 63 20 33 20 76 61 6c 29 29 0a 28 64 65 66 vec 3 val)).(def
5370: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 ine-inline (refd
5380: 62 3a 63 73 76 2d 73 65 74 2d 6d 61 78 63 6f 6c b:csv-set-maxcol
5390: 21 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 ! vec val)(vect
53a0: 6f 72 2d 73 65 74 21 20 76 65 63 20 34 20 76 61 or-set! vec 4 va
53b0: 6c 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 l))..(define (ge
53c0: 74 2d 64 61 74 20 72 65 73 75 6c 74 73 20 73 68 t-dat results sh
53d0: 65 65 74 6e 61 6d 65 29 0a 20 20 28 6f 72 20 28 eetname). (or (
53e0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
53f0: 65 66 61 75 6c 74 20 72 65 73 75 6c 74 73 20 73 efault results s
5400: 68 65 65 74 6e 61 6d 65 20 23 66 29 0a 20 20 20 heetname #f).
5410: 20 20 20 28 6c 65 74 20 28 28 74 6d 70 2d 76 65 (let ((tmp-ve
5420: 63 20 20 28 6d 61 6b 65 2d 72 65 66 64 62 3a 63 c (make-refdb:c
5430: 73 76 29 29 29 0a 09 28 68 61 73 68 2d 74 61 62 sv)))..(hash-tab
5440: 6c 65 2d 73 65 74 21 20 72 65 73 75 6c 74 73 20 le-set! results
5450: 73 68 65 65 74 6e 61 6d 65 20 74 6d 70 2d 76 65 sheetname tmp-ve
5460: 63 29 0a 09 74 6d 70 2d 76 65 63 29 29 29 0a 0a c)..tmp-vec)))..
5470: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
5480: 67 20 22 2d 72 65 66 64 62 32 64 61 74 22 29 0a g "-refdb2dat").
5490: 20 20 20 20 28 6c 65 74 2a 20 28 28 69 6e 70 75 (let* ((inpu
54a0: 74 2d 64 62 20 28 61 72 67 73 3a 67 65 74 2d 61 t-db (args:get-a
54b0: 72 67 20 22 2d 72 65 66 64 62 32 64 61 74 22 29 rg "-refdb2dat")
54c0: 29 0a 09 20 20 20 28 6f 75 74 2d 66 69 6c 65 20 ).. (out-file
54d0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
54e0: 6f 22 29 29 0a 09 20 20 20 28 6f 75 74 2d 66 6d o")).. (out-fm
54f0: 74 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 t (or (args:get
5500: 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 -arg "-dumpmode"
5510: 29 20 22 73 63 68 65 6d 65 22 29 29 0a 09 20 20 ) "scheme"))..
5520: 20 28 6f 75 74 2d 70 6f 72 74 20 28 69 66 20 28 (out-port (if (
5530: 61 6e 64 20 6f 75 74 2d 66 69 6c 65 20 0a 09 09 and out-file ...
5540: 09 20 20 20 20 20 20 28 6e 6f 74 20 28 6d 65 6d . (not (mem
5550: 62 65 72 20 6f 75 74 2d 66 6d 74 20 27 28 22 73 ber out-fmt '("s
5560: 71 6c 69 74 65 33 22 20 22 63 73 76 22 29 29 29 qlite3" "csv")))
5570: 29 0a 09 09 09 20 28 6f 70 65 6e 2d 6f 75 74 70 ).... (open-outp
5580: 75 74 2d 66 69 6c 65 20 6f 75 74 2d 66 69 6c 65 ut-file out-file
5590: 29 0a 09 09 09 20 28 63 75 72 72 65 6e 74 2d 6f ).... (current-o
55a0: 75 74 70 75 74 2d 70 6f 72 74 29 29 29 0a 09 20 utput-port)))..
55b0: 20 20 28 72 65 73 2d 64 61 74 61 20 28 63 6f 6e (res-data (con
55c0: 66 69 67 66 3a 72 65 61 64 2d 72 65 66 64 62 20 figf:read-refdb
55d0: 69 6e 70 75 74 2d 64 62 29 29 0a 09 20 20 20 28 input-db)).. (
55e0: 64 61 74 61 20 20 20 20 20 28 63 61 72 20 72 65 data (car re
55f0: 73 2d 64 61 74 61 29 29 0a 09 20 20 20 28 6d 73 s-data)).. (ms
5600: 67 20 20 20 20 20 20 28 63 61 64 72 20 72 65 73 g (cadr res
5610: 2d 64 61 74 61 29 29 29 0a 20 20 20 20 20 20 28 -data))). (
5620: 69 66 20 28 6e 6f 74 20 64 61 74 61 29 0a 09 20 if (not data)..
5630: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
5640: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
5650: 74 2a 20 22 42 61 64 20 69 6e 70 75 74 3f 20 64 t* "Bad input? d
5660: 61 74 61 3d 22 20 64 61 74 61 29 20 3b 3b 20 73 ata=" data) ;; s
5670: 6f 6d 65 20 65 72 72 6f 72 20 6f 63 63 75 72 72 ome error occurr
5680: 65 64 0a 09 20 20 28 77 69 74 68 2d 6f 75 74 70 ed.. (with-outp
5690: 75 74 2d 74 6f 2d 70 6f 72 74 20 6f 75 74 2d 70 ut-to-port out-p
56a0: 6f 72 74 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 ort.. (lambda
56b0: 20 28 29 0a 09 20 20 20 20 20 20 28 63 61 73 65 ().. (case
56c0: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
56d0: 20 6f 75 74 2d 66 6d 74 29 0a 09 09 28 28 73 63 out-fmt)...((sc
56e0: 68 65 6d 65 29 28 70 70 20 64 61 74 61 29 29 0a heme)(pp data)).
56f0: 09 09 28 28 70 65 72 6c 29 0a 09 09 20 3b 3b 20 ..((perl)... ;;
5700: 28 70 72 69 6e 74 20 22 25 68 61 73 68 20 3d 20 (print "%hash =
5710: 28 22 29 0a 09 09 20 3b 3b 20 20 20 20 20 20 20 (")... ;;
5720: 20 6b 65 79 31 20 3d 3e 20 27 76 61 6c 75 65 31 key1 => 'value1
5730: 27 2c 0a 09 09 20 3b 3b 20 20 20 20 20 20 20 20 ',... ;;
5740: 6b 65 79 32 20 3d 3e 20 27 76 61 6c 75 65 32 27 key2 => 'value2'
5750: 2c 0a 09 09 20 3b 3b 20 20 20 20 20 20 20 20 6b ,... ;; k
5760: 65 79 33 20 3d 3e 20 27 76 61 6c 75 65 33 27 2c ey3 => 'value3',
5770: 0a 09 09 20 3b 3b 20 29 3b 0a 09 09 20 28 63 6f ... ;; );... (co
5780: 6e 66 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 nfigf:map-all-hi
5790: 65 72 2d 61 6c 69 73 74 20 0a 09 09 20 20 64 61 er-alist ... da
57a0: 74 61 20 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 ta ... (lambda
57b0: 28 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 (sheetname secti
57c0: 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 onname varname v
57d0: 61 6c 29 0a 09 09 20 20 20 20 28 70 72 69 6e 74 al)... (print
57e0: 20 22 24 64 61 74 61 7b 5c 22 22 20 73 68 65 65 "$data{\"" shee
57f0: 74 6e 61 6d 65 20 22 5c 22 7d 7b 5c 22 22 20 73 tname "\"}{\"" s
5800: 65 63 74 69 6f 6e 6e 61 6d 65 20 22 5c 22 7d 7b ectionname "\"}{
5810: 5c 22 22 20 76 61 72 6e 61 6d 65 20 22 5c 22 7d \"" varname "\"}
5820: 20 3d 20 5c 22 22 20 76 61 6c 20 22 5c 22 3b 22 = \"" val "\";"
5830: 29 29 29 29 0a 09 09 28 28 70 79 74 68 6f 6e 20 ))))...((python
5840: 72 75 62 79 29 0a 09 09 20 28 70 72 69 6e 74 20 ruby)... (print
5850: 22 64 61 74 61 3d 7b 7d 22 29 0a 09 09 20 28 63 "data={}")... (c
5860: 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 onfigf:map-all-h
5870: 69 65 72 2d 61 6c 69 73 74 0a 09 09 20 20 64 61 ier-alist... da
5880: 74 61 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 28 ta... (lambda (
5890: 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f sheetname sectio
58a0: 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 nname varname va
58b0: 6c 29 0a 09 09 20 20 20 20 28 70 72 69 6e 74 20 l)... (print
58c0: 22 64 61 74 61 5b 5c 22 22 20 73 68 65 65 74 6e "data[\"" sheetn
58d0: 61 6d 65 20 22 5c 22 5d 5b 5c 22 22 20 73 65 63 ame "\"][\"" sec
58e0: 74 69 6f 6e 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 tionname "\"][\"
58f0: 22 20 76 61 72 6e 61 6d 65 20 22 5c 22 5d 20 3d " varname "\"] =
5900: 20 5c 22 22 20 76 61 6c 20 22 5c 22 22 29 29 0a \"" val "\"")).
5910: 09 09 20 20 69 6e 69 74 70 72 6f 63 31 3a 0a 09 .. initproc1:..
5920: 09 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 65 . (lambda (shee
5930: 74 6e 61 6d 65 29 0a 09 09 20 20 20 20 28 70 72 tname)... (pr
5940: 69 6e 74 20 22 64 61 74 61 5b 5c 22 22 20 73 68 int "data[\"" sh
5950: 65 65 74 6e 61 6d 65 20 22 5c 22 5d 20 3d 20 7b eetname "\"] = {
5960: 7d 22 29 29 0a 09 09 20 20 69 6e 69 74 70 72 6f }"))... initpro
5970: 63 32 3a 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 c2:... (lambda
5980: 28 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 (sheetname secti
5990: 6f 6e 6e 61 6d 65 29 0a 09 09 20 20 20 20 28 70 onname)... (p
59a0: 72 69 6e 74 20 22 64 61 74 61 5b 5c 22 22 20 73 rint "data[\"" s
59b0: 68 65 65 74 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 heetname "\"][\"
59c0: 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 5c " sectionname "\
59d0: 22 5d 20 3d 20 7b 7d 22 29 29 29 29 0a 09 09 28 "] = {}"))))...(
59e0: 28 63 73 76 29 0a 09 09 20 28 6c 65 74 2a 20 28 (csv)... (let* (
59f0: 28 72 65 73 75 6c 74 73 20 20 28 6d 61 6b 65 2d (results (make-
5a00: 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 hash-table)) ;;
5a10: 28 6d 61 6b 65 2d 73 70 61 72 73 65 2d 61 72 72 (make-sparse-arr
5a20: 61 79 29 29 29 0a 09 09 09 28 72 6f 77 2d 63 6f ay)))....(row-co
5a30: 6c 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 ls (make-hash-ta
5a40: 62 6c 65 29 29 29 20 3b 3b 20 68 61 73 68 20 6f ble))) ;; hash o
5a50: 66 20 68 61 73 68 65 73 20 77 68 65 72 65 20 73 f hashes where s
5a60: 65 63 74 69 6f 6e 20 3d 3e 20 68 74 20 7b 20 72 ection => ht { r
5a70: 6f 77 2d 3c 6e 61 6d 65 3e 20 3d 3e 20 6e 75 6d ow-<name> => num
5a80: 20 6f 72 20 63 6f 6c 2d 3c 6e 61 6d 65 3e 20 3d or col-<name> =
5a90: 3e 20 6e 75 6d 0a 09 09 20 20 20 3b 3b 20 28 70 > num... ;; (p
5aa0: 72 69 6e 74 20 22 64 61 74 61 3d 22 29 0a 09 09 rint "data=")...
5ab0: 20 20 20 3b 3b 20 28 70 70 20 64 61 74 61 29 0a ;; (pp data).
5ac0: 09 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 6d 61 .. (configf:ma
5ad0: 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 p-all-hier-alist
5ae0: 0a 09 09 20 20 20 20 64 61 74 61 0a 09 09 20 20 ... data...
5af0: 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 65 74 (lambda (sheet
5b00: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 name sectionname
5b10: 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 0a 09 09 varname val)...
5b20: 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 ;; (print
5b30: 22 73 68 65 65 74 6e 61 6d 65 3a 20 22 20 73 68 "sheetname: " sh
5b40: 65 65 74 6e 61 6d 65 20 22 2c 20 73 65 63 74 69 eetname ", secti
5b50: 6f 6e 6e 61 6d 65 3a 20 22 20 73 65 63 74 69 6f onname: " sectio
5b60: 6e 6e 61 6d 65 20 22 2c 20 76 61 72 6e 61 6d 65 nname ", varname
5b70: 3a 20 22 20 76 61 72 6e 61 6d 65 20 22 2c 20 76 : " varname ", v
5b80: 61 6c 3a 20 22 20 76 61 6c 29 0a 09 09 20 20 20 al: " val)...
5b90: 20 20 20 28 6c 65 74 2a 20 28 28 64 61 74 20 20 (let* ((dat
5ba0: 20 20 20 20 28 67 65 74 2d 64 61 74 20 72 65 73 (get-dat res
5bb0: 75 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 29 29 ults sheetname))
5bc0: 0a 09 09 09 20 20 20 20 20 28 76 65 63 20 20 20 .... (vec
5bd0: 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 (refdb:csv-ge
5be0: 74 2d 73 76 65 63 20 64 61 74 29 29 0a 09 09 09 t-svec dat))....
5bf0: 20 20 20 20 20 28 72 6f 77 6e 61 6d 65 73 20 28 (rownames (
5c00: 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 72 6f refdb:csv-get-ro
5c10: 77 73 20 64 61 74 29 29 0a 09 09 09 20 20 20 20 ws dat))....
5c20: 20 28 63 6f 6c 6e 61 6d 65 73 20 28 72 65 66 64 (colnames (refd
5c30: 62 3a 63 73 76 2d 67 65 74 2d 63 6f 6c 73 20 64 b:csv-get-cols d
5c40: 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 63 75 at)).... (cu
5c50: 72 72 72 6f 77 6e 20 28 68 61 73 68 2d 74 61 62 rrrown (hash-tab
5c60: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 le-ref/default r
5c70: 6f 77 6e 61 6d 65 73 20 76 61 72 6e 61 6d 65 20 ownames varname
5c80: 23 66 29 29 0a 09 09 09 20 20 20 20 20 28 63 75 #f)).... (cu
5c90: 72 72 63 6f 6c 6e 20 28 68 61 73 68 2d 74 61 62 rrcoln (hash-tab
5ca0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 le-ref/default c
5cb0: 6f 6c 6e 61 6d 65 73 20 73 65 63 74 69 6f 6e 6e olnames sectionn
5cc0: 61 6d 65 20 23 66 29 29 0a 09 09 09 20 20 20 20 ame #f))....
5cd0: 20 28 72 6f 77 6e 20 20 20 20 20 28 6f 72 20 63 (rown (or c
5ce0: 75 72 72 72 6f 77 6e 20 0a 09 09 09 09 09 20 20 urrrown ......
5cf0: 20 28 6c 65 74 2a 20 28 28 6c 61 73 74 6e 20 20 (let* ((lastn
5d00: 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d (refdb:csv-get-
5d10: 6d 61 78 72 6f 77 20 64 61 74 29 29 0a 09 09 09 maxrow dat))....
5d20: 09 09 09 20 20 28 6e 65 77 72 6f 77 6e 20 28 2b ... (newrown (+
5d30: 20 6c 61 73 74 6e 20 31 29 29 29 0a 09 09 09 09 lastn 1))).....
5d40: 09 20 20 20 20 20 28 72 65 66 64 62 3a 63 73 76 . (refdb:csv
5d50: 2d 73 65 74 2d 6d 61 78 72 6f 77 21 20 64 61 74 -set-maxrow! dat
5d60: 20 6e 65 77 72 6f 77 6e 29 0a 09 09 09 09 09 20 newrown)......
5d70: 20 20 20 20 6e 65 77 72 6f 77 6e 29 29 29 0a 09 newrown)))..
5d80: 09 09 20 20 20 20 20 28 63 6f 6c 6e 20 20 20 20 .. (coln
5d90: 20 28 6f 72 20 63 75 72 72 63 6f 6c 6e 20 0a 09 (or currcoln ..
5da0: 09 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 6c .... (let* ((l
5db0: 61 73 74 6e 20 20 20 28 72 65 66 64 62 3a 63 73 astn (refdb:cs
5dc0: 76 2d 67 65 74 2d 6d 61 78 63 6f 6c 20 64 61 74 v-get-maxcol dat
5dd0: 29 29 0a 09 09 09 09 09 09 20 20 28 6e 65 77 63 ))....... (newc
5de0: 6f 6c 6e 20 28 2b 20 6c 61 73 74 6e 20 31 29 29 oln (+ lastn 1))
5df0: 29 0a 09 09 09 09 09 20 20 20 20 20 28 72 65 66 )...... (ref
5e00: 64 62 3a 63 73 76 2d 73 65 74 2d 6d 61 78 63 6f db:csv-set-maxco
5e10: 6c 21 20 64 61 74 20 6e 65 77 63 6f 6c 6e 29 0a l! dat newcoln).
5e20: 09 09 09 09 09 20 20 20 20 20 6e 65 77 63 6f 6c ..... newcol
5e30: 6e 29 29 29 29 0a 09 09 09 28 69 66 20 28 6e 6f n))))....(if (no
5e40: 74 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d t (sparse-array-
5e50: 72 65 66 20 76 65 63 20 30 20 63 6f 6c 6e 29 29 ref vec 0 coln))
5e60: 20 3b 3b 20 28 65 71 3f 20 72 6f 77 6e 20 30 29 ;; (eq? rown 0)
5e70: 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 .... (begin..
5e80: 09 09 20 20 20 20 20 20 28 73 70 61 72 73 65 2d .. (sparse-
5e90: 61 72 72 61 79 2d 73 65 74 21 20 76 65 63 20 30 array-set! vec 0
5ea0: 20 63 6f 6c 6e 20 73 65 63 74 69 6f 6e 6e 61 6d coln sectionnam
5eb0: 65 29 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 28 e).... ;; (
5ec0: 70 72 69 6e 74 20 22 73 70 61 72 73 65 2d 61 72 print "sparse-ar
5ed0: 72 61 79 2d 72 65 66 20 22 20 30 20 22 2c 22 20 ray-ref " 0 ","
5ee0: 63 6f 6c 6e 20 22 3d 22 20 28 73 70 61 72 73 65 coln "=" (sparse
5ef0: 2d 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 30 -array-ref vec 0
5f00: 20 63 6f 6c 6e 29 29 0a 09 09 09 20 20 20 20 20 coln))....
5f10: 20 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 ))....(if (not
5f20: 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 (sparse-array-re
5f30: 66 20 76 65 63 20 72 6f 77 6e 20 30 29 29 20 3b f vec rown 0)) ;
5f40: 3b 20 28 65 71 3f 20 63 6f 6c 6e 20 30 29 0a 09 ; (eq? coln 0)..
5f50: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 .. (begin....
5f60: 20 20 20 20 20 20 28 73 70 61 72 73 65 2d 61 72 (sparse-ar
5f70: 72 61 79 2d 73 65 74 21 20 76 65 63 20 72 6f 77 ray-set! vec row
5f80: 6e 20 30 20 76 61 72 6e 61 6d 65 29 0a 09 09 09 n 0 varname)....
5f90: 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 ;; (print
5fa0: 22 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 "sparse-array-re
5fb0: 66 20 22 20 72 6f 77 6e 20 22 2c 22 20 30 20 22 f " rown "," 0 "
5fc0: 3d 22 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 =" (sparse-array
5fd0: 2d 72 65 66 20 76 65 63 20 72 6f 77 6e 20 30 29 -ref vec rown 0)
5fe0: 29 0a 09 09 09 20 20 20 20 20 20 29 29 0a 09 09 ).... ))...
5ff0: 09 28 69 66 20 28 6e 6f 74 20 63 75 72 72 72 6f .(if (not currro
6000: 77 6e 29 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 wn)(hash-table-s
6010: 65 74 21 20 72 6f 77 6e 61 6d 65 73 20 76 61 72 et! rownames var
6020: 6e 61 6d 65 20 72 6f 77 6e 29 29 0a 09 09 09 28 name rown))....(
6030: 69 66 20 28 6e 6f 74 20 63 75 72 72 63 6f 6c 6e if (not currcoln
6040: 29 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 )(hash-table-set
6050: 21 20 63 6f 6c 6e 61 6d 65 73 20 73 65 63 74 69 ! colnames secti
6060: 6f 6e 6e 61 6d 65 20 63 6f 6c 6e 29 29 0a 09 09 onname coln))...
6070: 09 3b 3b 20 28 70 72 69 6e 74 20 22 64 61 74 3d .;; (print "dat=
6080: 22 20 64 61 74 20 22 2c 20 72 6f 77 6e 3d 22 20 " dat ", rown="
6090: 72 6f 77 6e 20 22 2c 20 63 6f 6c 6e 3d 22 20 63 rown ", coln=" c
60a0: 6f 6c 6e 29 0a 09 09 09 28 73 70 61 72 73 65 2d oln)....(sparse-
60b0: 61 72 72 61 79 2d 73 65 74 21 20 76 65 63 20 72 array-set! vec r
60c0: 6f 77 6e 20 63 6f 6c 6e 20 76 61 6c 29 0a 09 09 own coln val)...
60d0: 09 3b 3b 20 28 70 72 69 6e 74 20 22 73 70 61 72 .;; (print "spar
60e0: 73 65 2d 61 72 72 61 79 2d 72 65 66 20 22 20 72 se-array-ref " r
60f0: 6f 77 6e 20 22 2c 22 20 63 6f 6c 6e 20 22 3d 22 own "," coln "="
6100: 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 (sparse-array-r
6110: 65 66 20 76 65 63 20 72 6f 77 6e 20 63 6f 6c 6e ef vec rown coln
6120: 29 29 0a 09 09 09 29 29 29 0a 09 09 20 20 20 28 ))....)))... (
6130: 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 20 28 for-each... (
6140: 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d lambda (sheetnam
6150: 65 29 0a 09 09 20 20 20 20 20 20 28 6c 65 74 2a e)... (let*
6160: 20 28 28 73 68 65 65 74 64 61 74 20 28 67 65 74 ((sheetdat (get
6170: 2d 64 61 74 20 72 65 73 75 6c 74 73 20 73 68 65 -dat results she
6180: 65 74 6e 61 6d 65 29 29 0a 09 09 09 20 20 20 20 etname))....
6190: 20 28 73 76 65 63 20 20 20 20 20 28 72 65 66 64 (svec (refd
61a0: 62 3a 63 73 76 2d 67 65 74 2d 73 76 65 63 20 73 b:csv-get-svec s
61b0: 68 65 65 74 64 61 74 29 29 0a 09 09 09 20 20 20 heetdat))....
61c0: 20 20 28 6d 61 78 72 6f 77 20 20 20 28 72 65 66 (maxrow (ref
61d0: 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 72 6f db:csv-get-maxro
61e0: 77 20 73 68 65 65 74 64 61 74 29 29 0a 09 09 09 w sheetdat))....
61f0: 20 20 20 20 20 28 6d 61 78 63 6f 6c 20 20 20 28 (maxcol (
6200: 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 refdb:csv-get-ma
6210: 78 63 6f 6c 20 73 68 65 65 74 64 61 74 29 29 0a xcol sheetdat)).
6220: 09 09 09 20 20 20 20 20 28 66 6e 61 6d 65 20 20 ... (fname
6230: 20 20 28 69 66 20 6f 75 74 2d 66 69 6c 65 20 0a (if out-file .
6240: 09 09 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d ..... (string-
6250: 73 75 62 73 74 69 74 75 74 65 20 22 25 73 22 20 substitute "%s"
6260: 73 68 65 65 74 6e 61 6d 65 20 6f 75 74 2d 66 69 sheetname out-fi
6270: 6c 65 29 20 3b 3b 20 22 2f 66 6f 6f 2f 62 61 72 le) ;; "/foo/bar
6280: 2f 25 73 2e 63 73 76 22 29 0a 09 09 09 09 09 20 /%s.csv")......
6290: 20 20 28 63 6f 6e 63 20 73 68 65 65 74 6e 61 6d (conc sheetnam
62a0: 65 20 22 2e 63 73 76 22 29 29 29 29 0a 09 09 09 e ".csv"))))....
62b0: 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d (with-output-to-
62c0: 66 69 6c 65 20 66 6e 61 6d 65 0a 09 09 09 20 20 file fname....
62d0: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 (lambda ()....
62e0: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 53 68 65 ;; (print "She
62f0: 65 74 6e 61 6d 65 3a 20 22 20 73 68 65 65 74 6e etname: " sheetn
6300: 61 6d 65 29 0a 09 09 09 20 20 20 20 28 6c 65 74 ame).... (let
6310: 20 6c 6f 6f 70 20 28 28 72 6f 77 20 20 20 20 20 loop ((row
6320: 20 20 30 29 0a 09 09 09 09 20 20 20 20 20 20 20 0).....
6330: 28 63 6f 6c 20 20 20 20 20 20 20 30 29 0a 09 09 (col 0)...
6340: 09 09 20 20 20 20 20 20 20 28 63 75 72 72 2d 72 .. (curr-r
6350: 6f 77 20 27 28 29 29 0a 09 09 09 09 20 20 20 20 ow '()).....
6360: 20 20 20 28 72 65 73 75 6c 74 20 20 20 27 28 29 (result '()
6370: 29 29 0a 09 09 09 20 20 20 20 20 20 28 6c 65 74 )).... (let
6380: 2a 20 28 28 76 61 6c 20 28 73 70 61 72 73 65 2d * ((val (sparse-
6390: 61 72 72 61 79 2d 72 65 66 20 73 76 65 63 20 72 array-ref svec r
63a0: 6f 77 20 63 6f 6c 29 29 0a 09 09 09 09 20 20 20 ow col)).....
63b0: 20 20 28 64 69 73 70 2d 76 61 6c 20 28 69 66 20 (disp-val (if
63c0: 76 61 6c 0a 09 09 09 09 09 09 20 20 20 28 63 6f val....... (co
63d0: 6e 63 20 22 5c 22 22 20 76 61 6c 20 22 5c 22 22 nc "\"" val "\""
63e0: 29 0a 09 09 09 09 09 09 20 20 20 22 22 29 29 29 )....... "")))
63f0: 0a 09 09 09 09 28 69 66 20 28 3e 20 63 6f 6c 20 .....(if (> col
6400: 30 29 28 64 69 73 70 6c 61 79 20 22 2c 22 29 29 0)(display ","))
6410: 0a 09 09 09 09 28 64 69 73 70 6c 61 79 20 64 69 .....(display di
6420: 73 70 2d 76 61 6c 29 0a 09 09 09 09 28 63 6f 6e sp-val).....(con
6430: 64 0a 09 09 09 09 20 28 28 3e 20 72 6f 77 20 6d d..... ((> row m
6440: 61 78 72 6f 77 29 28 64 69 73 70 6c 61 79 20 22 axrow)(display "
6450: 5c 6e 22 29 20 72 65 73 75 6c 74 29 0a 09 09 09 \n") result)....
6460: 09 20 28 28 3e 3d 20 63 6f 6c 20 6d 61 78 63 6f . ((>= col maxco
6470: 6c 29 0a 09 09 09 09 20 20 28 64 69 73 70 6c 61 l)..... (displa
6480: 79 20 22 5c 6e 22 29 0a 09 09 09 09 20 20 28 6c y "\n")..... (l
6490: 6f 6f 70 20 28 2b 20 72 6f 77 20 31 29 20 30 20 oop (+ row 1) 0
64a0: 27 28 29 20 28 61 70 70 65 6e 64 20 72 65 73 75 '() (append resu
64b0: 6c 74 20 28 6c 69 73 74 20 63 75 72 72 2d 72 6f lt (list curr-ro
64c0: 77 29 29 29 29 0a 09 09 09 09 20 28 65 6c 73 65 w))))..... (else
64d0: 0a 09 09 09 09 20 20 28 6c 6f 6f 70 20 72 6f 77 ..... (loop row
64e0: 20 28 2b 20 63 6f 6c 20 31 29 20 28 61 70 70 65 (+ col 1) (appe
64f0: 6e 64 20 63 75 72 72 2d 72 6f 77 20 28 6c 69 73 nd curr-row (lis
6500: 74 20 76 61 6c 29 29 20 72 65 73 75 6c 74 29 29 t val)) result))
6510: 29 29 29 29 29 29 29 0a 09 09 20 20 20 20 28 68 )))))))... (h
6520: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 ash-table-keys r
6530: 65 73 75 6c 74 73 29 29 29 29 0a 09 09 28 28 73 esults))))...((s
6540: 71 6c 69 74 65 33 29 0a 09 09 20 28 6c 65 74 2a qlite3)... (let*
6550: 20 28 28 64 62 2d 66 69 6c 65 20 20 20 28 6f 72 ((db-file (or
6560: 20 6f 75 74 2d 66 69 6c 65 20 28 70 61 74 68 6e out-file (pathn
6570: 61 6d 65 2d 66 69 6c 65 20 69 6e 70 75 74 2d 64 ame-file input-d
6580: 62 29 29 29 0a 09 09 09 28 64 62 2d 65 78 69 73 b)))....(db-exis
6590: 74 73 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f ts (file-exists?
65a0: 20 64 62 2d 66 69 6c 65 29 29 0a 09 09 09 28 64 db-file))....(d
65b0: 62 20 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 b (sqlite
65c0: 33 3a 6f 70 65 6e 2d 64 61 74 61 62 61 73 65 20 3:open-database
65d0: 64 62 2d 66 69 6c 65 29 29 29 0a 09 09 20 20 20 db-file)))...
65e0: 28 69 66 20 28 6e 6f 74 20 64 62 2d 65 78 69 73 (if (not db-exis
65f0: 74 73 29 28 73 71 6c 69 74 65 33 3a 65 78 65 63 ts)(sqlite3:exec
6600: 75 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 ute db "CREATE T
6610: 41 42 4c 45 20 64 61 74 61 20 28 73 68 65 65 74 ABLE data (sheet
6620: 2c 73 65 63 74 69 6f 6e 2c 76 61 72 2c 76 61 6c ,section,var,val
6630: 29 3b 22 29 29 0a 09 09 20 20 20 28 63 6f 6e 66 );"))... (conf
6640: 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 igf:map-all-hier
6650: 2d 61 6c 69 73 74 0a 09 09 20 20 20 20 64 61 74 -alist... dat
6660: 61 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 a... (lambda
6670: 28 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 (sheetname secti
6680: 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 onname varname v
6690: 61 6c 29 0a 09 09 20 20 20 20 20 20 28 73 71 6c al)... (sql
66a0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 0a ite3:execute db.
66b0: 09 09 09 09 20 20 20 20 20 20 20 22 49 4e 53 45 .... "INSE
66c0: 52 54 20 4f 52 20 52 45 50 4c 41 43 45 20 49 4e RT OR REPLACE IN
66d0: 54 4f 20 64 61 74 61 20 28 73 68 65 65 74 2c 73 TO data (sheet,s
66e0: 65 63 74 69 6f 6e 2c 76 61 72 2c 76 61 6c 29 20 ection,var,val)
66f0: 56 41 4c 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 29 VALUES (?,?,?,?)
6700: 3b 22 0a 09 09 09 09 20 20 20 20 20 20 20 73 68 ;"..... sh
6710: 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e eetname sectionn
6720: 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 ame varname val)
6730: 29 29 0a 09 09 20 20 20 28 73 71 6c 69 74 65 33 ))... (sqlite3
6740: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 29 :finalize! db)))
6750: 0a 09 09 28 65 6c 73 65 0a 09 09 20 28 70 70 20 ...(else... (pp
6760: 64 61 74 61 29 29 29 29 29 29 0a 20 20 20 20 20 data)))))).
6770: 20 28 69 66 20 6f 75 74 2d 66 69 6c 65 20 28 63 (if out-file (c
6780: 6c 6f 73 65 2d 6f 75 74 70 75 74 2d 70 6f 72 74 lose-output-port
6790: 20 6f 75 74 2d 70 6f 72 74 29 29 0a 20 20 20 20 out-port)).
67a0: 20 20 28 65 78 69 74 29 20 3b 3b 20 79 65 73 2c (exit) ;; yes,
67b0: 20 62 65 6e 64 69 6e 67 20 74 68 65 20 72 75 6c bending the rul
67c0: 65 73 20 68 65 72 65 20 2d 20 6e 65 65 64 20 74 es here - need t
67d0: 6f 20 65 78 69 74 20 73 69 6e 63 65 20 74 68 69 o exit since thi
67e0: 73 20 69 73 20 61 20 75 74 69 6c 69 74 79 0a 20 s is a utility.
67f0: 20 20 20 20 20 29 29 0a 0a 28 69 66 20 28 61 72 ))..(if (ar
6800: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 69 6e gs:get-arg "-pin
6810: 67 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 g"). (let* ((
6820: 73 65 72 76 65 72 2d 69 64 20 20 20 20 20 28 73 server-id (s
6830: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 tring->number (a
6840: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 69 rgs:get-arg "-pi
6850: 6e 67 22 29 29 29 20 3b 3b 20 65 78 74 72 61 63 ng"))) ;; extrac
6860: 74 20 72 75 6e 2d 69 64 20 28 69 2e 65 2e 20 6e t run-id (i.e. n
6870: 6f 20 22 3a 22 0a 09 20 20 20 28 68 6f 73 74 3a o ":".. (host:
6880: 70 6f 72 74 20 20 20 20 20 28 61 72 67 73 3a 67 port (args:g
6890: 65 74 2d 61 72 67 20 22 2d 70 69 6e 67 22 29 29 et-arg "-ping"))
68a0: 29 0a 20 20 20 20 20 20 28 73 65 72 76 65 72 3a ). (server:
68b0: 70 69 6e 67 20 28 6f 72 20 73 65 72 76 65 72 2d ping (or server-
68c0: 69 64 20 68 6f 73 74 3a 70 6f 72 74 29 20 64 6f id host:port) do
68d0: 2d 65 78 69 74 3a 20 23 74 29 29 29 0a 0a 3b 3b -exit: #t)))..;;
68e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
68f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6920: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 61 70 74 75 72 ======.;; Captur
6930: 65 2c 20 73 61 76 65 20 61 6e 64 20 6d 61 6e 69 e, save and mani
6940: 70 75 6c 61 74 65 20 65 6e 76 69 72 6f 6e 6d 65 pulate environme
6950: 6e 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d nts.;;==========
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 0a 0a 3b 3b ============..;;
69a0: 20 4e 4f 54 45 3a 20 4b 65 65 70 20 74 68 65 73 NOTE: Keep thes
69b0: 65 20 61 62 6f 76 65 20 74 68 65 20 73 65 63 74 e above the sect
69c0: 69 6f 6e 20 77 68 65 72 65 20 74 68 65 20 73 65 ion where the se
69d0: 72 76 65 72 20 6f 72 20 63 6c 69 65 6e 74 20 63 rver or client c
69e0: 6f 64 65 20 69 73 20 73 65 74 75 70 0a 0a 28 6c ode is setup..(l
69f0: 65 74 20 28 28 65 6e 76 63 61 70 20 28 61 72 67 et ((envcap (arg
6a00: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 63 s:get-arg "-envc
6a10: 61 70 22 29 29 29 0a 20 20 28 69 66 20 65 6e 76 ap"))). (if env
6a20: 63 61 70 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 cap. (let*
6a30: 28 28 64 62 20 20 20 20 20 20 28 65 6e 76 3a 6f ((db (env:o
6a40: 70 65 6e 2d 64 62 20 28 69 66 20 28 6e 75 6c 6c pen-db (if (null
6a50: 3f 20 72 65 6d 61 72 67 73 29 20 22 65 6e 76 64 ? remargs) "envd
6a60: 61 74 2e 64 62 22 20 28 63 61 72 20 72 65 6d 61 at.db" (car rema
6a70: 72 67 73 29 29 29 29 29 0a 09 28 65 6e 76 3a 73 rgs)))))..(env:s
6a80: 61 76 65 2d 65 6e 76 2d 76 61 72 73 20 64 62 20 ave-env-vars db
6a90: 65 6e 76 63 61 70 29 0a 09 28 65 6e 76 3a 63 6c envcap)..(env:cl
6aa0: 6f 73 65 2d 64 61 74 61 62 61 73 65 20 64 62 29 ose-database db)
6ab0: 0a 09 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 ..(set! *didsome
6ac0: 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b thing* #t))))..;
6ad0: 3b 20 64 65 6c 74 61 20 22 6c 61 6e 67 75 61 67 ; delta "languag
6ae0: 65 22 20 77 69 6c 6c 20 65 76 65 6e 74 75 61 6c e" will eventual
6af0: 6c 79 20 62 65 20 72 65 73 3d 61 2b 62 2d 63 20 ly be res=a+b-c
6b00: 62 75 74 20 66 6f 72 20 6e 6f 77 20 69 74 20 69 but for now it i
6b10: 73 20 6a 75 73 74 20 72 65 73 3d 61 2d 62 20 0a s just res=a-b .
6b20: 3b 3b 0a 28 6c 65 74 20 28 28 65 6e 76 64 65 6c ;;.(let ((envdel
6b30: 74 61 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ta (args:get-arg
6b40: 20 22 2d 65 6e 76 64 65 6c 74 61 22 29 29 29 0a "-envdelta"))).
6b50: 20 20 28 69 66 20 65 6e 76 64 65 6c 74 61 0a 20 (if envdelta.
6b60: 20 20 20 20 20 28 6c 65 74 20 28 28 6d 61 74 63 (let ((matc
6b70: 68 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 h (string-split
6b80: 65 6e 76 64 65 6c 74 61 20 22 2d 22 29 29 29 3b envdelta "-")));
6b90: 3b 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 ; (string-match
6ba0: 22 28 5b 61 2d 7a 30 2d 39 5f 5d 2b 29 3d 28 5b "([a-z0-9_]+)=([
6bb0: 61 2d 7a 30 2d 39 5f 5c 5c 2d 2c 5d 2b 29 22 20 a-z0-9_\\-,]+)"
6bc0: 65 6e 76 64 65 6c 74 61 29 29 29 0a 09 28 69 66 envdelta)))..(if
6bd0: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 6d 61 74 (not (null? mat
6be0: 63 68 29 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 ch)).. (let*
6bf0: 28 28 64 62 20 20 20 20 20 20 20 20 28 65 6e 76 ((db (env
6c00: 3a 6f 70 65 6e 2d 64 62 20 28 69 66 20 28 6e 75 :open-db (if (nu
6c10: 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 22 65 6e ll? remargs) "en
6c20: 76 64 61 74 2e 64 62 22 20 28 63 61 72 20 72 65 vdat.db" (car re
6c30: 6d 61 72 67 73 29 29 29 29 0a 09 09 20 20 20 3b margs))))... ;
6c40: 3b 20 28 72 65 73 63 74 78 20 20 20 20 28 63 61 ; (resctx (ca
6c50: 64 72 20 6d 61 74 63 68 29 29 0a 09 09 20 20 20 dr match))...
6c60: 3b 3b 20 28 65 71 75 6e 20 20 20 20 20 20 28 63 ;; (equn (c
6c70: 61 64 64 72 20 6d 61 74 63 68 29 29 0a 09 09 20 addr match))...
6c80: 20 20 28 70 61 72 74 73 20 20 20 20 20 6d 61 74 (parts mat
6c90: 63 68 29 20 3b 3b 20 28 73 74 72 69 6e 67 2d 73 ch) ;; (string-s
6ca0: 70 6c 69 74 20 65 71 75 6e 20 22 2d 22 29 29 0a plit equn "-")).
6cb0: 09 09 20 20 20 28 6d 69 6e 75 65 6e 64 20 20 20 .. (minuend
6cc0: 28 63 61 72 20 70 61 72 74 73 29 29 0a 09 09 20 (car parts))...
6cd0: 20 20 28 73 75 62 74 72 61 65 6e 64 20 28 63 61 (subtraend (ca
6ce0: 64 72 20 70 61 72 74 73 29 29 0a 09 09 20 20 20 dr parts))...
6cf0: 28 61 64 64 65 64 20 20 20 20 20 28 65 6e 76 3a (added (env:
6d00: 67 65 74 2d 61 64 64 65 64 20 20 20 64 62 20 6d get-added db m
6d10: 69 6e 75 65 6e 64 20 73 75 62 74 72 61 65 6e 64 inuend subtraend
6d20: 29 29 0a 09 09 20 20 20 28 72 65 6d 6f 76 65 64 ))... (removed
6d30: 20 20 20 28 65 6e 76 3a 67 65 74 2d 72 65 6d 6f (env:get-remo
6d40: 76 65 64 20 64 62 20 6d 69 6e 75 65 6e 64 20 73 ved db minuend s
6d50: 75 62 74 72 61 65 6e 64 29 29 0a 09 09 20 20 20 ubtraend))...
6d60: 28 63 68 61 6e 67 65 64 20 20 20 28 65 6e 76 3a (changed (env:
6d70: 67 65 74 2d 63 68 61 6e 67 65 64 20 64 62 20 6d get-changed db m
6d80: 69 6e 75 65 6e 64 20 73 75 62 74 72 61 65 6e 64 inuend subtraend
6d90: 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 70 ))).. ;; (p
6da0: 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 p (hash-table->a
6db0: 6c 69 73 74 20 61 64 64 65 64 29 29 0a 09 20 20 list added))..
6dc0: 20 20 20 20 3b 3b 20 28 70 70 20 28 68 61 73 68 ;; (pp (hash
6dd0: 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 72 65 -table->alist re
6de0: 6d 6f 76 65 64 29 29 0a 09 20 20 20 20 20 20 3b moved)).. ;
6df0: 3b 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c ; (pp (hash-tabl
6e00: 65 2d 3e 61 6c 69 73 74 20 63 68 61 6e 67 65 64 e->alist changed
6e10: 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 )).. (if (a
6e20: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 22 rgs:get-arg "-o"
6e30: 29 0a 09 09 20 20 28 77 69 74 68 2d 6f 75 74 70 )... (with-outp
6e40: 75 74 2d 74 6f 2d 66 69 6c 65 0a 09 09 20 20 20 ut-to-file...
6e50: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
6e60: 20 22 2d 6f 22 29 0a 09 09 20 20 20 20 28 6c 61 "-o")... (la
6e70: 6d 62 64 61 20 28 29 0a 09 09 20 20 20 20 20 20 mbda ()...
6e80: 28 65 6e 76 3a 70 72 69 6e 74 20 61 64 64 65 64 (env:print added
6e90: 20 72 65 6d 6f 76 65 64 20 63 68 61 6e 67 65 64 removed changed
6ea0: 29 29 29 0a 09 09 20 20 28 65 6e 76 3a 70 72 69 )))... (env:pri
6eb0: 6e 74 20 61 64 64 65 64 20 72 65 6d 6f 76 65 64 nt added removed
6ec0: 20 63 68 61 6e 67 65 64 29 29 0a 09 20 20 20 20 changed))..
6ed0: 20 20 28 65 6e 76 3a 63 6c 6f 73 65 2d 64 61 74 (env:close-dat
6ee0: 61 62 61 73 65 20 64 62 29 0a 09 20 20 20 20 20 abase db)..
6ef0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
6f00: 68 69 6e 67 2a 20 23 74 29 29 0a 09 20 20 20 20 hing* #t))..
6f10: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
6f20: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
6f30: 67 2d 70 6f 72 74 2a 20 22 50 61 72 61 6d 65 74 g-port* "Paramet
6f40: 65 72 20 74 6f 20 2d 65 6e 76 64 65 6c 74 61 20 er to -envdelta
6f50: 73 68 6f 75 6c 64 20 62 65 20 6e 65 77 3d 73 74 should be new=st
6f60: 61 72 2d 65 6e 64 22 29 29 29 29 29 0a 0a 3b 3b ar-end")))))..;;
6f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6fb0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 ======.;; Start
6fc0: 74 68 65 20 73 65 72 76 65 72 20 2d 20 63 61 6e the server - can
6fd0: 20 62 65 20 64 6f 6e 65 20 69 6e 20 63 6f 6e 6a be done in conj
6fe0: 75 6e 63 74 69 6f 6e 20 77 69 74 68 20 2d 72 75 unction with -ru
6ff0: 6e 61 6c 6c 20 6f 72 20 2d 72 75 6e 74 65 73 74 nall or -runtest
7000: 73 20 28 6f 6e 65 20 64 61 79 2e 2e 2e 29 0a 3b s (one day...).;
7010: 3b 20 20 20 77 65 20 73 74 61 72 74 20 74 68 65 ; we start the
7020: 20 73 65 72 76 65 72 20 69 66 20 6e 6f 74 20 72 server if not r
7030: 75 6e 6e 69 6e 67 20 65 6c 73 65 20 73 74 61 72 unning else star
7040: 74 20 74 68 65 20 63 6c 69 65 6e 74 20 74 68 72 t the client thr
7050: 65 61 64 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ead.;;==========
7060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
70a0: 20 53 65 72 76 65 72 3f 20 53 74 61 72 74 20 75 Server? Start u
70b0: 70 20 68 65 72 65 2e 0a 3b 3b 0a 28 69 66 20 28 p here..;;.(if (
70c0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
70d0: 65 72 76 65 72 22 29 0a 20 20 20 20 28 6c 65 74 erver"). (let
70e0: 20 28 28 74 6c 20 20 20 20 20 20 20 20 28 6c 61 ((tl (la
70f0: 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 20 20 20 unch:setup)).
7100: 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 (transpor
7110: 74 2d 74 79 70 65 20 28 73 74 72 69 6e 67 2d 3e t-type (string->
7120: 73 79 6d 62 6f 6c 20 28 6f 72 20 28 61 72 67 73 symbol (or (args
7130: 3a 67 65 74 2d 61 72 67 20 22 2d 74 72 61 6e 73 :get-arg "-trans
7140: 70 6f 72 74 22 29 20 22 68 74 74 70 22 29 29 29 port") "http")))
7150: 29 0a 20 20 20 20 20 20 28 73 65 72 76 65 72 3a ). (server:
7160: 6c 61 75 6e 63 68 20 30 20 74 72 61 6e 73 70 6f launch 0 transpo
7170: 72 74 2d 74 79 70 65 29 0a 20 20 20 20 20 20 28 rt-type). (
7180: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
7190: 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 ng* #t)))..(if (
71a0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
71b0: 20 22 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 "-list-servers"
71c0: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
71d0: 20 22 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 29 "-stop-server")
71e0: 0a 20 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 . (args:g
71f0: 65 74 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 et-arg "-kill-se
7200: 72 76 65 72 22 29 29 0a 20 20 20 20 28 6c 65 74 rver")). (let
7210: 20 28 28 74 6c 20 28 6c 61 75 6e 63 68 3a 73 65 ((tl (launch:se
7220: 74 75 70 29 29 29 0a 20 20 20 20 20 20 28 69 66 tup))). (if
7230: 20 74 6c 20 0a 09 20 20 28 6c 65 74 2a 20 28 28 tl .. (let* ((
7240: 74 64 62 64 61 74 20 20 28 74 61 73 6b 73 3a 6f tdbdat (tasks:o
7250: 70 65 6e 2d 64 62 29 29 0a 09 09 20 28 73 65 72 pen-db))... (ser
7260: 76 65 72 73 20 28 74 61 73 6b 73 3a 67 65 74 2d vers (tasks:get-
7270: 61 6c 6c 2d 73 65 72 76 65 72 73 20 28 64 62 3a all-servers (db:
7280: 64 65 6c 61 79 2d 69 66 2d 62 75 73 79 20 74 64 delay-if-busy td
7290: 62 64 61 74 29 29 29 0a 09 09 20 28 66 6d 74 73 bdat)))... (fmts
72a0: 74 72 20 20 22 7e 35 61 7e 31 32 61 7e 38 61 7e tr "~5a~12a~8a~
72b0: 32 30 61 7e 32 34 61 7e 31 30 61 7e 31 30 61 7e 20a~24a~10a~10a~
72c0: 31 30 61 7e 31 30 61 5c 6e 22 29 0a 09 09 20 28 10a~10a\n")... (
72d0: 73 65 72 76 65 72 73 2d 74 6f 2d 6b 69 6c 6c 20 servers-to-kill
72e0: 27 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 '()).
72f0: 20 20 20 20 20 20 28 6b 69 6c 6c 2d 73 77 69 74 (kill-swit
7300: 63 68 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 ch (if (args:ge
7310: 74 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 72 t-arg "-kill-ser
7320: 76 65 72 22 29 20 22 2d 39 22 20 22 22 29 29 0a ver") "-9" "")).
7330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7340: 20 28 6b 69 6c 6c 69 6e 66 6f 20 20 20 28 6f 72 (killinfo (or
7350: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7360: 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 29 20 28 -stop-server") (
7370: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6b args:get-arg "-k
7380: 69 6c 6c 2d 73 65 72 76 65 72 22 29 20 29 29 0a ill-server") )).
7390: 09 09 20 28 6b 68 6f 73 74 2d 70 6f 72 74 20 28 .. (khost-port (
73a0: 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 69 66 20 if killinfo (if
73b0: 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 (substring-index
73c0: 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f 29 28 73 ":" killinfo)(s
73d0: 74 72 69 6e 67 2d 73 70 6c 69 74 20 22 3a 22 29 tring-split ":")
73e0: 20 23 66 29 20 23 66 29 29 0a 09 09 20 28 73 69 #f) #f))... (si
73f0: 64 20 20 20 20 20 20 20 20 28 69 66 20 6b 69 6c d (if kil
7400: 6c 69 6e 66 6f 20 28 69 66 20 28 73 75 62 73 74 linfo (if (subst
7410: 72 69 6e 67 2d 69 6e 64 65 78 20 22 3a 22 20 6b ring-index ":" k
7420: 69 6c 6c 69 6e 66 6f 29 20 23 66 20 28 73 74 72 illinfo) #f (str
7430: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 6b 69 6c 6c ing->number kill
7440: 69 6e 66 6f 29 29 20 23 66 29 29 29 0a 09 20 20 info)) #f)))..
7450: 20 20 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 (format #t fmt
7460: 73 74 72 20 22 49 64 22 20 22 4d 54 76 65 72 22 str "Id" "MTver"
7470: 20 22 50 69 64 22 20 22 48 6f 73 74 22 20 22 49 "Pid" "Host" "I
7480: 6e 74 65 72 66 61 63 65 3a 4f 75 74 50 6f 72 74 nterface:OutPort
7490: 22 20 22 49 6e 50 6f 72 74 22 20 22 4c 61 73 74 " "InPort" "Last
74a0: 42 65 61 74 22 20 22 53 74 61 74 65 22 20 22 54 Beat" "State" "T
74b0: 72 61 6e 73 70 6f 72 74 22 29 0a 09 20 20 20 20 ransport")..
74c0: 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 74 (format #t fmtst
74d0: 72 20 22 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 r "==" "=====" "
74e0: 3d 3d 3d 22 20 22 3d 3d 3d 3d 22 20 22 3d 3d 3d ===" "====" "===
74f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 20 =============="
7500: 22 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d "======" "======
7510: 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d ==" "=====" "===
7520: 3d 3d 3d 3d 3d 3d 22 29 0a 09 20 20 20 20 28 66 ======").. (f
7530: 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 28 or-each .. (
7540: 6c 61 6d 62 64 61 20 28 73 65 72 76 65 72 29 0a lambda (server).
7550: 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 . (let* ((
7560: 69 64 20 20 20 20 20 20 20 20 20 28 76 65 63 74 id (vect
7570: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 30 29 or-ref server 0)
7580: 29 0a 09 09 20 20 20 20 20 20 28 70 69 64 20 20 )... (pid
7590: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re
75a0: 66 20 73 65 72 76 65 72 20 31 29 29 0a 09 09 20 f server 1))...
75b0: 20 20 20 20 20 28 68 6f 73 74 6e 61 6d 65 20 20 (hostname
75c0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
75d0: 76 65 72 20 32 29 29 0a 09 09 20 20 20 20 20 20 ver 2))...
75e0: 28 69 6e 74 65 72 66 61 63 65 20 20 28 76 65 63 (interface (vec
75f0: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 33 tor-ref server 3
7600: 29 29 20 0a 09 09 20 20 20 20 20 20 28 70 75 6c )) ... (pul
7610: 6c 70 6f 72 74 20 20 20 28 76 65 63 74 6f 72 2d lport (vector-
7620: 72 65 66 20 73 65 72 76 65 72 20 34 29 29 0a 09 ref server 4))..
7630: 09 20 20 20 20 20 20 28 70 75 62 70 6f 72 74 20 . (pubport
7640: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
7650: 65 72 76 65 72 20 35 29 29 0a 09 09 20 20 20 20 erver 5))...
7660: 20 20 28 73 74 61 72 74 2d 74 69 6d 65 20 28 76 (start-time (v
7670: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
7680: 20 36 29 29 0a 09 09 20 20 20 20 20 20 28 70 72 6))... (pr
7690: 69 6f 72 69 74 79 20 20 20 28 76 65 63 74 6f 72 iority (vector
76a0: 2d 72 65 66 20 73 65 72 76 65 72 20 37 29 29 0a -ref server 7)).
76b0: 09 09 20 20 20 20 20 20 28 73 74 61 74 65 20 20 .. (state
76c0: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
76d0: 73 65 72 76 65 72 20 38 29 29 0a 09 09 20 20 20 server 8))...
76e0: 20 20 20 28 6d 74 2d 76 65 72 20 20 20 20 20 28 (mt-ver (
76f0: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
7700: 72 20 39 29 29 0a 09 09 20 20 20 20 20 20 28 6c r 9))... (l
7710: 61 73 74 2d 75 70 64 61 74 65 20 28 76 65 63 74 ast-update (vect
7720: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 30 or-ref server 10
7730: 29 29 20 0a 09 09 20 20 20 20 20 20 28 74 72 61 )) ... (tra
7740: 6e 73 70 6f 72 74 20 20 28 76 65 63 74 6f 72 2d nsport (vector-
7750: 72 65 66 20 73 65 72 76 65 72 20 31 31 29 29 0a ref server 11)).
7760: 09 09 20 20 20 20 20 20 28 6b 69 6c 6c 65 64 20 .. (killed
7770: 20 20 20 20 23 66 29 0a 09 09 20 20 20 20 20 20 #f)...
7780: 28 73 74 61 74 75 73 20 20 20 20 20 28 3c 20 6c (status (< l
7790: 61 73 74 2d 75 70 64 61 74 65 20 32 30 29 29 29 ast-update 20)))
77a0: 0a 09 09 20 3b 3b 20 20 20 28 7a 6d 71 2d 73 6f ... ;; (zmq-so
77b0: 63 6b 65 74 73 20 28 69 66 20 73 74 61 74 75 73 ckets (if status
77c0: 20 28 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d (server:client-
77d0: 63 6f 6e 6e 65 63 74 20 68 6f 73 74 6e 61 6d 65 connect hostname
77e0: 20 70 6f 72 74 29 20 23 66 29 29 29 0a 09 09 20 port) #f)))...
77f0: 3b 3b 20 6e 6f 20 6e 65 65 64 20 74 6f 20 6c 6f ;; no need to lo
7800: 67 69 6e 20 61 73 20 73 74 61 74 75 73 20 6f 66 gin as status of
7810: 20 23 74 20 69 6e 64 69 63 61 74 65 73 20 77 65 #t indicates we
7820: 20 61 72 65 20 63 6f 6e 6e 65 63 74 69 6e 67 20 are connecting
7830: 74 6f 20 63 6f 72 72 65 63 74 20 0a 09 09 20 3b to correct ... ;
7840: 3b 20 73 65 72 76 65 72 0a 09 09 20 28 69 66 20 ; server... (if
7850: 28 65 71 75 61 6c 3f 20 73 74 61 74 65 20 22 64 (equal? state "d
7860: 65 61 64 22 29 0a 09 09 20 20 20 20 20 28 69 66 ead")... (if
7870: 20 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 (> last-update
7880: 28 2a 20 32 35 20 36 30 20 36 30 29 29 20 3b 3b (* 25 60 60)) ;;
7890: 20 6b 65 65 70 20 72 65 63 6f 72 64 73 20 61 72 keep records ar
78a0: 6f 75 6e 64 20 66 6f 72 20 73 6c 69 67 68 6c 79 ound for slighly
78b0: 20 6f 76 65 72 20 61 20 64 61 79 2e 0a 09 09 09 over a day.....
78c0: 20 28 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 (tasks:server-d
78d0: 65 72 65 67 69 73 74 65 72 20 28 64 62 3a 64 65 eregister (db:de
78e0: 6c 61 79 2d 69 66 2d 62 75 73 79 20 74 64 62 64 lay-if-busy tdbd
78f0: 61 74 29 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c at) hostname pul
7900: 6c 70 6f 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 lport: pullport
7910: 70 69 64 3a 20 70 69 64 20 61 63 74 69 6f 6e 3a pid: pid action:
7920: 20 27 64 65 6c 65 74 65 29 29 0a 09 09 20 20 20 'delete))...
7930: 20 20 28 69 66 20 28 3e 20 6c 61 73 74 2d 75 70 (if (> last-up
7940: 64 61 74 65 20 32 30 29 20 20 20 20 20 20 20 20 date 20)
7950: 3b 3b 20 4d 61 72 6b 20 61 73 20 64 65 61 64 20 ;; Mark as dead
7960: 69 66 20 6e 6f 74 20 75 70 64 61 74 65 64 20 69 if not updated i
7970: 6e 20 6c 61 73 74 20 32 30 20 73 65 63 6f 6e 64 n last 20 second
7980: 73 0a 09 09 09 20 28 74 61 73 6b 73 3a 73 65 72 s.... (tasks:ser
7990: 76 65 72 2d 64 65 72 65 67 69 73 74 65 72 20 28 ver-deregister (
79a0: 64 62 3a 64 65 6c 61 79 2d 69 66 2d 62 75 73 79 db:delay-if-busy
79b0: 20 74 64 62 64 61 74 29 20 68 6f 73 74 6e 61 6d tdbdat) hostnam
79c0: 65 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 6c 6c e pullport: pull
79d0: 70 6f 72 74 20 70 69 64 3a 20 70 69 64 29 29 29 port pid: pid)))
79e0: 0a 09 09 20 28 66 6f 72 6d 61 74 20 23 74 20 66 ... (format #t f
79f0: 6d 74 73 74 72 20 69 64 20 6d 74 2d 76 65 72 20 mtstr id mt-ver
7a00: 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 28 63 6f pid hostname (co
7a10: 6e 63 20 69 6e 74 65 72 66 61 63 65 20 22 3a 22 nc interface ":"
7a20: 20 70 75 6c 6c 70 6f 72 74 29 20 70 75 62 70 6f pullport) pubpo
7a30: 72 74 20 6c 61 73 74 2d 75 70 64 61 74 65 0a 09 rt last-update..
7a40: 09 09 20 28 69 66 20 73 74 61 74 75 73 20 22 61 .. (if status "a
7a50: 6c 69 76 65 22 20 22 64 65 61 64 22 29 20 74 72 live" "dead") tr
7a60: 61 6e 73 70 6f 72 74 29 0a 09 09 20 28 69 66 20 ansport)... (if
7a70: 28 6f 72 20 28 65 71 75 61 6c 3f 20 69 64 20 73 (or (equal? id s
7a80: 69 64 29 0a 09 09 09 20 28 65 71 75 61 6c 3f 20 id).... (equal?
7a90: 73 69 64 20 30 29 29 20 3b 3b 20 6b 69 6c 6c 20 sid 0)) ;; kill
7aa0: 61 6c 6c 2f 61 6e 79 0a 09 09 20 20 20 20 20 28 all/any... (
7ab0: 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 20 28 begin... (
7ac0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
7ad0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
7ae0: 70 6f 72 74 2a 20 22 41 74 74 65 6d 70 74 69 6e port* "Attemptin
7af0: 67 20 74 6f 20 6b 69 6c 6c 20 22 6b 69 6c 6c 2d g to kill "kill-
7b00: 73 77 69 74 63 68 22 20 73 65 72 76 65 72 20 77 switch" server w
7b10: 69 74 68 20 70 69 64 20 22 20 70 69 64 29 0a 09 ith pid " pid)..
7b20: 09 20 20 20 20 20 20 20 28 74 61 73 6b 73 3a 6b . (tasks:k
7b30: 69 6c 6c 2d 73 65 72 76 65 72 20 68 6f 73 74 6e ill-server hostn
7b40: 61 6d 65 20 70 69 64 20 6b 69 6c 6c 2d 73 77 69 ame pid kill-swi
7b50: 74 63 68 3a 20 6b 69 6c 6c 2d 73 77 69 74 63 68 tch: kill-switch
7b60: 29 29 29 29 29 0a 09 20 20 20 20 20 73 65 72 76 ))))).. serv
7b70: 65 72 73 29 0a 09 20 20 20 20 28 64 65 62 75 67 ers).. (debug
7b80: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 :print-info 1 *d
7b90: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
7ba0: 20 22 44 6f 6e 65 20 77 69 74 68 20 6c 69 73 74 "Done with list
7bb0: 73 65 72 76 65 72 73 22 29 0a 09 20 20 20 20 28 servers").. (
7bc0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
7bd0: 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 28 65 78 ng* #t).. (ex
7be0: 69 74 29 29 20 3b 3b 20 6d 75 73 74 20 64 6f 2c it)) ;; must do,
7bf0: 20 77 6f 75 6c 64 20 68 61 76 65 20 74 6f 20 61 would have to a
7c00: 64 64 20 63 68 65 63 6b 73 20 74 6f 20 6d 61 6e dd checks to man
7c10: 79 2f 61 6c 6c 20 63 61 6c 6c 73 20 62 65 6c 6f y/all calls belo
7c20: 77 0a 09 20 20 28 65 78 69 74 29 29 29 29 0a 0a w.. (exit))))..
7c30: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
7c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7c70: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 57 65 69 72 ========.;; Weir
7c80: 64 20 73 70 65 63 69 61 6c 20 63 61 6c 6c 73 20 d special calls
7c90: 74 68 61 74 20 6e 65 65 64 20 74 6f 20 72 75 6e that need to run
7ca0: 20 2a 61 66 74 65 72 2a 20 74 68 65 20 73 65 72 *after* the ser
7cb0: 76 65 72 20 68 61 73 20 73 74 61 72 74 65 64 3f ver has started?
7cc0: 0a 3b 3b 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 3d ================
7cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
7d10: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
7d20: 69 73 74 2d 74 61 72 67 65 74 73 22 29 0a 20 20 ist-targets").
7d30: 20 20 28 69 66 20 28 6c 61 75 6e 63 68 3a 73 65 (if (launch:se
7d40: 74 75 70 29 0a 20 20 20 20 20 20 20 20 28 6c 65 tup). (le
7d50: 74 20 28 28 74 61 72 67 65 74 73 20 28 63 6f 6d t ((targets (com
7d60: 6d 6f 6e 3a 67 65 74 2d 72 75 6e 63 6f 6e 66 69 mon:get-runconfi
7d70: 67 2d 74 61 72 67 65 74 73 29 29 29 0a 20 20 20 g-targets))).
7d80: 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
7d90: 69 6e 74 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c int 1 *default-l
7da0: 6f 67 2d 70 6f 72 74 2a 20 22 46 6f 75 6e 64 20 og-port* "Found
7db0: 22 28 6c 65 6e 67 74 68 20 74 61 72 67 65 74 73 "(length targets
7dc0: 29 20 22 20 74 61 72 67 65 74 73 22 29 0a 20 20 ) " targets").
7dd0: 20 20 20 20 20 20 20 20 28 63 61 73 65 20 28 73 (case (s
7de0: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f tring->symbol (o
7df0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
7e00: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 61 6c "-dumpmode") "al
7e10: 69 73 74 22 29 29 0a 20 20 20 20 20 20 20 20 20 ist")).
7e20: 20 20 20 28 28 61 6c 69 73 74 29 0a 20 20 20 20 ((alist).
7e30: 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 (for-ea
7e40: 63 68 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 ch (lambda (x).
7e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e60: 20 20 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e ;; (prin
7e70: 74 20 22 5b 22 20 78 20 22 5d 22 29 29 0a 20 20 t "[" x "]")).
7e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e90: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 78 29 (print x)
7ea0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
7eb0: 20 20 20 20 20 20 20 20 20 74 61 72 67 65 74 73 targets
7ec0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
7ed0: 28 6a 73 6f 6e 29 0a 20 20 20 20 20 20 20 20 20 (json).
7ee0: 20 20 20 20 28 6a 73 6f 6e 2d 77 72 69 74 65 20 (json-write
7ef0: 74 61 72 67 65 74 73 29 29 0a 20 20 20 20 20 20 targets)).
7f00: 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
7f10: 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
7f20: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
7f30: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
7f40: 20 22 64 75 6d 70 20 6f 75 74 70 75 74 20 66 6f "dump output fo
7f50: 72 6d 61 74 20 22 20 28 61 72 67 73 3a 67 65 74 rmat " (args:get
7f60: 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 -arg "-dumpmode"
7f70: 29 20 22 20 6e 6f 74 20 73 75 70 70 6f 72 74 65 ) " not supporte
7f80: 64 20 66 6f 72 20 2d 6c 69 73 74 2d 74 61 72 67 d for -list-targ
7f90: 65 74 73 22 29 29 29 0a 20 20 20 20 20 20 20 20 ets"))).
7fa0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
7fb0: 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b thing* #t))))..;
7fc0: 3b 20 63 61 63 68 65 20 74 68 65 20 72 75 6e 63 ; cache the runc
7fd0: 6f 6e 66 69 67 73 20 69 6e 20 24 4d 54 5f 4c 49 onfigs in $MT_LI
7fe0: 4e 4b 54 52 45 45 2f 24 4d 54 5f 54 41 52 47 45 NKTREE/$MT_TARGE
7ff0: 54 2f 24 4d 54 5f 52 55 4e 4e 41 4d 45 2f 2e 72 T/$MT_RUNNAME/.r
8000: 75 6e 63 6f 6e 66 69 67 0a 3b 3b 0a 28 64 65 66 unconfig.;;.(def
8010: 69 6e 65 20 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e ine (full-runcon
8020: 66 69 67 73 2d 72 65 61 64 29 0a 3b 3b 20 69 6e figs-read).;; in
8030: 20 74 68 65 20 65 6e 76 70 72 6f 63 65 73 73 69 the envprocessi
8040: 6e 67 20 62 72 61 6e 63 68 20 74 68 65 20 62 65 ng branch the be
8050: 6c 6f 77 20 63 6f 64 65 20 72 65 70 6c 61 63 65 low code replace
8060: 73 20 74 68 65 20 66 75 72 74 68 65 72 20 62 65 s the further be
8070: 6c 6f 77 20 63 6f 64 65 0a 3b 3b 20 20 28 69 66 low code.;; (if
8080: 20 28 65 71 3f 20 2a 63 6f 6e 66 69 67 73 74 61 (eq? *configsta
8090: 74 75 73 2a 20 27 66 75 6c 6c 64 61 74 61 29 0a tus* 'fulldata).
80a0: 3b 3b 20 20 20 20 20 20 2a 72 75 6e 63 6f 6e 66 ;; *runconf
80b0: 69 67 64 61 74 2a 0a 3b 3b 20 20 20 20 20 20 28 igdat*.;; (
80c0: 62 65 67 69 6e 0a 3b 3b 09 28 6c 61 75 6e 63 68 begin.;;.(launch
80d0: 3a 73 65 74 75 70 29 0a 3b 3b 09 2a 72 75 6e 63 :setup).;;.*runc
80e0: 6f 6e 66 69 67 64 61 74 2a 29 29 29 0a 0a 20 20 onfigdat*)))..
80f0: 28 6c 65 74 2a 20 28 28 72 75 6e 64 69 72 20 28 (let* ((rundir (
8100: 69 66 20 28 61 6e 64 20 28 67 65 74 65 6e 76 20 if (and (getenv
8110: 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 29 28 67 "MT_LINKTREE")(g
8120: 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 etenv "MT_TARGET
8130: 22 29 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 ")(getenv "MT_RU
8140: 4e 4e 41 4d 45 22 29 29 0a 09 09 20 20 20 20 20 NNAME"))...
8150: 28 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 22 4d (conc (getenv "M
8160: 54 5f 4c 49 4e 4b 54 52 45 45 22 29 20 22 2f 22 T_LINKTREE") "/"
8170: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 (getenv "MT_TAR
8180: 47 45 54 22 29 20 22 2f 22 20 28 67 65 74 65 6e GET") "/" (geten
8190: 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 29 29 v "MT_RUNNAME"))
81a0: 0a 09 09 20 20 20 20 20 23 66 29 29 0a 09 20 28 ... #f)).. (
81b0: 63 66 67 66 20 20 20 28 69 66 20 72 75 6e 64 69 cfgf (if rundi
81c0: 72 20 28 63 6f 6e 63 20 72 75 6e 64 69 72 20 22 r (conc rundir "
81d0: 2f 2e 72 75 6e 63 6f 6e 66 69 67 2e 22 20 6d 65 /.runconfig." me
81e0: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 gatest-version "
81f0: 2d 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 -" megatest-foss
8200: 69 6c 2d 68 61 73 68 29 20 23 66 29 29 29 0a 20 il-hash) #f))).
8210: 20 20 20 28 69 66 20 28 61 6e 64 20 63 66 67 66 (if (and cfgf
8220: 0a 09 20 20 20 20 20 28 66 69 6c 65 2d 65 78 69 .. (file-exi
8230: 73 74 73 3f 20 63 66 67 66 29 0a 09 20 20 20 20 sts? cfgf)..
8240: 20 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 (file-write-acc
8250: 65 73 73 3f 20 63 66 67 66 29 29 0a 09 28 63 6f ess? cfgf))..(co
8260: 6e 66 69 67 66 3a 72 65 61 64 2d 61 6c 69 73 74 nfigf:read-alist
8270: 20 63 66 67 66 29 0a 09 28 6c 65 74 2a 20 28 28 cfgf)..(let* ((
8280: 6b 65 79 73 20 20 20 28 72 6d 74 3a 67 65 74 2d keys (rmt:get-
8290: 6b 65 79 73 29 29 0a 09 20 20 20 20 20 20 20 28 keys)).. (
82a0: 74 61 72 67 65 74 20 28 63 6f 6d 6d 6f 6e 3a 61 target (common:a
82b0: 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 29 rgs-get-target))
82c0: 0a 09 20 20 20 20 20 20 20 28 6b 65 79 2d 76 61 .. (key-va
82d0: 6c 73 20 28 69 66 20 74 61 72 67 65 74 20 28 6b ls (if target (k
82e0: 65 79 73 3a 74 61 72 67 65 74 2d 3e 6b 65 79 76 eys:target->keyv
82f0: 61 6c 20 6b 65 79 73 20 74 61 72 67 65 74 29 20 al keys target)
8300: 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 73 65 #f)).. (se
8310: 63 74 69 6f 6e 73 20 28 69 66 20 74 61 72 67 65 ctions (if targe
8320: 74 20 28 6c 69 73 74 20 22 64 65 66 61 75 6c 74 t (list "default
8330: 22 20 74 61 72 67 65 74 29 20 23 66 29 29 0a 09 " target) #f))..
8340: 20 20 20 20 20 20 20 28 64 61 74 61 20 20 20 20 (data
8350: 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 28 73 (begin.... (s
8360: 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 etenv "MT_RUN_AR
8370: 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 EA_HOME" *toppat
8380: 68 2a 29 0a 09 09 09 20 20 20 28 69 66 20 6b 65 h*).... (if ke
8390: 79 2d 76 61 6c 73 0a 09 09 09 20 20 20 20 20 20 y-vals....
83a0: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
83b0: 64 61 20 28 6b 74 29 0a 09 09 09 09 09 20 20 20 da (kt)......
83c0: 28 73 65 74 65 6e 76 20 28 63 61 72 20 6b 74 29 (setenv (car kt)
83d0: 20 28 63 61 64 72 20 6b 74 29 29 29 0a 09 09 09 (cadr kt)))....
83e0: 09 09 20 6b 65 79 2d 76 61 6c 73 29 29 0a 09 09 .. key-vals))...
83f0: 09 20 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 . (read-config
8400: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
8410: 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f "/runconfigs.co
8420: 6e 66 69 67 22 29 20 23 66 20 23 74 20 73 65 63 nfig") #f #t sec
8430: 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f 6e 73 29 tions: sections)
8440: 29 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 ))).. (if (and
8450: 72 75 6e 64 69 72 20 3b 3b 20 68 61 76 65 20 61 rundir ;; have a
8460: 6c 6c 20 6e 65 65 64 65 64 20 76 61 72 69 61 62 ll needed variab
8470: 6c 65 73 73 0a 09 09 20 20 20 28 64 69 72 65 63 less... (direc
8480: 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 72 75 6e tory-exists? run
8490: 64 69 72 29 0a 09 09 20 20 20 28 66 69 6c 65 2d dir)... (file-
84a0: 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 72 75 write-access? ru
84b0: 6e 64 69 72 29 29 0a 09 20 20 20 20 20 20 28 62 ndir)).. (b
84c0: 65 67 69 6e 0a 09 09 28 63 6f 6e 66 69 67 66 3a egin...(configf:
84d0: 77 72 69 74 65 2d 61 6c 69 73 74 20 64 61 74 61 write-alist data
84e0: 20 63 66 67 66 29 0a 09 09 3b 3b 20 66 6f 72 63 cfgf)...;; forc
84f0: 65 20 72 65 2d 72 65 61 64 20 6f 66 20 6d 65 67 e re-read of meg
8500: 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 2d 20 74 atest.config - t
8510: 68 69 73 20 72 65 73 6f 6c 76 65 73 20 63 69 72 his resolves cir
8520: 63 75 6c 61 72 20 72 65 66 65 72 65 6e 63 65 73 cular references
8530: 20 62 65 74 77 65 65 6e 20 6d 65 67 61 74 65 73 between megates
8540: 74 2e 63 6f 6e 66 69 67 0a 09 09 28 6c 61 75 6e t.config...(laun
8550: 63 68 3a 73 65 74 75 70 20 66 6f 72 63 65 3a 20 ch:setup force:
8560: 23 74 29 0a 09 09 28 6c 61 75 6e 63 68 3a 63 61 #t)...(launch:ca
8570: 63 68 65 2d 63 6f 6e 66 69 67 29 29 29 20 3b 3b che-config))) ;;
8580: 20 77 65 20 63 61 6e 20 73 61 66 65 6c 79 20 63 we can safely c
8590: 61 63 68 65 20 6d 65 67 61 74 65 73 74 2e 63 6f ache megatest.co
85a0: 6e 66 69 67 20 73 69 6e 63 65 20 77 65 20 68 61 nfig since we ha
85b0: 76 65 20 61 20 76 61 6c 69 64 20 72 75 6e 63 6f ve a valid runco
85c0: 6e 66 69 67 0a 09 20 20 64 61 74 61 29 29 29 29 nfig.. data))))
85d0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
85e0: 61 72 67 20 22 2d 73 68 6f 77 2d 72 75 6e 63 6f arg "-show-runco
85f0: 6e 66 69 67 22 29 0a 20 20 20 20 28 6c 65 74 20 nfig"). (let
8600: 28 28 74 6c 20 28 6c 61 75 6e 63 68 3a 73 65 74 ((tl (launch:set
8610: 75 70 29 29 29 0a 20 20 20 20 20 20 28 70 75 73 up))). (pus
8620: 68 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 h-directory *top
8630: 70 61 74 68 2a 29 0a 20 20 20 20 20 20 28 6c 65 path*). (le
8640: 74 20 28 28 64 61 74 61 20 28 66 75 6c 6c 2d 72 t ((data (full-r
8650: 75 6e 63 6f 6e 66 69 67 73 2d 72 65 61 64 29 29 unconfigs-read))
8660: 29 0a 09 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 )..;; keep this
8670: 6f 6e 65 20 6c 6f 63 61 6c 0a 09 28 63 6f 6e 64 one local..(cond
8680: 0a 09 20 28 28 61 6e 64 20 28 61 72 67 73 3a 67 .. ((and (args:g
8690: 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e et-arg "-section
86a0: 22 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 ").. (args
86b0: 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 :get-arg "-var")
86c0: 29 0a 09 20 20 28 6c 65 74 20 28 28 76 61 6c 20 ).. (let ((val
86d0: 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (or (configf:loo
86e0: 6b 75 70 20 64 61 74 61 20 28 61 72 67 73 3a 67 kup data (args:g
86f0: 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e et-arg "-section
8700: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
8710: 22 2d 76 61 72 22 29 29 0a 09 09 09 20 28 63 6f "-var")).... (co
8720: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 nfigf:lookup dat
8730: 61 20 22 64 65 66 61 75 6c 74 22 20 28 61 72 67 a "default" (arg
8740: 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 s:get-arg "-var"
8750: 29 29 29 29 29 0a 09 20 20 20 20 28 69 66 20 76 ))))).. (if v
8760: 61 6c 20 28 70 72 69 6e 74 20 76 61 6c 29 29 29 al (print val)))
8770: 29 0a 09 20 28 28 6e 6f 74 20 28 61 72 67 73 3a ).. ((not (args:
8780: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
8790: 64 65 22 29 29 0a 09 20 20 28 70 70 20 28 68 61 de")).. (pp (ha
87a0: 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 sh-table->alist
87b0: 64 61 74 61 29 29 29 0a 09 20 28 28 73 74 72 69 data))).. ((stri
87c0: 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 ng=? (args:get-a
87d0: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 rg "-dumpmode")
87e0: 22 6a 73 6f 6e 22 29 0a 09 20 20 28 6a 73 6f 6e "json").. (json
87f0: 2d 77 72 69 74 65 20 64 61 74 61 29 29 0a 09 20 -write data))..
8800: 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 ((string=? (args
8810: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
8820: 6f 64 65 22 29 20 22 69 6e 69 22 29 0a 09 20 20 ode") "ini")..
8830: 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 69 67 2d (configf:config-
8840: 3e 69 6e 69 20 64 61 74 61 29 29 0a 09 20 28 65 >ini data)).. (e
8850: 6c 73 65 0a 09 20 20 28 64 65 62 75 67 3a 70 72 lse.. (debug:pr
8860: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
8870: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
8880: 2d 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 -dumpmode of " (
8890: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
88a0: 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 umpmode") " not
88b0: 72 65 63 6f 67 6e 69 73 65 64 22 29 29 29 0a 09 recognised")))..
88c0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
88d0: 69 6e 67 2a 20 23 74 29 29 0a 20 20 20 20 20 20 ing* #t)).
88e0: 28 70 6f 70 2d 64 69 72 65 63 74 6f 72 79 29 29 (pop-directory))
88f0: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
8900: 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 6f 6e 66 -arg "-show-conf
8910: 69 67 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 ig"). (let ((
8920: 74 6c 20 20 20 28 6c 61 75 6e 63 68 3a 73 65 74 tl (launch:set
8930: 75 70 29 29 0a 09 20 20 28 64 61 74 61 20 2a 63 up)).. (data *c
8940: 6f 6e 66 69 67 64 61 74 2a 29 29 20 3b 3b 20 28 onfigdat*)) ;; (
8950: 72 65 61 64 2d 63 6f 6e 66 69 67 20 22 6d 65 67 read-config "meg
8960: 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 20 23 66 atest.config" #f
8970: 20 23 74 29 29 29 0a 20 20 20 20 20 20 28 70 75 #t))). (pu
8980: 73 68 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f sh-directory *to
8990: 70 70 61 74 68 2a 29 0a 20 20 20 20 20 20 3b 3b ppath*). ;;
89a0: 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c keep this one l
89b0: 6f 63 61 6c 0a 20 20 20 20 20 20 28 63 6f 6e 64 ocal. (cond
89c0: 20 0a 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 . ((and (
89d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
89e0: 65 63 74 69 6f 6e 22 29 0a 09 20 20 20 20 20 28 ection").. (
89f0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 args:get-arg "-v
8a00: 61 72 22 29 29 0a 09 28 6c 65 74 20 28 28 76 61 ar"))..(let ((va
8a10: 6c 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 l (configf:looku
8a20: 70 20 64 61 74 61 20 28 61 72 67 73 3a 67 65 74 p data (args:get
8a30: 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 -arg "-section")
8a40: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8a50: 76 61 72 22 29 29 29 29 0a 09 20 20 28 69 66 20 var")))).. (if
8a60: 76 61 6c 20 28 70 72 69 6e 74 20 76 61 6c 29 29 val (print val))
8a70: 29 29 0a 0a 20 20 20 20 20 20 20 3b 3b 20 70 72 )).. ;; pr
8a80: 69 6e 74 20 6a 75 73 74 20 61 20 73 65 63 74 69 int just a secti
8a90: 6f 6e 20 69 66 20 6f 6e 6c 79 20 2d 73 65 63 74 on if only -sect
8aa0: 69 6f 6e 0a 0a 20 20 20 20 20 20 20 28 28 6e 6f ion.. ((no
8ab0: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
8ac0: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 29 0a 09 28 "-dumpmode"))..(
8ad0: 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e pp (hash-table->
8ae0: 61 6c 69 73 74 20 64 61 74 61 29 29 29 0a 20 20 alist data))).
8af0: 20 20 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 ((string=?
8b00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8b10: 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e dumpmode") "json
8b20: 22 29 0a 09 28 6a 73 6f 6e 2d 77 72 69 74 65 20 ")..(json-write
8b30: 64 61 74 61 29 29 0a 20 20 20 20 20 20 20 28 28 data)). ((
8b40: 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 string=? (args:g
8b50: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
8b60: 65 22 29 20 22 69 6e 69 22 29 0a 09 28 63 6f 6e e") "ini")..(con
8b70: 66 69 67 66 3a 63 6f 6e 66 69 67 2d 3e 69 6e 69 figf:config->ini
8b80: 20 64 61 74 61 29 29 0a 20 20 20 20 20 20 20 28 data)). (
8b90: 65 6c 73 65 0a 09 28 64 65 62 75 67 3a 70 72 69 else..(debug:pri
8ba0: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
8bb0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d ult-log-port* "-
8bc0: 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 61 dumpmode of " (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 20 22 20 6e 6f 74 20 72 mpmode") " not r
8bf0: 65 63 6f 67 6e 69 73 65 64 22 29 29 29 0a 20 20 ecognised"))).
8c00: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
8c10: 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 20 20 20 mething* #t).
8c20: 20 20 20 28 70 6f 70 2d 64 69 72 65 63 74 6f 72 (pop-director
8c30: 79 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a y)))..(if (args:
8c40: 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 get-arg "-show-c
8c50: 6d 64 69 6e 66 6f 22 29 0a 20 20 20 20 28 69 66 mdinfo"). (if
8c60: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
8c70: 72 67 20 22 3a 76 61 6c 75 65 22 29 28 67 65 74 rg ":value")(get
8c80: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
8c90: 29 29 0a 09 28 6c 65 74 20 28 28 64 61 74 61 20 ))..(let ((data
8ca0: 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 (common:read-enc
8cb0: 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 6f 72 20 oded-string (or
8cc0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
8cd0: 76 61 6c 75 65 22 29 28 67 65 74 65 6e 76 20 22 value")(getenv "
8ce0: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 MT_CMDINFO")))))
8cf0: 0a 09 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 .. (if (equal?
8d00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8d10: 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e dumpmode") "json
8d20: 22 29 0a 09 20 20 20 20 20 20 28 6a 73 6f 6e 2d ").. (json-
8d30: 77 72 69 74 65 20 64 61 74 61 29 0a 09 20 20 20 write data)..
8d40: 20 20 20 28 70 70 20 64 61 74 61 29 29 0a 09 20 (pp data))..
8d50: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
8d60: 68 69 6e 67 2a 20 23 74 29 29 0a 09 28 64 65 62 hing* #t))..(deb
8d70: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
8d80: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
8d90: 74 2a 20 22 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 t* "environment
8da0: 76 61 72 69 61 62 6c 65 20 4d 54 5f 43 4d 44 49 variable MT_CMDI
8db0: 4e 46 4f 20 69 73 20 6e 6f 74 20 73 65 74 22 29 NFO is not set")
8dc0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
8dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
8e10: 52 65 6d 6f 76 65 20 6f 6c 64 20 72 75 6e 28 73 Remove old run(s
8e20: 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ).;;============
8e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 ==========..;; s
8e70: 69 6e 63 65 20 73 65 76 65 72 61 6c 20 61 63 74 ince several act
8e80: 69 6f 6e 73 20 63 61 6e 20 62 65 20 73 70 65 63 ions can be spec
8e90: 69 66 69 65 64 20 6f 6e 20 74 68 65 20 63 6f 6d ified on the com
8ea0: 6d 61 6e 64 20 6c 69 6e 65 20 74 68 65 20 72 65 mand line the re
8eb0: 6d 6f 76 61 6c 0a 3b 3b 20 69 73 20 64 6f 6e 65 moval.;; is done
8ec0: 20 66 69 72 73 74 0a 28 64 65 66 69 6e 65 20 28 first.(define (
8ed0: 6f 70 65 72 61 74 65 2d 6f 6e 20 61 63 74 69 6f operate-on actio
8ee0: 6e 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e n). (let* ((run
8ef0: 72 65 63 20 28 72 75 6e 73 3a 72 75 6e 72 65 63 rec (runs:runrec
8f00: 2d 6d 61 6b 65 2d 72 65 63 6f 72 64 29 29 0a 09 -make-record))..
8f10: 20 28 74 61 72 67 65 74 20 28 63 6f 6d 6d 6f 6e (target (common
8f20: 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 :args-get-target
8f30: 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 ))). (cond.
8f40: 20 20 20 28 28 6e 6f 74 20 74 61 72 67 65 74 29 ((not target)
8f50: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
8f60: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
8f70: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
8f80: 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 Missing required
8f90: 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 parameter for "
8fa0: 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d action ", you m
8fb0: 75 73 74 20 73 70 65 63 69 66 79 20 2d 74 61 72 ust specify -tar
8fc0: 67 65 74 20 6f 72 20 2d 72 65 71 74 61 72 67 22 get or -reqtarg"
8fd0: 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 31 29 ). (exit 1)
8fe0: 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 6f 72 ). ((not (or
8ff0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9000: 3a 72 75 6e 6e 61 6d 65 22 29 0a 09 20 20 20 20 :runname")..
9010: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
9020: 20 22 2d 72 75 6e 6e 61 6d 65 22 29 29 29 0a 20 "-runname"))).
9030: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
9040: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
9050: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 lt-log-port* "Mi
9060: 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 ssing required p
9070: 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 61 arameter for " a
9080: 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 ction ", you mus
9090: 74 20 73 70 65 63 69 66 79 20 74 68 65 20 72 75 t specify the ru
90a0: 6e 20 6e 61 6d 65 20 70 61 74 74 65 72 6e 20 77 n name pattern w
90b0: 69 74 68 20 2d 72 75 6e 6e 61 6d 65 20 70 61 74 ith -runname pat
90c0: 74 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 t"). (exit
90d0: 32 29 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 2)). ((not (
90e0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
90f0: 65 73 74 70 61 74 74 22 29 29 0a 20 20 20 20 20 estpatt")).
9100: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
9110: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
9120: 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 69 6e og-port* "Missin
9130: 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d g required param
9140: 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f eter for " actio
9150: 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 n ", you must sp
9160: 65 63 69 66 79 20 74 68 65 20 74 65 73 74 20 70 ecify the test p
9170: 61 74 74 65 72 6e 20 77 69 74 68 20 2d 74 65 73 attern with -tes
9180: 74 70 61 74 74 22 29 0a 20 20 20 20 20 20 28 65 tpatt"). (e
9190: 78 69 74 20 33 29 29 0a 20 20 20 20 20 28 65 6c xit 3)). (el
91a0: 73 65 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f se. (if (no
91b0: 74 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e t (car *configin
91c0: 66 6f 2a 29 29 0a 09 20 20 28 62 65 67 69 6e 0a fo*)).. (begin.
91d0: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
91e0: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
91f0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 41 74 lt-log-port* "At
9200: 74 65 6d 70 74 65 64 20 22 20 61 63 74 69 6f 6e tempted " action
9210: 20 22 6f 6e 20 74 65 73 74 28 73 29 20 62 75 74 "on test(s) but
9220: 20 72 75 6e 20 61 72 65 61 20 63 6f 6e 66 69 67 run area config
9230: 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 22 file not found"
9240: 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 ).. (exit 1))
9250: 0a 09 20 20 3b 3b 20 70 75 74 20 74 65 73 74 20 .. ;; put test
9260: 70 61 72 61 6d 65 74 65 72 73 20 69 6e 74 6f 20 parameters into
9270: 63 6f 6e 76 65 6e 69 65 6e 74 20 76 61 72 69 61 convenient varia
9280: 62 6c 65 73 0a 09 20 20 28 62 65 67 69 6e 0a 09 bles.. (begin..
9290: 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 66 6f 72 ;; check for
92a0: 20 63 6f 72 72 65 63 74 20 76 65 72 73 69 6f 6e correct version
92b0: 2c 20 65 78 69 74 20 77 69 74 68 20 6d 65 73 73 , exit with mess
92c0: 61 67 65 20 69 66 20 6e 6f 74 20 63 6f 72 72 65 age if not corre
92d0: 63 74 0a 09 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a ct.. (common:
92e0: 65 78 69 74 2d 6f 6e 2d 76 65 72 73 69 6f 6e 2d exit-on-version-
92f0: 63 68 61 6e 67 65 64 29 0a 09 20 20 20 20 28 72 changed).. (r
9300: 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 20 uns:operate-on
9310: 61 63 74 69 6f 6e 0a 09 09 09 20 20 20 20 20 20 action....
9320: 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 20 20 target....
9330: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
9340: 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f -runname) ;; (o
9350: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
9360: 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 "-runname")(args
9370: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
9380: 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 20 28 me")).... (
9390: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
93a0: 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 testpatt #f) ;;
93b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
93c0: 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 testpatt")....
93d0: 20 20 20 20 73 74 61 74 65 3a 20 28 63 6f 6d 6d state: (comm
93e0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 73 74 61 74 on:args-get-stat
93f0: 65 29 0a 09 09 09 20 20 20 20 20 20 73 74 61 74 e).... stat
9400: 75 73 3a 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 us: (common:args
9410: 2d 67 65 74 2d 73 74 61 74 75 73 29 0a 09 09 09 -get-status)....
9420: 20 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d new-state-
9430: 73 74 61 74 75 73 3a 20 28 61 72 67 73 3a 67 65 status: (args:ge
9440: 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 74 61 74 t-arg "-set-stat
9450: 65 2d 73 74 61 74 75 73 22 29 29 29 29 0a 20 20 e-status")))).
9460: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
9470: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 29 mething* #t)))))
9480: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
9490: 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e arg "-remove-run
94a0: 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c s"). (general
94b0: 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 -run-call .
94c0: 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 0a 20 "-remove-runs".
94d0: 20 20 20 20 22 72 65 6d 6f 76 65 20 72 75 6e 73 "remove runs
94e0: 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ". (lambda (
94f0: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
9500: 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 eys keyvals).
9510: 20 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 (operate-on
9520: 27 72 65 6d 6f 76 65 2d 72 75 6e 73 29 29 29 29 'remove-runs))))
9530: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
9540: 61 72 67 20 22 2d 73 65 74 2d 73 74 61 74 65 2d arg "-set-state-
9550: 73 74 61 74 75 73 22 29 0a 20 20 20 20 28 67 65 status"). (ge
9560: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
9570: 20 20 20 20 20 22 2d 73 65 74 2d 73 74 61 74 65 "-set-state
9580: 2d 73 74 61 74 75 73 22 0a 20 20 20 20 20 22 73 -status". "s
9590: 65 74 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 et state and sta
95a0: 74 75 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 tus". (lambd
95b0: 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
95c0: 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a e keys keyvals).
95d0: 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d (operate-
95e0: 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 on 'set-state-st
95f0: 61 74 75 73 29 29 29 29 0a 0a 28 69 66 20 28 6f atus))))..(if (o
9600: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
9610: 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 "-set-run-status
9620: 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
9630: 67 20 22 2d 67 65 74 2d 72 75 6e 2d 73 74 61 74 g "-get-run-stat
9640: 75 73 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 us")). (gener
9650: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 al-run-call.
9660: 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 "-set-run-statu
9670: 73 22 0a 20 20 20 20 20 22 73 65 74 20 72 75 6e s". "set run
9680: 20 73 74 61 74 75 73 22 0a 20 20 20 20 20 28 6c status". (l
9690: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
96a0: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 nname keys keyva
96b0: 6c 73 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a ls). (let*
96c0: 20 28 28 72 75 6e 73 64 61 74 20 20 28 72 6d 74 ((runsdat (rmt
96d0: 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 :get-runs-by-pat
96e0: 74 20 6b 65 79 73 20 72 75 6e 6e 61 6d 65 20 0a t keys runname .
96f0: 09 09 09 09 09 28 63 6f 6d 6d 6f 6e 3a 61 72 67 .....(common:arg
9700: 73 2d 67 65 74 2d 74 61 72 67 65 74 29 0a 09 09 s-get-target)...
9710: 09 09 09 23 66 20 23 66 20 23 66 20 23 66 29 29 ...#f #f #f #f))
9720: 0a 09 20 20 20 20 20 20 28 68 65 61 64 65 72 20 .. (header
9730: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 (vector-ref ru
9740: 6e 73 64 61 74 20 30 29 29 0a 09 20 20 20 20 20 nsdat 0))..
9750: 20 28 72 6f 77 73 20 20 20 20 20 28 76 65 63 74 (rows (vect
9760: 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 31 or-ref runsdat 1
9770: 29 29 29 0a 09 20 28 69 66 20 28 6e 75 6c 6c 3f ))).. (if (null?
9780: 20 72 6f 77 73 29 0a 09 20 20 20 20 20 28 62 65 rows).. (be
9790: 67 69 6e 0a 09 20 20 20 20 20 20 20 28 64 65 62 gin.. (deb
97a0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
97b0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
97c0: 74 2a 20 22 4e 6f 20 6d 61 74 63 68 69 6e 67 20 t* "No matching
97d0: 72 75 6e 20 66 6f 75 6e 64 2e 22 29 0a 09 20 20 run found.")..
97e0: 20 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 09 (exit 1))..
97f0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 6f 77 (let* ((row
9800: 20 20 20 20 20 20 28 63 61 72 20 28 76 65 63 74 (car (vect
9810: 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 31 or-ref runsdat 1
9820: 29 29 29 0a 09 09 20 20 20 20 28 72 75 6e 2d 69 )))... (run-i
9830: 64 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 d (db:get-valu
9840: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 6f 77 20 e-by-header row
9850: 68 65 61 64 65 72 20 22 69 64 22 29 29 29 0a 09 header "id")))..
9860: 20 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 (if (args
9870: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 72 :get-arg "-set-r
9880: 75 6e 2d 73 74 61 74 75 73 22 29 0a 09 09 20 20 un-status")...
9890: 20 28 72 6d 74 3a 73 65 74 2d 72 75 6e 2d 73 74 (rmt:set-run-st
98a0: 61 74 75 73 20 72 75 6e 2d 69 64 20 28 61 72 67 atus run-id (arg
98b0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
98c0: 72 75 6e 2d 73 74 61 74 75 73 22 29 20 6d 73 67 run-status") msg
98d0: 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 : (args:get-arg
98e0: 22 2d 6d 22 29 29 0a 09 09 20 20 20 28 70 72 69 "-m"))... (pri
98f0: 6e 74 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d nt (rmt:get-run-
9900: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 29 29 0a status run-id)).
9910: 09 09 20 20 20 29 29 29 29 29 29 29 0a 0a 3b 3b .. )))))))..;;
9920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9960: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 75 65 72 79 20 ======.;; Query
9970: 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d runs.;;=========
9980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
99c0: 3b 20 2d 66 69 65 6c 64 73 20 72 75 6e 73 3a 69 ; -fields runs:i
99d0: 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 d,target,runname
99e0: 2c 63 6f 6d 6d 65 6e 74 2b 74 65 73 74 73 3a 69 ,comment+tests:i
99f0: 64 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f d,testname,item_
9a00: 70 61 74 68 2b 73 74 65 70 73 0a 3b 3b 0a 3b 3b path+steps.;;.;;
9a10: 20 63 73 69 3e 20 28 65 78 74 72 61 63 74 2d 66 csi> (extract-f
9a20: 69 65 6c 64 73 2d 63 6f 6e 73 74 72 61 69 6e 74 ields-constraint
9a30: 73 20 22 72 75 6e 73 3a 69 64 2c 74 61 72 67 65 s "runs:id,targe
9a40: 74 2c 72 75 6e 6e 61 6d 65 2c 63 6f 6d 6d 65 6e t,runname,commen
9a50: 74 2b 74 65 73 74 73 3a 69 64 2c 74 65 73 74 6e t+tests:id,testn
9a60: 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2b 73 74 ame,item_path+st
9a70: 65 70 73 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 eps").;;
9a80: 20 3d 3e 20 28 28 22 72 75 6e 73 22 20 22 69 64 => (("runs" "id
9a90: 22 20 22 74 61 72 67 65 74 22 20 22 72 75 6e 6e " "target" "runn
9aa0: 61 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 20 ame" "comment")
9ab0: 28 22 74 65 73 74 73 22 20 22 69 64 22 20 22 74 ("tests" "id" "t
9ac0: 65 73 74 6e 61 6d 65 22 20 22 69 74 65 6d 5f 70 estname" "item_p
9ad0: 61 74 68 22 29 20 28 22 73 74 65 70 73 22 29 29 ath") ("steps"))
9ae0: 0a 3b 3b 0a 3b 3b 20 20 20 4e 4f 54 45 3a 20 72 .;;.;; NOTE: r
9af0: 65 6d 65 6d 62 65 72 20 74 68 61 74 20 74 68 65 emember that the
9b00: 20 63 64 72 20 77 69 6c 6c 20 62 65 20 74 68 65 cdr will be the
9b10: 20 6c 69 73 74 20 79 6f 75 20 65 78 70 65 63 74 list you expect
9b20: 20 28 63 64 72 20 28 22 72 75 6e 73 22 20 22 69 (cdr ("runs" "i
9b30: 64 22 20 22 74 61 72 67 65 74 22 20 22 72 75 6e d" "target" "run
9b40: 6e 61 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 name" "comment")
9b50: 29 20 3d 3e 20 28 22 69 64 22 20 22 74 61 72 67 ) => ("id" "targ
9b60: 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 63 et" "runname" "c
9b70: 6f 6d 6d 65 6e 74 22 29 0a 3b 3b 20 20 20 20 20 omment").;;
9b80: 20 20 20 20 61 6e 64 20 73 6f 20 61 6c 69 73 74 and so alist
9b90: 2d 72 65 66 20 77 69 6c 6c 20 79 69 65 6c 64 20 -ref will yield
9ba0: 77 68 61 74 20 79 6f 75 20 65 78 70 65 63 74 0a what you expect.
9bb0: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 65 78 74 72 ;;.(define (extr
9bc0: 61 63 74 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 74 act-fields-const
9bd0: 72 61 69 6e 74 73 20 66 69 65 6c 64 73 2d 73 70 raints fields-sp
9be0: 65 63 29 0a 20 20 28 6d 61 70 20 28 6c 61 6d 62 ec). (map (lamb
9bf0: 64 61 20 28 74 61 62 6c 65 2d 73 70 65 63 29 20 da (table-spec)
9c00: 3b 3b 20 72 75 6e 73 3a 69 64 2c 74 61 72 67 65 ;; runs:id,targe
9c10: 74 2c 72 75 6e 6e 61 6d 65 0a 09 20 28 6c 65 74 t,runname.. (let
9c20: 20 28 28 64 61 74 20 28 73 74 72 69 6e 67 2d 73 ((dat (string-s
9c30: 70 6c 69 74 20 74 61 62 6c 65 2d 73 70 65 63 20 plit table-spec
9c40: 22 3a 22 29 29 29 20 3b 3b 20 28 22 72 75 6e 73 ":"))) ;; ("runs
9c50: 22 20 22 69 64 2c 74 61 72 67 65 74 2c 72 75 6e " "id,target,run
9c60: 6e 61 6d 65 22 29 0a 09 20 20 20 28 69 66 20 28 name").. (if (
9c70: 3e 20 28 6c 65 6e 67 74 68 20 64 61 74 29 20 31 > (length dat) 1
9c80: 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 ).. (cons
9c90: 28 63 61 72 20 64 61 74 29 28 73 74 72 69 6e 67 (car dat)(string
9ca0: 2d 73 70 6c 69 74 20 28 63 61 64 72 20 64 61 74 -split (cadr dat
9cb0: 29 20 22 2c 22 29 29 20 3b 3b 20 22 69 64 2c 74 ) ",")) ;; "id,t
9cc0: 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 22 0a 09 arget,runname"..
9cd0: 20 20 20 20 20 20 20 64 61 74 29 29 29 0a 20 20 dat))).
9ce0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c (string-spl
9cf0: 69 74 20 66 69 65 6c 64 73 2d 73 70 65 63 20 22 it fields-spec "
9d00: 2b 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 +")))..(define (
9d10: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
9d20: 6c 64 6e 61 6d 65 20 64 61 74 61 76 65 63 20 74 ldname datavec t
9d30: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
9d40: 66 69 65 6c 64 6e 61 6d 65 29 0a 20 20 28 6c 65 fieldname). (le
9d50: 74 20 28 28 69 6e 64 78 20 28 68 61 73 68 2d 74 t ((indx (hash-t
9d60: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
9d70: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
9d80: 78 20 66 69 65 6c 64 6e 61 6d 65 20 23 66 29 29 x fieldname #f))
9d90: 29 0a 20 20 20 20 28 69 66 20 69 6e 64 78 0a 09 ). (if indx..
9da0: 28 69 66 20 28 3e 3d 20 69 6e 64 78 20 28 76 65 (if (>= indx (ve
9db0: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 64 61 74 61 ctor-length data
9dc0: 76 65 63 29 29 0a 09 20 20 20 20 23 66 20 3b 3b vec)).. #f ;;
9dd0: 20 69 6e 64 65 78 20 74 6f 6f 20 68 69 67 68 2c index too high,
9de0: 20 73 68 6f 75 6c 64 20 72 61 69 73 65 20 61 6e should raise an
9df0: 20 65 72 72 6f 72 20 49 20 73 75 70 70 6f 73 65 error I suppose
9e00: 0a 09 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 .. (vector-re
9e10: 66 20 64 61 74 61 76 65 63 20 69 6e 64 78 29 29 f datavec indx))
9e20: 0a 09 23 66 29 29 29 0a 0a 3b 3b 20 4e 4f 54 45 ..#f)))..;; NOTE
9e30: 3a 20 6c 69 73 74 2d 72 75 6e 73 20 61 6e 64 20 : list-runs and
9e40: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 20 list-db-targets
9e50: 6f 70 65 72 61 74 65 20 6f 6e 20 6c 6f 63 61 6c operate on local
9e60: 20 64 62 21 21 21 0a 3b 3b 0a 3b 3b 20 49 44 45 db!!!.;;.;; IDE
9e70: 41 3a 20 6d 65 67 61 74 65 73 74 20 6c 69 73 74 A: megatest list
9e80: 20 2d 72 75 6e 6e 61 6d 65 20 62 6c 61 68 25 20 -runname blah%
9e90: 2e 2e 2e 0a 3b 3b 0a 28 69 66 20 28 6f 72 20 28 ....;;.(if (or (
9ea0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
9eb0: 69 73 74 2d 72 75 6e 73 22 29 0a 09 28 61 72 67 ist-runs")..(arg
9ec0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
9ed0: 2d 64 62 2d 74 61 72 67 65 74 73 22 29 29 0a 20 -db-targets")).
9ee0: 20 20 20 28 69 66 20 28 6c 61 75 6e 63 68 3a 73 (if (launch:s
9ef0: 65 74 75 70 29 0a 09 28 6c 65 74 2a 20 28 3b 3b etup)..(let* (;;
9f00: 20 28 64 62 73 74 72 75 63 74 20 20 20 20 28 6d (dbstruct (m
9f10: 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 ake-dbr:dbstruct
9f20: 20 70 61 74 68 3a 20 2a 74 6f 70 70 61 74 68 2a path: *toppath*
9f30: 20 6c 6f 63 61 6c 3a 20 28 61 72 67 73 3a 67 65 local: (args:ge
9f40: 74 2d 61 72 67 20 22 2d 6c 6f 63 61 6c 22 29 29 t-arg "-local"))
9f50: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 70 61 ).. (runpa
9f60: 74 74 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 tt (args:get
9f70: 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 -arg "-list-runs
9f80: 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ")).
9f90: 20 20 20 28 61 63 63 65 73 73 2d 6d 6f 64 65 20 (access-mode
9fa0: 28 64 62 3a 67 65 74 2d 61 63 63 65 73 73 2d 6d (db:get-access-m
9fb0: 6f 64 65 29 29 0a 09 20 20 20 20 20 20 20 28 74 ode)).. (t
9fc0: 65 73 74 70 61 74 74 20 20 20 20 28 63 6f 6d 6d estpatt (comm
9fd0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
9fe0: 70 61 74 74 20 23 66 29 29 0a 09 20 20 20 20 20 patt #f))..
9ff0: 20 20 3b 3b 20 28 69 66 20 28 61 72 67 73 3a 67 ;; (if (args:g
a000: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
a010: 74 22 29 20 0a 09 20 20 20 20 20 20 20 3b 3b 20 t") .. ;;
a020: 20 09 20 20 20 20 20 20 20 20 28 61 72 67 73 3a . (args:
a030: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
a040: 74 74 22 29 20 0a 09 20 20 20 20 20 20 20 3b 3b tt") .. ;;
a050: 20 20 09 20 20 20 20 20 20 20 20 22 25 22 29 29 . "%"))
a060: 0a 09 20 20 20 20 20 20 20 28 6b 65 79 73 20 20 .. (keys
a070: 20 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b (rmt:get-k
a080: 65 79 73 29 29 20 3b 3b 20 28 64 62 3a 67 65 74 eys)) ;; (db:get
a090: 2d 6b 65 79 73 20 64 62 73 74 72 75 63 74 29 29 -keys dbstruct))
a0a0: 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 72 75 6e .. ;; (run
a0b0: 73 64 61 74 20 20 28 64 62 3a 67 65 74 2d 72 75 sdat (db:get-ru
a0c0: 6e 73 20 64 62 73 74 72 75 63 74 20 72 75 6e 70 ns dbstruct runp
a0d0: 61 74 74 20 23 66 20 23 66 20 27 28 29 29 29 0a att #f #f '())).
a0e0: 09 3b 3b 20 28 72 75 6e 73 64 61 74 20 20 20 20 .;; (runsdat
a0f0: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 (rmt:get-runs-b
a100: 79 2d 70 61 74 74 20 6b 65 79 73 20 28 6f 72 20 y-patt keys (or
a110: 72 75 6e 70 61 74 74 20 22 25 22 29 20 28 63 6f runpatt "%") (co
a120: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 mmon:args-get-ta
a130: 72 67 65 74 29 20 3b 3b 20 28 64 62 3a 67 65 74 rget) ;; (db:get
a140: 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 64 62 -runs-by-patt db
a150: 73 74 72 75 63 74 20 6b 65 79 73 20 28 6f 72 20 struct keys (or
a160: 72 75 6e 70 61 74 74 20 22 25 22 29 20 28 63 6f runpatt "%") (co
a170: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 mmon:args-get-ta
a180: 72 67 65 74 29 0a 09 3b 3b 20 09 09 20 20 20 20 rget)..;; ..
a190: 20 20 20 20 20 20 20 09 20 23 66 20 23 66 20 27 . #f #f '
a1a0: 28 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 ("id" "runname"
a1b0: 22 73 74 61 74 65 22 20 22 73 74 61 74 75 73 22 "state" "status"
a1c0: 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f "owner" "event_
a1d0: 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 time" "comment")
a1e0: 20 30 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 0)).. (ru
a1f0: 6e 73 64 61 74 20 20 20 20 20 28 72 6d 74 3a 67 nsdat (rmt:g
a200: 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 et-runs-by-patt
a210: 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 61 74 74 keys (or runpatt
a220: 20 22 25 22 29 20 0a 20 20 20 20 20 20 20 20 20 "%") .
a230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a250: 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e (common
a260: 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 :args-get-target
a270: 29 20 23 66 20 23 66 20 27 28 22 69 64 22 20 22 ) #f #f '("id" "
a280: 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 runname" "state"
a290: 20 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 "status" "owner
a2a0: 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 22 " "event_time" "
a2b0: 63 6f 6d 6d 65 6e 74 22 29 20 30 29 29 0a 09 20 comment") 0))..
a2c0: 20 20 20 20 20 20 28 72 75 6e 73 74 6d 70 20 20 (runstmp
a2d0: 20 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 (db:get-rows
a2e0: 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 runsdat))..
a2f0: 20 20 28 68 65 61 64 65 72 20 20 20 20 20 20 28 (header (
a300: 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 db:get-header ru
a310: 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 nsdat))..
a320: 3b 3b 20 74 68 69 73 20 69 73 20 22 2d 73 69 6e ;; this is "-sin
a330: 63 65 22 20 73 75 70 70 6f 72 74 2e 20 54 68 69 ce" support. Thi
a340: 73 20 6c 6f 6f 6b 73 20 61 74 20 6c 61 73 74 20 s looks at last
a350: 6d 6f 64 20 74 69 6d 65 73 20 6f 66 20 3c 72 75 mod times of <ru
a360: 6e 2d 69 64 3e 2e 64 62 20 66 69 6c 65 73 0a 09 n-id>.db files..
a370: 20 20 20 20 20 20 20 3b 3b 20 61 6e 64 20 63 6f ;; and co
a380: 6c 6c 65 63 74 73 20 74 68 6f 73 65 20 6d 6f 64 llects those mod
a390: 69 66 69 65 64 20 73 69 6e 63 65 20 74 68 65 20 ified since the
a3a0: 2d 73 69 6e 63 65 20 74 69 6d 65 2e 0a 09 20 20 -since time...
a3b0: 20 20 20 20 20 28 72 75 6e 73 20 20 20 20 20 20 (runs
a3c0: 20 20 72 75 6e 73 74 6d 70 29 0a 20 20 20 20 20 runstmp).
a3d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a3e0: 20 20 20 3b 3b 20 28 69 66 20 28 61 6e 64 20 28 ;; (if (and (
a3f0: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 75 6e 73 74 not (null? runst
a400: 6d 70 29 29 0a 09 09 09 3b 3b 20 20 20 20 20 20 mp))....;;
a410: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
a420: 22 2d 73 69 6e 63 65 22 29 29 0a 09 09 09 3b 3b "-since"))....;;
a430: 20 20 20 28 6c 65 74 20 28 28 63 68 61 6e 67 65 (let ((change
a440: 64 2d 69 64 73 20 28 64 62 3a 67 65 74 2d 63 68 d-ids (db:get-ch
a450: 61 6e 67 65 64 2d 72 75 6e 2d 69 64 73 20 28 73 anged-run-ids (s
a460: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 tring->number (a
a470: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 rgs:get-arg "-si
a480: 6e 63 65 22 29 29 29 29 29 0a 09 09 09 3b 3b 20 nce")))))....;;
a490: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
a4a0: 68 65 64 20 28 63 61 72 20 72 75 6e 73 74 6d 70 hed (car runstmp
a4b0: 29 29 0a 09 09 09 3b 3b 20 20 20 09 20 20 20 20 ))....;; .
a4c0: 20 28 74 61 6c 20 28 63 64 72 20 72 75 6e 73 74 (tal (cdr runst
a4d0: 6d 70 29 29 0a 09 09 09 3b 3b 20 20 20 09 20 20 mp))....;; .
a4e0: 20 20 20 28 72 65 73 20 27 28 29 29 29 0a 09 09 (res '()))...
a4f0: 09 3b 3b 20 20 20 20 20 20 20 28 6c 65 74 20 28 .;; (let (
a500: 28 6e 65 77 2d 72 65 73 20 28 69 66 20 28 6d 65 (new-res (if (me
a510: 6d 62 65 72 20 28 64 62 3a 67 65 74 2d 76 61 6c mber (db:get-val
a520: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 68 65 64 ue-by-header hed
a530: 20 68 65 61 64 65 72 20 22 69 64 22 29 20 63 68 header "id") ch
a540: 61 6e 67 65 64 2d 69 64 73 29 0a 09 09 09 3b 3b anged-ids)....;;
a550: 20 20 20 09 09 20 20 20 20 20 20 20 28 63 6f 6e .. (con
a560: 73 20 68 65 64 20 72 65 73 29 0a 09 09 09 3b 3b s hed res)....;;
a570: 20 20 20 09 09 20 20 20 20 20 20 20 72 65 73 29 .. res)
a580: 29 29 0a 09 09 09 3b 3b 20 20 20 20 20 20 20 20 ))....;;
a590: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 (if (null? tal)
a5a0: 0a 09 09 09 3b 3b 20 20 20 09 20 20 28 72 65 76 ....;; . (rev
a5b0: 65 72 73 65 20 6e 65 77 2d 72 65 73 29 0a 09 09 erse new-res)...
a5c0: 09 3b 3b 20 20 20 09 20 20 28 6c 6f 6f 70 20 28 .;; . (loop (
a5d0: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal
a5e0: 29 20 6e 65 77 2d 72 65 73 29 29 29 29 29 0a 09 ) new-res)))))..
a5f0: 09 09 3b 3b 20 20 20 72 75 6e 73 74 6d 70 29 29 ..;; runstmp))
a600: 0a 09 20 20 20 20 20 20 20 28 64 62 2d 74 61 72 .. (db-tar
a610: 67 65 74 73 20 20 28 61 72 67 73 3a 67 65 74 2d gets (args:get-
a620: 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 61 arg "-list-db-ta
a630: 72 67 65 74 73 22 29 29 0a 09 20 20 20 20 20 20 rgets"))..
a640: 20 28 73 65 65 6e 20 20 20 20 20 20 20 20 28 6d (seen (m
a650: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
a660: 0a 09 20 20 20 20 20 20 20 28 64 6d 6f 64 65 20 .. (dmode
a670: 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 20 28 (let ((d (
a680: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
a690: 75 6d 70 6d 6f 64 65 22 29 29 29 0a 09 09 09 20 umpmode")))....
a6a0: 20 20 20 20 20 28 69 66 20 64 20 28 73 74 72 69 (if d (stri
a6b0: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 64 29 20 23 66 ng->symbol d) #f
a6c0: 29 29 29 0a 09 20 20 20 20 20 20 20 28 64 61 74 ))).. (dat
a6d0: 61 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 a (make-h
a6e0: 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 20 ash-table))..
a6f0: 20 20 20 20 28 66 69 65 6c 64 73 2d 73 70 65 63 (fields-spec
a700: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
a710: 72 67 20 22 2d 66 69 65 6c 64 73 22 29 0a 09 09 rg "-fields")...
a720: 09 09 28 65 78 74 72 61 63 74 2d 66 69 65 6c 64 ..(extract-field
a730: 73 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 28 61 s-constraints (a
a740: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 66 69 rgs:get-arg "-fi
a750: 65 6c 64 73 22 29 29 0a 09 09 09 09 28 6c 69 73 elds")).....(lis
a760: 74 20 28 63 6f 6e 73 20 22 72 75 6e 73 22 20 28 t (cons "runs" (
a770: 61 70 70 65 6e 64 20 6b 65 79 73 20 28 6c 69 73 append keys (lis
a780: 74 20 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 t "id" "runname"
a790: 20 22 73 74 61 74 65 22 20 22 73 74 61 74 75 73 "state" "status
a7a0: 22 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 " "owner" "event
a7b0: 5f 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 _time" "comment"
a7c0: 20 22 66 61 69 6c 5f 63 6f 75 6e 74 22 20 22 70 "fail_count" "p
a7d0: 61 73 73 5f 63 6f 75 6e 74 22 29 29 29 0a 09 09 ass_count")))...
a7e0: 09 09 20 20 20 20 20 20 28 63 6f 6e 73 20 22 74 .. (cons "t
a7f0: 65 73 74 73 22 20 20 64 62 3a 74 65 73 74 2d 72 ests" db:test-r
a800: 65 63 6f 72 64 2d 66 69 65 6c 64 73 29 20 3b 3b ecord-fields) ;;
a810: 20 22 69 64 22 20 22 74 65 73 74 6e 61 6d 65 22 "id" "testname"
a820: 20 22 74 65 73 74 5f 70 61 74 68 22 29 0a 09 09 "test_path")...
a830: 09 09 20 20 20 20 20 20 28 6c 69 73 74 20 22 73 .. (list "s
a840: 74 65 70 73 22 20 22 69 64 22 20 22 73 74 65 70 teps" "id" "step
a850: 6e 61 6d 65 22 29 29 29 29 0a 09 20 20 20 20 20 name"))))..
a860: 20 20 28 72 75 6e 73 2d 73 70 65 63 20 20 20 28 (runs-spec (
a870: 6c 65 74 20 28 28 72 20 28 61 6c 69 73 74 2d 72 let ((r (alist-r
a880: 65 66 20 22 72 75 6e 73 22 20 20 66 69 65 6c 64 ef "runs" field
a890: 73 2d 73 70 65 63 20 65 71 75 61 6c 3f 29 29 29 s-spec equal?)))
a8a0: 20 3b 3b 20 74 68 65 20 63 68 65 63 6b 20 69 73 ;; the check is
a8b0: 20 6e 6f 77 20 75 6e 6e 65 63 65 73 73 61 72 79 now unnecessary
a8c0: 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 61 .... (if (a
a8d0: 6e 64 20 72 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f nd r (not (null?
a8e0: 20 72 29 29 29 20 72 20 28 6c 69 73 74 20 22 69 r))) r (list "i
a8f0: 64 22 20 29 29 29 29 0a 09 20 20 20 20 20 20 20 d" ))))..
a900: 28 74 65 73 74 73 2d 73 70 65 63 20 20 28 6c 65 (tests-spec (le
a910: 74 20 28 28 74 20 28 61 6c 69 73 74 2d 72 65 66 t ((t (alist-ref
a920: 20 22 74 65 73 74 73 22 20 66 69 65 6c 64 73 2d "tests" fields-
a930: 73 70 65 63 20 65 71 75 61 6c 3f 29 29 29 0a 09 spec equal?)))..
a940: 09 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 .. (if (and
a950: 20 74 20 28 6e 75 6c 6c 3f 20 74 29 29 20 3b 3b t (null? t)) ;;
a960: 20 61 6c 6c 20 66 69 65 6c 64 73 0a 09 09 09 09 all fields.....
a970: 20 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 db:test-record
a980: 2d 66 69 65 6c 64 73 0a 09 09 09 09 20 20 74 29 -fields..... t)
a990: 29 29 0a 09 20 20 20 20 20 20 20 28 61 64 6a 2d )).. (adj-
a9a0: 74 65 73 74 73 2d 73 70 65 63 20 28 64 65 6c 65 tests-spec (dele
a9b0: 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 28 69 te-duplicates (i
a9c0: 66 20 74 65 73 74 73 2d 73 70 65 63 20 28 63 6f f tests-spec (co
a9d0: 6e 73 20 22 69 64 22 20 74 65 73 74 73 2d 73 70 ns "id" tests-sp
a9e0: 65 63 29 20 64 62 3a 74 65 73 74 2d 72 65 63 6f ec) db:test-reco
a9f0: 72 64 2d 66 69 65 6c 64 73 29 29 29 20 3b 3b 20 rd-fields))) ;;
aa00: 27 28 22 69 64 22 29 29 29 29 0a 09 20 20 20 20 '("id"))))..
aa10: 20 20 20 28 73 74 65 70 73 2d 73 70 65 63 20 20 (steps-spec
aa20: 28 61 6c 69 73 74 2d 72 65 66 20 22 73 74 65 70 (alist-ref "step
aa30: 73 22 20 66 69 65 6c 64 73 2d 73 70 65 63 20 65 s" fields-spec e
aa40: 71 75 61 6c 3f 29 29 0a 09 20 20 20 20 20 20 20 qual?))..
aa50: 28 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 (test-field-inde
aa60: 78 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 x (make-hash-tab
aa70: 6c 65 29 29 29 0a 09 20 20 28 69 66 20 28 61 6e le))).. (if (an
aa80: 64 20 74 65 73 74 73 2d 73 70 65 63 20 28 6e 6f d tests-spec (no
aa90: 74 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 2d 73 t (null? tests-s
aaa0: 70 65 63 29 29 29 20 3b 3b 20 64 6f 20 73 6f 6d pec))) ;; do som
aab0: 65 20 76 61 6c 69 64 61 74 69 6f 6e 20 61 6e 64 e validation and
aac0: 20 70 72 6f 63 65 73 73 69 6e 67 20 6f 66 20 74 processing of t
aad0: 68 65 20 74 65 73 74 2d 73 70 65 63 0a 09 20 20 he test-spec..
aae0: 20 20 20 20 28 6c 65 74 20 28 28 69 6e 76 61 6c (let ((inval
aaf0: 69 64 2d 74 65 73 74 73 2d 73 70 65 63 20 28 66 id-tests-spec (f
ab00: 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 ilter (lambda (x
ab10: 29 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 78 20 )(not (member x
ab20: 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 db:test-record-f
ab30: 69 65 6c 64 73 29 29 29 20 74 65 73 74 73 2d 73 ields))) tests-s
ab40: 70 65 63 29 29 29 0a 09 09 28 69 66 20 28 6e 75 pec)))...(if (nu
ab50: 6c 6c 3f 20 69 6e 76 61 6c 69 64 2d 74 65 73 74 ll? invalid-test
ab60: 73 2d 73 70 65 63 29 0a 09 09 20 20 20 20 3b 3b s-spec)... ;;
ab70: 20 67 65 6e 65 72 61 74 65 20 74 68 65 20 6c 6f generate the lo
ab80: 6f 6b 75 70 20 6d 61 70 20 74 65 73 74 2d 66 69 okup map test-fi
ab90: 65 6c 64 2d 6e 61 6d 65 20 3d 3e 20 69 6e 64 65 eld-name => inde
aba0: 78 2d 6e 75 6d 62 65 72 0a 09 09 20 20 20 20 28 x-number... (
abb0: 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 let loop ((hed (
abc0: 63 61 72 20 61 64 6a 2d 74 65 73 74 73 2d 73 70 car adj-tests-sp
abd0: 65 63 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 ec)).... (
abe0: 74 61 6c 20 28 63 64 72 20 61 64 6a 2d 74 65 73 tal (cdr adj-tes
abf0: 74 73 2d 73 70 65 63 29 29 0a 09 09 09 20 20 20 ts-spec))....
ac00: 20 20 20 20 28 69 64 78 20 30 29 29 0a 09 09 20 (idx 0))...
ac10: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
ac20: 2d 73 65 74 21 20 74 65 73 74 2d 66 69 65 6c 64 -set! test-field
ac30: 2d 69 6e 64 65 78 20 68 65 64 20 69 64 78 29 0a -index hed idx).
ac40: 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not
ac50: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 28 6c 6f (null? tal))(lo
ac60: 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 op (car tal)(cdr
ac70: 20 74 61 6c 29 28 2b 20 69 64 78 20 31 29 29 29 tal)(+ idx 1)))
ac80: 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 )... (begin..
ac90: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
aca0: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
acb0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
acc0: 49 6e 76 61 6c 69 64 20 74 65 73 74 20 66 69 65 Invalid test fie
acd0: 6c 64 73 20 73 70 65 63 69 66 69 65 64 3a 20 22 lds specified: "
ace0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
acf0: 65 72 73 65 20 69 6e 76 61 6c 69 64 2d 74 65 73 erse invalid-tes
ad00: 74 73 2d 73 70 65 63 20 22 2c 20 22 29 29 0a 09 ts-spec ", "))..
ad10: 09 20 20 20 20 20 20 28 65 78 69 74 29 29 29 29 . (exit))))
ad20: 29 0a 0a 09 20 20 3b 3b 20 45 61 63 68 20 72 75 )... ;; Each ru
ad30: 6e 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 20 0a n.. (for-each .
ad40: 09 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e . (lambda (run
ad50: 29 0a 09 20 20 20 20 20 28 6c 65 74 20 28 28 74 ).. (let ((t
ad60: 61 72 67 65 74 73 74 72 20 28 73 74 72 69 6e 67 argetstr (string
ad70: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 -intersperse (ma
ad80: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 p (lambda (x)...
ad90: 09 09 09 09 09 20 28 64 62 3a 67 65 74 2d 76 61 ..... (db:get-va
ada0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
adb0: 6e 20 68 65 61 64 65 72 20 78 29 29 0a 09 09 09 n header x))....
adc0: 09 09 09 20 20 20 20 20 20 20 6b 65 79 73 29 20 ... keys)
add0: 22 2f 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 "/"))).. (
ade0: 69 66 20 64 62 2d 74 61 72 67 65 74 73 0a 09 09 if db-targets...
adf0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 (if (not (has
ae00: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
ae10: 75 6c 74 20 73 65 65 6e 20 74 61 72 67 65 74 73 ult seen targets
ae20: 74 72 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 tr #f))...
ae30: 20 28 62 65 67 69 6e 0a 09 09 09 20 28 68 61 73 (begin.... (has
ae40: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 65 65 h-table-set! see
ae50: 6e 20 74 61 72 67 65 74 73 74 72 20 23 74 29 0a n targetstr #t).
ae60: 09 09 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 5b ... ;; (print "[
ae70: 22 20 74 61 72 67 65 74 73 74 72 20 22 5d 22 29 " targetstr "]")
ae80: 29 29 29 0a 09 09 09 20 28 69 66 20 28 6e 6f 74 ))).... (if (not
ae90: 20 64 6d 6f 64 65 29 0a 09 09 09 20 20 20 20 20 dmode)....
aea0: 28 70 72 69 6e 74 20 74 61 72 67 65 74 73 74 72 (print targetstr
aeb0: 29 0a 09 09 09 20 20 20 20 20 28 68 61 73 68 2d ).... (hash-
aec0: 74 61 62 6c 65 2d 73 65 74 21 20 64 61 74 61 20 table-set! data
aed0: 22 74 61 72 67 65 74 73 22 20 28 63 6f 6e 73 20 "targets" (cons
aee0: 74 61 72 67 65 74 73 74 72 20 28 68 61 73 68 2d targetstr (hash-
aef0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
af00: 74 20 64 61 74 61 20 22 74 61 72 67 65 74 73 22 t data "targets"
af10: 20 27 28 29 29 29 29 0a 09 09 09 20 20 20 20 20 '())))....
af20: 29 29 29 0a 09 09 20 20 20 28 6c 65 74 2a 20 28 )))... (let* (
af30: 28 72 75 6e 2d 69 64 20 20 28 64 62 3a 67 65 74 (run-id (db:get
af40: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
af50: 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 64 22 run header "id"
af60: 29 29 0a 09 09 09 20 20 28 72 75 6e 6e 61 6d 65 )).... (runname
af70: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
af80: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
af90: 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 20 der "runname"))
afa0: 0a 09 09 09 20 20 28 73 74 61 74 65 73 20 20 28 .... (states (
afb0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 6f 72 string-split (or
afc0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
afd0: 2d 73 74 61 74 65 22 29 20 22 22 29 20 22 2c 22 -state") "") ","
afe0: 29 29 0a 09 09 09 20 20 28 73 74 61 74 75 73 65 )).... (statuse
aff0: 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 s (string-split
b000: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
b010: 67 20 22 2d 73 74 61 74 75 73 22 29 20 22 22 29 g "-status") "")
b020: 20 22 2c 22 29 29 0a 09 09 09 20 20 28 74 65 73 ",")).... (tes
b030: 74 73 20 20 20 28 69 66 20 74 65 73 74 73 2d 73 ts (if tests-s
b040: 70 65 63 0a 09 09 09 09 20 20 20 20 20 20 20 28 pec..... (
b050: 64 62 3a 64 69 73 70 61 74 63 68 2d 71 75 65 72 db:dispatch-quer
b060: 79 20 61 63 63 65 73 73 2d 6d 6f 64 65 20 72 6d y access-mode rm
b070: 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d t:get-tests-for-
b080: 72 75 6e 20 64 62 3a 67 65 74 2d 74 65 73 74 73 run db:get-tests
b090: 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 64 20 -for-run run-id
b0a0: 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 testpatt states
b0b0: 73 74 61 74 75 73 65 73 20 23 66 20 23 66 20 23 statuses #f #f #
b0c0: 66 20 27 74 65 73 74 6e 61 6d 65 20 27 61 73 63 f 'testname 'asc
b0d0: 20 3b 3b 20 28 64 62 3a 67 65 74 2d 74 65 73 74 ;; (db:get-test
b0e0: 73 2d 66 6f 72 2d 72 75 6e 20 64 62 73 74 72 75 s-for-run dbstru
b0f0: 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 ct run-id testpa
b100: 74 74 20 27 28 29 20 27 28 29 20 23 66 20 23 66 tt '() '() #f #f
b110: 20 23 66 20 27 74 65 73 74 6e 61 6d 65 20 27 61 #f 'testname 'a
b120: 73 63 20 0a 09 09 09 09 09 09 09 20 20 20 20 20 sc ........
b130: 3b 3b 20 75 73 65 20 71 72 79 76 61 6c 73 20 69 ;; use qryvals i
b140: 66 20 74 65 73 74 2d 73 70 65 63 20 70 72 6f 76 f test-spec prov
b150: 69 64 65 64 0a 09 09 09 09 09 09 09 20 20 20 20 ided........
b160: 20 28 69 66 20 74 65 73 74 73 2d 73 70 65 63 0a (if tests-spec.
b170: 09 09 09 09 09 09 09 09 20 28 73 74 72 69 6e 67 ........ (string
b180: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 61 64 6a -intersperse adj
b190: 2d 74 65 73 74 73 2d 73 70 65 63 20 22 2c 22 29 -tests-spec ",")
b1a0: 0a 09 09 09 09 09 09 09 09 20 3b 3b 20 64 62 3a ......... ;; db:
b1b0: 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c test-record-fiel
b1c0: 64 73 0a 09 09 09 09 09 09 09 09 20 23 66 29 0a ds......... #f).
b1d0: 09 09 09 09 09 09 09 20 20 20 20 20 23 66 0a 09 ....... #f..
b1e0: 09 09 09 09 09 09 20 20 20 20 20 27 6e 6f 72 6d ...... 'norm
b1f0: 61 6c 29 0a 09 09 09 09 20 20 20 20 20 20 20 27 al)..... '
b200: 28 29 29 29 29 0a 09 09 20 20 20 20 20 28 63 61 ())))... (ca
b210: 73 65 20 64 6d 6f 64 65 0a 09 09 20 20 20 20 20 se dmode...
b220: 20 20 28 28 6a 73 6f 6e 20 6f 64 73 29 0a 09 09 ((json ods)...
b230: 09 28 69 66 20 72 75 6e 73 2d 73 70 65 63 0a 09 .(if runs-spec..
b240: 09 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 .. (for-each
b250: 0a 09 09 09 20 20 20 20 20 28 6c 61 6d 62 64 61 .... (lambda
b260: 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 (field-name)...
b270: 09 20 20 20 20 20 20 20 28 6d 75 74 69 6c 73 3a . (mutils:
b280: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
b290: 74 61 20 28 63 6f 6e 63 20 28 64 62 3a 67 65 74 ta (conc (db:get
b2a0: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
b2b0: 20 72 75 6e 20 68 65 61 64 65 72 20 66 69 65 6c run header fiel
b2c0: 64 2d 6e 61 6d 65 29 29 20 74 61 72 67 65 74 73 d-name)) targets
b2d0: 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 tr runname "meta
b2e0: 22 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 0a 09 " field-name))..
b2f0: 09 09 20 20 20 20 20 72 75 6e 73 2d 73 70 65 63 .. runs-spec
b300: 29 29 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c )))....;; (mutil
b310: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
b320: 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 6c data (db:get-val
b330: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
b340: 20 68 65 61 64 65 72 20 22 73 74 61 74 75 73 22 header "status"
b350: 29 20 20 20 20 20 74 61 72 67 65 74 73 74 72 20 ) targetstr
b360: 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 runname "meta" "
b370: 73 74 61 74 75 73 22 20 20 20 20 20 29 0a 09 09 status" )...
b380: 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 .;; (mutils:hier
b390: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 hash-set! data (
b3a0: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
b3b0: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
b3c0: 72 20 22 73 74 61 74 65 22 29 20 20 20 20 20 20 r "state")
b3d0: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
b3e0: 65 20 22 6d 65 74 61 22 20 22 73 74 61 74 65 22 e "meta" "state"
b3f0: 20 20 20 20 20 20 29 0a 09 09 09 3b 3b 20 28 6d )....;; (m
b400: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
b410: 65 74 21 20 64 61 74 61 20 28 63 6f 6e 63 20 28 et! data (conc (
b420: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
b430: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
b440: 72 20 22 69 64 22 29 29 20 20 74 61 72 67 65 74 r "id")) target
b450: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 str runname "met
b460: 61 22 20 22 69 64 22 20 20 20 20 20 20 20 20 20 a" "id"
b470: 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a )....;; (mutils:
b480: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
b490: 74 61 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 ta (db:get-value
b4a0: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
b4b0: 65 61 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d eader "event_tim
b4c0: 65 22 29 20 74 61 72 67 65 74 73 74 72 20 72 75 e") targetstr ru
b4d0: 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 65 76 nname "meta" "ev
b4e0: 65 6e 74 5f 74 69 6d 65 22 20 29 0a 09 09 09 3b ent_time" )....;
b4f0: 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 ; (mutils:hierha
b500: 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 64 62 sh-set! data (db
b510: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
b520: 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 ader run header
b530: 22 63 6f 6d 6d 65 6e 74 22 29 20 20 20 20 74 61 "comment") ta
b540: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
b550: 22 6d 65 74 61 22 20 22 63 6f 6d 6d 65 6e 74 22 "meta" "comment"
b560: 20 20 20 20 29 0a 09 09 09 3b 3b 20 3b 3b 20 61 )....;; ;; a
b570: 64 64 20 6c 61 73 74 20 65 6e 74 72 79 20 74 77 dd last entry tw
b580: 69 63 65 20 2d 20 73 65 65 6d 73 20 74 6f 20 62 ice - seems to b
b590: 65 20 61 20 62 75 67 20 69 6e 20 68 69 65 72 68 e a bug in hierh
b5a0: 61 73 68 3f 0a 09 09 09 3b 3b 20 28 6d 75 74 69 ash?....;; (muti
b5b0: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
b5c0: 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 data (db:get-va
b5d0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
b5e0: 6e 20 68 65 61 64 65 72 20 22 63 6f 6d 6d 65 6e n header "commen
b5f0: 74 22 29 20 20 20 20 74 61 72 67 65 74 73 74 72 t") targetstr
b600: 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 runname "meta"
b610: 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 29 0a 09 "comment" )..
b620: 09 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 09 . (else...
b630: 09 28 69 66 20 28 6e 75 6c 6c 3f 20 72 75 6e 73 .(if (null? runs
b640: 2d 73 70 65 63 29 0a 09 09 09 20 20 20 20 28 70 -spec).... (p
b650: 72 69 6e 74 20 22 52 75 6e 3a 20 22 20 74 61 72 rint "Run: " tar
b660: 67 65 74 73 74 72 20 22 2f 22 20 72 75 6e 6e 61 getstr "/" runna
b670: 6d 65 20 0a 09 09 09 09 20 20 20 22 20 73 74 61 me ..... " sta
b680: 74 75 73 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 tus: " (db:get-v
b690: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
b6a0: 75 6e 20 68 65 61 64 65 72 20 22 73 74 61 74 65 un header "state
b6b0: 22 29 0a 09 09 09 09 20 20 20 22 20 72 75 6e 2d ")..... " run-
b6c0: 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 2c 20 id: " run-id ",
b6d0: 6e 75 6d 62 65 72 20 74 65 73 74 73 3a 20 22 20 number tests: "
b6e0: 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 0a 09 (length tests)..
b6f0: 09 09 09 20 20 20 22 20 65 76 65 6e 74 5f 74 69 ... " event_ti
b700: 6d 65 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 61 me: " (db:get-va
b710: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
b720: 6e 20 68 65 61 64 65 72 20 22 65 76 65 6e 74 5f n header "event_
b730: 74 69 6d 65 22 29 29 0a 09 09 09 20 20 20 20 28 time")).... (
b740: 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 begin.... (
b750: 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 if (not (member
b760: 22 74 61 72 67 65 74 22 20 72 75 6e 73 2d 73 70 "target" runs-sp
b770: 65 63 29 29 0a 09 09 09 20 20 20 20 20 20 20 20 ec))....
b780: 20 20 3b 3b 20 28 64 69 73 70 6c 61 79 20 28 63 ;; (display (c
b790: 6f 6e 63 20 22 54 61 72 67 65 74 3a 20 22 20 74 onc "Target: " t
b7a0: 61 72 67 65 74 73 74 72 29 29 0a 09 09 09 20 20 argetstr))....
b7b0: 20 20 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 (display
b7c0: 20 28 63 6f 6e 63 20 22 52 75 6e 3a 20 22 20 74 (conc "Run: " t
b7d0: 61 72 67 65 74 73 74 72 20 22 2f 22 20 72 75 6e argetstr "/" run
b7e0: 6e 61 6d 65 20 22 20 22 29 29 29 0a 09 09 09 20 name " ")))....
b7f0: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 (for-each..
b800: 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda
b810: 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 (field-name)...
b820: 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f 20 66 .. (if (equal? f
b830: 69 65 6c 64 2d 6e 61 6d 65 20 22 74 61 72 67 65 ield-name "targe
b840: 74 22 29 0a 09 09 09 09 20 20 20 20 20 28 64 69 t")..... (di
b850: 73 70 6c 61 79 20 28 63 6f 6e 63 20 22 74 61 72 splay (conc "tar
b860: 67 65 74 3a 20 22 20 74 61 72 67 65 74 73 74 72 get: " targetstr
b870: 20 22 20 22 29 29 0a 09 09 09 09 20 20 20 20 20 " ")).....
b880: 28 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 66 (display (conc f
b890: 69 65 6c 64 2d 6e 61 6d 65 20 22 3a 20 22 20 28 ield-name ": " (
b8a0: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
b8b0: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
b8c0: 72 20 28 63 6f 6e 63 20 66 69 65 6c 64 2d 6e 61 r (conc field-na
b8d0: 6d 65 29 29 20 22 20 22 29 29 29 29 0a 09 09 09 me)) " "))))....
b8e0: 20 20 20 20 20 20 20 72 75 6e 73 2d 73 70 65 63 runs-spec
b8f0: 29 0a 09 09 09 20 20 20 20 20 20 28 6e 65 77 6c ).... (newl
b900: 69 6e 65 29 29 29 29 29 0a 09 09 20 20 20 20 20 ine)))))...
b910: 20 20 0a 09 09 20 20 20 20 20 28 66 6f 72 2d 65 ... (for-e
b920: 61 63 68 20 0a 09 09 20 20 20 20 20 20 28 6c 61 ach ... (la
b930: 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 20 20 mbda (test)...
b940: 20 20 20 20 09 28 68 61 6e 64 6c 65 2d 65 78 63 .(handle-exc
b950: 65 70 74 69 6f 6e 73 0a 09 09 09 20 65 78 6e 0a eptions.... exn.
b960: 09 09 09 20 28 62 65 67 69 6e 0a 09 09 09 20 20 ... (begin....
b970: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
b980: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
b990: 6f 67 2d 70 6f 72 74 2a 20 22 42 61 64 20 64 61 og-port* "Bad da
b9a0: 74 61 20 69 6e 20 74 65 73 74 20 72 65 63 6f 72 ta in test recor
b9b0: 64 3f 20 22 20 74 65 73 74 29 0a 09 09 09 20 20 d? " test)....
b9c0: 20 28 70 72 69 6e 74 20 22 65 78 6e 3d 22 20 28 (print "exn=" (
b9d0: 63 6f 6e 64 69 74 69 6f 6e 2d 3e 6c 69 73 74 20 condition->list
b9e0: 65 78 6e 29 29 0a 09 09 09 20 20 20 28 64 65 62 exn)).... (deb
b9f0: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
ba00: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 ult-log-port* "
ba10: 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f 6e message: " ((con
ba20: 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d dition-property-
ba30: 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d accessor 'exn 'm
ba40: 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 09 essage) exn))...
ba50: 09 20 20 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d . (print-call-
ba60: 63 68 61 69 6e 20 28 63 75 72 72 65 6e 74 2d 65 chain (current-e
ba70: 72 72 6f 72 2d 70 6f 72 74 29 29 29 0a 09 09 09 rror-port)))....
ba80: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 69 64 (let* ((test-id
ba90: 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 (if (membe
baa0: 72 20 22 69 64 22 20 20 20 20 20 20 20 20 20 20 r "id"
bab0: 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 tests-spec)(get
bac0: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
bad0: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
bae0: 65 6c 64 2d 69 6e 64 65 78 20 22 69 64 22 20 20 eld-index "id"
baf0: 20 20 20 20 20 20 20 20 29 20 23 66 29 29 20 3b ) #f)) ;
bb00: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 ; (db:test-get-i
bb10: 64 20 20 20 20 20 20 20 20 20 74 65 73 74 29 29 d test))
bb20: 0a 09 09 09 09 28 74 65 73 74 6e 61 6d 65 20 20 .....(testname
bb30: 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 (if (member "
bb40: 74 65 73 74 6e 61 6d 65 22 20 20 20 20 20 74 65 testname" te
bb50: 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 sts-spec)(get-va
bb60: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
bb70: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
bb80: 2d 69 6e 64 65 78 20 22 74 65 73 74 6e 61 6d 65 -index "testname
bb90: 22 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 " ) #f)) ;; (
bba0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 db:test-get-test
bbb0: 6e 61 6d 65 20 20 20 74 65 73 74 29 29 0a 09 09 name test))...
bbc0: 09 09 28 69 74 65 6d 70 61 74 68 20 20 20 20 20 ..(itempath
bbd0: 28 69 66 20 28 6d 65 6d 62 65 72 20 22 69 74 65 (if (member "ite
bbe0: 6d 5f 70 61 74 68 22 20 20 20 20 74 65 73 74 73 m_path" tests
bbf0: 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 -spec)(get-value
bc00: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
bc10: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
bc20: 64 65 78 20 22 69 74 65 6d 5f 70 61 74 68 22 20 dex "item_path"
bc30: 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a ) #f)) ;; (db:
bc40: 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 test-get-item-pa
bc50: 74 68 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 th test)).....(
bc60: 63 6f 6d 6d 65 6e 74 20 20 20 20 20 20 28 69 66 comment (if
bc70: 20 28 6d 65 6d 62 65 72 20 22 63 6f 6d 6d 65 6e (member "commen
bc80: 74 22 20 20 20 20 20 20 74 65 73 74 73 2d 73 70 t" tests-sp
bc90: 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 ec)(get-value-by
bca0: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
bcb0: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
bcc0: 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 20 29 "comment" )
bcd0: 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 #f)) ;; (db:tes
bce0: 74 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 20 20 t-get-comment
bcf0: 20 74 65 73 74 29 29 0a 09 09 09 09 28 74 73 74 test)).....(tst
bd00: 61 74 65 20 20 20 20 20 20 20 28 69 66 20 28 6d ate (if (m
bd10: 65 6d 62 65 72 20 22 73 74 61 74 65 22 20 20 20 ember "state"
bd20: 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 tests-spec)
bd30: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
bd40: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
bd50: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 73 t-field-index "s
bd60: 74 61 74 65 22 20 20 20 20 20 20 20 29 20 23 66 tate" ) #f
bd70: 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 )) ;; (db:test-g
bd80: 65 74 2d 73 74 61 74 65 20 20 20 20 20 20 74 65 et-state te
bd90: 73 74 29 29 0a 09 09 09 09 28 74 73 74 61 74 75 st)).....(tstatu
bda0: 73 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 s (if (memb
bdb0: 65 72 20 22 73 74 61 74 75 73 22 20 20 20 20 20 er "status"
bdc0: 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 tests-spec)(ge
bdd0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
bde0: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
bdf0: 69 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 ield-index "stat
be00: 75 73 22 20 20 20 20 20 20 29 20 23 66 29 29 20 us" ) #f))
be10: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
be20: 73 74 61 74 75 73 20 20 20 20 20 74 65 73 74 29 status test)
be30: 29 0a 09 09 09 09 28 65 76 65 6e 74 2d 74 69 6d ).....(event-tim
be40: 65 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 e (if (member
be50: 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 20 20 74 "event_time" t
be60: 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 ests-spec)(get-v
be70: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
be80: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
be90: 64 2d 69 6e 64 65 78 20 22 65 76 65 6e 74 5f 74 d-index "event_t
bea0: 69 6d 65 22 20 20 29 20 23 66 29 29 20 3b 3b 20 ime" ) #f)) ;;
beb0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 (db:test-get-eve
bec0: 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 29 0a 09 nt_time test))..
bed0: 09 09 09 28 72 75 6e 64 69 72 20 20 20 20 20 20 ...(rundir
bee0: 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 72 75 (if (member "ru
bef0: 6e 64 69 72 22 20 20 20 20 20 20 20 74 65 73 74 ndir" test
bf00: 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 s-spec)(get-valu
bf10: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
bf20: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
bf30: 6e 64 65 78 20 22 72 75 6e 64 69 72 22 20 20 20 ndex "rundir"
bf40: 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 ) #f)) ;; (db
bf50: 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 :test-get-rundir
bf60: 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 test)).....
bf70: 28 66 69 6e 61 6c 5f 6c 6f 67 66 20 20 20 28 69 (final_logf (i
bf80: 66 20 28 6d 65 6d 62 65 72 20 22 66 69 6e 61 6c f (member "final
bf90: 5f 6c 6f 67 66 22 20 20 20 74 65 73 74 73 2d 73 _logf" tests-s
bfa0: 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 pec)(get-value-b
bfb0: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
bfc0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
bfd0: 78 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 20 x "final_logf"
bfe0: 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 ) #f)) ;; (db:te
bff0: 73 74 2d 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 st-get-final_log
c000: 66 20 74 65 73 74 29 29 0a 09 09 09 09 28 72 75 f test)).....(ru
c010: 6e 5f 64 75 72 61 74 69 6f 6e 20 28 69 66 20 28 n_duration (if (
c020: 6d 65 6d 62 65 72 20 22 72 75 6e 5f 64 75 72 61 member "run_dura
c030: 74 69 6f 6e 22 20 74 65 73 74 73 2d 73 70 65 63 tion" tests-spec
c040: 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 )(get-value-by-f
c050: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
c060: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
c070: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 20 23 run_duration") #
c080: 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d f)) ;; (db:test-
c090: 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e get-run_duration
c0a0: 20 74 65 73 74 29 29 0a 09 09 09 09 28 66 75 6c test)).....(ful
c0b0: 6c 6e 61 6d 65 20 20 20 20 20 28 63 6f 6e 63 20 lname (conc
c0c0: 74 65 73 74 6e 61 6d 65 0a 09 09 09 09 09 09 20 testname.......
c0d0: 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 (if (equal? i
c0e0: 74 65 6d 70 61 74 68 20 22 22 29 0a 09 09 09 09 tempath "").....
c0f0: 09 09 09 22 22 20 0a 09 09 09 09 09 09 09 28 63 ..."" ........(c
c100: 6f 6e 63 20 22 28 22 20 69 74 65 6d 70 61 74 68 onc "(" itempath
c110: 20 22 29 22 29 29 29 29 29 0a 09 09 09 20 20 20 ")")))))....
c120: 28 63 61 73 65 20 64 6d 6f 64 65 0a 09 09 09 20 (case dmode....
c130: 20 20 20 20 28 28 6a 73 6f 6e 20 6f 64 73 29 0a ((json ods).
c140: 09 09 09 20 20 20 20 20 20 28 69 66 20 74 65 73 ... (if tes
c150: 74 73 2d 73 70 65 63 0a 09 09 09 09 20 20 28 66 ts-spec..... (f
c160: 6f 72 2d 65 61 63 68 0a 09 09 09 09 20 20 20 28 or-each..... (
c170: 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 2d 6e 61 lambda (field-na
c180: 6d 65 29 0a 09 09 09 09 20 20 20 20 20 28 6d 75 me)..... (mu
c190: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
c1a0: 74 21 20 64 61 74 61 20 20 28 67 65 74 2d 76 61 t! data (get-va
c1b0: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
c1c0: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
c1d0: 2d 69 6e 64 65 78 20 66 69 65 6c 64 2d 6e 61 6d -index field-nam
c1e0: 65 29 20 74 61 72 67 65 74 73 74 72 20 72 75 6e e) targetstr run
c1f0: 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e name "data" (con
c200: 63 20 74 65 73 74 2d 69 64 29 20 66 69 65 6c 64 c test-id) field
c210: 2d 6e 61 6d 65 29 29 0a 09 09 09 09 20 20 20 74 -name))..... t
c220: 65 73 74 73 2d 73 70 65 63 29 29 29 0a 09 09 09 ests-spec)))....
c230: 20 20 20 20 20 3b 3b 20 3b 3b 20 28 6d 75 74 69 ;; ;; (muti
c240: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
c250: 20 64 61 74 61 20 20 66 75 6c 6c 6e 61 6d 65 20 data fullname
c260: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
c270: 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 ame "data" (conc
c280: 20 74 65 73 74 2d 69 64 29 20 22 74 6e 61 6d 65 test-id) "tname
c290: 22 20 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 " )....
c2a0: 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 ;; (mutils:hier
c2b0: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 hash-set! data
c2c0: 74 65 73 74 6e 61 6d 65 20 20 20 74 61 72 67 65 testname targe
c2d0: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 tstr runname "da
c2e0: 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 ta" (conc test-i
c2f0: 64 29 20 22 74 65 73 74 6e 61 6d 65 22 20 20 29 d) "testname" )
c300: 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 .... ;; (mu
c310: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
c320: 74 21 20 64 61 74 61 20 20 69 74 65 6d 70 61 74 t! data itempat
c330: 68 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 h targetstr ru
c340: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
c350: 6e 63 20 74 65 73 74 2d 69 64 29 20 22 69 74 65 nc test-id) "ite
c360: 6d 70 61 74 68 22 20 20 29 0a 09 09 09 20 20 20 mpath" )....
c370: 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 ;; (mutils:hi
c380: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
c390: 20 20 63 6f 6d 6d 65 6e 74 20 20 20 20 74 61 72 comment tar
c3a0: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
c3b0: 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 data" (conc test
c3c0: 2d 69 64 29 20 22 63 6f 6d 6d 65 6e 74 22 20 20 -id) "comment"
c3d0: 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 ).... ;; (
c3e0: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
c3f0: 73 65 74 21 20 64 61 74 61 20 20 74 73 74 61 74 set! data tstat
c400: 65 20 20 20 20 20 74 61 72 67 65 74 73 74 72 20 e targetstr
c410: 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 runname "data" (
c420: 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 73 conc test-id) "s
c430: 74 61 74 65 22 20 20 20 20 20 29 0a 09 09 09 20 tate" )....
c440: 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a ;; (mutils:
c450: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
c460: 74 61 20 20 74 73 74 61 74 75 73 20 20 20 20 74 ta tstatus t
c470: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
c480: 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 "data" (conc te
c490: 73 74 2d 69 64 29 20 22 73 74 61 74 75 73 22 20 st-id) "status"
c4a0: 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 ).... ;;
c4b0: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
c4c0: 68 2d 73 65 74 21 20 64 61 74 61 20 20 72 75 6e h-set! data run
c4d0: 64 69 72 20 20 20 20 20 74 61 72 67 65 74 73 74 dir targetst
c4e0: 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 r runname "data"
c4f0: 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 (conc test-id)
c500: 22 72 75 6e 64 69 72 22 20 20 20 20 29 0a 09 09 "rundir" )...
c510: 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c . ;; (mutil
c520: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
c530: 64 61 74 61 20 20 66 69 6e 61 6c 5f 6c 6f 67 66 data final_logf
c540: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
c550: 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 me "data" (conc
c560: 74 65 73 74 2d 69 64 29 20 22 66 69 6e 61 6c 5f test-id) "final_
c570: 6c 6f 67 66 22 29 0a 09 09 09 20 20 20 20 20 3b logf").... ;
c580: 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ; (mutils:hierh
c590: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 72 ash-set! data r
c5a0: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 61 72 67 un_duration targ
c5b0: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 etstr runname "d
c5c0: 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d ata" (conc test-
c5d0: 69 64 29 20 22 72 75 6e 5f 64 75 72 61 74 69 6f id) "run_duratio
c5e0: 6e 22 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 n").... ;;
c5f0: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
c600: 2d 73 65 74 21 20 64 61 74 61 20 20 65 76 65 6e -set! data even
c610: 74 2d 74 69 6d 65 20 74 61 72 67 65 74 73 74 72 t-time targetstr
c620: 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 runname "data"
c630: 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 (conc test-id) "
c640: 65 76 65 6e 74 5f 74 69 6d 65 22 29 0a 09 09 09 event_time")....
c650: 20 20 20 20 20 3b 3b 20 20 3b 3b 20 61 64 64 20 ;; ;; add
c660: 6c 61 73 74 20 65 6e 74 72 79 20 74 77 69 63 65 last entry twice
c670: 20 2d 20 73 65 65 6d 73 20 74 6f 20 62 65 20 61 - seems to be a
c680: 20 62 75 67 20 69 6e 20 68 69 65 72 68 61 73 68 bug in hierhash
c690: 3f 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d ?.... ;; (m
c6a0: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
c6b0: 65 74 21 20 64 61 74 61 20 20 65 76 65 6e 74 2d et! data event-
c6c0: 74 69 6d 65 20 74 61 72 67 65 74 73 74 72 20 72 time targetstr r
c6d0: 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 unname "data" (c
c6e0: 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 65 76 onc test-id) "ev
c6f0: 65 6e 74 5f 74 69 6d 65 22 29 0a 09 09 09 20 20 ent_time")....
c700: 20 20 20 3b 3b 20 20 29 0a 09 09 09 20 20 20 20 ;; )....
c710: 20 28 65 6c 73 65 0a 09 09 09 20 20 20 20 20 20 (else....
c720: 28 69 66 20 28 61 6e 64 20 74 73 74 61 74 65 20 (if (and tstate
c730: 74 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 tstatus event-ti
c740: 6d 65 29 0a 09 09 09 09 20 20 28 66 6f 72 6d 61 me)..... (forma
c750: 74 20 23 74 0a 09 09 09 09 09 20 20 22 20 20 54 t #t...... " T
c760: 65 73 74 3a 20 7e 32 35 61 20 53 74 61 74 65 3a est: ~25a State:
c770: 20 7e 31 35 61 20 53 74 61 74 75 73 3a 20 7e 31 ~15a Status: ~1
c780: 35 61 20 52 75 6e 74 69 6d 65 3a 20 7e 35 40 61 5a Runtime: ~5@a
c790: 73 20 54 69 6d 65 3a 20 7e 32 32 61 20 48 6f 73 s Time: ~22a Hos
c7a0: 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 09 09 09 t: ~10a\n"......
c7b0: 20 20 28 69 66 20 66 75 6c 6c 6e 61 6d 65 20 66 (if fullname f
c7c0: 75 6c 6c 6e 61 6d 65 20 22 22 29 0a 09 09 09 09 ullname "").....
c7d0: 09 20 20 28 69 66 20 74 73 74 61 74 65 20 20 20 . (if tstate
c7e0: 74 73 74 61 74 65 20 20 20 22 22 29 0a 09 09 09 tstate "")....
c7f0: 09 09 20 20 28 69 66 20 74 73 74 61 74 75 73 20 .. (if tstatus
c800: 20 74 73 74 61 74 75 73 20 20 22 22 29 0a 09 09 tstatus "")...
c810: 09 09 09 20 20 28 67 65 74 2d 76 61 6c 75 65 2d ... (get-value-
c820: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
c830: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
c840: 65 78 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e ex "run_duration
c850: 22 29 3b 3b 28 69 66 20 74 65 73 74 20 20 20 20 ");;(if test
c860: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru
c870: 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 29 n_duration test)
c880: 20 22 22 29 0a 09 09 09 09 09 20 20 28 69 66 20 "")...... (if
c890: 65 76 65 6e 74 2d 74 69 6d 65 20 65 76 65 6e 74 event-time event
c8a0: 2d 74 69 6d 65 20 22 22 29 0a 09 09 09 09 09 20 -time "")......
c8b0: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
c8c0: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
c8d0: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
c8e0: 68 6f 73 74 22 29 29 20 3b 3b 28 69 66 20 74 65 host")) ;;(if te
c8f0: 73 74 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d st (db:test-get-
c900: 68 6f 73 74 20 74 65 73 74 29 29 20 22 22 29 0a host test)) "").
c910: 09 09 09 09 20 20 28 70 72 69 6e 74 20 22 20 20 .... (print "
c920: 54 65 73 74 3a 20 22 20 66 75 6c 6c 6e 61 6d 65 Test: " fullname
c930: 0a 09 09 09 09 09 20 28 69 66 20 74 73 74 61 74 ...... (if tstat
c940: 65 20 20 28 63 6f 6e 63 20 22 20 53 74 61 74 65 e (conc " State
c950: 3a 20 22 20 20 74 73 74 61 74 65 29 20 20 22 22 : " tstate) ""
c960: 29 0a 09 09 09 09 09 20 28 69 66 20 74 73 74 61 )...... (if tsta
c970: 74 75 73 20 28 63 6f 6e 63 20 22 20 53 74 61 74 tus (conc " Stat
c980: 75 73 3a 20 22 20 74 73 74 61 74 75 73 29 20 22 us: " tstatus) "
c990: 22 29 0a 09 09 09 09 09 20 28 69 66 20 28 67 65 ")...... (if (ge
c9a0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
c9b0: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
c9c0: 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 5f ield-index "run_
c9d0: 64 75 72 61 74 69 6f 6e 22 29 0a 09 09 09 09 09 duration")......
c9e0: 20 20 20 20 20 28 63 6f 6e 63 20 22 20 52 75 6e (conc " Run
c9f0: 74 69 6d 65 3a 20 22 20 28 67 65 74 2d 76 61 6c time: " (get-val
ca00: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
ca10: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
ca20: 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 61 74 index "run_durat
ca30: 69 6f 6e 22 29 29 0a 09 09 09 09 09 20 20 20 20 ion"))......
ca40: 20 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 65 "")...... (if e
ca50: 76 65 6e 74 2d 74 69 6d 65 20 28 63 6f 6e 63 20 vent-time (conc
ca60: 22 20 54 69 6d 65 3a 20 22 20 65 76 65 6e 74 2d " Time: " event-
ca70: 74 69 6d 65 29 20 22 22 29 0a 09 09 09 09 09 20 time) "")......
ca80: 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 (if (get-value-b
ca90: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
caa0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
cab0: 78 20 22 68 6f 73 74 22 29 0a 09 09 09 09 09 20 x "host")......
cac0: 20 20 20 20 28 63 6f 6e 63 20 22 20 48 6f 73 74 (conc " Host
cad0: 3a 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 : " (get-value-b
cae0: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
caf0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
cb00: 78 20 22 68 6f 73 74 22 29 29 0a 09 09 09 09 09 x "host"))......
cb10: 20 20 20 20 20 22 22 29 29 29 0a 09 09 09 20 20 "")))....
cb20: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 (if (not (or
cb30: 20 28 65 71 75 61 6c 3f 20 28 67 65 74 2d 76 61 (equal? (get-va
cb40: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
cb50: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
cb60: 2d 69 6e 64 65 78 20 22 73 74 61 74 75 73 22 29 -index "status")
cb70: 20 22 50 41 53 53 22 29 0a 09 09 09 09 09 20 20 "PASS")......
cb80: 20 28 65 71 75 61 6c 3f 20 28 67 65 74 2d 76 61 (equal? (get-va
cb90: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
cba0: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
cbb0: 2d 69 6e 64 65 78 20 22 73 74 61 74 75 73 22 29 -index "status")
cbc0: 20 22 57 41 52 4e 22 29 0a 09 09 09 09 09 20 20 "WARN")......
cbd0: 20 28 65 71 75 61 6c 3f 20 28 67 65 74 2d 76 61 (equal? (get-va
cbe0: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
cbf0: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
cc00: 2d 69 6e 64 65 78 20 22 73 74 61 74 65 22 29 20 -index "state")
cc10: 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 29 "NOT_STARTED"))
cc20: 29 0a 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 )..... (begin..
cc30: 09 09 09 20 20 20 20 28 70 72 69 6e 74 20 20 20 ... (print
cc40: 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 (if (get-value-b
cc50: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
cc60: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
cc70: 78 20 22 63 70 75 6c 6f 61 64 22 29 0a 09 09 09 x "cpuload")....
cc80: 09 09 09 20 28 63 6f 6e 63 20 22 20 20 20 20 20 ... (conc "
cc90: 20 20 20 20 63 70 75 6c 6f 61 64 3a 20 20 22 20 cpuload: "
cca0: 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d (get-value-by-
ccb0: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
ccc0: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
ccd0: 22 63 70 75 6c 6f 61 64 22 29 29 0a 09 09 09 09 "cpuload")).....
cce0: 09 09 20 22 22 29 20 3b 3b 20 28 64 62 3a 74 65 .. "") ;; (db:te
ccf0: 73 74 2d 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 st-get-cpuload t
cd00: 65 73 74 29 0a 09 09 09 09 09 20 20 20 20 20 28 est)...... (
cd10: 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 if (get-value-by
cd20: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
cd30: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
cd40: 20 22 64 69 73 6b 66 72 65 65 22 29 0a 09 09 09 "diskfree")....
cd50: 09 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 20 20 ... (conc "\n
cd60: 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 3a 20 diskfree:
cd70: 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d " (get-value-by-
cd80: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
cd90: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
cda0: 22 64 69 73 6b 66 72 65 65 22 29 29 20 3b 3b 20 "diskfree")) ;;
cdb0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 64 69 73 (db:test-get-dis
cdc0: 6b 66 72 65 65 20 74 65 73 74 29 0a 09 09 09 09 kfree test).....
cdd0: 09 09 20 22 22 29 0a 09 09 09 09 09 20 20 20 20 .. "")......
cde0: 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d (if (get-value-
cdf0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
ce00: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
ce10: 65 78 20 22 75 6e 61 6d 65 22 29 0a 09 09 09 09 ex "uname").....
ce20: 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 20 20 20 .. (conc "\n
ce30: 20 20 20 20 20 75 6e 61 6d 65 3a 20 20 20 20 22 uname: "
ce40: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
ce50: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
ce60: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
ce70: 75 6e 61 6d 65 22 29 29 20 3b 3b 20 28 64 62 3a uname")) ;; (db:
ce80: 74 65 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 74 test-get-uname t
ce90: 65 73 74 29 0a 09 09 09 09 09 09 20 22 22 29 0a est)....... "").
cea0: 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 67 ..... (if (g
ceb0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
cec0: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
ced0: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e field-index "run
cee0: 64 69 72 22 29 0a 09 09 09 09 09 09 20 28 63 6f dir")....... (co
cef0: 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 20 20 72 nc "\n r
cf00: 75 6e 64 69 72 3a 20 20 20 22 20 28 67 65 74 2d undir: " (get-
cf10: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
cf20: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
cf30: 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 64 69 72 ld-index "rundir
cf40: 22 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d ")) ;; (db:test-
cf50: 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 get-rundir test)
cf60: 0a 09 09 09 09 09 09 20 22 22 29 0a 3b 3b 09 09 ....... "").;;..
cf70: 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 ... "\n
cf80: 20 20 20 20 72 75 6e 64 69 72 3a 20 20 20 22 20 rundir: "
cf90: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
cfa0: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
cfb0: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 22 t-field-index ""
cfc0: 29 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 67 ) ;; (sdb:qry 'g
cfd0: 65 74 73 74 72 20 3b 3b 20 28 66 69 6c 65 64 62 etstr ;; (filedb
cfe0: 3a 67 65 74 2d 70 61 74 68 20 2a 66 64 62 2a 20 :get-path *fdb*
cff0: 0a 3b 3b 20 09 09 09 09 09 20 20 20 20 20 28 64 .;; ..... (d
d000: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 b:test-get-rundi
d010: 72 20 74 65 73 74 29 20 3b 3b 20 29 0a 09 09 09 r test) ;; )....
d020: 09 09 20 20 20 20 20 29 0a 09 09 09 09 20 20 20 .. ).....
d030: 20 3b 3b 20 45 61 63 68 20 74 65 73 74 0a 09 09 ;; Each test...
d040: 09 09 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 .. ;; DO NOT
d050: 72 65 6d 6f 74 65 20 72 75 6e 0a 09 09 09 09 20 remote run.....
d060: 20 20 20 28 6c 65 74 20 28 28 73 74 65 70 73 20 (let ((steps
d070: 28 64 62 3a 64 69 73 70 61 74 63 68 2d 71 75 65 (db:dispatch-que
d080: 72 79 20 61 63 63 65 73 73 2d 6d 6f 64 65 20 72 ry access-mode r
d090: 6d 74 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 mt:get-steps-for
d0a0: 2d 74 65 73 74 20 64 62 3a 67 65 74 2d 73 74 65 -test db:get-ste
d0b0: 70 73 2d 66 6f 72 2d 74 65 73 74 20 72 75 6e 2d ps-for-test run-
d0c0: 69 64 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d id (db:test-get-
d0d0: 69 64 20 74 65 73 74 29 29 29 29 20 3b 3b 20 28 id test)))) ;; (
d0e0: 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 db:get-steps-for
d0f0: 2d 74 65 73 74 20 64 62 73 74 72 75 63 74 20 72 -test dbstruct r
d100: 75 6e 2d 69 64 20 28 64 62 3a 74 65 73 74 2d 67 un-id (db:test-g
d110: 65 74 2d 69 64 20 74 65 73 74 29 29 29 29 0a 09 et-id test))))..
d120: 09 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 ... (for-ea
d130: 63 68 20 0a 09 09 09 09 20 20 20 20 20 20 20 28 ch ..... (
d140: 6c 61 6d 62 64 61 20 28 73 74 65 70 29 0a 09 09 lambda (step)...
d150: 09 09 09 20 28 66 6f 72 6d 61 74 20 23 74 20 0a ... (format #t .
d160: 09 09 09 09 09 09 20 22 20 20 20 20 53 74 65 70 ...... " Step
d170: 3a 20 7e 32 30 61 20 53 74 61 74 65 3a 20 7e 31 : ~20a State: ~1
d180: 30 61 20 53 74 61 74 75 73 3a 20 7e 31 30 61 20 0a Status: ~10a
d190: 54 69 6d 65 20 7e 32 32 61 5c 6e 22 0a 09 09 09 Time ~22a\n"....
d1a0: 09 09 09 20 28 74 64 62 3a 73 74 65 70 2d 67 65 ... (tdb:step-ge
d1b0: 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 70 29 t-stepname step)
d1c0: 0a 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 ....... (tdb:ste
d1d0: 70 2d 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 p-get-state step
d1e0: 29 0a 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 )....... (tdb:st
d1f0: 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 ep-get-status st
d200: 65 70 29 0a 09 09 09 09 09 09 20 28 74 64 62 3a ep)....... (tdb:
d210: 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
d220: 69 6d 65 20 73 74 65 70 29 29 29 0a 09 09 09 09 ime step))).....
d230: 20 20 20 20 20 20 20 73 74 65 70 73 29 29 29 29 steps))))
d240: 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 28 69 )))))... (i
d250: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
d260: 22 2d 73 6f 72 74 22 29 0a 09 09 09 20 20 28 73 "-sort").... (s
d270: 6f 72 74 20 74 65 73 74 73 0a 09 09 09 09 28 6c ort tests.....(l
d280: 61 6d 62 64 61 20 28 61 2d 74 65 73 74 20 62 2d ambda (a-test b-
d290: 74 65 73 74 29 0a 09 09 09 09 20 20 28 6c 65 74 test)..... (let
d2a0: 2a 20 28 28 6b 65 79 20 20 20 20 28 61 72 67 73 * ((key (args
d2b0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f 72 74 22 :get-arg "-sort"
d2c0: 29 29 0a 09 09 09 09 09 20 28 66 69 72 73 74 20 ))...... (first
d2d0: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
d2e0: 69 65 6c 64 6e 61 6d 65 20 61 2d 74 65 73 74 20 ieldname a-test
d2f0: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
d300: 20 6b 65 79 29 29 0a 09 09 09 09 09 20 28 73 65 key))...... (se
d310: 63 6f 6e 64 20 28 67 65 74 2d 76 61 6c 75 65 2d cond (get-value-
d320: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 62 2d 74 by-fieldname b-t
d330: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
d340: 6e 64 65 78 20 6b 65 79 29 29 29 0a 09 09 09 09 ndex key))).....
d350: 20 20 20 20 28 28 63 6f 6e 64 20 0a 09 09 09 09 ((cond .....
d360: 20 20 20 20 20 20 28 28 61 6e 64 20 28 6e 75 6d ((and (num
d370: 62 65 72 3f 20 66 69 72 73 74 29 28 6e 75 6d 62 ber? first)(numb
d380: 65 72 3f 20 73 65 63 6f 6e 64 29 29 20 3c 29 0a er? second)) <).
d390: 09 09 09 09 20 20 20 20 20 20 28 28 61 6e 64 20 .... ((and
d3a0: 28 73 74 72 69 6e 67 3f 20 66 69 72 73 74 29 28 (string? first)(
d3b0: 73 74 72 69 6e 67 3f 20 73 65 63 6f 6e 64 29 29 string? second))
d3c0: 20 73 74 72 69 6e 67 3c 3d 3f 29 0a 09 09 09 09 string<=?).....
d3d0: 20 20 20 20 20 20 28 65 6c 73 65 20 65 71 75 61 (else equa
d3e0: 6c 3f 29 29 0a 09 09 09 09 20 20 20 20 20 66 69 l?))..... fi
d3f0: 72 73 74 20 73 65 63 6f 6e 64 29 29 29 29 0a 09 rst second))))..
d400: 09 09 20 20 74 65 73 74 73 29 29 29 29 29 29 0a .. tests)))))).
d410: 09 20 20 20 72 75 6e 73 29 0a 09 20 20 28 69 66 . runs).. (if
d420: 20 28 65 71 3f 20 64 6d 6f 64 65 20 27 6a 73 6f (eq? dmode 'jso
d430: 6e 29 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 n)(json-write da
d440: 74 61 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 ta)).. (let* ((
d450: 6d 65 74 61 64 61 74 2d 66 69 65 6c 64 73 20 28 metadat-fields (
d460: 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 delete-duplicate
d470: 73 0a 09 09 09 09 20 20 28 61 70 70 65 6e 64 20 s..... (append
d480: 6b 65 79 73 20 27 28 20 22 72 75 6e 6e 61 6d 65 keys '( "runname
d490: 22 20 22 74 69 6d 65 22 20 22 6f 77 6e 65 72 22 " "time" "owner"
d4a0: 20 22 70 61 73 73 5f 63 6f 75 6e 74 22 20 22 66 "pass_count" "f
d4b0: 61 69 6c 5f 63 6f 75 6e 74 22 20 22 73 74 61 74 ail_count" "stat
d4c0: 65 22 20 22 73 74 61 74 75 73 22 20 22 63 6f 6d e" "status" "com
d4d0: 6d 65 6e 74 22 20 22 69 64 22 29 29 29 29 0a 09 ment" "id"))))..
d4e0: 09 20 28 72 75 6e 2d 66 69 65 6c 64 73 20 20 20 . (run-fields
d4f0: 20 27 28 0a 09 09 09 09 20 20 22 74 65 73 74 6e '(..... "testn
d500: 61 6d 65 22 0a 09 09 09 09 20 20 22 69 74 65 6d ame"..... "item
d510: 5f 70 61 74 68 22 0a 09 09 09 09 20 20 22 73 74 _path"..... "st
d520: 61 74 65 22 0a 09 09 09 09 20 20 22 73 74 61 74 ate"..... "stat
d530: 75 73 22 0a 09 09 09 09 20 20 22 63 6f 6d 6d 65 us"..... "comme
d540: 6e 74 22 0a 09 09 09 09 20 20 22 65 76 65 6e 74 nt"..... "event
d550: 5f 74 69 6d 65 22 0a 09 09 09 09 20 20 22 68 6f _time"..... "ho
d560: 73 74 22 0a 09 09 09 09 20 20 22 72 75 6e 5f 69 st"..... "run_i
d570: 64 22 0a 09 09 09 09 20 20 22 72 75 6e 5f 64 75 d"..... "run_du
d580: 72 61 74 69 6f 6e 22 0a 09 09 09 09 20 20 22 61 ration"..... "a
d590: 74 74 65 6d 70 74 6e 75 6d 22 0a 09 09 09 09 20 ttemptnum".....
d5a0: 20 22 69 64 22 0a 09 09 09 09 20 20 22 61 72 63 "id"..... "arc
d5b0: 68 69 76 65 64 22 0a 09 09 09 09 20 20 22 64 69 hived"..... "di
d5c0: 73 6b 66 72 65 65 22 0a 09 09 09 09 20 20 22 63 skfree"..... "c
d5d0: 70 75 6c 6f 61 64 22 0a 09 09 09 09 20 20 22 66 puload"..... "f
d5e0: 69 6e 61 6c 5f 6c 6f 67 66 22 0a 09 09 09 09 20 inal_logf".....
d5f0: 20 22 73 68 6f 72 74 64 69 72 22 0a 09 09 09 09 "shortdir".....
d600: 20 20 22 72 75 6e 64 69 72 22 0a 09 09 09 09 20 "rundir".....
d610: 20 22 75 6e 61 6d 65 22 0a 09 09 09 09 20 20 29 "uname"..... )
d620: 0a 09 09 09 09 29 0a 09 09 20 28 6e 65 77 64 61 .....)... (newda
d630: 74 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d t (comm
d640: 6f 6e 3a 74 6f 2d 61 6c 69 73 74 20 64 61 74 61 on:to-alist data
d650: 29 29 0a 09 09 20 28 61 6c 6c 72 75 6e 64 61 74 ))... (allrundat
d660: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null
d670: 3f 20 6e 65 77 64 61 74 29 0a 09 09 09 09 20 20 ? newdat).....
d680: 20 20 20 20 27 28 29 0a 09 09 09 09 20 20 20 20 '().....
d690: 20 20 28 63 61 72 20 28 6d 61 70 20 63 64 72 20 (car (map cdr
d6a0: 6e 65 77 64 61 74 29 29 29 29 20 3b 3b 20 28 63 newdat)))) ;; (c
d6b0: 61 72 20 28 6d 61 70 20 63 64 72 20 28 63 61 72 ar (map cdr (car
d6c0: 20 28 6d 61 70 20 63 64 72 20 6e 65 77 64 61 74 (map cdr newdat
d6d0: 29 29 29 29 29 0a 09 09 20 28 72 75 6e 73 20 20 )))))... (runs
d6e0: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 65 6e (appen
d6f0: 64 0a 09 09 09 09 20 20 20 28 6c 69 73 74 20 22 d..... (list "
d700: 72 75 6e 73 22 20 3b 3b 20 73 68 65 65 74 6e 61 runs" ;; sheetna
d710: 6d 65 0a 09 09 09 09 09 20 6d 65 74 61 64 61 74 me...... metadat
d720: 2d 66 69 65 6c 64 73 29 0a 09 09 09 09 20 20 20 -fields).....
d730: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 75 (map (lambda (ru
d740: 6e 29 0a 09 09 09 09 09 20 20 3b 3b 20 28 70 72 n)...... ;; (pr
d750: 69 6e 74 20 22 72 75 6e 3a 20 22 20 72 75 6e 29 int "run: " run)
d760: 0a 09 09 09 09 09 20 20 28 6c 65 74 2a 20 28 28 ...... (let* ((
d770: 72 75 6e 6e 61 6d 65 20 28 63 61 72 20 72 75 6e runname (car run
d780: 29 29 0a 09 09 09 09 09 09 20 28 72 75 6e 64 61 ))....... (runda
d790: 74 20 20 28 63 64 72 20 72 75 6e 29 29 0a 09 09 t (cdr run))...
d7a0: 09 09 09 09 20 28 6d 65 74 61 64 61 74 20 28 6c .... (metadat (l
d7b0: 65 74 20 28 28 74 6d 70 20 28 61 73 73 6f 63 20 et ((tmp (assoc
d7c0: 22 6d 65 74 61 22 20 72 75 6e 64 61 74 29 29 29 "meta" rundat)))
d7d0: 0a 09 09 09 09 09 09 09 20 20 20 20 28 69 66 20 ........ (if
d7e0: 74 6d 70 20 28 63 64 72 20 74 6d 70 29 20 23 66 tmp (cdr tmp) #f
d7f0: 29 29 29 29 0a 09 09 09 09 09 20 20 20 20 3b 3b ))))...... ;;
d800: 20 28 70 72 69 6e 74 20 22 72 75 6e 6e 61 6d 65 (print "runname
d810: 3a 20 22 20 72 75 6e 6e 61 6d 65 20 22 5c 6e 5c : " runname "\n\
d820: 6e 72 75 6e 64 61 74 3a 20 22 20 29 28 70 70 20 nrundat: " )(pp
d830: 72 75 6e 64 61 74 29 28 70 72 69 6e 74 20 22 5c rundat)(print "\
d840: 6e 5c 6e 6d 65 74 61 64 61 74 3a 20 22 29 28 70 n\nmetadat: ")(p
d850: 70 20 6d 65 74 61 64 61 74 29 0a 09 09 09 09 09 p metadat)......
d860: 20 20 20 20 28 69 66 20 6d 65 74 61 64 61 74 0a (if metadat.
d870: 09 09 09 09 09 09 28 6d 61 70 20 28 6c 61 6d 62 ......(map (lamb
d880: 64 61 20 28 66 69 65 6c 64 29 0a 09 09 09 09 09 da (field)......
d890: 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 . (let ((t
d8a0: 6d 70 20 28 61 73 73 6f 63 20 66 69 65 6c 64 20 mp (assoc field
d8b0: 6d 65 74 61 64 61 74 29 29 29 0a 09 09 09 09 09 metadat)))......
d8c0: 09 09 20 28 69 66 20 74 6d 70 20 28 63 64 72 20 .. (if tmp (cdr
d8d0: 74 6d 70 29 20 22 22 29 29 29 0a 09 09 09 09 09 tmp) "")))......
d8e0: 09 20 20 20 20 20 6d 65 74 61 64 61 74 2d 66 69 . metadat-fi
d8f0: 65 6c 64 73 29 0a 09 09 09 09 09 09 28 62 65 67 elds).......(beg
d900: 69 6e 0a 09 09 09 09 09 09 20 20 28 64 65 62 75 in....... (debu
d910: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
d920: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 lt-log-port* "WA
d930: 52 4e 49 4e 47 3a 20 6d 65 74 61 20 64 61 74 61 RNING: meta data
d940: 20 66 6f 72 20 72 75 6e 20 22 20 72 75 6e 6e 61 for run " runna
d950: 6d 65 20 22 20 6e 6f 74 20 66 6f 75 6e 64 22 29 me " not found")
d960: 0a 09 09 09 09 09 09 20 20 27 28 29 29 29 29 29 ....... '()))))
d970: 0a 09 09 09 09 09 61 6c 6c 72 75 6e 64 61 74 29 ......allrundat)
d980: 29 29 0a 09 09 20 3b 3b 20 27 28 20 28 20 22 74 ))... ;; '( ( "t
d990: 61 72 67 65 74 22 20 28 20 22 72 75 6e 6e 61 6d arget" ( "runnam
d9a0: 65 22 20 28 20 22 64 61 74 61 22 20 28 20 22 72 e" ( "data" ( "r
d9b0: 75 6e 69 64 22 20 28 20 22 69 64 20 2e 20 22 33 unid" ( "id . "3
d9c0: 37 22 20 29 20 28 20 2e 2e 2e 20 29 29 29 29 0a 7" ) ( ... )))).
d9d0: 09 09 20 28 72 75 6e 2d 70 61 67 65 73 20 20 20 .. (run-pages
d9e0: 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda
d9f0: 28 74 61 72 67 64 61 74 29 0a 09 09 09 09 09 28 (targdat)......(
da00: 6c 65 74 2a 20 28 28 74 61 72 67 65 74 20 20 28 let* ((target (
da10: 63 61 72 20 74 61 72 67 64 61 74 29 29 0a 09 09 car targdat))...
da20: 09 09 09 20 20 20 20 20 20 20 28 72 75 6e 73 64 ... (runsd
da30: 61 74 20 28 63 64 72 20 74 61 72 67 64 61 74 29 at (cdr targdat)
da40: 29 29 0a 09 09 09 09 09 20 20 28 69 66 20 72 75 ))...... (if ru
da50: 6e 73 64 61 74 0a 09 09 09 09 09 20 20 20 20 20 nsdat......
da60: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 (map (lambda (r
da70: 75 6e 64 61 74 29 0a 09 09 09 09 09 09 20 20 20 undat).......
da80: 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 6e 61 6d (let* ((runnam
da90: 65 20 20 28 63 61 72 20 72 75 6e 64 61 74 29 29 e (car rundat))
daa0: 0a 09 09 09 09 09 09 09 20 20 20 20 28 72 75 6e ........ (run
dab0: 64 61 74 20 20 20 28 63 64 72 20 72 75 6e 64 61 dat (cdr runda
dac0: 74 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 t))........ (
dad0: 74 65 73 74 73 64 61 74 20 28 6c 65 74 20 28 28 testsdat (let ((
dae0: 74 6d 70 20 28 61 73 73 6f 63 20 22 64 61 74 61 tmp (assoc "data
daf0: 22 20 72 75 6e 64 61 74 29 29 29 0a 09 09 09 09 " rundat))).....
db00: 09 09 09 09 09 28 69 66 20 74 6d 70 20 28 63 64 .....(if tmp (cd
db10: 72 20 74 6d 70 29 20 23 66 29 29 29 29 0a 09 09 r tmp) #f))))...
db20: 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 74 .... (if t
db30: 65 73 74 73 64 61 74 0a 09 09 09 09 09 09 09 20 estsdat........
db40: 20 20 28 6c 65 74 20 28 28 74 65 73 74 73 20 28 (let ((tests (
db50: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 74 65 73 map (lambda (tes
db60: 74 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 t)..........
db70: 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d (let* ((test-
db80: 69 64 20 20 28 63 61 72 20 74 65 73 74 29 29 0a id (car test)).
db90: 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
dba0: 28 74 65 73 74 2d 64 61 74 20 28 63 64 72 20 74 (test-dat (cdr t
dbb0: 65 73 74 29 29 29 0a 09 09 09 09 09 09 09 09 09 est)))..........
dbc0: 09 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 . (map (lambda (
dbd0: 66 69 65 6c 64 29 0a 09 09 09 09 09 09 09 09 09 field)..........
dbe0: 09 09 28 6c 65 74 20 28 28 74 6d 70 20 28 61 73 ..(let ((tmp (as
dbf0: 73 6f 63 20 66 69 65 6c 64 20 74 65 73 74 2d 64 soc field test-d
dc00: 61 74 29 29 29 0a 09 09 09 09 09 09 09 09 09 09 at)))...........
dc10: 09 20 20 28 69 66 20 74 6d 70 20 28 63 64 72 20 . (if tmp (cdr
dc20: 74 6d 70 29 20 22 22 29 29 29 0a 09 09 09 09 09 tmp) "")))......
dc30: 09 09 09 09 09 20 20 20 20 20 20 72 75 6e 2d 66 ..... run-f
dc40: 69 65 6c 64 73 29 29 29 0a 09 09 09 09 09 09 09 ields)))........
dc50: 09 09 20 20 20 20 20 74 65 73 74 73 64 61 74 29 .. testsdat)
dc60: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 3b ))........ ;
dc70: 3b 20 28 70 72 69 6e 74 20 22 54 61 72 67 65 74 ; (print "Target
dc80: 3a 20 22 20 74 61 72 67 65 74 20 22 2f 22 20 72 : " target "/" r
dc90: 75 6e 6e 61 6d 65 20 22 20 74 65 73 74 73 3a 22 unname " tests:"
dca0: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 3b 3b )........ ;;
dcb0: 20 28 70 70 20 74 65 73 74 73 29 0a 09 09 09 09 (pp tests).....
dcc0: 09 09 09 20 20 20 20 20 28 63 6f 6e 73 20 28 63 ... (cons (c
dcd0: 6f 6e 63 20 74 61 72 67 65 74 20 22 2f 22 20 72 onc target "/" r
dce0: 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 09 09 09 unname).........
dcf0: 20 20 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 28 (cons (list (
dd00: 63 6f 6e 63 20 74 61 72 67 65 74 20 22 2f 22 20 conc target "/"
dd10: 72 75 6e 6e 61 6d 65 29 29 0a 09 09 09 09 09 09 runname)).......
dd20: 09 09 09 20 28 63 6f 6e 73 20 27 28 29 0a 09 09 ... (cons '()...
dd30: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 ....... (c
dd40: 6f 6e 73 20 72 75 6e 2d 66 69 65 6c 64 73 20 74 ons run-fields t
dd50: 65 73 74 73 29 29 29 29 29 0a 09 09 09 09 09 09 ests))))).......
dd60: 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 . (begin......
dd70: 09 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 .. (debug:pr
dd80: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
dd90: 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e og-port* "WARNIN
dda0: 47 3a 20 72 75 6e 20 22 20 74 61 72 67 65 74 20 G: run " target
ddb0: 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 20 61 70 "/" runname " ap
ddc0: 70 65 61 72 73 20 74 6f 20 68 61 76 65 20 6e 6f pears to have no
ddd0: 20 64 61 74 61 22 29 0a 09 09 09 09 09 09 09 20 data")........
dde0: 20 20 20 20 3b 3b 20 28 70 70 20 72 75 6e 64 61 ;; (pp runda
ddf0: 74 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 27 t)........ '
de00: 28 29 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 ())))).......
de10: 72 75 6e 73 64 61 74 29 0a 09 09 09 09 09 20 20 runsdat)......
de20: 20 20 20 20 27 28 29 29 29 29 0a 09 09 09 09 20 '()))).....
de30: 20 20 20 20 20 6e 65 77 64 61 74 29 29 20 3b 3b newdat)) ;;
de40: 20 77 65 20 75 73 65 20 6e 65 77 64 61 74 20 74 we use newdat t
de50: 6f 20 67 65 74 20 74 61 72 67 65 74 0a 09 09 20 o get target...
de60: 28 73 68 65 65 74 73 20 20 20 20 20 20 20 20 20 (sheets
de70: 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 (filter (lambda
de80: 28 78 29 0a 09 09 09 09 09 20 20 20 28 6e 6f 74 (x)...... (not
de90: 20 28 6e 75 6c 6c 3f 20 78 29 29 29 0a 09 09 09 (null? x)))....
dea0: 09 09 20 28 63 6f 6e 73 20 72 75 6e 73 20 28 6d .. (cons runs (m
deb0: 61 70 20 63 61 72 20 72 75 6e 2d 70 61 67 65 73 ap car run-pages
dec0: 29 29 29 29 29 0a 09 20 20 20 20 3b 3b 20 28 70 ))))).. ;; (p
ded0: 72 69 6e 74 20 22 61 6c 6c 72 75 6e 64 61 74 3a rint "allrundat:
dee0: 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 70 20 61 ").. ;; (pp a
def0: 6c 6c 72 75 6e 64 61 74 29 0a 09 20 20 20 20 3b llrundat).. ;
df00: 3b 20 28 70 72 69 6e 74 20 22 72 75 6e 73 3a 22 ; (print "runs:"
df10: 29 0a 09 20 20 20 20 3b 3b 20 28 70 70 20 72 75 ).. ;; (pp ru
df20: 6e 73 29 0a 09 20 20 20 20 3b 28 70 72 69 6e 74 ns).. ;(print
df30: 20 22 73 68 65 65 74 73 3a 20 22 29 0a 09 20 20 "sheets: ")..
df40: 20 20 3b 3b 20 28 70 70 20 73 68 65 65 74 73 29 ;; (pp sheets)
df50: 0a 09 20 20 20 20 28 69 66 20 28 65 71 3f 20 64 .. (if (eq? d
df60: 6d 6f 64 65 20 27 6f 64 73 29 0a 09 09 28 6c 65 mode 'ods)...(le
df70: 74 2a 20 28 28 74 65 6d 70 64 69 72 20 20 20 20 t* ((tempdir
df80: 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 28 63 (conc "/tmp/" (c
df90: 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 urrent-user-name
dfa0: 29 20 22 2f 22 20 28 72 61 6e 64 6f 6d 20 31 30 ) "/" (random 10
dfb0: 30 30 30 29 20 22 5f 22 20 28 63 75 72 72 65 6e 000) "_" (curren
dfc0: 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 29 0a t-process-id))).
dfd0: 09 09 20 20 20 20 20 20 20 28 6f 75 74 70 75 74 .. (output
dfe0: 66 69 6c 65 20 28 6f 72 20 28 61 72 67 73 3a 67 file (or (args:g
dff0: 65 74 2d 61 72 67 20 22 2d 6f 22 29 20 22 6f 75 et-arg "-o") "ou
e000: 74 2e 6f 64 73 22 29 29 0a 09 09 20 20 20 20 20 t.ods"))...
e010: 20 20 28 6f 75 66 20 20 20 20 20 20 20 20 28 69 (ouf (i
e020: 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 f (string-match
e030: 28 72 65 67 65 78 70 20 22 5e 5b 2f 7e 5d 2b 2e (regexp "^[/~]+.
e040: 2a 22 29 20 6f 75 74 70 75 74 66 69 6c 65 29 20 *") outputfile)
e050: 3b 3b 20 66 75 6c 6c 20 70 61 74 68 3f 0a 09 09 ;; full path?...
e060: 09 09 20 20 20 20 20 20 20 6f 75 74 70 75 74 66 .. outputf
e070: 69 6c 65 0a 09 09 09 09 20 20 20 20 20 20 20 28 ile..... (
e080: 62 65 67 69 6e 0a 09 09 09 09 09 20 28 64 65 62 begin...... (deb
e090: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
e0a0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 ult-log-port* "W
e0b0: 41 52 4e 49 4e 47 3a 20 70 61 74 68 20 67 69 76 ARNING: path giv
e0c0: 65 6e 2c 20 22 20 6f 75 74 70 75 74 66 69 6c 65 en, " outputfile
e0d0: 20 22 20 69 73 20 72 65 6c 61 74 69 76 65 2c 20 " is relative,
e0e0: 70 72 65 66 69 78 69 6e 67 20 77 69 74 68 20 63 prefixing with c
e0f0: 75 72 72 65 6e 74 20 64 69 72 65 63 74 6f 72 79 urrent directory
e100: 22 29 0a 09 09 09 09 09 20 28 63 6f 6e 63 20 28 ")...... (conc (
e110: 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 current-director
e120: 79 29 20 22 2f 22 20 6f 75 74 70 75 74 66 69 6c y) "/" outputfil
e130: 65 29 29 29 29 29 0a 09 09 20 20 28 63 72 65 61 e)))))... (crea
e140: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 6d te-directory tem
e150: 70 64 69 72 20 23 74 29 0a 09 09 20 20 28 6f 64 pdir #t)... (od
e160: 73 3a 6c 69 73 74 2d 3e 6f 64 73 20 74 65 6d 70 s:list->ods temp
e170: 64 69 72 20 6f 75 66 20 73 68 65 65 74 73 29 29 dir ouf sheets))
e180: 29 29 0a 09 20 20 3b 3b 20 28 73 79 73 74 65 6d )).. ;; (system
e190: 20 28 63 6f 6e 63 20 22 72 6d 20 2d 72 66 20 22 (conc "rm -rf "
e1a0: 20 74 65 6d 70 64 69 72 29 29 0a 09 20 20 28 73 tempdir)).. (s
e1b0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
e1c0: 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 20 44 6f g* #t))))..;; Do
e1d0: 6e 27 74 20 74 68 69 6e 6b 20 49 20 6e 65 65 64 n't think I need
e1e0: 20 74 68 69 73 2e 20 49 6e 63 6f 72 70 6f 72 61 this. Incorpora
e1f0: 74 65 64 20 69 6e 74 6f 20 2d 6c 69 73 74 2d 72 ted into -list-r
e200: 75 6e 73 20 69 6e 73 74 65 61 64 0a 3b 3b 0a 3b uns instead.;;.;
e210: 3b 20 28 69 66 20 28 61 6e 64 20 28 61 72 67 73 ; (if (and (args
e220: 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 :get-arg "-since
e230: 22 29 0a 3b 3b 20 09 20 28 6c 61 75 6e 63 68 3a ").;; . (launch:
e240: 73 65 74 75 70 29 29 0a 3b 3b 20 20 20 20 20 28 setup)).;; (
e250: 6c 65 74 2a 20 28 28 73 69 6e 63 65 2d 74 69 6d let* ((since-tim
e260: 65 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 e (string->numbe
e270: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
e280: 22 2d 73 69 6e 63 65 22 29 29 29 0a 3b 3b 20 09 "-since"))).;; .
e290: 20 20 20 28 72 75 6e 2d 69 64 73 20 20 20 20 28 (run-ids (
e2a0: 64 62 3a 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 db:get-changed-r
e2b0: 75 6e 2d 69 64 73 20 73 69 6e 63 65 2d 74 69 6d un-ids since-tim
e2c0: 65 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 3b 3b e))).;; ;;
e2d0: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d (rmt:get-tests-
e2e0: 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 for-runs-mindata
e2f0: 20 72 75 6e 2d 69 64 73 20 74 65 73 74 70 61 74 run-ids testpat
e300: 74 20 73 74 61 74 65 73 20 73 74 61 74 75 73 20 t states status
e310: 6e 6f 74 2d 69 6e 29 0a 3b 3b 20 20 20 20 20 20 not-in).;;
e320: 20 28 70 72 69 6e 74 20 28 73 6f 72 74 20 72 75 (print (sort ru
e330: 6e 2d 69 64 73 20 3c 29 29 0a 3b 3b 20 20 20 20 n-ids <)).;;
e340: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
e350: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 20 20 ething* #t))).
e360: 20 20 20 20 0a 20 20 20 20 20 20 0a 3b 3b 3d 3d . .;;==
e370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e3a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e3b0: 3d 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e ====.;; full run
e3c0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
e3d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e3e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e3f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 =========..;; ge
e410: 74 20 6c 6f 63 6b 20 69 6e 20 64 62 20 66 6f 72 t lock in db for
e420: 20 66 75 6c 6c 20 72 75 6e 20 66 6f 72 20 74 68 full run for th
e430: 69 73 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 is directory.;;
e440: 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 20 77 69 for all tests wi
e450: 74 68 20 64 65 70 73 0a 3b 3b 20 20 20 77 61 6c th deps.;; wal
e460: 6b 20 74 72 65 65 20 6f 66 20 74 65 73 74 73 20 k tree of tests
e470: 74 6f 20 66 69 6e 64 20 68 65 61 64 20 74 61 73 to find head tas
e480: 6b 73 0a 3b 3b 20 20 20 61 64 64 20 68 65 61 64 ks.;; add head
e490: 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 tasks to task q
e4a0: 75 65 75 65 0a 3b 3b 20 20 20 61 64 64 20 64 65 ueue.;; add de
e4b0: 70 65 6e 64 61 6e 74 20 74 61 73 6b 73 20 74 6f pendant tasks to
e4c0: 20 74 61 73 6b 20 71 75 65 75 65 20 0a 3b 3b 20 task queue .;;
e4d0: 20 20 61 64 64 20 72 65 6d 61 69 6e 69 6e 67 20 add remaining
e4e0: 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 tasks to task qu
e4f0: 65 75 65 0a 3b 3b 20 66 6f 72 20 65 61 63 68 20 eue.;; for each
e500: 74 61 73 6b 20 69 6e 20 74 61 73 6b 20 71 75 65 task in task que
e510: 75 65 0a 3b 3b 20 20 20 69 66 20 68 61 76 65 20 ue.;; if have
e520: 61 64 65 71 75 61 74 65 20 72 65 73 6f 75 72 63 adequate resourc
e530: 65 73 0a 3b 3b 20 20 20 20 20 6c 61 75 6e 63 68 es.;; launch
e540: 20 74 61 73 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a task.;; else.
e550: 3b 3b 20 20 20 20 20 70 75 74 20 74 61 73 6b 20 ;; put task
e560: 69 6e 20 64 65 66 65 72 72 65 64 20 71 75 65 75 in deferred queu
e570: 65 0a 3b 3b 20 69 66 20 73 74 69 6c 6c 20 6f 6b e.;; if still ok
e580: 20 74 6f 20 72 75 6e 20 74 61 73 6b 73 0a 3b 3b to run tasks.;;
e590: 20 20 20 70 72 6f 63 65 73 73 20 64 65 66 65 72 process defer
e5a0: 72 65 64 20 74 61 73 6b 73 20 70 65 72 20 61 62 red tasks per ab
e5b0: 6f 76 65 20 73 74 65 70 73 0a 0a 3b 3b 20 72 75 ove steps..;; ru
e5c0: 6e 20 61 6c 6c 20 74 65 73 74 73 20 61 72 65 20 n all tests are
e5d0: 61 72 65 20 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 are Not COMPLETE
e5e0: 44 20 61 6e 64 20 50 41 53 53 20 6f 72 20 43 48 D and PASS or CH
e5f0: 45 43 4b 0a 28 69 66 20 28 6f 72 20 28 61 72 67 ECK.(if (or (arg
e600: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 s:get-arg "-runa
e610: 6c 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d ll")..(args:get-
e620: 61 72 67 20 22 2d 72 75 6e 22 29 0a 09 28 61 72 arg "-run")..(ar
e630: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 72 gs:get-arg "-rer
e640: 75 6e 2d 63 6c 65 61 6e 22 29 0a 09 28 61 72 67 un-clean")..(arg
e650: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 72 75 s:get-arg "-reru
e660: 6e 2d 61 6c 6c 22 29 0a 09 28 61 72 67 73 3a 67 n-all")..(args:g
e670: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
e680: 73 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 s")). (genera
e690: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 l-run-call .
e6a0: 20 22 2d 72 75 6e 61 6c 6c 22 0a 20 20 20 20 20 "-runall".
e6b0: 22 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 22 0a "run all tests".
e6c0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 (lambda (ta
e6d0: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
e6e0: 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 s keyvals).
e6f0: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
e700: 61 72 67 20 22 2d 72 65 72 75 6e 2d 63 6c 65 61 arg "-rerun-clea
e710: 6e 22 29 20 3b 3b 20 66 69 72 73 74 20 73 65 74 n") ;; first set
e720: 20 73 74 61 74 65 73 2f 73 74 61 74 75 73 65 73 states/statuses
e730: 20 63 6f 72 72 65 63 74 0a 09 20 20 20 28 6c 65 correct.. (le
e740: 74 20 28 28 73 74 61 74 65 73 20 20 20 28 6f 72 t ((states (or
e750: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
e760: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 76 61 *configdat* "va
e770: 6c 69 64 76 61 6c 75 65 73 22 20 22 63 6c 65 61 lidvalues" "clea
e780: 6e 72 65 72 75 6e 2d 73 74 61 74 65 73 22 29 0a nrerun-states").
e790: 09 09 09 20 20 20 20 20 20 20 22 4b 49 4c 4c 52 ... "KILLR
e7a0: 45 51 2c 4b 49 4c 4c 45 44 2c 55 4e 4b 4e 4f 57 EQ,KILLED,UNKNOW
e7b0: 4e 2c 49 4e 43 4f 4d 50 4c 45 54 45 2c 53 54 55 N,INCOMPLETE,STU
e7c0: 43 4b 2c 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 CK,NOT_STARTED")
e7d0: 29 0a 09 09 20 28 73 74 61 74 75 73 65 73 20 28 )... (statuses (
e7e0: 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b or (configf:look
e7f0: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
e800: 76 61 6c 69 64 76 61 6c 75 65 73 22 20 22 63 6c validvalues" "cl
e810: 65 61 6e 72 65 72 75 6e 2d 73 74 61 74 75 73 65 eanrerun-statuse
e820: 73 22 29 0a 09 09 09 20 20 20 20 20 20 20 22 46 s").... "F
e830: 41 49 4c 2c 49 4e 43 4f 4d 50 4c 45 54 45 2c 41 AIL,INCOMPLETE,A
e840: 42 4f 52 54 2c 43 48 45 43 4b 22 29 29 29 0a 09 BORT,CHECK")))..
e850: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
e860: 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 2d 68 -set! args:arg-h
e870: 61 73 68 20 22 2d 70 72 65 63 6c 65 61 6e 22 20 ash "-preclean"
e880: 23 74 29 0a 09 20 20 20 20 20 28 72 75 6e 73 3a #t).. (runs:
e890: 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d operate-on 'set-
e8a0: 73 74 61 74 65 2d 73 74 61 74 75 73 0a 09 09 09 state-status....
e8b0: 20 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 target....
e8c0: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 (common:ar
e8d0: 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 gs-get-runname)
e8e0: 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 ;; (or (args:ge
e8f0: 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
e900: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
e910: 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 :runname"))....
e920: 20 20 20 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d "%" ;; (com
e930: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 mon:args-get-tes
e940: 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 tpatt #f) ;; (ar
e950: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
e960: 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 tpatt")....
e970: 20 73 74 61 74 65 3a 20 20 73 74 61 74 65 73 0a state: states.
e980: 09 09 09 20 20 20 20 20 20 3b 3b 20 73 74 61 74 ... ;; stat
e990: 75 73 3a 20 73 74 61 74 75 73 65 73 0a 09 09 09 us: statuses....
e9a0: 20 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d new-state-
e9b0: 73 74 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 status: "NOT_STA
e9c0: 52 54 45 44 2c 6e 2f 61 22 29 0a 09 20 20 20 20 RTED,n/a")..
e9d0: 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f (runs:operate-o
e9e0: 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 61 n 'set-state-sta
e9f0: 74 75 73 0a 09 09 09 20 20 20 20 20 20 74 61 72 tus.... tar
ea00: 67 65 74 0a 09 09 09 20 20 20 20 20 20 28 63 6f get.... (co
ea10: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 mmon:args-get-ru
ea20: 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 nname) ;; (or (
ea30: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
ea40: 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 unname")(args:ge
ea50: 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 t-arg ":runname"
ea60: 29 29 0a 09 09 09 20 20 20 20 20 20 22 25 22 20 )).... "%"
ea70: 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d ;; (common:args-
ea80: 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 get-testpatt #f)
ea90: 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ;; (args:get-ar
eaa0: 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 g "-testpatt")..
eab0: 09 09 20 20 20 20 20 20 3b 3b 20 73 74 61 74 65 .. ;; state
eac0: 3a 20 20 73 74 61 74 65 73 0a 09 09 09 20 20 20 : states....
ead0: 20 20 20 73 74 61 74 75 73 3a 20 73 74 61 74 75 status: statu
eae0: 73 65 73 0a 09 09 09 20 20 20 20 20 20 6e 65 77 ses.... new
eaf0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a 20 22 -state-status: "
eb00: 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 22 NOT_STARTED,n/a"
eb10: 29 29 29 0a 20 20 20 20 20 20 20 3b 3b 20 52 45 ))). ;; RE
eb20: 52 55 4e 20 41 4c 4c 0a 20 20 20 20 20 20 20 28 RUN ALL. (
eb30: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
eb40: 20 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 29 20 3b "-rerun-all") ;
eb50: 3b 20 66 69 72 73 74 20 73 65 74 20 73 74 61 74 ; first set stat
eb60: 65 73 2f 73 74 61 74 75 73 65 73 20 63 6f 72 72 es/statuses corr
eb70: 65 63 74 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 ect.. (begin..
eb80: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
eb90: 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 2d 68 -set! args:arg-h
eba0: 61 73 68 20 22 2d 70 72 65 63 6c 65 61 6e 22 20 ash "-preclean"
ebb0: 23 74 29 0a 09 20 20 20 20 20 28 72 75 6e 73 3a #t).. (runs:
ebc0: 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d operate-on 'set-
ebd0: 73 74 61 74 65 2d 73 74 61 74 75 73 0a 09 09 09 state-status....
ebe0: 20 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 target....
ebf0: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 (common:ar
ec00: 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 gs-get-runname)
ec10: 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 ;; (or (args:ge
ec20: 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
ec30: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
ec40: 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 :runname"))....
ec50: 20 20 20 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d "%" ;; (com
ec60: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 mon:args-get-tes
ec70: 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 tpatt #f) ;; (ar
ec80: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
ec90: 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 tpatt")....
eca0: 20 73 74 61 74 65 3a 20 20 23 66 0a 09 09 09 20 state: #f....
ecb0: 20 20 20 20 20 3b 3b 20 73 74 61 74 75 73 3a 20 ;; status:
ecc0: 73 74 61 74 75 73 65 73 0a 09 09 09 20 20 20 20 statuses....
ecd0: 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 new-state-stat
ece0: 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 us: "NOT_STARTED
ecf0: 2c 6e 2f 61 22 29 0a 09 20 20 20 20 20 28 72 75 ,n/a").. (ru
ed00: 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 ns:operate-on 's
ed10: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a et-state-status.
ed20: 09 09 09 20 20 20 20 20 20 74 61 72 67 65 74 0a ... target.
ed30: 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e ... (common
ed40: 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d :args-get-runnam
ed50: 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 e) ;; (or (args
ed60: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 :get-arg "-runna
ed70: 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 me")(args:get-ar
ed80: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g ":runname"))..
ed90: 09 09 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 .. "%" ;; (
eda0: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
edb0: 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 testpatt #f) ;;
edc0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
edd0: 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 testpatt")....
ede0: 20 20 20 20 3b 3b 20 73 74 61 74 65 3a 20 20 73 ;; state: s
edf0: 74 61 74 65 73 0a 09 09 09 20 20 20 20 20 20 73 tates.... s
ee00: 74 61 74 75 73 3a 20 23 66 0a 09 09 09 20 20 20 tatus: #f....
ee10: 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 new-state-sta
ee20: 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 tus: "NOT_STARTE
ee30: 44 2c 6e 2f 61 22 29 29 29 0a 20 20 20 20 20 20 D,n/a"))).
ee40: 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 (runs:run-tests
ee50: 20 74 61 72 67 65 74 0a 09 09 20 20 20 20 20 20 target...
ee60: 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 20 20 20 runname...
ee70: 20 20 23 66 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a #f ;; (common:
ee80: 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 args-get-testpat
ee90: 74 20 23 66 29 0a 09 09 20 20 20 20 20 20 20 3b t #f)... ;
eea0: 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d ; (or (args:get-
eeb0: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
eec0: 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 20 20 20 ... ;;
eed0: 20 22 25 22 29 0a 09 09 20 20 20 20 20 20 20 75 "%")... u
eee0: 73 65 72 0a 09 09 20 20 20 20 20 20 20 61 72 67 ser... arg
eef0: 73 3a 61 72 67 2d 68 61 73 68 29 29 29 29 0a 0a s:arg-hash))))..
ef00: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
ef10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ef20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ef30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ef40: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e 20 ========.;; run
ef50: 6f 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d one test.;;=====
ef60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ef70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ef80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ef90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
efa0: 3d 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 20 74 68 =..;; 1. find th
efb0: 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b e config file.;;
efc0: 20 32 2e 20 63 68 61 6e 67 65 20 74 6f 20 74 68 2. change to th
efd0: 65 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 79 e test directory
efe0: 0a 3b 3b 20 33 2e 20 75 70 64 61 74 65 20 74 68 .;; 3. update th
eff0: 65 20 64 62 20 77 69 74 68 20 22 74 65 73 74 20 e db with "test
f000: 73 74 61 72 74 65 64 22 20 73 74 61 74 75 73 2c started" status,
f010: 20 73 65 74 20 72 75 6e 6e 69 6e 67 20 68 6f 73 set running hos
f020: 74 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 73 73 20 t.;; 4. process
f030: 6c 61 75 6e 63 68 20 74 68 65 20 74 65 73 74 0a launch the test.
f040: 3b 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 6f 72 20 ;; - monitor
f050: 74 68 65 20 70 72 6f 63 65 73 73 2c 20 75 70 64 the process, upd
f060: 61 74 65 20 73 74 61 74 73 20 69 6e 20 74 68 65 ate stats in the
f070: 20 64 62 20 65 76 65 72 79 20 32 5e 6e 20 6d 69 db every 2^n mi
f080: 6e 75 74 65 73 0a 3b 3b 20 35 2e 20 61 73 20 74 nutes.;; 5. as t
f090: 68 65 20 74 65 73 74 20 70 72 6f 63 65 65 64 73 he test proceeds
f0a0: 20 69 6e 74 65 72 6e 61 6c 6c 79 20 69 74 20 63 internally it c
f0b0: 61 6c 6c 73 20 6d 65 67 61 74 65 73 74 20 61 73 alls megatest as
f0c0: 20 65 61 63 68 20 73 74 65 70 20 69 73 0a 3b 3b each step is.;;
f0d0: 20 20 20 20 73 74 61 72 74 65 64 20 61 6e 64 20 started and
f0e0: 63 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 20 20 20 completed.;;
f0f0: 2d 20 73 74 65 70 20 73 74 61 72 74 65 64 2c 20 - step started,
f100: 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 20 20 20 timestamp.;;
f110: 2d 20 73 74 65 70 20 63 6f 6d 70 6c 65 74 65 64 - step completed
f120: 2c 20 65 78 69 74 20 73 74 61 74 75 73 2c 20 74 , exit status, t
f130: 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 2e 20 74 imestamp.;; 6. t
f140: 65 73 74 20 70 68 6f 6e 65 20 68 6f 6d 65 0a 3b est phone home.;
f150: 3b 20 20 20 20 2d 20 69 66 20 74 65 73 74 20 72 ; - if test r
f160: 75 6e 20 74 69 6d 65 20 3e 20 61 6c 6c 6f 77 65 un time > allowe
f170: 64 20 72 75 6e 20 74 69 6d 65 20 74 68 65 6e 20 d run time then
f180: 6b 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 20 20 2d kill job.;; -
f190: 20 69 66 20 63 61 6e 6e 6f 74 20 61 63 63 65 73 if cannot acces
f1a0: 73 20 64 62 20 3e 20 61 6c 6c 6f 77 65 64 20 64 s db > allowed d
f1b0: 69 73 63 6f 6e 6e 65 63 74 20 74 69 6d 65 20 74 isconnect time t
f1c0: 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 0a 3b 3b hen kill job..;;
f1d0: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
f1e0: 3d 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a = (if (or (args:
f1f0: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 28 get-arg "-run")(
f200: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
f210: 75 6e 74 65 73 74 73 22 29 29 0a 3b 3b 20 3d 3d untests")).;; ==
f220: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
f230: 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 (general-run-ca
f240: 6c 6c 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 ll .;; == duplic
f250: 61 74 65 64 20 3d 3d 20 20 20 20 22 2d 72 75 6e ated == "-run
f260: 74 65 73 74 73 22 20 0a 3b 3b 20 3d 3d 20 64 75 tests" .;; == du
f270: 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 22 plicated == "
f280: 72 75 6e 20 61 20 74 65 73 74 22 20 0a 3b 3b 20 run a test" .;;
f290: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f2a0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
f2b0: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
f2c0: 20 6b 65 79 76 61 6c 73 29 0a 3b 3b 20 3d 3d 20 keyvals).;; ==
f2d0: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
f2e0: 20 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 70 6c ;;.;; == dupl
f2f0: 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b icated == ;
f300: 3b 20 4d 61 79 20 6f 72 20 6d 61 79 20 6e 6f 74 ; May or may not
f310: 20 69 6d 70 6c 65 6d 65 6e 74 20 69 74 20 74 68 implement it th
f320: 69 73 20 77 61 79 20 2e 2e 2e 0a 3b 3b 20 3d 3d is way ....;; ==
f330: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
f340: 20 20 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 70 ;;.;; == dup
f350: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 licated ==
f360: 3b 3b 20 49 6e 73 65 72 74 20 74 68 69 73 20 72 ;; Insert this r
f370: 75 6e 20 69 6e 74 6f 20 74 68 65 20 74 61 73 6b un into the task
f380: 73 20 71 75 65 75 65 0a 3b 3b 20 3d 3d 20 64 75 s queue.;; == du
f390: 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 plicated ==
f3a0: 20 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c ;; (open-run-cl
f3b0: 6f 73 65 20 74 61 73 6b 73 3a 61 64 64 20 74 61 ose tasks:add ta
f3c0: 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 0a 3b 3b 20 sks:open-db .;;
f3d0: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f3e0: 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 ;; .
f3f0: 20 20 22 72 75 6e 74 65 73 74 73 22 20 0a 3b 3b "runtests" .;;
f400: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
f410: 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 = ;; .
f420: 20 20 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 64 75 user.;; == du
f430: 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 plicated ==
f440: 20 3b 3b 20 20 20 20 09 20 20 20 20 20 74 61 72 ;; . tar
f450: 67 65 74 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 get.;; == duplic
f460: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 ated == ;;
f470: 20 20 20 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 . runname
f480: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
f490: 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 d == ;;
f4a0: 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d . (args:get-
f4b0: 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
f4c0: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
f4d0: 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 d == ;;
f4e0: 09 20 20 20 20 20 23 66 29 29 29 29 0a 3b 3b 20 . #f)))).;;
f4f0: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f500: 20 20 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d (runs:run-
f510: 74 65 73 74 73 20 74 61 72 67 65 74 0a 3b 3b 20 tests target.;;
f520: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f530: 20 09 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a .. runname.
f540: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f550: 20 3d 3d 20 09 09 20 20 20 20 20 28 63 6f 6d 6d == .. (comm
f560: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
f570: 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 patt #f) ;; (arg
f580: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 s:get-arg "-runt
f590: 65 73 74 73 22 29 0a 3b 3b 20 3d 3d 20 64 75 70 ests").;; == dup
f5a0: 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 20 20 20 licated == ..
f5b0: 20 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 64 75 70 user.;; == dup
f5c0: 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 20 20 20 licated == ..
f5d0: 20 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 args:arg-hash)
f5e0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
f5f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
f630: 20 52 6f 6c 6c 75 70 20 69 6e 74 6f 20 61 20 72 Rollup into a r
f640: 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d un.;;===========
f650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
f690: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
f6a0: 2d 72 6f 6c 6c 75 70 22 29 0a 20 20 20 20 28 67 -rollup"). (g
f6b0: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
f6c0: 0a 20 20 20 20 20 22 2d 72 6f 6c 6c 75 70 22 20 . "-rollup"
f6d0: 0a 20 20 20 20 20 22 72 6f 6c 6c 75 70 20 74 65 . "rollup te
f6e0: 73 74 73 22 20 0a 20 20 20 20 20 28 6c 61 6d 62 sts" . (lamb
f6f0: 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 da (target runna
f700: 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 me keys keyvals)
f710: 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a 72 6f . (runs:ro
f720: 6c 6c 75 70 2d 72 75 6e 20 6b 65 79 73 0a 09 09 llup-run keys...
f730: 09 6b 65 79 76 61 6c 73 0a 09 09 09 28 6f 72 20 .keyvals....(or
f740: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
f750: 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 runname")(args:g
f760: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
f770: 22 29 20 29 0a 09 09 09 75 73 65 72 29 29 29 29 ") )....user))))
f780: 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f7b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f7c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 6f ==========.;; Lo
f7d0: 63 6b 20 6f 72 20 75 6e 6c 6f 63 6b 20 61 20 72 ck or unlock a r
f7e0: 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d un.;;===========
f7f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
f830: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
f840: 72 67 20 22 2d 6c 6f 63 6b 22 29 28 61 72 67 73 rg "-lock")(args
f850: 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 :get-arg "-unloc
f860: 6b 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 k")). (genera
f870: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 l-run-call .
f880: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
f890: 72 67 20 22 2d 6c 6f 63 6b 22 29 20 22 2d 6c 6f rg "-lock") "-lo
f8a0: 63 6b 22 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 ck" "-unlock").
f8b0: 20 20 20 20 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b "lock/unlock
f8c0: 20 74 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c tests" . (l
f8d0: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
f8e0: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 nname keys keyva
f8f0: 6c 73 29 0a 20 20 20 20 20 20 20 28 72 75 6e 73 ls). (runs
f900: 3a 68 61 6e 64 6c 65 2d 6c 6f 63 6b 69 6e 67 20 :handle-locking
f910: 0a 09 09 20 20 74 61 72 67 65 74 0a 09 09 20 20 ... target...
f920: 6b 65 79 73 0a 09 09 20 20 28 6f 72 20 28 61 72 keys... (or (ar
f930: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
f940: 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d name")(args:get-
f950: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 arg ":runname")
f960: 29 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d )... (args:get-
f970: 61 72 67 20 22 2d 6c 6f 63 6b 22 29 0a 09 09 20 arg "-lock")...
f980: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
f990: 2d 75 6e 6c 6f 63 6b 22 29 0a 09 09 20 20 75 73 -unlock")... us
f9a0: 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d er))))..;;======
f9b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f9c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f9d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f9e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f9f0: 0a 3b 3b 20 47 65 74 20 70 61 74 68 73 20 74 6f .;; Get paths to
fa00: 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d tests.;;=======
fa10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
fa50: 3b 3b 20 47 65 74 20 74 65 73 74 20 70 61 74 68 ;; Get test path
fa60: 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 s matching targe
fa70: 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 t, runname, and
fa80: 74 65 73 74 70 61 74 74 0a 28 69 66 20 28 6f 72 testpatt.(if (or
fa90: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
faa0: 2d 74 65 73 74 2d 66 69 6c 65 73 22 29 28 61 72 -test-files")(ar
fab0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
fac0: 74 2d 70 61 74 68 73 22 29 29 0a 20 20 20 20 3b t-paths")). ;
fad0: 3b 20 69 66 20 77 65 20 61 72 65 20 69 6e 20 61 ; if we are in a
fae0: 20 74 65 73 74 20 75 73 65 20 74 68 65 20 4d 54 test use the MT
faf0: 5f 43 4d 44 49 4e 46 4f 20 64 61 74 61 0a 20 20 _CMDINFO data.
fb00: 20 20 28 69 66 20 28 67 65 74 65 6e 76 20 22 4d (if (getenv "M
fb10: 54 5f 43 4d 44 49 4e 46 4f 22 29 0a 09 28 6c 65 T_CMDINFO")..(le
fb20: 74 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 t* ((startingdir
fb30: 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 (current-direct
fb40: 6f 72 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 ory)).. (c
fb50: 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e mdinfo (common
fb60: 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 74 :read-encoded-st
fb70: 72 69 6e 67 20 28 67 65 74 65 6e 76 20 22 4d 54 ring (getenv "MT
fb80: 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 20 20 _CMDINFO")))..
fb90: 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 (transport
fba0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
fbb0: 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 transport cmdinf
fbc0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 o)).. (tes
fbd0: 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 tpath (assoc/de
fbe0: 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 fault 'testpath
fbf0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
fc00: 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 (test-name (a
fc10: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
fc20: 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 st-name cmdinfo)
fc30: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 ).. (runsc
fc40: 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 ript (assoc/defa
fc50: 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 ult 'runscript c
fc60: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
fc70: 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 (db-host (ass
fc80: 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 oc/default 'db-h
fc90: 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a ost cmdinfo)).
fca0: 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 . (run-id
fcb0: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
fcc0: 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 t 'run-id cmd
fcd0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
fce0: 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 itemdat (assoc
fcf0: 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 /default 'itemda
fd00: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
fd10: 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 (state
fd20: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
fd30: 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 :state"))..
fd40: 20 20 28 73 74 61 74 75 73 20 20 20 20 28 61 72 (status (ar
fd50: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
fd60: 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 tus")).. (
fd70: 74 61 72 67 65 74 20 20 20 20 28 61 72 67 73 3a target (args:
fd80: 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 get-arg "-target
fd90: 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 6f 70 ")).. (top
fda0: 70 61 74 68 20 20 20 28 61 73 73 6f 63 2f 64 65 path (assoc/de
fdb0: 66 61 75 6c 74 20 27 74 6f 70 70 61 74 68 20 20 fault 'toppath
fdc0: 20 63 6d 64 69 6e 66 6f 29 29 29 0a 09 20 20 28 cmdinfo))).. (
fdd0: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
fde0: 20 74 6f 70 70 61 74 68 29 0a 09 20 20 28 69 66 toppath).. (if
fdf0: 20 28 6e 6f 74 20 74 61 72 67 65 74 29 0a 09 20 (not target)..
fe00: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 (begin...(d
fe10: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
fe20: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
fe30: 70 6f 72 74 2a 20 22 2d 74 61 72 67 65 74 20 69 port* "-target i
fe40: 73 20 72 65 71 75 69 72 65 64 2e 22 29 0a 09 09 s required.")...
fe50: 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 69 (exit 1))).. (i
fe60: 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
fe70: 65 74 75 70 29 29 0a 09 20 20 20 20 20 20 28 62 etup)).. (b
fe80: 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 egin...(debug:pr
fe90: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
fea0: 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 og-port* "Failed
feb0: 20 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 6e to setup, givin
fec0: 67 20 75 70 20 6f 6e 20 2d 74 65 73 74 2d 70 61 g up on -test-pa
fed0: 74 68 73 20 6f 72 20 2d 74 65 73 74 2d 66 69 6c ths or -test-fil
fee0: 65 73 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 es, exiting")...
fef0: 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 6c (exit 1))).. (l
ff00: 65 74 2a 20 28 28 6b 65 79 73 20 20 20 20 20 28 et* ((keys (
ff10: 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 0a 09 rmt:get-keys))..
ff20: 09 20 3b 3b 20 64 62 3a 74 65 73 74 2d 67 65 74 . ;; db:test-get
ff30: 2d 70 61 74 68 73 20 6d 75 73 74 20 6e 6f 74 20 -paths must not
ff40: 62 65 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 be run remote...
ff50: 20 28 70 61 74 68 73 20 20 20 20 28 74 65 73 74 (paths (test
ff60: 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 s:test-get-paths
ff70: 2d 6d 61 74 63 68 69 6e 67 20 6b 65 79 73 20 74 -matching keys t
ff80: 61 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d arget (args:get-
ff90: 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 arg "-test-files
ffa0: 22 29 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 ")))).. (set!
ffb0: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
ffc0: 23 74 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 #t).. (for-ea
ffd0: 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 74 68 ch (lambda (path
ffe0: 29 0a 09 09 09 28 69 66 20 28 66 69 6c 65 2d 65 )....(if (file-e
fff0: 78 69 73 74 73 3f 20 70 61 74 68 29 0a 09 09 09 xists? path)....
10000 28 70 72 69 6e 74 20 70 61 74 68 29 29 29 09 0a (print path)))..
10010 09 09 20 20 20 20 20 20 70 61 74 68 73 29 29 29 .. paths)))
10020 0a 09 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 67 ..;; else do a g
10030 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a eneral-run-call.
10040 09 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 .(general-run-ca
10050 6c 6c 20 0a 09 20 22 2d 74 65 73 74 2d 66 69 6c ll .. "-test-fil
10060 65 73 22 0a 09 20 22 47 65 74 20 70 61 74 68 73 es".. "Get paths
10070 20 74 6f 20 74 65 73 74 22 0a 09 20 28 6c 61 6d to test".. (lam
10080 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
10090 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 ame keys keyvals
100a0 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 64 62 ).. (let* ((db
100b0 20 20 20 20 20 20 20 23 66 29 0a 09 09 20 20 3b #f)... ;
100c0 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d ; DO NOT run rem
100d0 6f 74 65 0a 09 09 20 20 28 70 61 74 68 73 20 20 ote... (paths
100e0 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 67 65 (tests:test-ge
100f0 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 t-paths-matching
10100 20 6b 65 79 73 20 74 61 72 67 65 74 20 28 61 72 keys target (ar
10110 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
10120 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 20 t-files"))))..
10130 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
10140 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 20 mbda (path)....
10150 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 (print path))...
10160 20 20 20 20 20 20 20 70 61 74 68 73 29 29 29 29 paths))))
10170 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
10180 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10190 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
101a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
101b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
101c0 41 72 63 68 69 76 65 20 74 65 73 74 73 0a 3b 3b Archive tests.;;
101d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
101e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
101f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10200 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10210 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 ======.;; Archiv
10220 65 20 74 65 73 74 73 20 6d 61 74 63 68 69 6e 67 e tests matching
10230 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 target, runname
10240 2c 20 61 6e 64 20 74 65 73 74 70 61 74 74 0a 28 , and testpatt.(
10250 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
10260 20 22 2d 61 72 63 68 69 76 65 22 29 0a 20 20 20 "-archive").
10270 20 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 67 65 ;; else do a ge
10280 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 neral-run-call.
10290 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
102a0 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 61 72 63 call . "-arc
102b0 68 69 76 65 22 0a 20 20 20 20 20 22 41 72 63 68 hive". "Arch
102c0 69 76 65 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 ive". (lambd
102d0 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
102e0 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a e keys keyvals).
102f0 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d (operate-
10300 6f 6e 20 27 61 72 63 68 69 76 65 29 29 29 29 0a on 'archive)))).
10310 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10340 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10350 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 74 =========.;; Ext
10360 72 61 63 74 20 61 20 73 70 72 65 61 64 73 68 65 ract a spreadshe
10370 65 74 20 66 72 6f 6d 20 74 68 65 20 72 75 6e 73 et from the runs
10380 20 64 61 74 61 62 61 73 65 0a 3b 3b 3d 3d 3d 3d database.;;====
10390 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
103a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
103b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
103c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
103d0 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ==..(if (args:ge
103e0 74 2d 61 72 67 20 22 2d 65 78 74 72 61 63 74 2d t-arg "-extract-
103f0 6f 64 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 ods"). (gener
10400 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 al-run-call.
10410 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 0a "-extract-ods".
10420 20 20 20 20 20 22 4d 61 6b 65 20 6f 64 73 20 73 "Make ods s
10430 70 72 65 61 64 73 68 65 65 74 22 0a 20 20 20 20 preadsheet".
10440 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
10450 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
10460 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6c yvals). (l
10470 65 74 20 28 28 64 62 73 74 72 75 63 74 20 20 20 et ((dbstruct
10480 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 (make-dbr:dbstru
10490 63 74 20 70 61 74 68 3a 20 2a 74 6f 70 70 61 74 ct path: *toppat
104a0 68 2a 20 6c 6f 63 61 6c 3a 20 23 74 29 29 0a 09 h* local: #t))..
104b0 20 20 20 20 20 28 6f 75 74 70 75 74 66 69 6c 65 (outputfile
104c0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
104d0 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 29 0a -extract-ods")).
104e0 09 20 20 20 20 20 28 72 75 6e 73 70 61 74 74 20 . (runspatt
104f0 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d (or (args:get-
10500 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 arg "-runname")(
10510 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 args:get-arg ":r
10520 75 6e 6e 61 6d 65 22 29 29 29 0a 09 20 20 20 20 unname")))..
10530 20 28 70 61 74 68 6d 6f 64 20 20 20 20 28 61 72 (pathmod (ar
10540 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 61 74 gs:get-arg "-pat
10550 68 6d 6f 64 22 29 29 29 0a 09 20 20 20 20 20 3b hmod"))).. ;
10560 3b 20 28 6b 65 79 76 61 6c 61 6c 69 73 74 20 28 ; (keyvalalist (
10570 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 79 73 keys->alist keys
10580 20 22 25 22 29 29 29 0a 09 20 28 64 65 62 75 67 "%"))).. (debug
10590 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 75 6c :print 2 *defaul
105a0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 78 74 t-log-port* "Ext
105b0 72 61 63 74 20 6f 64 73 2c 20 6f 75 74 70 75 74 ract ods, output
105c0 66 69 6c 65 3a 20 22 20 6f 75 74 70 75 74 66 69 file: " outputfi
105d0 6c 65 20 22 20 72 75 6e 73 70 61 74 74 3a 20 22 le " runspatt: "
105e0 20 72 75 6e 73 70 61 74 74 20 22 20 6b 65 79 76 runspatt " keyv
105f0 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 29 0a als: " keyvals).
10600 09 20 28 64 62 3a 65 78 74 72 61 63 74 2d 6f 64 . (db:extract-od
10610 73 2d 66 69 6c 65 20 64 62 73 74 72 75 63 74 20 s-file dbstruct
10620 6f 75 74 70 75 74 66 69 6c 65 20 6b 65 79 76 61 outputfile keyva
10630 6c 73 20 28 69 66 20 72 75 6e 73 70 61 74 74 20 ls (if runspatt
10640 72 75 6e 73 70 61 74 74 20 22 25 22 29 20 70 61 runspatt "%") pa
10650 74 68 6d 6f 64 29 0a 09 20 28 64 62 3a 63 6c 6f thmod).. (db:clo
10660 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 29 se-all dbstruct)
10670 0a 09 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d .. (set! *didsom
10680 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 29 0a ething* #t))))).
10690 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
106a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
106b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
106c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
106d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 =========.;; exe
106e0 63 75 74 65 20 74 68 65 20 74 65 73 74 0a 3b 3b cute the test.;;
106f0 20 20 20 20 2d 20 67 65 74 73 20 63 61 6c 6c 65 - gets calle
10700 64 20 6f 6e 20 72 65 6d 6f 74 65 20 68 6f 73 74 d on remote host
10710 0a 3b 3b 20 20 20 20 2d 20 72 65 63 65 69 76 65 .;; - receive
10720 73 20 69 6e 66 6f 20 66 72 6f 6d 20 74 68 65 20 s info from the
10730 2d 65 78 65 63 75 74 65 20 70 61 72 61 6d 0a 3b -execute param.;
10740 3b 20 20 20 20 2d 20 70 61 73 73 65 73 20 69 6e ; - passes in
10750 66 6f 20 74 6f 20 73 74 65 70 73 20 76 69 61 20 fo to steps via
10760 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 MT_CMDINFO env v
10770 61 72 20 28 66 75 74 75 72 65 20 69 73 20 74 6f ar (future is to
10780 20 75 73 65 20 61 20 64 6f 74 20 66 69 6c 65 29 use a dot file)
10790 0a 3b 3b 20 20 20 20 2d 20 67 61 74 68 65 72 73 .;; - gathers
107a0 20 68 6f 73 74 20 69 6e 66 6f 20 61 6e 64 20 0a host info and .
107b0 3b 3b 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 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
10800 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 rgs:get-arg "-ex
10810 65 63 75 74 65 22 29 0a 20 20 20 20 28 62 65 67 ecute"). (beg
10820 69 6e 0a 20 20 20 20 20 20 28 6c 61 75 6e 63 68 in. (launch
10830 3a 65 78 65 63 75 74 65 20 28 61 72 67 73 3a 67 :execute (args:g
10840 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 65 et-arg "-execute
10850 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ")). (set!
10860 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
10870 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
10880 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10890 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
108c0 3b 20 72 65 63 6f 76 65 72 20 66 72 6f 6d 20 61 ; recover from a
108d0 20 74 65 73 74 20 77 68 65 72 65 20 74 68 65 20 test where the
108e0 6d 61 6e 61 67 69 6e 67 20 6d 74 65 73 74 20 77 managing mtest w
108f0 61 73 20 6b 69 6c 6c 65 64 20 62 75 74 20 74 68 as killed but th
10900 65 20 75 6e 64 65 72 6c 79 69 6e 67 0a 3b 3b 20 e underlying.;;
10910 70 72 6f 63 65 73 73 20 6d 69 67 68 74 20 73 74 process might st
10920 69 6c 6c 20 62 65 20 73 61 6c 76 61 67 65 61 62 ill be salvageab
10930 6c 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d le.;;===========
10940 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10950 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10960 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10970 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
10980 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
10990 2d 72 65 63 6f 76 65 72 2d 74 65 73 74 22 29 0a -recover-test").
109a0 20 20 20 20 28 6c 65 74 2a 20 28 28 70 61 72 61 (let* ((para
109b0 6d 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 ms (string-split
109c0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
109d0 2d 72 65 63 6f 76 65 72 2d 74 65 73 74 22 29 20 -recover-test")
109e0 22 2c 22 29 29 29 0a 20 20 20 20 20 20 28 69 66 ","))). (if
109f0 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 72 61 (> (length para
10a00 6d 73 29 20 31 29 20 3b 3b 20 72 75 6e 2d 69 64 ms) 1) ;; run-id
10a10 20 61 6e 64 20 74 65 73 74 2d 69 64 0a 09 20 20 and test-id..
10a20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 28 73 (let ((run-id (s
10a30 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 tring->number (c
10a40 61 72 20 70 61 72 61 6d 73 29 29 29 0a 09 09 28 ar params)))...(
10a50 74 65 73 74 2d 69 64 20 28 73 74 72 69 6e 67 2d test-id (string-
10a60 3e 6e 75 6d 62 65 72 20 28 63 61 64 72 20 70 61 >number (cadr pa
10a70 72 61 6d 73 29 29 29 29 0a 09 20 20 20 20 28 69 rams)))).. (i
10a80 66 20 28 61 6e 64 20 72 75 6e 2d 69 64 20 74 65 f (and run-id te
10a90 73 74 2d 69 64 29 0a 09 09 28 62 65 67 69 6e 0a st-id)...(begin.
10aa0 09 09 20 20 28 6c 61 75 6e 63 68 3a 72 65 63 6f .. (launch:reco
10ab0 76 65 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 ver-test run-id
10ac0 74 65 73 74 2d 69 64 29 0a 09 09 20 20 28 73 65 test-id)... (se
10ad0 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
10ae0 2a 20 23 74 29 29 0a 09 09 28 62 65 67 69 6e 0a * #t))...(begin.
10af0 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
10b00 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
10b10 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 62 61 64 t-log-port* "bad
10b20 20 72 75 6e 2d 69 64 20 6f 72 20 74 65 73 74 2d run-id or test-
10b30 69 64 2c 20 6d 75 73 74 20 62 65 20 69 6e 74 65 id, must be inte
10b40 67 65 72 73 22 29 0a 09 09 20 20 28 65 78 69 74 gers")... (exit
10b50 20 31 29 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 1)))))))..;;===
10b60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10ba0 3d 3d 3d 0a 3b 3b 20 54 65 73 74 20 63 6f 6d 6d ===.;; Test comm
10bb0 61 6e 64 73 20 28 69 2e 65 2e 20 66 6f 72 20 75 ands (i.e. for u
10bc0 73 65 20 69 6e 73 69 64 65 20 74 65 73 74 73 29 se inside tests)
10bd0 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
10be0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10bf0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c10 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
10c20 6e 65 20 28 6d 65 67 61 74 65 73 74 3a 73 74 65 ne (megatest:ste
10c30 70 20 73 74 65 70 20 73 74 61 74 65 20 73 74 61 p step state sta
10c40 74 75 73 20 6c 6f 67 66 69 6c 65 20 6d 73 67 29 tus logfile msg)
10c50 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 . (if (not (get
10c60 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
10c70 29 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a )). (begin.
10c80 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 .(debug:print-er
10c90 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
10ca0 6f 67 2d 70 6f 72 74 2a 20 22 4d 54 5f 43 4d 44 og-port* "MT_CMD
10cb0 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 INFO env var not
10cc0 20 73 65 74 2c 20 2d 73 74 65 70 20 6d 75 73 74 set, -step must
10cd0 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 be called *insi
10ce0 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 69 de* a megatest i
10cf0 6e 76 6f 6b 65 64 20 65 6e 76 69 72 6f 6e 6d 65 nvoked environme
10d00 6e 74 21 22 29 0a 09 28 65 78 69 74 20 35 29 29 nt!")..(exit 5))
10d10 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 . (let* ((c
10d20 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e mdinfo (common
10d30 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 74 :read-encoded-st
10d40 72 69 6e 67 20 28 67 65 74 65 6e 76 20 22 4d 54 ring (getenv "MT
10d50 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 20 20 _CMDINFO")))..
10d60 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 (transport (a
10d70 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 ssoc/default 'tr
10d80 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 ansport cmdinfo)
10d90 29 0a 09 20 20 20 20 20 28 74 65 73 74 70 61 74 ).. (testpat
10da0 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c h (assoc/defaul
10db0 74 20 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 t 'testpath cmd
10dc0 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 info)).. (te
10dd0 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 st-name (assoc/d
10de0 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d efault 'test-nam
10df0 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 e cmdinfo))..
10e00 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 (runscript (as
10e10 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
10e20 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 script cmdinfo))
10e30 0a 09 20 20 20 20 20 28 64 62 2d 68 6f 73 74 20 .. (db-host
10e40 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
10e50 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 'db-host cmdi
10e60 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 75 6e nfo)).. (run
10e70 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 -id (assoc/de
10e80 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 fault 'run-id
10e90 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
10ea0 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 73 73 (test-id (ass
10eb0 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
10ec0 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a -id cmdinfo)).
10ed0 09 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 . (itemdat
10ee0 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
10ef0 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 'itemdat cmdin
10f00 66 6f 29 29 0a 09 20 20 20 20 20 28 77 6f 72 6b fo)).. (work
10f10 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 65 66 -area (assoc/def
10f20 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 ault 'work-area
10f30 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
10f40 28 64 62 20 20 20 20 20 20 20 20 23 66 29 29 0a (db #f)).
10f50 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f .(change-directo
10f60 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 28 69 ry testpath)..(i
10f70 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
10f80 65 74 75 70 29 29 0a 09 20 20 20 20 28 62 65 67 etup)).. (beg
10f90 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 in.. (debug
10fa0 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
10fb0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
10fc0 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
10fd0 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 20 28 iting").. (
10fe0 65 78 69 74 20 31 29 29 29 0a 09 28 69 66 20 28 exit 1)))..(if (
10ff0 61 6e 64 20 73 74 61 74 65 20 73 74 61 74 75 73 and state status
11000 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 63 6f ).. (let ((co
11010 6d 6d 65 6e 74 20 28 6c 61 75 6e 63 68 3a 6c 6f mment (launch:lo
11020 61 64 2d 6c 6f 67 70 72 6f 2d 64 61 74 20 72 75 ad-logpro-dat ru
11030 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 n-id test-id ste
11040 70 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 p))).. ;; (
11050 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 rmt:test-set-log
11060 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
11070 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
11080 22 2e 68 74 6d 6c 22 29 29 29 29 0a 09 20 20 20 ".html"))))..
11090 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 65 70 (rmt:teststep
110a0 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
110b0 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 -id test-id step
110c0 20 73 74 61 74 65 20 73 74 61 74 75 73 20 28 6f state status (o
110d0 72 20 63 6f 6d 6d 65 6e 74 20 6d 73 67 29 20 6c r comment msg) l
110e0 6f 67 66 69 6c 65 29 29 0a 09 20 20 20 20 28 62 ogfile)).. (b
110f0 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 egin.. (deb
11100 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
11110 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
11120 72 74 2a 20 22 59 6f 75 20 6d 75 73 74 20 73 70 rt* "You must sp
11130 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 ecify :state and
11140 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 65 76 :status with ev
11150 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 73 74 65 ery call to -ste
11160 70 22 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 p").. (exit
11170 20 36 29 29 29 29 29 29 0a 0a 28 69 66 20 28 61 6))))))..(if (a
11180 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
11190 65 70 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ep"). (begin.
111a0 20 20 20 20 20 20 28 6d 65 67 61 74 65 73 74 3a (megatest:
111b0 73 74 65 70 20 0a 20 20 20 20 20 20 20 28 61 72 step . (ar
111c0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 gs:get-arg "-ste
111d0 70 22 29 0a 20 20 20 20 20 20 20 28 6f 72 20 28 p"). (or (
111e0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
111f0 74 61 74 65 22 29 28 61 72 67 73 3a 67 65 74 2d tate")(args:get-
11200 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a 20 arg ":state")).
11210 20 20 20 20 20 20 28 6f 72 20 28 61 72 67 73 3a (or (args:
11220 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 75 73 get-arg "-status
11230 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
11240 22 3a 73 74 61 74 75 73 22 29 29 0a 20 20 20 20 ":status")).
11250 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
11260 20 22 2d 73 65 74 6c 6f 67 22 29 0a 20 20 20 20 "-setlog").
11270 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
11280 20 22 2d 6d 22 29 29 0a 20 20 20 20 20 20 3b 3b "-m")). ;;
11290 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 (if db (sqlite3
112a0 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
112b0 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
112c0 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
112d0 0a 20 20 20 20 0a 28 69 66 20 28 6f 72 20 28 61 . .(if (or (a
112e0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
112f0 74 6c 6f 67 22 29 20 20 20 20 20 20 20 3b 3b 20 tlog") ;;
11300 73 69 6e 63 65 20 73 65 74 74 69 6e 67 20 75 70 since setting up
11310 20 69 73 20 73 6f 20 63 6f 73 74 6c 79 20 6c 65 is so costly le
11320 74 73 20 70 69 67 67 79 62 61 63 6b 20 6f 6e 20 ts piggyback on
11330 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 09 3b 3b -test-status..;;
11340 20 20 20 20 20 28 6e 6f 74 20 28 61 72 67 73 3a (not (args:
11350 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 get-arg "-step")
11360 29 29 20 20 3b 3b 20 2d 73 65 74 6c 6f 67 20 6d )) ;; -setlog m
11370 61 79 20 68 61 76 65 20 62 65 65 6e 20 70 72 6f ay have been pro
11380 63 65 73 73 65 64 20 61 6c 72 65 61 64 79 20 69 cessed already i
11390 6e 20 74 68 65 20 22 2d 73 74 65 70 22 20 70 72 n the "-step" pr
113a0 65 76 69 6f 75 73 0a 09 3b 3b 20 20 20 20 20 4e evious..;; N
113b0 45 57 20 50 4f 4c 49 43 59 20 2d 20 2d 73 65 74 EW POLICY - -set
113c0 6c 6f 67 20 73 65 74 73 20 74 65 73 74 20 6f 76 log sets test ov
113d0 65 72 61 6c 6c 20 6c 6f 67 20 6f 6e 20 65 76 65 erall log on eve
113e0 72 79 20 63 61 6c 6c 2e 0a 09 28 61 72 67 73 3a ry call...(args:
113f0 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f get-arg "-set-to
11400 70 6c 6f 67 22 29 0a 09 28 61 72 67 73 3a 67 65 plog")..(args:ge
11410 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 t-arg "-test-sta
11420 74 75 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 tus")..(args:get
11430 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 -arg "-set-value
11440 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 s")..(args:get-a
11450 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 rg "-load-test-d
11460 61 74 61 22 29 0a 09 28 61 72 67 73 3a 67 65 74 ata")..(args:get
11470 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 -arg "-runstep")
11480 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
11490 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d "-summarize-item
114a0 73 22 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f s")). (if (no
114b0 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d t (getenv "MT_CM
114c0 44 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e DINFO"))..(begin
114d0 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
114e0 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
114f0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 54 5f t-log-port* "MT_
11500 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 CMDINFO env var
11510 6e 6f 74 20 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 not set, command
11520 73 20 2d 74 65 73 74 2d 73 74 61 74 75 73 2c 20 s -test-status,
11530 2d 72 75 6e 73 74 65 70 20 61 6e 64 20 2d 73 65 -runstep and -se
11540 74 6c 6f 67 20 6d 75 73 74 20 62 65 20 63 61 6c tlog must be cal
11550 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d led *inside* a m
11560 65 67 61 74 65 73 74 20 65 6e 76 69 72 6f 6e 6d egatest environm
11570 65 6e 74 21 22 29 0a 09 20 20 28 65 78 69 74 20 ent!").. (exit
11580 35 29 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 5))..(let* ((sta
11590 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 65 6e rtingdir (curren
115a0 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 20 t-directory))..
115b0 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 (cmdinfo
115c0 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e (common:read-en
115d0 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 67 65 coded-string (ge
115e0 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
115f0 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 72 "))).. (tr
11600 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f 64 ansport (assoc/d
11610 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f 72 efault 'transpor
11620 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
11630 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 (testpath (
11640 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
11650 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
11660 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
11670 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 -name (assoc/def
11680 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 ault 'test-name
11690 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
116a0 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 (runscript (as
116b0 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
116c0 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 script cmdinfo))
116d0 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 .. (db-hos
116e0 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
116f0 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d lt 'db-host cm
11700 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
11710 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f (run-id (asso
11720 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 c/default 'run-i
11730 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 d cmdinfo))..
11740 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 (test-id
11750 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
11760 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 'test-id cmdi
11770 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 nfo)).. (i
11780 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f temdat (assoc/
11790 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 default 'itemdat
117a0 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
117b0 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 (work-area
117c0 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
117d0 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 66 work-area cmdinf
117e0 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 20 o)).. (db
117f0 20 20 20 20 20 20 20 23 66 29 20 3b 3b 20 28 6f #f) ;; (o
11800 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 20 20 pen-db))..
11810 20 28 73 74 61 74 65 20 20 20 20 20 28 61 72 67 (state (arg
11820 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
11830 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 e")).. (st
11840 61 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 atus (args:ge
11850 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 t-arg ":status")
11860 29 0a 09 20 20 20 20 20 20 20 28 73 74 65 70 6e ).. (stepn
11870 61 6d 65 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ame (args:get-a
11880 72 67 20 22 2d 73 74 65 70 22 29 29 29 0a 09 20 rg "-step")))..
11890 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 (if (not (launc
118a0 68 3a 73 65 74 75 70 29 29 0a 09 20 20 20 20 20 h:setup))..
118b0 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
118c0 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
118d0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
118e0 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
118f0 69 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 iting")...(exit
11900 31 29 29 29 0a 0a 09 20 20 28 69 66 20 28 61 72 1)))... (if (ar
11910 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
11920 73 74 65 70 22 29 28 64 65 62 75 67 3a 70 72 69 step")(debug:pri
11930 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 nt-info 1 *defau
11940 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 75 lt-log-port* "Ru
11950 6e 6e 69 6e 67 20 2d 72 75 6e 73 74 65 70 2c 20 nning -runstep,
11960 66 69 72 73 74 20 63 68 61 6e 67 65 20 74 6f 20 first change to
11970 64 69 72 65 63 74 6f 72 79 20 22 20 77 6f 72 6b directory " work
11980 2d 61 72 65 61 29 29 0a 09 20 20 28 63 68 61 6e -area)).. (chan
11990 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 ge-directory wor
119a0 6b 2d 61 72 65 61 29 0a 09 20 20 3b 3b 20 63 61 k-area).. ;; ca
119b0 6e 20 73 65 74 75 70 20 61 73 20 63 6c 69 65 6e n setup as clien
119c0 74 20 66 6f 72 20 73 65 72 76 65 72 20 6d 6f 64 t for server mod
119d0 65 20 6e 6f 77 0a 09 20 20 3b 3b 20 28 63 6c 69 e now.. ;; (cli
119e0 65 6e 74 3a 73 65 74 75 70 29 0a 0a 09 20 20 28 ent:setup)... (
119f0 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
11a00 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 "-load-test-dat
11a10 61 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 68 61 a").. ;; ha
11a20 73 20 73 75 62 20 63 6f 6d 6d 61 6e 64 73 20 74 s sub commands t
11a30 68 61 74 20 61 72 65 20 72 64 62 3a 0a 09 20 20 hat are rdb:..
11a40 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 70 75 ;; DO NOT pu
11a50 74 20 74 68 69 73 20 6f 6e 65 20 69 6e 74 6f 20 t this one into
11a60 65 69 74 68 65 72 20 72 6d 74 3a 20 6f 72 20 6f either rmt: or o
11a70 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 0a 09 20 pen-run-close..
11a80 20 20 20 20 20 28 74 64 62 3a 6c 6f 61 64 2d 74 (tdb:load-t
11a90 65 73 74 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 est-data run-id
11aa0 74 65 73 74 2d 69 64 29 29 0a 09 20 20 28 69 66 test-id)).. (if
11ab0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
11ac0 2d 73 65 74 6c 6f 67 22 29 0a 09 20 20 20 20 20 -setlog")..
11ad0 20 28 6c 65 74 20 28 28 6c 6f 67 66 6e 61 6d 65 (let ((logfname
11ae0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
11af0 2d 73 65 74 6c 6f 67 22 29 29 29 0a 09 09 28 72 -setlog")))...(r
11b00 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 mt:test-set-log!
11b10 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
11b20 6c 6f 67 66 6e 61 6d 65 29 29 29 0a 09 20 20 28 logfname))).. (
11b30 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
11b40 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a "-set-toplog").
11b50 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 . ;; DO NOT
11b60 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 run remote..
11b70 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 (tests:test-s
11b80 65 74 2d 74 6f 70 6c 6f 67 21 20 72 75 6e 2d 69 et-toplog! run-i
11b90 64 20 74 65 73 74 2d 6e 61 6d 65 20 28 61 72 67 d test-name (arg
11ba0 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
11bb0 74 6f 70 6c 6f 67 22 29 29 29 0a 09 20 20 28 69 toplog"))).. (i
11bc0 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
11bd0 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d "-summarize-item
11be0 73 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 44 4f s").. ;; DO
11bf0 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a NOT run remote.
11c00 09 20 20 20 20 20 20 28 74 65 73 74 73 3a 73 75 . (tests:su
11c10 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 72 75 mmarize-items ru
11c20 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 n-id test-id tes
11c30 74 2d 6e 61 6d 65 20 23 74 29 29 20 3b 3b 20 64 t-name #t)) ;; d
11c40 6f 20 66 6f 72 63 65 20 68 65 72 65 0a 09 20 20 o force here..
11c50 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
11c60 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 20 g "-runstep")..
11c70 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
11c80 72 65 6d 61 72 67 73 29 0a 09 09 20 20 28 62 65 remargs)... (be
11c90 67 69 6e 0a 09 09 20 20 20 20 28 64 65 62 75 67 gin... (debug
11ca0 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
11cb0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
11cc0 2a 20 22 6e 6f 74 68 69 6e 67 20 73 70 65 63 69 * "nothing speci
11cd0 66 69 65 64 20 74 6f 20 72 75 6e 21 22 29 0a 09 fied to run!")..
11ce0 09 20 20 20 20 28 69 66 20 64 62 20 28 73 71 6c . (if db (sql
11cf0 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
11d00 62 29 29 0a 09 09 20 20 20 20 28 65 78 69 74 20 b))... (exit
11d10 36 29 29 0a 09 09 20 20 28 6c 65 74 2a 20 28 28 6))... (let* ((
11d20 73 74 65 70 6e 61 6d 65 20 20 20 28 61 72 67 73 stepname (args
11d30 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 :get-arg "-runst
11d40 65 70 22 29 29 0a 09 09 09 20 28 6c 6f 67 70 72 ep")).... (logpr
11d50 6f 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d ofile (args:get-
11d60 61 72 67 20 22 2d 6c 6f 67 70 72 6f 22 29 29 0a arg "-logpro")).
11d70 09 09 09 20 28 6c 6f 67 66 69 6c 65 20 20 20 20 ... (logfile
11d80 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 (conc stepname "
11d90 2e 6c 6f 67 22 29 29 0a 09 09 09 20 28 63 6d 64 .log")).... (cmd
11da0 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c (if (nul
11db0 6c 3f 20 72 65 6d 61 72 67 73 29 20 23 66 20 28 l? remargs) #f (
11dc0 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 0a 09 car remargs)))..
11dd0 09 09 20 28 70 61 72 61 6d 73 20 20 20 20 20 28 .. (params (
11de0 69 66 20 63 6d 64 20 28 63 64 72 20 72 65 6d 61 if cmd (cdr rema
11df0 72 67 73 29 20 27 28 29 29 29 0a 09 09 09 20 28 rgs) '())).... (
11e00 65 78 69 74 73 74 61 74 20 20 20 23 66 29 0a 09 exitstat #f)..
11e10 09 09 20 28 73 68 65 6c 6c 20 20 20 20 20 20 28 .. (shell (
11e20 6c 65 74 20 28 28 73 68 20 28 67 65 74 2d 65 6e let ((sh (get-en
11e30 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
11e40 6c 65 20 22 53 48 45 4c 4c 22 29 20 29 29 0a 09 le "SHELL") ))..
11e50 09 09 09 20 20 20 20 20 20 20 28 69 66 20 73 68 ... (if sh
11e60 20 0a 09 09 09 09 09 20 20 20 28 6c 61 73 74 20 ...... (last
11e70 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 73 68 (string-split sh
11e80 20 22 2f 22 29 29 0a 09 09 09 09 09 20 20 20 22 "/"))...... "
11e90 62 61 73 68 22 29 29 29 0a 09 09 09 20 28 72 65 bash"))).... (re
11ea0 64 69 72 20 20 20 20 20 20 28 63 61 73 65 20 28 dir (case (
11eb0 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 string->symbol s
11ec0 68 65 6c 6c 29 0a 09 09 09 09 20 20 20 20 20 20 hell).....
11ed0 20 28 28 74 63 73 68 20 63 73 68 20 6b 73 68 29 ((tcsh csh ksh)
11ee0 20 20 20 20 22 3e 26 22 29 0a 09 09 09 09 20 20 ">&").....
11ef0 20 20 20 20 20 28 28 7a 73 68 20 62 61 73 68 20 ((zsh bash
11f00 73 68 20 61 73 68 29 20 22 32 3e 26 31 20 3e 22 sh ash) "2>&1 >"
11f10 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 65 6c )..... (el
11f20 73 65 20 22 3e 26 22 29 29 29 0a 09 09 09 20 28 se ">&"))).... (
11f30 66 75 6c 6c 63 6d 64 20 20 20 20 28 63 6f 6e 63 fullcmd (conc
11f40 20 22 28 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 "(" (string-int
11f50 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 09 09 ersperse .......
11f60 28 63 6f 6e 73 20 63 6d 64 20 70 61 72 61 6d 73 (cons cmd params
11f70 29 20 22 20 22 29 0a 09 09 09 09 09 20 20 20 22 ) " ")...... "
11f80 29 20 22 20 72 65 64 69 72 20 22 20 22 20 6c 6f ) " redir " " lo
11f90 67 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 3b gfile)))... ;
11fa0 3b 20 6d 61 72 6b 20 74 68 65 20 73 74 61 72 74 ; mark the start
11fb0 20 6f 66 20 74 68 65 20 74 65 73 74 0a 09 09 20 of the test...
11fc0 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 65 70 (rmt:teststep
11fd0 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
11fe0 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 -id test-id step
11ff0 6e 61 6d 65 20 22 73 74 61 72 74 22 20 22 6e 2f name "start" "n/
12000 61 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 a" (args:get-arg
12010 20 22 2d 6d 22 29 20 6c 6f 67 66 69 6c 65 29 0a "-m") logfile).
12020 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 74 68 65 .. ;; run the
12030 20 74 65 73 74 20 73 74 65 70 0a 09 09 20 20 20 test step...
12040 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
12050 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 2 *default-lo
12060 67 2d 70 6f 72 74 2a 20 22 52 75 6e 6e 69 6e 67 g-port* "Running
12070 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 5c 22 \"" fullcmd "\"
12080 20 69 6e 20 64 69 72 65 63 74 6f 72 79 20 5c 22 in directory \"
12090 22 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 " startingdir)..
120a0 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 . (change-dir
120b0 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 64 ectory startingd
120c0 69 72 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 ir)... (set!
120d0 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65 6d exitstat (system
120e0 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 20 20 20 fullcmd))...
120f0 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 (set! *globalex
12100 69 74 73 74 61 74 75 73 2a 20 65 78 69 74 73 74 itstatus* exitst
12110 61 74 29 0a 09 09 20 20 20 20 3b 3b 20 28 63 68 at)... ;; (ch
12120 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
12130 65 73 74 70 61 74 68 29 0a 09 09 20 20 20 20 3b estpath)... ;
12140 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 66 20 ; run logpro if
12150 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b 20 28 70 applicable ;; (p
12160 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c 73 22 20 rocess-run "ls"
12170 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20 22 32 3e (list "/foo" "2>
12180 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67 22 29 29 &1" "blah.log"))
12190 0a 09 09 20 20 20 20 28 69 66 20 6c 6f 67 70 72 ... (if logpr
121a0 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74 2a 20 28 ofile....(let* (
121b0 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 28 63 6f (htmllogfile (co
121c0 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 nc stepname ".ht
121d0 6d 6c 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 ml"))....
121e0 28 6f 6c 64 65 78 69 74 73 74 61 74 20 65 78 69 (oldexitstat exi
121f0 74 73 74 61 74 29 0a 09 09 09 20 20 20 20 20 20 tstat)....
12200 20 28 63 6d 64 20 20 20 20 20 20 20 20 20 28 73 (cmd (s
12210 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
12220 65 20 28 6c 69 73 74 20 22 6c 6f 67 70 72 6f 22 e (list "logpro"
12230 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68 74 6d 6c logprofile html
12240 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c 6f 67 66 logfile "<" logf
12250 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63 20 73 74 ile ">" (conc st
12260 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70 72 6f 2e epname "_logpro.
12270 6c 6f 67 22 29 29 20 22 20 22 29 29 29 0a 09 09 log")) " ")))...
12280 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
12290 69 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d info 2 *default-
122a0 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 75 6e 6e 69 log-port* "runni
122b0 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 29 ng \"" cmd "\"")
122c0 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 .... (change-di
122d0 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 rectory starting
122e0 64 69 72 29 0a 09 09 09 20 20 28 73 65 74 21 20 dir).... (set!
122f0 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65 6d exitstat (system
12300 20 63 6d 64 29 29 0a 09 09 09 20 20 28 73 65 74 cmd)).... (set
12310 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 ! *globalexitsta
12320 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 20 3b tus* exitstat) ;
12330 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 0a 09 ; no necessary..
12340 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 .. (change-dire
12350 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a ctory testpath).
12360 09 09 09 20 20 28 72 6d 74 3a 74 65 73 74 2d 73 ... (rmt:test-s
12370 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 et-log! run-id t
12380 65 73 74 2d 69 64 20 68 74 6d 6c 6c 6f 67 66 69 est-id htmllogfi
12390 6c 65 29 29 29 0a 09 09 20 20 20 20 28 6c 65 74 le)))... (let
123a0 20 28 28 6d 73 67 20 28 61 72 67 73 3a 67 65 74 ((msg (args:get
123b0 2d 61 72 67 20 22 2d 6d 22 29 29 29 0a 09 09 20 -arg "-m")))...
123c0 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 (rmt:testst
123d0 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 ep-set-status! r
123e0 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 un-id test-id st
123f0 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 78 69 epname "end" exi
12400 74 73 74 61 74 20 6d 73 67 20 6c 6f 67 66 69 6c tstat msg logfil
12410 65 29 29 0a 09 09 20 20 20 20 29 29 29 0a 09 20 e))... )))..
12420 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 (if (or (args:g
12430 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 et-arg "-test-st
12440 61 74 75 73 22 29 0a 09 09 20 20 28 61 72 67 73 atus")... (args
12450 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 :get-arg "-set-v
12460 61 6c 75 65 73 22 29 29 0a 09 20 20 20 20 20 20 alues"))..
12470 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 75 73 (let ((newstatus
12480 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e 75 6d (cond.....((num
12490 62 65 72 3f 20 73 74 61 74 75 73 29 20 20 20 20 ber? status)
124a0 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 (if (equal? s
124b0 74 61 74 75 73 20 30 29 20 22 50 41 53 53 22 20 tatus 0) "PASS"
124c0 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 28 61 "FAIL")).....((a
124d0 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 74 61 74 nd (string? stat
124e0 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 28 73 us)..... (s
124f0 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 tring->number st
12500 61 74 75 73 29 29 28 69 66 20 28 65 71 75 61 6c atus))(if (equal
12510 3f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 ? (string->numbe
12520 72 20 73 74 61 74 75 73 29 20 30 29 20 22 50 41 r status) 0) "PA
12530 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 09 09 SS" "FAIL"))....
12540 09 28 65 6c 73 65 20 73 74 61 74 75 73 29 29 29 .(else status)))
12550 0a 09 09 20 20 20 20 3b 3b 20 74 72 61 6e 73 66 ... ;; transf
12560 65 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 79 73 er relevant keys
12570 20 69 6e 74 6f 20 61 20 68 61 73 68 20 74 6f 20 into a hash to
12580 62 65 20 70 61 73 73 65 64 20 74 6f 20 74 65 73 be passed to tes
12590 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a 09 09 t-set-status!...
125a0 20 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 73 65 ;; could use
125b0 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 20 49 an assoc list I
125c0 20 67 75 65 73 73 2e 20 0a 09 09 20 20 20 20 28 guess. ... (
125d0 6f 74 68 65 72 64 61 74 61 20 28 6c 65 74 20 28 otherdata (let (
125e0 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d (res (make-hash-
125f0 74 61 62 6c 65 29 29 29 0a 09 09 09 09 20 28 66 table)))..... (f
12600 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
12610 28 6b 65 79 29 0a 09 09 09 09 09 20 20 20 20 20 (key)......
12620 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
12630 67 20 6b 65 79 29 0a 09 09 09 09 09 09 20 28 68 g key)....... (h
12640 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 ash-table-set! r
12650 65 73 20 6b 65 79 20 28 61 72 67 73 3a 67 65 74 es key (args:get
12660 2d 61 72 67 20 6b 65 79 29 29 29 29 0a 09 09 09 -arg key))))....
12670 09 09 20 20 20 28 6c 69 73 74 20 22 3a 76 61 6c .. (list ":val
12680 75 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 78 70 ue" ":tol" ":exp
12690 65 63 74 65 64 22 20 22 3a 66 69 72 73 74 5f 65 ected" ":first_e
126a0 72 72 22 20 22 3a 66 69 72 73 74 5f 77 61 72 6e rr" ":first_warn
126b0 22 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 61 74 " ":units" ":cat
126c0 65 67 6f 72 79 22 20 22 3a 76 61 72 69 61 62 6c egory" ":variabl
126d0 65 22 29 29 0a 09 09 09 09 20 72 65 73 29 29 29 e"))..... res)))
126e0 0a 09 09 28 69 66 20 28 61 6e 64 20 28 61 72 67 ...(if (and (arg
126f0 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
12700 2d 73 74 61 74 75 73 22 29 0a 09 09 09 20 28 6f -status").... (o
12710 72 20 28 6e 6f 74 20 73 74 61 74 65 29 0a 09 09 r (not state)...
12720 09 20 20 20 20 20 28 6e 6f 74 20 73 74 61 74 75 . (not statu
12730 73 29 29 29 0a 09 09 20 20 20 20 28 62 65 67 69 s)))... (begi
12740 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 67 n... (debug
12750 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
12760 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
12770 2a 20 22 59 6f 75 20 6d 75 73 74 20 73 70 65 63 * "You must spec
12780 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a ify :state and :
12790 73 74 61 74 75 73 20 77 69 74 68 20 65 76 65 72 status with ever
127a0 79 20 63 61 6c 6c 20 74 6f 20 2d 74 65 73 74 2d y call to -test-
127b0 73 74 61 74 75 73 5c 6e 22 20 68 65 6c 70 29 0a status\n" help).
127c0 09 09 20 20 20 20 20 20 28 69 66 20 28 73 71 6c .. (if (sql
127d0 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 64 ite3:database? d
127e0 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c b)(sqlite3:final
127f0 69 7a 65 21 20 64 62 29 29 0a 09 09 20 20 20 20 ize! db))...
12800 20 20 28 65 78 69 74 20 36 29 29 29 0a 09 09 28 (exit 6)))...(
12810 6c 65 74 2a 20 28 28 6d 73 67 20 20 20 20 28 61 let* ((msg (a
12820 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
12830 29 29 0a 09 09 20 20 20 20 20 20 20 28 6e 75 6d ))... (num
12840 6f 74 68 20 28 6c 65 6e 67 74 68 20 28 68 61 73 oth (length (has
12850 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 6f 74 68 h-table-keys oth
12860 65 72 64 61 74 61 29 29 29 29 0a 09 09 20 20 3b erdata))))... ;
12870 3b 20 43 6f 6e 76 65 72 74 20 74 6f 20 72 70 63 ; Convert to rpc
12880 20 69 6e 73 69 64 65 20 74 68 65 20 74 65 73 74 inside the test
12890 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
128a0 73 21 20 63 61 6c 6c 2c 20 6e 6f 74 20 68 65 72 s! call, not her
128b0 65 0a 09 09 20 20 28 74 65 73 74 73 3a 74 65 73 e... (tests:tes
128c0 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 t-set-status! ru
128d0 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 61 n-id test-id sta
128e0 74 65 20 6e 65 77 73 74 61 74 75 73 20 6d 73 67 te newstatus msg
128f0 20 6f 74 68 65 72 64 61 74 61 20 77 6f 72 6b 2d otherdata work-
12900 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 61 29 area: work-area)
12910 29 29 29 0a 09 20 20 28 69 66 20 28 73 71 6c 69 ))).. (if (sqli
12920 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 64 62 te3:database? db
12930 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 )(sqlite3:finali
12940 7a 65 21 20 64 62 29 29 0a 09 20 20 28 73 65 74 ze! db)).. (set
12950 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
12960 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d #t))))..;;=====
12970 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12980 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12990 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
129a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
129b0 3d 0a 3b 3b 20 56 61 72 69 6f 75 73 20 68 65 6c =.;; Various hel
129c0 70 65 72 20 63 6f 6d 6d 61 6e 64 73 20 63 61 6e per commands can
129d0 20 67 6f 20 62 65 6c 6f 77 20 68 65 72 65 0a 3b go below here.;
129e0 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
129f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a20 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 =======..(if (or
12a30 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
12a40 2d 73 68 6f 77 6b 65 79 73 22 29 0a 20 20 20 20 -showkeys").
12a50 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
12a60 67 20 22 2d 73 68 6f 77 2d 6b 65 79 73 22 29 29 g "-show-keys"))
12a70 0a 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 23 . (let ((db #
12a80 66 29 0a 09 20 20 28 6b 65 79 73 20 23 66 29 29 f).. (keys #f))
12a90 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
12aa0 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
12ab0 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
12ac0 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
12ad0 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
12ae0 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
12af0 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 p, exiting")..
12b00 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 (exit 1))).
12b10 20 20 20 28 73 65 74 21 20 6b 65 79 73 20 28 72 (set! keys (r
12b20 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 20 3b 3b mt:get-keys)) ;;
12b30 20 20 64 62 29 29 0a 20 20 20 20 20 20 28 64 65 db)). (de
12b40 62 75 67 3a 70 72 69 6e 74 20 31 20 2a 64 65 66 bug:print 1 *def
12b50 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
12b60 4b 65 79 73 3a 20 22 20 28 73 74 72 69 6e 67 2d Keys: " (string-
12b70 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 73 intersperse keys
12b80 20 22 2c 20 22 29 29 0a 20 20 20 20 20 20 28 69 ", ")). (i
12b90 66 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 62 f (sqlite3:datab
12ba0 61 73 65 3f 20 64 62 29 28 73 71 6c 69 74 65 33 ase? db)(sqlite3
12bb0 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
12bc0 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
12bd0 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
12be0 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
12bf0 61 72 67 20 22 2d 67 75 69 22 29 0a 20 20 20 20 arg "-gui").
12c00 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 64 65 (begin. (de
12c10 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
12c20 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
12c30 4c 6f 6f 6b 20 61 74 20 74 68 65 20 64 61 73 68 Look at the dash
12c40 62 6f 61 72 64 20 66 6f 72 20 6e 6f 77 22 29 0a board for now").
12c50 20 20 20 20 20 20 3b 3b 20 28 6d 65 67 61 74 65 ;; (megate
12c60 73 74 2d 67 75 69 29 0a 20 20 20 20 20 20 28 73 st-gui). (s
12c70 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
12c80 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
12c90 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 72 rgs:get-arg "-cr
12ca0 65 61 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 72 eate-megatest-ar
12cb0 65 61 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ea"). (begin.
12cc0 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c (genexampl
12cd0 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2e 63 6f e:mk-megatest.co
12ce0 6e 66 69 67 29 0a 20 20 20 20 20 20 28 73 65 74 nfig). (set
12cf0 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
12d00 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
12d10 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 72 65 61 s:get-arg "-crea
12d20 74 65 2d 74 65 73 74 22 29 0a 20 20 20 20 28 6c te-test"). (l
12d30 65 74 20 28 28 74 65 73 74 6e 61 6d 65 20 28 61 et ((testname (a
12d40 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 72 rgs:get-arg "-cr
12d50 65 61 74 65 2d 74 65 73 74 22 29 29 29 0a 20 20 eate-test"))).
12d60 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 3a (genexample:
12d70 6d 6b 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 mk-megatest-test
12d80 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 20 20 20 testname).
12d90 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
12da0 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d hing* #t)))..;;=
12db0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12dc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12dd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12de0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12df0 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 =====.;; Update
12e00 74 68 65 20 64 61 74 61 62 61 73 65 20 73 63 68 the database sch
12e10 65 6d 61 2c 20 63 6c 65 61 6e 20 75 70 20 74 68 ema, clean up th
12e20 65 20 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d e db.;;=========
12e30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
12e70 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
12e80 20 22 2d 72 65 62 75 69 6c 64 2d 64 62 22 29 0a "-rebuild-db").
12e90 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
12ea0 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 (if (not (launc
12eb0 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 65 h:setup)).. (be
12ec0 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a gin.. (debug:
12ed0 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
12ee0 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c -log-port* "Fail
12ef0 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
12f00 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 78 ting") .. (ex
12f10 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 3b 3b it 1))). ;;
12f20 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c keep this one l
12f30 6f 63 61 6c 0a 20 20 20 20 20 20 28 6f 70 65 6e ocal. (open
12f40 2d 72 75 6e 2d 63 6c 6f 73 65 20 70 61 74 63 68 -run-close patch
12f50 2d 64 62 20 23 66 29 0a 20 20 20 20 20 20 28 73 -db #f). (s
12f60 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
12f70 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
12f80 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6c rgs:get-arg "-cl
12f90 65 61 6e 75 70 2d 64 62 22 29 0a 20 20 20 20 28 eanup-db"). (
12fa0 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 begin. (if
12fb0 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 (not (launch:set
12fc0 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 up)).. (begin..
12fd0 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
12fe0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
12ff0 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f port* "Failed to
13000 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
13010 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ) .. (exit 1)
13020 29 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 )). (let ((
13030 64 62 73 74 72 75 63 74 20 28 64 62 3a 73 65 74 dbstruct (db:set
13040 75 70 20 2a 74 6f 70 70 61 74 68 2a 29 29 29 0a up *toppath*))).
13050 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a (common:
13060 63 6c 65 61 6e 75 70 2d 64 62 20 64 62 73 74 72 cleanup-db dbstr
13070 75 63 74 29 29 0a 20 20 20 20 20 20 28 73 65 74 uct)). (set
13080 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
13090 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
130a0 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 61 72 6b s:get-arg "-mark
130b0 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 22 29 0a 20 -incompletes").
130c0 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
130d0 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 (if (not (launch
130e0 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 65 67 :setup)).. (beg
130f0 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 in.. (debug:p
13100 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
13110 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 log-port* "Faile
13120 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit
13130 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 69 74 ing").. (exit
13140 20 31 29 29 29 0a 20 20 20 20 20 20 28 6f 70 65 1))). (ope
13150 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 66 n-run-close db:f
13160 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 ind-and-mark-inc
13170 6f 6d 70 6c 65 74 65 20 23 66 29 0a 20 20 20 20 omplete #f).
13180 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
13190 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
131a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131e0 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 ======.;; Update
131f0 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 61 20 the tests meta
13200 64 61 74 61 20 66 72 6f 6d 20 74 68 65 20 74 65 data from the te
13210 73 74 63 6f 6e 66 69 67 20 66 69 6c 65 73 0a 3b stconfig files.;
13220 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
13230 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13240 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13250 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13260 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
13270 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 70 64 gs:get-arg "-upd
13280 61 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 20 28 ate-meta"). (
13290 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 begin. (if
132a0 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 (not (launch:set
132b0 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 up)).. (begin..
132c0 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
132d0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
132e0 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f port* "Failed to
132f0 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
13300 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ) .. (exit 1)
13310 29 29 0a 20 20 20 20 20 20 28 72 75 6e 73 3a 75 )). (runs:u
13320 70 64 61 74 65 2d 61 6c 6c 2d 74 65 73 74 5f 6d pdate-all-test_m
13330 65 74 61 20 23 66 29 0a 20 20 20 20 20 20 28 73 eta #f). (s
13340 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
13350 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d g* #t)))..;;====
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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13390 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
133a0 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 61 20 72 65 ==.;; Start a re
133b0 70 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d pl.;;===========
133c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
133d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
133e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
133f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
13400 66 61 6b 65 6f 75 74 20 72 65 61 64 6c 69 6e 65 fakeout readline
13410 0a 28 69 6e 63 6c 75 64 65 20 22 72 65 61 64 6c .(include "readl
13420 69 6e 65 2d 66 69 78 2e 73 63 6d 22 29 0a 0a 0a ine-fix.scm")...
13430 28 77 68 65 6e 20 28 61 72 67 73 3a 67 65 74 2d (when (args:get-
13440 61 72 67 20 22 2d 64 69 66 66 2d 72 65 70 22 29 arg "-diff-rep")
13450 0a 20 20 28 77 68 65 6e 20 28 61 6e 64 0a 20 20 . (when (and.
13460 20 20 20 20 20 20 20 28 6e 6f 74 20 28 61 72 67 (not (arg
13470 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 69 66 66 s:get-arg "-diff
13480 2d 68 74 6d 6c 22 29 29 0a 20 20 20 20 20 20 20 -html")).
13490 20 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 (not (args:get
134a0 2d 61 72 67 20 22 2d 64 69 66 66 2d 65 6d 61 69 -arg "-diff-emai
134b0 6c 22 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 l"))). (debug
134c0 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
134d0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 75 73 t-log-port* "Mus
134e0 74 20 73 70 65 63 69 66 79 20 2d 64 69 66 66 2d t specify -diff-
134f0 68 74 6d 6c 20 6f 72 20 2d 64 69 66 66 2d 65 6d html or -diff-em
13500 61 69 6c 20 77 69 74 68 20 2d 64 69 66 66 2d 72 ail with -diff-r
13510 65 70 22 29 0a 20 20 20 20 28 73 65 74 21 20 2a ep"). (set! *
13520 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 31 29 didsomething* 1)
13530 0a 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 20 . (exit 1)).
13540 20 0a 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 . (let* ((topp
13550 61 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 ath (launch:setu
13560 70 29 29 29 0a 20 20 20 20 28 64 6f 2d 64 69 66 p))). (do-dif
13570 66 2d 72 65 70 6f 72 74 0a 20 20 20 20 20 28 61 f-report. (a
13580 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 72 rgs:get-arg "-sr
13590 63 2d 74 61 72 67 65 74 22 29 0a 20 20 20 20 20 c-target").
135a0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
135b0 73 72 63 2d 72 75 6e 6e 61 6d 65 22 29 0a 20 20 src-runname").
135c0 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
135d0 20 22 2d 74 61 72 67 65 74 22 29 0a 20 20 20 20 "-target").
135e0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
135f0 2d 72 75 6e 6e 61 6d 65 22 29 0a 20 20 20 20 20 -runname").
13600 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
13610 64 69 66 66 2d 68 74 6d 6c 22 29 0a 20 20 20 20 diff-html").
13620 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
13630 2d 64 69 66 66 2d 65 6d 61 69 6c 22 29 29 0a 20 -diff-email")).
13640 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
13650 65 74 68 69 6e 67 2a 20 23 74 29 0a 20 20 20 20 ething* #t).
13660 28 65 78 69 74 20 30 29 29 29 0a 0a 28 69 66 20 (exit 0)))..(if
13670 28 6f 72 20 28 67 65 74 65 6e 76 20 22 4d 54 5f (or (getenv "MT_
13680 52 55 4e 53 43 52 49 50 54 22 29 0a 09 28 61 72 RUNSCRIPT")..(ar
13690 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 gs:get-arg "-rep
136a0 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 l")..(args:get-a
136b0 72 67 20 22 2d 6c 6f 61 64 22 29 29 0a 20 20 20 rg "-load")).
136c0 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 (let* ((toppath
136d0 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
136e0 0a 09 20 20 20 28 64 62 73 74 72 75 63 74 20 28 .. (dbstruct (
136f0 69 66 20 28 61 6e 64 20 74 6f 70 70 61 74 68 0a if (and toppath.
13700 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13710 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
13720 6f 6d 6d 6f 6e 3a 6f 6e 2d 68 6f 6d 65 68 6f 73 ommon:on-homehos
13730 74 3f 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t?)).
13740 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 (d
13750 62 3a 73 65 74 75 70 29 0a 20 20 20 20 20 20 20 b:setup).
13760 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13770 20 20 23 66 29 29 29 20 3b 3b 20 6d 61 6b 65 2d #f))) ;; make-
13780 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 dbr:dbstruct pat
13790 68 3a 20 74 6f 70 70 61 74 68 20 6c 6f 63 61 6c h: toppath local
137a0 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 : (args:get-arg
137b0 22 2d 6c 6f 63 61 6c 22 29 29 20 23 66 29 29 29 "-local")) #f)))
137c0 0a 20 20 20 20 20 20 28 69 66 20 2a 74 6f 70 70 . (if *topp
137d0 61 74 68 2a 0a 09 20 20 28 63 6f 6e 64 0a 09 20 ath*.. (cond..
137e0 20 20 28 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 ((getenv "MT_R
137f0 55 4e 53 43 52 49 50 54 22 29 0a 09 20 20 20 20 UNSCRIPT")..
13800 3b 3b 20 48 6f 77 20 74 6f 20 72 75 6e 20 6d 65 ;; How to run me
13810 67 61 74 65 73 74 20 73 63 72 69 70 74 73 0a 09 gatest scripts..
13820 20 20 20 20 3b 3b 0a 09 20 20 20 20 3b 3b 20 23 ;;.. ;; #
13830 21 2f 62 69 6e 2f 62 61 73 68 0a 09 20 20 20 20 !/bin/bash..
13840 3b 3b 0a 09 20 20 20 20 3b 3b 20 65 78 70 6f 72 ;;.. ;; expor
13850 74 20 4d 54 5f 52 55 4e 53 43 52 49 50 54 3d 79 t MT_RUNSCRIPT=y
13860 65 73 0a 09 20 20 20 20 3b 3b 20 6d 65 67 61 74 es.. ;; megat
13870 65 73 74 20 3c 3c 20 45 4f 46 0a 09 20 20 20 20 est << EOF..
13880 3b 3b 20 28 70 72 69 6e 74 20 22 48 65 6c 6c 6f ;; (print "Hello
13890 20 77 6f 72 6c 64 22 29 0a 09 20 20 20 20 3b 3b world").. ;;
138a0 20 28 65 78 69 74 29 0a 09 20 20 20 20 3b 3b 20 (exit).. ;;
138b0 45 4f 46 0a 0a 09 20 20 20 20 28 72 65 70 6c 29 EOF... (repl)
138c0 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 20 20 20 ).. (else..
138d0 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 (begin.. (
138e0 73 65 74 21 20 2a 64 62 2a 20 64 62 73 74 72 75 set! *db* dbstru
138f0 63 74 29 0a 09 20 20 20 20 20 20 28 69 6d 70 6f ct).. (impo
13900 72 74 20 65 78 74 72 61 73 29 20 3b 3b 20 6d 69 rt extras) ;; mi
13910 67 68 74 20 6e 6f 74 20 62 65 20 6e 65 65 64 65 ght not be neede
13920 64 0a 09 20 20 20 20 20 20 3b 3b 20 28 69 6d 70 d.. ;; (imp
13930 6f 72 74 20 63 73 69 29 0a 09 20 20 20 20 20 20 ort csi)..
13940 28 69 6d 70 6f 72 74 20 72 65 61 64 6c 69 6e 65 (import readline
13950 29 0a 09 20 20 20 20 20 20 28 69 6d 70 6f 72 74 ).. (import
13960 20 61 70 72 6f 70 6f 73 29 0a 09 20 20 20 20 20 apropos)..
13970 20 3b 3b 20 28 69 6d 70 6f 72 74 20 28 70 72 65 ;; (import (pre
13980 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 fix sqlite3 sqli
13990 74 65 33 3a 29 29 20 3b 3b 20 64 6f 65 73 6e 27 te3:)) ;; doesn'
139a0 74 20 77 6f 72 6b 20 2e 2e 2e 0a 0a 09 20 20 20 t work ......
139b0 20 20 20 28 69 66 20 2a 75 73 65 2d 6e 65 77 2d (if *use-new-
139c0 72 65 61 64 6c 69 6e 65 2a 0a 09 09 20 20 28 62 readline*... (b
139d0 65 67 69 6e 0a 09 09 20 20 20 20 28 69 6e 73 74 egin... (inst
139e0 61 6c 6c 2d 68 69 73 74 6f 72 79 2d 66 69 6c 65 all-history-file
139f0 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e (get-environmen
13a00 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 t-variable "HOME
13a10 22 29 20 22 2e 6d 65 67 61 74 65 73 74 5f 68 69 ") ".megatest_hi
13a20 73 74 6f 72 79 22 29 20 3b 3b 20 20 5b 68 6f 6d story") ;; [hom
13a30 65 64 69 72 5d 20 5b 66 69 6c 65 6e 61 6d 65 5d edir] [filename]
13a40 20 5b 6e 6c 69 6e 65 73 5d 29 0a 09 09 20 20 20 [nlines])...
13a50 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 2d (current-input-
13a60 70 6f 72 74 20 28 6d 61 6b 65 2d 72 65 61 64 6c port (make-readl
13a70 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 65 ine-port "megate
13a80 73 74 3e 20 22 29 29 29 0a 09 09 20 20 28 62 65 st> ")))... (be
13a90 67 69 6e 0a 09 09 20 20 20 20 28 67 6e 75 2d 68 gin... (gnu-h
13aa0 69 73 74 6f 72 79 2d 69 6e 73 74 61 6c 6c 2d 66 istory-install-f
13ab0 69 6c 65 2d 6d 61 6e 61 67 65 72 0a 09 09 20 20 ile-manager...
13ac0 20 20 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e (string-appen
13ad0 64 0a 09 09 20 20 20 20 20 20 28 6f 72 20 28 67 d... (or (g
13ae0 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
13af0 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 ariable "HOME")
13b00 22 2e 22 29 20 22 2f 2e 6d 65 67 61 74 65 73 74 ".") "/.megatest
13b10 5f 68 69 73 74 6f 72 79 22 29 29 0a 09 09 20 20 _history"))...
13b20 20 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 (current-input
13b30 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 67 6e 75 2d -port (make-gnu-
13b40 72 65 61 64 6c 69 6e 65 2d 70 6f 72 74 20 22 6d readline-port "m
13b50 65 67 61 74 65 73 74 3e 20 22 29 29 29 29 0a 09 egatest> "))))..
13b60 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a (if (args:
13b70 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 29 get-arg "-repl")
13b80 0a 09 09 20 20 28 72 65 70 6c 29 0a 09 09 20 20 ... (repl)...
13b90 28 6c 6f 61 64 20 28 61 72 67 73 3a 67 65 74 2d (load (args:get-
13ba0 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 29 0a 09 arg "-load")))..
13bb0 20 20 20 20 20 20 3b 3b 20 28 64 62 3a 63 6c 6f ;; (db:clo
13bc0 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 29 se-all dbstruct)
13bd0 20 3c 3d 20 74 61 6b 65 6e 20 63 61 72 65 20 6f <= taken care o
13be0 66 20 62 79 20 6f 6e 2d 65 78 69 74 20 63 61 6c f by on-exit cal
13bf0 6c 0a 09 20 20 20 20 20 20 29 0a 09 20 20 20 20 l.. )..
13c00 28 65 78 69 74 29 29 29 0a 09 20 20 28 73 65 74 (exit))).. (set
13c10 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
13c20 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d #t))))..;;=====
13c30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13c40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13c50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13c60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13c70 3d 0a 3b 3b 20 57 61 69 74 20 6f 6e 20 61 20 72 =.;; Wait on a r
13c80 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 65 0a 3b un to complete.;
13c90 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
13ca0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13cb0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13cc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13cd0 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 6e =======..(if (an
13ce0 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
13cf0 22 2d 72 75 6e 2d 77 61 69 74 22 29 0a 09 20 28 "-run-wait").. (
13d00 6e 6f 74 20 28 6f 72 20 28 61 72 67 73 3a 67 65 not (or (args:ge
13d10 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a 09 09 t-arg "-run")...
13d20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
13d30 22 2d 72 75 6e 74 65 73 74 73 22 29 29 29 29 20 "-runtests"))))
13d40 3b 3b 20 72 75 6e 2d 77 61 69 74 20 69 73 20 62 ;; run-wait is b
13d50 75 69 6c 74 20 69 6e 74 6f 20 72 75 6e 74 65 73 uilt into runtes
13d60 74 73 20 6e 6f 77 0a 20 20 20 20 28 62 65 67 69 ts now. (begi
13d70 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 n. (if (not
13d80 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
13d90 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
13da0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
13db0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
13dc0 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
13dd0 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 up, exiting") ..
13de0 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
13df0 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e (operate-on
13e00 20 27 72 75 6e 2d 77 61 69 74 29 0a 20 20 20 20 'run-wait).
13e10 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
13e20 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
13e30 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 3b ;; ;; redo me ;
13e40 3b 20 4e 6f 74 20 63 6f 6e 76 65 72 74 65 64 20 ; Not converted
13e50 74 6f 20 75 73 65 20 64 62 73 74 72 75 63 74 20 to use dbstruct
13e60 79 65 74 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 yet.;; ;; ;; red
13e70 6f 20 6d 65 20 3b 3b 0a 3b 3b 20 3b 3b 20 3b 3b o me ;;.;; ;; ;;
13e80 20 72 65 64 6f 20 6d 65 20 28 69 66 20 28 61 72 redo me (if (ar
13e90 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e gs:get-arg "-con
13ea0 76 65 72 74 2d 74 6f 2d 6e 6f 72 6d 22 29 0a 3b vert-to-norm").;
13eb0 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
13ec0 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 (let* ((topp
13ed0 61 74 68 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 ath (setup-for-r
13ee0 75 6e 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 un)).;; ;; ;; re
13ef0 64 6f 20 6d 65 20 09 20 20 20 28 64 62 73 74 72 do me . (dbstr
13f00 75 63 74 20 28 69 66 20 74 6f 70 70 61 74 68 20 uct (if toppath
13f10 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 (make-dbr:dbstru
13f20 63 74 20 70 61 74 68 3a 20 74 6f 70 70 61 74 68 ct path: toppath
13f30 20 6c 6f 63 61 6c 3a 20 23 74 29 29 29 29 0a 3b local: #t)))).;
13f40 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
13f50 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
13f60 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13f70 65 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 e (lambda
13f80 20 28 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b (field).;; ;; ;
13f90 3b 20 72 65 64 6f 20 6d 65 20 09 20 28 6c 65 74 ; redo me . (let
13fa0 20 28 28 64 61 74 20 27 28 29 29 29 0a 3b 3b 20 ((dat '())).;;
13fb0 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 ;; ;; redo me .
13fc0 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
13fd0 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
13fe0 6f 67 2d 70 6f 72 74 2a 20 22 47 65 74 74 69 6e og-port* "Gettin
13ff0 67 20 64 61 74 61 20 66 6f 72 20 66 69 65 6c 64 g data for field
14000 20 22 20 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 " field).;; ;;
14010 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 ;; redo me . (
14020 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
14030 2d 72 6f 77 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 -row.;; ;; ;; re
14040 64 6f 20 6d 65 20 09 20 20 20 20 28 6c 61 6d 62 do me . (lamb
14050 64 61 20 28 69 64 20 76 61 6c 29 0a 3b 3b 20 3b da (id val).;; ;
14060 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 ; ;; redo me .
14070 20 20 20 20 28 73 65 74 21 20 64 61 74 20 28 63 (set! dat (c
14080 6f 6e 73 20 28 6c 69 73 74 20 69 64 20 76 61 6c ons (list id val
14090 29 20 64 61 74 29 29 29 0a 3b 3b 20 3b 3b 20 3b ) dat))).;; ;; ;
140a0 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 28 ; redo me . (
140b0 64 62 3a 67 65 74 2d 64 62 20 64 62 20 72 75 6e db:get-db db run
140c0 2d 69 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 -id).;; ;; ;; re
140d0 64 6f 20 6d 65 20 09 20 20 20 20 28 63 6f 6e 63 do me . (conc
140e0 20 22 53 45 4c 45 43 54 20 69 64 2c 22 20 66 69 "SELECT id," fi
140f0 65 6c 64 20 22 20 46 52 4f 4d 20 74 65 73 74 73 eld " FROM tests
14100 3b 22 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 ;")).;; ;; ;; re
14110 64 6f 20 6d 65 20 09 20 20 20 28 64 65 62 75 67 do me . (debug
14120 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 :print-info 0 *d
14130 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
14140 20 22 66 6f 75 6e 64 20 22 20 28 6c 65 6e 67 74 "found " (lengt
14150 68 20 64 61 74 29 20 22 20 69 74 65 6d 73 20 66 h dat) " items f
14160 6f 72 20 66 69 65 6c 64 20 22 20 66 69 65 6c 64 or field " field
14170 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
14180 6d 65 20 09 20 20 20 28 6c 65 74 20 28 28 71 72 me . (let ((qr
14190 79 20 28 73 71 6c 69 74 65 33 3a 70 72 65 70 61 y (sqlite3:prepa
141a0 72 65 20 64 62 20 28 63 6f 6e 63 20 22 55 50 44 re db (conc "UPD
141b0 41 54 45 20 74 65 73 74 73 20 53 45 54 20 22 20 ATE tests SET "
141c0 66 69 65 6c 64 20 22 3d 3f 20 57 48 45 52 45 20 field "=? WHERE
141d0 69 64 3d 3f 3b 22 29 29 29 29 0a 3b 3b 20 3b 3b id=?;")))).;; ;;
141e0 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
141f0 20 20 28 66 6f 72 2d 65 61 63 68 0a 3b 3b 20 3b (for-each.;; ;
14200 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 ; ;; redo me .
14210 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 74 65 (lambda (ite
14220 6d 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f m).;; ;; ;; redo
14230 20 6d 65 20 09 09 28 6c 65 74 20 28 28 6e 65 77 me ..(let ((new
14240 76 61 6c 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 val ;; (sdb:qry
14250 27 67 65 74 69 64 20 0a 3b 3b 20 3b 3b 20 3b 3b 'getid .;; ;; ;;
14260 20 72 65 64 6f 20 6d 65 20 09 09 20 20 20 20 20 redo me ..
14270 20 20 28 63 61 64 72 20 69 74 65 6d 29 29 29 20 (cadr item)))
14280 3b 3b 20 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 ;; ).;; ;; ;; re
14290 64 6f 20 6d 65 20 09 09 20 20 28 69 66 20 28 6e do me .. (if (n
142a0 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 77 76 61 ot (equal? newva
142b0 6c 20 28 63 61 64 72 20 69 74 65 6d 29 29 29 0a l (cadr item))).
142c0 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
142d0 20 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a .. (debug:
142e0 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
142f0 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
14300 22 43 6f 6e 76 65 72 74 69 6e 67 20 22 20 28 63 "Converting " (c
14310 61 64 72 20 69 74 65 6d 29 20 22 20 74 6f 20 22 adr item) " to "
14320 20 6e 65 77 76 61 6c 20 22 20 66 6f 72 20 74 65 newval " for te
14330 73 74 20 23 22 20 28 63 61 72 20 69 74 65 6d 29 st #" (car item)
14340 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f )).;; ;; ;; redo
14350 20 6d 65 20 09 09 20 20 28 73 71 6c 69 74 65 33 me .. (sqlite3
14360 3a 65 78 65 63 75 74 65 20 71 72 79 20 6e 65 77 :execute qry new
14370 76 61 6c 20 28 63 61 72 20 69 74 65 6d 29 29 29 val (car item)))
14380 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
14390 6d 65 20 09 20 20 20 20 20 20 64 61 74 29 0a 3b me . dat).;
143a0 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
143b0 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 . (sqlite3:f
143c0 69 6e 61 6c 69 7a 65 21 20 71 72 79 29 29 29 29 inalize! qry))))
143d0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
143e0 65 20 20 20 20 20 20 20 20 28 64 62 3a 63 6c 6f e (db:clo
143f0 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 29 se-all dbstruct)
14400 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
14410 65 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 22 e (list "
14420 75 6e 61 6d 65 22 20 22 72 75 6e 64 69 72 22 20 uname" "rundir"
14430 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 22 63 6f "final_logf" "co
14440 6d 6d 65 6e 74 22 29 29 0a 3b 3b 20 3b 3b 20 3b mment")).;; ;; ;
14450 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 20 20 ; redo me
14460 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
14470 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
14480 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
14490 69 6d 70 6f 72 74 2d 6d 65 67 61 74 65 73 74 2e import-megatest.
144a0 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a db"). (begin.
144b0 20 20 20 20 20 20 28 64 62 3a 6d 75 6c 74 69 2d (db:multi-
144c0 64 62 2d 73 79 6e 63 20 0a 20 20 20 20 20 20 20 db-sync .
144d0 28 64 62 3a 73 65 74 75 70 29 0a 20 20 20 20 20 (db:setup).
144e0 20 20 27 6b 69 6c 6c 73 65 72 76 65 72 73 0a 20 'killservers.
144f0 20 20 20 20 20 20 27 64 65 6a 75 6e 6b 0a 20 20 'dejunk.
14500 20 20 20 20 20 27 61 64 6a 2d 74 65 73 74 69 64 'adj-testid
14510 73 0a 20 20 20 20 20 20 20 27 6f 6c 64 32 6e 65 s. 'old2ne
14520 77 0a 20 20 20 20 20 20 20 3b 3b 20 27 6e 65 77 w. ;; 'new
14530 32 6f 6c 64 0a 20 20 20 20 20 20 20 29 0a 20 20 2old. ).
14540 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
14550 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
14560 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
14570 67 20 22 2d 73 79 6e 63 2d 74 6f 2d 6d 65 67 61 g "-sync-to-mega
14580 74 65 73 74 2e 64 62 22 29 0a 20 20 20 20 28 62 test.db"). (b
14590 65 67 69 6e 0a 20 20 20 20 20 20 28 64 62 3a 6d egin. (db:m
145a0 75 6c 74 69 2d 64 62 2d 73 79 6e 63 20 0a 20 20 ulti-db-sync .
145b0 20 20 20 20 20 28 64 62 3a 73 65 74 75 70 29 0a (db:setup).
145c0 20 20 20 20 20 20 20 27 6e 65 77 32 6f 6c 64 0a 'new2old.
145d0 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 20 28 ). (
145e0 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
145f0 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 ng* #t)))..(if (
14600 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 args:get-arg "-g
14610 65 6e 65 72 61 74 65 2d 68 74 6d 6c 22 29 0a 20 enerate-html").
14620 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 (let* ((toppa
14630 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 th (launch:setup
14640 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 74 ))). (if (t
14650 65 73 74 73 3a 63 72 65 61 74 65 2d 68 74 6d 6c ests:create-html
14660 2d 74 72 65 65 20 23 66 29 0a 20 20 20 20 20 20 -tree #f).
14670 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
14680 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
14690 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 48 54 4d 4c -log-port* "HTML
146a0 20 6f 75 74 70 75 74 20 63 72 65 61 74 65 64 20 output created
146b0 69 6e 20 22 20 74 6f 70 70 61 74 68 20 22 2f 6c in " toppath "/l
146c0 74 2f 70 61 67 65 23 2e 68 74 6d 6c 22 29 0a 20 t/page#.html").
146d0 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
146e0 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
146f0 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c -log-port* "Fail
14700 65 64 20 74 6f 20 63 72 65 61 74 65 20 48 54 4d ed to create HTM
14710 4c 20 6f 75 74 70 75 74 20 69 6e 20 22 20 74 6f L output in " to
14720 70 70 61 74 68 20 22 2f 6c 74 2f 72 75 6e 73 2d ppath "/lt/runs-
14730 69 6e 64 65 78 2e 68 74 6d 6c 22 29 29 0a 20 20 index.html")).
14740 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
14750 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
14760 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
14770 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14780 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14790 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
147a0 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 69 74 ========.;; Exit
147b0 20 61 6e 64 20 63 6c 65 61 6e 20 75 70 0a 3b 3b and clean up.;;
147c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
147d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
147e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
147f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14800 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6e 6f 74 ======..(if (not
14810 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 29 *didsomething*)
14820 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
14830 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
14840 2d 70 6f 72 74 2a 20 68 65 6c 70 29 29 0a 3b 3b -port* help)).;;
14850 28 42 42 3e 20 22 74 68 72 65 61 64 2d 6a 6f 69 (BB> "thread-joi
14860 6e 21 20 77 61 74 63 68 64 6f 67 22 29 0a 0a 3b n! watchdog")..;
14870 3b 20 6a 6f 69 6e 20 74 68 65 20 77 61 74 63 68 ; join the watch
14880 64 6f 67 20 74 68 72 65 61 64 20 69 66 20 69 74 dog thread if it
14890 20 68 61 73 20 62 65 65 6e 20 74 68 72 65 61 64 has been thread
148a0 2d 73 74 61 72 74 21 65 64 20 20 28 69 74 20 6d -start!ed (it m
148b0 61 79 20 6e 6f 74 20 68 61 76 65 20 62 65 65 6e ay not have been
148c0 20 73 74 61 72 74 65 64 20 69 6e 20 74 68 65 20 started in the
148d0 63 61 73 65 20 6f 66 20 61 20 73 65 72 76 65 72 case of a server
148e0 20 74 68 61 74 20 6e 65 76 65 72 20 65 6e 74 65 that never ente
148f0 72 73 20 72 75 6e 6e 69 6e 67 20 73 74 61 74 65 rs running state
14900 29 0a 3b 3b 20 20 20 28 73 79 6d 62 6f 6c 73 20 ).;; (symbols
14910 72 65 74 75 72 6e 65 64 20 62 79 20 74 68 72 65 returned by thre
14920 61 64 2d 73 74 61 74 65 3a 20 63 72 65 61 74 65 ad-state: create
14930 64 20 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 20 d ready running
14940 62 6c 6f 63 6b 65 64 20 73 75 73 70 65 6e 64 65 blocked suspende
14950 64 20 73 6c 65 65 70 69 6e 67 20 74 65 72 6d 69 d sleeping termi
14960 6e 61 74 65 64 20 64 65 61 64 29 0a 28 69 66 20 nated dead).(if
14970 28 74 68 72 65 61 64 3f 20 2a 77 61 74 63 68 64 (thread? *watchd
14980 6f 67 2a 29 0a 20 20 20 20 28 63 61 73 65 20 28 og*). (case (
14990 74 68 72 65 61 64 2d 73 74 61 74 65 20 2a 77 61 thread-state *wa
149a0 74 63 68 64 6f 67 2a 29 0a 20 20 20 20 20 20 28 tchdog*). (
149b0 28 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 20 62 (ready running b
149c0 6c 6f 63 6b 65 64 20 73 6c 65 65 70 69 6e 67 20 locked sleeping
149d0 74 65 72 6d 69 6e 61 74 65 64 20 64 65 61 64 29 terminated dead)
149e0 0a 20 20 20 20 20 20 20 28 74 68 72 65 61 64 2d . (thread-
149f0 6a 6f 69 6e 21 20 2a 77 61 74 63 68 64 6f 67 2a join! *watchdog*
14a00 29 29 29 29 0a 0a 28 73 65 74 21 20 2a 74 69 6d ))))..(set! *tim
14a10 65 2d 74 6f 2d 65 78 69 74 2a 20 23 74 29 0a 0a e-to-exit* #t)..
14a20 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 2a 67 (if (not (eq? *g
14a30 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
14a40 20 30 29 29 0a 20 20 20 20 28 69 66 20 28 6f 72 0)). (if (or
14a50 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
14a60 2d 72 75 6e 22 29 28 61 72 67 73 3a 67 65 74 2d -run")(args:get-
14a70 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
14a80 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
14a90 72 75 6e 61 6c 6c 22 29 29 0a 20 20 20 20 20 20 runall")).
14aa0 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
14ab0 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
14ac0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
14ad0 70 6f 72 74 2a 20 22 4e 4f 54 45 3a 20 53 75 62 port* "NOTE: Sub
14ae0 70 72 6f 63 65 73 73 65 73 20 77 69 74 68 20 6e processes with n
14af0 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 20 63 6f 64 on-zero exit cod
14b00 65 20 64 65 74 65 63 74 65 64 3a 20 22 20 2a 67 e detected: " *g
14b10 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
14b20 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 78 ). (ex
14b30 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 28 it 0)). (
14b40 63 61 73 65 20 2a 67 6c 6f 62 61 6c 65 78 69 74 case *globalexit
14b50 73 74 61 74 75 73 2a 0a 20 20 20 20 20 20 20 20 status*.
14b60 20 28 28 30 29 28 65 78 69 74 20 30 29 29 0a 20 ((0)(exit 0)).
14b70 20 20 20 20 20 20 20 20 28 28 31 29 28 65 78 69 ((1)(exi
14b80 74 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 28 t 1)). (
14b90 28 32 29 28 65 78 69 74 20 32 29 29 0a 20 20 20 (2)(exit 2)).
14ba0 20 20 20 20 20 20 28 65 6c 73 65 20 28 65 78 69 (else (exi
14bb0 74 20 33 29 29 29 29 29 0a t 3))))).