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 3b 3b 20 28 72 65 61 64 2d 63 6f 6e . ;; (read-con
8400: 66 69 67 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 fig (conc *toppa
8410: 74 68 2a 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 th* "/runconfigs
8420: 2e 63 6f 6e 66 69 67 22 29 20 23 66 20 23 74 20 .config") #f #t
8430: 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f sections: sectio
8440: 6e 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 ns)))).
8450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8460: 20 20 28 72 75 6e 63 6f 6e 66 69 67 3a 72 65 61 (runconfig:rea
8470: 64 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 d (conc *toppath
8480: 2a 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 * "/runconfigs.c
8490: 6f 6e 66 69 67 22 29 20 74 61 72 67 65 74 20 23 onfig") target #
84a0: 66 29 29 29 29 0a 09 20 20 28 69 66 20 28 61 6e f)))).. (if (an
84b0: 64 20 72 75 6e 64 69 72 20 3b 3b 20 68 61 76 65 d rundir ;; have
84c0: 20 61 6c 6c 20 6e 65 65 64 65 64 20 76 61 72 69 all needed vari
84d0: 61 62 6c 65 73 73 0a 09 09 20 20 20 28 64 69 72 abless... (dir
84e0: 65 63 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 72 ectory-exists? r
84f0: 75 6e 64 69 72 29 0a 09 09 20 20 20 28 66 69 6c undir)... (fil
8500: 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 e-write-access?
8510: 72 75 6e 64 69 72 29 29 0a 09 20 20 20 20 20 20 rundir))..
8520: 28 62 65 67 69 6e 0a 09 09 28 63 6f 6e 66 69 67 (begin...(config
8530: 66 3a 77 72 69 74 65 2d 61 6c 69 73 74 20 64 61 f:write-alist da
8540: 74 61 20 63 66 67 66 29 0a 09 09 3b 3b 20 66 6f ta cfgf)...;; fo
8550: 72 63 65 20 72 65 2d 72 65 61 64 20 6f 66 20 6d rce re-read of m
8560: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 2d egatest.config -
8570: 20 74 68 69 73 20 72 65 73 6f 6c 76 65 73 20 63 this resolves c
8580: 69 72 63 75 6c 61 72 20 72 65 66 65 72 65 6e 63 ircular referenc
8590: 65 73 20 62 65 74 77 65 65 6e 20 6d 65 67 61 74 es between megat
85a0: 65 73 74 2e 63 6f 6e 66 69 67 0a 09 09 28 6c 61 est.config...(la
85b0: 75 6e 63 68 3a 73 65 74 75 70 20 66 6f 72 63 65 unch:setup force
85c0: 3a 20 23 74 29 0a 09 09 28 6c 61 75 6e 63 68 3a : #t)...(launch:
85d0: 63 61 63 68 65 2d 63 6f 6e 66 69 67 29 29 29 20 cache-config)))
85e0: 3b 3b 20 77 65 20 63 61 6e 20 73 61 66 65 6c 79 ;; we can safely
85f0: 20 63 61 63 68 65 20 6d 65 67 61 74 65 73 74 2e cache megatest.
8600: 63 6f 6e 66 69 67 20 73 69 6e 63 65 20 77 65 20 config since we
8610: 68 61 76 65 20 61 20 76 61 6c 69 64 20 72 75 6e have a valid run
8620: 63 6f 6e 66 69 67 0a 09 20 20 64 61 74 61 29 29 config.. data))
8630: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
8640: 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 72 75 6e t-arg "-show-run
8650: 63 6f 6e 66 69 67 22 29 0a 20 20 20 20 28 6c 65 config"). (le
8660: 74 20 28 28 74 6c 20 28 6c 61 75 6e 63 68 3a 73 t ((tl (launch:s
8670: 65 74 75 70 29 29 29 0a 20 20 20 20 20 20 28 70 etup))). (p
8680: 75 73 68 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 ush-directory *t
8690: 6f 70 70 61 74 68 2a 29 0a 20 20 20 20 20 20 28 oppath*). (
86a0: 6c 65 74 20 28 28 64 61 74 61 20 28 66 75 6c 6c let ((data (full
86b0: 2d 72 75 6e 63 6f 6e 66 69 67 73 2d 72 65 61 64 -runconfigs-read
86c0: 29 29 29 0a 09 3b 3b 20 6b 65 65 70 20 74 68 69 )))..;; keep thi
86d0: 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 09 28 63 6f s one local..(co
86e0: 6e 64 0a 09 20 28 28 61 6e 64 20 28 61 72 67 73 nd.. ((and (args
86f0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 :get-arg "-secti
8700: 6f 6e 22 29 0a 09 20 20 20 20 20 20 20 28 61 72 on").. (ar
8710: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 gs:get-arg "-var
8720: 22 29 29 0a 09 20 20 28 6c 65 74 20 28 28 76 61 ")).. (let ((va
8730: 6c 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c l (or (configf:l
8740: 6f 6f 6b 75 70 20 64 61 74 61 20 28 61 72 67 73 ookup data (args
8750: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 :get-arg "-secti
8760: 6f 6e 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 on")(args:get-ar
8770: 67 20 22 2d 76 61 72 22 29 29 0a 09 09 09 20 28 g "-var")).... (
8780: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 configf:lookup d
8790: 61 74 61 20 22 64 65 66 61 75 6c 74 22 20 28 61 ata "default" (a
87a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 rgs:get-arg "-va
87b0: 72 22 29 29 29 29 29 0a 09 20 20 20 20 28 69 66 r"))))).. (if
87c0: 20 76 61 6c 20 28 70 72 69 6e 74 20 76 61 6c 29 val (print val)
87d0: 29 29 29 0a 09 20 28 28 6f 72 20 28 6e 6f 74 20 ))).. ((or (not
87e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
87f0: 64 75 6d 70 6d 6f 64 65 22 29 29 0a 20 20 20 20 dumpmode")).
8800: 20 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e (strin
8810: 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 g=? (args:get-ar
8820: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
8830: 69 6e 69 22 29 29 0a 09 20 20 28 63 6f 6e 66 69 ini")).. (confi
8840: 67 66 3a 63 6f 6e 66 69 67 2d 3e 69 6e 69 20 64 gf:config->ini d
8850: 61 74 61 29 29 0a 09 20 28 28 73 74 72 69 6e 67 ata)).. ((string
8860: 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 =? (args:get-arg
8870: 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 73 "-dumpmode") "s
8880: 65 78 70 22 29 0a 09 20 20 28 70 70 20 28 68 61 exp").. (pp (ha
8890: 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 sh-table->alist
88a0: 64 61 74 61 29 29 29 0a 09 20 28 28 73 74 72 69 data))).. ((stri
88b0: 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 ng=? (args:get-a
88c0: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 rg "-dumpmode")
88d0: 22 6a 73 6f 6e 22 29 0a 09 20 20 28 6a 73 6f 6e "json").. (json
88e0: 2d 77 72 69 74 65 20 64 61 74 61 29 29 0a 09 20 -write data))..
88f0: 28 65 6c 73 65 0a 09 20 20 28 64 65 62 75 67 3a (else.. (debug:
8900: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
8910: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
8920: 20 22 2d 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 "-dumpmode of "
8930: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8940: 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f -dumpmode") " no
8950: 74 20 72 65 63 6f 67 6e 69 73 65 64 22 29 29 29 t recognised")))
8960: 0a 09 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 ..(set! *didsome
8970: 74 68 69 6e 67 2a 20 23 74 29 29 0a 20 20 20 20 thing* #t)).
8980: 20 20 28 70 6f 70 2d 64 69 72 65 63 74 6f 72 79 (pop-directory
8990: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
89a0: 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 6f et-arg "-show-co
89b0: 6e 66 69 67 22 29 0a 20 20 20 20 28 6c 65 74 20 nfig"). (let
89c0: 28 28 74 6c 20 20 20 28 6c 61 75 6e 63 68 3a 73 ((tl (launch:s
89d0: 65 74 75 70 29 29 0a 09 20 20 28 64 61 74 61 20 etup)).. (data
89e0: 2a 63 6f 6e 66 69 67 64 61 74 2a 29 29 20 3b 3b *configdat*)) ;;
89f0: 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 22 6d (read-config "m
8a00: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 20 egatest.config"
8a10: 23 66 20 23 74 29 29 29 0a 20 20 20 20 20 20 28 #f #t))). (
8a20: 70 75 73 68 2d 64 69 72 65 63 74 6f 72 79 20 2a push-directory *
8a30: 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 20 20 20 toppath*).
8a40: 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 ;; keep this one
8a50: 20 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 63 6f local. (co
8a60: 6e 64 20 0a 20 20 20 20 20 20 20 28 28 61 6e 64 nd . ((and
8a70: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8a80: 2d 73 65 63 74 69 6f 6e 22 29 0a 09 20 20 20 20 -section")..
8a90: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8aa0: 2d 76 61 72 22 29 29 0a 09 28 6c 65 74 20 28 28 -var"))..(let ((
8ab0: 76 61 6c 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f val (configf:loo
8ac0: 6b 75 70 20 64 61 74 61 20 28 61 72 67 73 3a 67 kup data (args:g
8ad0: 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e et-arg "-section
8ae0: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
8af0: 22 2d 76 61 72 22 29 29 29 29 0a 09 20 20 28 69 "-var")))).. (i
8b00: 66 20 76 61 6c 20 28 70 72 69 6e 74 20 76 61 6c f val (print val
8b10: 29 29 29 29 0a 0a 20 20 20 20 20 20 20 3b 3b 20 )))).. ;;
8b20: 70 72 69 6e 74 20 6a 75 73 74 20 61 20 73 65 63 print just a sec
8b30: 74 69 6f 6e 20 69 66 20 6f 6e 6c 79 20 2d 73 65 tion if only -se
8b40: 63 74 69 6f 6e 0a 0a 20 20 20 20 20 20 20 28 28 ction.. ((
8b50: 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 not (args:get-ar
8b60: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 29 0a g "-dumpmode")).
8b70: 09 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 .(pp (hash-table
8b80: 2d 3e 61 6c 69 73 74 20 64 61 74 61 29 29 29 0a ->alist data))).
8b90: 20 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 3d ((string=
8ba0: 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ? (args:get-arg
8bb0: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 "-dumpmode") "js
8bc0: 6f 6e 22 29 0a 09 28 6a 73 6f 6e 2d 77 72 69 74 on")..(json-writ
8bd0: 65 20 64 61 74 61 29 29 0a 20 20 20 20 20 20 20 e data)).
8be0: 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 ((string=? (args
8bf0: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
8c00: 6f 64 65 22 29 20 22 69 6e 69 22 29 0a 09 28 63 ode") "ini")..(c
8c10: 6f 6e 66 69 67 66 3a 63 6f 6e 66 69 67 2d 3e 69 onfigf:config->i
8c20: 6e 69 20 64 61 74 61 29 29 0a 20 20 20 20 20 20 ni data)).
8c30: 20 28 65 6c 73 65 0a 09 28 64 65 62 75 67 3a 70 (else..(debug:p
8c40: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
8c50: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
8c60: 22 2d 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 20 "-dumpmode of "
8c70: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8c80: 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f 74 dumpmode") " not
8c90: 20 72 65 63 6f 67 6e 69 73 65 64 22 29 29 29 0a recognised"))).
8ca0: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
8cb0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 20 something* #t).
8cc0: 20 20 20 20 20 28 70 6f 70 2d 64 69 72 65 63 74 (pop-direct
8cd0: 6f 72 79 29 29 29 0a 0a 28 69 66 20 28 61 72 67 ory)))..(if (arg
8ce0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 s:get-arg "-show
8cf0: 2d 63 6d 64 69 6e 66 6f 22 29 0a 20 20 20 20 28 -cmdinfo"). (
8d00: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
8d10: 2d 61 72 67 20 22 3a 76 61 6c 75 65 22 29 28 67 -arg ":value")(g
8d20: 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
8d30: 4f 22 29 29 0a 09 28 6c 65 74 20 28 28 64 61 74 O"))..(let ((dat
8d40: 61 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 a (common:read-e
8d50: 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 6f ncoded-string (o
8d60: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
8d70: 22 3a 76 61 6c 75 65 22 29 28 67 65 74 65 6e 76 ":value")(getenv
8d80: 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 "MT_CMDINFO")))
8d90: 29 29 0a 09 20 20 28 69 66 20 28 65 71 75 61 6c )).. (if (equal
8da0: 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ? (args:get-arg
8db0: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 "-dumpmode") "js
8dc0: 6f 6e 22 29 0a 09 20 20 20 20 20 20 28 6a 73 6f on").. (jso
8dd0: 6e 2d 77 72 69 74 65 20 64 61 74 61 29 0a 09 20 n-write data)..
8de0: 20 20 20 20 20 28 70 70 20 64 61 74 61 29 29 0a (pp data)).
8df0: 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d . (set! *didsom
8e00: 65 74 68 69 6e 67 2a 20 23 74 29 29 0a 09 28 64 ething* #t))..(d
8e10: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
8e20: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
8e30: 6f 72 74 2a 20 22 65 6e 76 69 72 6f 6e 6d 65 6e ort* "environmen
8e40: 74 20 76 61 72 69 61 62 6c 65 20 4d 54 5f 43 4d t variable MT_CM
8e50: 44 49 4e 46 4f 20 69 73 20 6e 6f 74 20 73 65 74 DINFO is not set
8e60: 22 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ")))..;;========
8e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
8eb0: 3b 20 52 65 6d 6f 76 65 20 6f 6c 64 20 72 75 6e ; Remove old run
8ec0: 28 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d (s).;;==========
8ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
8f10: 20 73 69 6e 63 65 20 73 65 76 65 72 61 6c 20 61 since several a
8f20: 63 74 69 6f 6e 73 20 63 61 6e 20 62 65 20 73 70 ctions can be sp
8f30: 65 63 69 66 69 65 64 20 6f 6e 20 74 68 65 20 63 ecified on the c
8f40: 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 74 68 65 20 ommand line the
8f50: 72 65 6d 6f 76 61 6c 0a 3b 3b 20 69 73 20 64 6f removal.;; is do
8f60: 6e 65 20 66 69 72 73 74 0a 28 64 65 66 69 6e 65 ne first.(define
8f70: 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 61 63 74 (operate-on act
8f80: 69 6f 6e 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 ion). (let* ((r
8f90: 75 6e 72 65 63 20 28 72 75 6e 73 3a 72 75 6e 72 unrec (runs:runr
8fa0: 65 63 2d 6d 61 6b 65 2d 72 65 63 6f 72 64 29 29 ec-make-record))
8fb0: 0a 09 20 28 74 61 72 67 65 74 20 28 63 6f 6d 6d .. (target (comm
8fc0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 on:args-get-targ
8fd0: 65 74 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a et))). (cond.
8fe0: 20 20 20 20 20 28 28 6e 6f 74 20 74 61 72 67 65 ((not targe
8ff0: 74 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a t). (debug:
9000: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
9010: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
9020: 20 22 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 "Missing requir
9030: 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 ed parameter for
9040: 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 " action ", you
9050: 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 2d 74 must specify -t
9060: 61 72 67 65 74 20 6f 72 20 2d 72 65 71 74 61 72 arget or -reqtar
9070: 67 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 g"). (exit
9080: 31 29 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 1)). ((not (
9090: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
90a0: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 0a 09 20 20 ":runname")..
90b0: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
90c0: 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 29 29 rg "-runname")))
90d0: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
90e0: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
90f0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
9100: 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 Missing required
9110: 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 parameter for "
9120: 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d action ", you m
9130: 75 73 74 20 73 70 65 63 69 66 79 20 74 68 65 20 ust specify the
9140: 72 75 6e 20 6e 61 6d 65 20 70 61 74 74 65 72 6e run name pattern
9150: 20 77 69 74 68 20 2d 72 75 6e 6e 61 6d 65 20 70 with -runname p
9160: 61 74 74 22 29 0a 20 20 20 20 20 20 28 65 78 69 att"). (exi
9170: 74 20 32 29 29 0a 20 20 20 20 20 28 28 6e 6f 74 t 2)). ((not
9180: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9190: 2d 74 65 73 74 70 61 74 74 22 29 29 0a 20 20 20 -testpatt")).
91a0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
91b0: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
91c0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 -log-port* "Miss
91d0: 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 ing required par
91e0: 61 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 ameter for " act
91f0: 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 ion ", you must
9200: 73 70 65 63 69 66 79 20 74 68 65 20 74 65 73 74 specify the test
9210: 20 70 61 74 74 65 72 6e 20 77 69 74 68 20 2d 74 pattern with -t
9220: 65 73 74 70 61 74 74 22 29 0a 20 20 20 20 20 20 estpatt").
9230: 28 65 78 69 74 20 33 29 29 0a 20 20 20 20 20 28 (exit 3)). (
9240: 65 6c 73 65 0a 20 20 20 20 20 20 28 69 66 20 28 else. (if (
9250: 6e 6f 74 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 not (car *config
9260: 69 6e 66 6f 2a 29 29 0a 09 20 20 28 62 65 67 69 info*)).. (begi
9270: 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 n.. (debug:pr
9280: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
9290: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
92a0: 41 74 74 65 6d 70 74 65 64 20 22 20 61 63 74 69 Attempted " acti
92b0: 6f 6e 20 22 6f 6e 20 74 65 73 74 28 73 29 20 62 on "on test(s) b
92c0: 75 74 20 72 75 6e 20 61 72 65 61 20 63 6f 6e 66 ut run area conf
92d0: 69 67 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e ig file not foun
92e0: 64 22 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 d").. (exit 1
92f0: 29 29 0a 09 20 20 3b 3b 20 70 75 74 20 74 65 73 )).. ;; put tes
9300: 74 20 70 61 72 61 6d 65 74 65 72 73 20 69 6e 74 t parameters int
9310: 6f 20 63 6f 6e 76 65 6e 69 65 6e 74 20 76 61 72 o convenient var
9320: 69 61 62 6c 65 73 0a 09 20 20 28 62 65 67 69 6e iables.. (begin
9330: 0a 09 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 66 .. ;; check f
9340: 6f 72 20 63 6f 72 72 65 63 74 20 76 65 72 73 69 or correct versi
9350: 6f 6e 2c 20 65 78 69 74 20 77 69 74 68 20 6d 65 on, exit with me
9360: 73 73 61 67 65 20 69 66 20 6e 6f 74 20 63 6f 72 ssage if not cor
9370: 72 65 63 74 0a 09 20 20 20 20 28 63 6f 6d 6d 6f rect.. (commo
9380: 6e 3a 65 78 69 74 2d 6f 6e 2d 76 65 72 73 69 6f n:exit-on-versio
9390: 6e 2d 63 68 61 6e 67 65 64 29 0a 09 20 20 20 20 n-changed)..
93a0: 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e (runs:operate-on
93b0: 20 20 61 63 74 69 6f 6e 0a 09 09 09 20 20 20 20 action....
93c0: 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 target....
93d0: 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 (common:args-g
93e0: 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 et-runname) ;;
93f0: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
9400: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 g "-runname")(ar
9410: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
9420: 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 name"))....
9430: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
9440: 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 20 3b t-testpatt #f) ;
9450: 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ; (args:get-arg
9460: 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 "-testpatt")....
9470: 20 20 20 20 20 20 73 74 61 74 65 3a 20 28 63 6f state: (co
9480: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 73 74 mmon:args-get-st
9490: 61 74 65 29 0a 09 09 09 20 20 20 20 20 20 73 74 ate).... st
94a0: 61 74 75 73 3a 20 28 63 6f 6d 6d 6f 6e 3a 61 72 atus: (common:ar
94b0: 67 73 2d 67 65 74 2d 73 74 61 74 75 73 29 0a 09 gs-get-status)..
94c0: 09 09 20 20 20 20 20 20 6e 65 77 2d 73 74 61 74 .. new-stat
94d0: 65 2d 73 74 61 74 75 73 3a 20 28 61 72 67 73 3a e-status: (args:
94e0: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 74 get-arg "-set-st
94f0: 61 74 65 2d 73 74 61 74 75 73 22 29 29 29 29 0a ate-status")))).
9500: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
9510: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
9520: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
9530: 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d 72 t-arg "-remove-r
9540: 75 6e 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 uns"). (gener
9550: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 al-run-call .
9560: 20 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 "-remove-runs"
9570: 0a 20 20 20 20 20 22 72 65 6d 6f 76 65 20 72 75 . "remove ru
9580: 6e 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ns". (lambda
9590: 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 (target runname
95a0: 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 keys keyvals).
95b0: 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d 6f (operate-o
95c0: 6e 20 27 72 65 6d 6f 76 65 2d 72 75 6e 73 29 29 n 'remove-runs))
95d0: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
95e0: 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 74 61 74 t-arg "-set-stat
95f0: 65 2d 73 74 61 74 75 73 22 29 0a 20 20 20 20 28 e-status"). (
9600: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
9610: 20 0a 20 20 20 20 20 22 2d 73 65 74 2d 73 74 61 . "-set-sta
9620: 74 65 2d 73 74 61 74 75 73 22 0a 20 20 20 20 20 te-status".
9630: 22 73 65 74 20 73 74 61 74 65 20 61 6e 64 20 73 "set state and s
9640: 74 61 74 75 73 22 0a 20 20 20 20 20 28 6c 61 6d tatus". (lam
9650: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
9660: 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 ame keys keyvals
9670: 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 ). (operat
9680: 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d e-on 'set-state-
9690: 73 74 61 74 75 73 29 29 29 29 0a 0a 28 69 66 20 status))))..(if
96a0: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
96b0: 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 g "-set-run-stat
96c0: 75 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d us")..(args:get-
96d0: 61 72 67 20 22 2d 67 65 74 2d 72 75 6e 2d 73 74 arg "-get-run-st
96e0: 61 74 75 73 22 29 29 0a 20 20 20 20 28 67 65 6e atus")). (gen
96f0: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 eral-run-call.
9700: 20 20 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 "-set-run-sta
9710: 74 75 73 22 0a 20 20 20 20 20 22 73 65 74 20 72 tus". "set r
9720: 75 6e 20 73 74 61 74 75 73 22 0a 20 20 20 20 20 un status".
9730: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
9740: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
9750: 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6c 65 vals). (le
9760: 74 2a 20 28 28 72 75 6e 73 64 61 74 20 20 28 72 t* ((runsdat (r
9770: 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 mt:get-runs-by-p
9780: 61 74 74 20 6b 65 79 73 20 72 75 6e 6e 61 6d 65 att keys runname
9790: 20 0a 09 09 09 09 09 28 63 6f 6d 6d 6f 6e 3a 61 ......(common:a
97a0: 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 0a rgs-get-target).
97b0: 09 09 09 09 09 23 66 20 23 66 20 23 66 20 23 66 .....#f #f #f #f
97c0: 29 29 0a 09 20 20 20 20 20 20 28 68 65 61 64 65 )).. (heade
97d0: 72 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 r (vector-ref
97e0: 72 75 6e 73 64 61 74 20 30 29 29 0a 09 20 20 20 runsdat 0))..
97f0: 20 20 20 28 72 6f 77 73 20 20 20 20 20 28 76 65 (rows (ve
9800: 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 ctor-ref runsdat
9810: 20 31 29 29 29 0a 09 20 28 69 66 20 28 6e 75 6c 1))).. (if (nul
9820: 6c 3f 20 72 6f 77 73 29 0a 09 20 20 20 20 20 28 l? rows).. (
9830: 62 65 67 69 6e 0a 09 20 20 20 20 20 20 20 28 64 begin.. (d
9840: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
9850: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
9860: 6f 72 74 2a 20 22 4e 6f 20 6d 61 74 63 68 69 6e ort* "No matchin
9870: 67 20 72 75 6e 20 66 6f 75 6e 64 2e 22 29 0a 09 g run found.")..
9880: 20 20 20 20 20 20 20 28 65 78 69 74 20 31 29 29 (exit 1))
9890: 0a 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 .. (let* ((r
98a0: 6f 77 20 20 20 20 20 20 28 63 61 72 20 28 76 65 ow (car (ve
98b0: 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 ctor-ref runsdat
98c0: 20 31 29 29 29 0a 09 09 20 20 20 20 28 72 75 6e 1)))... (run
98d0: 2d 69 64 20 20 20 28 64 62 3a 67 65 74 2d 76 61 -id (db:get-va
98e0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 6f lue-by-header ro
98f0: 77 20 68 65 61 64 65 72 20 22 69 64 22 29 29 29 w header "id")))
9900: 0a 09 20 20 20 20 20 20 20 28 69 66 20 28 61 72 .. (if (ar
9910: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
9920: 2d 72 75 6e 2d 73 74 61 74 75 73 22 29 0a 09 09 -run-status")...
9930: 20 20 20 28 72 6d 74 3a 73 65 74 2d 72 75 6e 2d (rmt:set-run-
9940: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 28 61 status run-id (a
9950: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
9960: 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 29 20 6d t-run-status") m
9970: 73 67 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 sg: (args:get-ar
9980: 67 20 22 2d 6d 22 29 29 0a 09 09 20 20 20 28 70 g "-m"))... (p
9990: 72 69 6e 74 20 28 72 6d 74 3a 67 65 74 2d 72 75 rint (rmt:get-ru
99a0: 6e 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 29 n-status run-id)
99b0: 29 0a 09 09 20 20 20 29 29 29 29 29 29 29 0a 0a )... )))))))..
99c0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
99d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a00: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 75 65 72 ========.;; Quer
9a10: 79 20 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d y runs.;;=======
9a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
9a60: 0a 3b 3b 20 2d 66 69 65 6c 64 73 20 72 75 6e 73 .;; -fields runs
9a70: 3a 69 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 :id,target,runna
9a80: 6d 65 2c 63 6f 6d 6d 65 6e 74 2b 74 65 73 74 73 me,comment+tests
9a90: 3a 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 :id,testname,ite
9aa0: 6d 5f 70 61 74 68 2b 73 74 65 70 73 0a 3b 3b 0a m_path+steps.;;.
9ab0: 3b 3b 20 63 73 69 3e 20 28 65 78 74 72 61 63 74 ;; csi> (extract
9ac0: 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 74 72 61 69 -fields-constrai
9ad0: 6e 74 73 20 22 72 75 6e 73 3a 69 64 2c 74 61 72 nts "runs:id,tar
9ae0: 67 65 74 2c 72 75 6e 6e 61 6d 65 2c 63 6f 6d 6d get,runname,comm
9af0: 65 6e 74 2b 74 65 73 74 73 3a 69 64 2c 74 65 73 ent+tests:id,tes
9b00: 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2b tname,item_path+
9b10: 73 74 65 70 73 22 29 0a 3b 3b 20 20 20 20 20 20 steps").;;
9b20: 20 20 20 3d 3e 20 28 28 22 72 75 6e 73 22 20 22 => (("runs" "
9b30: 69 64 22 20 22 74 61 72 67 65 74 22 20 22 72 75 id" "target" "ru
9b40: 6e 6e 61 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 nname" "comment"
9b50: 29 20 28 22 74 65 73 74 73 22 20 22 69 64 22 20 ) ("tests" "id"
9b60: 22 74 65 73 74 6e 61 6d 65 22 20 22 69 74 65 6d "testname" "item
9b70: 5f 70 61 74 68 22 29 20 28 22 73 74 65 70 73 22 _path") ("steps"
9b80: 29 29 0a 3b 3b 0a 3b 3b 20 20 20 4e 4f 54 45 3a )).;;.;; NOTE:
9b90: 20 72 65 6d 65 6d 62 65 72 20 74 68 61 74 20 74 remember that t
9ba0: 68 65 20 63 64 72 20 77 69 6c 6c 20 62 65 20 74 he cdr will be t
9bb0: 68 65 20 6c 69 73 74 20 79 6f 75 20 65 78 70 65 he list you expe
9bc0: 63 74 20 28 63 64 72 20 28 22 72 75 6e 73 22 20 ct (cdr ("runs"
9bd0: 22 69 64 22 20 22 74 61 72 67 65 74 22 20 22 72 "id" "target" "r
9be0: 75 6e 6e 61 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 unname" "comment
9bf0: 22 29 29 20 3d 3e 20 28 22 69 64 22 20 22 74 61 ")) => ("id" "ta
9c00: 72 67 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 20 rget" "runname"
9c10: 22 63 6f 6d 6d 65 6e 74 22 29 0a 3b 3b 20 20 20 "comment").;;
9c20: 20 20 20 20 20 20 61 6e 64 20 73 6f 20 61 6c 69 and so ali
9c30: 73 74 2d 72 65 66 20 77 69 6c 6c 20 79 69 65 6c st-ref will yiel
9c40: 64 20 77 68 61 74 20 79 6f 75 20 65 78 70 65 63 d what you expec
9c50: 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 65 78 t.;;.(define (ex
9c60: 74 72 61 63 74 2d 66 69 65 6c 64 73 2d 63 6f 6e tract-fields-con
9c70: 73 74 72 61 69 6e 74 73 20 66 69 65 6c 64 73 2d straints fields-
9c80: 73 70 65 63 29 0a 20 20 28 6d 61 70 20 28 6c 61 spec). (map (la
9c90: 6d 62 64 61 20 28 74 61 62 6c 65 2d 73 70 65 63 mbda (table-spec
9ca0: 29 20 3b 3b 20 72 75 6e 73 3a 69 64 2c 74 61 72 ) ;; runs:id,tar
9cb0: 67 65 74 2c 72 75 6e 6e 61 6d 65 0a 09 20 28 6c get,runname.. (l
9cc0: 65 74 20 28 28 64 61 74 20 28 73 74 72 69 6e 67 et ((dat (string
9cd0: 2d 73 70 6c 69 74 20 74 61 62 6c 65 2d 73 70 65 -split table-spe
9ce0: 63 20 22 3a 22 29 29 29 20 3b 3b 20 28 22 72 75 c ":"))) ;; ("ru
9cf0: 6e 73 22 20 22 69 64 2c 74 61 72 67 65 74 2c 72 ns" "id,target,r
9d00: 75 6e 6e 61 6d 65 22 29 0a 09 20 20 20 28 69 66 unname").. (if
9d10: 20 28 3e 20 28 6c 65 6e 67 74 68 20 64 61 74 29 (> (length dat)
9d20: 20 31 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 1).. (con
9d30: 73 20 28 63 61 72 20 64 61 74 29 28 73 74 72 69 s (car dat)(stri
9d40: 6e 67 2d 73 70 6c 69 74 20 28 63 61 64 72 20 64 ng-split (cadr d
9d50: 61 74 29 20 22 2c 22 29 29 20 3b 3b 20 22 69 64 at) ",")) ;; "id
9d60: 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 22 ,target,runname"
9d70: 0a 09 20 20 20 20 20 20 20 64 61 74 29 29 29 0a .. dat))).
9d80: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 (string-s
9d90: 70 6c 69 74 20 66 69 65 6c 64 73 2d 73 70 65 63 plit fields-spec
9da0: 20 22 2b 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 "+")))..(define
9db0: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
9dc0: 69 65 6c 64 6e 61 6d 65 20 64 61 74 61 76 65 63 ieldname datavec
9dd0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
9de0: 78 20 66 69 65 6c 64 6e 61 6d 65 29 0a 20 20 28 x fieldname). (
9df0: 6c 65 74 20 28 28 69 6e 64 78 20 28 68 61 73 68 let ((indx (hash
9e00: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
9e10: 6c 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e lt test-field-in
9e20: 64 65 78 20 66 69 65 6c 64 6e 61 6d 65 20 23 66 dex fieldname #f
9e30: 29 29 29 0a 20 20 20 20 28 69 66 20 69 6e 64 78 ))). (if indx
9e40: 0a 09 28 69 66 20 28 3e 3d 20 69 6e 64 78 20 28 ..(if (>= indx (
9e50: 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 64 61 vector-length da
9e60: 74 61 76 65 63 29 29 0a 09 20 20 20 20 23 66 20 tavec)).. #f
9e70: 3b 3b 20 69 6e 64 65 78 20 74 6f 6f 20 68 69 67 ;; index too hig
9e80: 68 2c 20 73 68 6f 75 6c 64 20 72 61 69 73 65 20 h, should raise
9e90: 61 6e 20 65 72 72 6f 72 20 49 20 73 75 70 70 6f an error I suppo
9ea0: 73 65 0a 09 20 20 20 20 28 76 65 63 74 6f 72 2d se.. (vector-
9eb0: 72 65 66 20 64 61 74 61 76 65 63 20 69 6e 64 78 ref datavec indx
9ec0: 29 29 0a 09 23 66 29 29 29 0a 0a 3b 3b 20 4e 4f ))..#f)))..;; NO
9ed0: 54 45 3a 20 6c 69 73 74 2d 72 75 6e 73 20 61 6e TE: list-runs an
9ee0: 64 20 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 d list-db-target
9ef0: 73 20 6f 70 65 72 61 74 65 20 6f 6e 20 6c 6f 63 s operate on loc
9f00: 61 6c 20 64 62 21 21 21 0a 3b 3b 0a 3b 3b 20 49 al db!!!.;;.;; I
9f10: 44 45 41 3a 20 6d 65 67 61 74 65 73 74 20 6c 69 DEA: megatest li
9f20: 73 74 20 2d 72 75 6e 6e 61 6d 65 20 62 6c 61 68 st -runname blah
9f30: 25 20 2e 2e 2e 0a 3b 3b 0a 28 69 66 20 28 6f 72 % ....;;.(if (or
9f40: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9f50: 2d 6c 69 73 74 2d 72 75 6e 73 22 29 0a 09 28 61 -list-runs")..(a
9f60: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
9f70: 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 29 29 st-db-targets"))
9f80: 0a 20 20 20 20 28 69 66 20 28 6c 61 75 6e 63 68 . (if (launch
9f90: 3a 73 65 74 75 70 29 0a 09 28 6c 65 74 2a 20 28 :setup)..(let* (
9fa0: 3b 3b 20 28 64 62 73 74 72 75 63 74 20 20 20 20 ;; (dbstruct
9fb0: 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 (make-dbr:dbstru
9fc0: 63 74 20 70 61 74 68 3a 20 2a 74 6f 70 70 61 74 ct path: *toppat
9fd0: 68 2a 20 6c 6f 63 61 6c 3a 20 28 61 72 67 73 3a h* local: (args:
9fe0: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 61 6c 22 get-arg "-local"
9ff0: 29 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e ))).. (run
a000: 70 61 74 74 20 20 20 20 20 28 61 72 67 73 3a 67 patt (args:g
a010: 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 et-arg "-list-ru
a020: 6e 73 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 ns")).
a030: 20 20 20 20 20 28 61 63 63 65 73 73 2d 6d 6f 64 (access-mod
a040: 65 20 28 64 62 3a 67 65 74 2d 61 63 63 65 73 73 e (db:get-access
a050: 2d 6d 6f 64 65 29 29 0a 09 20 20 20 20 20 20 20 -mode))..
a060: 28 74 65 73 74 70 61 74 74 20 20 20 20 28 63 6f (testpatt (co
a070: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 mmon:args-get-te
a080: 73 74 70 61 74 74 20 23 66 29 29 0a 09 20 20 20 stpatt #f))..
a090: 20 20 20 20 3b 3b 20 28 69 66 20 28 61 72 67 73 ;; (if (args
a0a0: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 :get-arg "-testp
a0b0: 61 74 74 22 29 20 0a 09 20 20 20 20 20 20 20 3b att") .. ;
a0c0: 3b 20 20 09 20 20 20 20 20 20 20 20 28 61 72 67 ; . (arg
a0d0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
a0e0: 70 61 74 74 22 29 20 0a 09 20 20 20 20 20 20 20 patt") ..
a0f0: 3b 3b 20 20 09 20 20 20 20 20 20 20 20 22 25 22 ;; . "%"
a100: 29 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 73 )).. (keys
a110: 20 20 20 20 20 20 20 20 28 72 6d 74 3a 67 65 74 (rmt:get
a120: 2d 6b 65 79 73 29 29 20 3b 3b 20 28 64 62 3a 67 -keys)) ;; (db:g
a130: 65 74 2d 6b 65 79 73 20 64 62 73 74 72 75 63 74 et-keys dbstruct
a140: 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 72 )).. ;; (r
a150: 75 6e 73 64 61 74 20 20 28 64 62 3a 67 65 74 2d unsdat (db:get-
a160: 72 75 6e 73 20 64 62 73 74 72 75 63 74 20 72 75 runs dbstruct ru
a170: 6e 70 61 74 74 20 23 66 20 23 66 20 27 28 29 29 npatt #f #f '())
a180: 29 0a 09 3b 3b 20 28 72 75 6e 73 64 61 74 20 20 )..;; (runsdat
a190: 20 20 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 (rmt:get-runs
a1a0: 2d 62 79 2d 70 61 74 74 20 6b 65 79 73 20 28 6f -by-patt keys (o
a1b0: 72 20 72 75 6e 70 61 74 74 20 22 25 22 29 20 28 r runpatt "%") (
a1c0: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
a1d0: 74 61 72 67 65 74 29 20 3b 3b 20 28 64 62 3a 67 target) ;; (db:g
a1e0: 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 et-runs-by-patt
a1f0: 64 62 73 74 72 75 63 74 20 6b 65 79 73 20 28 6f dbstruct keys (o
a200: 72 20 72 75 6e 70 61 74 74 20 22 25 22 29 20 28 r runpatt "%") (
a210: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
a220: 74 61 72 67 65 74 29 0a 09 3b 3b 20 09 09 20 20 target)..;; ..
a230: 20 20 20 20 20 20 20 20 20 09 20 23 66 20 23 66 . #f #f
a240: 20 27 28 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 '("id" "runname
a250: 22 20 22 73 74 61 74 65 22 20 22 73 74 61 74 75 " "state" "statu
a260: 73 22 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e s" "owner" "even
a270: 74 5f 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 t_time" "comment
a280: 22 29 20 30 29 29 0a 09 20 20 20 20 20 20 20 28 ") 0)).. (
a290: 72 75 6e 73 64 61 74 20 20 20 20 20 28 72 6d 74 runsdat (rmt
a2a0: 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 :get-runs-by-pat
a2b0: 74 20 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 61 t keys (or runpa
a2c0: 74 74 20 22 25 22 29 20 0a 20 20 20 20 20 20 20 tt "%") .
a2d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a2e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a2f0: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d (comm
a300: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 on:args-get-targ
a310: 65 74 29 20 23 66 20 23 66 20 27 28 22 69 64 22 et) #f #f '("id"
a320: 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 "runname" "stat
a330: 65 22 20 22 73 74 61 74 75 73 22 20 22 6f 77 6e e" "status" "own
a340: 65 72 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 er" "event_time"
a350: 20 22 63 6f 6d 6d 65 6e 74 22 29 20 30 29 29 0a "comment") 0)).
a360: 09 20 20 20 20 20 20 20 28 72 75 6e 73 74 6d 70 . (runstmp
a370: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 (db:get-row
a380: 73 20 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 s runsdat))..
a390: 20 20 20 20 28 68 65 61 64 65 72 20 20 20 20 20 (header
a3a0: 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 (db:get-header
a3b0: 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 runsdat))..
a3c0: 20 20 3b 3b 20 74 68 69 73 20 69 73 20 22 2d 73 ;; this is "-s
a3d0: 69 6e 63 65 22 20 73 75 70 70 6f 72 74 2e 20 54 ince" support. T
a3e0: 68 69 73 20 6c 6f 6f 6b 73 20 61 74 20 6c 61 73 his looks at las
a3f0: 74 20 6d 6f 64 20 74 69 6d 65 73 20 6f 66 20 3c t mod times of <
a400: 72 75 6e 2d 69 64 3e 2e 64 62 20 66 69 6c 65 73 run-id>.db files
a410: 0a 09 20 20 20 20 20 20 20 3b 3b 20 61 6e 64 20 .. ;; and
a420: 63 6f 6c 6c 65 63 74 73 20 74 68 6f 73 65 20 6d collects those m
a430: 6f 64 69 66 69 65 64 20 73 69 6e 63 65 20 74 68 odified since th
a440: 65 20 2d 73 69 6e 63 65 20 74 69 6d 65 2e 0a 09 e -since time...
a450: 20 20 20 20 20 20 20 28 72 75 6e 73 20 20 20 20 (runs
a460: 20 20 20 20 72 75 6e 73 74 6d 70 29 0a 20 20 20 runstmp).
a470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a480: 20 20 20 20 20 3b 3b 20 28 69 66 20 28 61 6e 64 ;; (if (and
a490: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 75 6e (not (null? run
a4a0: 73 74 6d 70 29 29 0a 09 09 09 3b 3b 20 20 20 20 stmp))....;;
a4b0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
a4c0: 67 20 22 2d 73 69 6e 63 65 22 29 29 0a 09 09 09 g "-since"))....
a4d0: 3b 3b 20 20 20 28 6c 65 74 20 28 28 63 68 61 6e ;; (let ((chan
a4e0: 67 65 64 2d 69 64 73 20 28 64 62 3a 67 65 74 2d ged-ids (db:get-
a4f0: 63 68 61 6e 67 65 64 2d 72 75 6e 2d 69 64 73 20 changed-run-ids
a500: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
a510: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
a520: 73 69 6e 63 65 22 29 29 29 29 29 0a 09 09 09 3b since")))))....;
a530: 3b 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 ; (let loop
a540: 28 28 68 65 64 20 28 63 61 72 20 72 75 6e 73 74 ((hed (car runst
a550: 6d 70 29 29 0a 09 09 09 3b 3b 20 20 20 09 20 20 mp))....;; .
a560: 20 20 20 28 74 61 6c 20 28 63 64 72 20 72 75 6e (tal (cdr run
a570: 73 74 6d 70 29 29 0a 09 09 09 3b 3b 20 20 20 09 stmp))....;; .
a580: 20 20 20 20 20 28 72 65 73 20 27 28 29 29 29 0a (res '())).
a590: 09 09 09 3b 3b 20 20 20 20 20 20 20 28 6c 65 74 ...;; (let
a5a0: 20 28 28 6e 65 77 2d 72 65 73 20 28 69 66 20 28 ((new-res (if (
a5b0: 6d 65 6d 62 65 72 20 28 64 62 3a 67 65 74 2d 76 member (db:get-v
a5c0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 68 alue-by-header h
a5d0: 65 64 20 68 65 61 64 65 72 20 22 69 64 22 29 20 ed header "id")
a5e0: 63 68 61 6e 67 65 64 2d 69 64 73 29 0a 09 09 09 changed-ids)....
a5f0: 3b 3b 20 20 20 09 09 20 20 20 20 20 20 20 28 63 ;; .. (c
a600: 6f 6e 73 20 68 65 64 20 72 65 73 29 0a 09 09 09 ons hed res)....
a610: 3b 3b 20 20 20 09 09 20 20 20 20 20 20 20 72 65 ;; .. re
a620: 73 29 29 29 0a 09 09 09 3b 3b 20 20 20 20 20 20 s)))....;;
a630: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 (if (null? ta
a640: 6c 29 0a 09 09 09 3b 3b 20 20 20 09 20 20 28 72 l)....;; . (r
a650: 65 76 65 72 73 65 20 6e 65 77 2d 72 65 73 29 0a everse new-res).
a660: 09 09 09 3b 3b 20 20 20 09 20 20 28 6c 6f 6f 70 ...;; . (loop
a670: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
a680: 61 6c 29 20 6e 65 77 2d 72 65 73 29 29 29 29 29 al) new-res)))))
a690: 0a 09 09 09 3b 3b 20 20 20 72 75 6e 73 74 6d 70 ....;; runstmp
a6a0: 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d 74 )).. (db-t
a6b0: 61 72 67 65 74 73 20 20 28 61 72 67 73 3a 67 65 argets (args:ge
a6c0: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d t-arg "-list-db-
a6d0: 74 61 72 67 65 74 73 22 29 29 0a 09 20 20 20 20 targets"))..
a6e0: 20 20 20 28 73 65 65 6e 20 20 20 20 20 20 20 20 (seen
a6f0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
a700: 29 29 0a 09 20 20 20 20 20 20 20 28 64 6d 6f 64 )).. (dmod
a710: 65 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 e (let ((d
a720: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
a730: 2d 64 75 6d 70 6d 6f 64 65 22 29 29 29 0a 09 09 -dumpmode")))...
a740: 09 20 20 20 20 20 20 28 69 66 20 64 20 28 73 74 . (if d (st
a750: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 64 29 20 ring->symbol d)
a760: 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 28 64 #f))).. (d
a770: 61 74 61 20 20 20 20 20 20 20 20 28 6d 61 6b 65 ata (make
a780: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 -hash-table))..
a790: 20 20 20 20 20 20 28 66 69 65 6c 64 73 2d 73 70 (fields-sp
a7a0: 65 63 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 ec (if (args:get
a7b0: 2d 61 72 67 20 22 2d 66 69 65 6c 64 73 22 29 0a -arg "-fields").
a7c0: 09 09 09 09 28 65 78 74 72 61 63 74 2d 66 69 65 ....(extract-fie
a7d0: 6c 64 73 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 lds-constraints
a7e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
a7f0: 66 69 65 6c 64 73 22 29 29 0a 09 09 09 09 28 6c fields")).....(l
a800: 69 73 74 20 28 63 6f 6e 73 20 22 72 75 6e 73 22 ist (cons "runs"
a810: 20 28 61 70 70 65 6e 64 20 6b 65 79 73 20 28 6c (append keys (l
a820: 69 73 74 20 22 69 64 22 20 22 72 75 6e 6e 61 6d ist "id" "runnam
a830: 65 22 20 22 73 74 61 74 65 22 20 22 73 74 61 74 e" "state" "stat
a840: 75 73 22 20 22 6f 77 6e 65 72 22 20 22 65 76 65 us" "owner" "eve
a850: 6e 74 5f 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e nt_time" "commen
a860: 74 22 20 22 66 61 69 6c 5f 63 6f 75 6e 74 22 20 t" "fail_count"
a870: 22 70 61 73 73 5f 63 6f 75 6e 74 22 29 29 29 0a "pass_count"))).
a880: 09 09 09 09 20 20 20 20 20 20 28 63 6f 6e 73 20 .... (cons
a890: 22 74 65 73 74 73 22 20 20 64 62 3a 74 65 73 74 "tests" db:test
a8a0: 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 29 20 -record-fields)
a8b0: 3b 3b 20 22 69 64 22 20 22 74 65 73 74 6e 61 6d ;; "id" "testnam
a8c0: 65 22 20 22 74 65 73 74 5f 70 61 74 68 22 29 0a e" "test_path").
a8d0: 09 09 09 09 20 20 20 20 20 20 28 6c 69 73 74 20 .... (list
a8e0: 22 73 74 65 70 73 22 20 22 69 64 22 20 22 73 74 "steps" "id" "st
a8f0: 65 70 6e 61 6d 65 22 29 29 29 29 0a 09 20 20 20 epname"))))..
a900: 20 20 20 20 28 72 75 6e 73 2d 73 70 65 63 20 20 (runs-spec
a910: 20 28 6c 65 74 20 28 28 72 20 28 61 6c 69 73 74 (let ((r (alist
a920: 2d 72 65 66 20 22 72 75 6e 73 22 20 20 66 69 65 -ref "runs" fie
a930: 6c 64 73 2d 73 70 65 63 20 65 71 75 61 6c 3f 29 lds-spec equal?)
a940: 29 29 20 3b 3b 20 74 68 65 20 63 68 65 63 6b 20 )) ;; the check
a950: 69 73 20 6e 6f 77 20 75 6e 6e 65 63 65 73 73 61 is now unnecessa
a960: 72 79 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 ry.... (if
a970: 28 61 6e 64 20 72 20 28 6e 6f 74 20 28 6e 75 6c (and r (not (nul
a980: 6c 3f 20 72 29 29 29 20 72 20 28 6c 69 73 74 20 l? r))) r (list
a990: 22 69 64 22 20 29 29 29 29 0a 09 20 20 20 20 20 "id" ))))..
a9a0: 20 20 28 74 65 73 74 73 2d 73 70 65 63 20 20 28 (tests-spec (
a9b0: 6c 65 74 20 28 28 74 20 28 61 6c 69 73 74 2d 72 let ((t (alist-r
a9c0: 65 66 20 22 74 65 73 74 73 22 20 66 69 65 6c 64 ef "tests" field
a9d0: 73 2d 73 70 65 63 20 65 71 75 61 6c 3f 29 29 29 s-spec equal?)))
a9e0: 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 61 .... (if (a
a9f0: 6e 64 20 74 20 28 6e 75 6c 6c 3f 20 74 29 29 20 nd t (null? t))
aa00: 3b 3b 20 61 6c 6c 20 66 69 65 6c 64 73 0a 09 09 ;; all fields...
aa10: 09 09 20 20 64 62 3a 74 65 73 74 2d 72 65 63 6f .. db:test-reco
aa20: 72 64 2d 66 69 65 6c 64 73 0a 09 09 09 09 20 20 rd-fields.....
aa30: 74 29 29 29 0a 09 20 20 20 20 20 20 20 28 61 64 t))).. (ad
aa40: 6a 2d 74 65 73 74 73 2d 73 70 65 63 20 28 64 65 j-tests-spec (de
aa50: 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 lete-duplicates
aa60: 28 69 66 20 74 65 73 74 73 2d 73 70 65 63 20 28 (if tests-spec (
aa70: 63 6f 6e 73 20 22 69 64 22 20 74 65 73 74 73 2d cons "id" tests-
aa80: 73 70 65 63 29 20 64 62 3a 74 65 73 74 2d 72 65 spec) db:test-re
aa90: 63 6f 72 64 2d 66 69 65 6c 64 73 29 29 29 20 3b cord-fields))) ;
aaa0: 3b 20 27 28 22 69 64 22 29 29 29 29 0a 09 20 20 ; '("id"))))..
aab0: 20 20 20 20 20 28 73 74 65 70 73 2d 73 70 65 63 (steps-spec
aac0: 20 20 28 61 6c 69 73 74 2d 72 65 66 20 22 73 74 (alist-ref "st
aad0: 65 70 73 22 20 66 69 65 6c 64 73 2d 73 70 65 63 eps" fields-spec
aae0: 20 65 71 75 61 6c 3f 29 29 0a 09 20 20 20 20 20 equal?))..
aaf0: 20 20 28 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e (test-field-in
ab00: 64 65 78 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 dex (make-hash-t
ab10: 61 62 6c 65 29 29 29 0a 09 20 20 28 69 66 20 28 able))).. (if (
ab20: 61 6e 64 20 74 65 73 74 73 2d 73 70 65 63 20 28 and tests-spec (
ab30: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 not (null? tests
ab40: 2d 73 70 65 63 29 29 29 20 3b 3b 20 64 6f 20 73 -spec))) ;; do s
ab50: 6f 6d 65 20 76 61 6c 69 64 61 74 69 6f 6e 20 61 ome validation a
ab60: 6e 64 20 70 72 6f 63 65 73 73 69 6e 67 20 6f 66 nd processing of
ab70: 20 74 68 65 20 74 65 73 74 2d 73 70 65 63 0a 09 the test-spec..
ab80: 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 6e 76 (let ((inv
ab90: 61 6c 69 64 2d 74 65 73 74 73 2d 73 70 65 63 20 alid-tests-spec
aba0: 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 (filter (lambda
abb0: 28 78 29 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 (x)(not (member
abc0: 78 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 x db:test-record
abd0: 2d 66 69 65 6c 64 73 29 29 29 20 74 65 73 74 73 -fields))) tests
abe0: 2d 73 70 65 63 29 29 29 0a 09 09 28 69 66 20 28 -spec)))...(if (
abf0: 6e 75 6c 6c 3f 20 69 6e 76 61 6c 69 64 2d 74 65 null? invalid-te
ac00: 73 74 73 2d 73 70 65 63 29 0a 09 09 20 20 20 20 sts-spec)...
ac10: 3b 3b 20 67 65 6e 65 72 61 74 65 20 74 68 65 20 ;; generate the
ac20: 6c 6f 6f 6b 75 70 20 6d 61 70 20 74 65 73 74 2d lookup map test-
ac30: 66 69 65 6c 64 2d 6e 61 6d 65 20 3d 3e 20 69 6e field-name => in
ac40: 64 65 78 2d 6e 75 6d 62 65 72 0a 09 09 20 20 20 dex-number...
ac50: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 (let loop ((hed
ac60: 20 28 63 61 72 20 61 64 6a 2d 74 65 73 74 73 2d (car adj-tests-
ac70: 73 70 65 63 29 29 0a 09 09 09 20 20 20 20 20 20 spec))....
ac80: 20 28 74 61 6c 20 28 63 64 72 20 61 64 6a 2d 74 (tal (cdr adj-t
ac90: 65 73 74 73 2d 73 70 65 63 29 29 0a 09 09 09 20 ests-spec))....
aca0: 20 20 20 20 20 20 28 69 64 78 20 30 29 29 0a 09 (idx 0))..
acb0: 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 . (hash-tab
acc0: 6c 65 2d 73 65 74 21 20 74 65 73 74 2d 66 69 65 le-set! test-fie
acd0: 6c 64 2d 69 6e 64 65 78 20 68 65 64 20 69 64 78 ld-index hed idx
ace0: 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 6e )... (if (n
acf0: 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 28 ot (null? tal))(
ad00: 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 loop (car tal)(c
ad10: 64 72 20 74 61 6c 29 28 2b 20 69 64 78 20 31 29 dr tal)(+ idx 1)
ad20: 29 29 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e )))... (begin
ad30: 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a ... (debug:
ad40: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
ad50: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
ad60: 20 22 49 6e 76 61 6c 69 64 20 74 65 73 74 20 66 "Invalid test f
ad70: 69 65 6c 64 73 20 73 70 65 63 69 66 69 65 64 3a ields specified:
ad80: 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 " (string-inter
ad90: 73 70 65 72 73 65 20 69 6e 76 61 6c 69 64 2d 74 sperse invalid-t
ada0: 65 73 74 73 2d 73 70 65 63 20 22 2c 20 22 29 29 ests-spec ", "))
adb0: 0a 09 09 20 20 20 20 20 20 28 65 78 69 74 29 29 ... (exit))
adc0: 29 29 29 0a 0a 09 20 20 3b 3b 20 45 61 63 68 20 )))... ;; Each
add0: 72 75 6e 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 run.. (for-each
ade0: 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 72 .. (lambda (r
adf0: 75 6e 29 0a 09 20 20 20 20 20 28 6c 65 74 20 28 un).. (let (
ae00: 28 74 61 72 67 65 74 73 74 72 20 28 73 74 72 69 (targetstr (stri
ae10: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
ae20: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a map (lambda (x).
ae30: 09 09 09 09 09 09 09 20 28 64 62 3a 67 65 74 2d ....... (db:get-
ae40: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
ae50: 72 75 6e 20 68 65 61 64 65 72 20 78 29 29 0a 09 run header x))..
ae60: 09 09 09 09 09 20 20 20 20 20 20 20 6b 65 79 73 ..... keys
ae70: 29 20 22 2f 22 29 29 29 0a 09 20 20 20 20 20 20 ) "/")))..
ae80: 20 28 69 66 20 64 62 2d 74 61 72 67 65 74 73 0a (if db-targets.
ae90: 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 28 68 .. (if (not (h
aea0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
aeb0: 66 61 75 6c 74 20 73 65 65 6e 20 74 61 72 67 65 fault seen targe
aec0: 74 73 74 72 20 23 66 29 29 0a 09 09 20 20 20 20 tstr #f))...
aed0: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 20 28 68 (begin.... (h
aee0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 ash-table-set! s
aef0: 65 65 6e 20 74 61 72 67 65 74 73 74 72 20 23 74 een targetstr #t
af00: 29 0a 09 09 09 20 3b 3b 20 28 70 72 69 6e 74 20 ).... ;; (print
af10: 22 5b 22 20 74 61 72 67 65 74 73 74 72 20 22 5d "[" targetstr "]
af20: 22 29 29 29 29 0a 09 09 09 20 28 69 66 20 28 6e ")))).... (if (n
af30: 6f 74 20 64 6d 6f 64 65 29 0a 09 09 09 20 20 20 ot dmode)....
af40: 20 20 28 70 72 69 6e 74 20 74 61 72 67 65 74 73 (print targets
af50: 74 72 29 0a 09 09 09 20 20 20 20 20 28 68 61 73 tr).... (has
af60: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 64 61 74 h-table-set! dat
af70: 61 20 22 74 61 72 67 65 74 73 22 20 28 63 6f 6e a "targets" (con
af80: 73 20 74 61 72 67 65 74 73 74 72 20 28 68 61 73 s targetstr (has
af90: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
afa0: 75 6c 74 20 64 61 74 61 20 22 74 61 72 67 65 74 ult data "target
afb0: 73 22 20 27 28 29 29 29 29 0a 09 09 09 20 20 20 s" '())))....
afc0: 20 20 29 29 29 0a 09 09 20 20 20 28 6c 65 74 2a )))... (let*
afd0: 20 28 28 72 75 6e 2d 69 64 20 20 28 64 62 3a 67 ((run-id (db:g
afe0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
aff0: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 er run header "i
b000: 64 22 29 29 0a 09 09 09 20 20 28 72 75 6e 6e 61 d")).... (runna
b010: 6d 65 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 me (db:get-value
b020: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
b030: 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 eader "runname")
b040: 29 20 0a 09 09 09 20 20 28 73 74 61 74 65 73 20 ) .... (states
b050: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 (string-split (
b060: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
b070: 20 22 2d 73 74 61 74 65 22 29 20 22 22 29 20 22 "-state") "") "
b080: 2c 22 29 29 0a 09 09 09 20 20 28 73 74 61 74 75 ,")).... (statu
b090: 73 65 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 ses (string-spli
b0a0: 74 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d t (or (args:get-
b0b0: 61 72 67 20 22 2d 73 74 61 74 75 73 22 29 20 22 arg "-status") "
b0c0: 22 29 20 22 2c 22 29 29 0a 09 09 09 20 20 28 74 ") ",")).... (t
b0d0: 65 73 74 73 20 20 20 28 69 66 20 74 65 73 74 73 ests (if tests
b0e0: 2d 73 70 65 63 0a 09 09 09 09 20 20 20 20 20 20 -spec.....
b0f0: 20 28 64 62 3a 64 69 73 70 61 74 63 68 2d 71 75 (db:dispatch-qu
b100: 65 72 79 20 61 63 63 65 73 73 2d 6d 6f 64 65 20 ery access-mode
b110: 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f rmt:get-tests-fo
b120: 72 2d 72 75 6e 20 64 62 3a 67 65 74 2d 74 65 73 r-run db:get-tes
b130: 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 ts-for-run run-i
b140: 64 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 d testpatt state
b150: 73 20 73 74 61 74 75 73 65 73 20 23 66 20 23 66 s statuses #f #f
b160: 20 23 66 20 27 74 65 73 74 6e 61 6d 65 20 27 61 #f 'testname 'a
b170: 73 63 20 3b 3b 20 28 64 62 3a 67 65 74 2d 74 65 sc ;; (db:get-te
b180: 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 73 74 sts-for-run dbst
b190: 72 75 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 ruct run-id test
b1a0: 70 61 74 74 20 27 28 29 20 27 28 29 20 23 66 20 patt '() '() #f
b1b0: 23 66 20 23 66 20 27 74 65 73 74 6e 61 6d 65 20 #f #f 'testname
b1c0: 27 61 73 63 20 0a 09 09 09 09 09 09 09 20 20 20 'asc ........
b1d0: 20 20 3b 3b 20 75 73 65 20 71 72 79 76 61 6c 73 ;; use qryvals
b1e0: 20 69 66 20 74 65 73 74 2d 73 70 65 63 20 70 72 if test-spec pr
b1f0: 6f 76 69 64 65 64 0a 09 09 09 09 09 09 09 20 20 ovided........
b200: 20 20 20 28 69 66 20 74 65 73 74 73 2d 73 70 65 (if tests-spe
b210: 63 0a 09 09 09 09 09 09 09 09 20 28 73 74 72 69 c......... (stri
b220: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 61 ng-intersperse a
b230: 64 6a 2d 74 65 73 74 73 2d 73 70 65 63 20 22 2c dj-tests-spec ",
b240: 22 29 0a 09 09 09 09 09 09 09 09 20 3b 3b 20 64 ")......... ;; d
b250: 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 b:test-record-fi
b260: 65 6c 64 73 0a 09 09 09 09 09 09 09 09 20 23 66 elds......... #f
b270: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 23 66 )........ #f
b280: 0a 09 09 09 09 09 09 09 20 20 20 20 20 27 6e 6f ........ 'no
b290: 72 6d 61 6c 29 0a 09 09 09 09 20 20 20 20 20 20 rmal).....
b2a0: 20 27 28 29 29 29 29 0a 09 09 20 20 20 20 20 28 '())))... (
b2b0: 63 61 73 65 20 64 6d 6f 64 65 0a 09 09 20 20 20 case dmode...
b2c0: 20 20 20 20 28 28 6a 73 6f 6e 20 6f 64 73 29 0a ((json ods).
b2d0: 09 09 09 28 69 66 20 72 75 6e 73 2d 73 70 65 63 ...(if runs-spec
b2e0: 0a 09 09 09 20 20 20 20 28 66 6f 72 2d 65 61 63 .... (for-eac
b2f0: 68 20 0a 09 09 09 20 20 20 20 20 28 6c 61 6d 62 h .... (lamb
b300: 64 61 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a da (field-name).
b310: 09 09 09 20 20 20 20 20 20 20 28 6d 75 74 69 6c ... (mutil
b320: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
b330: 64 61 74 61 20 28 63 6f 6e 63 20 28 64 62 3a 67 data (conc (db:g
b340: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
b350: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 66 69 er run header fi
b360: 65 6c 64 2d 6e 61 6d 65 29 29 20 74 61 72 67 65 eld-name)) targe
b370: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 tstr runname "me
b380: 74 61 22 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 ta" field-name))
b390: 0a 09 09 09 20 20 20 20 20 72 75 6e 73 2d 73 70 .... runs-sp
b3a0: 65 63 29 29 29 0a 09 09 09 3b 3b 20 28 6d 75 74 ec)))....;; (mut
b3b0: 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 ils:hierhash-set
b3c0: 21 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 ! data (db:get-v
b3d0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
b3e0: 75 6e 20 68 65 61 64 65 72 20 22 73 74 61 74 75 un header "statu
b3f0: 73 22 29 20 20 20 20 20 74 61 72 67 65 74 73 74 s") targetst
b400: 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 r runname "meta"
b410: 20 22 73 74 61 74 75 73 22 20 20 20 20 20 29 0a "status" ).
b420: 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 ...;; (mutils:hi
b430: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
b440: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
b450: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
b460: 64 65 72 20 22 73 74 61 74 65 22 29 20 20 20 20 der "state")
b470: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
b480: 61 6d 65 20 22 6d 65 74 61 22 20 22 73 74 61 74 ame "meta" "stat
b490: 65 22 20 20 20 20 20 20 29 0a 09 09 09 3b 3b 20 e" )....;;
b4a0: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
b4b0: 2d 73 65 74 21 20 64 61 74 61 20 28 63 6f 6e 63 -set! data (conc
b4c0: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
b4d0: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
b4e0: 64 65 72 20 22 69 64 22 29 29 20 20 74 61 72 67 der "id")) targ
b4f0: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d etstr runname "m
b500: 65 74 61 22 20 22 69 64 22 20 20 20 20 20 20 20 eta" "id"
b510: 20 20 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c )....;; (mutil
b520: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
b530: 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 6c data (db:get-val
b540: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
b550: 20 68 65 61 64 65 72 20 22 65 76 65 6e 74 5f 74 header "event_t
b560: 69 6d 65 22 29 20 74 61 72 67 65 74 73 74 72 20 ime") targetstr
b570: 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 runname "meta" "
b580: 65 76 65 6e 74 5f 74 69 6d 65 22 20 29 0a 09 09 event_time" )...
b590: 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 .;; (mutils:hier
b5a0: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 hash-set! data (
b5b0: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
b5c0: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
b5d0: 72 20 22 63 6f 6d 6d 65 6e 74 22 29 20 20 20 20 r "comment")
b5e0: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
b5f0: 65 20 22 6d 65 74 61 22 20 22 63 6f 6d 6d 65 6e e "meta" "commen
b600: 74 22 20 20 20 20 29 0a 09 09 09 3b 3b 20 3b 3b t" )....;; ;;
b610: 20 61 64 64 20 6c 61 73 74 20 65 6e 74 72 79 20 add last entry
b620: 74 77 69 63 65 20 2d 20 73 65 65 6d 73 20 74 6f twice - seems to
b630: 20 62 65 20 61 20 62 75 67 20 69 6e 20 68 69 65 be a bug in hie
b640: 72 68 61 73 68 3f 0a 09 09 09 3b 3b 20 28 6d 75 rhash?....;; (mu
b650: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
b660: 74 21 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d t! data (db:get-
b670: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
b680: 72 75 6e 20 68 65 61 64 65 72 20 22 63 6f 6d 6d run header "comm
b690: 65 6e 74 22 29 20 20 20 20 74 61 72 67 65 74 73 ent") targets
b6a0: 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 tr runname "meta
b6b0: 22 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 29 " "comment" )
b6c0: 0a 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 0a ... (else.
b6d0: 09 09 09 28 69 66 20 28 6e 75 6c 6c 3f 20 72 75 ...(if (null? ru
b6e0: 6e 73 2d 73 70 65 63 29 0a 09 09 09 20 20 20 20 ns-spec)....
b6f0: 28 70 72 69 6e 74 20 22 52 75 6e 3a 20 22 20 74 (print "Run: " t
b700: 61 72 67 65 74 73 74 72 20 22 2f 22 20 72 75 6e argetstr "/" run
b710: 6e 61 6d 65 20 0a 09 09 09 09 20 20 20 22 20 73 name ..... " s
b720: 74 61 74 75 73 3a 20 22 20 28 64 62 3a 67 65 74 tatus: " (db:get
b730: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
b740: 20 72 75 6e 20 68 65 61 64 65 72 20 22 73 74 61 run header "sta
b750: 74 65 22 29 0a 09 09 09 09 20 20 20 22 20 72 75 te")..... " ru
b760: 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 n-id: " run-id "
b770: 2c 20 6e 75 6d 62 65 72 20 74 65 73 74 73 3a 20 , number tests:
b780: 22 20 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 " (length tests)
b790: 0a 09 09 09 09 20 20 20 22 20 65 76 65 6e 74 5f ..... " event_
b7a0: 74 69 6d 65 3a 20 22 20 28 64 62 3a 67 65 74 2d time: " (db:get-
b7b0: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
b7c0: 72 75 6e 20 68 65 61 64 65 72 20 22 65 76 65 6e run header "even
b7d0: 74 5f 74 69 6d 65 22 29 29 0a 09 09 09 20 20 20 t_time"))....
b7e0: 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 (begin....
b7f0: 20 28 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 (if (not (membe
b800: 72 20 22 74 61 72 67 65 74 22 20 72 75 6e 73 2d r "target" runs-
b810: 73 70 65 63 29 29 0a 09 09 09 20 20 20 20 20 20 spec))....
b820: 20 20 20 20 3b 3b 20 28 64 69 73 70 6c 61 79 20 ;; (display
b830: 28 63 6f 6e 63 20 22 54 61 72 67 65 74 3a 20 22 (conc "Target: "
b840: 20 74 61 72 67 65 74 73 74 72 29 29 0a 09 09 09 targetstr))....
b850: 20 20 20 20 20 20 20 20 20 20 28 64 69 73 70 6c (displ
b860: 61 79 20 28 63 6f 6e 63 20 22 52 75 6e 3a 20 22 ay (conc "Run: "
b870: 20 74 61 72 67 65 74 73 74 72 20 22 2f 22 20 72 targetstr "/" r
b880: 75 6e 6e 61 6d 65 20 22 20 22 29 29 29 0a 09 09 unname " ")))...
b890: 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 . (for-each
b8a0: 0a 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 .... (lamb
b8b0: 64 61 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a da (field-name).
b8c0: 09 09 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f .... (if (equal?
b8d0: 20 66 69 65 6c 64 2d 6e 61 6d 65 20 22 74 61 72 field-name "tar
b8e0: 67 65 74 22 29 0a 09 09 09 09 20 20 20 20 20 28 get")..... (
b8f0: 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 22 74 display (conc "t
b900: 61 72 67 65 74 3a 20 22 20 74 61 72 67 65 74 73 arget: " targets
b910: 74 72 20 22 20 22 29 29 0a 09 09 09 09 20 20 20 tr " ")).....
b920: 20 20 28 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 (display (conc
b930: 20 66 69 65 6c 64 2d 6e 61 6d 65 20 22 3a 20 22 field-name ": "
b940: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
b950: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
b960: 64 65 72 20 28 63 6f 6e 63 20 66 69 65 6c 64 2d der (conc field-
b970: 6e 61 6d 65 29 29 20 22 20 22 29 29 29 29 0a 09 name)) " "))))..
b980: 09 09 20 20 20 20 20 20 20 72 75 6e 73 2d 73 70 .. runs-sp
b990: 65 63 29 0a 09 09 09 20 20 20 20 20 20 28 6e 65 ec).... (ne
b9a0: 77 6c 69 6e 65 29 29 29 29 29 0a 09 09 20 20 20 wline)))))...
b9b0: 20 20 20 20 0a 09 09 20 20 20 20 20 28 66 6f 72 ... (for
b9c0: 2d 65 61 63 68 20 0a 09 09 20 20 20 20 20 20 28 -each ... (
b9d0: 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 lambda (test)...
b9e0: 20 20 20 20 20 20 09 28 68 61 6e 64 6c 65 2d 65 .(handle-e
b9f0: 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 20 65 78 xceptions.... ex
ba00: 6e 0a 09 09 09 20 28 62 65 67 69 6e 0a 09 09 09 n.... (begin....
ba10: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
ba20: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
ba30: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 42 61 64 20 -log-port* "Bad
ba40: 64 61 74 61 20 69 6e 20 74 65 73 74 20 72 65 63 data in test rec
ba50: 6f 72 64 3f 20 22 20 74 65 73 74 29 0a 09 09 09 ord? " test)....
ba60: 20 20 20 28 70 72 69 6e 74 20 22 65 78 6e 3d 22 (print "exn="
ba70: 20 28 63 6f 6e 64 69 74 69 6f 6e 2d 3e 6c 69 73 (condition->lis
ba80: 74 20 65 78 6e 29 29 0a 09 09 09 20 20 20 28 64 t exn)).... (d
ba90: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
baa0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
bab0: 22 20 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 " message: " ((c
bac0: 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 ondition-propert
bad0: 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 y-accessor 'exn
bae0: 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 'message) exn)).
baf0: 09 09 09 20 20 20 28 70 72 69 6e 74 2d 63 61 6c ... (print-cal
bb00: 6c 2d 63 68 61 69 6e 20 28 63 75 72 72 65 6e 74 l-chain (current
bb10: 2d 65 72 72 6f 72 2d 70 6f 72 74 29 29 29 0a 09 -error-port)))..
bb20: 09 09 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d .. (let* ((test-
bb30: 69 64 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d id (if (mem
bb40: 62 65 72 20 22 69 64 22 20 20 20 20 20 20 20 20 ber "id"
bb50: 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 tests-spec)(g
bb60: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
bb70: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
bb80: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 69 64 22 field-index "id"
bb90: 20 20 20 20 20 20 20 20 20 20 29 20 23 66 29 29 ) #f))
bba0: 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ;; (db:test-get
bbb0: 2d 69 64 20 20 20 20 20 20 20 20 20 74 65 73 74 -id test
bbc0: 29 29 0a 09 09 09 09 28 74 65 73 74 6e 61 6d 65 )).....(testname
bbd0: 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 (if (member
bbe0: 20 22 74 65 73 74 6e 61 6d 65 22 20 20 20 20 20 "testname"
bbf0: 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d tests-spec)(get-
bc00: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
bc10: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
bc20: 6c 64 2d 69 6e 64 65 78 20 22 74 65 73 74 6e 61 ld-index "testna
bc30: 6d 65 22 20 20 20 20 29 20 23 66 29 29 20 3b 3b me" ) #f)) ;;
bc40: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 (db:test-get-te
bc50: 73 74 6e 61 6d 65 20 20 20 74 65 73 74 29 29 0a stname test)).
bc60: 09 09 09 09 28 69 74 65 6d 70 61 74 68 20 20 20 ....(itempath
bc70: 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 69 (if (member "i
bc80: 74 65 6d 5f 70 61 74 68 22 20 20 20 20 74 65 73 tem_path" tes
bc90: 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c ts-spec)(get-val
bca0: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
bcb0: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
bcc0: 69 6e 64 65 78 20 22 69 74 65 6d 5f 70 61 74 68 index "item_path
bcd0: 22 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 " ) #f)) ;; (d
bce0: 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d b:test-get-item-
bcf0: 70 61 74 68 20 20 74 65 73 74 29 29 0a 09 09 09 path test))....
bd00: 09 28 63 6f 6d 6d 65 6e 74 20 20 20 20 20 20 28 .(comment (
bd10: 69 66 20 28 6d 65 6d 62 65 72 20 22 63 6f 6d 6d if (member "comm
bd20: 65 6e 74 22 20 20 20 20 20 20 74 65 73 74 73 2d ent" tests-
bd30: 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d spec)(get-value-
bd40: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
bd50: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
bd60: 65 78 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 ex "comment"
bd70: 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 ) #f)) ;; (db:t
bd80: 65 73 74 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 est-get-comment
bd90: 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 74 test)).....(t
bda0: 73 74 61 74 65 20 20 20 20 20 20 20 28 69 66 20 state (if
bdb0: 28 6d 65 6d 62 65 72 20 22 73 74 61 74 65 22 20 (member "state"
bdc0: 20 20 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 tests-spe
bdd0: 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d c)(get-value-by-
bde0: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
bdf0: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
be00: 22 73 74 61 74 65 22 20 20 20 20 20 20 20 29 20 "state" )
be10: 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 #f)) ;; (db:test
be20: 2d 67 65 74 2d 73 74 61 74 65 20 20 20 20 20 20 -get-state
be30: 74 65 73 74 29 29 0a 09 09 09 09 28 74 73 74 61 test)).....(tsta
be40: 74 75 73 20 20 20 20 20 20 28 69 66 20 28 6d 65 tus (if (me
be50: 6d 62 65 72 20 22 73 74 61 74 75 73 22 20 20 20 mber "status"
be60: 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 tests-spec)(
be70: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
be80: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
be90: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 -field-index "st
bea0: 61 74 75 73 22 20 20 20 20 20 20 29 20 23 66 29 atus" ) #f)
beb0: 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 ) ;; (db:test-ge
bec0: 74 2d 73 74 61 74 75 73 20 20 20 20 20 74 65 73 t-status tes
bed0: 74 29 29 0a 09 09 09 09 28 65 76 65 6e 74 2d 74 t)).....(event-t
bee0: 69 6d 65 20 20 20 28 69 66 20 28 6d 65 6d 62 65 ime (if (membe
bef0: 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 20 r "event_time"
bf00: 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 tests-spec)(get
bf10: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
bf20: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
bf30: 65 6c 64 2d 69 6e 64 65 78 20 22 65 76 65 6e 74 eld-index "event
bf40: 5f 74 69 6d 65 22 20 20 29 20 23 66 29 29 20 3b _time" ) #f)) ;
bf50: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 ; (db:test-get-e
bf60: 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 29 vent_time test))
bf70: 0a 09 09 09 09 28 72 75 6e 64 69 72 20 20 20 20 .....(rundir
bf80: 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 (if (member "
bf90: 72 75 6e 64 69 72 22 20 20 20 20 20 20 20 74 65 rundir" te
bfa0: 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 sts-spec)(get-va
bfb0: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
bfc0: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
bfd0: 2d 69 6e 64 65 78 20 22 72 75 6e 64 69 72 22 20 -index "rundir"
bfe0: 20 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 ) #f)) ;; (
bff0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 db:test-get-rund
c000: 69 72 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 ir test))...
c010: 09 09 28 66 69 6e 61 6c 5f 6c 6f 67 66 20 20 20 ..(final_logf
c020: 28 69 66 20 28 6d 65 6d 62 65 72 20 22 66 69 6e (if (member "fin
c030: 61 6c 5f 6c 6f 67 66 22 20 20 20 74 65 73 74 73 al_logf" tests
c040: 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 -spec)(get-value
c050: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
c060: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
c070: 64 65 78 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 dex "final_logf"
c080: 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a ) #f)) ;; (db:
c090: 74 65 73 74 2d 67 65 74 2d 66 69 6e 61 6c 5f 6c test-get-final_l
c0a0: 6f 67 66 20 74 65 73 74 29 29 0a 09 09 09 09 28 ogf test)).....(
c0b0: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 28 69 66 run_duration (if
c0c0: 20 28 6d 65 6d 62 65 72 20 22 72 75 6e 5f 64 75 (member "run_du
c0d0: 72 61 74 69 6f 6e 22 20 74 65 73 74 73 2d 73 70 ration" tests-sp
c0e0: 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 ec)(get-value-by
c0f0: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
c100: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
c110: 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 "run_duration")
c120: 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 #f)) ;; (db:tes
c130: 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 t-get-run_durati
c140: 6f 6e 20 74 65 73 74 29 29 0a 09 09 09 09 28 66 on test)).....(f
c150: 75 6c 6c 6e 61 6d 65 20 20 20 20 20 28 63 6f 6e ullname (con
c160: 63 20 74 65 73 74 6e 61 6d 65 0a 09 09 09 09 09 c testname......
c170: 09 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f . (if (equal?
c180: 20 69 74 65 6d 70 61 74 68 20 22 22 29 0a 09 09 itempath "")...
c190: 09 09 09 09 09 22 22 20 0a 09 09 09 09 09 09 09 ....."" ........
c1a0: 28 63 6f 6e 63 20 22 28 22 20 69 74 65 6d 70 61 (conc "(" itempa
c1b0: 74 68 20 22 29 22 29 29 29 29 29 0a 09 09 09 20 th ")")))))....
c1c0: 20 20 28 63 61 73 65 20 64 6d 6f 64 65 0a 09 09 (case dmode...
c1d0: 09 20 20 20 20 20 28 28 6a 73 6f 6e 20 6f 64 73 . ((json ods
c1e0: 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 74 ).... (if t
c1f0: 65 73 74 73 2d 73 70 65 63 0a 09 09 09 09 20 20 ests-spec.....
c200: 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 09 20 20 (for-each.....
c210: 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 2d (lambda (field-
c220: 6e 61 6d 65 29 0a 09 09 09 09 20 20 20 20 20 28 name)..... (
c230: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
c240: 73 65 74 21 20 64 61 74 61 20 20 28 67 65 74 2d set! data (get-
c250: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
c260: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
c270: 6c 64 2d 69 6e 64 65 78 20 66 69 65 6c 64 2d 6e ld-index field-n
c280: 61 6d 65 29 20 74 61 72 67 65 74 73 74 72 20 72 ame) targetstr r
c290: 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 unname "data" (c
c2a0: 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 66 69 65 onc test-id) fie
c2b0: 6c 64 2d 6e 61 6d 65 29 29 0a 09 09 09 09 20 20 ld-name)).....
c2c0: 20 74 65 73 74 73 2d 73 70 65 63 29 29 29 0a 09 tests-spec)))..
c2d0: 09 09 20 20 20 20 20 3b 3b 20 3b 3b 20 28 6d 75 .. ;; ;; (mu
c2e0: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
c2f0: 74 21 20 64 61 74 61 20 20 66 75 6c 6c 6e 61 6d t! data fullnam
c300: 65 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 e targetstr ru
c310: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
c320: 6e 63 20 74 65 73 74 2d 69 64 29 20 22 74 6e 61 nc test-id) "tna
c330: 6d 65 22 20 20 20 20 20 29 0a 09 09 09 20 20 20 me" )....
c340: 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 ;; (mutils:hi
c350: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
c360: 20 20 74 65 73 74 6e 61 6d 65 20 20 20 74 61 72 testname tar
c370: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
c380: 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 data" (conc test
c390: 2d 69 64 29 20 22 74 65 73 74 6e 61 6d 65 22 20 -id) "testname"
c3a0: 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 ).... ;; (
c3b0: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
c3c0: 73 65 74 21 20 64 61 74 61 20 20 69 74 65 6d 70 set! data itemp
c3d0: 61 74 68 20 20 20 74 61 72 67 65 74 73 74 72 20 ath targetstr
c3e0: 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 runname "data" (
c3f0: 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 69 conc test-id) "i
c400: 74 65 6d 70 61 74 68 22 20 20 29 0a 09 09 09 20 tempath" )....
c410: 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a ;; (mutils:
c420: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
c430: 74 61 20 20 63 6f 6d 6d 65 6e 74 20 20 20 20 74 ta comment t
c440: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
c450: 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 "data" (conc te
c460: 73 74 2d 69 64 29 20 22 63 6f 6d 6d 65 6e 74 22 st-id) "comment"
c470: 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 ).... ;;
c480: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
c490: 68 2d 73 65 74 21 20 64 61 74 61 20 20 74 73 74 h-set! data tst
c4a0: 61 74 65 20 20 20 20 20 74 61 72 67 65 74 73 74 ate targetst
c4b0: 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 r runname "data"
c4c0: 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 (conc test-id)
c4d0: 22 73 74 61 74 65 22 20 20 20 20 20 29 0a 09 09 "state" )...
c4e0: 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c . ;; (mutil
c4f0: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
c500: 64 61 74 61 20 20 74 73 74 61 74 75 73 20 20 20 data tstatus
c510: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
c520: 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 me "data" (conc
c530: 74 65 73 74 2d 69 64 29 20 22 73 74 61 74 75 73 test-id) "status
c540: 22 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b " ).... ;
c550: 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ; (mutils:hierh
c560: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 72 ash-set! data r
c570: 75 6e 64 69 72 20 20 20 20 20 74 61 72 67 65 74 undir target
c580: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 str runname "dat
c590: 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 a" (conc test-id
c5a0: 29 20 22 72 75 6e 64 69 72 22 20 20 20 20 29 0a ) "rundir" ).
c5b0: 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 ... ;; (mut
c5c0: 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 ils:hierhash-set
c5d0: 21 20 64 61 74 61 20 20 66 69 6e 61 6c 5f 6c 6f ! data final_lo
c5e0: 67 66 20 74 61 72 67 65 74 73 74 72 20 72 75 6e gf targetstr run
c5f0: 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e name "data" (con
c600: 63 20 74 65 73 74 2d 69 64 29 20 22 66 69 6e 61 c test-id) "fina
c610: 6c 5f 6c 6f 67 66 22 29 0a 09 09 09 20 20 20 20 l_logf")....
c620: 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 ;; (mutils:hie
c630: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
c640: 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 61 run_duration ta
c650: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
c660: 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 "data" (conc tes
c670: 74 2d 69 64 29 20 22 72 75 6e 5f 64 75 72 61 74 t-id) "run_durat
c680: 69 6f 6e 22 29 0a 09 09 09 20 20 20 20 20 3b 3b ion").... ;;
c690: 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 (mutils:hierha
c6a0: 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 65 76 sh-set! data ev
c6b0: 65 6e 74 2d 74 69 6d 65 20 74 61 72 67 65 74 73 ent-time targets
c6c0: 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 tr runname "data
c6d0: 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 " (conc test-id)
c6e0: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 0a 09 "event_time")..
c6f0: 09 09 20 20 20 20 20 3b 3b 20 20 3b 3b 20 61 64 .. ;; ;; ad
c700: 64 20 6c 61 73 74 20 65 6e 74 72 79 20 74 77 69 d last entry twi
c710: 63 65 20 2d 20 73 65 65 6d 73 20 74 6f 20 62 65 ce - seems to be
c720: 20 61 20 62 75 67 20 69 6e 20 68 69 65 72 68 61 a bug in hierha
c730: 73 68 3f 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 sh?.... ;;
c740: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
c750: 2d 73 65 74 21 20 64 61 74 61 20 20 65 76 65 6e -set! data even
c760: 74 2d 74 69 6d 65 20 74 61 72 67 65 74 73 74 72 t-time targetstr
c770: 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 runname "data"
c780: 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 (conc test-id) "
c790: 65 76 65 6e 74 5f 74 69 6d 65 22 29 0a 09 09 09 event_time")....
c7a0: 20 20 20 20 20 3b 3b 20 20 29 0a 09 09 09 20 20 ;; )....
c7b0: 20 20 20 28 65 6c 73 65 0a 09 09 09 20 20 20 20 (else....
c7c0: 20 20 28 69 66 20 28 61 6e 64 20 74 73 74 61 74 (if (and tstat
c7d0: 65 20 74 73 74 61 74 75 73 20 65 76 65 6e 74 2d e tstatus event-
c7e0: 74 69 6d 65 29 0a 09 09 09 09 20 20 28 66 6f 72 time)..... (for
c7f0: 6d 61 74 20 23 74 0a 09 09 09 09 09 20 20 22 20 mat #t...... "
c800: 20 54 65 73 74 3a 20 7e 32 35 61 20 53 74 61 74 Test: ~25a Stat
c810: 65 3a 20 7e 31 35 61 20 53 74 61 74 75 73 3a 20 e: ~15a Status:
c820: 7e 31 35 61 20 52 75 6e 74 69 6d 65 3a 20 7e 35 ~15a Runtime: ~5
c830: 40 61 73 20 54 69 6d 65 3a 20 7e 32 32 61 20 48 @as Time: ~22a H
c840: 6f 73 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 09 ost: ~10a\n"....
c850: 09 09 20 20 28 69 66 20 66 75 6c 6c 6e 61 6d 65 .. (if fullname
c860: 20 66 75 6c 6c 6e 61 6d 65 20 22 22 29 0a 09 09 fullname "")...
c870: 09 09 09 20 20 28 69 66 20 74 73 74 61 74 65 20 ... (if tstate
c880: 20 20 74 73 74 61 74 65 20 20 20 22 22 29 0a 09 tstate "")..
c890: 09 09 09 09 20 20 28 69 66 20 74 73 74 61 74 75 .... (if tstatu
c8a0: 73 20 20 74 73 74 61 74 75 73 20 20 22 22 29 0a s tstatus "").
c8b0: 09 09 09 09 09 20 20 28 67 65 74 2d 76 61 6c 75 ..... (get-valu
c8c0: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
c8d0: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
c8e0: 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 61 74 69 ndex "run_durati
c8f0: 6f 6e 22 29 3b 3b 28 69 66 20 74 65 73 74 20 20 on");;(if test
c900: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
c910: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 run_duration tes
c920: 74 29 20 22 22 29 0a 09 09 09 09 09 20 20 28 69 t) "")...... (i
c930: 66 20 65 76 65 6e 74 2d 74 69 6d 65 20 65 76 65 f event-time eve
c940: 6e 74 2d 74 69 6d 65 20 22 22 29 0a 09 09 09 09 nt-time "").....
c950: 09 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 . (get-value-by
c960: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
c970: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
c980: 20 22 68 6f 73 74 22 29 29 20 3b 3b 28 69 66 20 "host")) ;;(if
c990: 74 65 73 74 20 28 64 62 3a 74 65 73 74 2d 67 65 test (db:test-ge
c9a0: 74 2d 68 6f 73 74 20 74 65 73 74 29 29 20 22 22 t-host test)) ""
c9b0: 29 0a 09 09 09 09 20 20 28 70 72 69 6e 74 20 22 )..... (print "
c9c0: 20 20 54 65 73 74 3a 20 22 20 66 75 6c 6c 6e 61 Test: " fullna
c9d0: 6d 65 0a 09 09 09 09 09 20 28 69 66 20 74 73 74 me...... (if tst
c9e0: 61 74 65 20 20 28 63 6f 6e 63 20 22 20 53 74 61 ate (conc " Sta
c9f0: 74 65 3a 20 22 20 20 74 73 74 61 74 65 29 20 20 te: " tstate)
ca00: 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 74 73 "")...... (if ts
ca10: 74 61 74 75 73 20 28 63 6f 6e 63 20 22 20 53 74 tatus (conc " St
ca20: 61 74 75 73 3a 20 22 20 74 73 74 61 74 75 73 29 atus: " tstatus)
ca30: 20 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 28 "")...... (if (
ca40: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
ca50: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
ca60: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 -field-index "ru
ca70: 6e 5f 64 75 72 61 74 69 6f 6e 22 29 0a 09 09 09 n_duration")....
ca80: 09 09 20 20 20 20 20 28 63 6f 6e 63 20 22 20 52 .. (conc " R
ca90: 75 6e 74 69 6d 65 3a 20 22 20 28 67 65 74 2d 76 untime: " (get-v
caa0: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
cab0: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
cac0: 64 2d 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 d-index "run_dur
cad0: 61 74 69 6f 6e 22 29 29 0a 09 09 09 09 09 20 20 ation"))......
cae0: 20 20 20 22 22 29 0a 09 09 09 09 09 20 28 69 66 "")...... (if
caf0: 20 65 76 65 6e 74 2d 74 69 6d 65 20 28 63 6f 6e event-time (con
cb00: 63 20 22 20 54 69 6d 65 3a 20 22 20 65 76 65 6e c " Time: " even
cb10: 74 2d 74 69 6d 65 29 20 22 22 29 0a 09 09 09 09 t-time) "").....
cb20: 09 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 . (if (get-value
cb30: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
cb40: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
cb50: 64 65 78 20 22 68 6f 73 74 22 29 0a 09 09 09 09 dex "host").....
cb60: 09 20 20 20 20 20 28 63 6f 6e 63 20 22 20 48 6f . (conc " Ho
cb70: 73 74 3a 20 22 20 28 67 65 74 2d 76 61 6c 75 65 st: " (get-value
cb80: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
cb90: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
cba0: 64 65 78 20 22 68 6f 73 74 22 29 29 0a 09 09 09 dex "host"))....
cbb0: 09 09 20 20 20 20 20 22 22 29 29 29 0a 09 09 09 .. "")))....
cbc0: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
cbd0: 6f 72 20 28 65 71 75 61 6c 3f 20 28 67 65 74 2d or (equal? (get-
cbe0: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
cbf0: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
cc00: 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 75 73 ld-index "status
cc10: 22 29 20 22 50 41 53 53 22 29 0a 09 09 09 09 09 ") "PASS")......
cc20: 20 20 20 28 65 71 75 61 6c 3f 20 28 67 65 74 2d (equal? (get-
cc30: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
cc40: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
cc50: 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 75 73 ld-index "status
cc60: 22 29 20 22 57 41 52 4e 22 29 0a 09 09 09 09 09 ") "WARN")......
cc70: 20 20 20 28 65 71 75 61 6c 3f 20 28 67 65 74 2d (equal? (get-
cc80: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
cc90: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
cca0: 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 65 22 ld-index "state"
ccb0: 29 20 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 ) "NOT_STARTED"
ccc0: 29 29 29 0a 09 09 09 09 20 20 28 62 65 67 69 6e )))..... (begin
ccd0: 0a 09 09 09 09 20 20 20 20 28 70 72 69 6e 74 20 ..... (print
cce0: 20 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 (if (get-value
ccf0: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
cd00: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
cd10: 64 65 78 20 22 63 70 75 6c 6f 61 64 22 29 0a 09 dex "cpuload")..
cd20: 09 09 09 09 09 20 28 63 6f 6e 63 20 22 20 20 20 ..... (conc "
cd30: 20 20 20 20 20 20 63 70 75 6c 6f 61 64 3a 20 20 cpuload:
cd40: 22 20 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 " (get-value-b
cd50: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
cd60: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
cd70: 78 20 22 63 70 75 6c 6f 61 64 22 29 29 0a 09 09 x "cpuload"))...
cd80: 09 09 09 09 20 22 22 29 20 3b 3b 20 28 64 62 3a .... "") ;; (db:
cd90: 74 65 73 74 2d 67 65 74 2d 63 70 75 6c 6f 61 64 test-get-cpuload
cda0: 20 74 65 73 74 29 0a 09 09 09 09 09 20 20 20 20 test)......
cdb0: 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d (if (get-value-
cdc0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
cdd0: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
cde0: 65 78 20 22 64 69 73 6b 66 72 65 65 22 29 0a 09 ex "diskfree")..
cdf0: 09 09 09 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 ..... (conc "\n
ce00: 20 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 diskfree
ce10: 3a 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 : " (get-value-b
ce20: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
ce30: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
ce40: 78 20 22 64 69 73 6b 66 72 65 65 22 29 29 20 3b x "diskfree")) ;
ce50: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 64 ; (db:test-get-d
ce60: 69 73 6b 66 72 65 65 20 74 65 73 74 29 0a 09 09 iskfree test)...
ce70: 09 09 09 09 20 22 22 29 0a 09 09 09 09 09 20 20 .... "")......
ce80: 20 20 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 (if (get-valu
ce90: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
cea0: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
ceb0: 6e 64 65 78 20 22 75 6e 61 6d 65 22 29 0a 09 09 ndex "uname")...
cec0: 09 09 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 20 .... (conc "\n
ced0: 20 20 20 20 20 20 20 75 6e 61 6d 65 3a 20 20 20 uname:
cee0: 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 " (get-value-by
cef0: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
cf00: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
cf10: 20 22 75 6e 61 6d 65 22 29 29 20 3b 3b 20 28 64 "uname")) ;; (d
cf20: 62 3a 74 65 73 74 2d 67 65 74 2d 75 6e 61 6d 65 b:test-get-uname
cf30: 20 74 65 73 74 29 0a 09 09 09 09 09 09 20 22 22 test)....... ""
cf40: 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 )...... (if
cf50: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
cf60: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
cf70: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 t-field-index "r
cf80: 75 6e 64 69 72 22 29 0a 09 09 09 09 09 09 20 28 undir")....... (
cf90: 63 6f 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 20 conc "\n
cfa0: 20 72 75 6e 64 69 72 3a 20 20 20 22 20 28 67 65 rundir: " (ge
cfb0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
cfc0: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
cfd0: 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 64 ield-index "rund
cfe0: 69 72 22 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 ir")) ;; (db:tes
cff0: 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 t-get-rundir tes
d000: 74 29 0a 09 09 09 09 09 09 20 22 22 29 0a 3b 3b t)....... "").;;
d010: 09 09 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 ..... "\n
d020: 20 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 20 rundir:
d030: 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d " (get-value-by-
d040: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
d050: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
d060: 22 22 29 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 "") ;; (sdb:qry
d070: 27 67 65 74 73 74 72 20 3b 3b 20 28 66 69 6c 65 'getstr ;; (file
d080: 64 62 3a 67 65 74 2d 70 61 74 68 20 2a 66 64 62 db:get-path *fdb
d090: 2a 20 0a 3b 3b 20 09 09 09 09 09 20 20 20 20 20 * .;; .....
d0a0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e (db:test-get-run
d0b0: 64 69 72 20 74 65 73 74 29 20 3b 3b 20 29 0a 09 dir test) ;; )..
d0c0: 09 09 09 09 20 20 20 20 20 29 0a 09 09 09 09 20 .... ).....
d0d0: 20 20 20 3b 3b 20 45 61 63 68 20 74 65 73 74 0a ;; Each test.
d0e0: 09 09 09 09 20 20 20 20 3b 3b 20 44 4f 20 4e 4f .... ;; DO NO
d0f0: 54 20 72 65 6d 6f 74 65 20 72 75 6e 0a 09 09 09 T remote run....
d100: 09 20 20 20 20 28 6c 65 74 20 28 28 73 74 65 70 . (let ((step
d110: 73 20 28 64 62 3a 64 69 73 70 61 74 63 68 2d 71 s (db:dispatch-q
d120: 75 65 72 79 20 61 63 63 65 73 73 2d 6d 6f 64 65 uery access-mode
d130: 20 72 6d 74 3a 67 65 74 2d 73 74 65 70 73 2d 66 rmt:get-steps-f
d140: 6f 72 2d 74 65 73 74 20 64 62 3a 67 65 74 2d 73 or-test db:get-s
d150: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 72 75 teps-for-test ru
d160: 6e 2d 69 64 20 28 64 62 3a 74 65 73 74 2d 67 65 n-id (db:test-ge
d170: 74 2d 69 64 20 74 65 73 74 29 29 29 29 20 3b 3b t-id test)))) ;;
d180: 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 (db:get-steps-f
d190: 6f 72 2d 74 65 73 74 20 64 62 73 74 72 75 63 74 or-test dbstruct
d1a0: 20 72 75 6e 2d 69 64 20 28 64 62 3a 74 65 73 74 run-id (db:test
d1b0: 2d 67 65 74 2d 69 64 20 74 65 73 74 29 29 29 29 -get-id test))))
d1c0: 0a 09 09 09 09 20 20 20 20 20 20 28 66 6f 72 2d ..... (for-
d1d0: 65 61 63 68 20 0a 09 09 09 09 20 20 20 20 20 20 each .....
d1e0: 20 28 6c 61 6d 62 64 61 20 28 73 74 65 70 29 0a (lambda (step).
d1f0: 09 09 09 09 09 20 28 66 6f 72 6d 61 74 20 23 74 ..... (format #t
d200: 20 0a 09 09 09 09 09 09 20 22 20 20 20 20 53 74 ....... " St
d210: 65 70 3a 20 7e 32 30 61 20 53 74 61 74 65 3a 20 ep: ~20a State:
d220: 7e 31 30 61 20 53 74 61 74 75 73 3a 20 7e 31 30 ~10a Status: ~10
d230: 61 20 54 69 6d 65 20 7e 32 32 61 5c 6e 22 0a 09 a Time ~22a\n"..
d240: 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 2d ..... (tdb:step-
d250: 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 get-stepname ste
d260: 70 29 0a 09 09 09 09 09 09 20 28 74 64 62 3a 73 p)....... (tdb:s
d270: 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 74 tep-get-state st
d280: 65 70 29 0a 09 09 09 09 09 09 20 28 74 64 62 3a ep)....... (tdb:
d290: 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 step-get-status
d2a0: 73 74 65 70 29 0a 09 09 09 09 09 09 20 28 74 64 step)....... (td
d2b0: 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 b:step-get-event
d2c0: 5f 74 69 6d 65 20 73 74 65 70 29 29 29 0a 09 09 _time step)))...
d2d0: 09 09 20 20 20 20 20 20 20 73 74 65 70 73 29 29 .. steps))
d2e0: 29 29 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 )))))))...
d2f0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
d300: 67 20 22 2d 73 6f 72 74 22 29 0a 09 09 09 20 20 g "-sort")....
d310: 28 73 6f 72 74 20 74 65 73 74 73 0a 09 09 09 09 (sort tests.....
d320: 28 6c 61 6d 62 64 61 20 28 61 2d 74 65 73 74 20 (lambda (a-test
d330: 62 2d 74 65 73 74 29 0a 09 09 09 09 20 20 28 6c b-test)..... (l
d340: 65 74 2a 20 28 28 6b 65 79 20 20 20 20 28 61 72 et* ((key (ar
d350: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f 72 gs:get-arg "-sor
d360: 74 22 29 29 0a 09 09 09 09 09 20 28 66 69 72 73 t"))...... (firs
d370: 74 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 t (get-value-by
d380: 2d 66 69 65 6c 64 6e 61 6d 65 20 61 2d 74 65 73 -fieldname a-tes
d390: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
d3a0: 65 78 20 6b 65 79 29 29 0a 09 09 09 09 09 20 28 ex key))...... (
d3b0: 73 65 63 6f 6e 64 20 28 67 65 74 2d 76 61 6c 75 second (get-valu
d3c0: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 62 e-by-fieldname b
d3d0: 2d 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 -test test-field
d3e0: 2d 69 6e 64 65 78 20 6b 65 79 29 29 29 0a 09 09 -index key)))...
d3f0: 09 09 20 20 20 20 28 28 63 6f 6e 64 20 0a 09 09 .. ((cond ...
d400: 09 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 6e .. ((and (n
d410: 75 6d 62 65 72 3f 20 66 69 72 73 74 29 28 6e 75 umber? first)(nu
d420: 6d 62 65 72 3f 20 73 65 63 6f 6e 64 29 29 20 3c mber? second)) <
d430: 29 0a 09 09 09 09 20 20 20 20 20 20 28 28 61 6e )..... ((an
d440: 64 20 28 73 74 72 69 6e 67 3f 20 66 69 72 73 74 d (string? first
d450: 29 28 73 74 72 69 6e 67 3f 20 73 65 63 6f 6e 64 )(string? second
d460: 29 29 20 73 74 72 69 6e 67 3c 3d 3f 29 0a 09 09 )) string<=?)...
d470: 09 09 20 20 20 20 20 20 28 65 6c 73 65 20 65 71 .. (else eq
d480: 75 61 6c 3f 29 29 0a 09 09 09 09 20 20 20 20 20 ual?)).....
d490: 66 69 72 73 74 20 73 65 63 6f 6e 64 29 29 29 29 first second))))
d4a0: 0a 09 09 09 20 20 74 65 73 74 73 29 29 29 29 29 .... tests)))))
d4b0: 29 0a 09 20 20 20 72 75 6e 73 29 0a 09 20 20 28 ).. runs).. (
d4c0: 69 66 20 28 65 71 3f 20 64 6d 6f 64 65 20 27 6a if (eq? dmode 'j
d4d0: 73 6f 6e 29 28 6a 73 6f 6e 2d 77 72 69 74 65 20 son)(json-write
d4e0: 64 61 74 61 29 29 0a 09 20 20 28 6c 65 74 2a 20 data)).. (let*
d4f0: 28 28 6d 65 74 61 64 61 74 2d 66 69 65 6c 64 73 ((metadat-fields
d500: 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 (delete-duplica
d510: 74 65 73 0a 09 09 09 09 20 20 28 61 70 70 65 6e tes..... (appen
d520: 64 20 6b 65 79 73 20 27 28 20 22 72 75 6e 6e 61 d keys '( "runna
d530: 6d 65 22 20 22 74 69 6d 65 22 20 22 6f 77 6e 65 me" "time" "owne
d540: 72 22 20 22 70 61 73 73 5f 63 6f 75 6e 74 22 20 r" "pass_count"
d550: 22 66 61 69 6c 5f 63 6f 75 6e 74 22 20 22 73 74 "fail_count" "st
d560: 61 74 65 22 20 22 73 74 61 74 75 73 22 20 22 63 ate" "status" "c
d570: 6f 6d 6d 65 6e 74 22 20 22 69 64 22 29 29 29 29 omment" "id"))))
d580: 0a 09 09 20 28 72 75 6e 2d 66 69 65 6c 64 73 20 ... (run-fields
d590: 20 20 20 27 28 0a 09 09 09 09 20 20 22 74 65 73 '(..... "tes
d5a0: 74 6e 61 6d 65 22 0a 09 09 09 09 20 20 22 69 74 tname"..... "it
d5b0: 65 6d 5f 70 61 74 68 22 0a 09 09 09 09 20 20 22 em_path"..... "
d5c0: 73 74 61 74 65 22 0a 09 09 09 09 20 20 22 73 74 state"..... "st
d5d0: 61 74 75 73 22 0a 09 09 09 09 20 20 22 63 6f 6d atus"..... "com
d5e0: 6d 65 6e 74 22 0a 09 09 09 09 20 20 22 65 76 65 ment"..... "eve
d5f0: 6e 74 5f 74 69 6d 65 22 0a 09 09 09 09 20 20 22 nt_time"..... "
d600: 68 6f 73 74 22 0a 09 09 09 09 20 20 22 72 75 6e host"..... "run
d610: 5f 69 64 22 0a 09 09 09 09 20 20 22 72 75 6e 5f _id"..... "run_
d620: 64 75 72 61 74 69 6f 6e 22 0a 09 09 09 09 20 20 duration".....
d630: 22 61 74 74 65 6d 70 74 6e 75 6d 22 0a 09 09 09 "attemptnum"....
d640: 09 20 20 22 69 64 22 0a 09 09 09 09 20 20 22 61 . "id"..... "a
d650: 72 63 68 69 76 65 64 22 0a 09 09 09 09 20 20 22 rchived"..... "
d660: 64 69 73 6b 66 72 65 65 22 0a 09 09 09 09 20 20 diskfree".....
d670: 22 63 70 75 6c 6f 61 64 22 0a 09 09 09 09 20 20 "cpuload".....
d680: 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 0a 09 09 09 "final_logf"....
d690: 09 20 20 22 73 68 6f 72 74 64 69 72 22 0a 09 09 . "shortdir"...
d6a0: 09 09 20 20 22 72 75 6e 64 69 72 22 0a 09 09 09 .. "rundir"....
d6b0: 09 20 20 22 75 6e 61 6d 65 22 0a 09 09 09 09 20 . "uname".....
d6c0: 20 29 0a 09 09 09 09 29 0a 09 09 20 28 6e 65 77 ).....)... (new
d6d0: 64 61 74 20 20 20 20 20 20 20 20 20 20 28 63 6f dat (co
d6e0: 6d 6d 6f 6e 3a 74 6f 2d 61 6c 69 73 74 20 64 61 mmon:to-alist da
d6f0: 74 61 29 29 0a 09 09 20 28 61 6c 6c 72 75 6e 64 ta))... (allrund
d700: 61 74 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 at (if (nu
d710: 6c 6c 3f 20 6e 65 77 64 61 74 29 0a 09 09 09 09 ll? newdat).....
d720: 20 20 20 20 20 20 27 28 29 0a 09 09 09 09 20 20 '().....
d730: 20 20 20 20 28 63 61 72 20 28 6d 61 70 20 63 64 (car (map cd
d740: 72 20 6e 65 77 64 61 74 29 29 29 29 20 3b 3b 20 r newdat)))) ;;
d750: 28 63 61 72 20 28 6d 61 70 20 63 64 72 20 28 63 (car (map cdr (c
d760: 61 72 20 28 6d 61 70 20 63 64 72 20 6e 65 77 64 ar (map cdr newd
d770: 61 74 29 29 29 29 29 0a 09 09 20 28 72 75 6e 73 at)))))... (runs
d780: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
d790: 65 6e 64 0a 09 09 09 09 20 20 20 28 6c 69 73 74 end..... (list
d7a0: 20 22 72 75 6e 73 22 20 3b 3b 20 73 68 65 65 74 "runs" ;; sheet
d7b0: 6e 61 6d 65 0a 09 09 09 09 09 20 6d 65 74 61 64 name...... metad
d7c0: 61 74 2d 66 69 65 6c 64 73 29 0a 09 09 09 09 20 at-fields).....
d7d0: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
d7e0: 72 75 6e 29 0a 09 09 09 09 09 20 20 3b 3b 20 28 run)...... ;; (
d7f0: 70 72 69 6e 74 20 22 72 75 6e 3a 20 22 20 72 75 print "run: " ru
d800: 6e 29 0a 09 09 09 09 09 20 20 28 6c 65 74 2a 20 n)...... (let*
d810: 28 28 72 75 6e 6e 61 6d 65 20 28 63 61 72 20 72 ((runname (car r
d820: 75 6e 29 29 0a 09 09 09 09 09 09 20 28 72 75 6e un))....... (run
d830: 64 61 74 20 20 28 63 64 72 20 72 75 6e 29 29 0a dat (cdr run)).
d840: 09 09 09 09 09 09 20 28 6d 65 74 61 64 61 74 20 ...... (metadat
d850: 28 6c 65 74 20 28 28 74 6d 70 20 28 61 73 73 6f (let ((tmp (asso
d860: 63 20 22 6d 65 74 61 22 20 72 75 6e 64 61 74 29 c "meta" rundat)
d870: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 69 ))........ (i
d880: 66 20 74 6d 70 20 28 63 64 72 20 74 6d 70 29 20 f tmp (cdr tmp)
d890: 23 66 29 29 29 29 0a 09 09 09 09 09 20 20 20 20 #f))))......
d8a0: 3b 3b 20 28 70 72 69 6e 74 20 22 72 75 6e 6e 61 ;; (print "runna
d8b0: 6d 65 3a 20 22 20 72 75 6e 6e 61 6d 65 20 22 5c me: " runname "\
d8c0: 6e 5c 6e 72 75 6e 64 61 74 3a 20 22 20 29 28 70 n\nrundat: " )(p
d8d0: 70 20 72 75 6e 64 61 74 29 28 70 72 69 6e 74 20 p rundat)(print
d8e0: 22 5c 6e 5c 6e 6d 65 74 61 64 61 74 3a 20 22 29 "\n\nmetadat: ")
d8f0: 28 70 70 20 6d 65 74 61 64 61 74 29 0a 09 09 09 (pp metadat)....
d900: 09 09 20 20 20 20 28 69 66 20 6d 65 74 61 64 61 .. (if metada
d910: 74 0a 09 09 09 09 09 09 28 6d 61 70 20 28 6c 61 t.......(map (la
d920: 6d 62 64 61 20 28 66 69 65 6c 64 29 0a 09 09 09 mbda (field)....
d930: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 ... (let (
d940: 28 74 6d 70 20 28 61 73 73 6f 63 20 66 69 65 6c (tmp (assoc fiel
d950: 64 20 6d 65 74 61 64 61 74 29 29 29 0a 09 09 09 d metadat)))....
d960: 09 09 09 09 20 28 69 66 20 74 6d 70 20 28 63 64 .... (if tmp (cd
d970: 72 20 74 6d 70 29 20 22 22 29 29 29 0a 09 09 09 r tmp) "")))....
d980: 09 09 09 20 20 20 20 20 6d 65 74 61 64 61 74 2d ... metadat-
d990: 66 69 65 6c 64 73 29 0a 09 09 09 09 09 09 28 62 fields).......(b
d9a0: 65 67 69 6e 0a 09 09 09 09 09 09 20 20 28 64 65 egin....... (de
d9b0: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
d9c0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
d9d0: 57 41 52 4e 49 4e 47 3a 20 6d 65 74 61 20 64 61 WARNING: meta da
d9e0: 74 61 20 66 6f 72 20 72 75 6e 20 22 20 72 75 6e ta for run " run
d9f0: 6e 61 6d 65 20 22 20 6e 6f 74 20 66 6f 75 6e 64 name " not found
da00: 22 29 0a 09 09 09 09 09 09 20 20 27 28 29 29 29 ")....... '()))
da10: 29 29 0a 09 09 09 09 09 61 6c 6c 72 75 6e 64 61 ))......allrunda
da20: 74 29 29 29 0a 09 09 20 3b 3b 20 27 28 20 28 20 t)))... ;; '( (
da30: 22 74 61 72 67 65 74 22 20 28 20 22 72 75 6e 6e "target" ( "runn
da40: 61 6d 65 22 20 28 20 22 64 61 74 61 22 20 28 20 ame" ( "data" (
da50: 22 72 75 6e 69 64 22 20 28 20 22 69 64 20 2e 20 "runid" ( "id .
da60: 22 33 37 22 20 29 20 28 20 2e 2e 2e 20 29 29 29 "37" ) ( ... )))
da70: 29 0a 09 09 20 28 72 75 6e 2d 70 61 67 65 73 20 )... (run-pages
da80: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd
da90: 61 20 28 74 61 72 67 64 61 74 29 0a 09 09 09 09 a (targdat).....
daa0: 09 28 6c 65 74 2a 20 28 28 74 61 72 67 65 74 20 .(let* ((target
dab0: 20 28 63 61 72 20 74 61 72 67 64 61 74 29 29 0a (car targdat)).
dac0: 09 09 09 09 09 20 20 20 20 20 20 20 28 72 75 6e ..... (run
dad0: 73 64 61 74 20 28 63 64 72 20 74 61 72 67 64 61 sdat (cdr targda
dae0: 74 29 29 29 0a 09 09 09 09 09 20 20 28 69 66 20 t)))...... (if
daf0: 72 75 6e 73 64 61 74 0a 09 09 09 09 09 20 20 20 runsdat......
db00: 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda
db10: 28 72 75 6e 64 61 74 29 0a 09 09 09 09 09 09 20 (rundat).......
db20: 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 6e (let* ((runn
db30: 61 6d 65 20 20 28 63 61 72 20 72 75 6e 64 61 74 ame (car rundat
db40: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 72 ))........ (r
db50: 75 6e 64 61 74 20 20 20 28 63 64 72 20 72 75 6e undat (cdr run
db60: 64 61 74 29 29 0a 09 09 09 09 09 09 09 20 20 20 dat))........
db70: 20 28 74 65 73 74 73 64 61 74 20 28 6c 65 74 20 (testsdat (let
db80: 28 28 74 6d 70 20 28 61 73 73 6f 63 20 22 64 61 ((tmp (assoc "da
db90: 74 61 22 20 72 75 6e 64 61 74 29 29 29 0a 09 09 ta" rundat)))...
dba0: 09 09 09 09 09 09 09 28 69 66 20 74 6d 70 20 28 .......(if tmp (
dbb0: 63 64 72 20 74 6d 70 29 20 23 66 29 29 29 29 0a cdr tmp) #f)))).
dbc0: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 69 66 ...... (if
dbd0: 20 74 65 73 74 73 64 61 74 0a 09 09 09 09 09 09 testsdat.......
dbe0: 09 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 73 . (let ((tests
dbf0: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 74 (map (lambda (t
dc00: 65 73 74 29 0a 09 09 09 09 09 09 09 09 09 20 20 est)..........
dc10: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 (let* ((tes
dc20: 74 2d 69 64 20 20 28 63 61 72 20 74 65 73 74 29 t-id (car test)
dc30: 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 20 )...........
dc40: 20 20 28 74 65 73 74 2d 64 61 74 20 28 63 64 72 (test-dat (cdr
dc50: 20 74 65 73 74 29 29 29 0a 09 09 09 09 09 09 09 test)))........
dc60: 09 09 09 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 ... (map (lambda
dc70: 20 28 66 69 65 6c 64 29 0a 09 09 09 09 09 09 09 (field)........
dc80: 09 09 09 09 28 6c 65 74 20 28 28 74 6d 70 20 28 ....(let ((tmp (
dc90: 61 73 73 6f 63 20 66 69 65 6c 64 20 74 65 73 74 assoc field test
dca0: 2d 64 61 74 29 29 29 0a 09 09 09 09 09 09 09 09 -dat))).........
dcb0: 09 09 09 20 20 28 69 66 20 74 6d 70 20 28 63 64 ... (if tmp (cd
dcc0: 72 20 74 6d 70 29 20 22 22 29 29 29 0a 09 09 09 r tmp) "")))....
dcd0: 09 09 09 09 09 09 09 20 20 20 20 20 20 72 75 6e ....... run
dce0: 2d 66 69 65 6c 64 73 29 29 29 0a 09 09 09 09 09 -fields)))......
dcf0: 09 09 09 09 20 20 20 20 20 74 65 73 74 73 64 61 .... testsda
dd00: 74 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 t)))........
dd10: 20 3b 3b 20 28 70 72 69 6e 74 20 22 54 61 72 67 ;; (print "Targ
dd20: 65 74 3a 20 22 20 74 61 72 67 65 74 20 22 2f 22 et: " target "/"
dd30: 20 72 75 6e 6e 61 6d 65 20 22 20 74 65 73 74 73 runname " tests
dd40: 3a 22 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 :")........
dd50: 3b 3b 20 28 70 70 20 74 65 73 74 73 29 0a 09 09 ;; (pp tests)...
dd60: 09 09 09 09 09 20 20 20 20 20 28 63 6f 6e 73 20 ..... (cons
dd70: 28 63 6f 6e 63 20 74 61 72 67 65 74 20 22 2f 22 (conc target "/"
dd80: 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 09 runname).......
dd90: 09 09 20 20 20 28 63 6f 6e 73 20 28 6c 69 73 74 .. (cons (list
dda0: 20 28 63 6f 6e 63 20 74 61 72 67 65 74 20 22 2f (conc target "/
ddb0: 22 20 72 75 6e 6e 61 6d 65 29 29 0a 09 09 09 09 " runname)).....
ddc0: 09 09 09 09 09 20 28 63 6f 6e 73 20 27 28 29 0a ..... (cons '().
ddd0: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
dde0: 28 63 6f 6e 73 20 72 75 6e 2d 66 69 65 6c 64 73 (cons run-fields
ddf0: 20 74 65 73 74 73 29 29 29 29 29 0a 09 09 09 09 tests))))).....
de00: 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 ... (begin....
de10: 09 09 09 09 20 20 20 20 20 28 64 65 62 75 67 3a .... (debug:
de20: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
de30: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e -log-port* "WARN
de40: 49 4e 47 3a 20 72 75 6e 20 22 20 74 61 72 67 65 ING: run " targe
de50: 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 20 t "/" runname "
de60: 61 70 70 65 61 72 73 20 74 6f 20 68 61 76 65 20 appears to have
de70: 6e 6f 20 64 61 74 61 22 29 0a 09 09 09 09 09 09 no data").......
de80: 09 20 20 20 20 20 3b 3b 20 28 70 70 20 72 75 6e . ;; (pp run
de90: 64 61 74 29 0a 09 09 09 09 09 09 09 20 20 20 20 dat)........
dea0: 20 27 28 29 29 29 29 29 0a 09 09 09 09 09 09 20 '())))).......
deb0: 20 20 72 75 6e 73 64 61 74 29 0a 09 09 09 09 09 runsdat)......
dec0: 20 20 20 20 20 20 27 28 29 29 29 29 0a 09 09 09 '())))....
ded0: 09 20 20 20 20 20 20 6e 65 77 64 61 74 29 29 20 . newdat))
dee0: 3b 3b 20 77 65 20 75 73 65 20 6e 65 77 64 61 74 ;; we use newdat
def0: 20 74 6f 20 67 65 74 20 74 61 72 67 65 74 0a 09 to get target..
df00: 09 20 28 73 68 65 65 74 73 20 20 20 20 20 20 20 . (sheets
df10: 20 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 (filter (lambd
df20: 61 20 28 78 29 0a 09 09 09 09 09 20 20 20 28 6e a (x)...... (n
df30: 6f 74 20 28 6e 75 6c 6c 3f 20 78 29 29 29 0a 09 ot (null? x)))..
df40: 09 09 09 09 20 28 63 6f 6e 73 20 72 75 6e 73 20 .... (cons runs
df50: 28 6d 61 70 20 63 61 72 20 72 75 6e 2d 70 61 67 (map car run-pag
df60: 65 73 29 29 29 29 29 0a 09 20 20 20 20 3b 3b 20 es))))).. ;;
df70: 28 70 72 69 6e 74 20 22 61 6c 6c 72 75 6e 64 61 (print "allrunda
df80: 74 3a 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 70 t:").. ;; (pp
df90: 20 61 6c 6c 72 75 6e 64 61 74 29 0a 09 20 20 20 allrundat)..
dfa0: 20 3b 3b 20 28 70 72 69 6e 74 20 22 72 75 6e 73 ;; (print "runs
dfb0: 3a 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 70 20 :").. ;; (pp
dfc0: 72 75 6e 73 29 0a 09 20 20 20 20 3b 28 70 72 69 runs).. ;(pri
dfd0: 6e 74 20 22 73 68 65 65 74 73 3a 20 22 29 0a 09 nt "sheets: ")..
dfe0: 20 20 20 20 3b 3b 20 28 70 70 20 73 68 65 65 74 ;; (pp sheet
dff0: 73 29 0a 09 20 20 20 20 28 69 66 20 28 65 71 3f s).. (if (eq?
e000: 20 64 6d 6f 64 65 20 27 6f 64 73 29 0a 09 09 28 dmode 'ods)...(
e010: 6c 65 74 2a 20 28 28 74 65 6d 70 64 69 72 20 20 let* ((tempdir
e020: 20 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 (conc "/tmp/"
e030: 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 (current-user-na
e040: 6d 65 29 20 22 2f 22 20 28 72 61 6e 64 6f 6d 20 me) "/" (random
e050: 31 30 30 30 30 29 20 22 5f 22 20 28 63 75 72 72 10000) "_" (curr
e060: 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 ent-process-id))
e070: 29 0a 09 09 20 20 20 20 20 20 20 28 6f 75 74 70 )... (outp
e080: 75 74 66 69 6c 65 20 28 6f 72 20 28 61 72 67 73 utfile (or (args
e090: 3a 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 20 22 :get-arg "-o") "
e0a0: 6f 75 74 2e 6f 64 73 22 29 29 0a 09 09 20 20 20 out.ods"))...
e0b0: 20 20 20 20 28 6f 75 66 20 20 20 20 20 20 20 20 (ouf
e0c0: 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (if (string-matc
e0d0: 68 20 28 72 65 67 65 78 70 20 22 5e 5b 2f 7e 5d h (regexp "^[/~]
e0e0: 2b 2e 2a 22 29 20 6f 75 74 70 75 74 66 69 6c 65 +.*") outputfile
e0f0: 29 20 3b 3b 20 66 75 6c 6c 20 70 61 74 68 3f 0a ) ;; full path?.
e100: 09 09 09 09 20 20 20 20 20 20 20 6f 75 74 70 75 .... outpu
e110: 74 66 69 6c 65 0a 09 09 09 09 20 20 20 20 20 20 tfile.....
e120: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 28 64 (begin...... (d
e130: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
e140: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
e150: 22 57 41 52 4e 49 4e 47 3a 20 70 61 74 68 20 67 "WARNING: path g
e160: 69 76 65 6e 2c 20 22 20 6f 75 74 70 75 74 66 69 iven, " outputfi
e170: 6c 65 20 22 20 69 73 20 72 65 6c 61 74 69 76 65 le " is relative
e180: 2c 20 70 72 65 66 69 78 69 6e 67 20 77 69 74 68 , prefixing with
e190: 20 63 75 72 72 65 6e 74 20 64 69 72 65 63 74 6f current directo
e1a0: 72 79 22 29 0a 09 09 09 09 09 20 28 63 6f 6e 63 ry")...... (conc
e1b0: 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 (current-direct
e1c0: 6f 72 79 29 20 22 2f 22 20 6f 75 74 70 75 74 66 ory) "/" outputf
e1d0: 69 6c 65 29 29 29 29 29 0a 09 09 20 20 28 63 72 ile)))))... (cr
e1e0: 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 eate-directory t
e1f0: 65 6d 70 64 69 72 20 23 74 29 0a 09 09 20 20 28 empdir #t)... (
e200: 6f 64 73 3a 6c 69 73 74 2d 3e 6f 64 73 20 74 65 ods:list->ods te
e210: 6d 70 64 69 72 20 6f 75 66 20 73 68 65 65 74 73 mpdir ouf sheets
e220: 29 29 29 29 0a 09 20 20 3b 3b 20 28 73 79 73 74 )))).. ;; (syst
e230: 65 6d 20 28 63 6f 6e 63 20 22 72 6d 20 2d 72 66 em (conc "rm -rf
e240: 20 22 20 74 65 6d 70 64 69 72 29 29 0a 09 20 20 " tempdir))..
e250: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
e260: 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 20 ing* #t))))..;;
e270: 44 6f 6e 27 74 20 74 68 69 6e 6b 20 49 20 6e 65 Don't think I ne
e280: 65 64 20 74 68 69 73 2e 20 49 6e 63 6f 72 70 6f ed this. Incorpo
e290: 72 61 74 65 64 20 69 6e 74 6f 20 2d 6c 69 73 74 rated into -list
e2a0: 2d 72 75 6e 73 20 69 6e 73 74 65 61 64 0a 3b 3b -runs instead.;;
e2b0: 0a 3b 3b 20 28 69 66 20 28 61 6e 64 20 28 61 72 .;; (if (and (ar
e2c0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 6e gs:get-arg "-sin
e2d0: 63 65 22 29 0a 3b 3b 20 09 20 28 6c 61 75 6e 63 ce").;; . (launc
e2e0: 68 3a 73 65 74 75 70 29 29 0a 3b 3b 20 20 20 20 h:setup)).;;
e2f0: 20 28 6c 65 74 2a 20 28 28 73 69 6e 63 65 2d 74 (let* ((since-t
e300: 69 6d 65 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d ime (string->num
e310: 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ber (args:get-ar
e320: 67 20 22 2d 73 69 6e 63 65 22 29 29 29 0a 3b 3b g "-since"))).;;
e330: 20 09 20 20 20 28 72 75 6e 2d 69 64 73 20 20 20 . (run-ids
e340: 20 28 64 62 3a 67 65 74 2d 63 68 61 6e 67 65 64 (db:get-changed
e350: 2d 72 75 6e 2d 69 64 73 20 73 69 6e 63 65 2d 74 -run-ids since-t
e360: 69 6d 65 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 ime))).;;
e370: 3b 3b 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 ;; (rmt:get-test
e380: 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 s-for-runs-minda
e390: 74 61 20 72 75 6e 2d 69 64 73 20 74 65 73 74 70 ta run-ids testp
e3a0: 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 75 att states statu
e3b0: 73 20 6e 6f 74 2d 69 6e 29 0a 3b 3b 20 20 20 20 s not-in).;;
e3c0: 20 20 20 28 70 72 69 6e 74 20 28 73 6f 72 74 20 (print (sort
e3d0: 72 75 6e 2d 69 64 73 20 3c 29 29 0a 3b 3b 20 20 run-ids <)).;;
e3e0: 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
e3f0: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
e400: 20 20 20 20 20 20 0a 20 20 20 20 20 20 0a 3b 3b . .;;
e410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e450: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 72 ======.;; full r
e460: 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d un.;;===========
e470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
e4b0: 67 65 74 20 6c 6f 63 6b 20 69 6e 20 64 62 20 66 get lock in db f
e4c0: 6f 72 20 66 75 6c 6c 20 72 75 6e 20 66 6f 72 20 or full run for
e4d0: 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 0a 3b this directory.;
e4e0: 3b 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 20 ; for all tests
e4f0: 77 69 74 68 20 64 65 70 73 0a 3b 3b 20 20 20 77 with deps.;; w
e500: 61 6c 6b 20 74 72 65 65 20 6f 66 20 74 65 73 74 alk tree of test
e510: 73 20 74 6f 20 66 69 6e 64 20 68 65 61 64 20 74 s to find head t
e520: 61 73 6b 73 0a 3b 3b 20 20 20 61 64 64 20 68 65 asks.;; add he
e530: 61 64 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b ad tasks to task
e540: 20 71 75 65 75 65 0a 3b 3b 20 20 20 61 64 64 20 queue.;; add
e550: 64 65 70 65 6e 64 61 6e 74 20 74 61 73 6b 73 20 dependant tasks
e560: 74 6f 20 74 61 73 6b 20 71 75 65 75 65 20 0a 3b to task queue .;
e570: 3b 20 20 20 61 64 64 20 72 65 6d 61 69 6e 69 6e ; add remainin
e580: 67 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 g tasks to task
e590: 71 75 65 75 65 0a 3b 3b 20 66 6f 72 20 65 61 63 queue.;; for eac
e5a0: 68 20 74 61 73 6b 20 69 6e 20 74 61 73 6b 20 71 h task in task q
e5b0: 75 65 75 65 0a 3b 3b 20 20 20 69 66 20 68 61 76 ueue.;; if hav
e5c0: 65 20 61 64 65 71 75 61 74 65 20 72 65 73 6f 75 e adequate resou
e5d0: 72 63 65 73 0a 3b 3b 20 20 20 20 20 6c 61 75 6e rces.;; laun
e5e0: 63 68 20 74 61 73 6b 0a 3b 3b 20 20 20 65 6c 73 ch task.;; els
e5f0: 65 0a 3b 3b 20 20 20 20 20 70 75 74 20 74 61 73 e.;; put tas
e600: 6b 20 69 6e 20 64 65 66 65 72 72 65 64 20 71 75 k in deferred qu
e610: 65 75 65 0a 3b 3b 20 69 66 20 73 74 69 6c 6c 20 eue.;; if still
e620: 6f 6b 20 74 6f 20 72 75 6e 20 74 61 73 6b 73 0a ok to run tasks.
e630: 3b 3b 20 20 20 70 72 6f 63 65 73 73 20 64 65 66 ;; process def
e640: 65 72 72 65 64 20 74 61 73 6b 73 20 70 65 72 20 erred tasks per
e650: 61 62 6f 76 65 20 73 74 65 70 73 0a 0a 3b 3b 20 above steps..;;
e660: 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 61 72 run all tests ar
e670: 65 20 61 72 65 20 4e 6f 74 20 43 4f 4d 50 4c 45 e are Not COMPLE
e680: 54 45 44 20 61 6e 64 20 50 41 53 53 20 6f 72 20 TED and PASS or
e690: 43 48 45 43 4b 0a 28 69 66 20 28 6f 72 20 28 61 CHECK.(if (or (a
e6a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
e6b0: 6e 61 6c 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 nall")..(args:ge
e6c0: 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a 09 28 t-arg "-run")..(
e6d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
e6e0: 65 72 75 6e 2d 63 6c 65 61 6e 22 29 0a 09 28 61 erun-clean")..(a
e6f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
e700: 72 75 6e 2d 61 6c 6c 22 29 0a 09 28 61 72 67 73 run-all")..(args
e710: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
e720: 73 74 73 22 29 29 0a 20 20 20 20 28 67 65 6e 65 sts")). (gene
e730: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 ral-run-call .
e740: 20 20 20 22 2d 72 75 6e 61 6c 6c 22 0a 20 20 20 "-runall".
e750: 20 20 22 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 "run all tests
e760: 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ". (lambda (
e770: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
e780: 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 eys keyvals).
e790: 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 (if (args:ge
e7a0: 74 2d 61 72 67 20 22 2d 72 65 72 75 6e 2d 63 6c t-arg "-rerun-cl
e7b0: 65 61 6e 22 29 20 3b 3b 20 66 69 72 73 74 20 73 ean") ;; first s
e7c0: 65 74 20 73 74 61 74 65 73 2f 73 74 61 74 75 73 et states/status
e7d0: 65 73 20 63 6f 72 72 65 63 74 0a 09 20 20 20 28 es correct.. (
e7e0: 6c 65 74 20 28 28 73 74 61 74 65 73 20 20 20 28 let ((states (
e7f0: 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b or (configf:look
e800: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
e810: 76 61 6c 69 64 76 61 6c 75 65 73 22 20 22 63 6c validvalues" "cl
e820: 65 61 6e 72 65 72 75 6e 2d 73 74 61 74 65 73 22 eanrerun-states"
e830: 29 0a 09 09 09 20 20 20 20 20 20 20 22 4b 49 4c ).... "KIL
e840: 4c 52 45 51 2c 4b 49 4c 4c 45 44 2c 55 4e 4b 4e LREQ,KILLED,UNKN
e850: 4f 57 4e 2c 49 4e 43 4f 4d 50 4c 45 54 45 2c 53 OWN,INCOMPLETE,S
e860: 54 55 43 4b 2c 4e 4f 54 5f 53 54 41 52 54 45 44 TUCK,NOT_STARTED
e870: 22 29 29 0a 09 09 20 28 73 74 61 74 75 73 65 73 "))... (statuses
e880: 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f (or (configf:lo
e890: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
e8a0: 20 22 76 61 6c 69 64 76 61 6c 75 65 73 22 20 22 "validvalues" "
e8b0: 63 6c 65 61 6e 72 65 72 75 6e 2d 73 74 61 74 75 cleanrerun-statu
e8c0: 73 65 73 22 29 0a 09 09 09 20 20 20 20 20 20 20 ses")....
e8d0: 22 46 41 49 4c 2c 49 4e 43 4f 4d 50 4c 45 54 45 "FAIL,INCOMPLETE
e8e0: 2c 41 42 4f 52 54 2c 43 48 45 43 4b 22 29 29 29 ,ABORT,CHECK")))
e8f0: 0a 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 .. (hash-tab
e900: 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 le-set! args:arg
e910: 2d 68 61 73 68 20 22 2d 70 72 65 63 6c 65 61 6e -hash "-preclean
e920: 22 20 23 74 29 0a 09 20 20 20 20 20 28 72 75 6e " #t).. (run
e930: 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 s:operate-on 'se
e940: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a 09 t-state-status..
e950: 09 09 20 20 20 20 20 20 74 61 72 67 65 74 0a 09 .. target..
e960: 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a .. (common:
e970: 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 args-get-runname
e980: 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a ) ;; (or (args:
e990: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d get-arg "-runnam
e9a0: 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 e")(args:get-arg
e9b0: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 ":runname"))...
e9c0: 09 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 63 . "%" ;; (c
e9d0: 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 ommon:args-get-t
e9e0: 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 estpatt #f) ;; (
e9f0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
ea00: 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 estpatt")....
ea10: 20 20 20 73 74 61 74 65 3a 20 20 73 74 61 74 65 state: state
ea20: 73 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 73 74 s.... ;; st
ea30: 61 74 75 73 3a 20 73 74 61 74 75 73 65 73 0a 09 atus: statuses..
ea40: 09 09 20 20 20 20 20 20 6e 65 77 2d 73 74 61 74 .. new-stat
ea50: 65 2d 73 74 61 74 75 73 3a 20 22 4e 4f 54 5f 53 e-status: "NOT_S
ea60: 54 41 52 54 45 44 2c 6e 2f 61 22 29 0a 09 20 20 TARTED,n/a")..
ea70: 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 (runs:operate
ea80: 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 -on 'set-state-s
ea90: 74 61 74 75 73 0a 09 09 09 20 20 20 20 20 20 74 tatus.... t
eaa0: 61 72 67 65 74 0a 09 09 09 20 20 20 20 20 20 28 arget.... (
eab0: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
eac0: 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 runname) ;; (or
ead0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
eae0: 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a -runname")(args:
eaf0: 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d get-arg ":runnam
eb00: 65 22 29 29 0a 09 09 09 20 20 20 20 20 20 22 25 e")).... "%
eb10: 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 " ;; (common:arg
eb20: 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 s-get-testpatt #
eb30: 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d f) ;; (args:get-
eb40: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
eb50: 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 73 74 61 .... ;; sta
eb60: 74 65 3a 20 20 73 74 61 74 65 73 0a 09 09 09 20 te: states....
eb70: 20 20 20 20 20 73 74 61 74 75 73 3a 20 73 74 61 status: sta
eb80: 74 75 73 65 73 0a 09 09 09 20 20 20 20 20 20 6e tuses.... n
eb90: 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a ew-state-status:
eba0: 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f "NOT_STARTED,n/
ebb0: 61 22 29 29 29 0a 20 20 20 20 20 20 20 3b 3b 20 a"))). ;;
ebc0: 52 45 52 55 4e 20 41 4c 4c 0a 20 20 20 20 20 20 RERUN ALL.
ebd0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
ebe0: 72 67 20 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 29 rg "-rerun-all")
ebf0: 20 3b 3b 20 66 69 72 73 74 20 73 65 74 20 73 74 ;; first set st
ec00: 61 74 65 73 2f 73 74 61 74 75 73 65 73 20 63 6f ates/statuses co
ec10: 72 72 65 63 74 0a 09 20 20 20 28 62 65 67 69 6e rrect.. (begin
ec20: 0a 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 .. (hash-tab
ec30: 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 le-set! args:arg
ec40: 2d 68 61 73 68 20 22 2d 70 72 65 63 6c 65 61 6e -hash "-preclean
ec50: 22 20 23 74 29 0a 09 20 20 20 20 20 28 72 75 6e " #t).. (run
ec60: 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 s:operate-on 'se
ec70: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a 09 t-state-status..
ec80: 09 09 20 20 20 20 20 20 74 61 72 67 65 74 0a 09 .. target..
ec90: 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a .. (common:
eca0: 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 args-get-runname
ecb0: 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a ) ;; (or (args:
ecc0: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d get-arg "-runnam
ecd0: 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 e")(args:get-arg
ece0: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 ":runname"))...
ecf0: 09 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 63 . "%" ;; (c
ed00: 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 ommon:args-get-t
ed10: 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 estpatt #f) ;; (
ed20: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
ed30: 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 estpatt")....
ed40: 20 20 20 73 74 61 74 65 3a 20 20 23 66 0a 09 09 state: #f...
ed50: 09 20 20 20 20 20 20 3b 3b 20 73 74 61 74 75 73 . ;; status
ed60: 3a 20 73 74 61 74 75 73 65 73 0a 09 09 09 20 20 : statuses....
ed70: 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 new-state-st
ed80: 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 atus: "NOT_START
ed90: 45 44 2c 6e 2f 61 22 29 0a 09 20 20 20 20 20 28 ED,n/a").. (
eda0: 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 runs:operate-on
edb0: 27 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 'set-state-statu
edc0: 73 0a 09 09 09 20 20 20 20 20 20 74 61 72 67 65 s.... targe
edd0: 74 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d t.... (comm
ede0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e on:args-get-runn
edf0: 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 ame) ;; (or (ar
ee00: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
ee10: 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d name")(args:get-
ee20: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 arg ":runname"))
ee30: 0a 09 09 09 20 20 20 20 20 20 22 25 22 20 3b 3b .... "%" ;;
ee40: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
ee50: 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 20 3b t-testpatt #f) ;
ee60: 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ; (args:get-arg
ee70: 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 "-testpatt")....
ee80: 20 20 20 20 20 20 3b 3b 20 73 74 61 74 65 3a 20 ;; state:
ee90: 20 73 74 61 74 65 73 0a 09 09 09 20 20 20 20 20 states....
eea0: 20 73 74 61 74 75 73 3a 20 23 66 0a 09 09 09 20 status: #f....
eeb0: 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 new-state-s
eec0: 74 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 tatus: "NOT_STAR
eed0: 54 45 44 2c 6e 2f 61 22 29 29 29 0a 20 20 20 20 TED,n/a"))).
eee0: 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 (runs:run-tes
eef0: 74 73 20 74 61 72 67 65 74 0a 09 09 20 20 20 20 ts target...
ef00: 20 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 20 runname...
ef10: 20 20 20 20 23 66 20 3b 3b 20 28 63 6f 6d 6d 6f #f ;; (commo
ef20: 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 n:args-get-testp
ef30: 61 74 74 20 23 66 29 0a 09 09 20 20 20 20 20 20 att #f)...
ef40: 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 ;; (or (args:ge
ef50: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
ef60: 22 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 20 ")... ;;
ef70: 20 20 20 22 25 22 29 0a 09 09 20 20 20 20 20 20 "%")...
ef80: 20 75 73 65 72 0a 09 09 20 20 20 20 20 20 20 61 user... a
ef90: 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 29 rgs:arg-hash))))
efa0: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
efb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
efc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
efd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
efe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75 ==========.;; ru
eff0: 6e 20 6f 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d 3d n one test.;;===
f000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f040: 3d 3d 3d 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 20 ===..;; 1. find
f050: 74 68 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a the config file.
f060: 3b 3b 20 32 2e 20 63 68 61 6e 67 65 20 74 6f 20 ;; 2. change to
f070: 74 68 65 20 74 65 73 74 20 64 69 72 65 63 74 6f the test directo
f080: 72 79 0a 3b 3b 20 33 2e 20 75 70 64 61 74 65 20 ry.;; 3. update
f090: 74 68 65 20 64 62 20 77 69 74 68 20 22 74 65 73 the db with "tes
f0a0: 74 20 73 74 61 72 74 65 64 22 20 73 74 61 74 75 t started" statu
f0b0: 73 2c 20 73 65 74 20 72 75 6e 6e 69 6e 67 20 68 s, set running h
f0c0: 6f 73 74 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 73 ost.;; 4. proces
f0d0: 73 20 6c 61 75 6e 63 68 20 74 68 65 20 74 65 73 s launch the tes
f0e0: 74 0a 3b 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 6f t.;; - monito
f0f0: 72 20 74 68 65 20 70 72 6f 63 65 73 73 2c 20 75 r the process, u
f100: 70 64 61 74 65 20 73 74 61 74 73 20 69 6e 20 74 pdate stats in t
f110: 68 65 20 64 62 20 65 76 65 72 79 20 32 5e 6e 20 he db every 2^n
f120: 6d 69 6e 75 74 65 73 0a 3b 3b 20 35 2e 20 61 73 minutes.;; 5. as
f130: 20 74 68 65 20 74 65 73 74 20 70 72 6f 63 65 65 the test procee
f140: 64 73 20 69 6e 74 65 72 6e 61 6c 6c 79 20 69 74 ds internally it
f150: 20 63 61 6c 6c 73 20 6d 65 67 61 74 65 73 74 20 calls megatest
f160: 61 73 20 65 61 63 68 20 73 74 65 70 20 69 73 0a as each step is.
f170: 3b 3b 20 20 20 20 73 74 61 72 74 65 64 20 61 6e ;; started an
f180: 64 20 63 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 20 d completed.;;
f190: 20 20 2d 20 73 74 65 70 20 73 74 61 72 74 65 64 - step started
f1a0: 2c 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 20 , timestamp.;;
f1b0: 20 20 2d 20 73 74 65 70 20 63 6f 6d 70 6c 65 74 - step complet
f1c0: 65 64 2c 20 65 78 69 74 20 73 74 61 74 75 73 2c ed, exit status,
f1d0: 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 2e timestamp.;; 6.
f1e0: 20 74 65 73 74 20 70 68 6f 6e 65 20 68 6f 6d 65 test phone home
f1f0: 0a 3b 3b 20 20 20 20 2d 20 69 66 20 74 65 73 74 .;; - if test
f200: 20 72 75 6e 20 74 69 6d 65 20 3e 20 61 6c 6c 6f run time > allo
f210: 77 65 64 20 72 75 6e 20 74 69 6d 65 20 74 68 65 wed run time the
f220: 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 20 n kill job.;;
f230: 20 2d 20 69 66 20 63 61 6e 6e 6f 74 20 61 63 63 - if cannot acc
f240: 65 73 73 20 64 62 20 3e 20 61 6c 6c 6f 77 65 64 ess db > allowed
f250: 20 64 69 73 63 6f 6e 6e 65 63 74 20 74 69 6d 65 disconnect time
f260: 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 0a then kill job..
f270: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f280: 20 3d 3d 20 28 69 66 20 28 6f 72 20 28 61 72 67 == (if (or (arg
f290: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 s:get-arg "-run"
f2a0: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
f2b0: 2d 72 75 6e 74 65 73 74 73 22 29 29 0a 3b 3b 20 -runtests")).;;
f2c0: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f2d0: 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
f2e0: 63 61 6c 6c 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c call .;; == dupl
f2f0: 69 63 61 74 65 64 20 3d 3d 20 20 20 20 22 2d 72 icated == "-r
f300: 75 6e 74 65 73 74 73 22 20 0a 3b 3b 20 3d 3d 20 untests" .;; ==
f310: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
f320: 20 22 72 75 6e 20 61 20 74 65 73 74 22 20 0a 3b "run a test" .;
f330: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
f340: 3d 3d 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 == (lambda (t
f350: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
f360: 79 73 20 6b 65 79 76 61 6c 73 29 0a 3b 3b 20 3d ys keyvals).;; =
f370: 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
f380: 20 20 20 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 ;;.;; == du
f390: 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 plicated ==
f3a0: 20 3b 3b 20 4d 61 79 20 6f 72 20 6d 61 79 20 6e ;; May or may n
f3b0: 6f 74 20 69 6d 70 6c 65 6d 65 6e 74 20 69 74 20 ot implement it
f3c0: 74 68 69 73 20 77 61 79 20 2e 2e 2e 0a 3b 3b 20 this way ....;;
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 0a 3b 3b 20 3d 3d 20 64 ;;.;; == d
f3f0: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
f400: 20 20 3b 3b 20 49 6e 73 65 72 74 20 74 68 69 73 ;; Insert this
f410: 20 72 75 6e 20 69 6e 74 6f 20 74 68 65 20 74 61 run into the ta
f420: 73 6b 73 20 71 75 65 75 65 0a 3b 3b 20 3d 3d 20 sks queue.;; ==
f430: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
f440: 20 20 20 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d ;; (open-run-
f450: 63 6c 6f 73 65 20 74 61 73 6b 73 3a 61 64 64 20 close tasks:add
f460: 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 0a 3b tasks:open-db .;
f470: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
f480: 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 == ;; .
f490: 20 20 20 20 22 72 75 6e 74 65 73 74 73 22 20 0a "runtests" .
f4a0: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f4b0: 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 == ;; .
f4c0: 20 20 20 20 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 user.;; ==
f4d0: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
f4e0: 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 74 ;; . t
f4f0: 61 72 67 65 74 0a 3b 3b 20 3d 3d 20 64 75 70 6c arget.;; == dupl
f500: 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b icated == ;
f510: 3b 20 20 20 20 09 20 20 20 20 20 72 75 6e 6e 61 ; . runna
f520: 6d 65 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 me.;; == duplica
f530: 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 ted == ;;
f540: 20 20 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 . (args:ge
f550: 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 t-arg "-runtests
f560: 22 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 ").;; == duplica
f570: 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 ted == ;;
f580: 20 20 09 20 20 20 20 20 23 66 29 29 29 29 0a 3b . #f)))).;
f590: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
f5a0: 3d 3d 20 20 20 20 20 20 28 72 75 6e 73 3a 72 75 == (runs:ru
f5b0: 6e 2d 74 65 73 74 73 20 74 61 72 67 65 74 0a 3b n-tests target.;
f5c0: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
f5d0: 3d 3d 20 09 09 20 20 20 20 20 72 75 6e 6e 61 6d == .. runnam
f5e0: 65 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 e.;; == duplicat
f5f0: 65 64 20 3d 3d 20 09 09 20 20 20 20 20 28 63 6f ed == .. (co
f600: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 mmon:args-get-te
f610: 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 stpatt #f) ;; (a
f620: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
f630: 6e 74 65 73 74 73 22 29 0a 3b 3b 20 3d 3d 20 64 ntests").;; == d
f640: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 20 uplicated == ..
f650: 20 20 20 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 64 user.;; == d
f660: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 20 uplicated == ..
f670: 20 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 73 args:arg-has
f680: 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d h))))..;;=======
f690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f6a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f6b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f6c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
f6d0: 3b 3b 20 52 6f 6c 6c 75 70 20 69 6e 74 6f 20 61 ;; Rollup into a
f6e0: 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;=========
f6f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
f730: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
f740: 20 22 2d 72 6f 6c 6c 75 70 22 29 0a 20 20 20 20 "-rollup").
f750: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
f760: 6c 20 0a 20 20 20 20 20 22 2d 72 6f 6c 6c 75 70 l . "-rollup
f770: 22 20 0a 20 20 20 20 20 22 72 6f 6c 6c 75 70 20 " . "rollup
f780: 74 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c 61 tests" . (la
f790: 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
f7a0: 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c name keys keyval
f7b0: 73 29 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a s). (runs:
f7c0: 72 6f 6c 6c 75 70 2d 72 75 6e 20 6b 65 79 73 0a rollup-run keys.
f7d0: 09 09 09 6b 65 79 76 61 6c 73 0a 09 09 09 28 6f ...keyvals....(o
f7e0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
f7f0: 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 "-runname")(args
f800: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
f810: 6d 65 22 29 20 29 0a 09 09 09 75 73 65 72 29 29 me") )....user))
f820: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
f830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
f870: 4c 6f 63 6b 20 6f 72 20 75 6e 6c 6f 63 6b 20 61 Lock or unlock a
f880: 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;=========
f890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
f8d0: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
f8e0: 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 28 61 72 -arg "-lock")(ar
f8f0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c gs:get-arg "-unl
f900: 6f 63 6b 22 29 29 0a 20 20 20 20 28 67 65 6e 65 ock")). (gene
f910: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 ral-run-call .
f920: 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 (if (args:get
f930: 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 20 22 2d -arg "-lock") "-
f940: 6c 6f 63 6b 22 20 22 2d 75 6e 6c 6f 63 6b 22 29 lock" "-unlock")
f950: 0a 20 20 20 20 20 22 6c 6f 63 6b 2f 75 6e 6c 6f . "lock/unlo
f960: 63 6b 20 74 65 73 74 73 22 20 0a 20 20 20 20 20 ck tests" .
f970: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
f980: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
f990: 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 72 75 vals). (ru
f9a0: 6e 73 3a 68 61 6e 64 6c 65 2d 6c 6f 63 6b 69 6e ns:handle-lockin
f9b0: 67 20 0a 09 09 20 20 74 61 72 67 65 74 0a 09 09 g ... target...
f9c0: 20 20 6b 65 79 73 0a 09 09 20 20 28 6f 72 20 28 keys... (or (
f9d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
f9e0: 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 unname")(args:ge
f9f0: 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 t-arg ":runname"
fa00: 29 20 29 0a 09 09 20 20 28 61 72 67 73 3a 67 65 ) )... (args:ge
fa10: 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 0a 09 t-arg "-lock")..
fa20: 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 . (args:get-arg
fa30: 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 09 09 20 20 "-unlock")...
fa40: 75 73 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d user))))..;;====
fa50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa90: 3d 3d 0a 3b 3b 20 47 65 74 20 70 61 74 68 73 20 ==.;; Get paths
faa0: 74 6f 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d to tests.;;=====
fab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
faf0: 3d 0a 3b 3b 20 47 65 74 20 74 65 73 74 20 70 61 =.;; Get test pa
fb00: 74 68 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 ths matching tar
fb10: 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e get, runname, an
fb20: 64 20 74 65 73 74 70 61 74 74 0a 28 69 66 20 28 d testpatt.(if (
fb30: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
fb40: 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 29 28 "-test-files")(
fb50: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
fb60: 65 73 74 2d 70 61 74 68 73 22 29 29 0a 20 20 20 est-paths")).
fb70: 20 3b 3b 20 69 66 20 77 65 20 61 72 65 20 69 6e ;; if we are in
fb80: 20 61 20 74 65 73 74 20 75 73 65 20 74 68 65 20 a test use the
fb90: 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 61 74 61 0a MT_CMDINFO data.
fba0: 20 20 20 20 28 69 66 20 28 67 65 74 65 6e 76 20 (if (getenv
fbb0: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 0a 09 28 "MT_CMDINFO")..(
fbc0: 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e 67 64 let* ((startingd
fbd0: 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 ir (current-dire
fbe0: 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 20 20 ctory))..
fbf0: 28 63 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d (cmdinfo (comm
fc00: 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d on:read-encoded-
fc10: 73 74 72 69 6e 67 20 28 67 65 74 65 6e 76 20 22 string (getenv "
fc20: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 MT_CMDINFO")))..
fc30: 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 (transpor
fc40: 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
fc50: 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 'transport cmdi
fc60: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
fc70: 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f estpath (assoc/
fc80: 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 default 'testpat
fc90: 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 h cmdinfo))..
fca0: 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 (test-name
fcb0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
fcc0: 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 test-name cmdinf
fcd0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
fce0: 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 script (assoc/de
fcf0: 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 fault 'runscript
fd00: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
fd10: 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 (db-host (a
fd20: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 ssoc/default 'db
fd30: 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 -host cmdinfo)
fd40: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 ).. (run-i
fd50: 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 d (assoc/defa
fd60: 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 ult 'run-id c
fd70: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
fd80: 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 (itemdat (ass
fd90: 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d oc/default 'item
fda0: 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a dat cmdinfo)).
fdb0: 09 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 . (state
fdc0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
fdd0: 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 ":state"))..
fde0: 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 (status (
fdf0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 args:get-arg ":s
fe00: 74 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 tatus"))..
fe10: 20 28 74 61 72 67 65 74 20 20 20 20 28 61 72 67 (target (arg
fe20: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 s:get-arg "-targ
fe30: 65 74 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 et")).. (t
fe40: 6f 70 70 61 74 68 20 20 20 28 61 73 73 6f 63 2f oppath (assoc/
fe50: 64 65 66 61 75 6c 74 20 27 74 6f 70 70 61 74 68 default 'toppath
fe60: 20 20 20 63 6d 64 69 6e 66 6f 29 29 29 0a 09 20 cmdinfo)))..
fe70: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
fe80: 72 79 20 74 6f 70 70 61 74 68 29 0a 09 20 20 28 ry toppath).. (
fe90: 69 66 20 28 6e 6f 74 20 74 61 72 67 65 74 29 0a if (not target).
fea0: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
feb0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
fec0: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
fed0: 67 2d 70 6f 72 74 2a 20 22 2d 74 61 72 67 65 74 g-port* "-target
fee0: 20 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 0a is required.").
fef0: 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 ..(exit 1)))..
ff00: 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 (if (not (launch
ff10: 3a 73 65 74 75 70 29 29 0a 09 20 20 20 20 20 20 :setup))..
ff20: 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a (begin...(debug:
ff30: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
ff40: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c -log-port* "Fail
ff50: 65 64 20 74 6f 20 73 65 74 75 70 2c 20 67 69 76 ed to setup, giv
ff60: 69 6e 67 20 75 70 20 6f 6e 20 2d 74 65 73 74 2d ing up on -test-
ff70: 70 61 74 68 73 20 6f 72 20 2d 74 65 73 74 2d 66 paths or -test-f
ff80: 69 6c 65 73 2c 20 65 78 69 74 69 6e 67 22 29 0a iles, exiting").
ff90: 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 ..(exit 1)))..
ffa0: 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 20 (let* ((keys
ffb0: 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 (rmt:get-keys))
ffc0: 0a 09 09 20 3b 3b 20 64 62 3a 74 65 73 74 2d 67 ... ;; db:test-g
ffd0: 65 74 2d 70 61 74 68 73 20 6d 75 73 74 20 6e 6f et-paths must no
ffe0: 74 20 62 65 20 72 75 6e 20 72 65 6d 6f 74 65 0a t be run remote.
fff0: 09 09 20 28 70 61 74 68 73 20 20 20 20 28 74 65 .. (paths (te
10000 73 74 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 sts:test-get-pat
10010 68 73 2d 6d 61 74 63 68 69 6e 67 20 6b 65 79 73 hs-matching keys
10020 20 74 61 72 67 65 74 20 28 61 72 67 73 3a 67 65 target (args:ge
10030 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c t-arg "-test-fil
10040 65 73 22 29 29 29 29 0a 09 20 20 20 20 28 73 65 es")))).. (se
10050 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
10060 2a 20 23 74 29 0a 09 20 20 20 20 28 66 6f 72 2d * #t).. (for-
10070 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 each (lambda (pa
10080 74 68 29 0a 09 09 09 28 69 66 20 28 66 69 6c 65 th)....(if (file
10090 2d 65 78 69 73 74 73 3f 20 70 61 74 68 29 0a 09 -exists? path)..
100a0 09 09 28 70 72 69 6e 74 20 70 61 74 68 29 29 29 ..(print path)))
100b0 09 0a 09 09 20 20 20 20 20 20 70 61 74 68 73 29 .... paths)
100c0 29 29 0a 09 3b 3b 20 65 6c 73 65 20 64 6f 20 61 ))..;; else do a
100d0 20 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c general-run-cal
100e0 6c 0a 09 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d l..(general-run-
100f0 63 61 6c 6c 20 0a 09 20 22 2d 74 65 73 74 2d 66 call .. "-test-f
10100 69 6c 65 73 22 0a 09 20 22 47 65 74 20 70 61 74 iles".. "Get pat
10110 68 73 20 74 6f 20 74 65 73 74 22 0a 09 20 28 6c hs to test".. (l
10120 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
10130 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 nname keys keyva
10140 6c 73 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 ls).. (let* ((
10150 64 62 20 20 20 20 20 20 20 23 66 29 0a 09 09 20 db #f)...
10160 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 ;; DO NOT run r
10170 65 6d 6f 74 65 0a 09 09 20 20 28 70 61 74 68 73 emote... (paths
10180 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d (tests:test-
10190 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 get-paths-matchi
101a0 6e 67 20 6b 65 79 73 20 74 61 72 67 65 74 20 28 ng keys target (
101b0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
101c0 65 73 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 est-files"))))..
101d0 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 (for-each (
101e0 6c 61 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 lambda (path)...
101f0 09 20 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a . (print path)).
10200 09 09 20 20 20 20 20 20 20 70 61 74 68 73 29 29 .. paths))
10210 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
10220 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10230 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10240 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10250 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
10260 3b 20 41 72 63 68 69 76 65 20 74 65 73 74 73 0a ; Archive tests.
10270 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
10280 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10290 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
102a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
102b0 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 ========.;; Arch
102c0 69 76 65 20 74 65 73 74 73 20 6d 61 74 63 68 69 ive tests matchi
102d0 6e 67 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 ng target, runna
102e0 6d 65 2c 20 61 6e 64 20 74 65 73 74 70 61 74 74 me, and testpatt
102f0 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
10300 72 67 20 22 2d 61 72 63 68 69 76 65 22 29 0a 20 rg "-archive").
10310 20 20 20 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 ;; else do a
10320 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
10330 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
10340 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 61 n-call . "-a
10350 72 63 68 69 76 65 22 0a 20 20 20 20 20 22 41 72 rchive". "Ar
10360 63 68 69 76 65 22 0a 20 20 20 20 20 28 6c 61 6d chive". (lam
10370 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
10380 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 ame keys keyvals
10390 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 ). (operat
103a0 65 2d 6f 6e 20 27 61 72 63 68 69 76 65 29 29 29 e-on 'archive)))
103b0 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
103e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
103f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 ===========.;; E
10400 78 74 72 61 63 74 20 61 20 73 70 72 65 61 64 73 xtract a spreads
10410 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 72 75 heet from the ru
10420 6e 73 20 64 61 74 61 62 61 73 65 0a 3b 3b 3d 3d ns database.;;==
10430 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10440 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10450 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10460 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10470 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
10480 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 61 63 get-arg "-extrac
10490 74 2d 6f 64 73 22 29 0a 20 20 20 20 28 67 65 6e t-ods"). (gen
104a0 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 eral-run-call.
104b0 20 20 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 "-extract-ods
104c0 22 0a 20 20 20 20 20 22 4d 61 6b 65 20 6f 64 73 ". "Make ods
104d0 20 73 70 72 65 61 64 73 68 65 65 74 22 0a 20 20 spreadsheet".
104e0 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
104f0 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
10500 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 keyvals).
10510 28 6c 65 74 20 28 28 64 62 73 74 72 75 63 74 20 (let ((dbstruct
10520 20 20 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 (make-dbr:dbst
10530 72 75 63 74 20 70 61 74 68 3a 20 2a 74 6f 70 70 ruct path: *topp
10540 61 74 68 2a 20 6c 6f 63 61 6c 3a 20 23 74 29 29 ath* local: #t))
10550 0a 09 20 20 20 20 20 28 6f 75 74 70 75 74 66 69 .. (outputfi
10560 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 le (args:get-arg
10570 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 "-extract-ods")
10580 29 0a 09 20 20 20 20 20 28 72 75 6e 73 70 61 74 ).. (runspat
10590 74 20 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 t (or (args:ge
105a0 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
105b0 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
105c0 3a 72 75 6e 6e 61 6d 65 22 29 29 29 0a 09 20 20 :runname")))..
105d0 20 20 20 28 70 61 74 68 6d 6f 64 20 20 20 20 28 (pathmod (
105e0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 args:get-arg "-p
105f0 61 74 68 6d 6f 64 22 29 29 29 0a 09 20 20 20 20 athmod")))..
10600 20 3b 3b 20 28 6b 65 79 76 61 6c 61 6c 69 73 74 ;; (keyvalalist
10610 20 28 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 (keys->alist ke
10620 79 73 20 22 25 22 29 29 29 0a 09 20 28 64 65 62 ys "%"))).. (deb
10630 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 ug:print 2 *defa
10640 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 ult-log-port* "E
10650 78 74 72 61 63 74 20 6f 64 73 2c 20 6f 75 74 70 xtract ods, outp
10660 75 74 66 69 6c 65 3a 20 22 20 6f 75 74 70 75 74 utfile: " output
10670 66 69 6c 65 20 22 20 72 75 6e 73 70 61 74 74 3a file " runspatt:
10680 20 22 20 72 75 6e 73 70 61 74 74 20 22 20 6b 65 " runspatt " ke
10690 79 76 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 yvals: " keyvals
106a0 29 0a 09 20 28 64 62 3a 65 78 74 72 61 63 74 2d ).. (db:extract-
106b0 6f 64 73 2d 66 69 6c 65 20 64 62 73 74 72 75 63 ods-file dbstruc
106c0 74 20 6f 75 74 70 75 74 66 69 6c 65 20 6b 65 79 t outputfile key
106d0 76 61 6c 73 20 28 69 66 20 72 75 6e 73 70 61 74 vals (if runspat
106e0 74 20 72 75 6e 73 70 61 74 74 20 22 25 22 29 20 t runspatt "%")
106f0 70 61 74 68 6d 6f 64 29 0a 09 20 28 64 62 3a 63 pathmod).. (db:c
10700 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 lose-all dbstruc
10710 74 29 0a 09 20 28 73 65 74 21 20 2a 64 69 64 73 t).. (set! *dids
10720 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 omething* #t))))
10730 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
10740 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10750 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10760 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10770 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 ===========.;; e
10780 78 65 63 75 74 65 20 74 68 65 20 74 65 73 74 0a xecute the test.
10790 3b 3b 20 20 20 20 2d 20 67 65 74 73 20 63 61 6c ;; - gets cal
107a0 6c 65 64 20 6f 6e 20 72 65 6d 6f 74 65 20 68 6f led on remote ho
107b0 73 74 0a 3b 3b 20 20 20 20 2d 20 72 65 63 65 69 st.;; - recei
107c0 76 65 73 20 69 6e 66 6f 20 66 72 6f 6d 20 74 68 ves info from th
107d0 65 20 2d 65 78 65 63 75 74 65 20 70 61 72 61 6d e -execute param
107e0 0a 3b 3b 20 20 20 20 2d 20 70 61 73 73 65 73 20 .;; - passes
107f0 69 6e 66 6f 20 74 6f 20 73 74 65 70 73 20 76 69 info to steps vi
10800 61 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 a MT_CMDINFO env
10810 20 76 61 72 20 28 66 75 74 75 72 65 20 69 73 20 var (future is
10820 74 6f 20 75 73 65 20 61 20 64 6f 74 20 66 69 6c to use a dot fil
10830 65 29 0a 3b 3b 20 20 20 20 2d 20 67 61 74 68 65 e).;; - gathe
10840 72 73 20 68 6f 73 74 20 69 6e 66 6f 20 61 6e 64 rs host info and
10850 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;============
10860 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10870 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 69 66 20 ==========..(if
108a0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
108b0 65 78 65 63 75 74 65 22 29 0a 20 20 20 20 28 62 execute"). (b
108c0 65 67 69 6e 0a 20 20 20 20 20 20 28 6c 61 75 6e egin. (laun
108d0 63 68 3a 65 78 65 63 75 74 65 20 28 61 72 67 73 ch:execute (args
108e0 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 :get-arg "-execu
108f0 74 65 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 te")). (set
10900 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
10910 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d #t)))..;;======
10920 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10930 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10940 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10950 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10960 0a 3b 3b 20 72 65 63 6f 76 65 72 20 66 72 6f 6d .;; recover from
10970 20 61 20 74 65 73 74 20 77 68 65 72 65 20 74 68 a test where th
10980 65 20 6d 61 6e 61 67 69 6e 67 20 6d 74 65 73 74 e managing mtest
10990 20 77 61 73 20 6b 69 6c 6c 65 64 20 62 75 74 20 was killed but
109a0 74 68 65 20 75 6e 64 65 72 6c 79 69 6e 67 0a 3b the underlying.;
109b0 3b 20 70 72 6f 63 65 73 73 20 6d 69 67 68 74 20 ; process might
109c0 73 74 69 6c 6c 20 62 65 20 73 61 6c 76 61 67 65 still be salvage
109d0 61 62 6c 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d able.;;=========
109e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
10a20 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
10a30 20 22 2d 72 65 63 6f 76 65 72 2d 74 65 73 74 22 "-recover-test"
10a40 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 70 61 ). (let* ((pa
10a50 72 61 6d 73 20 28 73 74 72 69 6e 67 2d 73 70 6c rams (string-spl
10a60 69 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 it (args:get-arg
10a70 20 22 2d 72 65 63 6f 76 65 72 2d 74 65 73 74 22 "-recover-test"
10a80 29 20 22 2c 22 29 29 29 0a 20 20 20 20 20 20 28 ) ","))). (
10a90 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 if (> (length pa
10aa0 72 61 6d 73 29 20 31 29 20 3b 3b 20 72 75 6e 2d rams) 1) ;; run-
10ab0 69 64 20 61 6e 64 20 74 65 73 74 2d 69 64 0a 09 id and test-id..
10ac0 20 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 (let ((run-id
10ad0 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
10ae0 28 63 61 72 20 70 61 72 61 6d 73 29 29 29 0a 09 (car params)))..
10af0 09 28 74 65 73 74 2d 69 64 20 28 73 74 72 69 6e .(test-id (strin
10b00 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 64 72 20 g->number (cadr
10b10 70 61 72 61 6d 73 29 29 29 29 0a 09 20 20 20 20 params))))..
10b20 28 69 66 20 28 61 6e 64 20 72 75 6e 2d 69 64 20 (if (and run-id
10b30 74 65 73 74 2d 69 64 29 0a 09 09 28 62 65 67 69 test-id)...(begi
10b40 6e 0a 09 09 20 20 28 6c 61 75 6e 63 68 3a 72 65 n... (launch:re
10b50 63 6f 76 65 72 2d 74 65 73 74 20 72 75 6e 2d 69 cover-test run-i
10b60 64 20 74 65 73 74 2d 69 64 29 0a 09 09 20 20 28 d test-id)... (
10b70 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
10b80 6e 67 2a 20 23 74 29 29 0a 09 09 28 62 65 67 69 ng* #t))...(begi
10b90 6e 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 n... (debug:pri
10ba0 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
10bb0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 62 ult-log-port* "b
10bc0 61 64 20 72 75 6e 2d 69 64 20 6f 72 20 74 65 73 ad run-id or tes
10bd0 74 2d 69 64 2c 20 6d 75 73 74 20 62 65 20 69 6e t-id, must be in
10be0 74 65 67 65 72 73 22 29 0a 09 09 20 20 28 65 78 tegers")... (ex
10bf0 69 74 20 31 29 29 29 29 29 29 29 0a 0a 3b 3b 3d it 1)))))))..;;=
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 3d 3d 3d 3d 3d 3d 3d ================
10c20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c40 3d 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 20 63 6f =====.;; Test co
10c50 6d 6d 61 6e 64 73 20 28 69 2e 65 2e 20 66 6f 72 mmands (i.e. for
10c60 20 75 73 65 20 69 6e 73 69 64 65 20 74 65 73 74 use inside test
10c70 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s).;;===========
10c80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10ca0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10cb0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 ===========..(de
10cc0 66 69 6e 65 20 28 6d 65 67 61 74 65 73 74 3a 73 fine (megatest:s
10cd0 74 65 70 20 73 74 65 70 20 73 74 61 74 65 20 73 tep step state s
10ce0 74 61 74 75 73 20 6c 6f 67 66 69 6c 65 20 6d 73 tatus logfile ms
10cf0 67 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 67 g). (if (not (g
10d00 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
10d10 4f 22 29 29 0a 20 20 20 20 20 20 28 62 65 67 69 O")). (begi
10d20 6e 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d n..(debug:print-
10d30 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
10d40 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 54 5f 43 -log-port* "MT_C
10d50 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e MDINFO env var n
10d60 6f 74 20 73 65 74 2c 20 2d 73 74 65 70 20 6d 75 ot set, -step mu
10d70 73 74 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e st be called *in
10d80 73 69 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 side* a megatest
10d90 20 69 6e 76 6f 6b 65 64 20 65 6e 76 69 72 6f 6e invoked environ
10da0 6d 65 6e 74 21 22 29 0a 09 28 65 78 69 74 20 35 ment!")..(exit 5
10db0 29 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 )). (let* (
10dc0 28 63 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d (cmdinfo (comm
10dd0 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d on:read-encoded-
10de0 73 74 72 69 6e 67 20 28 67 65 74 65 6e 76 20 22 string (getenv "
10df0 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 MT_CMDINFO")))..
10e00 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 (transport
10e10 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
10e20 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 transport cmdinf
10e30 6f 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 70 o)).. (testp
10e40 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
10e50 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
10e60 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 mdinfo)).. (
10e70 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 test-name (assoc
10e80 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e /default 'test-n
10e90 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ame cmdinfo))..
10ea0 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 (runscript (
10eb0 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
10ec0 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f unscript cmdinfo
10ed0 29 29 0a 09 20 20 20 20 20 28 64 62 2d 68 6f 73 )).. (db-hos
10ee0 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
10ef0 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d lt 'db-host cm
10f00 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 dinfo)).. (r
10f10 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f un-id (assoc/
10f20 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 default 'run-id
10f30 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
10f40 20 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 (test-id (a
10f50 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
10f60 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 st-id cmdinfo)
10f70 29 0a 09 20 20 20 20 20 28 69 74 65 6d 64 61 74 ).. (itemdat
10f80 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
10f90 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 t 'itemdat cmd
10fa0 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 77 6f info)).. (wo
10fb0 72 6b 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 rk-area (assoc/d
10fc0 65 66 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 efault 'work-are
10fd0 61 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 a cmdinfo))..
10fe0 20 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 (db #f)
10ff0 29 0a 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 )..(change-direc
11000 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
11010 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 (if (not (launch
11020 3a 73 65 74 75 70 29 29 0a 09 20 20 20 20 28 62 :setup)).. (b
11030 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 egin.. (deb
11040 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
11050 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 ult-log-port* "F
11060 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 ailed to setup,
11070 65 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 exiting")..
11080 20 28 65 78 69 74 20 31 29 29 29 0a 09 28 69 66 (exit 1)))..(if
11090 20 28 61 6e 64 20 73 74 61 74 65 20 73 74 61 74 (and state stat
110a0 75 73 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 us).. (let ((
110b0 63 6f 6d 6d 65 6e 74 20 28 6c 61 75 6e 63 68 3a comment (launch:
110c0 6c 6f 61 64 2d 6c 6f 67 70 72 6f 2d 64 61 74 20 load-logpro-dat
110d0 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 run-id test-id s
110e0 74 65 70 29 29 29 0a 09 20 20 20 20 20 20 3b 3b tep))).. ;;
110f0 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c (rmt:test-set-l
11100 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d og! run-id test-
11110 69 64 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d id (conc stepnam
11120 65 20 22 2e 68 74 6d 6c 22 29 29 29 29 0a 09 20 e ".html"))))..
11130 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 (rmt:testst
11140 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 ep-set-status! r
11150 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 un-id test-id st
11160 65 70 20 73 74 61 74 65 20 73 74 61 74 75 73 20 ep state status
11170 28 6f 72 20 63 6f 6d 6d 65 6e 74 20 6d 73 67 29 (or comment msg)
11180 20 6c 6f 67 66 69 6c 65 29 29 0a 09 20 20 20 20 logfile))..
11190 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 (begin.. (d
111a0 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
111b0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
111c0 70 6f 72 74 2a 20 22 59 6f 75 20 6d 75 73 74 20 port* "You must
111d0 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 specify :state a
111e0 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 nd :status with
111f0 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 73 every call to -s
11200 74 65 70 22 29 0a 09 20 20 20 20 20 20 28 65 78 tep").. (ex
11210 69 74 20 36 29 29 29 29 29 29 0a 0a 28 69 66 20 it 6))))))..(if
11220 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11230 73 74 65 70 22 29 0a 20 20 20 20 28 62 65 67 69 step"). (begi
11240 6e 0a 20 20 20 20 20 20 28 6d 65 67 61 74 65 73 n. (megates
11250 74 3a 73 74 65 70 20 0a 20 20 20 20 20 20 20 28 t:step . (
11260 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
11270 74 65 70 22 29 0a 20 20 20 20 20 20 20 28 6f 72 tep"). (or
11280 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
11290 2d 73 74 61 74 65 22 29 28 61 72 67 73 3a 67 65 -state")(args:ge
112a0 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 t-arg ":state"))
112b0 0a 20 20 20 20 20 20 20 28 6f 72 20 28 61 72 67 . (or (arg
112c0 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 s:get-arg "-stat
112d0 75 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 us")(args:get-ar
112e0 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a 20 20 g ":status")).
112f0 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
11300 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a 20 20 rg "-setlog").
11310 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
11320 72 67 20 22 2d 6d 22 29 29 0a 20 20 20 20 20 20 rg "-m")).
11330 3b 3b 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 ;; (if db (sqlit
11340 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
11350 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
11360 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
11370 29 29 0a 20 20 20 20 0a 28 69 66 20 28 6f 72 20 )). .(if (or
11380 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11390 73 65 74 6c 6f 67 22 29 20 20 20 20 20 20 20 3b setlog") ;
113a0 3b 20 73 69 6e 63 65 20 73 65 74 74 69 6e 67 20 ; since setting
113b0 75 70 20 69 73 20 73 6f 20 63 6f 73 74 6c 79 20 up is so costly
113c0 6c 65 74 73 20 70 69 67 67 79 62 61 63 6b 20 6f lets piggyback o
113d0 6e 20 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 09 n -test-status..
113e0 3b 3b 20 20 20 20 20 28 6e 6f 74 20 28 61 72 67 ;; (not (arg
113f0 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 s:get-arg "-step
11400 22 29 29 29 20 20 3b 3b 20 2d 73 65 74 6c 6f 67 "))) ;; -setlog
11410 20 6d 61 79 20 68 61 76 65 20 62 65 65 6e 20 70 may have been p
11420 72 6f 63 65 73 73 65 64 20 61 6c 72 65 61 64 79 rocessed already
11430 20 69 6e 20 74 68 65 20 22 2d 73 74 65 70 22 20 in the "-step"
11440 70 72 65 76 69 6f 75 73 0a 09 3b 3b 20 20 20 20 previous..;;
11450 20 4e 45 57 20 50 4f 4c 49 43 59 20 2d 20 2d 73 NEW POLICY - -s
11460 65 74 6c 6f 67 20 73 65 74 73 20 74 65 73 74 20 etlog sets test
11470 6f 76 65 72 61 6c 6c 20 6c 6f 67 20 6f 6e 20 65 overall log on e
11480 76 65 72 79 20 63 61 6c 6c 2e 0a 09 28 61 72 67 very call...(arg
11490 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
114a0 74 6f 70 6c 6f 67 22 29 0a 09 28 61 72 67 73 3a toplog")..(args:
114b0 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 get-arg "-test-s
114c0 74 61 74 75 73 22 29 0a 09 28 61 72 67 73 3a 67 tatus")..(args:g
114d0 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 6c et-arg "-set-val
114e0 75 65 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 ues")..(args:get
114f0 2d 61 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 74 -arg "-load-test
11500 2d 64 61 74 61 22 29 0a 09 28 61 72 67 73 3a 67 -data")..(args:g
11510 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 et-arg "-runstep
11520 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
11530 67 20 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 g "-summarize-it
11540 65 6d 73 22 29 29 0a 20 20 20 20 28 69 66 20 28 ems")). (if (
11550 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f not (getenv "MT_
11560 43 4d 44 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 CMDINFO"))..(beg
11570 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 in.. (debug:pri
11580 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
11590 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d ult-log-port* "M
115a0 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 T_CMDINFO env va
115b0 72 20 6e 6f 74 20 73 65 74 2c 20 63 6f 6d 6d 61 r not set, comma
115c0 6e 64 73 20 2d 74 65 73 74 2d 73 74 61 74 75 73 nds -test-status
115d0 2c 20 2d 72 75 6e 73 74 65 70 20 61 6e 64 20 2d , -runstep and -
115e0 73 65 74 6c 6f 67 20 6d 75 73 74 20 62 65 20 63 setlog must be c
115f0 61 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 alled *inside* a
11600 20 6d 65 67 61 74 65 73 74 20 65 6e 76 69 72 6f megatest enviro
11610 6e 6d 65 6e 74 21 22 29 0a 09 20 20 28 65 78 69 nment!").. (exi
11620 74 20 35 29 29 0a 09 28 6c 65 74 2a 20 28 28 73 t 5))..(let* ((s
11630 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 tartingdir (curr
11640 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a ent-directory)).
11650 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f . (cmdinfo
11660 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d (common:read-
11670 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 encoded-string (
11680 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e getenv "MT_CMDIN
11690 46 4f 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 FO"))).. (
116a0 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 transport (assoc
116b0 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 /default 'transp
116c0 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ort cmdinfo))..
116d0 20 20 20 20 20 20 28 74 65 73 74 70 61 74 68 20 (testpath
116e0 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
116f0 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 'testpath cmdin
11700 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 fo)).. (te
11710 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 st-name (assoc/d
11720 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d efault 'test-nam
11730 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 e cmdinfo))..
11740 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 (runscript (
11750 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
11760 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f unscript cmdinfo
11770 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 )).. (db-h
11780 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 ost (assoc/def
11790 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 ault 'db-host
117a0 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
117b0 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 (run-id (as
117c0 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
117d0 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 -id cmdinfo))
117e0 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 .. (test-i
117f0 64 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 d (assoc/defau
11800 6c 74 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d lt 'test-id cm
11810 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
11820 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f (itemdat (asso
11830 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 c/default 'itemd
11840 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 at cmdinfo))..
11850 20 20 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 (work-are
11860 61 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 a (assoc/default
11870 20 27 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 'work-area cmdi
11880 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 nfo)).. (d
11890 62 20 20 20 20 20 20 20 20 23 66 29 20 3b 3b 20 b #f) ;;
118a0 28 6f 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 (open-db))..
118b0 20 20 20 28 73 74 61 74 65 20 20 20 20 20 28 61 (state (a
118c0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
118d0 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 ate")).. (
118e0 73 74 61 74 75 73 20 20 20 20 28 61 72 67 73 3a status (args:
118f0 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 get-arg ":status
11900 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 65 ")).. (ste
11910 70 6e 61 6d 65 20 20 28 61 72 67 73 3a 67 65 74 pname (args:get
11920 2d 61 72 67 20 22 2d 73 74 65 70 22 29 29 29 0a -arg "-step"))).
11930 09 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 . (if (not (lau
11940 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 20 nch:setup))..
11950 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 (begin...(deb
11960 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
11970 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 ult-log-port* "F
11980 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 ailed to setup,
11990 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 69 exiting")...(exi
119a0 74 20 31 29 29 29 0a 0a 09 20 20 28 69 66 20 28 t 1)))... (if (
119b0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
119c0 75 6e 73 74 65 70 22 29 28 64 65 62 75 67 3a 70 unstep")(debug:p
119d0 72 69 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 rint-info 1 *def
119e0 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
119f0 52 75 6e 6e 69 6e 67 20 2d 72 75 6e 73 74 65 70 Running -runstep
11a00 2c 20 66 69 72 73 74 20 63 68 61 6e 67 65 20 74 , first change t
11a10 6f 20 64 69 72 65 63 74 6f 72 79 20 22 20 77 6f o directory " wo
11a20 72 6b 2d 61 72 65 61 29 29 0a 09 20 20 28 63 68 rk-area)).. (ch
11a30 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 ange-directory w
11a40 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 3b 3b 20 ork-area).. ;;
11a50 63 61 6e 20 73 65 74 75 70 20 61 73 20 63 6c 69 can setup as cli
11a60 65 6e 74 20 66 6f 72 20 73 65 72 76 65 72 20 6d ent for server m
11a70 6f 64 65 20 6e 6f 77 0a 09 20 20 3b 3b 20 28 63 ode now.. ;; (c
11a80 6c 69 65 6e 74 3a 73 65 74 75 70 29 0a 0a 09 20 lient:setup)...
11a90 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
11aa0 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 rg "-load-test-d
11ab0 61 74 61 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 ata").. ;;
11ac0 68 61 73 20 73 75 62 20 63 6f 6d 6d 61 6e 64 73 has sub commands
11ad0 20 74 68 61 74 20 61 72 65 20 72 64 62 3a 0a 09 that are rdb:..
11ae0 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 ;; DO NOT
11af0 70 75 74 20 74 68 69 73 20 6f 6e 65 20 69 6e 74 put this one int
11b00 6f 20 65 69 74 68 65 72 20 72 6d 74 3a 20 6f 72 o either rmt: or
11b10 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 0a open-run-close.
11b20 09 20 20 20 20 20 20 28 74 64 62 3a 6c 6f 61 64 . (tdb:load
11b30 2d 74 65 73 74 2d 64 61 74 61 20 72 75 6e 2d 69 -test-data run-i
11b40 64 20 74 65 73 74 2d 69 64 29 29 0a 09 20 20 28 d test-id)).. (
11b50 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
11b60 20 22 2d 73 65 74 6c 6f 67 22 29 0a 09 20 20 20 "-setlog")..
11b70 20 20 20 28 6c 65 74 20 28 28 6c 6f 67 66 6e 61 (let ((logfna
11b80 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 me (args:get-arg
11b90 20 22 2d 73 65 74 6c 6f 67 22 29 29 29 0a 09 09 "-setlog")))...
11ba0 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f (rmt:test-set-lo
11bb0 67 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 g! run-id test-i
11bc0 64 20 6c 6f 67 66 6e 61 6d 65 29 29 29 0a 09 20 d logfname)))..
11bd0 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
11be0 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 rg "-set-toplog"
11bf0 29 0a 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e ).. ;; DO N
11c00 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 OT run remote..
11c10 20 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 (tests:test
11c20 2d 73 65 74 2d 74 6f 70 6c 6f 67 21 20 72 75 6e -set-toplog! run
11c30 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 28 61 -id test-name (a
11c40 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
11c50 74 2d 74 6f 70 6c 6f 67 22 29 29 29 0a 09 20 20 t-toplog")))..
11c60 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
11c70 67 20 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 g "-summarize-it
11c80 65 6d 73 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 ems").. ;;
11c90 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 DO NOT run remot
11ca0 65 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 3a e.. (tests:
11cb0 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 summarize-items
11cc0 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 run-id test-id t
11cd0 65 73 74 2d 6e 61 6d 65 20 23 74 29 29 20 3b 3b est-name #t)) ;;
11ce0 20 64 6f 20 66 6f 72 63 65 20 68 65 72 65 0a 09 do force here..
11cf0 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
11d00 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a arg "-runstep").
11d10 09 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c . (if (null
11d20 3f 20 72 65 6d 61 72 67 73 29 0a 09 09 20 20 28 ? remargs)... (
11d30 62 65 67 69 6e 0a 09 09 20 20 20 20 28 64 65 62 begin... (deb
11d40 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
11d50 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
11d60 72 74 2a 20 22 6e 6f 74 68 69 6e 67 20 73 70 65 rt* "nothing spe
11d70 63 69 66 69 65 64 20 74 6f 20 72 75 6e 21 22 29 cified to run!")
11d80 0a 09 09 20 20 20 20 28 69 66 20 64 62 20 28 73 ... (if db (s
11d90 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
11da0 20 64 62 29 29 0a 09 09 20 20 20 20 28 65 78 69 db))... (exi
11db0 74 20 36 29 29 0a 09 09 20 20 28 6c 65 74 2a 20 t 6))... (let*
11dc0 28 28 73 74 65 70 6e 61 6d 65 20 20 20 28 61 72 ((stepname (ar
11dd0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
11de0 73 74 65 70 22 29 29 0a 09 09 09 20 28 6c 6f 67 step")).... (log
11df0 70 72 6f 66 69 6c 65 20 28 61 72 67 73 3a 67 65 profile (args:ge
11e00 74 2d 61 72 67 20 22 2d 6c 6f 67 70 72 6f 22 29 t-arg "-logpro")
11e10 29 0a 09 09 09 20 28 6c 6f 67 66 69 6c 65 20 20 ).... (logfile
11e20 20 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 (conc stepname
11e30 20 22 2e 6c 6f 67 22 29 29 0a 09 09 09 20 28 63 ".log")).... (c
11e40 6d 64 20 20 20 20 20 20 20 20 28 69 66 20 28 6e md (if (n
11e50 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 23 66 ull? remargs) #f
11e60 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 (car remargs)))
11e70 0a 09 09 09 20 28 70 61 72 61 6d 73 20 20 20 20 .... (params
11e80 20 28 69 66 20 63 6d 64 20 28 63 64 72 20 72 65 (if cmd (cdr re
11e90 6d 61 72 67 73 29 20 27 28 29 29 29 0a 09 09 09 margs) '()))....
11ea0 20 28 65 78 69 74 73 74 61 74 20 20 20 23 66 29 (exitstat #f)
11eb0 0a 09 09 09 20 28 73 68 65 6c 6c 20 20 20 20 20 .... (shell
11ec0 20 28 6c 65 74 20 28 28 73 68 20 28 67 65 74 2d (let ((sh (get-
11ed0 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
11ee0 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 20 29 29 able "SHELL") ))
11ef0 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ..... (if
11f00 73 68 20 0a 09 09 09 09 09 20 20 20 28 6c 61 73 sh ...... (las
11f10 74 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 t (string-split
11f20 73 68 20 22 2f 22 29 29 0a 09 09 09 09 09 20 20 sh "/"))......
11f30 20 22 62 61 73 68 22 29 29 29 0a 09 09 09 20 28 "bash"))).... (
11f40 72 65 64 69 72 20 20 20 20 20 20 28 63 61 73 65 redir (case
11f50 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
11f60 20 73 68 65 6c 6c 29 0a 09 09 09 09 20 20 20 20 shell).....
11f70 20 20 20 28 28 74 63 73 68 20 63 73 68 20 6b 73 ((tcsh csh ks
11f80 68 29 20 20 20 20 22 3e 26 22 29 0a 09 09 09 09 h) ">&").....
11f90 20 20 20 20 20 20 20 28 28 7a 73 68 20 62 61 73 ((zsh bas
11fa0 68 20 73 68 20 61 73 68 29 20 22 32 3e 26 31 20 h sh ash) "2>&1
11fb0 3e 22 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 >")..... (
11fc0 65 6c 73 65 20 22 3e 26 22 29 29 29 0a 09 09 09 else ">&")))....
11fd0 20 28 66 75 6c 6c 63 6d 64 20 20 20 20 28 63 6f (fullcmd (co
11fe0 6e 63 20 22 28 22 20 28 73 74 72 69 6e 67 2d 69 nc "(" (string-i
11ff0 6e 74 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 ntersperse .....
12000 09 09 28 63 6f 6e 73 20 63 6d 64 20 70 61 72 61 ..(cons cmd para
12010 6d 73 29 20 22 20 22 29 0a 09 09 09 09 09 20 20 ms) " ")......
12020 20 22 29 20 22 20 72 65 64 69 72 20 22 20 22 20 ") " redir " "
12030 6c 6f 67 66 69 6c 65 29 29 29 0a 09 09 20 20 20 logfile)))...
12040 20 3b 3b 20 6d 61 72 6b 20 74 68 65 20 73 74 61 ;; mark the sta
12050 72 74 20 6f 66 20 74 68 65 20 74 65 73 74 0a 09 rt of the test..
12060 09 20 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 . (rmt:testst
12070 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 ep-set-status! r
12080 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 un-id test-id st
12090 65 70 6e 61 6d 65 20 22 73 74 61 72 74 22 20 22 epname "start" "
120a0 6e 2f 61 22 20 28 61 72 67 73 3a 67 65 74 2d 61 n/a" (args:get-a
120b0 72 67 20 22 2d 6d 22 29 20 6c 6f 67 66 69 6c 65 rg "-m") logfile
120c0 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 74 )... ;; run t
120d0 68 65 20 74 65 73 74 20 73 74 65 70 0a 09 09 20 he test step...
120e0 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
120f0 69 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d info 2 *default-
12100 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 75 6e 6e 69 log-port* "Runni
12110 6e 67 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 ng \"" fullcmd "
12120 5c 22 20 69 6e 20 64 69 72 65 63 74 6f 72 79 20 \" in directory
12130 5c 22 22 20 73 74 61 72 74 69 6e 67 64 69 72 29 \"" startingdir)
12140 0a 09 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 ... (change-d
12150 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e irectory startin
12160 67 64 69 72 29 0a 09 09 20 20 20 20 28 73 65 74 gdir)... (set
12170 21 20 65 78 69 74 73 74 61 74 20 28 73 79 73 74 ! exitstat (syst
12180 65 6d 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 20 em fullcmd))...
12190 20 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c (set! *global
121a0 65 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 74 exitstatus* exit
121b0 73 74 61 74 29 0a 09 09 20 20 20 20 3b 3b 20 28 stat)... ;; (
121c0 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
121d0 20 74 65 73 74 70 61 74 68 29 0a 09 09 20 20 20 testpath)...
121e0 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 ;; run logpro i
121f0 66 20 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b 20 f applicable ;;
12200 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c 73 (process-run "ls
12210 22 20 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20 22 " (list "/foo" "
12220 32 3e 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67 22 2>&1" "blah.log"
12230 29 29 0a 09 09 20 20 20 20 28 69 66 20 6c 6f 67 ))... (if log
12240 70 72 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74 2a profile....(let*
12250 20 28 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 28 ((htmllogfile (
12260 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e conc stepname ".
12270 68 74 6d 6c 22 29 29 0a 09 09 09 20 20 20 20 20 html"))....
12280 20 20 28 6f 6c 64 65 78 69 74 73 74 61 74 20 65 (oldexitstat e
12290 78 69 74 73 74 61 74 29 0a 09 09 09 20 20 20 20 xitstat)....
122a0 20 20 20 28 63 6d 64 20 20 20 20 20 20 20 20 20 (cmd
122b0 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
122c0 72 73 65 20 28 6c 69 73 74 20 22 6c 6f 67 70 72 rse (list "logpr
122d0 6f 22 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68 74 o" logprofile ht
122e0 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c 6f mllogfile "<" lo
122f0 67 66 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63 20 gfile ">" (conc
12300 73 74 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70 72 stepname "_logpr
12310 6f 2e 6c 6f 67 22 29 29 20 22 20 22 29 29 29 0a o.log")) " "))).
12320 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
12330 74 2d 69 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c t-info 2 *defaul
12340 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 75 6e t-log-port* "run
12350 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 ning \"" cmd "\"
12360 22 29 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d ").... (change-
12370 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 directory starti
12380 6e 67 64 69 72 29 0a 09 09 09 20 20 28 73 65 74 ngdir).... (set
12390 21 20 65 78 69 74 73 74 61 74 20 28 73 79 73 74 ! exitstat (syst
123a0 65 6d 20 63 6d 64 29 29 0a 09 09 09 20 20 28 73 em cmd)).... (s
123b0 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 et! *globalexits
123c0 74 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 tatus* exitstat)
123d0 20 3b 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 ;; no necessary
123e0 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 .... (change-di
123f0 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 rectory testpath
12400 29 0a 09 09 09 20 20 28 72 6d 74 3a 74 65 73 74 ).... (rmt:test
12410 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 -set-log! run-id
12420 20 74 65 73 74 2d 69 64 20 68 74 6d 6c 6c 6f 67 test-id htmllog
12430 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 28 6c file)))... (l
12440 65 74 20 28 28 6d 73 67 20 28 61 72 67 73 3a 67 et ((msg (args:g
12450 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 29 0a 09 et-arg "-m")))..
12460 09 20 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 . (rmt:test
12470 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
12480 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
12490 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 stepname "end" e
124a0 78 69 74 73 74 61 74 20 6d 73 67 20 6c 6f 67 66 xitstat msg logf
124b0 69 6c 65 29 29 0a 09 09 20 20 20 20 29 29 29 0a ile))... ))).
124c0 09 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 . (if (or (args
124d0 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d :get-arg "-test-
124e0 73 74 61 74 75 73 22 29 0a 09 09 20 20 28 61 72 status")... (ar
124f0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
12500 2d 76 61 6c 75 65 73 22 29 29 0a 09 20 20 20 20 -values"))..
12510 20 20 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 (let ((newstat
12520 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e us (cond.....((n
12530 75 6d 62 65 72 3f 20 73 74 61 74 75 73 29 20 20 umber? status)
12540 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f (if (equal?
12550 20 73 74 61 74 75 73 20 30 29 20 22 50 41 53 53 status 0) "PASS
12560 22 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 " "FAIL")).....(
12570 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 74 (and (string? st
12580 61 74 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 atus).....
12590 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
125a0 73 74 61 74 75 73 29 29 28 69 66 20 28 65 71 75 status))(if (equ
125b0 61 6c 3f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d al? (string->num
125c0 62 65 72 20 73 74 61 74 75 73 29 20 30 29 20 22 ber status) 0) "
125d0 50 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 PASS" "FAIL"))..
125e0 09 09 09 28 65 6c 73 65 20 73 74 61 74 75 73 29 ...(else status)
125f0 29 29 0a 09 09 20 20 20 20 3b 3b 20 74 72 61 6e ))... ;; tran
12600 73 66 65 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 sfer relevant ke
12610 79 73 20 69 6e 74 6f 20 61 20 68 61 73 68 20 74 ys into a hash t
12620 6f 20 62 65 20 70 61 73 73 65 64 20 74 6f 20 74 o be passed to t
12630 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a est-set-status!.
12640 09 09 20 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 .. ;; could u
12650 73 65 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 se an assoc list
12660 20 49 20 67 75 65 73 73 2e 20 0a 09 09 20 20 20 I guess. ...
12670 20 28 6f 74 68 65 72 64 61 74 61 20 28 6c 65 74 (otherdata (let
12680 20 28 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 ((res (make-has
12690 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 09 20 h-table))).....
126a0 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
126b0 61 20 28 6b 65 79 29 0a 09 09 09 09 09 20 20 20 a (key)......
126c0 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
126d0 61 72 67 20 6b 65 79 29 0a 09 09 09 09 09 09 20 arg key).......
126e0 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
126f0 20 72 65 73 20 6b 65 79 20 28 61 72 67 73 3a 67 res key (args:g
12700 65 74 2d 61 72 67 20 6b 65 79 29 29 29 29 0a 09 et-arg key))))..
12710 09 09 09 09 20 20 20 28 6c 69 73 74 20 22 3a 76 .... (list ":v
12720 61 6c 75 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 alue" ":tol" ":e
12730 78 70 65 63 74 65 64 22 20 22 3a 66 69 72 73 74 xpected" ":first
12740 5f 65 72 72 22 20 22 3a 66 69 72 73 74 5f 77 61 _err" ":first_wa
12750 72 6e 22 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 rn" ":units" ":c
12760 61 74 65 67 6f 72 79 22 20 22 3a 76 61 72 69 61 ategory" ":varia
12770 62 6c 65 22 29 29 0a 09 09 09 09 20 72 65 73 29 ble"))..... res)
12780 29 29 0a 09 09 28 69 66 20 28 61 6e 64 20 28 61 ))...(if (and (a
12790 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
127a0 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 09 20 st-status")....
127b0 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 65 29 0a (or (not state).
127c0 09 09 09 20 20 20 20 20 28 6e 6f 74 20 73 74 61 ... (not sta
127d0 74 75 73 29 29 29 0a 09 09 20 20 20 20 28 62 65 tus)))... (be
127e0 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 gin... (deb
127f0 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
12800 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
12810 72 74 2a 20 22 59 6f 75 20 6d 75 73 74 20 73 70 rt* "You must sp
12820 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 ecify :state and
12830 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 65 76 :status with ev
12840 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 74 65 73 ery call to -tes
12850 74 2d 73 74 61 74 75 73 5c 6e 22 20 68 65 6c 70 t-status\n" help
12860 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 73 )... (if (s
12870 71 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f qlite3:database?
12880 20 64 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e db)(sqlite3:fin
12890 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 09 20 20 alize! db))...
128a0 20 20 20 20 28 65 78 69 74 20 36 29 29 29 0a 09 (exit 6)))..
128b0 09 28 6c 65 74 2a 20 28 28 6d 73 67 20 20 20 20 .(let* ((msg
128c0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
128d0 6d 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 6e m"))... (n
128e0 75 6d 6f 74 68 20 28 6c 65 6e 67 74 68 20 28 68 umoth (length (h
128f0 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 6f ash-table-keys o
12900 74 68 65 72 64 61 74 61 29 29 29 29 0a 09 09 20 therdata))))...
12910 20 3b 3b 20 43 6f 6e 76 65 72 74 20 74 6f 20 72 ;; Convert to r
12920 70 63 20 69 6e 73 69 64 65 20 74 68 65 20 74 65 pc inside the te
12930 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 sts:test-set-sta
12940 74 75 73 21 20 63 61 6c 6c 2c 20 6e 6f 74 20 68 tus! call, not h
12950 65 72 65 0a 09 09 20 20 28 74 65 73 74 73 3a 74 ere... (tests:t
12960 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
12970 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 run-id test-id s
12980 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 20 6d tate newstatus m
12990 73 67 20 6f 74 68 65 72 64 61 74 61 20 77 6f 72 sg otherdata wor
129a0 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 k-area: work-are
129b0 61 29 29 29 29 0a 09 20 20 28 69 66 20 28 73 71 a)))).. (if (sq
129c0 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 lite3:database?
129d0 64 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 db)(sqlite3:fina
129e0 6c 69 7a 65 21 20 64 62 29 29 0a 09 20 20 28 73 lize! db)).. (s
129f0 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
12a00 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d g* #t))))..;;===
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 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a50 3d 3d 3d 0a 3b 3b 20 56 61 72 69 6f 75 73 20 68 ===.;; Various h
12a60 65 6c 70 65 72 20 63 6f 6d 6d 61 6e 64 73 20 63 elper commands c
12a70 61 6e 20 67 6f 20 62 65 6c 6f 77 20 68 65 72 65 an go below here
12a80 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
12a90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12aa0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ab0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ac0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
12ad0 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
12ae0 20 22 2d 73 68 6f 77 6b 65 79 73 22 29 0a 20 20 "-showkeys").
12af0 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
12b00 61 72 67 20 22 2d 73 68 6f 77 2d 6b 65 79 73 22 arg "-show-keys"
12b10 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 64 62 )). (let ((db
12b20 20 23 66 29 0a 09 20 20 28 6b 65 79 73 20 23 66 #f).. (keys #f
12b30 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f )). (if (no
12b40 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 t (launch:setup)
12b50 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 ).. (begin..
12b60 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
12b70 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
12b80 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 t* "Failed to se
12b90 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 tup, exiting")..
12ba0 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
12bb0 20 20 20 20 20 28 73 65 74 21 20 6b 65 79 73 20 (set! keys
12bc0 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 20 (rmt:get-keys))
12bd0 3b 3b 20 20 64 62 29 29 0a 20 20 20 20 20 20 28 ;; db)). (
12be0 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 2a 64 debug:print 1 *d
12bf0 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
12c00 20 22 4b 65 79 73 3a 20 22 20 28 73 74 72 69 6e "Keys: " (strin
12c10 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 g-intersperse ke
12c20 79 73 20 22 2c 20 22 29 29 0a 20 20 20 20 20 20 ys ", ")).
12c30 28 69 66 20 28 73 71 6c 69 74 65 33 3a 64 61 74 (if (sqlite3:dat
12c40 61 62 61 73 65 3f 20 64 62 29 28 73 71 6c 69 74 abase? db)(sqlit
12c50 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
12c60 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
12c70 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
12c80 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
12c90 74 2d 61 72 67 20 22 2d 67 75 69 22 29 0a 20 20 t-arg "-gui").
12ca0 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
12cb0 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
12cc0 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
12cd0 20 22 4c 6f 6f 6b 20 61 74 20 74 68 65 20 64 61 "Look at the da
12ce0 73 68 62 6f 61 72 64 20 66 6f 72 20 6e 6f 77 22 shboard for now"
12cf0 29 0a 20 20 20 20 20 20 3b 3b 20 28 6d 65 67 61 ). ;; (mega
12d00 74 65 73 74 2d 67 75 69 29 0a 20 20 20 20 20 20 test-gui).
12d10 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
12d20 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
12d30 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
12d40 63 72 65 61 74 65 2d 6d 65 67 61 74 65 73 74 2d create-megatest-
12d50 61 72 65 61 22 29 0a 20 20 20 20 28 62 65 67 69 area"). (begi
12d60 6e 0a 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d n. (genexam
12d70 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2e ple:mk-megatest.
12d80 63 6f 6e 66 69 67 29 0a 20 20 20 20 20 20 28 73 config). (s
12d90 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
12da0 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
12db0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 72 rgs:get-arg "-cr
12dc0 65 61 74 65 2d 74 65 73 74 22 29 0a 20 20 20 20 eate-test").
12dd0 28 6c 65 74 20 28 28 74 65 73 74 6e 61 6d 65 20 (let ((testname
12de0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
12df0 63 72 65 61 74 65 2d 74 65 73 74 22 29 29 29 0a create-test"))).
12e00 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c (genexampl
12e10 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2d 74 65 e:mk-megatest-te
12e20 73 74 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 20 st testname).
12e30 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
12e40 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b ething* #t)))..;
12e50 3b 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 3d 3d 3d ================
12e70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e90 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 =======.;; Updat
12ea0 65 20 74 68 65 20 64 61 74 61 62 61 73 65 20 73 e the database s
12eb0 63 68 65 6d 61 2c 20 63 6c 65 61 6e 20 75 70 20 chema, clean up
12ec0 74 68 65 20 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d the db.;;=======
12ed0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ee0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ef0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
12f10 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
12f20 72 67 20 22 2d 72 65 62 75 69 6c 64 2d 64 62 22 rg "-rebuild-db"
12f30 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
12f40 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 (if (not (lau
12f50 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 nch:setup)).. (
12f60 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 begin.. (debu
12f70 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
12f80 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 lt-log-port* "Fa
12f90 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 iled to setup, e
12fa0 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 xiting") .. (
12fb0 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 exit 1))).
12fc0 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 ;; keep this one
12fd0 20 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 6f 70 local. (op
12fe0 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 70 61 74 en-run-close pat
12ff0 63 68 2d 64 62 20 23 66 29 0a 20 20 20 20 20 20 ch-db #f).
13000 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
13010 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
13020 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
13030 63 6c 65 61 6e 75 70 2d 64 62 22 29 0a 20 20 20 cleanup-db").
13040 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 (begin. (i
13050 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
13060 65 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e etup)).. (begin
13070 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
13080 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
13090 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 g-port* "Failed
130a0 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
130b0 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 g") .. (exit
130c0 31 29 29 29 0a 20 20 20 20 20 20 28 6c 65 74 20 1))). (let
130d0 28 28 64 62 73 74 72 75 63 74 20 28 64 62 3a 73 ((dbstruct (db:s
130e0 65 74 75 70 20 2a 74 6f 70 70 61 74 68 2a 29 29 etup *toppath*))
130f0 29 0a 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f ). (commo
13100 6e 3a 63 6c 65 61 6e 75 70 2d 64 62 20 64 62 73 n:cleanup-db dbs
13110 74 72 75 63 74 29 29 0a 20 20 20 20 20 20 28 73 truct)). (s
13120 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
13130 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
13140 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 61 rgs:get-arg "-ma
13150 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 22 29 rk-incompletes")
13160 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
13170 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e (if (not (laun
13180 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 ch:setup)).. (b
13190 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 egin.. (debug
131a0 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
131b0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
131c0 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
131d0 69 74 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 iting").. (ex
131e0 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 6f it 1))). (o
131f0 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 pen-run-close db
13200 3a 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 :find-and-mark-i
13210 6e 63 6f 6d 70 6c 65 74 65 20 23 66 29 0a 20 20 ncomplete #f).
13220 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
13230 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
13240 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13270 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13280 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 ========.;; Upda
13290 74 65 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 te the tests met
132a0 61 20 64 61 74 61 20 66 72 6f 6d 20 74 68 65 20 a data from the
132b0 74 65 73 74 63 6f 6e 66 69 67 20 66 69 6c 65 73 testconfig files
132c0 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
132d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
132e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
132f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13300 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
13310 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 args:get-arg "-u
13320 70 64 61 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 pdate-meta").
13330 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 (begin. (i
13340 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
13350 65 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e etup)).. (begin
13360 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
13370 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
13380 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 g-port* "Failed
13390 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
133a0 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 g") .. (exit
133b0 31 29 29 29 0a 20 20 20 20 20 20 28 72 75 6e 73 1))). (runs
133c0 3a 75 70 64 61 74 65 2d 61 6c 6c 2d 74 65 73 74 :update-all-test
133d0 5f 6d 65 74 61 20 23 66 29 0a 20 20 20 20 20 20 _meta #f).
133e0 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
133f0 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d ing* #t)))..;;==
13400 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13410 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13420 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13430 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13440 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 61 20 ====.;; Start a
13450 72 65 70 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d repl.;;=========
13460 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13470 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13480 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13490 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
134a0 3b 20 66 61 6b 65 6f 75 74 20 72 65 61 64 6c 69 ; fakeout readli
134b0 6e 65 0a 28 69 6e 63 6c 75 64 65 20 22 72 65 61 ne.(include "rea
134c0 64 6c 69 6e 65 2d 66 69 78 2e 73 63 6d 22 29 0a dline-fix.scm").
134d0 0a 0a 28 77 68 65 6e 20 28 61 72 67 73 3a 67 65 ..(when (args:ge
134e0 74 2d 61 72 67 20 22 2d 64 69 66 66 2d 72 65 70 t-arg "-diff-rep
134f0 22 29 0a 20 20 28 77 68 65 6e 20 28 61 6e 64 0a "). (when (and.
13500 20 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 61 (not (a
13510 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 69 rgs:get-arg "-di
13520 66 66 2d 68 74 6d 6c 22 29 29 0a 20 20 20 20 20 ff-html")).
13530 20 20 20 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 (not (args:g
13540 65 74 2d 61 72 67 20 22 2d 64 69 66 66 2d 65 6d et-arg "-diff-em
13550 61 69 6c 22 29 29 29 0a 20 20 20 20 28 64 65 62 ail"))). (deb
13560 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
13570 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d ult-log-port* "M
13580 75 73 74 20 73 70 65 63 69 66 79 20 2d 64 69 66 ust specify -dif
13590 66 2d 68 74 6d 6c 20 6f 72 20 2d 64 69 66 66 2d f-html or -diff-
135a0 65 6d 61 69 6c 20 77 69 74 68 20 2d 64 69 66 66 email with -diff
135b0 2d 72 65 70 22 29 0a 20 20 20 20 28 73 65 74 21 -rep"). (set!
135c0 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
135d0 31 29 0a 20 20 20 20 28 65 78 69 74 20 31 29 29 1). (exit 1))
135e0 0a 20 20 0a 20 20 28 6c 65 74 2a 20 28 28 74 6f . . (let* ((to
135f0 70 70 61 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 ppath (launch:se
13600 74 75 70 29 29 29 0a 20 20 20 20 28 64 6f 2d 64 tup))). (do-d
13610 69 66 66 2d 72 65 70 6f 72 74 0a 20 20 20 20 20 iff-report.
13620 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
13630 73 72 63 2d 74 61 72 67 65 74 22 29 0a 20 20 20 src-target").
13640 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
13650 22 2d 73 72 63 2d 72 75 6e 6e 61 6d 65 22 29 0a "-src-runname").
13660 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
13670 72 67 20 22 2d 74 61 72 67 65 74 22 29 0a 20 20 rg "-target").
13680 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
13690 20 22 2d 72 75 6e 6e 61 6d 65 22 29 0a 20 20 20 "-runname").
136a0 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
136b0 22 2d 64 69 66 66 2d 68 74 6d 6c 22 29 0a 20 20 "-diff-html").
136c0 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
136d0 20 22 2d 64 69 66 66 2d 65 6d 61 69 6c 22 29 29 "-diff-email"))
136e0 0a 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 . (set! *dids
136f0 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 20 20 omething* #t).
13700 20 20 28 65 78 69 74 20 30 29 29 29 0a 0a 28 69 (exit 0)))..(i
13710 66 20 28 6f 72 20 28 67 65 74 65 6e 76 20 22 4d f (or (getenv "M
13720 54 5f 52 55 4e 53 43 52 49 50 54 22 29 0a 09 28 T_RUNSCRIPT")..(
13730 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
13740 65 70 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 epl")..(args:get
13750 2d 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 0a 20 -arg "-load")).
13760 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 (let* ((toppa
13770 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 th (launch:setup
13780 29 29 0a 09 20 20 20 28 64 62 73 74 72 75 63 74 )).. (dbstruct
13790 20 28 69 66 20 28 61 6e 64 20 74 6f 70 70 61 74 (if (and toppat
137a0 68 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 h.
137b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
137c0 28 63 6f 6d 6d 6f 6e 3a 6f 6e 2d 68 6f 6d 65 68 (common:on-homeh
137d0 6f 73 74 3f 29 29 0a 20 20 20 20 20 20 20 20 20 ost?)).
137e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
137f0 28 64 62 3a 73 65 74 75 70 29 0a 20 20 20 20 20 (db:setup).
13800 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13810 20 20 20 20 23 66 29 29 29 20 3b 3b 20 6d 61 6b #f))) ;; mak
13820 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 e-dbr:dbstruct p
13830 61 74 68 3a 20 74 6f 70 70 61 74 68 20 6c 6f 63 ath: toppath loc
13840 61 6c 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 al: (args:get-ar
13850 67 20 22 2d 6c 6f 63 61 6c 22 29 29 20 23 66 29 g "-local")) #f)
13860 29 29 0a 20 20 20 20 20 20 28 69 66 20 2a 74 6f )). (if *to
13870 70 70 61 74 68 2a 0a 09 20 20 28 63 6f 6e 64 0a ppath*.. (cond.
13880 09 20 20 20 28 28 67 65 74 65 6e 76 20 22 4d 54 . ((getenv "MT
13890 5f 52 55 4e 53 43 52 49 50 54 22 29 0a 09 20 20 _RUNSCRIPT")..
138a0 20 20 3b 3b 20 48 6f 77 20 74 6f 20 72 75 6e 20 ;; How to run
138b0 6d 65 67 61 74 65 73 74 20 73 63 72 69 70 74 73 megatest scripts
138c0 0a 09 20 20 20 20 3b 3b 0a 09 20 20 20 20 3b 3b .. ;;.. ;;
138d0 20 23 21 2f 62 69 6e 2f 62 61 73 68 0a 09 20 20 #!/bin/bash..
138e0 20 20 3b 3b 0a 09 20 20 20 20 3b 3b 20 65 78 70 ;;.. ;; exp
138f0 6f 72 74 20 4d 54 5f 52 55 4e 53 43 52 49 50 54 ort MT_RUNSCRIPT
13900 3d 79 65 73 0a 09 20 20 20 20 3b 3b 20 6d 65 67 =yes.. ;; meg
13910 61 74 65 73 74 20 3c 3c 20 45 4f 46 0a 09 20 20 atest << EOF..
13920 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 48 65 6c ;; (print "Hel
13930 6c 6f 20 77 6f 72 6c 64 22 29 0a 09 20 20 20 20 lo world")..
13940 3b 3b 20 28 65 78 69 74 29 0a 09 20 20 20 20 3b ;; (exit).. ;
13950 3b 20 45 4f 46 0a 0a 09 20 20 20 20 28 72 65 70 ; EOF... (rep
13960 6c 29 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 20 l)).. (else..
13970 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
13980 20 28 73 65 74 21 20 2a 64 62 2a 20 64 62 73 74 (set! *db* dbst
13990 72 75 63 74 29 0a 09 20 20 20 20 20 20 28 69 6d ruct).. (im
139a0 70 6f 72 74 20 65 78 74 72 61 73 29 20 3b 3b 20 port extras) ;;
139b0 6d 69 67 68 74 20 6e 6f 74 20 62 65 20 6e 65 65 might not be nee
139c0 64 65 64 0a 09 20 20 20 20 20 20 3b 3b 20 28 69 ded.. ;; (i
139d0 6d 70 6f 72 74 20 63 73 69 29 0a 09 20 20 20 20 mport csi)..
139e0 20 20 28 69 6d 70 6f 72 74 20 72 65 61 64 6c 69 (import readli
139f0 6e 65 29 0a 09 20 20 20 20 20 20 28 69 6d 70 6f ne).. (impo
13a00 72 74 20 61 70 72 6f 70 6f 73 29 0a 09 20 20 20 rt apropos)..
13a10 20 20 20 3b 3b 20 28 69 6d 70 6f 72 74 20 28 70 ;; (import (p
13a20 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 refix sqlite3 sq
13a30 6c 69 74 65 33 3a 29 29 20 3b 3b 20 64 6f 65 73 lite3:)) ;; does
13a40 6e 27 74 20 77 6f 72 6b 20 2e 2e 2e 0a 0a 09 20 n't work ......
13a50 20 20 20 20 20 28 69 66 20 2a 75 73 65 2d 6e 65 (if *use-ne
13a60 77 2d 72 65 61 64 6c 69 6e 65 2a 0a 09 09 20 20 w-readline*...
13a70 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 69 6e (begin... (in
13a80 73 74 61 6c 6c 2d 68 69 73 74 6f 72 79 2d 66 69 stall-history-fi
13a90 6c 65 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d le (get-environm
13aa0 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f ent-variable "HO
13ab0 4d 45 22 29 20 22 2e 6d 65 67 61 74 65 73 74 5f ME") ".megatest_
13ac0 68 69 73 74 6f 72 79 22 29 20 3b 3b 20 20 5b 68 history") ;; [h
13ad0 6f 6d 65 64 69 72 5d 20 5b 66 69 6c 65 6e 61 6d omedir] [filenam
13ae0 65 5d 20 5b 6e 6c 69 6e 65 73 5d 29 0a 09 09 20 e] [nlines])...
13af0 20 20 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 (current-inpu
13b00 74 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 72 65 61 t-port (make-rea
13b10 64 6c 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 61 dline-port "mega
13b20 74 65 73 74 3e 20 22 29 29 29 0a 09 09 20 20 28 test> ")))... (
13b30 62 65 67 69 6e 0a 09 09 20 20 20 20 28 67 6e 75 begin... (gnu
13b40 2d 68 69 73 74 6f 72 79 2d 69 6e 73 74 61 6c 6c -history-install
13b50 2d 66 69 6c 65 2d 6d 61 6e 61 67 65 72 0a 09 09 -file-manager...
13b60 20 20 20 20 20 28 73 74 72 69 6e 67 2d 61 70 70 (string-app
13b70 65 6e 64 0a 09 09 20 20 20 20 20 20 28 6f 72 20 end... (or
13b80 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
13b90 2d 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 -variable "HOME"
13ba0 29 20 22 2e 22 29 20 22 2f 2e 6d 65 67 61 74 65 ) ".") "/.megate
13bb0 73 74 5f 68 69 73 74 6f 72 79 22 29 29 0a 09 09 st_history"))...
13bc0 20 20 20 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 (current-inp
13bd0 75 74 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 67 6e ut-port (make-gn
13be0 75 2d 72 65 61 64 6c 69 6e 65 2d 70 6f 72 74 20 u-readline-port
13bf0 22 6d 65 67 61 74 65 73 74 3e 20 22 29 29 29 29 "megatest> "))))
13c00 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 72 67 .. (if (arg
13c10 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c s:get-arg "-repl
13c20 22 29 0a 09 09 20 20 28 72 65 70 6c 29 0a 09 09 ")... (repl)...
13c30 20 20 28 6c 6f 61 64 20 28 61 72 67 73 3a 67 65 (load (args:ge
13c40 74 2d 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 29 t-arg "-load")))
13c50 0a 09 20 20 20 20 20 20 3b 3b 20 28 64 62 3a 63 .. ;; (db:c
13c60 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 lose-all dbstruc
13c70 74 29 20 3c 3d 20 74 61 6b 65 6e 20 63 61 72 65 t) <= taken care
13c80 20 6f 66 20 62 79 20 6f 6e 2d 65 78 69 74 20 63 of by on-exit c
13c90 61 6c 6c 0a 09 20 20 20 20 20 20 29 0a 09 20 20 all.. )..
13ca0 20 20 28 65 78 69 74 29 29 29 0a 09 20 20 28 73 (exit))).. (s
13cb0 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
13cc0 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d g* #t))))..;;===
13cd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ce0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13cf0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13d00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13d10 3d 3d 3d 0a 3b 3b 20 57 61 69 74 20 6f 6e 20 61 ===.;; Wait on a
13d20 20 72 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 65 run to complete
13d30 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
13d40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13d50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13d60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13d70 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
13d80 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 and (args:get-ar
13d90 67 20 22 2d 72 75 6e 2d 77 61 69 74 22 29 0a 09 g "-run-wait")..
13da0 20 28 6e 6f 74 20 28 6f 72 20 28 61 72 67 73 3a (not (or (args:
13db0 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a get-arg "-run").
13dc0 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 .. (args:get-ar
13dd0 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 29 29 g "-runtests")))
13de0 29 20 3b 3b 20 72 75 6e 2d 77 61 69 74 20 69 73 ) ;; run-wait is
13df0 20 62 75 69 6c 74 20 69 6e 74 6f 20 72 75 6e 74 built into runt
13e00 65 73 74 73 20 6e 6f 77 0a 20 20 20 20 28 62 65 ests now. (be
13e10 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e gin. (if (n
13e20 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 ot (launch:setup
13e30 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 )).. (begin..
13e40 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
13e50 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
13e60 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 rt* "Failed to s
13e70 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 etup, exiting")
13e80 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 .. (exit 1)))
13e90 0a 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d . (operate-
13ea0 6f 6e 20 27 72 75 6e 2d 77 61 69 74 29 0a 20 20 on 'run-wait).
13eb0 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
13ec0 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
13ed0 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
13ee0 20 3b 3b 20 4e 6f 74 20 63 6f 6e 76 65 72 74 65 ;; Not converte
13ef0 64 20 74 6f 20 75 73 65 20 64 62 73 74 72 75 63 d to use dbstruc
13f00 74 20 79 65 74 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 t yet.;; ;; ;; r
13f10 65 64 6f 20 6d 65 20 3b 3b 0a 3b 3b 20 3b 3b 20 edo me ;;.;; ;;
13f20 3b 3b 20 72 65 64 6f 20 6d 65 20 28 69 66 20 28 ;; redo me (if (
13f30 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 args:get-arg "-c
13f40 6f 6e 76 65 72 74 2d 74 6f 2d 6e 6f 72 6d 22 29 onvert-to-norm")
13f50 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13f60 65 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f e (let* ((to
13f70 70 70 61 74 68 20 28 73 65 74 75 70 2d 66 6f 72 ppath (setup-for
13f80 2d 72 75 6e 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 -run)).;; ;; ;;
13f90 72 65 64 6f 20 6d 65 20 09 20 20 20 28 64 62 73 redo me . (dbs
13fa0 74 72 75 63 74 20 28 69 66 20 74 6f 70 70 61 74 truct (if toppat
13fb0 68 20 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 h (make-dbr:dbst
13fc0 72 75 63 74 20 70 61 74 68 3a 20 74 6f 70 70 61 ruct path: toppa
13fd0 74 68 20 6c 6f 63 61 6c 3a 20 23 74 29 29 29 29 th local: #t))))
13fe0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13ff0 65 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 e (for-eac
14000 68 20 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f h .;; ;; ;; redo
14010 20 6d 65 20 20 20 20 20 20 20 20 28 6c 61 6d 62 me (lamb
14020 64 61 20 28 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b da (field).;; ;;
14030 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 28 6c ;; redo me . (l
14040 65 74 20 28 28 64 61 74 20 27 28 29 29 29 0a 3b et ((dat '())).;
14050 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
14060 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
14070 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
14080 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 47 65 74 74 -log-port* "Gett
14090 69 6e 67 20 64 61 74 61 20 66 6f 72 20 66 69 65 ing data for fie
140a0 6c 64 20 22 20 66 69 65 6c 64 29 0a 3b 3b 20 3b ld " field).;; ;
140b0 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 ; ;; redo me .
140c0 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
140d0 63 68 2d 72 6f 77 0a 3b 3b 20 3b 3b 20 3b 3b 20 ch-row.;; ;; ;;
140e0 72 65 64 6f 20 6d 65 20 09 20 20 20 20 28 6c 61 redo me . (la
140f0 6d 62 64 61 20 28 69 64 20 76 61 6c 29 0a 3b 3b mbda (id val).;;
14100 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
14110 20 20 20 20 20 20 28 73 65 74 21 20 64 61 74 20 (set! dat
14120 28 63 6f 6e 73 20 28 6c 69 73 74 20 69 64 20 76 (cons (list id v
14130 61 6c 29 20 64 61 74 29 29 29 0a 3b 3b 20 3b 3b al) dat))).;; ;;
14140 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
14150 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 20 72 (db:get-db db r
14160 75 6e 2d 69 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 un-id).;; ;; ;;
14170 72 65 64 6f 20 6d 65 20 09 20 20 20 20 28 63 6f redo me . (co
14180 6e 63 20 22 53 45 4c 45 43 54 20 69 64 2c 22 20 nc "SELECT id,"
14190 66 69 65 6c 64 20 22 20 46 52 4f 4d 20 74 65 73 field " FROM tes
141a0 74 73 3b 22 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 ts;")).;; ;; ;;
141b0 72 65 64 6f 20 6d 65 20 09 20 20 20 28 64 65 62 redo me . (deb
141c0 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
141d0 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
141e0 74 2a 20 22 66 6f 75 6e 64 20 22 20 28 6c 65 6e t* "found " (len
141f0 67 74 68 20 64 61 74 29 20 22 20 69 74 65 6d 73 gth dat) " items
14200 20 66 6f 72 20 66 69 65 6c 64 20 22 20 66 69 65 for field " fie
14210 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ld).;; ;; ;; red
14220 6f 20 6d 65 20 09 20 20 20 28 6c 65 74 20 28 28 o me . (let ((
14230 71 72 79 20 28 73 71 6c 69 74 65 33 3a 70 72 65 qry (sqlite3:pre
14240 70 61 72 65 20 64 62 20 28 63 6f 6e 63 20 22 55 pare db (conc "U
14250 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
14260 22 20 66 69 65 6c 64 20 22 3d 3f 20 57 48 45 52 " field "=? WHER
14270 45 20 69 64 3d 3f 3b 22 29 29 29 29 0a 3b 3b 20 E id=?;")))).;;
14280 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 ;; ;; redo me .
14290 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 3b 3b (for-each.;;
142a0 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
142b0 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 (lambda (i
142c0 74 65 6d 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 tem).;; ;; ;; re
142d0 64 6f 20 6d 65 20 09 09 28 6c 65 74 20 28 28 6e do me ..(let ((n
142e0 65 77 76 61 6c 20 3b 3b 20 28 73 64 62 3a 71 72 ewval ;; (sdb:qr
142f0 79 20 27 67 65 74 69 64 20 0a 3b 3b 20 3b 3b 20 y 'getid .;; ;;
14300 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 20 20 20 ;; redo me ..
14310 20 20 20 20 28 63 61 64 72 20 69 74 65 6d 29 29 (cadr item))
14320 29 20 3b 3b 20 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 ) ;; ).;; ;; ;;
14330 72 65 64 6f 20 6d 65 20 09 09 20 20 28 69 66 20 redo me .. (if
14340 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 77 (not (equal? new
14350 76 61 6c 20 28 63 61 64 72 20 69 74 65 6d 29 29 val (cadr item))
14360 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
14370 6d 65 20 09 09 20 20 20 20 20 20 28 64 65 62 75 me .. (debu
14380 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
14390 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
143a0 2a 20 22 43 6f 6e 76 65 72 74 69 6e 67 20 22 20 * "Converting "
143b0 28 63 61 64 72 20 69 74 65 6d 29 20 22 20 74 6f (cadr item) " to
143c0 20 22 20 6e 65 77 76 61 6c 20 22 20 66 6f 72 20 " newval " for
143d0 74 65 73 74 20 23 22 20 28 63 61 72 20 69 74 65 test #" (car ite
143e0 6d 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 m))).;; ;; ;; re
143f0 64 6f 20 6d 65 20 09 09 20 20 28 73 71 6c 69 74 do me .. (sqlit
14400 65 33 3a 65 78 65 63 75 74 65 20 71 72 79 20 6e e3:execute qry n
14410 65 77 76 61 6c 20 28 63 61 72 20 69 74 65 6d 29 ewval (car item)
14420 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ))).;; ;; ;; red
14430 6f 20 6d 65 20 09 20 20 20 20 20 20 64 61 74 29 o me . dat)
14440 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
14450 65 20 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 e . (sqlite3
14460 3a 66 69 6e 61 6c 69 7a 65 21 20 71 72 79 29 29 :finalize! qry))
14470 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f )).;; ;; ;; redo
14480 20 6d 65 20 20 20 20 20 20 20 20 28 64 62 3a 63 me (db:c
14490 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 lose-all dbstruc
144a0 74 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f t).;; ;; ;; redo
144b0 20 6d 65 20 20 20 20 20 20 20 20 28 6c 69 73 74 me (list
144c0 20 22 75 6e 61 6d 65 22 20 22 72 75 6e 64 69 72 "uname" "rundir
144d0 22 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 22 " "final_logf" "
144e0 63 6f 6d 6d 65 6e 74 22 29 29 0a 3b 3b 20 3b 3b comment")).;; ;;
144f0 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 ;; redo me
14500 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
14510 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
14520 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
14530 22 2d 69 6d 70 6f 72 74 2d 6d 65 67 61 74 65 73 "-import-megates
14540 74 2e 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 t.db"). (begi
14550 6e 0a 20 20 20 20 20 20 28 64 62 3a 6d 75 6c 74 n. (db:mult
14560 69 2d 64 62 2d 73 79 6e 63 20 0a 20 20 20 20 20 i-db-sync .
14570 20 20 28 64 62 3a 73 65 74 75 70 29 0a 20 20 20 (db:setup).
14580 20 20 20 20 27 6b 69 6c 6c 73 65 72 76 65 72 73 'killservers
14590 0a 20 20 20 20 20 20 20 27 64 65 6a 75 6e 6b 0a . 'dejunk.
145a0 20 20 20 20 20 20 20 27 61 64 6a 2d 74 65 73 74 'adj-test
145b0 69 64 73 0a 20 20 20 20 20 20 20 27 6f 6c 64 32 ids. 'old2
145c0 6e 65 77 0a 20 20 20 20 20 20 20 3b 3b 20 27 6e new. ;; 'n
145d0 65 77 32 6f 6c 64 0a 20 20 20 20 20 20 20 29 0a ew2old. ).
145e0 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
145f0 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
14600 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
14610 61 72 67 20 22 2d 73 79 6e 63 2d 74 6f 2d 6d 65 arg "-sync-to-me
14620 67 61 74 65 73 74 2e 64 62 22 29 0a 20 20 20 20 gatest.db").
14630 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 64 62 (begin. (db
14640 3a 6d 75 6c 74 69 2d 64 62 2d 73 79 6e 63 20 0a :multi-db-sync .
14650 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 75 70 (db:setup
14660 29 0a 20 20 20 20 20 20 20 27 6e 65 77 32 6f 6c ). 'new2ol
14670 64 0a 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 d. ).
14680 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
14690 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 hing* #t)))..(if
146a0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
146b0 2d 67 65 6e 65 72 61 74 65 2d 68 74 6d 6c 22 29 -generate-html")
146c0 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 . (let* ((top
146d0 70 61 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 path (launch:set
146e0 75 70 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 up))). (if
146f0 28 74 65 73 74 73 3a 63 72 65 61 74 65 2d 68 74 (tests:create-ht
14700 6d 6c 2d 74 72 65 65 20 23 66 29 0a 20 20 20 20 ml-tree #f).
14710 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
14720 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
14730 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 48 54 lt-log-port* "HT
14740 4d 4c 20 6f 75 74 70 75 74 20 63 72 65 61 74 65 ML output create
14750 64 20 69 6e 20 22 20 74 6f 70 70 61 74 68 20 22 d in " toppath "
14760 2f 6c 74 2f 70 61 67 65 23 2e 68 74 6d 6c 22 29 /lt/page#.html")
14770 0a 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 . (debu
14780 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
14790 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 lt-log-port* "Fa
147a0 69 6c 65 64 20 74 6f 20 63 72 65 61 74 65 20 48 iled to create H
147b0 54 4d 4c 20 6f 75 74 70 75 74 20 69 6e 20 22 20 TML output in "
147c0 74 6f 70 70 61 74 68 20 22 2f 6c 74 2f 72 75 6e toppath "/lt/run
147d0 73 2d 69 6e 64 65 78 2e 68 74 6d 6c 22 29 29 0a s-index.html")).
147e0 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
147f0 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
14800 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
14810 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14820 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14830 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14840 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 ==========.;; Ex
14850 69 74 20 61 6e 64 20 63 6c 65 61 6e 20 75 70 0a it and clean up.
14860 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
14870 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14880 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14890 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
148a0 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6e ========..(if (n
148b0 6f 74 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 ot *didsomething
148c0 2a 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 *). (debug:pr
148d0 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
148e0 6f 67 2d 70 6f 72 74 2a 20 68 65 6c 70 29 29 0a og-port* help)).
148f0 3b 3b 28 42 42 3e 20 22 74 68 72 65 61 64 2d 6a ;;(BB> "thread-j
14900 6f 69 6e 21 20 77 61 74 63 68 64 6f 67 22 29 0a oin! watchdog").
14910 0a 3b 3b 20 6a 6f 69 6e 20 74 68 65 20 77 61 74 .;; join the wat
14920 63 68 64 6f 67 20 74 68 72 65 61 64 20 69 66 20 chdog thread if
14930 69 74 20 68 61 73 20 62 65 65 6e 20 74 68 72 65 it has been thre
14940 61 64 2d 73 74 61 72 74 21 65 64 20 20 28 69 74 ad-start!ed (it
14950 20 6d 61 79 20 6e 6f 74 20 68 61 76 65 20 62 65 may not have be
14960 65 6e 20 73 74 61 72 74 65 64 20 69 6e 20 74 68 en started in th
14970 65 20 63 61 73 65 20 6f 66 20 61 20 73 65 72 76 e case of a serv
14980 65 72 20 74 68 61 74 20 6e 65 76 65 72 20 65 6e er that never en
14990 74 65 72 73 20 72 75 6e 6e 69 6e 67 20 73 74 61 ters running sta
149a0 74 65 29 0a 3b 3b 20 20 20 28 73 79 6d 62 6f 6c te).;; (symbol
149b0 73 20 72 65 74 75 72 6e 65 64 20 62 79 20 74 68 s returned by th
149c0 72 65 61 64 2d 73 74 61 74 65 3a 20 63 72 65 61 read-state: crea
149d0 74 65 64 20 72 65 61 64 79 20 72 75 6e 6e 69 6e ted ready runnin
149e0 67 20 62 6c 6f 63 6b 65 64 20 73 75 73 70 65 6e g blocked suspen
149f0 64 65 64 20 73 6c 65 65 70 69 6e 67 20 74 65 72 ded sleeping ter
14a00 6d 69 6e 61 74 65 64 20 64 65 61 64 29 0a 28 69 minated dead).(i
14a10 66 20 28 74 68 72 65 61 64 3f 20 2a 77 61 74 63 f (thread? *watc
14a20 68 64 6f 67 2a 29 0a 20 20 20 20 28 63 61 73 65 hdog*). (case
14a30 20 28 74 68 72 65 61 64 2d 73 74 61 74 65 20 2a (thread-state *
14a40 77 61 74 63 68 64 6f 67 2a 29 0a 20 20 20 20 20 watchdog*).
14a50 20 28 28 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 ((ready running
14a60 20 62 6c 6f 63 6b 65 64 20 73 6c 65 65 70 69 6e blocked sleepin
14a70 67 20 74 65 72 6d 69 6e 61 74 65 64 20 64 65 61 g terminated dea
14a80 64 29 0a 20 20 20 20 20 20 20 28 74 68 72 65 61 d). (threa
14a90 64 2d 6a 6f 69 6e 21 20 2a 77 61 74 63 68 64 6f d-join! *watchdo
14aa0 67 2a 29 29 29 29 0a 0a 28 73 65 74 21 20 2a 74 g*))))..(set! *t
14ab0 69 6d 65 2d 74 6f 2d 65 78 69 74 2a 20 23 74 29 ime-to-exit* #t)
14ac0 0a 0a 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 ..(if (not (eq?
14ad0 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 *globalexitstatu
14ae0 73 2a 20 30 29 29 0a 20 20 20 20 28 69 66 20 28 s* 0)). (if (
14af0 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
14b00 20 22 2d 72 75 6e 22 29 28 61 72 67 73 3a 67 65 "-run")(args:ge
14b10 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 t-arg "-runtests
14b20 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
14b30 22 2d 72 75 6e 61 6c 6c 22 29 29 0a 20 20 20 20 "-runall")).
14b40 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
14b50 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
14b60 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
14b70 67 2d 70 6f 72 74 2a 20 22 4e 4f 54 45 3a 20 53 g-port* "NOTE: S
14b80 75 62 70 72 6f 63 65 73 73 65 73 20 77 69 74 68 ubprocesses with
14b90 20 6e 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 20 63 non-zero exit c
14ba0 6f 64 65 20 64 65 74 65 63 74 65 64 3a 20 22 20 ode detected: "
14bb0 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 *globalexitstatu
14bc0 73 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 s*). (
14bd0 65 78 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 exit 0)).
14be0 20 28 63 61 73 65 20 2a 67 6c 6f 62 61 6c 65 78 (case *globalex
14bf0 69 74 73 74 61 74 75 73 2a 0a 20 20 20 20 20 20 itstatus*.
14c00 20 20 20 28 28 30 29 28 65 78 69 74 20 30 29 29 ((0)(exit 0))
14c10 0a 20 20 20 20 20 20 20 20 20 28 28 31 29 28 65 . ((1)(e
14c20 78 69 74 20 31 29 29 0a 20 20 20 20 20 20 20 20 xit 1)).
14c30 20 28 28 32 29 28 65 78 69 74 20 32 29 29 0a 20 ((2)(exit 2)).
14c40 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 65 (else (e
14c50 78 69 74 20 33 29 29 29 29 29 0a xit 3))))).