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 0a 28 64 65 66 69 6e 65 20 2a 64 62 2a 20 23 ..(define *db* #
0530: 66 29 20 3b 3b 20 74 68 69 73 20 69 73 20 6f 6e f) ;; this is on
0540: 6c 79 20 66 6f 72 20 74 68 65 20 72 65 70 6c 2c ly for the repl,
0550: 20 64 6f 20 6e 6f 74 20 75 73 65 20 69 6e 20 67 do not use in g
0560: 65 6e 65 72 61 6c 21 21 21 21 0a 0a 28 69 6e 63 eneral!!!!..(inc
0570: 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 lude "common_rec
0580: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl
0590: 75 64 65 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 ude "key_records
05a0: 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 .scm").(include
05b0: 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 "db_records.scm"
05c0: 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 75 6e 5f ).(include "run_
05d0: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 records.scm").(i
05e0: 6e 63 6c 75 64 65 20 22 6d 65 67 61 74 65 73 74 nclude "megatest
05f0: 2d 66 6f 73 73 69 6c 2d 68 61 73 68 2e 73 63 6d -fossil-hash.scm
0600: 22 29 0a 0a 28 6c 65 74 20 28 28 64 65 62 75 67 ")..(let ((debug
0610: 63 6f 6e 74 72 6f 6c 66 20 28 63 6f 6e 63 20 28 controlf (conc (
0620: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
0630: 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 variable "HOME")
0640: 20 22 2f 2e 6d 65 67 61 74 65 73 74 72 63 22 29 "/.megatestrc")
0650: 29 29 0a 20 20 28 69 66 20 28 66 69 6c 65 2d 65 )). (if (file-e
0660: 78 69 73 74 73 3f 20 64 65 62 75 67 63 6f 6e 74 xists? debugcont
0670: 72 6f 6c 66 29 0a 20 20 20 20 20 20 28 6c 6f 61 rolf). (loa
0680: 64 20 64 65 62 75 67 63 6f 6e 74 72 6f 6c 66 29 d debugcontrolf)
0690: 29 29 0a 0a 3b 3b 20 44 69 73 61 62 6c 65 64 20 ))..;; Disabled
06a0: 68 65 6c 70 20 69 74 65 6d 73 0a 3b 3b 20 20 2d help items.;; -
06b0: 72 6f 6c 6c 75 70 20 20 20 20 20 20 20 20 20 20 rollup
06c0: 20 20 20 20 20 20 20 3a 20 28 63 75 72 72 65 6e : (curren
06d0: 74 6c 79 20 64 69 73 61 62 6c 65 64 29 20 66 69 tly disabled) fi
06e0: 6c 6c 20 72 75 6e 20 28 73 65 74 20 62 79 20 3a ll run (set by :
06f0: 72 75 6e 6e 61 6d 65 29 20 20 77 69 74 68 20 6c runname) with l
0700: 61 74 65 73 74 20 74 65 73 74 28 73 29 0a 3b 3b atest test(s).;;
0710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0720: 20 20 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d from
0730: 20 70 72 69 6f 72 20 72 75 6e 73 20 77 69 74 68 prior runs with
0740: 20 73 61 6d 65 20 6b 65 79 73 0a 0a 28 64 65 66 same keys..(def
0750: 69 6e 65 20 68 65 6c 70 20 28 63 6f 6e 63 20 22 ine help (conc "
0760: 0a 4d 65 67 61 74 65 73 74 2c 20 64 6f 63 75 6d .Megatest, docum
0770: 65 6e 74 61 74 69 6f 6e 20 61 74 20 68 74 74 70 entation at http
0780: 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f ://www.kiatoa.co
0790: 6d 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 m/fossils/megate
07a0: 73 74 0a 20 20 76 65 72 73 69 6f 6e 20 22 20 6d st. version " m
07b0: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 egatest-version
07c0: 22 0a 20 20 6c 69 63 65 6e 73 65 20 47 50 4c 2c ". license GPL,
07d0: 20 43 6f 70 79 72 69 67 68 74 20 4d 61 74 74 20 Copyright Matt
07e0: 57 65 6c 6c 61 6e 64 20 32 30 30 36 2d 32 30 31 Welland 2006-201
07f0: 35 0a 0a 55 73 61 67 65 3a 20 6d 65 67 61 74 65 5..Usage: megate
0800: 73 74 20 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 2d st [options]. -
0810: 68 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 h
0820: 20 20 20 20 20 20 20 3a 20 74 68 69 73 20 68 65 : this he
0830: 6c 70 0a 20 20 2d 76 65 72 73 69 6f 6e 20 20 20 lp. -version
0840: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 70 : p
0850: 72 69 6e 74 20 6d 65 67 61 74 65 73 74 20 76 65 rint megatest ve
0860: 72 73 69 6f 6e 20 28 63 75 72 72 65 6e 74 6c 79 rsion (currently
0870: 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 " megatest-vers
0880: 69 6f 6e 20 22 29 0a 0a 4c 61 75 6e 63 68 69 6e ion ")..Launchin
0890: 67 20 61 6e 64 20 6d 61 6e 61 67 69 6e 67 20 72 g and managing r
08a0: 75 6e 73 0a 20 20 2d 72 75 6e 61 6c 6c 20 20 20 uns. -runall
08b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
08c0: 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 6f 72 run all tests or
08d0: 20 61 73 20 73 70 65 63 69 66 69 65 64 20 62 79 as specified by
08e0: 20 2d 74 65 73 74 70 61 74 74 0a 20 20 2d 72 65 -testpatt. -re
08f0: 6d 6f 76 65 2d 72 75 6e 73 20 20 20 20 20 20 20 move-runs
0900: 20 20 20 20 20 3a 20 72 65 6d 6f 76 65 20 74 68 : remove th
0910: 65 20 64 61 74 61 20 66 6f 72 20 61 20 72 75 6e e data for a run
0920: 2c 20 72 65 71 75 69 72 65 73 20 2d 72 75 6e 6e , requires -runn
0930: 61 6d 65 20 61 6e 64 20 2d 74 65 73 74 70 61 74 ame and -testpat
0940: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
0950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 4f 70 Op
0960: 74 69 6f 6e 61 6c 6c 79 20 75 73 65 20 3a 73 74 tionally use :st
0970: 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 0a ate and :status.
0980: 20 20 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 -set-state-sta
0990: 74 75 73 20 58 2c 59 20 20 20 3a 20 73 65 74 20 tus X,Y : set
09a0: 73 74 61 74 65 20 74 6f 20 58 20 61 6e 64 20 73 state to X and s
09b0: 74 61 74 75 73 20 74 6f 20 59 2c 20 72 65 71 75 tatus to Y, requ
09c0: 69 72 65 73 20 63 6f 6e 74 72 6f 6c 73 20 70 65 ires controls pe
09d0: 72 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 0a 20 r -remove-runs.
09e0: 20 2d 72 65 72 75 6e 20 46 41 49 4c 2c 57 41 52 -rerun FAIL,WAR
09f0: 4e 2e 2e 2e 20 20 20 20 20 3a 20 66 6f 72 63 65 N... : force
0a00: 20 72 65 2d 72 75 6e 20 66 6f 72 20 74 65 73 74 re-run for test
0a10: 73 20 77 69 74 68 20 73 70 65 63 69 66 69 63 65 s with specifice
0a20: 64 20 73 74 61 74 75 73 28 73 29 0a 20 20 2d 72 d status(s). -r
0a30: 65 72 75 6e 2d 63 6c 65 61 6e 20 20 20 20 20 20 erun-clean
0a40: 20 20 20 20 20 20 3a 20 73 65 74 20 61 6c 6c 20 : set all
0a50: 74 65 73 74 73 20 6e 6f 74 20 43 4f 4d 50 4c 45 tests not COMPLE
0a60: 54 45 44 2b 50 41 53 53 2c 57 41 52 4e 2c 57 41 TED+PASS,WARN,WA
0a70: 49 56 45 44 20 74 6f 20 4e 4f 54 5f 53 54 41 52 IVED to NOT_STAR
0a80: 54 45 44 2c 6e 2f 61 0a 20 20 20 20 20 20 20 20 TED,n/a.
0a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0aa0: 20 20 20 20 61 6e 64 20 74 68 65 6e 20 72 75 6e and then run
0ab0: 20 74 68 65 20 73 70 65 63 69 66 69 65 64 20 74 the specified t
0ac0: 65 73 74 70 61 74 74 20 77 69 74 68 20 2d 70 72 estpatt with -pr
0ad0: 65 63 6c 65 61 6e 0a 20 20 2d 72 65 72 75 6e 2d eclean. -rerun-
0ae0: 61 6c 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 all
0af0: 20 3a 20 73 65 74 20 61 6c 6c 20 74 65 73 74 73 : set all tests
0b00: 20 74 6f 20 4e 4f 54 5f 53 54 41 52 54 45 44 2c to NOT_STARTED,
0b10: 6e 2f 61 20 61 6e 64 20 72 75 6e 20 77 69 74 68 n/a and run with
0b20: 20 2d 70 72 65 63 6c 65 61 6e 0a 20 20 2d 6c 6f -preclean. -lo
0b30: 63 6b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ck
0b40: 20 20 20 20 20 3a 20 6c 6f 63 6b 20 72 75 6e 20 : lock run
0b50: 73 70 65 63 69 66 69 65 64 20 62 79 20 74 61 72 specified by tar
0b60: 67 65 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a get and runname.
0b70: 20 20 2d 75 6e 6c 6f 63 6b 20 20 20 20 20 20 20 -unlock
0b80: 20 20 20 20 20 20 20 20 20 20 3a 20 75 6e 6c 6f : unlo
0b90: 63 6b 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 ck run specified
0ba0: 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 by target and r
0bb0: 75 6e 6e 61 6d 65 0a 20 20 2d 73 65 74 2d 72 75 unname. -set-ru
0bc0: 6e 2d 73 74 61 74 75 73 20 73 74 61 74 75 73 20 n-status status
0bd0: 20 3a 20 73 65 74 73 20 73 74 61 74 75 73 20 66 : sets status f
0be0: 6f 72 20 72 75 6e 20 74 6f 20 73 74 61 74 75 73 or run to status
0bf0: 2c 20 72 65 71 75 69 72 65 73 20 2d 74 61 72 67 , requires -targ
0c00: 65 74 20 61 6e 64 20 2d 72 75 6e 6e 61 6d 65 0a et and -runname.
0c10: 20 20 2d 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 -get-run-statu
0c20: 73 20 20 20 20 20 20 20 20 20 3a 20 67 65 74 73 s : gets
0c30: 20 73 74 61 74 75 73 20 66 6f 72 20 72 75 6e 20 status for run
0c40: 73 70 65 63 69 66 69 65 64 20 62 79 20 74 61 72 specified by tar
0c50: 67 65 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a get and runname.
0c60: 20 20 2d 72 75 6e 2d 77 61 69 74 20 20 20 20 20 -run-wait
0c70: 20 20 20 20 20 20 20 20 20 20 3a 20 77 61 69 74 : wait
0c80: 20 6f 6e 20 72 75 6e 20 73 70 65 63 69 66 69 65 on run specifie
0c90: 64 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 d by target and
0ca0: 72 75 6e 6e 61 6d 65 0a 20 20 2d 70 72 65 63 6c runname. -precl
0cb0: 65 61 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 ean
0cc0: 20 20 3a 20 72 65 6d 6f 76 65 20 74 68 65 20 65 : remove the e
0cd0: 78 69 73 74 69 6e 67 20 74 65 73 74 20 64 69 72 xisting test dir
0ce0: 65 63 74 6f 72 79 20 62 65 66 6f 72 65 20 72 75 ectory before ru
0cf0: 6e 6e 69 6e 67 20 74 68 65 20 74 65 73 74 0a 20 nning the test.
0d00: 20 2d 63 6c 65 61 6e 2d 63 61 63 68 65 20 20 20 -clean-cache
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 63 61 63 68 65 64 20 6d 65 67 e the cached meg
0d30: 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 61 6e 64 atest.config and
0d40: 20 72 75 6e 63 6f 6e 66 69 67 2e 63 6f 6e 66 69 runconfig.confi
0d50: 67 20 66 69 6c 65 73 0a 0a 53 65 6c 65 63 74 6f g files..Selecto
0d60: 72 73 20 28 65 2e 67 2e 20 75 73 65 20 66 6f 72 rs (e.g. use for
0d70: 20 2d 72 75 6e 74 65 73 74 73 2c 20 2d 72 65 6d -runtests, -rem
0d80: 6f 76 65 2d 72 75 6e 73 2c 20 2d 73 65 74 2d 73 ove-runs, -set-s
0d90: 74 61 74 65 2d 73 74 61 74 75 73 2c 20 2d 6c 69 tate-status, -li
0da0: 73 74 2d 72 75 6e 73 20 65 74 63 2e 29 0a 20 20 st-runs etc.).
0db0: 2d 74 61 72 67 65 74 20 6b 65 79 31 2f 6b 65 79 -target key1/key
0dc0: 32 2f 2e 2e 2e 20 20 20 3a 20 72 75 6e 20 66 6f 2/... : run fo
0dd0: 72 20 6b 65 79 31 2c 20 6b 65 79 32 2c 20 65 74 r key1, key2, et
0de0: 63 2e 0a 20 20 2d 72 65 71 74 61 72 67 20 6b 65 c.. -reqtarg ke
0df0: 79 31 2f 6b 65 79 32 2f 2e 2e 2e 20 20 3a 20 72 y1/key2/... : r
0e00: 75 6e 20 66 6f 72 20 6b 65 79 31 2c 20 6b 65 79 un for key1, key
0e10: 32 2c 20 65 74 63 2e 20 62 75 74 20 6b 65 79 31 2, etc. but key1
0e20: 2f 6b 65 79 32 20 6d 75 73 74 20 62 65 20 69 6e /key2 must be in
0e30: 20 72 75 6e 63 6f 6e 66 69 67 0a 20 20 2d 74 65 runconfig. -te
0e40: 73 74 70 61 74 74 20 70 61 74 74 31 2f 70 61 74 stpatt patt1/pat
0e50: 74 32 2c 70 61 74 74 33 2f 2e 2e 2e 20 20 3a 20 t2,patt3/... :
0e60: 25 20 69 73 20 77 69 6c 64 63 61 72 64 0a 20 20 % is wildcard.
0e70: 2d 72 75 6e 6e 61 6d 65 20 20 20 20 20 20 20 20 -runname
0e80: 20 20 20 20 20 20 20 20 3a 20 72 65 71 75 69 72 : requir
0e90: 65 64 2c 20 6e 61 6d 65 20 66 6f 72 20 74 68 69 ed, name for thi
0ea0: 73 20 70 61 72 74 69 63 75 6c 61 72 20 74 65 73 s particular tes
0eb0: 74 20 72 75 6e 0a 20 20 2d 73 74 61 74 65 20 20 t run. -state
0ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ed0: 3a 20 41 70 70 6c 69 65 73 20 74 6f 20 72 75 6e : Applies to run
0ee0: 73 2c 20 74 65 73 74 73 20 6f 72 20 73 74 65 70 s, tests or step
0ef0: 73 20 64 65 70 65 6e 64 69 6e 67 20 6f 6e 20 63 s depending on c
0f00: 6f 6e 74 65 78 74 0a 20 20 2d 73 74 61 74 75 73 ontext. -status
0f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f20: 20 3a 20 41 70 70 6c 69 65 73 20 74 6f 20 72 75 : Applies to ru
0f30: 6e 73 2c 20 74 65 73 74 73 20 6f 72 20 73 74 65 ns, tests or ste
0f40: 70 73 20 64 65 70 65 6e 64 69 6e 67 20 6f 6e 20 ps depending on
0f50: 63 6f 6e 74 65 78 74 0a 0a 54 65 73 74 20 68 65 context..Test he
0f60: 6c 70 65 72 73 20 28 66 6f 72 20 75 73 65 20 69 lpers (for use i
0f70: 6e 73 69 64 65 20 74 65 73 74 73 29 0a 20 20 2d nside tests). -
0f80: 73 74 65 70 20 73 74 65 70 6e 61 6d 65 0a 20 20 step stepname.
0f90: 2d 74 65 73 74 2d 73 74 61 74 75 73 20 20 20 20 -test-status
0fa0: 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 : set th
0fb0: 65 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 e state and stat
0fc0: 75 73 20 6f 66 20 61 20 74 65 73 74 20 28 75 73 us of a test (us
0fd0: 65 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 e :state and :st
0fe0: 61 74 75 73 29 0a 20 20 2d 73 65 74 6c 6f 67 20 atus). -setlog
0ff0: 6c 6f 67 66 6e 61 6d 65 20 20 20 20 20 20 20 20 logfname
1000: 3a 20 73 65 74 20 74 68 65 20 70 61 74 68 2f 66 : set the path/f
1010: 69 6c 65 6e 61 6d 65 20 74 6f 20 74 68 65 20 66 ilename to the f
1020: 69 6e 61 6c 20 6c 6f 67 20 72 65 6c 61 74 69 76 inal log relativ
1030: 65 20 74 6f 20 74 68 65 20 74 65 73 74 0a 20 20 e to the test.
1040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1050: 20 20 20 20 20 20 20 20 20 20 64 69 72 65 63 74 direct
1060: 6f 72 79 2e 20 6d 61 79 20 62 65 20 75 73 65 64 ory. may be used
1070: 20 77 69 74 68 20 2d 74 65 73 74 2d 73 74 61 74 with -test-stat
1080: 75 73 0a 20 20 2d 73 65 74 2d 74 6f 70 6c 6f 67 us. -set-toplog
1090: 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 3a 20 73 logfname : s
10a0: 65 74 20 74 68 65 20 6f 76 65 72 61 6c 6c 20 6c et the overall l
10b0: 6f 67 20 66 6f 72 20 61 20 73 75 69 74 65 20 6f og for a suite o
10c0: 66 20 73 75 62 2d 74 65 73 74 73 0a 20 20 2d 73 f sub-tests. -s
10d0: 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 20 ummarize-items
10e0: 20 20 20 20 20 20 3a 20 66 6f 72 20 61 6e 20 69 : for an i
10f0: 74 65 6d 69 7a 65 64 20 74 65 73 74 20 63 72 65 temized test cre
1100: 61 74 65 20 61 20 73 75 6d 6d 61 72 79 20 68 74 ate a summary ht
1110: 6d 6c 20 0a 20 20 2d 6d 20 63 6f 6d 6d 65 6e 74 ml . -m comment
1120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
1130: 69 6e 73 65 72 74 20 61 20 63 6f 6d 6d 65 6e 74 insert a comment
1140: 20 66 6f 72 20 74 68 69 73 20 74 65 73 74 0a 0a for this test..
1150: 54 65 73 74 20 64 61 74 61 20 63 61 70 74 75 72 Test data captur
1160: 65 0a 20 20 2d 73 65 74 2d 76 61 6c 75 65 73 20 e. -set-values
1170: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 75 70 : up
1180: 64 61 74 65 20 6f 72 20 73 65 74 20 76 61 6c 75 date or set valu
1190: 65 73 20 69 6e 20 74 68 65 20 74 65 73 74 64 61 es in the testda
11a0: 74 61 20 74 61 62 6c 65 0a 20 20 3a 63 61 74 65 ta table. :cate
11b0: 67 6f 72 79 20 20 20 20 20 20 20 20 20 20 20 20 gory
11c0: 20 20 20 3a 20 73 65 74 20 74 68 65 20 63 61 74 : set the cat
11d0: 65 67 6f 72 79 20 66 69 65 6c 64 20 28 6f 70 74 egory field (opt
11e0: 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 72 69 61 62 ional). :variab
11f0: 6c 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 le
1200: 20 3a 20 73 65 74 20 74 68 65 20 76 61 72 69 61 : set the varia
1210: 62 6c 65 20 6e 61 6d 65 20 28 6f 70 74 69 6f 6e ble name (option
1220: 61 6c 29 0a 20 20 3a 76 61 6c 75 65 20 20 20 20 al). :value
1230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
1240: 76 61 6c 75 65 20 6d 65 61 73 75 72 65 64 20 28 value measured (
1250: 72 65 71 75 69 72 65 64 29 0a 20 20 3a 65 78 70 required). :exp
1260: 65 63 74 65 64 20 20 20 20 20 20 20 20 20 20 20 ected
1270: 20 20 20 20 3a 20 76 61 6c 75 65 20 65 78 70 65 : value expe
1280: 63 74 65 64 20 28 72 65 71 75 69 72 65 64 29 0a cted (required).
1290: 20 20 3a 74 6f 6c 20 20 20 20 20 20 20 20 20 20 :tol
12a0: 20 20 20 20 20 20 20 20 20 20 3a 20 7c 76 61 6c : |val
12b0: 75 65 2d 65 78 70 65 63 74 7c 20 3c 3d 20 74 6f ue-expect| <= to
12c0: 6c 20 28 72 65 71 75 69 72 65 64 2c 20 63 61 6e l (required, can
12d0: 20 62 65 20 3c 2c 20 3e 2c 20 3e 3d 2c 20 3c 3d be <, >, >=, <=
12e0: 20 6f 72 20 6e 75 6d 62 65 72 29 0a 20 20 3a 75 or number). :u
12f0: 6e 69 74 73 20 20 20 20 20 20 20 20 20 20 20 20 nits
1300: 20 20 20 20 20 20 3a 20 6e 61 6d 65 20 6f 66 20 : name of
1310: 74 68 65 20 75 6e 69 74 73 20 66 6f 72 20 76 61 the units for va
1320: 6c 75 65 2c 20 65 78 70 65 63 74 65 64 5f 76 61 lue, expected_va
1330: 6c 75 65 20 65 74 63 2e 20 28 6f 70 74 69 6f 6e lue etc. (option
1340: 61 6c 29 0a 20 20 2d 6c 6f 61 64 2d 74 65 73 74 al). -load-test
1350: 2d 64 61 74 61 20 20 20 20 20 20 20 20 20 3a 20 -data :
1360: 72 65 61 64 20 74 65 73 74 20 73 70 65 63 69 66 read test specif
1370: 69 63 20 64 61 74 61 20 66 6f 72 20 73 74 6f 72 ic data for stor
1380: 61 67 65 20 69 6e 20 74 68 65 20 74 65 73 74 5f age in the test_
1390: 64 61 74 61 20 74 61 62 6c 65 0a 20 20 20 20 20 data table.
13a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13b0: 20 20 20 20 20 20 20 66 72 6f 6d 20 73 74 61 6e from stan
13c0: 64 61 72 64 20 69 6e 2e 20 45 61 63 68 20 6c 69 dard in. Each li
13d0: 6e 65 20 69 73 20 63 6f 6d 6d 61 20 64 65 6c 69 ne is comma deli
13e0: 6d 69 74 65 64 20 77 69 74 68 20 66 6f 75 72 0a mited with four.
13f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1400: 20 20 20 20 20 20 20 20 20 20 20 20 66 69 65 6c fiel
1410: 64 73 20 63 61 74 65 67 6f 72 79 2c 76 61 72 69 ds category,vari
1420: 61 62 6c 65 2c 76 61 6c 75 65 2c 63 6f 6d 6d 65 able,value,comme
1430: 6e 74 0a 0a 51 75 65 72 69 65 73 0a 20 20 2d 6c nt..Queries. -l
1440: 69 73 74 2d 72 75 6e 73 20 70 61 74 74 20 20 20 ist-runs patt
1450: 20 20 20 20 20 20 3a 20 6c 69 73 74 20 72 75 6e : list run
1460: 73 20 6d 61 74 63 68 69 6e 67 20 70 61 74 74 65 s matching patte
1470: 72 6e 20 5c 22 70 61 74 74 5c 22 2c 20 25 20 69 rn \"patt\", % i
1480: 73 20 74 68 65 20 77 69 6c 64 63 61 72 64 0a 20 s the wildcard.
1490: 20 2d 73 68 6f 77 2d 6b 65 79 73 20 20 20 20 20 -show-keys
14a0: 20 20 20 20 20 20 20 20 20 3a 20 73 68 6f 77 20 : show
14b0: 74 68 65 20 6b 65 79 73 20 75 73 65 64 20 69 6e the keys used in
14c0: 20 74 68 69 73 20 6d 65 67 61 74 65 73 74 20 73 this megatest s
14d0: 65 74 75 70 0a 20 20 2d 74 65 73 74 2d 66 69 6c etup. -test-fil
14e0: 65 73 20 74 61 72 67 70 61 74 74 20 20 20 20 3a es targpatt :
14f0: 20 67 65 74 20 74 68 65 20 6d 6f 73 74 20 72 65 get the most re
1500: 63 65 6e 74 20 74 65 73 74 20 70 61 74 68 2f 66 cent test path/f
1510: 69 6c 65 20 6d 61 74 63 68 69 6e 67 20 74 61 72 ile matching tar
1520: 67 70 61 74 74 20 65 2e 67 2e 20 25 2f 25 2e 2e gpatt e.g. %/%..
1530: 2e 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 . .
1540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
1550: 65 74 75 72 6e 73 20 6c 69 73 74 20 73 6f 72 74 eturns list sort
1560: 65 64 20 62 79 20 61 67 65 20 61 73 63 65 6e 64 ed by age ascend
1570: 69 6e 67 2c 20 73 65 65 20 65 78 61 6d 70 6c 65 ing, see example
1580: 73 20 62 65 6c 6f 77 0a 20 20 2d 74 65 73 74 2d s below. -test-
1590: 70 61 74 68 73 20 20 20 20 20 20 20 20 20 20 20 paths
15a0: 20 20 3a 20 67 65 74 20 74 68 65 20 74 65 73 74 : get the test
15b0: 20 70 61 74 68 73 20 6d 61 74 63 68 69 6e 67 20 paths matching
15c0: 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c target, runname,
15d0: 20 69 74 65 6d 20 61 6e 64 20 74 65 73 74 0a 20 item and test.
15e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15f0: 20 20 20 20 20 20 20 20 20 20 20 70 61 74 74 65 patte
1600: 72 6e 73 2e 0a 20 20 2d 6c 69 73 74 2d 64 69 73 rns.. -list-dis
1610: 6b 73 20 20 20 20 20 20 20 20 20 20 20 20 20 3a ks :
1620: 20 6c 69 73 74 20 74 68 65 20 64 69 73 6b 73 20 list the disks
1630: 61 76 61 69 6c 61 62 6c 65 20 66 6f 72 20 73 74 available for st
1640: 6f 72 69 6e 67 20 72 75 6e 73 0a 20 20 2d 6c 69 oring runs. -li
1650: 73 74 2d 74 61 72 67 65 74 73 20 20 20 20 20 20 st-targets
1660: 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 65 20 : list the
1670: 74 61 72 67 65 74 73 20 69 6e 20 72 75 6e 63 6f targets in runco
1680: 6e 66 69 67 73 2e 63 6f 6e 66 69 67 0a 20 20 2d nfigs.config. -
1690: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 20 list-db-targets
16a0: 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 : list th
16b0: 65 20 74 61 72 67 65 74 20 63 6f 6d 62 69 6e 61 e target combina
16c0: 74 69 6f 6e 73 20 75 73 65 64 20 69 6e 20 74 68 tions used in th
16d0: 65 20 64 62 0a 20 20 2d 73 68 6f 77 2d 63 6f 6e e db. -show-con
16e0: 66 69 67 20 20 20 20 20 20 20 20 20 20 20 20 3a fig :
16f0: 20 64 75 6d 70 20 74 68 65 20 69 6e 74 65 72 6e dump the intern
1700: 61 6c 20 72 65 70 72 65 73 65 6e 74 61 74 69 6f al representatio
1710: 6e 20 6f 66 20 74 68 65 20 6d 65 67 61 74 65 73 n of the megates
1720: 74 2e 63 6f 6e 66 69 67 20 66 69 6c 65 0a 20 20 t.config file.
1730: 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 20 -show-runconfig
1740: 20 20 20 20 20 20 20 20 3a 20 64 75 6d 70 20 74 : dump t
1750: 68 65 20 69 6e 74 65 72 6e 61 6c 20 72 65 70 72 he internal repr
1760: 65 73 65 6e 74 61 74 69 6f 6e 20 6f 66 20 74 68 esentation of th
1770: 65 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e e runconfigs.con
1780: 66 69 67 20 66 69 6c 65 0a 20 20 2d 64 75 6d 70 fig file. -dump
1790: 6d 6f 64 65 20 4d 4f 44 45 20 20 20 20 20 20 20 mode MODE
17a0: 20 20 20 3a 20 64 75 6d 70 20 69 6e 20 4d 4f 44 : dump in MOD
17b0: 45 20 66 6f 72 6d 61 74 20 69 6e 73 74 65 61 64 E format instead
17c0: 20 6f 66 20 73 65 78 70 72 2c 20 4d 4f 44 45 3d of sexpr, MODE=
17d0: 6a 73 6f 6e 2c 69 6e 69 2c 73 65 78 70 20 65 74 json,ini,sexp et
17e0: 63 2e 0a 20 20 2d 73 68 6f 77 2d 63 6d 64 69 6e c.. -show-cmdin
17f0: 66 6f 20 20 20 20 20 20 20 20 20 20 20 3a 20 64 fo : d
1800: 75 6d 70 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 ump the command
1810: 69 6e 66 6f 20 66 6f 72 20 61 20 74 65 73 74 20 info for a test
1820: 28 72 75 6e 20 69 6e 20 74 65 73 74 20 65 6e 76 (run in test env
1830: 69 72 6f 6e 6d 65 6e 74 29 0a 20 20 2d 73 65 63 ironment). -sec
1840: 74 69 6f 6e 20 73 65 63 74 69 6f 6e 4e 61 6d 65 tion sectionName
1850: 0a 20 20 2d 76 61 72 20 76 61 72 4e 61 6d 65 20 . -var varName
1860: 20 20 20 20 20 20 20 20 20 20 20 3a 20 66 6f 72 : for
1870: 20 63 6f 6e 66 69 67 20 61 6e 64 20 72 75 6e 63 config and runc
1880: 6f 6e 66 69 67 20 6c 6f 6f 6b 75 70 20 76 61 6c onfig lookup val
1890: 75 65 20 66 6f 72 20 73 65 63 74 69 6f 6e 4e 61 ue for sectionNa
18a0: 6d 65 20 76 61 72 4e 61 6d 65 0a 20 20 2d 73 69 me varName. -si
18b0: 6e 63 65 20 4e 20 20 20 20 20 20 20 20 20 20 20 nce N
18c0: 20 20 20 20 20 3a 20 67 65 74 20 6c 69 73 74 20 : get list
18d0: 6f 66 20 72 75 6e 73 20 63 68 61 6e 67 65 64 20 of runs changed
18e0: 73 69 6e 63 65 20 74 69 6d 65 20 4e 20 28 55 6e since time N (Un
18f0: 69 78 20 73 65 63 6f 6e 64 73 29 0a 20 20 2d 66 ix seconds). -f
1900: 69 65 6c 64 73 20 66 69 65 6c 64 73 70 65 63 20 ields fieldspec
1910: 20 20 20 20 20 20 3a 20 66 69 65 6c 64 73 20 74 : fields t
1920: 6f 20 69 6e 63 6c 75 64 65 20 69 6e 20 6a 73 6f o include in jso
1930: 6e 20 64 75 6d 70 3b 20 72 75 6e 73 3a 69 64 2c n dump; runs:id,
1940: 72 75 6e 61 6d 65 2b 74 65 73 74 73 3a 74 65 73 runame+tests:tes
1950: 74 6e 61 6d 65 2b 73 74 65 70 73 0a 20 20 2d 73 tname+steps. -s
1960: 6f 72 74 20 66 69 65 6c 64 6e 61 6d 65 20 20 20 ort fieldname
1970: 20 20 20 20 20 20 3a 20 69 6e 20 2d 6c 69 73 74 : in -list
1980: 2d 72 75 6e 73 20 73 6f 72 74 20 74 65 73 74 73 -runs sort tests
1990: 20 62 79 20 74 68 69 73 20 66 69 65 6c 64 0a 0a by this field..
19a0: 4d 69 73 63 20 0a 20 20 2d 73 74 61 72 74 2d 64 Misc . -start-d
19b0: 69 72 20 70 61 74 68 20 20 20 20 20 20 20 20 20 ir path
19c0: 3a 20 73 77 69 74 63 68 20 74 6f 20 74 68 69 73 : switch to this
19d0: 20 64 69 72 65 63 74 6f 72 79 20 62 65 66 6f 72 directory befor
19e0: 65 20 72 75 6e 6e 69 6e 67 20 6d 65 67 61 74 65 e running megate
19f0: 73 74 0a 20 20 2d 72 65 62 75 69 6c 64 2d 64 62 st. -rebuild-db
1a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 62 : b
1a10: 72 69 6e 67 20 74 68 65 20 64 61 74 61 62 61 73 ring the databas
1a20: 65 20 73 63 68 65 6d 61 20 75 70 20 74 6f 20 64 e schema up to d
1a30: 61 74 65 0a 20 20 2d 63 6c 65 61 6e 75 70 2d 64 ate. -cleanup-d
1a40: 62 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 b :
1a50: 72 65 6d 6f 76 65 20 61 6e 79 20 6f 72 70 68 61 remove any orpha
1a60: 6e 20 72 65 63 6f 72 64 73 2c 20 76 61 63 75 75 n records, vacuu
1a70: 6d 20 74 68 65 20 64 62 0a 20 20 2d 69 6d 70 6f m the db. -impo
1a80: 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 20 20 rt-megatest.db
1a90: 20 20 20 3a 20 6d 69 67 72 61 74 65 20 61 20 64 : migrate a d
1aa0: 61 74 61 62 61 73 65 20 66 72 6f 6d 20 76 31 2e atabase from v1.
1ab0: 35 35 20 73 65 72 69 65 73 20 74 6f 20 76 31 2e 55 series to v1.
1ac0: 36 30 20 73 65 72 69 65 73 0a 20 20 2d 73 79 6e 60 series. -syn
1ad0: 63 2d 74 6f 2d 6d 65 67 61 74 65 73 74 2e 64 62 c-to-megatest.db
1ae0: 20 20 20 20 3a 20 6d 69 67 72 61 74 65 20 64 61 : migrate da
1af0: 74 61 20 62 61 63 6b 20 74 6f 20 6d 65 67 61 74 ta back to megat
1b00: 65 73 74 2e 64 62 0a 20 20 2d 75 70 64 61 74 65 est.db. -update
1b10: 2d 6d 65 74 61 20 20 20 20 20 20 20 20 20 20 20 -meta
1b20: 20 3a 20 75 70 64 61 74 65 20 74 68 65 20 74 65 : update the te
1b30: 73 74 73 20 6d 65 74 61 64 61 74 61 20 66 6f 72 sts metadata for
1b40: 20 61 6c 6c 20 74 65 73 74 73 0a 20 20 2d 73 65 all tests. -se
1b50: 74 76 61 72 73 20 56 41 52 31 3d 76 61 6c 31 2c tvars VAR1=val1,
1b60: 56 41 52 32 3d 76 61 6c 32 20 3a 20 41 64 64 20 VAR2=val2 : Add
1b70: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 environment vari
1b80: 61 62 6c 65 73 20 74 6f 20 61 20 72 75 6e 20 4e ables to a run N
1b90: 42 2f 2f 20 74 68 65 73 65 20 61 72 65 0a 20 20 B// these are.
1ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6f o
1bc0: 76 65 72 77 72 69 74 74 65 6e 20 62 79 20 76 61 verwritten by va
1bd0: 6c 75 65 73 20 73 65 74 20 69 6e 20 63 6f 6e 66 lues set in conf
1be0: 69 67 20 66 69 6c 65 73 2e 0a 20 20 2d 73 65 72 ig files.. -ser
1bf0: 76 65 72 20 2d 7c 68 6f 73 74 6e 61 6d 65 20 20 ver -|hostname
1c00: 20 20 20 20 3a 20 73 74 61 72 74 20 74 68 65 20 : start the
1c10: 73 65 72 76 65 72 20 28 72 65 64 75 63 65 73 20 server (reduces
1c20: 63 6f 6e 74 65 6e 74 69 6f 6e 20 6f 6e 20 6d 65 contention on me
1c30: 67 61 74 65 73 74 2e 64 62 29 2c 20 75 73 65 0a gatest.db), use.
1c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c50: 20 20 20 20 20 20 20 20 20 20 20 20 2d 20 74 6f - to
1c60: 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c 79 20 66 automatically f
1c70: 69 67 75 72 65 20 6f 75 74 20 68 6f 73 74 6e 61 igure out hostna
1c80: 6d 65 0a 20 20 2d 74 72 61 6e 73 70 6f 72 74 20 me. -transport
1c90: 68 74 74 70 7c 72 70 63 20 20 20 20 20 3a 20 75 http|rpc : u
1ca0: 73 65 20 68 74 74 70 20 6f 72 20 72 70 63 20 66 se http or rpc f
1cb0: 6f 72 20 74 72 61 6e 73 70 6f 72 74 20 28 64 65 or transport (de
1cc0: 66 61 75 6c 74 20 69 73 20 68 74 74 70 29 20 0a fault is http) .
1cd0: 20 20 2d 64 61 65 6d 6f 6e 69 7a 65 20 20 20 20 -daemonize
1ce0: 20 20 20 20 20 20 20 20 20 20 3a 20 66 6f 72 6b : fork
1cf0: 20 69 6e 74 6f 20 62 61 63 6b 67 72 6f 75 6e 64 into background
1d00: 20 61 6e 64 20 64 69 73 63 6f 6e 6e 65 63 74 20 and disconnect
1d10: 66 72 6f 6d 20 73 74 64 69 6e 2f 6f 75 74 0a 20 from stdin/out.
1d20: 20 2d 6c 6f 67 20 6c 6f 67 66 69 6c 65 20 20 20 -log logfile
1d30: 20 20 20 20 20 20 20 20 20 3a 20 73 65 6e 64 20 : send
1d40: 73 74 64 6f 75 74 20 61 6e 64 20 73 74 64 65 72 stdout and stder
1d50: 72 20 74 6f 20 6c 6f 67 66 69 6c 65 0a 20 20 2d r to logfile. -
1d60: 6c 69 73 74 2d 73 65 72 76 65 72 73 20 20 20 20 list-servers
1d70: 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 : list th
1d80: 65 20 73 65 72 76 65 72 73 20 0a 20 20 2d 73 74 e servers . -st
1d90: 6f 70 2d 73 65 72 76 65 72 20 69 64 20 20 20 20 op-server id
1da0: 20 20 20 20 20 3a 20 73 74 6f 70 20 73 65 72 76 : stop serv
1db0: 65 72 20 73 70 65 63 69 66 69 65 64 20 62 79 20 er specified by
1dc0: 69 64 20 28 73 65 65 20 6f 75 74 70 75 74 20 6f id (see output o
1dd0: 66 20 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 29 f -list-servers)
1de0: 2c 20 75 73 65 0a 20 20 20 20 20 20 20 20 20 20 , use.
1df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e00: 20 20 30 20 74 6f 20 6b 69 6c 6c 20 61 6c 6c 0a 0 to kill all.
1e10: 20 20 2d 72 65 70 6c 20 20 20 20 20 20 20 20 20 -repl
1e20: 20 20 20 20 20 20 20 20 20 20 3a 20 73 74 61 72 : star
1e30: 74 20 61 20 72 65 70 6c 20 28 75 73 65 66 75 6c t a repl (useful
1e40: 20 66 6f 72 20 65 78 74 65 6e 64 69 6e 67 20 6d for extending m
1e50: 65 67 61 74 65 73 74 29 0a 20 20 2d 6c 6f 61 64 egatest). -load
1e60: 20 66 69 6c 65 2e 73 63 6d 20 20 20 20 20 20 20 file.scm
1e70: 20 20 20 3a 20 6c 6f 61 64 20 61 6e 64 20 72 75 : load and ru
1e80: 6e 20 66 69 6c 65 2e 73 63 6d 0a 20 20 2d 6d 61 n file.scm. -ma
1e90: 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 20 20 rk-incompletes
1ea0: 20 20 20 20 20 3a 20 66 69 6e 64 20 61 6e 64 20 : find and
1eb0: 6d 61 72 6b 20 69 6e 63 6f 6d 70 6c 65 74 65 20 mark incomplete
1ec0: 74 65 73 74 73 0a 20 20 2d 70 69 6e 67 20 72 75 tests. -ping ru
1ed0: 6e 2d 69 64 7c 68 6f 73 74 3a 70 6f 72 74 20 20 n-id|host:port
1ee0: 3a 20 70 69 6e 67 20 73 65 72 76 65 72 2c 20 65 : ping server, e
1ef0: 78 69 74 20 77 69 74 68 20 30 20 69 66 20 66 6f xit with 0 if fo
1f00: 75 6e 64 0a 20 20 2d 64 65 62 75 67 20 4e 7c 4e und. -debug N|N
1f10: 2c 4d 2c 4f 2e 2e 2e 20 20 20 20 20 20 20 3a 20 ,M,O... :
1f20: 65 6e 61 62 6c 65 20 64 65 62 75 67 20 30 2d 4e enable debug 0-N
1f30: 20 6f 72 20 4e 20 61 6e 64 20 4d 20 61 6e 64 20 or N and M and
1f40: 4f 20 2e 2e 2e 0a 0a 55 74 69 6c 69 74 69 65 73 O .....Utilities
1f50: 0a 20 20 2d 65 6e 76 32 66 69 6c 65 20 66 6e 61 . -env2file fna
1f60: 6d 65 20 20 20 20 20 20 20 20 20 3a 20 77 72 69 me : wri
1f70: 74 65 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 te the environme
1f80: 6e 74 20 74 6f 20 66 6e 61 6d 65 2e 63 73 68 20 nt to fname.csh
1f90: 61 6e 64 20 66 6e 61 6d 65 2e 73 68 0a 20 20 2d and fname.sh. -
1fa0: 65 6e 76 63 61 70 20 66 6e 61 6d 65 3d 63 6f 6e envcap fname=con
1fb0: 74 65 78 74 20 20 20 3a 20 73 61 76 65 20 63 75 text : save cu
1fc0: 72 72 65 6e 74 20 76 61 72 69 61 62 6c 65 73 20 rrent variables
1fd0: 6c 61 62 65 6c 65 64 20 61 73 20 63 6f 6e 74 65 labeled as conte
1fe0: 78 74 20 69 6e 20 66 69 6c 65 20 66 6e 61 6d 65 xt in file fname
1ff0: 0a 20 20 2d 72 65 66 64 62 32 64 61 74 20 72 65 . -refdb2dat re
2000: 66 64 62 20 20 20 20 20 20 20 20 3a 20 63 6f 6e fdb : con
2010: 76 65 72 74 20 72 65 66 64 62 20 74 6f 20 73 65 vert refdb to se
2020: 78 70 20 6f 72 20 74 6f 20 66 6f 72 6d 61 74 20 xp or to format
2030: 73 70 65 63 69 66 69 65 64 20 62 79 20 2d 64 75 specified by -du
2040: 6d 70 6d 6f 64 65 0a 20 20 20 20 20 20 20 20 20 mpmode.
2050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2060: 20 20 20 66 6f 72 6d 61 74 73 3a 20 70 65 72 6c formats: perl
2070: 2c 20 72 75 62 79 2c 20 73 71 6c 69 74 65 33 2c , ruby, sqlite3,
2080: 20 63 73 76 20 28 66 6f 72 20 63 73 76 20 74 68 csv (for csv th
2090: 65 20 2d 6f 20 70 61 72 61 6d 0a 20 20 20 20 20 e -o param.
20a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20b0: 20 20 20 20 20 20 20 77 69 6c 6c 20 73 75 62 73 will subs
20c0: 74 69 74 75 74 65 20 25 73 20 66 6f 72 20 74 68 titute %s for th
20d0: 65 20 73 68 65 65 74 20 6e 61 6d 65 20 69 6e 20 e sheet name in
20e0: 67 65 6e 65 72 61 74 69 6e 67 20 0a 20 20 20 20 generating .
20f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2100: 20 20 20 20 20 20 20 20 6d 75 6c 74 69 70 6c 65 multiple
2110: 20 73 68 65 65 74 73 29 0a 20 20 2d 6f 20 20 20 sheets). -o
2120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2130: 20 20 20 3a 20 6f 75 74 70 75 74 20 66 69 6c 65 : output file
2140: 20 66 6f 72 20 72 65 66 64 62 32 64 61 74 20 28 for refdb2dat (
2150: 64 65 66 61 75 6c 74 73 20 74 6f 20 73 74 64 6f defaults to stdo
2160: 75 74 29 0a 20 20 2d 61 72 63 68 69 76 65 20 63 ut). -archive c
2170: 6d 64 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 md :
2180: 61 72 63 68 69 76 65 20 72 75 6e 73 20 73 70 65 archive runs spe
2190: 63 69 66 69 65 64 20 62 79 20 73 65 6c 65 63 74 cified by select
21a0: 6f 72 73 20 74 6f 20 6f 6e 65 20 6f 66 20 64 69 ors to one of di
21b0: 73 6b 73 20 73 70 65 63 69 66 69 65 64 0a 20 20 sks specified.
21c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21d0: 20 20 20 20 20 20 20 20 20 20 69 6e 20 74 68 65 in the
21e0: 20 5b 61 72 63 68 69 76 65 2d 64 69 73 6b 73 5d [archive-disks]
21f0: 20 73 65 63 74 69 6f 6e 2e 0a 20 20 20 20 20 20 section..
2200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2210: 20 20 20 20 20 20 63 6d 64 3a 20 6b 65 65 70 2d cmd: keep-
2220: 68 74 6d 6c 2c 20 72 65 73 74 6f 72 65 2c 20 73 html, restore, s
2230: 61 76 65 2c 20 73 61 76 65 2d 72 65 6d 6f 76 65 ave, save-remove
2240: 0a 20 20 2d 67 65 6e 65 72 61 74 65 2d 68 74 6d . -generate-htm
2250: 6c 20 20 20 20 20 20 20 20 20 20 3a 20 63 72 65 l : cre
2260: 61 74 65 20 61 20 73 69 6d 70 6c 65 20 68 74 6d ate a simple htm
2270: 6c 20 74 72 65 65 20 66 6f 72 20 62 72 6f 77 73 l tree for brows
2280: 69 6e 67 20 79 6f 75 72 20 72 75 6e 73 0a 0a 53 ing your runs..S
2290: 70 72 65 61 64 73 68 65 65 74 20 67 65 6e 65 72 preadsheet gener
22a0: 61 74 69 6f 6e 0a 20 20 2d 65 78 74 72 61 63 74 ation. -extract
22b0: 2d 6f 64 73 20 66 6e 61 6d 65 2e 6f 64 73 20 20 -ods fname.ods
22c0: 3a 20 65 78 74 72 61 63 74 20 61 6e 20 6f 70 65 : extract an ope
22d0: 6e 20 64 6f 63 75 6d 65 6e 74 20 73 70 72 65 61 n document sprea
22e0: 64 73 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 dsheet from the
22f0: 64 61 74 61 62 61 73 65 0a 20 20 2d 70 61 74 68 database. -path
2300: 6d 6f 64 20 70 61 74 68 20 20 20 20 20 20 20 20 mod path
2310: 20 20 20 3a 20 69 6e 73 65 72 74 20 70 61 74 68 : insert path
2320: 2c 20 69 2e 65 2e 20 70 61 74 68 2f 72 75 6e 61 , i.e. path/runa
2330: 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 me/itempath/logf
2340: 69 6c 65 2e 68 74 6d 6c 0a 20 20 20 20 20 20 20 ile.html.
2350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2360: 20 20 20 20 20 77 69 6c 6c 20 63 6c 65 61 72 20 will clear
2370: 74 68 65 20 66 69 65 6c 64 20 69 66 20 6e 6f 20 the field if no
2380: 72 75 6e 64 69 72 2f 74 65 73 74 6e 61 6d 65 2f rundir/testname/
2390: 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 69 6c 65 itempath/logfile
23a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
23b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 if
23c0: 69 74 20 63 6f 6e 74 61 69 6e 73 20 66 6f 72 77 it contains forw
23d0: 61 72 64 20 73 6c 61 73 68 65 73 20 74 68 65 20 ard slashes the
23e0: 70 61 74 68 20 77 69 6c 6c 20 62 65 20 63 6f 6e path will be con
23f0: 76 65 72 74 65 64 0a 20 20 20 20 20 20 20 20 20 verted.
2400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2410: 20 20 20 74 6f 20 77 69 6e 64 6f 77 73 20 73 74 to windows st
2420: 79 6c 65 0a 47 65 74 74 69 6e 67 20 73 74 61 72 yle.Getting star
2430: 74 65 64 0a 20 20 2d 63 72 65 61 74 65 2d 6d 65 ted. -create-me
2440: 67 61 74 65 73 74 2d 61 72 65 61 20 20 20 20 20 gatest-area
2450: 20 20 3a 20 63 72 65 61 74 65 20 61 20 73 6b 65 : create a ske
2460: 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 74 20 61 leton megatest a
2470: 72 65 61 2e 20 59 6f 75 20 77 69 6c 6c 20 62 65 rea. You will be
2480: 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 20 70 61 prompted for pa
2490: 74 68 73 0a 20 20 2d 63 72 65 61 74 65 2d 74 65 ths. -create-te
24a0: 73 74 20 74 65 73 74 6e 61 6d 65 20 20 20 20 20 st testname
24b0: 20 20 3a 20 63 72 65 61 74 65 20 61 20 73 6b 65 : create a ske
24c0: 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 74 20 74 leton megatest t
24d0: 65 73 74 2e 20 59 6f 75 20 77 69 6c 6c 20 62 65 est. You will be
24e0: 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 20 69 6e prompted for in
24f0: 66 6f 0a 0a 45 78 61 6d 70 6c 65 73 0a 0a 23 20 fo..Examples..#
2500: 47 65 74 20 74 65 73 74 20 70 61 74 68 2c 20 75 Get test path, u
2510: 73 65 20 27 2e 27 20 74 6f 20 67 65 74 20 61 20 se '.' to get a
2520: 73 69 6e 67 6c 65 20 70 61 74 68 20 6f 72 20 61 single path or a
2530: 20 73 70 65 63 69 66 69 63 20 70 61 74 68 2f 66 specific path/f
2540: 69 6c 65 20 70 61 74 74 65 72 6e 0a 6d 65 67 61 ile pattern.mega
2550: 74 65 73 74 20 2d 74 65 73 74 2d 66 69 6c 65 73 test -test-files
2560: 20 27 6c 6f 67 73 2f 2a 2e 6c 6f 67 27 20 2d 74 'logs/*.log' -t
2570: 61 72 67 65 74 20 75 62 75 6e 74 75 2f 6e 25 2f arget ubuntu/n%/
2580: 6e 6f 25 20 2d 72 75 6e 6e 61 6d 65 20 77 34 39 no% -runname w49
2590: 25 20 2d 74 65 73 74 70 61 74 74 20 74 65 73 74 % -testpatt test
25a0: 5f 6d 74 25 0a 0a 43 61 6c 6c 65 64 20 61 73 20 _mt%..Called as
25b0: 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 " (string-inters
25c0: 70 65 72 73 65 20 28 61 72 67 76 29 20 22 20 22 perse (argv) " "
25d0: 29 20 22 0a 56 65 72 73 69 6f 6e 20 22 20 6d 65 ) ".Version " me
25e0: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 gatest-version "
25f0: 2c 20 62 75 69 6c 74 20 66 72 6f 6d 20 22 20 6d , built from " m
2600: 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 egatest-fossil-h
2610: 61 73 68 20 29 29 0a 0a 3b 3b 20 20 2d 67 75 69 ash ))..;; -gui
2620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2630: 20 20 20 20 3a 20 73 74 61 72 74 20 61 20 67 75 : start a gu
2640: 69 20 69 6e 74 65 72 66 61 63 65 0a 3b 3b 20 20 i interface.;;
2650: 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 20 20 -config fname
2660: 20 20 20 20 20 20 20 20 3a 20 6f 76 65 72 72 69 : overri
2670: 64 65 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 de the runconfig
2680: 20 66 69 6c 65 20 77 69 74 68 20 66 6e 61 6d 65 file with fname
2690: 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 20 61 72 67 ..;; process arg
26a0: 73 0a 28 64 65 66 69 6e 65 20 72 65 6d 61 72 67 s.(define remarg
26b0: 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 73 s (args:get-args
26c0: 20 0a 09 09 20 28 61 72 67 76 29 0a 09 09 20 28 ... (argv)... (
26d0: 6c 69 73 74 20 20 22 2d 72 75 6e 74 65 73 74 73 list "-runtests
26e0: 22 20 20 3b 3b 20 72 75 6e 20 61 20 73 70 65 63 " ;; run a spec
26f0: 69 66 69 63 20 74 65 73 74 0a 09 09 09 22 2d 63 ific test...."-c
2700: 6f 6e 66 69 67 22 20 20 20 20 3b 3b 20 6f 76 65 onfig" ;; ove
2710: 72 72 69 64 65 20 74 68 65 20 63 6f 6e 66 69 67 rride the config
2720: 20 66 69 6c 65 20 6e 61 6d 65 0a 09 09 09 22 2d file name...."-
2730: 65 78 65 63 75 74 65 22 20 20 20 3b 3b 20 72 75 execute" ;; ru
2740: 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 65 6e n the command en
2750: 63 6f 64 65 64 20 69 6e 20 74 68 65 20 62 61 73 coded in the bas
2760: 65 36 34 20 70 61 72 61 6d 65 74 65 72 0a 09 09 e64 parameter...
2770: 09 22 2d 73 74 65 70 22 0a 09 09 09 22 2d 74 61 ."-step"...."-ta
2780: 72 67 65 74 22 0a 09 09 09 22 2d 72 65 71 74 61 rget"...."-reqta
2790: 72 67 22 0a 09 09 09 22 3a 72 75 6e 6e 61 6d 65 rg"....":runname
27a0: 22 0a 09 09 09 22 2d 72 75 6e 6e 61 6d 65 22 0a "...."-runname".
27b0: 09 09 09 22 3a 73 74 61 74 65 22 20 20 0a 09 09 ...":state" ...
27c0: 09 22 2d 73 74 61 74 65 22 0a 09 09 09 22 3a 73 ."-state"....":s
27d0: 74 61 74 75 73 22 0a 09 09 09 22 2d 73 74 61 74 tatus"...."-stat
27e0: 75 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d 72 75 us"...."-list-ru
27f0: 6e 73 22 0a 09 09 09 22 2d 74 65 73 74 70 61 74 ns"...."-testpat
2800: 74 22 20 0a 09 09 09 22 2d 69 74 65 6d 70 61 74 t" ...."-itempat
2810: 74 22 0a 09 09 09 22 2d 73 65 74 6c 6f 67 22 0a t"...."-setlog".
2820: 09 09 09 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 ..."-set-toplog"
2830: 0a 09 09 09 22 2d 72 75 6e 73 74 65 70 22 0a 09 ...."-runstep"..
2840: 09 09 22 2d 6c 6f 67 70 72 6f 22 0a 09 09 09 22 .."-logpro"...."
2850: 2d 6d 22 0a 09 09 09 22 2d 72 65 72 75 6e 22 0a -m"...."-rerun".
2860: 09 09 09 22 2d 64 61 79 73 22 0a 09 09 09 22 2d ..."-days"...."-
2870: 72 65 6e 61 6d 65 2d 72 75 6e 22 0a 09 09 09 22 rename-run"...."
2880: 2d 74 6f 22 0a 09 09 09 3b 3b 20 76 61 6c 75 65 -to"....;; value
2890: 73 20 61 6e 64 20 6d 65 73 73 61 67 65 73 0a 09 s and messages..
28a0: 09 09 22 3a 63 61 74 65 67 6f 72 79 22 0a 09 09 ..":category"...
28b0: 09 22 3a 76 61 72 69 61 62 6c 65 22 0a 09 09 09 .":variable"....
28c0: 22 3a 76 61 6c 75 65 22 0a 09 09 09 22 3a 65 78 ":value"....":ex
28d0: 70 65 63 74 65 64 22 0a 09 09 09 22 3a 74 6f 6c pected"....":tol
28e0: 22 0a 09 09 09 22 3a 75 6e 69 74 73 22 0a 09 09 "....":units"...
28f0: 09 3b 3b 20 6d 69 73 63 0a 09 09 09 22 2d 73 74 .;; misc...."-st
2900: 61 72 74 2d 64 69 72 22 0a 09 09 09 22 2d 73 65 art-dir"...."-se
2910: 72 76 65 72 22 0a 09 09 09 22 2d 73 74 6f 70 2d rver"...."-stop-
2920: 73 65 72 76 65 72 22 0a 09 09 09 22 2d 74 72 61 server"...."-tra
2930: 6e 73 70 6f 72 74 22 0a 09 09 09 22 2d 6b 69 6c nsport"...."-kil
2940: 6c 2d 73 65 72 76 65 72 22 0a 09 09 09 22 2d 70 l-server"...."-p
2950: 6f 72 74 22 0a 09 09 09 22 2d 65 78 74 72 61 63 ort"...."-extrac
2960: 74 2d 6f 64 73 22 0a 09 09 09 22 2d 70 61 74 68 t-ods"...."-path
2970: 6d 6f 64 22 0a 09 09 09 22 2d 65 6e 76 32 66 69 mod"...."-env2fi
2980: 6c 65 22 0a 09 09 09 22 2d 65 6e 76 63 61 70 22 le"...."-envcap"
2990: 0a 09 09 09 22 2d 65 6e 76 64 65 6c 74 61 22 0a ...."-envdelta".
29a0: 09 09 09 22 2d 73 65 74 76 61 72 73 22 0a 09 09 ..."-setvars"...
29b0: 09 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 ."-set-state-sta
29c0: 74 75 73 22 0a 09 09 09 22 2d 73 65 74 2d 72 75 tus"...."-set-ru
29d0: 6e 2d 73 74 61 74 75 73 22 0a 09 09 09 22 2d 64 n-status"...."-d
29e0: 65 62 75 67 22 20 3b 3b 20 66 6f 72 20 2a 76 65 ebug" ;; for *ve
29f0: 72 62 6f 73 69 74 79 2a 20 3e 20 32 0a 09 09 09 rbosity* > 2....
2a00: 22 2d 63 72 65 61 74 65 2d 74 65 73 74 22 0a 09 "-create-test"..
2a10: 09 09 22 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d .."-override-tim
2a20: 65 6f 75 74 22 0a 09 09 09 22 2d 74 65 73 74 2d eout"...."-test-
2a30: 66 69 6c 65 73 22 20 20 3b 3b 20 2d 74 65 73 74 files" ;; -test
2a40: 2d 70 61 74 68 73 20 69 73 20 66 6f 72 20 6c 69 -paths is for li
2a50: 73 74 69 6e 67 20 61 6c 6c 0a 09 09 09 22 2d 6c sting all...."-l
2a60: 6f 61 64 22 20 20 20 20 20 20 20 20 3b 3b 20 6c oad" ;; l
2a70: 6f 61 64 20 61 6e 64 20 65 78 65 63 74 75 74 65 oad and exectute
2a80: 20 61 20 73 63 68 65 6d 65 20 66 69 6c 65 0a 09 a scheme file..
2a90: 09 09 22 2d 73 65 63 74 69 6f 6e 22 0a 09 09 09 .."-section"....
2aa0: 22 2d 76 61 72 22 0a 09 09 09 22 2d 64 75 6d 70 "-var"...."-dump
2ab0: 6d 6f 64 65 22 0a 09 09 09 22 2d 72 75 6e 2d 69 mode"...."-run-i
2ac0: 64 22 0a 09 09 09 22 2d 70 69 6e 67 22 0a 09 09 d"...."-ping"...
2ad0: 09 22 2d 72 65 66 64 62 32 64 61 74 22 0a 09 09 ."-refdb2dat"...
2ae0: 09 22 2d 6f 22 0a 09 09 09 22 2d 6c 6f 67 22 0a ."-o"...."-log".
2af0: 09 09 09 22 2d 61 72 63 68 69 76 65 22 0a 09 09 ..."-archive"...
2b00: 09 22 2d 73 69 6e 63 65 22 0a 09 09 09 22 2d 66 ."-since"...."-f
2b10: 69 65 6c 64 73 22 0a 09 09 09 22 2d 72 65 63 6f ields"...."-reco
2b20: 76 65 72 2d 74 65 73 74 22 20 3b 3b 20 72 75 6e ver-test" ;; run
2b30: 2d 69 64 2c 74 65 73 74 2d 69 64 20 2d 20 75 73 -id,test-id - us
2b40: 65 64 20 69 6e 74 65 72 6e 61 6c 6c 79 20 74 6f ed internally to
2b50: 20 72 65 63 6f 76 65 72 20 61 20 74 65 73 74 20 recover a test
2b60: 73 74 75 63 6b 20 69 6e 20 52 55 4e 4e 49 4e 47 stuck in RUNNING
2b70: 20 73 74 61 74 65 0a 09 09 09 22 2d 73 6f 72 74 state...."-sort
2b80: 22 0a 09 09 09 29 20 0a 09 09 20 28 6c 69 73 74 "....) ... (list
2b90: 20 20 22 2d 68 22 20 22 2d 68 65 6c 70 22 20 22 "-h" "-help" "
2ba0: 2d 2d 68 65 6c 70 22 0a 09 09 09 22 2d 6d 61 6e --help"...."-man
2bb0: 75 61 6c 22 0a 09 09 09 22 2d 76 65 72 73 69 6f ual"...."-versio
2bc0: 6e 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d 66 n"... "-f
2bd0: 6f 72 63 65 22 0a 09 09 20 20 20 20 20 20 20 20 orce"...
2be0: 22 2d 78 74 65 72 6d 22 0a 09 09 20 20 20 20 20 "-xterm"...
2bf0: 20 20 20 22 2d 73 68 6f 77 6b 65 79 73 22 0a 09 "-showkeys"..
2c00: 09 20 20 20 20 20 20 20 20 22 2d 73 68 6f 77 2d . "-show-
2c10: 6b 65 79 73 22 0a 09 09 20 20 20 20 20 20 20 20 keys"...
2c20: 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 0a 09 "-test-status"..
2c30: 09 09 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 0a .."-set-values".
2c40: 09 09 09 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 ..."-load-test-d
2c50: 61 74 61 22 0a 09 09 09 22 2d 73 75 6d 6d 61 72 ata"...."-summar
2c60: 69 7a 65 2d 69 74 65 6d 73 22 0a 09 09 20 20 20 ize-items"...
2c70: 20 20 20 20 20 22 2d 67 75 69 22 0a 09 09 09 22 "-gui"...."
2c80: 2d 64 61 65 6d 6f 6e 69 7a 65 22 0a 09 09 09 22 -daemonize"...."
2c90: 2d 70 72 65 63 6c 65 61 6e 22 0a 09 09 09 22 2d -preclean"...."-
2ca0: 72 65 72 75 6e 2d 63 6c 65 61 6e 22 0a 09 09 09 rerun-clean"....
2cb0: 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 0a 09 09 09 "-rerun-all"....
2cc0: 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 22 0a 0a "-clean-cache"..
2cd0: 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 09 22 2d ...;; misc...."-
2ce0: 72 65 70 6c 22 0a 09 09 09 22 2d 6c 6f 63 6b 22 repl"...."-lock"
2cf0: 0a 09 09 09 22 2d 75 6e 6c 6f 63 6b 22 0a 09 09 ...."-unlock"...
2d00: 09 22 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 ."-list-servers"
2d10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2d20: 20 20 20 20 20 20 20 20 20 22 2d 72 75 6e 2d 77 "-run-w
2d30: 61 69 74 22 20 20 20 20 20 20 3b 3b 20 77 61 69 ait" ;; wai
2d40: 74 20 6f 6e 20 61 20 72 75 6e 20 74 6f 20 63 6f t on a run to co
2d50: 6d 70 6c 65 74 65 20 28 69 2e 65 2e 20 6e 6f 20 mplete (i.e. no
2d60: 52 55 4e 4e 49 4e 47 29 0a 09 09 09 22 2d 6c 6f RUNNING)...."-lo
2d70: 63 61 6c 22 20 20 20 20 20 20 20 20 20 3b 3b 20 cal" ;;
2d80: 72 75 6e 20 73 6f 6d 65 20 63 6f 6d 6d 61 6e 64 run some command
2d90: 73 20 75 73 69 6e 67 20 6c 6f 63 61 6c 20 64 62 s using local db
2da0: 20 61 63 63 65 73 73 0a 20 20 20 20 20 20 20 20 access.
2db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2dc0: 22 2d 67 65 6e 65 72 61 74 65 2d 68 74 6d 6c 22 "-generate-html"
2dd0: 0a 0a 09 09 09 3b 3b 20 6d 69 73 63 20 71 75 65 .....;; misc que
2de0: 72 69 65 73 0a 09 09 09 22 2d 6c 69 73 74 2d 64 ries...."-list-d
2df0: 69 73 6b 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d isks"...."-list-
2e00: 74 61 72 67 65 74 73 22 0a 09 09 09 22 2d 6c 69 targets"...."-li
2e10: 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 0a 09 st-db-targets"..
2e20: 09 09 22 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 .."-show-runconf
2e30: 69 67 22 0a 09 09 09 22 2d 73 68 6f 77 2d 63 6f ig"...."-show-co
2e40: 6e 66 69 67 22 0a 09 09 09 22 2d 73 68 6f 77 2d nfig"...."-show-
2e50: 63 6d 64 69 6e 66 6f 22 0a 09 09 09 22 2d 67 65 cmdinfo"...."-ge
2e60: 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 0a 0a 09 t-run-status"...
2e70: 09 09 3b 3b 20 71 75 65 72 69 65 73 0a 09 09 09 ..;; queries....
2e80: 22 2d 74 65 73 74 2d 70 61 74 68 73 22 20 3b 3b "-test-paths" ;;
2e90: 20 67 65 74 20 70 61 74 68 28 73 29 20 74 6f 20 get path(s) to
2ea0: 61 20 74 65 73 74 2c 20 6f 72 64 65 72 65 64 20 a test, ordered
2eb0: 62 79 20 79 6f 75 6e 67 65 73 74 20 66 69 72 73 by youngest firs
2ec0: 74 0a 0a 09 09 09 22 2d 72 75 6e 61 6c 6c 22 20 t....."-runall"
2ed0: 20 20 20 3b 3b 20 72 75 6e 20 61 6c 6c 20 74 65 ;; run all te
2ee0: 73 74 73 2c 20 72 65 73 70 65 63 74 73 20 2d 74 sts, respects -t
2ef0: 65 73 74 70 61 74 74 2c 20 64 65 66 61 75 6c 74 estpatt, default
2f00: 73 20 74 6f 20 25 0a 09 09 09 22 2d 72 75 6e 22 s to %...."-run"
2f10: 20 20 20 20 20 20 20 3b 3b 20 61 6c 69 61 73 20 ;; alias
2f20: 66 6f 72 20 2d 72 75 6e 61 6c 6c 0a 09 09 09 22 for -runall...."
2f30: 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 0a 09 09 -remove-runs"...
2f40: 09 22 2d 72 65 62 75 69 6c 64 2d 64 62 22 0a 09 ."-rebuild-db"..
2f50: 09 09 22 2d 63 6c 65 61 6e 75 70 2d 64 62 22 0a .."-cleanup-db".
2f60: 09 09 09 22 2d 72 6f 6c 6c 75 70 22 0a 09 09 09 ..."-rollup"....
2f70: 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 22 0a 09 "-update-meta"..
2f80: 09 09 22 2d 63 72 65 61 74 65 2d 6d 65 67 61 74 .."-create-megat
2f90: 65 73 74 2d 61 72 65 61 22 0a 09 09 09 22 2d 6d est-area"...."-m
2fa0: 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 22 ark-incompletes"
2fb0: 0a 0a 09 09 09 22 2d 63 6f 6e 76 65 72 74 2d 74 ....."-convert-t
2fc0: 6f 2d 6e 6f 72 6d 22 0a 09 09 09 22 2d 63 6f 6e o-norm"...."-con
2fd0: 76 65 72 74 2d 74 6f 2d 6f 6c 64 22 0a 09 09 09 vert-to-old"....
2fe0: 22 2d 69 6d 70 6f 72 74 2d 6d 65 67 61 74 65 73 "-import-megates
2ff0: 74 2e 64 62 22 0a 09 09 09 22 2d 73 79 6e 63 2d t.db"...."-sync-
3000: 74 6f 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 0a to-megatest.db".
3010: 0a 09 09 09 22 2d 6c 6f 67 67 69 6e 67 22 0a 09 ...."-logging"..
3020: 09 09 22 2d 76 22 20 3b 3b 20 76 65 72 62 6f 73 .."-v" ;; verbos
3030: 65 20 32 2c 20 6d 6f 72 65 20 74 68 61 6e 20 6e e 2, more than n
3040: 6f 72 6d 61 6c 20 28 6e 6f 72 6d 61 6c 20 69 73 ormal (normal is
3050: 20 31 29 0a 09 09 09 22 2d 71 22 20 3b 3b 20 71 1)...."-q" ;; q
3060: 75 69 65 74 20 30 2c 20 65 72 72 6f 72 73 2f 77 uiet 0, errors/w
3070: 61 72 6e 69 6e 67 73 20 6f 6e 6c 79 0a 09 09 20 arnings only...
3080: 20 20 20 20 20 20 29 0a 09 09 20 61 72 67 73 3a )... args:
3090: 61 72 67 2d 68 61 73 68 0a 09 09 20 30 29 29 0a arg-hash... 0)).
30a0: 0a 3b 3b 20 41 64 64 20 61 72 67 73 20 74 68 61 .;; Add args tha
30b0: 74 20 75 73 65 20 72 65 6d 61 72 67 73 20 68 65 t use remargs he
30c0: 72 65 0a 3b 3b 0a 28 69 66 20 28 61 6e 64 20 28 re.;;.(if (and (
30d0: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 not (null? remar
30e0: 67 73 29 29 0a 09 20 28 6e 6f 74 20 28 6f 72 0a gs)).. (not (or.
30f0: 09 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 . (args:ge
3100: 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 t-arg "-runstep"
3110: 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 3a ).. (args:
3120: 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 63 61 70 get-arg "-envcap
3130: 22 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 ").. (args
3140: 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 64 65 :get-arg "-envde
3150: 6c 74 61 22 29 0a 09 20 20 20 20 20 20 20 29 0a lta").. ).
3160: 09 20 20 20 20 20 20 29 29 0a 20 20 20 20 28 64 . )). (d
3170: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
3180: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
3190: 70 6f 72 74 2a 20 22 55 6e 72 65 63 6f 67 6e 69 port* "Unrecogni
31a0: 73 65 64 20 61 72 67 75 6d 65 6e 74 73 3a 20 22 sed arguments: "
31b0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
31c0: 65 72 73 65 20 28 69 66 20 28 6c 69 73 74 3f 20 erse (if (list?
31d0: 72 65 6d 61 72 67 73 29 20 72 65 6d 61 72 67 73 remargs) remargs
31e0: 20 28 61 72 67 76 29 29 20 20 22 20 22 29 29 29 (argv)) " ")))
31f0: 0a 0a 3b 3b 20 69 6d 6d 65 64 69 61 74 65 6c 79 ..;; immediately
3200: 20 73 65 74 20 4d 54 5f 54 41 52 47 45 54 20 69 set MT_TARGET i
3210: 66 20 2d 72 65 71 74 61 72 67 20 6f 72 20 2d 74 f -reqtarg or -t
3220: 61 72 67 65 74 20 61 72 65 20 61 76 61 69 6c 61 arget are availa
3230: 62 6c 65 0a 3b 3b 0a 28 6c 65 74 20 28 28 74 61 ble.;;.(let ((ta
3240: 72 67 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 rg (or (args:get
3250: 2d 61 72 67 20 22 2d 72 65 71 74 61 72 67 22 29 -arg "-reqtarg")
3260: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3270: 74 61 72 67 65 74 22 29 29 29 29 0a 20 20 28 69 target")))). (i
3280: 66 20 74 61 72 67 20 28 73 65 74 65 6e 76 20 22 f targ (setenv "
3290: 4d 54 5f 54 41 52 47 45 54 22 20 74 61 72 67 29 MT_TARGET" targ)
32a0: 29 29 0a 0a 3b 3b 20 54 68 65 20 77 61 74 63 68 ))..;; The watch
32b0: 64 6f 67 20 69 73 20 74 6f 20 6b 65 65 70 20 61 dog is to keep a
32c0: 6e 20 65 79 65 20 6f 6e 20 74 68 69 6e 67 73 20 n eye on things
32d0: 6c 69 6b 65 20 64 62 20 73 79 6e 63 20 65 74 63 like db sync etc
32e0: 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 2a 74 69 ..;;.(define *ti
32f0: 6d 65 2d 7a 65 72 6f 2a 20 28 63 75 72 72 65 6e me-zero* (curren
3300: 74 2d 73 65 63 6f 6e 64 73 29 29 0a 28 64 65 66 t-seconds)).(def
3310: 69 6e 65 20 2a 77 61 74 63 68 64 6f 67 2a 0a 20 ine *watchdog*.
3320: 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 0a 20 (make-thread .
3330: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 (lambda ().
3340: 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
3350: 20 30 2e 30 35 29 20 3b 3b 20 64 65 6c 61 79 20 0.05) ;; delay
3360: 66 6f 72 20 73 74 61 72 74 75 70 0a 20 20 20 20 for startup.
3370: 20 28 6c 65 74 20 28 28 6c 65 67 61 63 79 2d 73 (let ((legacy-s
3380: 79 6e 63 20 28 63 6f 6d 6d 6f 6e 3a 6c 65 67 61 ync (common:lega
3390: 63 79 2d 73 79 6e 63 2d 72 65 71 75 69 72 65 64 cy-sync-required
33a0: 29 29 0a 09 20 20 20 28 64 65 62 75 67 2d 6d 6f )).. (debug-mo
33b0: 64 65 20 20 28 64 65 62 75 67 3a 64 65 62 75 67 de (debug:debug
33c0: 2d 6d 6f 64 65 20 31 29 29 0a 09 20 20 20 28 6c -mode 1)).. (l
33d0: 61 73 74 2d 74 69 6d 65 20 20 20 28 63 75 72 72 ast-time (curr
33e0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 0a 20 ent-seconds))).
33f0: 20 20 20 20 20 20 28 69 66 20 28 63 6f 6d 6d 6f (if (commo
3400: 6e 3a 6c 65 67 61 63 79 2d 73 79 6e 63 2d 72 65 n:legacy-sync-re
3410: 63 6f 6d 6d 65 6e 64 65 64 29 0a 09 20 20 20 28 commended).. (
3420: 6c 65 74 20 6c 6f 6f 70 20 28 29 0a 09 20 20 20 let loop ()..
3430: 20 20 3b 3b 20 73 79 6e 63 20 66 6f 72 20 66 69 ;; sync for fi
3440: 6c 65 73 79 73 74 65 6d 20 6c 6f 63 61 6c 20 64 lesystem local d
3450: 62 20 77 72 69 74 65 73 0a 09 20 20 20 20 20 3b b writes.. ;
3460: 3b 0a 09 20 20 20 20 20 28 6c 65 74 20 28 28 73 ;.. (let ((s
3470: 74 61 72 74 2d 74 69 6d 65 20 20 20 20 20 20 28 tart-time (
3480: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
3490: 29 0a 09 09 20 20 20 28 73 65 72 76 65 72 73 2d )... (servers-
34a0: 73 74 61 72 74 65 64 20 28 6d 61 6b 65 2d 68 61 started (make-ha
34b0: 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 20 20 20 sh-table)))..
34c0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 (for-each ..
34d0: 09 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 .(lambda (run-id
34e0: 29 0a 09 09 20 20 28 6d 75 74 65 78 2d 6c 6f 63 )... (mutex-loc
34f0: 6b 21 20 2a 64 62 2d 6d 75 6c 74 69 2d 73 79 6e k! *db-multi-syn
3500: 63 2d 6d 75 74 65 78 2a 29 0a 09 09 20 20 28 69 c-mutex*)... (i
3510: 66 20 28 61 6e 64 20 6c 65 67 61 63 79 2d 73 79 f (and legacy-sy
3520: 6e 63 20 0a 09 09 09 20 20 20 28 68 61 73 68 2d nc .... (hash-
3530: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
3540: 74 20 2a 64 62 2d 6c 6f 63 61 6c 2d 73 79 6e 63 t *db-local-sync
3550: 2a 20 72 75 6e 2d 69 64 20 23 66 29 29 0a 09 09 * run-id #f))...
3560: 20 20 20 20 20 20 3b 3b 20 28 69 66 20 28 3e 20 ;; (if (>
3570: 28 2d 20 73 74 61 72 74 2d 74 69 6d 65 20 6c 61 (- start-time la
3580: 73 74 2d 77 72 69 74 65 29 20 35 29 20 3b 3b 20 st-write) 5) ;;
3590: 65 76 65 72 79 20 66 69 76 65 20 73 65 63 6f 6e every five secon
35a0: 64 73 0a 09 09 20 20 20 20 20 20 28 62 65 67 69 ds... (begi
35b0: 6e 20 3b 3b 20 6c 65 74 20 28 28 73 79 6e 63 2d n ;; let ((sync-
35c0: 74 69 6d 65 20 28 2d 20 28 63 75 72 72 65 6e 74 time (- (current
35d0: 2d 73 65 63 6f 6e 64 73 29 20 73 74 61 72 74 2d -seconds) start-
35e0: 74 69 6d 65 29 29 29 0a 09 09 09 28 64 62 3a 6d time)))....(db:m
35f0: 75 6c 74 69 2d 64 62 2d 73 79 6e 63 20 28 6c 69 ulti-db-sync (li
3600: 73 74 20 72 75 6e 2d 69 64 29 20 27 6e 65 77 32 st run-id) 'new2
3610: 6f 6c 64 29 0a 09 09 09 28 6c 65 74 20 28 28 73 old)....(let ((s
3620: 79 6e 63 2d 74 69 6d 65 20 28 2d 20 28 63 75 72 ync-time (- (cur
3630: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 73 74 rent-seconds) st
3640: 61 72 74 2d 74 69 6d 65 29 29 29 0a 09 09 09 20 art-time)))....
3650: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
3660: 66 6f 20 33 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 3 *default-lo
3670: 67 2d 70 6f 72 74 2a 20 22 53 79 6e 63 20 6f 66 g-port* "Sync of
3680: 20 6e 65 77 64 62 20 74 6f 20 6f 6c 64 64 62 20 newdb to olddb
3690: 66 6f 72 20 72 75 6e 2d 69 64 20 22 20 72 75 6e for run-id " run
36a0: 2d 69 64 20 22 20 63 6f 6d 70 6c 65 74 65 64 20 -id " completed
36b0: 69 6e 20 22 20 73 79 6e 63 2d 74 69 6d 65 20 22 in " sync-time "
36c0: 20 73 65 63 6f 6e 64 73 22 29 0a 09 09 09 20 20 seconds")....
36d0: 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f 77 2d (if (common:low-
36e0: 6e 6f 69 73 65 2d 70 72 69 6e 74 20 33 30 20 22 noise-print 30 "
36f0: 73 79 6e 63 20 6e 65 77 20 74 6f 20 6f 6c 64 22 sync new to old"
3700: 29 0a 09 09 09 20 20 20 20 20 20 28 64 65 62 75 ).... (debu
3710: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
3720: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
3730: 2a 20 22 53 79 6e 63 20 6f 66 20 6e 65 77 64 62 * "Sync of newdb
3740: 20 74 6f 20 6f 6c 64 64 62 20 66 6f 72 20 72 75 to olddb for ru
3750: 6e 2d 69 64 20 22 20 72 75 6e 2d 69 64 20 22 20 n-id " run-id "
3760: 63 6f 6d 70 6c 65 74 65 64 20 69 6e 20 22 20 73 completed in " s
3770: 79 6e 63 2d 74 69 6d 65 20 22 20 73 65 63 6f 6e ync-time " secon
3780: 64 73 22 29 29 29 0a 09 09 09 3b 3b 20 28 69 66 ds")))....;; (if
3790: 20 28 3e 20 73 79 6e 63 2d 74 69 6d 65 20 31 30 (> sync-time 10
37a0: 29 20 3b 3b 20 74 6f 6f 6b 20 6d 6f 72 65 20 74 ) ;; took more t
37b0: 68 61 6e 20 74 65 6e 20 73 65 63 6f 6e 64 73 2c han ten seconds,
37c0: 20 73 74 61 72 74 20 61 20 73 65 72 76 65 72 20 start a server
37d0: 66 6f 72 20 74 68 69 73 20 72 75 6e 0a 09 09 09 for this run....
37e0: 3b 3b 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ;; (begin...
37f0: 09 3b 3b 20 20 20 20 20 20 20 28 64 65 62 75 67 .;; (debug
3800: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 :print-info 0 *d
3810: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
3820: 20 22 53 79 6e 63 20 69 73 20 74 61 6b 69 6e 67 "Sync is taking
3830: 20 61 20 6c 6f 6e 67 20 74 69 6d 65 2c 20 73 74 a long time, st
3840: 61 72 74 20 75 70 20 61 20 73 65 72 76 65 72 20 art up a server
3850: 74 6f 20 61 73 73 69 73 74 20 66 6f 72 20 72 75 to assist for ru
3860: 6e 20 22 20 72 75 6e 2d 69 64 29 0a 09 09 09 3b n " run-id)....;
3870: 3b 20 20 20 20 20 20 20 28 73 65 72 76 65 72 3a ; (server:
3880: 6b 69 6e 64 2d 72 75 6e 20 72 75 6e 2d 69 64 29 kind-run run-id)
3890: 29 29 29 29 0a 09 09 09 28 68 61 73 68 2d 74 61 ))))....(hash-ta
38a0: 62 6c 65 2d 64 65 6c 65 74 65 21 20 2a 64 62 2d ble-delete! *db-
38b0: 6c 6f 63 61 6c 2d 73 79 6e 63 2a 20 72 75 6e 2d local-sync* run-
38c0: 69 64 29 29 29 0a 09 09 20 20 28 6d 75 74 65 78 id)))... (mutex
38d0: 2d 75 6e 6c 6f 63 6b 21 20 2a 64 62 2d 6d 75 6c -unlock! *db-mul
38e0: 74 69 2d 73 79 6e 63 2d 6d 75 74 65 78 2a 29 29 ti-sync-mutex*))
38f0: 0a 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b ...(hash-table-k
3900: 65 79 73 20 2a 64 62 2d 6c 6f 63 61 6c 2d 73 79 eys *db-local-sy
3910: 6e 63 2a 29 29 0a 09 20 20 20 20 20 20 20 28 69 nc*)).. (i
3920: 66 20 28 61 6e 64 20 64 65 62 75 67 2d 6d 6f 64 f (and debug-mod
3930: 65 0a 09 09 09 28 3e 20 28 2d 20 73 74 61 72 74 e....(> (- start
3940: 2d 74 69 6d 65 20 6c 61 73 74 2d 74 69 6d 65 29 -time last-time)
3950: 20 36 30 29 29 0a 09 09 20 20 20 28 62 65 67 69 60))... (begi
3960: 6e 0a 09 09 20 20 20 20 20 28 73 65 74 21 20 6c n... (set! l
3970: 61 73 74 2d 74 69 6d 65 20 73 74 61 72 74 2d 74 ast-time start-t
3980: 69 6d 65 29 0a 09 09 20 20 20 20 20 28 64 65 62 ime)... (deb
3990: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 ug:print-info 4
39a0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
39b0: 74 2a 20 22 74 69 6d 65 73 74 61 6d 70 20 2d 3e t* "timestamp ->
39c0: 20 22 20 28 73 65 63 6f 6e 64 73 2d 3e 74 69 6d " (seconds->tim
39d0: 65 2d 73 74 72 69 6e 67 20 28 63 75 72 72 65 6e e-string (curren
39e0: 74 2d 73 65 63 6f 6e 64 73 29 29 20 22 2c 20 74 t-seconds)) ", t
39f0: 69 6d 65 20 73 69 6e 63 65 20 73 74 61 72 74 20 ime since start
3a00: 2d 3e 20 22 20 28 73 65 63 6f 6e 64 73 2d 3e 68 -> " (seconds->h
3a10: 72 2d 6d 69 6e 2d 73 65 63 20 28 2d 20 28 63 75 r-min-sec (- (cu
3a20: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 2a rrent-seconds) *
3a30: 74 69 6d 65 2d 7a 65 72 6f 2a 29 29 29 29 29 29 time-zero*))))))
3a40: 0a 09 20 20 20 20 20 0a 09 20 20 20 20 20 3b 3b .. .. ;;
3a50: 20 6b 65 65 70 20 67 6f 69 6e 67 20 75 6e 6c 65 keep going unle
3a60: 73 73 20 74 69 6d 65 20 74 6f 20 65 78 69 74 0a ss time to exit.
3a70: 09 20 20 20 20 20 3b 3b 0a 09 20 20 20 20 20 28 . ;;.. (
3a80: 69 66 20 28 6e 6f 74 20 2a 74 69 6d 65 2d 74 6f if (not *time-to
3a90: 2d 65 78 69 74 2a 29 0a 09 09 20 28 6c 65 74 20 -exit*)... (let
3aa0: 64 65 6c 61 79 2d 6c 6f 6f 70 20 28 28 63 6f 75 delay-loop ((cou
3ab0: 6e 74 20 30 29 29 0a 09 09 20 20 20 28 69 66 20 nt 0))... (if
3ac0: 28 61 6e 64 20 28 6e 6f 74 20 2a 74 69 6d 65 2d (and (not *time-
3ad0: 74 6f 2d 65 78 69 74 2a 29 0a 09 09 09 20 20 20 to-exit*)....
3ae0: 20 28 3c 20 63 6f 75 6e 74 20 31 31 29 29 20 3b (< count 11)) ;
3af0: 3b 20 61 70 72 6f 78 20 35 2d 36 20 73 65 63 6f ; aprox 5-6 seco
3b00: 6e 64 73 0a 09 09 20 20 20 20 20 20 20 28 62 65 nds... (be
3b10: 67 69 6e 0a 09 09 09 20 28 74 68 72 65 61 64 2d gin.... (thread-
3b20: 73 6c 65 65 70 21 20 31 29 0a 09 09 09 20 28 64 sleep! 1).... (d
3b30: 65 6c 61 79 2d 6c 6f 6f 70 20 28 2b 20 63 6f 75 elay-loop (+ cou
3b40: 6e 74 20 31 29 29 29 29 0a 09 09 20 20 20 28 6c nt 1))))... (l
3b50: 6f 6f 70 29 29 29 0a 09 20 20 20 20 20 28 69 66 oop))).. (if
3b60: 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f 77 2d 6e 6f 69 (common:low-noi
3b70: 73 65 2d 70 72 69 6e 74 20 33 30 29 0a 09 09 20 se-print 30)...
3b80: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
3b90: 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 0 *default-log
3ba0: 2d 70 6f 72 74 2a 20 22 45 78 69 74 69 6e 67 20 -port* "Exiting
3bb0: 77 61 74 63 68 64 6f 67 20 74 69 6d 65 72 2c 20 watchdog timer,
3bc0: 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a 20 3d *time-to-exit* =
3bd0: 20 22 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 " *time-to-exit
3be0: 2a 29 29 29 29 29 0a 20 20 20 20 20 22 57 61 74 *))))). "Wat
3bf0: 63 68 64 6f 67 20 74 68 72 65 61 64 22 29 29 29 chdog thread")))
3c00: 0a 0a 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 ..(thread-start!
3c10: 20 2a 77 61 74 63 68 64 6f 67 2a 29 0a 0a 28 69 *watchdog*)..(i
3c20: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
3c30: 22 2d 6c 6f 67 22 29 0a 20 20 20 20 28 6c 65 74 "-log"). (let
3c40: 20 28 28 6f 75 70 20 28 6f 70 65 6e 2d 6f 75 74 ((oup (open-out
3c50: 70 75 74 2d 66 69 6c 65 20 28 61 72 67 73 3a 67 put-file (args:g
3c60: 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 29 29 et-arg "-log")))
3c70: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
3c80: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
3c90: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
3ca0: 53 65 6e 64 69 6e 67 20 6c 6f 67 20 6f 75 74 70 Sending log outp
3cb0: 75 74 20 74 6f 20 22 20 28 61 72 67 73 3a 67 65 ut to " (args:ge
3cc0: 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 29 0a 20 t-arg "-log")).
3cd0: 20 20 20 20 20 28 73 65 74 21 20 2a 64 65 66 61 (set! *defa
3ce0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 6f 75 ult-log-port* ou
3cf0: 70 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 p)))..(if (or (a
3d00: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 22 rgs:get-arg "-h"
3d10: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
3d20: 20 22 2d 68 65 6c 70 22 29 0a 09 28 61 72 67 73 "-help")..(args
3d30: 3a 67 65 74 2d 61 72 67 20 22 2d 2d 68 65 6c 70 :get-arg "--help
3d40: 22 29 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 ")). (begin.
3d50: 20 20 20 20 20 28 70 72 69 6e 74 20 68 65 6c 70 (print help
3d60: 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 29 ). (exit)))
3d70: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
3d80: 61 72 67 20 22 2d 6d 61 6e 75 61 6c 22 29 0a 20 arg "-manual").
3d90: 20 20 20 28 6c 65 74 2a 20 28 28 68 74 6d 6c 76 (let* ((htmlv
3da0: 69 65 77 65 72 63 6d 64 20 28 6f 72 20 28 63 6f iewercmd (or (co
3db0: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f nfigf:lookup *co
3dc0: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
3dd0: 20 22 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 22 "htmlviewercmd"
3de0: 29 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d ).... (comm
3df0: 6f 6e 3a 77 68 69 63 68 20 27 28 22 66 69 72 65 on:which '("fire
3e00: 66 6f 78 22 20 22 61 72 6f 72 61 22 29 29 29 29 fox" "arora"))))
3e10: 0a 09 20 20 20 28 69 6e 73 74 61 6c 6c 2d 68 6f .. (install-ho
3e20: 6d 65 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d me (common:get-
3e30: 69 6e 73 74 61 6c 6c 2d 61 72 65 61 29 29 0a 09 install-area))..
3e40: 20 20 20 28 6d 61 6e 75 61 6c 2d 68 74 6d 6c 20 (manual-html
3e50: 20 20 28 63 6f 6e 63 20 69 6e 73 74 61 6c 6c 2d (conc install-
3e60: 68 6f 6d 65 20 22 2f 73 68 61 72 65 2f 64 6f 63 home "/share/doc
3e70: 73 2f 6d 65 67 61 74 65 73 74 5f 6d 61 6e 75 61 s/megatest_manua
3e80: 6c 2e 68 74 6d 6c 22 29 29 29 0a 20 20 20 20 20 l.html"))).
3e90: 20 28 69 66 20 28 61 6e 64 20 69 6e 73 74 61 6c (if (and instal
3ea0: 6c 2d 68 6f 6d 65 0a 09 20 20 20 20 20 20 20 28 l-home.. (
3eb0: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6d 61 6e file-exists? man
3ec0: 75 61 6c 2d 68 74 6d 6c 29 29 0a 09 20 20 28 73 ual-html)).. (s
3ed0: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 28 22 20 ystem (conc "("
3ee0: 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 22 20 htmlviewercmd "
3ef0: 22 20 6d 61 6e 75 61 6c 2d 68 74 6d 6c 20 22 20 " manual-html "
3f00: 29 20 26 22 29 29 0a 09 20 20 28 73 79 73 74 65 ) &")).. (syste
3f10: 6d 20 28 63 6f 6e 63 20 22 28 22 20 68 74 6d 6c m (conc "(" html
3f20: 76 69 65 77 65 72 63 6d 64 20 22 20 68 74 74 70 viewercmd " http
3f30: 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f ://www.kiatoa.co
3f40: 6d 2f 63 67 69 2d 62 69 6e 2f 66 6f 73 73 69 6c m/cgi-bin/fossil
3f50: 73 2f 6d 65 67 61 74 65 73 74 2f 64 6f 63 2f 74 s/megatest/doc/t
3f60: 69 70 2f 64 6f 63 73 2f 6d 61 6e 75 61 6c 2f 6d ip/docs/manual/m
3f70: 65 67 61 74 65 73 74 5f 6d 61 6e 75 61 6c 2e 68 egatest_manual.h
3f80: 74 6d 6c 20 29 20 26 22 29 29 29 0a 20 20 20 20 tml ) &"))).
3f90: 20 20 28 65 78 69 74 29 29 29 0a 0a 28 69 66 20 (exit)))..(if
3fa0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3fb0: 73 74 61 72 74 2d 64 69 72 22 29 0a 20 20 20 20 start-dir").
3fc0: 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 (if (file-exists
3fd0: 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ? (args:get-arg
3fe0: 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 0a 09 "-start-dir"))..
3ff0: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
4000: 79 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 y (args:get-arg
4010: 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 0a 09 "-start-dir"))..
4020: 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 (begin.. (debug
4030: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
4040: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
4050: 2a 20 22 6e 6f 6e 2d 65 78 69 73 74 61 6e 74 20 * "non-existant
4060: 73 74 61 72 74 20 64 69 72 20 22 20 28 61 72 67 start dir " (arg
4070: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 s:get-arg "-star
4080: 74 2d 64 69 72 22 29 20 22 20 73 70 65 63 69 66 t-dir") " specif
4090: 69 65 64 2c 20 65 78 69 74 69 6e 67 2e 22 29 0a ied, exiting.").
40a0: 09 20 20 28 65 78 69 74 20 31 29 29 29 29 0a 0a . (exit 1))))..
40b0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
40c0: 67 20 22 2d 76 65 72 73 69 6f 6e 22 29 0a 20 20 g "-version").
40d0: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
40e0: 70 72 69 6e 74 20 28 63 6f 6d 6d 6f 6e 3a 76 65 print (common:ve
40f0: 72 73 69 6f 6e 2d 73 69 67 6e 61 74 75 72 65 29 rsion-signature)
4100: 29 20 3b 3b 20 28 70 72 69 6e 74 20 6d 65 67 61 ) ;; (print mega
4110: 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 20 test-version).
4120: 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a 28 64 (exit)))..(d
4130: 65 66 69 6e 65 20 2a 64 69 64 73 6f 6d 65 74 68 efine *didsometh
4140: 69 6e 67 2a 20 23 66 29 0a 0a 3b 3b 20 4f 76 65 ing* #f)..;; Ove
4150: 72 61 6c 6c 20 65 78 69 74 20 68 61 6e 64 6c 69 rall exit handli
4160: 6e 67 20 73 65 74 75 70 20 69 6d 6d 65 64 69 61 ng setup immedia
4170: 74 65 6c 79 0a 3b 3b 0a 28 69 66 20 28 6f 72 20 tely.;;.(if (or
4180: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4190: 70 72 6f 63 65 73 73 2d 72 65 61 70 22 29 29 0a process-reap")).
41a0: 20 20 20 20 20 20 20 20 3b 3b 20 28 61 72 67 73 ;; (args
41b0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
41c0: 73 74 73 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a sts")..;; (args:
41d0: 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 get-arg "-execut
41e0: 65 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a 67 65 e")..;; (args:ge
41f0: 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d 72 t-arg "-remove-r
4200: 75 6e 73 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a uns")..;; (args:
4210: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 get-arg "-runste
4220: 70 22 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 p")). (let ((
4230: 6f 72 69 67 69 6e 61 6c 2d 65 78 69 74 20 28 65 original-exit (e
4240: 78 69 74 2d 68 61 6e 64 6c 65 72 29 29 29 0a 20 xit-handler))).
4250: 20 20 20 20 20 28 65 78 69 74 2d 68 61 6e 64 6c (exit-handl
4260: 65 72 20 28 6c 61 6d 62 64 61 20 28 23 21 6f 70 er (lambda (#!op
4270: 74 69 6f 6e 61 6c 20 28 65 78 69 74 2d 63 6f 64 tional (exit-cod
4280: 65 20 30 29 29 0a 09 09 20 20 20 20 20 20 28 70 e 0))... (p
4290: 72 69 6e 74 66 20 22 50 72 65 70 61 72 69 6e 67 rintf "Preparing
42a0: 20 74 6f 20 65 78 69 74 20 77 69 74 68 20 65 78 to exit with ex
42b0: 69 74 20 63 6f 64 65 20 7e 41 20 2e 2e 2e 5c 6e it code ~A ...\n
42c0: 22 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 20 " exit-code)...
42d0: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
42e0: 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda
42f0: 20 28 70 69 64 29 0a 09 09 09 20 28 68 61 6e 64 (pid).... (hand
4300: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 le-exceptions...
4310: 09 20 20 65 78 6e 0a 09 09 09 20 20 23 74 0a 09 . exn.... #t..
4320: 09 09 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 .. (let-values
4330: 28 28 28 70 69 64 2d 76 61 6c 20 65 78 69 74 2d (((pid-val exit-
4340: 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 status exit-code
4350: 29 20 28 70 72 6f 63 65 73 73 2d 77 61 69 74 20 ) (process-wait
4360: 70 69 64 20 23 74 29 29 29 0a 09 09 09 09 20 20 pid #t))).....
4370: 20 20 20 20 28 69 66 20 28 6f 72 20 28 65 71 3f (if (or (eq?
4380: 20 70 69 64 2d 76 61 6c 20 70 69 64 29 0a 09 09 pid-val pid)...
4390: 09 09 09 20 20 20 20 20 20 28 65 71 3f 20 70 69 ... (eq? pi
43a0: 64 2d 76 61 6c 20 30 29 29 0a 09 09 09 09 09 20 d-val 0))......
43b0: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 (begin......
43c0: 20 28 70 72 69 6e 74 66 20 22 53 65 6e 64 69 6e (printf "Sendin
43d0: 67 20 73 69 67 6e 61 6c 2f 74 65 72 6d 20 74 6f g signal/term to
43e0: 20 7e 41 5c 6e 22 20 70 69 64 29 0a 09 09 09 09 ~A\n" pid).....
43f0: 09 20 20 20 20 28 70 72 6f 63 65 73 73 2d 73 69 . (process-si
4400: 67 6e 61 6c 20 70 69 64 20 73 69 67 6e 61 6c 2f gnal pid signal/
4410: 74 65 72 6d 29 29 29 29 29 29 0a 09 09 20 20 20 term))))))...
4420: 20 20 20 20 28 70 72 6f 63 65 73 73 3a 63 68 69 (process:chi
4430: 6c 64 72 65 6e 20 23 66 29 29 0a 09 09 20 20 20 ldren #f))...
4440: 20 20 20 28 6f 72 69 67 69 6e 61 6c 2d 65 78 69 (original-exi
4450: 74 20 65 78 69 74 2d 63 6f 64 65 29 29 29 29 29 t exit-code)))))
4460: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
4470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 4d 69 ==========.;; Mi
44b0: 73 63 20 73 65 74 75 70 20 73 74 75 66 66 0a 3b sc setup stuff.;
44c0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
44d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4500: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 62 75 67 3a =======..(debug:
4510: 73 65 74 75 70 29 0a 0a 28 69 66 20 28 61 72 67 setup)..(if (arg
4520: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 67 s:get-arg "-logg
4530: 69 6e 67 22 29 28 73 65 74 21 20 2a 6c 6f 67 67 ing")(set! *logg
4540: 69 6e 67 2a 20 23 74 29 29 0a 0a 28 69 66 20 28 ing* #t))..(if (
4550: 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 debug:debug-mode
4560: 20 33 29 20 3b 3b 20 77 65 20 61 72 65 20 6f 62 3) ;; we are ob
4570: 76 69 6f 75 73 6c 79 20 64 65 62 75 67 67 69 6e viously debuggin
4580: 67 0a 20 20 20 20 28 73 65 74 21 20 6f 70 65 6e g. (set! open
4590: 2d 72 75 6e 2d 63 6c 6f 73 65 20 6f 70 65 6e 2d -run-close open-
45a0: 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 run-close-no-exc
45b0: 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 29 eption-handling)
45c0: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
45d0: 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 -arg "-itempatt"
45e0: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 ). (let ((new
45f0: 76 61 6c 20 28 63 6f 6e 63 20 28 61 72 67 73 3a val (conc (args:
4600: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
4610: 74 74 22 29 20 22 2f 22 20 28 61 72 67 73 3a 67 tt") "/" (args:g
4620: 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 et-arg "-itempat
4630: 74 22 29 29 29 29 0a 20 20 20 20 20 20 28 64 65 t")))). (de
4640: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
4650: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4660: 57 41 52 4e 49 4e 47 3a 20 2d 69 74 65 6d 70 61 WARNING: -itempa
4670: 74 74 20 68 61 73 20 62 65 65 6e 20 64 65 70 72 tt has been depr
4680: 65 63 61 74 65 64 2c 20 70 6c 65 61 73 65 20 75 ecated, please u
4690: 73 65 20 2d 74 65 73 74 70 61 74 74 20 74 65 73 se -testpatt tes
46a0: 74 70 61 74 74 2f 69 74 65 6d 70 61 74 74 20 6d tpatt/itempatt m
46b0: 65 74 68 6f 64 2c 20 6e 65 77 20 74 65 73 74 70 ethod, new testp
46c0: 61 74 74 20 69 73 20 22 6e 65 77 76 61 6c 29 0a att is "newval).
46d0: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
46e0: 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 2d e-set! args:arg-
46f0: 68 61 73 68 20 22 2d 74 65 73 74 70 61 74 74 22 hash "-testpatt"
4700: 20 6e 65 77 76 61 6c 29 0a 20 20 20 20 20 20 28 newval). (
4710: 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 hash-table-delet
4720: 65 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 e! args:arg-hash
4730: 20 22 2d 69 74 65 6d 70 61 74 74 22 29 29 29 0a "-itempatt"))).
4740: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
4750: 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a rg "-runtests").
4760: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
4770: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
4780: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
4790: 5c 22 2d 72 75 6e 74 65 73 74 73 5c 22 20 69 73 \"-runtests\" is
47a0: 20 64 65 70 72 65 63 61 74 65 64 2e 20 55 73 65 deprecated. Use
47b0: 20 5c 22 2d 72 75 6e 5c 22 20 77 69 74 68 20 5c \"-run\" with \
47c0: 22 2d 74 65 73 74 70 61 74 74 5c 22 20 69 6e 73 "-testpatt\" ins
47d0: 74 65 61 64 22 29 29 0a 0a 28 6f 6e 2d 65 78 69 tead"))..(on-exi
47e0: 74 20 73 74 64 2d 65 78 69 74 2d 70 72 6f 63 65 t std-exit-proce
47f0: 64 75 72 65 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d dure)..;;=======
4800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a ===============.
4840: 3b 3b 20 4d 69 73 63 20 67 65 6e 65 72 61 6c 20 ;; Misc general
4850: 63 61 6c 6c 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d calls.;;========
4860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
48a0: 3b 3b 20 68 61 6e 64 6c 65 20 61 20 63 6c 65 61 ;; handle a clea
48b0: 6e 2d 63 61 63 68 65 20 72 65 71 75 65 73 74 20 n-cache request
48c0: 61 73 20 65 61 72 6c 79 20 61 73 20 70 6f 73 73 as early as poss
48d0: 69 62 6c 65 0a 3b 3b 0a 28 69 66 20 28 61 72 67 ible.;;.(if (arg
48e0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6c 65 61 s:get-arg "-clea
48f0: 6e 2d 63 61 63 68 65 22 29 0a 20 20 20 20 28 62 n-cache"). (b
4900: 65 67 69 6e 0a 20 20 20 20 20 20 28 73 65 74 21 egin. (set!
4910: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
4920: 23 74 29 20 3b 3b 20 73 75 70 70 72 65 73 73 20 #t) ;; suppress
4930: 74 68 65 20 68 65 6c 70 20 6f 75 74 70 75 74 2e the help output.
4940: 0a 20 20 20 20 20 20 28 69 66 20 28 67 65 74 65 . (if (gete
4950: 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 20 nv "MT_TARGET")
4960: 3b 3b 20 6e 6f 20 70 6f 69 6e 74 20 69 6e 20 74 ;; no point in t
4970: 72 79 69 6e 67 20 69 66 20 6e 6f 20 74 61 72 67 rying if no targ
4980: 65 74 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a et.. (if (args:
4990: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d get-arg "-runnam
49a0: 65 22 29 0a 09 20 20 20 20 20 20 28 6c 65 74 2a e").. (let*
49b0: 20 28 28 74 6f 70 70 61 74 68 20 20 28 6c 61 75 ((toppath (lau
49c0: 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 09 20 20 nch:setup))...
49d0: 20 20 20 28 6c 69 6e 6b 74 72 65 65 20 28 69 66 (linktree (if
49e0: 20 74 6f 70 70 61 74 68 20 28 63 6f 6e 66 69 67 toppath (config
49f0: 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
4a00: 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c 69 dat* "setup" "li
4a10: 6e 6b 74 72 65 65 22 29 29 29 0a 09 09 20 20 20 nktree")))...
4a20: 20 20 28 72 75 6e 74 6f 70 20 20 20 28 63 6f 6e (runtop (con
4a30: 63 20 6c 69 6e 6b 74 72 65 65 20 22 2f 22 20 28 c linktree "/" (
4a40: 67 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 getenv "MT_TARGE
4a50: 54 22 29 20 22 2f 22 20 28 61 72 67 73 3a 67 65 T") "/" (args:ge
4a60: 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
4a70: 29 29 29 0a 09 09 20 20 20 20 20 28 66 69 6c 65 )))... (file
4a80: 73 20 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 s (if (file-e
4a90: 78 69 73 74 73 3f 20 72 75 6e 74 6f 70 29 0a 09 xists? runtop)..
4aa0: 09 09 09 20 20 20 28 61 70 70 65 6e 64 20 28 67 ... (append (g
4ab0: 6c 6f 62 20 28 63 6f 6e 63 20 72 75 6e 74 6f 70 lob (conc runtop
4ac0: 20 22 2f 2e 6d 65 67 61 74 65 73 74 2a 22 29 29 "/.megatest*"))
4ad0: 0a 09 09 09 09 09 20 20 20 28 67 6c 6f 62 20 28 ...... (glob (
4ae0: 63 6f 6e 63 20 72 75 6e 74 6f 70 20 22 2f 2e 72 conc runtop "/.r
4af0: 75 6e 63 6f 6e 66 69 67 2a 22 29 29 29 0a 09 09 unconfig*")))...
4b00: 09 09 20 20 20 27 28 29 29 29 29 0a 09 09 28 69 .. '())))...(i
4b10: 66 20 28 6e 75 6c 6c 3f 20 66 69 6c 65 73 29 0a f (null? files).
4b20: 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
4b30: 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
4b40: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f lt-log-port* "No
4b50: 20 63 61 63 68 65 64 20 6d 65 67 61 74 65 73 74 cached megatest
4b60: 20 6f 72 20 72 75 6e 63 6f 6e 66 69 67 73 20 66 or runconfigs f
4b70: 69 6c 65 73 20 66 6f 75 6e 64 2e 20 4e 6f 6e 65 iles found. None
4b80: 20 72 65 6d 6f 76 65 64 2e 22 29 0a 09 09 20 20 removed.")...
4b90: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 (begin...
4ba0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
4bb0: 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 0 *default-lo
4bc0: 67 2d 70 6f 72 74 2a 20 22 52 65 6d 6f 76 69 6e g-port* "Removin
4bd0: 67 20 63 61 63 68 65 64 20 66 69 6c 65 73 3a 5c g cached files:\
4be0: 6e 20 20 20 20 22 20 28 73 74 72 69 6e 67 2d 69 n " (string-i
4bf0: 6e 74 65 72 73 70 65 72 73 65 20 66 69 6c 65 73 ntersperse files
4c00: 20 22 5c 6e 20 20 20 20 22 29 29 0a 09 09 20 20 "\n "))...
4c10: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 (for-each ..
4c20: 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 . (lambda
4c30: 28 66 29 0a 09 09 09 20 28 68 61 6e 64 6c 65 2d (f).... (handle-
4c40: 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 20 20 exceptions....
4c50: 20 20 20 65 78 6e 0a 09 09 09 20 20 20 20 20 28 exn.... (
4c60: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
4c70: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
4c80: 20 22 57 41 52 4e 49 4e 47 3a 20 46 61 69 6c 65 "WARNING: Faile
4c90: 64 20 74 6f 20 72 65 6d 6f 76 65 20 66 69 6c 65 d to remove file
4ca0: 20 22 20 66 29 0a 09 09 09 20 20 20 28 64 65 6c " f).... (del
4cb0: 65 74 65 2d 66 69 6c 65 20 66 29 29 29 0a 09 09 ete-file f)))...
4cc0: 20 20 20 20 20 20 20 66 69 6c 65 73 29 29 29 29 files))))
4cd0: 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
4ce0: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
4cf0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
4d00: 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 20 72 65 "-clean-cache re
4d10: 71 75 69 72 65 73 20 2d 72 75 6e 6e 61 6d 65 2e quires -runname.
4d20: 22 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 ")).. (debug:pr
4d30: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
4d40: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4d50: 2d 63 6c 65 61 6e 2d 63 61 63 68 65 20 72 65 71 -clean-cache req
4d60: 75 69 72 65 73 20 2d 74 61 72 67 65 74 20 6f 72 uires -target or
4d70: 20 2d 72 65 71 74 61 72 67 22 29 29 29 29 0a 09 -reqtarg"))))..
4d80: 20 20 20 20 0a 09 20 20 0a 28 69 66 20 28 61 72 .. .(if (ar
4d90: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 gs:get-arg "-env
4da0: 32 66 69 6c 65 22 29 0a 20 20 20 20 28 62 65 67 2file"). (beg
4db0: 69 6e 0a 20 20 20 20 20 20 28 73 61 76 65 2d 65 in. (save-e
4dc0: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 nvironment-as-fi
4dd0: 6c 65 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 les (args:get-ar
4de0: 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 29 29 0a g "-env2file")).
4df0: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
4e00: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
4e10: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
4e20: 61 72 67 20 22 2d 6c 69 73 74 2d 64 69 73 6b 73 arg "-list-disks
4e30: 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6f "). (let ((to
4e40: 70 70 61 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 ppath (launch:se
4e50: 74 75 70 29 29 29 0a 20 20 20 20 20 20 28 70 72 tup))). (pr
4e60: 69 6e 74 20 0a 20 20 20 20 20 20 20 28 73 74 72 int . (str
4e70: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
4e80: 0a 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 ..(map (lambda (
4e90: 78 29 0a 09 20 20 20 20 20 20 20 28 73 74 72 69 x).. (stri
4ea0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a ng-intersperse .
4eb0: 09 09 78 0a 09 09 22 20 3d 3e 20 22 29 29 0a 09 ..x..." => "))..
4ec0: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 (common:get
4ed0: 2d 64 69 73 6b 73 20 2a 63 6f 6e 66 69 67 64 61 -disks *configda
4ee0: 74 2a 29 29 0a 09 22 5c 6e 22 29 29 0a 20 20 20 t*)).."\n")).
4ef0: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
4f00: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b ething* #t)))..;
4f10: 3b 20 63 73 76 20 70 72 6f 63 65 73 73 69 6e 67 ; csv processing
4f20: 20 72 65 63 6f 72 64 0a 28 64 65 66 69 6e 65 20 record.(define
4f30: 28 6d 61 6b 65 2d 72 65 66 64 62 3a 63 73 76 29 (make-refdb:csv)
4f40: 0a 20 20 28 76 65 63 74 6f 72 20 0a 20 20 20 28 . (vector . (
4f50: 6d 61 6b 65 2d 73 70 61 72 73 65 2d 61 72 72 61 make-sparse-arra
4f60: 79 29 0a 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 y). (make-hash
4f70: 2d 74 61 62 6c 65 29 0a 20 20 20 28 6d 61 6b 65 -table). (make
4f80: 2d 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 20 -hash-table).
4f90: 30 0a 20 20 20 30 29 29 0a 28 64 65 66 69 6e 65 0. 0)).(define
4fa0: 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 -inline (refdb:c
4fb0: 73 76 2d 67 65 74 2d 73 76 65 63 20 20 20 20 20 sv-get-svec
4fc0: 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d vec) (vector-
4fd0: 72 65 66 20 20 76 65 63 20 30 29 29 0a 28 64 65 ref vec 0)).(de
4fe0: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 fine-inline (ref
4ff0: 64 62 3a 63 73 76 2d 67 65 74 2d 72 6f 77 73 20 db:csv-get-rows
5000: 20 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 vec) (vec
5010: 74 6f 72 2d 72 65 66 20 20 76 65 63 20 31 29 29 tor-ref vec 1))
5020: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
5030: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 63 (refdb:csv-get-c
5040: 6f 6c 73 20 20 20 20 20 76 65 63 29 20 20 20 20 ols vec)
5050: 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 (vector-ref vec
5060: 20 32 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 2)).(define-inl
5070: 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 67 ine (refdb:csv-g
5080: 65 74 2d 6d 61 78 72 6f 77 20 20 20 76 65 63 29 et-maxrow vec)
5090: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
50a0: 20 76 65 63 20 33 29 29 0a 28 64 65 66 69 6e 65 vec 3)).(define
50b0: 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 -inline (refdb:c
50c0: 73 76 2d 67 65 74 2d 6d 61 78 63 6f 6c 20 20 20 sv-get-maxcol
50d0: 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d vec) (vector-
50e0: 72 65 66 20 20 76 65 63 20 34 29 29 0a 28 64 65 ref vec 4)).(de
50f0: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 fine-inline (ref
5100: 64 62 3a 63 73 76 2d 73 65 74 2d 73 76 65 63 21 db:csv-set-svec!
5110: 20 20 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 vec val)(vec
5120: 74 6f 72 2d 73 65 74 21 20 76 65 63 20 30 20 76 tor-set! vec 0 v
5130: 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c al)).(define-inl
5140: 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 73 ine (refdb:csv-s
5150: 65 74 2d 72 6f 77 73 21 20 20 20 20 76 65 63 20 et-rows! vec
5160: 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 val)(vector-set!
5170: 20 76 65 63 20 31 20 76 61 6c 29 29 0a 28 64 65 vec 1 val)).(de
5180: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 fine-inline (ref
5190: 64 62 3a 63 73 76 2d 73 65 74 2d 63 6f 6c 73 21 db:csv-set-cols!
51a0: 20 20 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 vec val)(vec
51b0: 74 6f 72 2d 73 65 74 21 20 76 65 63 20 32 20 76 tor-set! vec 2 v
51c0: 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c al)).(define-inl
51d0: 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 73 ine (refdb:csv-s
51e0: 65 74 2d 6d 61 78 72 6f 77 21 20 20 76 65 63 20 et-maxrow! vec
51f0: 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 val)(vector-set!
5200: 20 76 65 63 20 33 20 76 61 6c 29 29 0a 28 64 65 vec 3 val)).(de
5210: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 fine-inline (ref
5220: 64 62 3a 63 73 76 2d 73 65 74 2d 6d 61 78 63 6f db:csv-set-maxco
5230: 6c 21 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 l! vec val)(vec
5240: 74 6f 72 2d 73 65 74 21 20 76 65 63 20 34 20 76 tor-set! vec 4 v
5250: 61 6c 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 al))..(define (g
5260: 65 74 2d 64 61 74 20 72 65 73 75 6c 74 73 20 73 et-dat results s
5270: 68 65 65 74 6e 61 6d 65 29 0a 20 20 28 6f 72 20 heetname). (or
5280: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
5290: 64 65 66 61 75 6c 74 20 72 65 73 75 6c 74 73 20 default results
52a0: 73 68 65 65 74 6e 61 6d 65 20 23 66 29 0a 20 20 sheetname #f).
52b0: 20 20 20 20 28 6c 65 74 20 28 28 74 6d 70 2d 76 (let ((tmp-v
52c0: 65 63 20 20 28 6d 61 6b 65 2d 72 65 66 64 62 3a ec (make-refdb:
52d0: 63 73 76 29 29 29 0a 09 28 68 61 73 68 2d 74 61 csv)))..(hash-ta
52e0: 62 6c 65 2d 73 65 74 21 20 72 65 73 75 6c 74 73 ble-set! results
52f0: 20 73 68 65 65 74 6e 61 6d 65 20 74 6d 70 2d 76 sheetname tmp-v
5300: 65 63 29 0a 09 74 6d 70 2d 76 65 63 29 29 29 0a ec)..tmp-vec))).
5310: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
5320: 72 67 20 22 2d 72 65 66 64 62 32 64 61 74 22 29 rg "-refdb2dat")
5330: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 69 6e 70 . (let* ((inp
5340: 75 74 2d 64 62 20 28 61 72 67 73 3a 67 65 74 2d ut-db (args:get-
5350: 61 72 67 20 22 2d 72 65 66 64 62 32 64 61 74 22 arg "-refdb2dat"
5360: 29 29 0a 09 20 20 20 28 6f 75 74 2d 66 69 6c 65 )).. (out-file
5370: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5380: 2d 6f 22 29 29 0a 09 20 20 20 28 6f 75 74 2d 66 -o")).. (out-f
5390: 6d 74 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 mt (or (args:ge
53a0: 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 t-arg "-dumpmode
53b0: 22 29 20 22 73 63 68 65 6d 65 22 29 29 0a 09 20 ") "scheme"))..
53c0: 20 20 28 6f 75 74 2d 70 6f 72 74 20 28 69 66 20 (out-port (if
53d0: 28 61 6e 64 20 6f 75 74 2d 66 69 6c 65 20 0a 09 (and out-file ..
53e0: 09 09 20 20 20 20 20 20 28 6e 6f 74 20 28 6d 65 .. (not (me
53f0: 6d 62 65 72 20 6f 75 74 2d 66 6d 74 20 27 28 22 mber out-fmt '("
5400: 73 71 6c 69 74 65 33 22 20 22 63 73 76 22 29 29 sqlite3" "csv"))
5410: 29 29 0a 09 09 09 20 28 6f 70 65 6e 2d 6f 75 74 )).... (open-out
5420: 70 75 74 2d 66 69 6c 65 20 6f 75 74 2d 66 69 6c put-file out-fil
5430: 65 29 0a 09 09 09 20 28 63 75 72 72 65 6e 74 2d e).... (current-
5440: 6f 75 74 70 75 74 2d 70 6f 72 74 29 29 29 0a 09 output-port)))..
5450: 20 20 20 28 72 65 73 2d 64 61 74 61 20 28 63 6f (res-data (co
5460: 6e 66 69 67 66 3a 72 65 61 64 2d 72 65 66 64 62 nfigf:read-refdb
5470: 20 69 6e 70 75 74 2d 64 62 29 29 0a 09 20 20 20 input-db))..
5480: 28 64 61 74 61 20 20 20 20 20 28 63 61 72 20 72 (data (car r
5490: 65 73 2d 64 61 74 61 29 29 0a 09 20 20 20 28 6d es-data)).. (m
54a0: 73 67 20 20 20 20 20 20 28 63 61 64 72 20 72 65 sg (cadr re
54b0: 73 2d 64 61 74 61 29 29 29 0a 20 20 20 20 20 20 s-data))).
54c0: 28 69 66 20 28 6e 6f 74 20 64 61 74 61 29 0a 09 (if (not data)..
54d0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
54e0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
54f0: 72 74 2a 20 22 42 61 64 20 69 6e 70 75 74 3f 20 rt* "Bad input?
5500: 64 61 74 61 3d 22 20 64 61 74 61 29 20 3b 3b 20 data=" data) ;;
5510: 73 6f 6d 65 20 65 72 72 6f 72 20 6f 63 63 75 72 some error occur
5520: 72 65 64 0a 09 20 20 28 77 69 74 68 2d 6f 75 74 red.. (with-out
5530: 70 75 74 2d 74 6f 2d 70 6f 72 74 20 6f 75 74 2d put-to-port out-
5540: 70 6f 72 74 0a 09 20 20 20 20 28 6c 61 6d 62 64 port.. (lambd
5550: 61 20 28 29 0a 09 20 20 20 20 20 20 28 63 61 73 a ().. (cas
5560: 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f e (string->symbo
5570: 6c 20 6f 75 74 2d 66 6d 74 29 0a 09 09 28 28 73 l out-fmt)...((s
5580: 63 68 65 6d 65 29 28 70 70 20 64 61 74 61 29 29 cheme)(pp data))
5590: 0a 09 09 28 28 70 65 72 6c 29 0a 09 09 20 3b 3b ...((perl)... ;;
55a0: 20 28 70 72 69 6e 74 20 22 25 68 61 73 68 20 3d (print "%hash =
55b0: 20 28 22 29 0a 09 09 20 3b 3b 20 20 20 20 20 20 (")... ;;
55c0: 20 20 6b 65 79 31 20 3d 3e 20 27 76 61 6c 75 65 key1 => 'value
55d0: 31 27 2c 0a 09 09 20 3b 3b 20 20 20 20 20 20 20 1',... ;;
55e0: 20 6b 65 79 32 20 3d 3e 20 27 76 61 6c 75 65 32 key2 => 'value2
55f0: 27 2c 0a 09 09 20 3b 3b 20 20 20 20 20 20 20 20 ',... ;;
5600: 6b 65 79 33 20 3d 3e 20 27 76 61 6c 75 65 33 27 key3 => 'value3'
5610: 2c 0a 09 09 20 3b 3b 20 29 3b 0a 09 09 20 28 63 ,... ;; );... (c
5620: 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 onfigf:map-all-h
5630: 69 65 72 2d 61 6c 69 73 74 20 0a 09 09 20 20 64 ier-alist ... d
5640: 61 74 61 20 0a 09 09 20 20 28 6c 61 6d 62 64 61 ata ... (lambda
5650: 20 28 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 (sheetname sect
5660: 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 ionname varname
5670: 76 61 6c 29 0a 09 09 20 20 20 20 28 70 72 69 6e val)... (prin
5680: 74 20 22 24 64 61 74 61 7b 5c 22 22 20 73 68 65 t "$data{\"" she
5690: 65 74 6e 61 6d 65 20 22 5c 22 7d 7b 5c 22 22 20 etname "\"}{\""
56a0: 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 5c 22 7d sectionname "\"}
56b0: 7b 5c 22 22 20 76 61 72 6e 61 6d 65 20 22 5c 22 {\"" varname "\"
56c0: 7d 20 3d 20 5c 22 22 20 76 61 6c 20 22 5c 22 3b } = \"" val "\";
56d0: 22 29 29 29 29 0a 09 09 28 28 70 79 74 68 6f 6e "))))...((python
56e0: 20 72 75 62 79 29 0a 09 09 20 28 70 72 69 6e 74 ruby)... (print
56f0: 20 22 64 61 74 61 3d 7b 7d 22 29 0a 09 09 20 28 "data={}")... (
5700: 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d configf:map-all-
5710: 68 69 65 72 2d 61 6c 69 73 74 0a 09 09 20 20 64 hier-alist... d
5720: 61 74 61 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 ata... (lambda
5730: 28 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 (sheetname secti
5740: 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 onname varname v
5750: 61 6c 29 0a 09 09 20 20 20 20 28 70 72 69 6e 74 al)... (print
5760: 20 22 64 61 74 61 5b 5c 22 22 20 73 68 65 65 74 "data[\"" sheet
5770: 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 22 20 73 65 name "\"][\"" se
5780: 63 74 69 6f 6e 6e 61 6d 65 20 22 5c 22 5d 5b 5c ctionname "\"][\
5790: 22 22 20 76 61 72 6e 61 6d 65 20 22 5c 22 5d 20 "" varname "\"]
57a0: 3d 20 5c 22 22 20 76 61 6c 20 22 5c 22 22 29 29 = \"" val "\""))
57b0: 0a 09 09 20 20 69 6e 69 74 70 72 6f 63 31 3a 0a ... initproc1:.
57c0: 09 09 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 .. (lambda (she
57d0: 65 74 6e 61 6d 65 29 0a 09 09 20 20 20 20 28 70 etname)... (p
57e0: 72 69 6e 74 20 22 64 61 74 61 5b 5c 22 22 20 73 rint "data[\"" s
57f0: 68 65 65 74 6e 61 6d 65 20 22 5c 22 5d 20 3d 20 heetname "\"] =
5800: 7b 7d 22 29 29 0a 09 09 20 20 69 6e 69 74 70 72 {}"))... initpr
5810: 6f 63 32 3a 0a 09 09 20 20 28 6c 61 6d 62 64 61 oc2:... (lambda
5820: 20 28 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 (sheetname sect
5830: 69 6f 6e 6e 61 6d 65 29 0a 09 09 20 20 20 20 28 ionname)... (
5840: 70 72 69 6e 74 20 22 64 61 74 61 5b 5c 22 22 20 print "data[\""
5850: 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 5d 5b 5c sheetname "\"][\
5860: 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 "" sectionname "
5870: 5c 22 5d 20 3d 20 7b 7d 22 29 29 29 29 0a 09 09 \"] = {}"))))...
5880: 28 28 63 73 76 29 0a 09 09 20 28 6c 65 74 2a 20 ((csv)... (let*
5890: 28 28 72 65 73 75 6c 74 73 20 20 28 6d 61 6b 65 ((results (make
58a0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b -hash-table)) ;;
58b0: 20 28 6d 61 6b 65 2d 73 70 61 72 73 65 2d 61 72 (make-sparse-ar
58c0: 72 61 79 29 29 29 0a 09 09 09 28 72 6f 77 2d 63 ray)))....(row-c
58d0: 6f 6c 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 ols (make-hash-t
58e0: 61 62 6c 65 29 29 29 20 3b 3b 20 68 61 73 68 20 able))) ;; hash
58f0: 6f 66 20 68 61 73 68 65 73 20 77 68 65 72 65 20 of hashes where
5900: 73 65 63 74 69 6f 6e 20 3d 3e 20 68 74 20 7b 20 section => ht {
5910: 72 6f 77 2d 3c 6e 61 6d 65 3e 20 3d 3e 20 6e 75 row-<name> => nu
5920: 6d 20 6f 72 20 63 6f 6c 2d 3c 6e 61 6d 65 3e 20 m or col-<name>
5930: 3d 3e 20 6e 75 6d 0a 09 09 20 20 20 3b 3b 20 28 => num... ;; (
5940: 70 72 69 6e 74 20 22 64 61 74 61 3d 22 29 0a 09 print "data=")..
5950: 09 20 20 20 3b 3b 20 28 70 70 20 64 61 74 61 29 . ;; (pp data)
5960: 0a 09 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 6d ... (configf:m
5970: 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 ap-all-hier-alis
5980: 74 0a 09 09 20 20 20 20 64 61 74 61 0a 09 09 20 t... data...
5990: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 65 (lambda (shee
59a0: 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d tname sectionnam
59b0: 65 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 0a 09 e varname val)..
59c0: 09 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 . ;; (print
59d0: 20 22 73 68 65 65 74 6e 61 6d 65 3a 20 22 20 73 "sheetname: " s
59e0: 68 65 65 74 6e 61 6d 65 20 22 2c 20 73 65 63 74 heetname ", sect
59f0: 69 6f 6e 6e 61 6d 65 3a 20 22 20 73 65 63 74 69 ionname: " secti
5a00: 6f 6e 6e 61 6d 65 20 22 2c 20 76 61 72 6e 61 6d onname ", varnam
5a10: 65 3a 20 22 20 76 61 72 6e 61 6d 65 20 22 2c 20 e: " varname ",
5a20: 76 61 6c 3a 20 22 20 76 61 6c 29 0a 09 09 20 20 val: " val)...
5a30: 20 20 20 20 28 6c 65 74 2a 20 28 28 64 61 74 20 (let* ((dat
5a40: 20 20 20 20 20 28 67 65 74 2d 64 61 74 20 72 65 (get-dat re
5a50: 73 75 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 29 sults sheetname)
5a60: 29 0a 09 09 09 20 20 20 20 20 28 76 65 63 20 20 ).... (vec
5a70: 20 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 (refdb:csv-g
5a80: 65 74 2d 73 76 65 63 20 64 61 74 29 29 0a 09 09 et-svec dat))...
5a90: 09 20 20 20 20 20 28 72 6f 77 6e 61 6d 65 73 20 . (rownames
5aa0: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 72 (refdb:csv-get-r
5ab0: 6f 77 73 20 64 61 74 29 29 0a 09 09 09 20 20 20 ows dat))....
5ac0: 20 20 28 63 6f 6c 6e 61 6d 65 73 20 28 72 65 66 (colnames (ref
5ad0: 64 62 3a 63 73 76 2d 67 65 74 2d 63 6f 6c 73 20 db:csv-get-cols
5ae0: 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 63 dat)).... (c
5af0: 75 72 72 72 6f 77 6e 20 28 68 61 73 68 2d 74 61 urrrown (hash-ta
5b00: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
5b10: 72 6f 77 6e 61 6d 65 73 20 76 61 72 6e 61 6d 65 rownames varname
5b20: 20 23 66 29 29 0a 09 09 09 20 20 20 20 20 28 63 #f)).... (c
5b30: 75 72 72 63 6f 6c 6e 20 28 68 61 73 68 2d 74 61 urrcoln (hash-ta
5b40: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
5b50: 63 6f 6c 6e 61 6d 65 73 20 73 65 63 74 69 6f 6e colnames section
5b60: 6e 61 6d 65 20 23 66 29 29 0a 09 09 09 20 20 20 name #f))....
5b70: 20 20 28 72 6f 77 6e 20 20 20 20 20 28 6f 72 20 (rown (or
5b80: 63 75 72 72 72 6f 77 6e 20 0a 09 09 09 09 09 20 currrown ......
5b90: 20 20 28 6c 65 74 2a 20 28 28 6c 61 73 74 6e 20 (let* ((lastn
5ba0: 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 (refdb:csv-get
5bb0: 2d 6d 61 78 72 6f 77 20 64 61 74 29 29 0a 09 09 -maxrow dat))...
5bc0: 09 09 09 09 20 20 28 6e 65 77 72 6f 77 6e 20 28 .... (newrown (
5bd0: 2b 20 6c 61 73 74 6e 20 31 29 29 29 0a 09 09 09 + lastn 1)))....
5be0: 09 09 20 20 20 20 20 28 72 65 66 64 62 3a 63 73 .. (refdb:cs
5bf0: 76 2d 73 65 74 2d 6d 61 78 72 6f 77 21 20 64 61 v-set-maxrow! da
5c00: 74 20 6e 65 77 72 6f 77 6e 29 0a 09 09 09 09 09 t newrown)......
5c10: 20 20 20 20 20 6e 65 77 72 6f 77 6e 29 29 29 0a newrown))).
5c20: 09 09 09 20 20 20 20 20 28 63 6f 6c 6e 20 20 20 ... (coln
5c30: 20 20 28 6f 72 20 63 75 72 72 63 6f 6c 6e 20 0a (or currcoln .
5c40: 09 09 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 ..... (let* ((
5c50: 6c 61 73 74 6e 20 20 20 28 72 65 66 64 62 3a 63 lastn (refdb:c
5c60: 73 76 2d 67 65 74 2d 6d 61 78 63 6f 6c 20 64 61 sv-get-maxcol da
5c70: 74 29 29 0a 09 09 09 09 09 09 20 20 28 6e 65 77 t))....... (new
5c80: 63 6f 6c 6e 20 28 2b 20 6c 61 73 74 6e 20 31 29 coln (+ lastn 1)
5c90: 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 72 65 ))...... (re
5ca0: 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d 61 78 63 fdb:csv-set-maxc
5cb0: 6f 6c 21 20 64 61 74 20 6e 65 77 63 6f 6c 6e 29 ol! dat newcoln)
5cc0: 0a 09 09 09 09 09 20 20 20 20 20 6e 65 77 63 6f ...... newco
5cd0: 6c 6e 29 29 29 29 0a 09 09 09 28 69 66 20 28 6e ln))))....(if (n
5ce0: 6f 74 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 ot (sparse-array
5cf0: 2d 72 65 66 20 76 65 63 20 30 20 63 6f 6c 6e 29 -ref vec 0 coln)
5d00: 29 20 3b 3b 20 28 65 71 3f 20 72 6f 77 6e 20 30 ) ;; (eq? rown 0
5d10: 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a ).... (begin.
5d20: 09 09 09 20 20 20 20 20 20 28 73 70 61 72 73 65 ... (sparse
5d30: 2d 61 72 72 61 79 2d 73 65 74 21 20 76 65 63 20 -array-set! vec
5d40: 30 20 63 6f 6c 6e 20 73 65 63 74 69 6f 6e 6e 61 0 coln sectionna
5d50: 6d 65 29 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 me).... ;;
5d60: 28 70 72 69 6e 74 20 22 73 70 61 72 73 65 2d 61 (print "sparse-a
5d70: 72 72 61 79 2d 72 65 66 20 22 20 30 20 22 2c 22 rray-ref " 0 ","
5d80: 20 63 6f 6c 6e 20 22 3d 22 20 28 73 70 61 72 73 coln "=" (spars
5d90: 65 2d 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 e-array-ref vec
5da0: 30 20 63 6f 6c 6e 29 29 0a 09 09 09 20 20 20 20 0 coln))....
5db0: 20 20 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 ))....(if (not
5dc0: 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 (sparse-array-r
5dd0: 65 66 20 76 65 63 20 72 6f 77 6e 20 30 29 29 20 ef vec rown 0))
5de0: 3b 3b 20 28 65 71 3f 20 63 6f 6c 6e 20 30 29 0a ;; (eq? coln 0).
5df0: 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ... (begin...
5e00: 09 20 20 20 20 20 20 28 73 70 61 72 73 65 2d 61 . (sparse-a
5e10: 72 72 61 79 2d 73 65 74 21 20 76 65 63 20 72 6f rray-set! vec ro
5e20: 77 6e 20 30 20 76 61 72 6e 61 6d 65 29 0a 09 09 wn 0 varname)...
5e30: 09 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 . ;; (print
5e40: 20 22 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 "sparse-array-r
5e50: 65 66 20 22 20 72 6f 77 6e 20 22 2c 22 20 30 20 ef " rown "," 0
5e60: 22 3d 22 20 28 73 70 61 72 73 65 2d 61 72 72 61 "=" (sparse-arra
5e70: 79 2d 72 65 66 20 76 65 63 20 72 6f 77 6e 20 30 y-ref vec rown 0
5e80: 29 29 0a 09 09 09 20 20 20 20 20 20 29 29 0a 09 )).... ))..
5e90: 09 09 28 69 66 20 28 6e 6f 74 20 63 75 72 72 72 ..(if (not currr
5ea0: 6f 77 6e 29 28 68 61 73 68 2d 74 61 62 6c 65 2d own)(hash-table-
5eb0: 73 65 74 21 20 72 6f 77 6e 61 6d 65 73 20 76 61 set! rownames va
5ec0: 72 6e 61 6d 65 20 72 6f 77 6e 29 29 0a 09 09 09 rname rown))....
5ed0: 28 69 66 20 28 6e 6f 74 20 63 75 72 72 63 6f 6c (if (not currcol
5ee0: 6e 29 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 n)(hash-table-se
5ef0: 74 21 20 63 6f 6c 6e 61 6d 65 73 20 73 65 63 74 t! colnames sect
5f00: 69 6f 6e 6e 61 6d 65 20 63 6f 6c 6e 29 29 0a 09 ionname coln))..
5f10: 09 09 3b 3b 20 28 70 72 69 6e 74 20 22 64 61 74 ..;; (print "dat
5f20: 3d 22 20 64 61 74 20 22 2c 20 72 6f 77 6e 3d 22 =" dat ", rown="
5f30: 20 72 6f 77 6e 20 22 2c 20 63 6f 6c 6e 3d 22 20 rown ", coln="
5f40: 63 6f 6c 6e 29 0a 09 09 09 28 73 70 61 72 73 65 coln)....(sparse
5f50: 2d 61 72 72 61 79 2d 73 65 74 21 20 76 65 63 20 -array-set! vec
5f60: 72 6f 77 6e 20 63 6f 6c 6e 20 76 61 6c 29 0a 09 rown coln val)..
5f70: 09 09 3b 3b 20 28 70 72 69 6e 74 20 22 73 70 61 ..;; (print "spa
5f80: 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 22 20 rse-array-ref "
5f90: 72 6f 77 6e 20 22 2c 22 20 63 6f 6c 6e 20 22 3d rown "," coln "=
5fa0: 22 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d " (sparse-array-
5fb0: 72 65 66 20 76 65 63 20 72 6f 77 6e 20 63 6f 6c ref vec rown col
5fc0: 6e 29 29 0a 09 09 09 29 29 29 0a 09 09 20 20 20 n))....)))...
5fd0: 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 20 (for-each...
5fe0: 28 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 (lambda (sheetna
5ff0: 6d 65 29 0a 09 09 20 20 20 20 20 20 28 6c 65 74 me)... (let
6000: 2a 20 28 28 73 68 65 65 74 64 61 74 20 28 67 65 * ((sheetdat (ge
6010: 74 2d 64 61 74 20 72 65 73 75 6c 74 73 20 73 68 t-dat results sh
6020: 65 65 74 6e 61 6d 65 29 29 0a 09 09 09 20 20 20 eetname))....
6030: 20 20 28 73 76 65 63 20 20 20 20 20 28 72 65 66 (svec (ref
6040: 64 62 3a 63 73 76 2d 67 65 74 2d 73 76 65 63 20 db:csv-get-svec
6050: 73 68 65 65 74 64 61 74 29 29 0a 09 09 09 20 20 sheetdat))....
6060: 20 20 20 28 6d 61 78 72 6f 77 20 20 20 28 72 65 (maxrow (re
6070: 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 72 fdb:csv-get-maxr
6080: 6f 77 20 73 68 65 65 74 64 61 74 29 29 0a 09 09 ow sheetdat))...
6090: 09 20 20 20 20 20 28 6d 61 78 63 6f 6c 20 20 20 . (maxcol
60a0: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d (refdb:csv-get-m
60b0: 61 78 63 6f 6c 20 73 68 65 65 74 64 61 74 29 29 axcol sheetdat))
60c0: 0a 09 09 09 20 20 20 20 20 28 66 6e 61 6d 65 20 .... (fname
60d0: 20 20 20 28 69 66 20 6f 75 74 2d 66 69 6c 65 20 (if out-file
60e0: 0a 09 09 09 09 09 20 20 20 28 73 74 72 69 6e 67 ...... (string
60f0: 2d 73 75 62 73 74 69 74 75 74 65 20 22 25 73 22 -substitute "%s"
6100: 20 73 68 65 65 74 6e 61 6d 65 20 6f 75 74 2d 66 sheetname out-f
6110: 69 6c 65 29 20 3b 3b 20 22 2f 66 6f 6f 2f 62 61 ile) ;; "/foo/ba
6120: 72 2f 25 73 2e 63 73 76 22 29 0a 09 09 09 09 09 r/%s.csv")......
6130: 20 20 20 28 63 6f 6e 63 20 73 68 65 65 74 6e 61 (conc sheetna
6140: 6d 65 20 22 2e 63 73 76 22 29 29 29 29 0a 09 09 me ".csv"))))...
6150: 09 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f .(with-output-to
6160: 2d 66 69 6c 65 20 66 6e 61 6d 65 0a 09 09 09 20 -file fname....
6170: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 (lambda ()....
6180: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 53 68 ;; (print "Sh
6190: 65 65 74 6e 61 6d 65 3a 20 22 20 73 68 65 65 74 eetname: " sheet
61a0: 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 28 6c 65 name).... (le
61b0: 74 20 6c 6f 6f 70 20 28 28 72 6f 77 20 20 20 20 t loop ((row
61c0: 20 20 20 30 29 0a 09 09 09 09 20 20 20 20 20 20 0).....
61d0: 20 28 63 6f 6c 20 20 20 20 20 20 20 30 29 0a 09 (col 0)..
61e0: 09 09 09 20 20 20 20 20 20 20 28 63 75 72 72 2d ... (curr-
61f0: 72 6f 77 20 27 28 29 29 0a 09 09 09 09 20 20 20 row '()).....
6200: 20 20 20 20 28 72 65 73 75 6c 74 20 20 20 27 28 (result '(
6210: 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 6c 65 ))).... (le
6220: 74 2a 20 28 28 76 61 6c 20 28 73 70 61 72 73 65 t* ((val (sparse
6230: 2d 61 72 72 61 79 2d 72 65 66 20 73 76 65 63 20 -array-ref svec
6240: 72 6f 77 20 63 6f 6c 29 29 0a 09 09 09 09 20 20 row col)).....
6250: 20 20 20 28 64 69 73 70 2d 76 61 6c 20 28 69 66 (disp-val (if
6260: 20 76 61 6c 0a 09 09 09 09 09 09 20 20 20 28 63 val....... (c
6270: 6f 6e 63 20 22 5c 22 22 20 76 61 6c 20 22 5c 22 onc "\"" val "\"
6280: 22 29 0a 09 09 09 09 09 09 20 20 20 22 22 29 29 ")....... ""))
6290: 29 0a 09 09 09 09 28 69 66 20 28 3e 20 63 6f 6c ).....(if (> col
62a0: 20 30 29 28 64 69 73 70 6c 61 79 20 22 2c 22 29 0)(display ",")
62b0: 29 0a 09 09 09 09 28 64 69 73 70 6c 61 79 20 64 ).....(display d
62c0: 69 73 70 2d 76 61 6c 29 0a 09 09 09 09 28 63 6f isp-val).....(co
62d0: 6e 64 0a 09 09 09 09 20 28 28 3e 20 72 6f 77 20 nd..... ((> row
62e0: 6d 61 78 72 6f 77 29 28 64 69 73 70 6c 61 79 20 maxrow)(display
62f0: 22 5c 6e 22 29 20 72 65 73 75 6c 74 29 0a 09 09 "\n") result)...
6300: 09 09 20 28 28 3e 3d 20 63 6f 6c 20 6d 61 78 63 .. ((>= col maxc
6310: 6f 6c 29 0a 09 09 09 09 20 20 28 64 69 73 70 6c ol)..... (displ
6320: 61 79 20 22 5c 6e 22 29 0a 09 09 09 09 20 20 28 ay "\n")..... (
6330: 6c 6f 6f 70 20 28 2b 20 72 6f 77 20 31 29 20 30 loop (+ row 1) 0
6340: 20 27 28 29 20 28 61 70 70 65 6e 64 20 72 65 73 '() (append res
6350: 75 6c 74 20 28 6c 69 73 74 20 63 75 72 72 2d 72 ult (list curr-r
6360: 6f 77 29 29 29 29 0a 09 09 09 09 20 28 65 6c 73 ow))))..... (els
6370: 65 0a 09 09 09 09 20 20 28 6c 6f 6f 70 20 72 6f e..... (loop ro
6380: 77 20 28 2b 20 63 6f 6c 20 31 29 20 28 61 70 70 w (+ col 1) (app
6390: 65 6e 64 20 63 75 72 72 2d 72 6f 77 20 28 6c 69 end curr-row (li
63a0: 73 74 20 76 61 6c 29 29 20 72 65 73 75 6c 74 29 st val)) result)
63b0: 29 29 29 29 29 29 29 29 0a 09 09 20 20 20 20 28 ))))))))... (
63c0: 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 hash-table-keys
63d0: 72 65 73 75 6c 74 73 29 29 29 29 0a 09 09 28 28 results))))...((
63e0: 73 71 6c 69 74 65 33 29 0a 09 09 20 28 6c 65 74 sqlite3)... (let
63f0: 2a 20 28 28 64 62 2d 66 69 6c 65 20 20 20 28 6f * ((db-file (o
6400: 72 20 6f 75 74 2d 66 69 6c 65 20 28 70 61 74 68 r out-file (path
6410: 6e 61 6d 65 2d 66 69 6c 65 20 69 6e 70 75 74 2d name-file input-
6420: 64 62 29 29 29 0a 09 09 09 28 64 62 2d 65 78 69 db)))....(db-exi
6430: 73 74 73 20 28 66 69 6c 65 2d 65 78 69 73 74 73 sts (file-exists
6440: 3f 20 64 62 2d 66 69 6c 65 29 29 0a 09 09 09 28 ? db-file))....(
6450: 64 62 20 20 20 20 20 20 20 20 28 73 71 6c 69 74 db (sqlit
6460: 65 33 3a 6f 70 65 6e 2d 64 61 74 61 62 61 73 65 e3:open-database
6470: 20 64 62 2d 66 69 6c 65 29 29 29 0a 09 09 20 20 db-file)))...
6480: 20 28 69 66 20 28 6e 6f 74 20 64 62 2d 65 78 69 (if (not db-exi
6490: 73 74 73 29 28 73 71 6c 69 74 65 33 3a 65 78 65 sts)(sqlite3:exe
64a0: 63 75 74 65 20 64 62 20 22 43 52 45 41 54 45 20 cute db "CREATE
64b0: 54 41 42 4c 45 20 64 61 74 61 20 28 73 68 65 65 TABLE data (shee
64c0: 74 2c 73 65 63 74 69 6f 6e 2c 76 61 72 2c 76 61 t,section,var,va
64d0: 6c 29 3b 22 29 29 0a 09 09 20 20 20 28 63 6f 6e l);"))... (con
64e0: 66 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 figf:map-all-hie
64f0: 72 2d 61 6c 69 73 74 0a 09 09 20 20 20 20 64 61 r-alist... da
6500: 74 61 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 61 ta... (lambda
6510: 20 28 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 (sheetname sect
6520: 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 ionname varname
6530: 76 61 6c 29 0a 09 09 20 20 20 20 20 20 28 73 71 val)... (sq
6540: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
6550: 0a 09 09 09 09 20 20 20 20 20 20 20 22 49 4e 53 ..... "INS
6560: 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 20 49 ERT OR REPLACE I
6570: 4e 54 4f 20 64 61 74 61 20 28 73 68 65 65 74 2c NTO data (sheet,
6580: 73 65 63 74 69 6f 6e 2c 76 61 72 2c 76 61 6c 29 section,var,val)
6590: 20 56 41 4c 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f VALUES (?,?,?,?
65a0: 29 3b 22 0a 09 09 09 09 20 20 20 20 20 20 20 73 );"..... s
65b0: 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e heetname section
65c0: 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c name varname val
65d0: 29 29 29 0a 09 09 20 20 20 28 73 71 6c 69 74 65 )))... (sqlite
65e0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 3:finalize! db))
65f0: 29 0a 09 09 28 65 6c 73 65 0a 09 09 20 28 70 70 )...(else... (pp
6600: 20 64 61 74 61 29 29 29 29 29 29 0a 20 20 20 20 data)))))).
6610: 20 20 28 69 66 20 6f 75 74 2d 66 69 6c 65 20 28 (if out-file (
6620: 63 6c 6f 73 65 2d 6f 75 74 70 75 74 2d 70 6f 72 close-output-por
6630: 74 20 6f 75 74 2d 70 6f 72 74 29 29 0a 20 20 20 t out-port)).
6640: 20 20 20 28 65 78 69 74 29 20 3b 3b 20 79 65 73 (exit) ;; yes
6650: 2c 20 62 65 6e 64 69 6e 67 20 74 68 65 20 72 75 , bending the ru
6660: 6c 65 73 20 68 65 72 65 20 2d 20 6e 65 65 64 20 les here - need
6670: 74 6f 20 65 78 69 74 20 73 69 6e 63 65 20 74 68 to exit since th
6680: 69 73 20 69 73 20 61 20 75 74 69 6c 69 74 79 0a is is a utility.
6690: 20 20 20 20 20 20 29 29 0a 0a 28 69 66 20 28 61 ))..(if (a
66a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 69 rgs:get-arg "-pi
66b0: 6e 67 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 ng"). (let* (
66c0: 28 72 75 6e 2d 69 64 20 20 20 20 20 20 20 20 28 (run-id (
66d0: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
66e0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
66f0: 75 6e 2d 69 64 22 29 29 29 0a 09 20 20 20 28 68 un-id"))).. (h
6700: 6f 73 74 3a 70 6f 72 74 20 20 20 20 20 28 61 72 ost:port (ar
6710: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 69 6e gs:get-arg "-pin
6720: 67 22 29 29 29 0a 20 20 20 20 20 20 28 73 65 72 g"))). (ser
6730: 76 65 72 3a 70 69 6e 67 20 72 75 6e 2d 69 64 20 ver:ping run-id
6740: 68 6f 73 74 3a 70 6f 72 74 29 29 29 0a 0a 3b 3b host:port)))..;;
6750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6790: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 61 70 74 75 72 ======.;; Captur
67a0: 65 2c 20 73 61 76 65 20 61 6e 64 20 6d 61 6e 69 e, save and mani
67b0: 70 75 6c 61 74 65 20 65 6e 76 69 72 6f 6e 6d 65 pulate environme
67c0: 6e 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d nts.;;==========
67d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
6810: 20 4e 4f 54 45 3a 20 4b 65 65 70 20 74 68 65 73 NOTE: Keep thes
6820: 65 20 61 62 6f 76 65 20 74 68 65 20 73 65 63 74 e above the sect
6830: 69 6f 6e 20 77 68 65 72 65 20 74 68 65 20 73 65 ion where the se
6840: 72 76 65 72 20 6f 72 20 63 6c 69 65 6e 74 20 63 rver or client c
6850: 6f 64 65 20 69 73 20 73 65 74 75 70 0a 0a 28 6c ode is setup..(l
6860: 65 74 20 28 28 65 6e 76 63 61 70 20 28 61 72 67 et ((envcap (arg
6870: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 63 s:get-arg "-envc
6880: 61 70 22 29 29 29 0a 20 20 28 69 66 20 65 6e 76 ap"))). (if env
6890: 63 61 70 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 cap. (let*
68a0: 28 28 64 62 20 20 20 20 20 20 28 65 6e 76 3a 6f ((db (env:o
68b0: 70 65 6e 2d 64 62 20 28 69 66 20 28 6e 75 6c 6c pen-db (if (null
68c0: 3f 20 72 65 6d 61 72 67 73 29 20 22 65 6e 76 64 ? remargs) "envd
68d0: 61 74 2e 64 62 22 20 28 63 61 72 20 72 65 6d 61 at.db" (car rema
68e0: 72 67 73 29 29 29 29 29 0a 09 28 65 6e 76 3a 73 rgs)))))..(env:s
68f0: 61 76 65 2d 65 6e 76 2d 76 61 72 73 20 64 62 20 ave-env-vars db
6900: 65 6e 76 63 61 70 29 0a 09 28 65 6e 76 3a 63 6c envcap)..(env:cl
6910: 6f 73 65 2d 64 61 74 61 62 61 73 65 20 64 62 29 ose-database db)
6920: 0a 09 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 ..(set! *didsome
6930: 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b thing* #t))))..;
6940: 3b 20 64 65 6c 74 61 20 22 6c 61 6e 67 75 61 67 ; delta "languag
6950: 65 22 20 77 69 6c 6c 20 65 76 65 6e 74 75 61 6c e" will eventual
6960: 6c 79 20 62 65 20 72 65 73 3d 61 2b 62 2d 63 20 ly be res=a+b-c
6970: 62 75 74 20 66 6f 72 20 6e 6f 77 20 69 74 20 69 but for now it i
6980: 73 20 6a 75 73 74 20 72 65 73 3d 61 2d 62 20 0a s just res=a-b .
6990: 3b 3b 0a 28 6c 65 74 20 28 28 65 6e 76 64 65 6c ;;.(let ((envdel
69a0: 74 61 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ta (args:get-arg
69b0: 20 22 2d 65 6e 76 64 65 6c 74 61 22 29 29 29 0a "-envdelta"))).
69c0: 20 20 28 69 66 20 65 6e 76 64 65 6c 74 61 0a 20 (if envdelta.
69d0: 20 20 20 20 20 28 6c 65 74 20 28 28 6d 61 74 63 (let ((matc
69e0: 68 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 h (string-split
69f0: 65 6e 76 64 65 6c 74 61 20 22 2d 22 29 29 29 3b envdelta "-")));
6a00: 3b 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 ; (string-match
6a10: 22 28 5b 61 2d 7a 30 2d 39 5f 5d 2b 29 3d 28 5b "([a-z0-9_]+)=([
6a20: 61 2d 7a 30 2d 39 5f 5c 5c 2d 2c 5d 2b 29 22 20 a-z0-9_\\-,]+)"
6a30: 65 6e 76 64 65 6c 74 61 29 29 29 0a 09 28 69 66 envdelta)))..(if
6a40: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 6d 61 74 (not (null? mat
6a50: 63 68 29 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 ch)).. (let*
6a60: 28 28 64 62 20 20 20 20 20 20 20 20 28 65 6e 76 ((db (env
6a70: 3a 6f 70 65 6e 2d 64 62 20 28 69 66 20 28 6e 75 :open-db (if (nu
6a80: 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 22 65 6e ll? remargs) "en
6a90: 76 64 61 74 2e 64 62 22 20 28 63 61 72 20 72 65 vdat.db" (car re
6aa0: 6d 61 72 67 73 29 29 29 29 0a 09 09 20 20 20 3b margs))))... ;
6ab0: 3b 20 28 72 65 73 63 74 78 20 20 20 20 28 63 61 ; (resctx (ca
6ac0: 64 72 20 6d 61 74 63 68 29 29 0a 09 09 20 20 20 dr match))...
6ad0: 3b 3b 20 28 65 71 75 6e 20 20 20 20 20 20 28 63 ;; (equn (c
6ae0: 61 64 64 72 20 6d 61 74 63 68 29 29 0a 09 09 20 addr match))...
6af0: 20 20 28 70 61 72 74 73 20 20 20 20 20 6d 61 74 (parts mat
6b00: 63 68 29 20 3b 3b 20 28 73 74 72 69 6e 67 2d 73 ch) ;; (string-s
6b10: 70 6c 69 74 20 65 71 75 6e 20 22 2d 22 29 29 0a plit equn "-")).
6b20: 09 09 20 20 20 28 6d 69 6e 75 65 6e 64 20 20 20 .. (minuend
6b30: 28 63 61 72 20 70 61 72 74 73 29 29 0a 09 09 20 (car parts))...
6b40: 20 20 28 73 75 62 74 72 61 65 6e 64 20 28 63 61 (subtraend (ca
6b50: 64 72 20 70 61 72 74 73 29 29 0a 09 09 20 20 20 dr parts))...
6b60: 28 61 64 64 65 64 20 20 20 20 20 28 65 6e 76 3a (added (env:
6b70: 67 65 74 2d 61 64 64 65 64 20 20 20 64 62 20 6d get-added db m
6b80: 69 6e 75 65 6e 64 20 73 75 62 74 72 61 65 6e 64 inuend subtraend
6b90: 29 29 0a 09 09 20 20 20 28 72 65 6d 6f 76 65 64 ))... (removed
6ba0: 20 20 20 28 65 6e 76 3a 67 65 74 2d 72 65 6d 6f (env:get-remo
6bb0: 76 65 64 20 64 62 20 6d 69 6e 75 65 6e 64 20 73 ved db minuend s
6bc0: 75 62 74 72 61 65 6e 64 29 29 0a 09 09 20 20 20 ubtraend))...
6bd0: 28 63 68 61 6e 67 65 64 20 20 20 28 65 6e 76 3a (changed (env:
6be0: 67 65 74 2d 63 68 61 6e 67 65 64 20 64 62 20 6d get-changed db m
6bf0: 69 6e 75 65 6e 64 20 73 75 62 74 72 61 65 6e 64 inuend subtraend
6c00: 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 70 ))).. ;; (p
6c10: 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 p (hash-table->a
6c20: 6c 69 73 74 20 61 64 64 65 64 29 29 0a 09 20 20 list added))..
6c30: 20 20 20 20 3b 3b 20 28 70 70 20 28 68 61 73 68 ;; (pp (hash
6c40: 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 72 65 -table->alist re
6c50: 6d 6f 76 65 64 29 29 0a 09 20 20 20 20 20 20 3b moved)).. ;
6c60: 3b 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c ; (pp (hash-tabl
6c70: 65 2d 3e 61 6c 69 73 74 20 63 68 61 6e 67 65 64 e->alist changed
6c80: 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 )).. (if (a
6c90: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 22 rgs:get-arg "-o"
6ca0: 29 0a 09 09 20 20 28 77 69 74 68 2d 6f 75 74 70 )... (with-outp
6cb0: 75 74 2d 74 6f 2d 66 69 6c 65 0a 09 09 20 20 20 ut-to-file...
6cc0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
6cd0: 20 22 2d 6f 22 29 0a 09 09 20 20 20 20 28 6c 61 "-o")... (la
6ce0: 6d 62 64 61 20 28 29 0a 09 09 20 20 20 20 20 20 mbda ()...
6cf0: 28 65 6e 76 3a 70 72 69 6e 74 20 61 64 64 65 64 (env:print added
6d00: 20 72 65 6d 6f 76 65 64 20 63 68 61 6e 67 65 64 removed changed
6d10: 29 29 29 0a 09 09 20 20 28 65 6e 76 3a 70 72 69 )))... (env:pri
6d20: 6e 74 20 61 64 64 65 64 20 72 65 6d 6f 76 65 64 nt added removed
6d30: 20 63 68 61 6e 67 65 64 29 29 0a 09 20 20 20 20 changed))..
6d40: 20 20 28 65 6e 76 3a 63 6c 6f 73 65 2d 64 61 74 (env:close-dat
6d50: 61 62 61 73 65 20 64 62 29 0a 09 20 20 20 20 20 abase db)..
6d60: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
6d70: 68 69 6e 67 2a 20 23 74 29 29 0a 09 20 20 20 20 hing* #t))..
6d80: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
6d90: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
6da0: 67 2d 70 6f 72 74 2a 20 22 50 61 72 61 6d 65 74 g-port* "Paramet
6db0: 65 72 20 74 6f 20 2d 65 6e 76 64 65 6c 74 61 20 er to -envdelta
6dc0: 73 68 6f 75 6c 64 20 62 65 20 6e 65 77 3d 73 74 should be new=st
6dd0: 61 72 2d 65 6e 64 22 29 29 29 29 29 0a 0a 3b 3b ar-end")))))..;;
6de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e20: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 ======.;; Start
6e30: 74 68 65 20 73 65 72 76 65 72 20 2d 20 63 61 6e the server - can
6e40: 20 62 65 20 64 6f 6e 65 20 69 6e 20 63 6f 6e 6a be done in conj
6e50: 75 6e 63 74 69 6f 6e 20 77 69 74 68 20 2d 72 75 unction with -ru
6e60: 6e 61 6c 6c 20 6f 72 20 2d 72 75 6e 74 65 73 74 nall or -runtest
6e70: 73 20 28 6f 6e 65 20 64 61 79 2e 2e 2e 29 0a 3b s (one day...).;
6e80: 3b 20 20 20 77 65 20 73 74 61 72 74 20 74 68 65 ; we start the
6e90: 20 73 65 72 76 65 72 20 69 66 20 6e 6f 74 20 72 server if not r
6ea0: 75 6e 6e 69 6e 67 20 65 6c 73 65 20 73 74 61 72 unning else star
6eb0: 74 20 74 68 65 20 63 6c 69 65 6e 74 20 74 68 72 t the client thr
6ec0: 65 61 64 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ead.;;==========
6ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
6f10: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
6f20: 22 2d 73 65 72 76 65 72 22 29 0a 0a 20 20 20 20 "-server")..
6f30: 3b 3b 20 53 65 72 76 65 72 3f 20 53 74 61 72 74 ;; Server? Start
6f40: 20 75 70 20 68 65 72 65 2e 0a 20 20 20 20 3b 3b up here.. ;;
6f50: 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 20 . (let ((tl
6f60: 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 73 65 (launch:se
6f70: 74 75 70 29 29 0a 09 20 20 28 72 75 6e 2d 69 64 tup)).. (run-id
6f80: 20 20 20 20 28 61 6e 64 20 28 61 72 67 73 3a 67 (and (args:g
6f90: 65 74 2d 61 72 67 20 22 2d 72 75 6e 2d 69 64 22 et-arg "-run-id"
6fa0: 29 0a 09 09 09 20 20 28 73 74 72 69 6e 67 2d 3e ).... (string->
6fb0: 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 number (args:get
6fc0: 2d 61 72 67 20 22 2d 72 75 6e 2d 69 64 22 29 29 -arg "-run-id"))
6fd0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 74 72 )). (tr
6fe0: 61 6e 73 70 6f 72 74 2d 74 79 70 65 20 28 73 74 ansport-type (st
6ff0: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 ring->symbol (or
7000: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7010: 2d 74 72 61 6e 73 70 6f 72 74 22 29 20 22 68 74 -transport") "ht
7020: 74 70 22 29 29 29 29 0a 20 20 20 20 20 20 28 69 tp")))). (i
7030: 66 20 72 75 6e 2d 69 64 0a 09 20 20 28 62 65 67 f run-id.. (beg
7040: 69 6e 0a 09 20 20 20 20 28 73 65 72 76 65 72 3a in.. (server:
7050: 6c 61 75 6e 63 68 20 72 75 6e 2d 69 64 20 74 72 launch run-id tr
7060: 61 6e 73 70 6f 72 74 2d 74 79 70 65 29 0a 09 20 ansport-type)..
7070: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
7080: 65 74 68 69 6e 67 2a 20 23 74 29 29 0a 09 20 20 ething* #t))..
7090: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
70a0: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
70b0: 67 2d 70 6f 72 74 2a 20 22 73 65 72 76 65 72 20 g-port* "server
70c0: 72 65 71 75 69 72 65 73 20 72 75 6e 2d 69 64 20 requires run-id
70d0: 62 65 20 73 70 65 63 69 66 69 65 64 20 77 69 74 be specified wit
70e0: 68 20 2d 72 75 6e 2d 69 64 22 29 29 29 0a 0a 20 h -run-id")))..
70f0: 20 20 20 3b 3b 20 4e 6f 74 20 61 20 73 65 72 76 ;; Not a serv
7100: 65 72 3f 20 54 68 69 73 20 73 65 63 74 69 6f 6e er? This section
7110: 20 77 69 6c 6c 20 64 65 63 69 64 65 20 68 6f 77 will decide how
7120: 20 74 6f 20 63 6f 6d 6d 75 6e 69 63 61 74 65 0a to communicate.
7130: 20 20 20 20 3b 3b 0a 20 20 20 20 3b 3b 20 20 53 ;;. ;; S
7140: 65 74 75 70 20 63 6c 69 65 6e 74 20 66 6f 72 20 etup client for
7150: 61 6c 6c 20 65 78 70 65 63 74 20 6c 69 73 74 65 all expect liste
7160: 64 20 68 65 72 65 0a 20 20 20 20 28 69 66 20 28 d here. (if (
7170: 6e 75 6c 6c 3f 20 28 6c 73 65 74 2d 69 6e 74 65 null? (lset-inte
7180: 72 73 65 63 74 69 6f 6e 20 0a 09 09 65 71 75 61 rsection ...equa
7190: 6c 3f 0a 09 09 28 68 61 73 68 2d 74 61 62 6c 65 l?...(hash-table
71a0: 2d 6b 65 79 73 20 61 72 67 73 3a 61 72 67 2d 68 -keys args:arg-h
71b0: 61 73 68 29 0a 09 09 27 28 22 2d 6c 69 73 74 2d ash)...'("-list-
71c0: 73 65 72 76 65 72 73 22 0a 09 09 20 20 22 2d 73 servers"... "-s
71d0: 74 6f 70 2d 73 65 72 76 65 72 22 0a 20 20 20 20 top-server".
71e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 2d "-
71f0: 6b 69 6c 6c 2d 73 65 72 76 65 72 22 0a 09 09 20 kill-server"...
7200: 20 22 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 6f 22 "-show-cmdinfo"
7210: 0a 09 09 20 20 22 2d 6c 69 73 74 2d 72 75 6e 73 ... "-list-runs
7220: 22 0a 09 09 20 20 22 2d 70 69 6e 67 22 29 29 29 "... "-ping")))
7230: 0a 09 28 69 66 20 28 6c 61 75 6e 63 68 3a 73 65 ..(if (launch:se
7240: 74 75 70 29 0a 09 20 20 20 20 28 6c 65 74 20 28 tup).. (let (
7250: 28 72 75 6e 2d 69 64 20 20 20 20 28 61 6e 64 20 (run-id (and
7260: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7270: 72 75 6e 2d 69 64 22 29 0a 09 09 09 09 20 20 28 run-id")..... (
7280: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
7290: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
72a0: 75 6e 2d 69 64 22 29 29 29 29 29 0a 09 20 20 20 un-id")))))..
72b0: 20 20 20 3b 3b 20 28 73 65 74 21 20 2a 66 64 62 ;; (set! *fdb
72c0: 2a 20 20 20 28 66 69 6c 65 64 62 3a 6f 70 65 6e * (filedb:open
72d0: 2d 64 62 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 -db (conc *toppa
72e0: 74 68 2a 20 22 2f 64 62 2f 70 61 74 68 73 2e 64 th* "/db/paths.d
72f0: 62 22 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 b"))).. ;;
7300: 69 66 20 6e 6f 74 20 6c 69 73 74 20 6f 72 20 6b if not list or k
7310: 69 6c 6c 20 74 68 65 6e 20 73 74 61 72 74 20 61 ill then start a
7320: 20 63 6c 69 65 6e 74 20 28 69 66 20 61 70 70 72 client (if appr
7330: 6f 70 72 69 61 74 65 29 0a 09 20 20 20 20 20 20 opriate)..
7340: 28 69 66 20 28 6f 72 20 28 61 72 67 73 2d 64 65 (if (or (args-de
7350: 66 69 6e 65 64 3f 20 22 2d 68 22 20 22 2d 76 65 fined? "-h" "-ve
7360: 72 73 69 6f 6e 22 20 22 2d 63 72 65 61 74 65 2d rsion" "-create-
7370: 6d 65 67 61 74 65 73 74 2d 61 72 65 61 22 20 22 megatest-area" "
7380: 2d 63 72 65 61 74 65 2d 74 65 73 74 22 29 0a 09 -create-test")..
7390: 09 20 20 20 20 20 20 28 65 71 3f 20 28 6c 65 6e . (eq? (len
73a0: 67 74 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d gth (hash-table-
73b0: 6b 65 79 73 20 61 72 67 73 3a 61 72 67 2d 68 61 keys args:arg-ha
73c0: 73 68 29 29 20 30 29 29 0a 09 09 20 20 28 64 65 sh)) 0))... (de
73d0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 bug:print-info 1
73e0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
73f0: 72 74 2a 20 22 53 65 72 76 65 72 20 63 6f 6e 6e rt* "Server conn
7400: 65 63 74 69 6f 6e 20 6e 6f 74 20 6e 65 65 64 65 ection not neede
7410: 64 22 29 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 d")... (begin..
7420: 09 20 20 20 20 3b 3b 20 28 69 66 20 72 75 6e 2d . ;; (if run-
7430: 69 64 20 0a 09 09 20 20 20 20 3b 3b 20 20 20 20 id ... ;;
7440: 20 28 63 6c 69 65 6e 74 3a 6c 61 75 6e 63 68 20 (client:launch
7450: 72 75 6e 2d 69 64 29 20 0a 09 09 20 20 20 20 3b run-id) ... ;
7460: 3b 20 20 20 20 20 28 63 6c 69 65 6e 74 3a 6c 61 ; (client:la
7470: 75 6e 63 68 20 30 29 20 20 20 20 20 20 3b 3b 20 unch 0) ;;
7480: 77 69 74 68 6f 75 74 20 72 75 6e 2d 69 64 20 77 without run-id w
7490: 65 27 6c 6c 20 73 74 61 72 74 20 61 20 73 65 72 e'll start a ser
74a0: 76 65 72 20 66 6f 72 20 22 30 22 0a 09 09 20 20 ver for "0"...
74b0: 20 20 23 74 0a 09 09 20 20 20 20 29 29 29 29 29 #t... )))))
74c0: 29 0a 0a 3b 3b 20 4d 41 59 20 53 54 49 4c 4c 20 )..;; MAY STILL
74d0: 4e 45 45 44 20 54 48 49 53 0a 3b 3b 09 09 20 20 NEED THIS.;;..
74e0: 20 20 20 20 20 28 73 65 74 21 20 2a 6d 65 67 61 (set! *mega
74f0: 74 65 73 74 2d 64 62 2a 20 28 6d 61 6b 65 2d 64 test-db* (make-d
7500: 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 68 br:dbstruct path
7510: 3a 20 2a 74 6f 70 70 61 74 68 2a 20 6c 6f 63 61 : *toppath* loca
7520: 6c 3a 20 23 74 29 29 29 29 29 29 29 29 29 29 0a l: #t)))))))))).
7530: 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 .(if (or (args:g
7540: 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 73 65 et-arg "-list-se
7550: 72 76 65 72 73 22 29 0a 09 28 61 72 67 73 3a 67 rvers")..(args:g
7560: 65 74 2d 61 72 67 20 22 2d 73 74 6f 70 2d 73 65 et-arg "-stop-se
7570: 72 76 65 72 22 29 0a 20 20 20 20 20 20 20 20 28 rver"). (
7580: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6b args:get-arg "-k
7590: 69 6c 6c 2d 73 65 72 76 65 72 22 29 29 0a 20 20 ill-server")).
75a0: 20 20 28 6c 65 74 20 28 28 74 6c 20 28 6c 61 75 (let ((tl (lau
75b0: 6e 63 68 3a 73 65 74 75 70 29 29 29 0a 20 20 20 nch:setup))).
75c0: 20 20 20 28 69 66 20 74 6c 20 0a 09 20 20 28 6c (if tl .. (l
75d0: 65 74 2a 20 28 28 74 64 62 64 61 74 20 20 28 74 et* ((tdbdat (t
75e0: 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 29 0a 09 asks:open-db))..
75f0: 09 20 28 73 65 72 76 65 72 73 20 28 74 61 73 6b . (servers (task
7600: 73 3a 67 65 74 2d 61 6c 6c 2d 73 65 72 76 65 72 s:get-all-server
7610: 73 20 28 64 62 3a 64 65 6c 61 79 2d 69 66 2d 62 s (db:delay-if-b
7620: 75 73 79 20 74 64 62 64 61 74 29 29 29 0a 09 09 usy tdbdat)))...
7630: 20 28 66 6d 74 73 74 72 20 20 22 7e 35 61 7e 31 (fmtstr "~5a~1
7640: 32 61 7e 38 61 7e 32 30 61 7e 32 34 61 7e 31 30 2a~8a~20a~24a~10
7650: 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 5c 6e 22 a~10a~10a~10a\n"
7660: 29 0a 09 09 20 28 73 65 72 76 65 72 73 2d 74 6f )... (servers-to
7670: 2d 6b 69 6c 6c 20 27 28 29 29 0a 20 20 20 20 20 -kill '()).
7680: 20 20 20 20 20 20 20 20 20 20 20 20 28 6b 69 6c (kil
7690: 6c 2d 73 77 69 74 63 68 20 20 28 69 66 20 28 61 l-switch (if (a
76a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6b 69 rgs:get-arg "-ki
76b0: 6c 6c 2d 73 65 72 76 65 72 22 29 20 22 2d 39 22 ll-server") "-9"
76c0: 20 22 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 "")).
76d0: 20 20 20 20 20 20 20 28 6b 69 6c 6c 69 6e 66 6f (killinfo
76e0: 20 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 (or (args:get
76f0: 2d 61 72 67 20 22 2d 73 74 6f 70 2d 73 65 72 76 -arg "-stop-serv
7700: 65 72 22 29 20 28 61 72 67 73 3a 67 65 74 2d 61 er") (args:get-a
7710: 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 rg "-kill-server
7720: 22 29 20 29 29 0a 09 09 20 28 6b 68 6f 73 74 2d ") ))... (khost-
7730: 70 6f 72 74 20 28 69 66 20 6b 69 6c 6c 69 6e 66 port (if killinf
7740: 6f 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 o (if (substring
7750: 2d 69 6e 64 65 78 20 22 3a 22 20 6b 69 6c 6c 69 -index ":" killi
7760: 6e 66 6f 29 28 73 74 72 69 6e 67 2d 73 70 6c 69 nfo)(string-spli
7770: 74 20 22 3a 22 29 20 23 66 29 20 23 66 29 29 0a t ":") #f) #f)).
7780: 09 09 20 28 73 69 64 20 20 20 20 20 20 20 20 28 .. (sid (
7790: 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 69 66 20 if killinfo (if
77a0: 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 (substring-index
77b0: 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f 29 20 23 ":" killinfo) #
77c0: 66 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 f (string->numbe
77d0: 72 20 6b 69 6c 6c 69 6e 66 6f 29 29 20 23 66 29 r killinfo)) #f)
77e0: 29 29 0a 09 20 20 20 20 28 66 6f 72 6d 61 74 20 )).. (format
77f0: 23 74 20 66 6d 74 73 74 72 20 22 49 64 22 20 22 #t fmtstr "Id" "
7800: 4d 54 76 65 72 22 20 22 50 69 64 22 20 22 48 6f MTver" "Pid" "Ho
7810: 73 74 22 20 22 49 6e 74 65 72 66 61 63 65 3a 4f st" "Interface:O
7820: 75 74 50 6f 72 74 22 20 22 49 6e 50 6f 72 74 22 utPort" "InPort"
7830: 20 22 4c 61 73 74 42 65 61 74 22 20 22 53 74 61 "LastBeat" "Sta
7840: 74 65 22 20 22 54 72 61 6e 73 70 6f 72 74 22 29 te" "Transport")
7850: 0a 09 20 20 20 20 28 66 6f 72 6d 61 74 20 23 74 .. (format #t
7860: 20 66 6d 74 73 74 72 20 22 3d 3d 22 20 22 3d 3d fmtstr "==" "==
7870: 3d 3d 3d 22 20 22 3d 3d 3d 22 20 22 3d 3d 3d 3d ===" "===" "====
7880: 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d " "=============
7890: 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 22 20 22 ====" "======" "
78a0: 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d ========" "=====
78b0: 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 29 0a 09 " "=========")..
78c0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 (for-each ..
78d0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 (lambda (se
78e0: 72 76 65 72 29 0a 09 20 20 20 20 20 20 20 28 6c rver).. (l
78f0: 65 74 2a 20 28 28 69 64 20 20 20 20 20 20 20 20 et* ((id
7900: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
7910: 76 65 72 20 30 29 29 0a 09 09 20 20 20 20 20 20 ver 0))...
7920: 28 70 69 64 20 20 20 20 20 20 20 20 28 76 65 63 (pid (vec
7930: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 tor-ref server 1
7940: 29 29 0a 09 09 20 20 20 20 20 20 28 68 6f 73 74 ))... (host
7950: 6e 61 6d 65 20 20 20 28 76 65 63 74 6f 72 2d 72 name (vector-r
7960: 65 66 20 73 65 72 76 65 72 20 32 29 29 0a 09 09 ef server 2))...
7970: 20 20 20 20 20 20 28 69 6e 74 65 72 66 61 63 65 (interface
7980: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
7990: 72 76 65 72 20 33 29 29 20 0a 09 09 20 20 20 20 rver 3)) ...
79a0: 20 20 28 70 75 6c 6c 70 6f 72 74 20 20 20 28 76 (pullport (v
79b0: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
79c0: 20 34 29 29 0a 09 09 20 20 20 20 20 20 28 70 75 4))... (pu
79d0: 62 70 6f 72 74 20 20 20 20 28 76 65 63 74 6f 72 bport (vector
79e0: 2d 72 65 66 20 73 65 72 76 65 72 20 35 29 29 0a -ref server 5)).
79f0: 09 09 20 20 20 20 20 20 28 73 74 61 72 74 2d 74 .. (start-t
7a00: 69 6d 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ime (vector-ref
7a10: 73 65 72 76 65 72 20 36 29 29 0a 09 09 20 20 20 server 6))...
7a20: 20 20 20 28 70 72 69 6f 72 69 74 79 20 20 20 28 (priority (
7a30: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
7a40: 72 20 37 29 29 0a 09 09 20 20 20 20 20 20 28 73 r 7))... (s
7a50: 74 61 74 65 20 20 20 20 20 20 28 76 65 63 74 6f tate (vecto
7a60: 72 2d 72 65 66 20 73 65 72 76 65 72 20 38 29 29 r-ref server 8))
7a70: 0a 09 09 20 20 20 20 20 20 28 6d 74 2d 76 65 72 ... (mt-ver
7a80: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref
7a90: 20 73 65 72 76 65 72 20 39 29 29 0a 09 09 20 20 server 9))...
7aa0: 20 20 20 20 28 6c 61 73 74 2d 75 70 64 61 74 65 (last-update
7ab0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
7ac0: 76 65 72 20 31 30 29 29 20 0a 09 09 20 20 20 20 ver 10)) ...
7ad0: 20 20 28 74 72 61 6e 73 70 6f 72 74 20 20 28 76 (transport (v
7ae0: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
7af0: 20 31 31 29 29 0a 09 09 20 20 20 20 20 20 28 6b 11))... (k
7b00: 69 6c 6c 65 64 20 20 20 20 20 23 66 29 0a 09 09 illed #f)...
7b10: 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 (status
7b20: 20 20 28 3c 20 6c 61 73 74 2d 75 70 64 61 74 65 (< last-update
7b30: 20 32 30 29 29 29 0a 09 09 20 3b 3b 20 20 20 28 20)))... ;; (
7b40: 7a 6d 71 2d 73 6f 63 6b 65 74 73 20 28 69 66 20 zmq-sockets (if
7b50: 73 74 61 74 75 73 20 28 73 65 72 76 65 72 3a 63 status (server:c
7b60: 6c 69 65 6e 74 2d 63 6f 6e 6e 65 63 74 20 68 6f lient-connect ho
7b70: 73 74 6e 61 6d 65 20 70 6f 72 74 29 20 23 66 29 stname port) #f)
7b80: 29 29 0a 09 09 20 3b 3b 20 6e 6f 20 6e 65 65 64 ))... ;; no need
7b90: 20 74 6f 20 6c 6f 67 69 6e 20 61 73 20 73 74 61 to login as sta
7ba0: 74 75 73 20 6f 66 20 23 74 20 69 6e 64 69 63 61 tus of #t indica
7bb0: 74 65 73 20 77 65 20 61 72 65 20 63 6f 6e 6e 65 tes we are conne
7bc0: 63 74 69 6e 67 20 74 6f 20 63 6f 72 72 65 63 74 cting to correct
7bd0: 20 0a 09 09 20 3b 3b 20 73 65 72 76 65 72 0a 09 ... ;; server..
7be0: 09 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 . (if (equal? st
7bf0: 61 74 65 20 22 64 65 61 64 22 29 0a 09 09 20 20 ate "dead")...
7c00: 20 20 20 28 69 66 20 28 3e 20 6c 61 73 74 2d 75 (if (> last-u
7c10: 70 64 61 74 65 20 28 2a 20 32 35 20 36 30 20 36 pdate (* 25 60 6
7c20: 30 29 29 20 3b 3b 20 6b 65 65 70 20 72 65 63 6f 0)) ;; keep reco
7c30: 72 64 73 20 61 72 6f 75 6e 64 20 66 6f 72 20 73 rds around for s
7c40: 6c 69 67 68 6c 79 20 6f 76 65 72 20 61 20 64 61 lighly over a da
7c50: 79 2e 0a 09 09 09 20 28 74 61 73 6b 73 3a 73 65 y..... (tasks:se
7c60: 72 76 65 72 2d 64 65 72 65 67 69 73 74 65 72 20 rver-deregister
7c70: 28 64 62 3a 64 65 6c 61 79 2d 69 66 2d 62 75 73 (db:delay-if-bus
7c80: 79 20 74 64 62 64 61 74 29 20 68 6f 73 74 6e 61 y tdbdat) hostna
7c90: 6d 65 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 6c me pullport: pul
7ca0: 6c 70 6f 72 74 20 70 69 64 3a 20 70 69 64 20 61 lport pid: pid a
7cb0: 63 74 69 6f 6e 3a 20 27 64 65 6c 65 74 65 29 29 ction: 'delete))
7cc0: 0a 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 6c ... (if (> l
7cd0: 61 73 74 2d 75 70 64 61 74 65 20 32 30 29 20 20 ast-update 20)
7ce0: 20 20 20 20 20 20 3b 3b 20 4d 61 72 6b 20 61 73 ;; Mark as
7cf0: 20 64 65 61 64 20 69 66 20 6e 6f 74 20 75 70 64 dead if not upd
7d00: 61 74 65 64 20 69 6e 20 6c 61 73 74 20 32 30 20 ated in last 20
7d10: 73 65 63 6f 6e 64 73 0a 09 09 09 20 28 74 61 73 seconds.... (tas
7d20: 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 ks:server-deregi
7d30: 73 74 65 72 20 28 64 62 3a 64 65 6c 61 79 2d 69 ster (db:delay-i
7d40: 66 2d 62 75 73 79 20 74 64 62 64 61 74 29 20 68 f-busy tdbdat) h
7d50: 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 74 ostname pullport
7d60: 3a 20 70 75 6c 6c 70 6f 72 74 20 70 69 64 3a 20 : pullport pid:
7d70: 70 69 64 29 29 29 0a 09 09 20 28 66 6f 72 6d 61 pid)))... (forma
7d80: 74 20 23 74 20 66 6d 74 73 74 72 20 69 64 20 6d t #t fmtstr id m
7d90: 74 2d 76 65 72 20 70 69 64 20 68 6f 73 74 6e 61 t-ver pid hostna
7da0: 6d 65 20 28 63 6f 6e 63 20 69 6e 74 65 72 66 61 me (conc interfa
7db0: 63 65 20 22 3a 22 20 70 75 6c 6c 70 6f 72 74 29 ce ":" pullport)
7dc0: 20 70 75 62 70 6f 72 74 20 6c 61 73 74 2d 75 70 pubport last-up
7dd0: 64 61 74 65 0a 09 09 09 20 28 69 66 20 73 74 61 date.... (if sta
7de0: 74 75 73 20 22 61 6c 69 76 65 22 20 22 64 65 61 tus "alive" "dea
7df0: 64 22 29 20 74 72 61 6e 73 70 6f 72 74 29 0a 09 d") transport)..
7e00: 09 20 28 69 66 20 28 6f 72 20 28 65 71 75 61 6c . (if (or (equal
7e10: 3f 20 69 64 20 73 69 64 29 0a 09 09 09 20 28 65 ? id sid).... (e
7e20: 71 75 61 6c 3f 20 73 69 64 20 30 29 29 20 3b 3b qual? sid 0)) ;;
7e30: 20 6b 69 6c 6c 20 61 6c 6c 2f 61 6e 79 0a 09 09 kill all/any...
7e40: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 (begin...
7e50: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
7e60: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
7e70: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 41 74 74 t-log-port* "Att
7e80: 65 6d 70 74 69 6e 67 20 74 6f 20 6b 69 6c 6c 20 empting to kill
7e90: 22 6b 69 6c 6c 2d 73 77 69 74 63 68 22 20 73 65 "kill-switch" se
7ea0: 72 76 65 72 20 77 69 74 68 20 70 69 64 20 22 20 rver with pid "
7eb0: 70 69 64 29 0a 09 09 20 20 20 20 20 20 20 28 74 pid)... (t
7ec0: 61 73 6b 73 3a 6b 69 6c 6c 2d 73 65 72 76 65 72 asks:kill-server
7ed0: 20 68 6f 73 74 6e 61 6d 65 20 70 69 64 20 6b 69 hostname pid ki
7ee0: 6c 6c 2d 73 77 69 74 63 68 3a 20 6b 69 6c 6c 2d ll-switch: kill-
7ef0: 73 77 69 74 63 68 29 29 29 29 29 0a 09 20 20 20 switch)))))..
7f00: 20 20 73 65 72 76 65 72 73 29 0a 09 20 20 20 20 servers)..
7f10: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
7f20: 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 1 *default-log
7f30: 2d 70 6f 72 74 2a 20 22 44 6f 6e 65 20 77 69 74 -port* "Done wit
7f40: 68 20 6c 69 73 74 73 65 72 76 65 72 73 22 29 0a h listservers").
7f50: 09 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 . (set! *dids
7f60: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 omething* #t)..
7f70: 20 20 20 28 65 78 69 74 29 29 20 3b 3b 20 6d 75 (exit)) ;; mu
7f80: 73 74 20 64 6f 2c 20 77 6f 75 6c 64 20 68 61 76 st do, would hav
7f90: 65 20 74 6f 20 61 64 64 20 63 68 65 63 6b 73 20 e to add checks
7fa0: 74 6f 20 6d 61 6e 79 2f 61 6c 6c 20 63 61 6c 6c to many/all call
7fb0: 73 20 62 65 6c 6f 77 0a 09 20 20 28 65 78 69 74 s below.. (exit
7fc0: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
7fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
8010: 3b 20 57 65 69 72 64 20 73 70 65 63 69 61 6c 20 ; Weird special
8020: 63 61 6c 6c 73 20 74 68 61 74 20 6e 65 65 64 20 calls that need
8030: 74 6f 20 72 75 6e 20 2a 61 66 74 65 72 2a 20 74 to run *after* t
8040: 68 65 20 73 65 72 76 65 72 20 68 61 73 20 73 74 he server has st
8050: 61 72 74 65 64 3f 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d arted?.;;=======
8060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
80a0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
80b0: 72 67 20 22 2d 6c 69 73 74 2d 74 61 72 67 65 74 rg "-list-target
80c0: 73 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 s"). (let ((t
80d0: 61 72 67 65 74 73 20 28 63 6f 6d 6d 6f 6e 3a 67 argets (common:g
80e0: 65 74 2d 72 75 6e 63 6f 6e 66 69 67 2d 74 61 72 et-runconfig-tar
80f0: 67 65 74 73 29 29 29 0a 20 20 20 20 20 20 28 64 gets))). (d
8100: 65 62 75 67 3a 70 72 69 6e 74 20 31 20 2a 64 65 ebug:print 1 *de
8110: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
8120: 22 46 6f 75 6e 64 20 22 28 6c 65 6e 67 74 68 20 "Found "(length
8130: 74 61 72 67 65 74 73 29 20 22 20 74 61 72 67 65 targets) " targe
8140: 74 73 22 29 0a 20 20 20 20 20 20 28 63 61 73 65 ts"). (case
8150: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
8160: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
8170: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 rg "-dumpmode")
8180: 22 61 6c 69 73 74 22 29 29 0a 09 28 28 61 6c 69 "alist"))..((ali
8190: 73 74 29 0a 09 20 28 66 6f 72 2d 65 61 63 68 20 st).. (for-each
81a0: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 20 20 (lambda (x)...
81b0: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 5b 22 ;; (print "["
81c0: 20 78 20 22 5d 22 29 29 0a 09 09 20 20 20 20 20 x "]"))...
81d0: 28 70 72 69 6e 74 20 78 29 29 0a 09 09 20 20 20 (print x))...
81e0: 74 61 72 67 65 74 73 29 29 0a 09 28 28 6a 73 6f targets))..((jso
81f0: 6e 29 0a 09 20 28 6a 73 6f 6e 2d 77 72 69 74 65 n).. (json-write
8200: 20 74 61 72 67 65 74 73 29 29 0a 09 28 65 6c 73 targets))..(els
8210: 65 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 e.. (debug:print
8220: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
8230: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 64 75 6d t-log-port* "dum
8240: 70 20 6f 75 74 70 75 74 20 66 6f 72 6d 61 74 20 p output format
8250: 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 " (args:get-arg
8260: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e "-dumpmode") " n
8270: 6f 74 20 73 75 70 70 6f 72 74 65 64 20 66 6f 72 ot supported for
8280: 20 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 22 29 -list-targets")
8290: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
82a0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
82b0: 29 29 29 0a 0a 3b 3b 20 63 61 63 68 65 20 74 68 )))..;; cache th
82c0: 65 20 72 75 6e 63 6f 6e 66 69 67 73 20 69 6e 20 e runconfigs in
82d0: 24 4d 54 5f 4c 49 4e 4b 54 52 45 45 2f 24 4d 54 $MT_LINKTREE/$MT
82e0: 5f 54 41 52 47 45 54 2f 24 4d 54 5f 52 55 4e 4e _TARGET/$MT_RUNN
82f0: 41 4d 45 2f 2e 72 75 6e 63 6f 6e 66 69 67 0a 3b AME/.runconfig.;
8300: 3b 0a 28 64 65 66 69 6e 65 20 28 66 75 6c 6c 2d ;.(define (full-
8310: 72 75 6e 63 6f 6e 66 69 67 73 2d 72 65 61 64 29 runconfigs-read)
8320: 0a 3b 3b 20 69 6e 20 74 68 65 20 65 6e 76 70 72 .;; in the envpr
8330: 6f 63 65 73 73 69 6e 67 20 62 72 61 6e 63 68 20 ocessing branch
8340: 74 68 65 20 62 65 6c 6f 77 20 63 6f 64 65 20 72 the below code r
8350: 65 70 6c 61 63 65 73 20 74 68 65 20 66 75 72 74 eplaces the furt
8360: 68 65 72 20 62 65 6c 6f 77 20 63 6f 64 65 0a 3b her below code.;
8370: 3b 20 20 28 69 66 20 28 65 71 3f 20 2a 63 6f 6e ; (if (eq? *con
8380: 66 69 67 73 74 61 74 75 73 2a 20 27 66 75 6c 6c figstatus* 'full
8390: 64 61 74 61 29 0a 3b 3b 20 20 20 20 20 20 2a 72 data).;; *r
83a0: 75 6e 63 6f 6e 66 69 67 64 61 74 2a 0a 3b 3b 20 unconfigdat*.;;
83b0: 20 20 20 20 20 28 62 65 67 69 6e 0a 3b 3b 09 28 (begin.;;.(
83c0: 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 0a 3b 3b launch:setup).;;
83d0: 09 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 29 .*runconfigdat*)
83e0: 29 29 0a 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 )).. (let* ((ru
83f0: 6e 64 69 72 20 28 69 66 20 28 61 6e 64 20 28 67 ndir (if (and (g
8400: 65 74 65 6e 76 20 22 4d 54 5f 4c 49 4e 4b 54 52 etenv "MT_LINKTR
8410: 45 45 22 29 28 67 65 74 65 6e 76 20 22 4d 54 5f EE")(getenv "MT_
8420: 54 41 52 47 45 54 22 29 28 67 65 74 65 6e 76 20 TARGET")(getenv
8430: 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 29 29 0a 09 "MT_RUNNAME"))..
8440: 09 20 20 20 20 20 28 63 6f 6e 63 20 28 67 65 74 . (conc (get
8450: 65 6e 76 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 env "MT_LINKTREE
8460: 22 29 20 22 2f 22 20 28 67 65 74 65 6e 76 20 22 ") "/" (getenv "
8470: 4d 54 5f 54 41 52 47 45 54 22 29 20 22 2f 22 20 MT_TARGET") "/"
8480: 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 4e (getenv "MT_RUNN
8490: 41 4d 45 22 29 29 0a 09 09 20 20 20 20 20 23 66 AME"))... #f
84a0: 29 29 0a 09 20 28 63 66 67 66 20 20 20 28 69 66 )).. (cfgf (if
84b0: 20 72 75 6e 64 69 72 20 28 63 6f 6e 63 20 72 75 rundir (conc ru
84c0: 6e 64 69 72 20 22 2f 2e 72 75 6e 63 6f 6e 66 69 ndir "/.runconfi
84d0: 67 2e 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 g." megatest-ver
84e0: 73 69 6f 6e 20 22 2d 22 20 6d 65 67 61 74 65 73 sion "-" megates
84f0: 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 29 20 23 t-fossil-hash) #
8500: 66 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 6e f))). (if (an
8510: 64 20 63 66 67 66 0a 09 20 20 20 20 20 28 66 69 d cfgf.. (fi
8520: 6c 65 2d 65 78 69 73 74 73 3f 20 63 66 67 66 29 le-exists? cfgf)
8530: 0a 09 20 20 20 20 20 28 66 69 6c 65 2d 77 72 69 .. (file-wri
8540: 74 65 2d 61 63 63 65 73 73 3f 20 63 66 67 66 29 te-access? cfgf)
8550: 29 0a 09 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 )..(configf:read
8560: 2d 61 6c 69 73 74 20 63 66 67 66 29 0a 09 28 6c -alist cfgf)..(l
8570: 65 74 2a 20 28 28 6b 65 79 73 20 20 20 28 72 6d et* ((keys (rm
8580: 74 3a 67 65 74 2d 6b 65 79 73 29 29 0a 09 20 20 t:get-keys))..
8590: 20 20 20 20 20 28 74 61 72 67 65 74 20 28 63 6f (target (co
85a0: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 mmon:args-get-ta
85b0: 72 67 65 74 29 29 0a 09 20 20 20 20 20 20 20 28 rget)).. (
85c0: 6b 65 79 2d 76 61 6c 73 20 28 69 66 20 74 61 72 key-vals (if tar
85d0: 67 65 74 20 28 6b 65 79 73 3a 74 61 72 67 65 74 get (keys:target
85e0: 2d 3e 6b 65 79 76 61 6c 20 6b 65 79 73 20 74 61 ->keyval keys ta
85f0: 72 67 65 74 29 20 23 66 29 29 0a 09 20 20 20 20 rget) #f))..
8600: 20 20 20 28 73 65 63 74 69 6f 6e 73 20 28 69 66 (sections (if
8610: 20 74 61 72 67 65 74 20 28 6c 69 73 74 20 22 64 target (list "d
8620: 65 66 61 75 6c 74 22 20 74 61 72 67 65 74 29 20 efault" target)
8630: 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 64 61 #f)).. (da
8640: 74 61 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ta (begin...
8650: 09 20 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f . (setenv "MT_
8660: 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 2a RUN_AREA_HOME" *
8670: 74 6f 70 70 61 74 68 2a 29 0a 09 09 09 20 20 20 toppath*)....
8680: 28 69 66 20 6b 65 79 2d 76 61 6c 73 0a 09 09 09 (if key-vals....
8690: 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 (for-each
86a0: 20 28 6c 61 6d 62 64 61 20 28 6b 74 29 0a 09 09 (lambda (kt)...
86b0: 09 09 09 20 20 20 28 73 65 74 65 6e 76 20 28 63 ... (setenv (c
86c0: 61 72 20 6b 74 29 20 28 63 61 64 72 20 6b 74 29 ar kt) (cadr kt)
86d0: 29 29 0a 09 09 09 09 09 20 6b 65 79 2d 76 61 6c ))...... key-val
86e0: 73 29 29 0a 09 09 09 20 20 20 28 72 65 61 64 2d s)).... (read-
86f0: 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 2a 74 6f config (conc *to
8700: 70 70 61 74 68 2a 20 22 2f 72 75 6e 63 6f 6e 66 ppath* "/runconf
8710: 69 67 73 2e 63 6f 6e 66 69 67 22 29 20 23 66 20 igs.config") #f
8720: 23 74 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 #t sections: sec
8730: 74 69 6f 6e 73 29 29 29 29 0a 09 20 20 28 69 66 tions)))).. (if
8740: 20 28 61 6e 64 20 72 75 6e 64 69 72 20 3b 3b 20 (and rundir ;;
8750: 68 61 76 65 20 61 6c 6c 20 6e 65 65 64 65 64 20 have all needed
8760: 76 61 72 69 61 62 6c 65 73 73 0a 09 09 20 20 20 variabless...
8770: 28 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 (directory-exist
8780: 73 3f 20 72 75 6e 64 69 72 29 0a 09 09 20 20 20 s? rundir)...
8790: 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 (file-write-acce
87a0: 73 73 3f 20 72 75 6e 64 69 72 29 29 0a 09 20 20 ss? rundir))..
87b0: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 63 6f (begin...(co
87c0: 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 73 nfigf:write-alis
87d0: 74 20 64 61 74 61 20 63 66 67 66 29 0a 09 09 3b t data cfgf)...;
87e0: 3b 20 66 6f 72 63 65 20 72 65 2d 72 65 61 64 20 ; force re-read
87f0: 6f 66 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 of megatest.conf
8800: 69 67 20 2d 20 74 68 69 73 20 72 65 73 6f 6c 76 ig - this resolv
8810: 65 73 20 63 69 72 63 75 6c 61 72 20 72 65 66 65 es circular refe
8820: 72 65 6e 63 65 73 20 62 65 74 77 65 65 6e 20 6d rences between m
8830: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 0a 09 egatest.config..
8840: 09 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 20 66 .(launch:setup f
8850: 6f 72 63 65 3a 20 23 74 29 0a 09 09 28 6c 61 75 orce: #t)...(lau
8860: 6e 63 68 3a 63 61 63 68 65 2d 63 6f 6e 66 69 67 nch:cache-config
8870: 29 29 29 20 3b 3b 20 77 65 20 63 61 6e 20 73 61 ))) ;; we can sa
8880: 66 65 6c 79 20 63 61 63 68 65 20 6d 65 67 61 74 fely cache megat
8890: 65 73 74 2e 63 6f 6e 66 69 67 20 73 69 6e 63 65 est.config since
88a0: 20 77 65 20 68 61 76 65 20 61 20 76 61 6c 69 64 we have a valid
88b0: 20 72 75 6e 63 6f 6e 66 69 67 0a 09 20 20 64 61 runconfig.. da
88c0: 74 61 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 ta))))..(if (arg
88d0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 s:get-arg "-show
88e0: 2d 72 75 6e 63 6f 6e 66 69 67 22 29 0a 20 20 20 -runconfig").
88f0: 20 28 6c 65 74 20 28 28 74 6c 20 28 6c 61 75 6e (let ((tl (laun
8900: 63 68 3a 73 65 74 75 70 29 29 29 0a 20 20 20 20 ch:setup))).
8910: 20 20 28 70 75 73 68 2d 64 69 72 65 63 74 6f 72 (push-director
8920: 79 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 y *toppath*).
8930: 20 20 20 28 6c 65 74 20 28 28 64 61 74 61 20 28 (let ((data (
8940: 66 75 6c 6c 2d 72 75 6e 63 6f 6e 66 69 67 73 2d full-runconfigs-
8950: 72 65 61 64 29 29 29 0a 09 3b 3b 20 6b 65 65 70 read)))..;; keep
8960: 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a this one local.
8970: 09 28 63 6f 6e 64 0a 09 20 28 28 61 6e 64 20 28 .(cond.. ((and (
8980: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
8990: 65 63 74 69 6f 6e 22 29 0a 09 20 20 20 20 20 20 ection")..
89a0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
89b0: 2d 76 61 72 22 29 29 0a 09 20 20 28 6c 65 74 20 -var")).. (let
89c0: 28 28 76 61 6c 20 28 6f 72 20 28 63 6f 6e 66 69 ((val (or (confi
89d0: 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 61 20 28 gf:lookup data (
89e0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
89f0: 65 63 74 69 6f 6e 22 29 28 61 72 67 73 3a 67 65 ection")(args:ge
8a00: 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 0a 09 t-arg "-var"))..
8a10: 09 09 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b .. (configf:look
8a20: 75 70 20 64 61 74 61 20 22 64 65 66 61 75 6c 74 up data "default
8a30: 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 " (args:get-arg
8a40: 22 2d 76 61 72 22 29 29 29 29 29 0a 09 20 20 20 "-var")))))..
8a50: 20 28 69 66 20 76 61 6c 20 28 70 72 69 6e 74 20 (if val (print
8a60: 76 61 6c 29 29 29 29 0a 09 20 28 28 6e 6f 74 20 val)))).. ((not
8a70: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8a80: 64 75 6d 70 6d 6f 64 65 22 29 29 0a 09 20 20 28 dumpmode")).. (
8a90: 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e pp (hash-table->
8aa0: 61 6c 69 73 74 20 64 61 74 61 29 29 29 0a 09 20 alist data)))..
8ab0: 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 ((string=? (args
8ac0: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
8ad0: 6f 64 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 20 ode") "json")..
8ae0: 20 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 74 (json-write dat
8af0: 61 29 29 0a 09 20 28 28 73 74 72 69 6e 67 3d 3f a)).. ((string=?
8b00: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8b10: 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 69 6e 69 -dumpmode") "ini
8b20: 22 29 0a 09 20 20 28 63 6f 6e 66 69 67 66 3a 63 ").. (configf:c
8b30: 6f 6e 66 69 67 2d 3e 69 6e 69 20 64 61 74 61 29 onfig->ini data)
8b40: 29 0a 09 20 28 65 6c 73 65 0a 09 20 20 28 64 65 ).. (else.. (de
8b50: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
8b60: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
8b70: 6f 72 74 2a 20 22 2d 64 75 6d 70 6d 6f 64 65 20 ort* "-dumpmode
8b80: 6f 66 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 of " (args:get-a
8b90: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 rg "-dumpmode")
8ba0: 22 20 6e 6f 74 20 72 65 63 6f 67 6e 69 73 65 64 " not recognised
8bb0: 22 29 29 29 0a 09 28 73 65 74 21 20 2a 64 69 64 ")))..(set! *did
8bc0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 0a something* #t)).
8bd0: 20 20 20 20 20 20 28 70 6f 70 2d 64 69 72 65 63 (pop-direc
8be0: 74 6f 72 79 29 29 29 0a 0a 28 69 66 20 28 61 72 tory)))..(if (ar
8bf0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f gs:get-arg "-sho
8c00: 77 2d 63 6f 6e 66 69 67 22 29 0a 20 20 20 20 28 w-config"). (
8c10: 6c 65 74 20 28 28 74 6c 20 20 20 28 6c 61 75 6e let ((tl (laun
8c20: 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 64 ch:setup)).. (d
8c30: 61 74 61 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 ata *configdat*)
8c40: 29 20 3b 3b 20 28 72 65 61 64 2d 63 6f 6e 66 69 ) ;; (read-confi
8c50: 67 20 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 g "megatest.conf
8c60: 69 67 22 20 23 66 20 23 74 29 29 29 0a 20 20 20 ig" #f #t))).
8c70: 20 20 20 28 70 75 73 68 2d 64 69 72 65 63 74 6f (push-directo
8c80: 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 ry *toppath*).
8c90: 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 ;; keep this
8ca0: 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 one local.
8cb0: 20 28 63 6f 6e 64 20 0a 20 20 20 20 20 20 20 28 (cond . (
8cc0: 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 (and (args:get-a
8cd0: 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 0a 09 rg "-section")..
8ce0: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
8cf0: 72 67 20 22 2d 76 61 72 22 29 29 0a 09 28 6c 65 rg "-var"))..(le
8d00: 74 20 28 28 76 61 6c 20 28 63 6f 6e 66 69 67 66 t ((val (configf
8d10: 3a 6c 6f 6f 6b 75 70 20 64 61 74 61 20 28 61 72 :lookup data (ar
8d20: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 63 gs:get-arg "-sec
8d30: 74 69 6f 6e 22 29 28 61 72 67 73 3a 67 65 74 2d tion")(args:get-
8d40: 61 72 67 20 22 2d 76 61 72 22 29 29 29 29 0a 09 arg "-var"))))..
8d50: 20 20 28 69 66 20 76 61 6c 20 28 70 72 69 6e 74 (if val (print
8d60: 20 76 61 6c 29 29 29 29 0a 0a 20 20 20 20 20 20 val))))..
8d70: 20 3b 3b 20 70 72 69 6e 74 20 6a 75 73 74 20 61 ;; print just a
8d80: 20 73 65 63 74 69 6f 6e 20 69 66 20 6f 6e 6c 79 section if only
8d90: 20 2d 73 65 63 74 69 6f 6e 0a 0a 20 20 20 20 20 -section..
8da0: 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 ((not (args:ge
8db0: 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 t-arg "-dumpmode
8dc0: 22 29 29 0a 09 28 70 70 20 28 68 61 73 68 2d 74 "))..(pp (hash-t
8dd0: 61 62 6c 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 able->alist data
8de0: 29 29 29 0a 20 20 20 20 20 20 20 28 28 73 74 72 ))). ((str
8df0: 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d ing=? (args:get-
8e00: 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 arg "-dumpmode")
8e10: 20 22 6a 73 6f 6e 22 29 0a 09 28 6a 73 6f 6e 2d "json")..(json-
8e20: 77 72 69 74 65 20 64 61 74 61 29 29 0a 20 20 20 write data)).
8e30: 20 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 ((string=? (
8e40: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
8e50: 75 6d 70 6d 6f 64 65 22 29 20 22 69 6e 69 22 29 umpmode") "ini")
8e60: 0a 09 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 69 ..(configf:confi
8e70: 67 2d 3e 69 6e 69 20 64 61 74 61 29 29 0a 20 20 g->ini data)).
8e80: 20 20 20 20 20 28 65 6c 73 65 0a 09 28 64 65 62 (else..(deb
8e90: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
8ea0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
8eb0: 72 74 2a 20 22 2d 64 75 6d 70 6d 6f 64 65 20 6f rt* "-dumpmode o
8ec0: 66 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 f " (args:get-ar
8ed0: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
8ee0: 20 6e 6f 74 20 72 65 63 6f 67 6e 69 73 65 64 22 not recognised"
8ef0: 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ))). (set!
8f00: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
8f10: 74 29 0a 20 20 20 20 20 20 28 70 6f 70 2d 64 69 t). (pop-di
8f20: 72 65 63 74 6f 72 79 29 29 29 0a 0a 28 69 66 20 rectory)))..(if
8f30: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8f40: 73 68 6f 77 2d 63 6d 64 69 6e 66 6f 22 29 0a 20 show-cmdinfo").
8f50: 20 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 (if (or (args
8f60: 3a 67 65 74 2d 61 72 67 20 22 3a 76 61 6c 75 65 :get-arg ":value
8f70: 22 29 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d ")(getenv "MT_CM
8f80: 44 49 4e 46 4f 22 29 29 0a 09 28 6c 65 74 20 28 DINFO"))..(let (
8f90: 28 64 61 74 61 20 28 63 6f 6d 6d 6f 6e 3a 72 65 (data (common:re
8fa0: 61 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e ad-encoded-strin
8fb0: 67 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d g (or (args:get-
8fc0: 61 72 67 20 22 3a 76 61 6c 75 65 22 29 28 67 65 arg ":value")(ge
8fd0: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
8fe0: 22 29 29 29 29 29 0a 09 20 20 28 69 66 20 28 65 "))))).. (if (e
8ff0: 71 75 61 6c 3f 20 28 61 72 67 73 3a 67 65 74 2d qual? (args:get-
9000: 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 arg "-dumpmode")
9010: 20 22 6a 73 6f 6e 22 29 0a 09 20 20 20 20 20 20 "json")..
9020: 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 (json-write data
9030: 29 0a 09 20 20 20 20 20 20 28 70 70 20 64 61 74 ).. (pp dat
9040: 61 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 a)).. (set! *di
9050: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
9060: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ..(debug:print-i
9070: 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
9080: 6f 67 2d 70 6f 72 74 2a 20 22 65 6e 76 69 72 6f og-port* "enviro
9090: 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 20 4d nment variable M
90a0: 54 5f 43 4d 44 49 4e 46 4f 20 69 73 20 6e 6f 74 T_CMDINFO is not
90b0: 20 73 65 74 22 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d set")))..;;====
90c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9100: 3d 3d 0a 3b 3b 20 52 65 6d 6f 76 65 20 6f 6c 64 ==.;; Remove old
9110: 20 72 75 6e 28 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d run(s).;;======
9120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9160: 0a 0a 3b 3b 20 73 69 6e 63 65 20 73 65 76 65 72 ..;; since sever
9170: 61 6c 20 61 63 74 69 6f 6e 73 20 63 61 6e 20 62 al actions can b
9180: 65 20 73 70 65 63 69 66 69 65 64 20 6f 6e 20 74 e specified on t
9190: 68 65 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 he command line
91a0: 74 68 65 20 72 65 6d 6f 76 61 6c 0a 3b 3b 20 69 the removal.;; i
91b0: 73 20 64 6f 6e 65 20 66 69 72 73 74 0a 28 64 65 s done first.(de
91c0: 66 69 6e 65 20 28 6f 70 65 72 61 74 65 2d 6f 6e fine (operate-on
91d0: 20 61 63 74 69 6f 6e 29 0a 20 20 28 6c 65 74 2a action). (let*
91e0: 20 28 28 72 75 6e 72 65 63 20 28 72 75 6e 73 3a ((runrec (runs:
91f0: 72 75 6e 72 65 63 2d 6d 61 6b 65 2d 72 65 63 6f runrec-make-reco
9200: 72 64 29 29 0a 09 20 28 74 61 72 67 65 74 20 28 rd)).. (target (
9210: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
9220: 74 61 72 67 65 74 29 29 29 0a 20 20 20 20 28 63 target))). (c
9230: 6f 6e 64 0a 20 20 20 20 20 28 28 6e 6f 74 20 74 ond. ((not t
9240: 61 72 67 65 74 29 0a 20 20 20 20 20 20 28 64 65 arget). (de
9250: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
9260: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
9270: 6f 72 74 2a 20 22 4d 69 73 73 69 6e 67 20 72 65 ort* "Missing re
9280: 71 75 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 quired parameter
9290: 20 66 6f 72 20 22 20 61 63 74 69 6f 6e 20 22 2c for " action ",
92a0: 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 you must specif
92b0: 79 20 2d 74 61 72 67 65 74 20 6f 72 20 2d 72 65 y -target or -re
92c0: 71 74 61 72 67 22 29 0a 20 20 20 20 20 20 28 65 qtarg"). (e
92d0: 78 69 74 20 31 29 29 0a 20 20 20 20 20 28 28 6e xit 1)). ((n
92e0: 6f 74 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 ot (or (args:get
92f0: 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 -arg ":runname")
9300: 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 .. (args:g
9310: 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 et-arg "-runname
9320: 22 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 "))). (debu
9330: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
9340: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
9350: 74 2a 20 22 4d 69 73 73 69 6e 67 20 72 65 71 75 t* "Missing requ
9360: 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 ired parameter f
9370: 6f 72 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 or " action ", y
9380: 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 ou must specify
9390: 74 68 65 20 72 75 6e 20 6e 61 6d 65 20 70 61 74 the run name pat
93a0: 74 65 72 6e 20 77 69 74 68 20 2d 72 75 6e 6e 61 tern with -runna
93b0: 6d 65 20 70 61 74 74 22 29 0a 20 20 20 20 20 20 me patt").
93c0: 28 65 78 69 74 20 32 29 29 0a 20 20 20 20 20 28 (exit 2)). (
93d0: 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 (not (args:get-a
93e0: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 29 rg "-testpatt"))
93f0: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
9400: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
9410: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
9420: 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 Missing required
9430: 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 parameter for "
9440: 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d action ", you m
9450: 75 73 74 20 73 70 65 63 69 66 79 20 74 68 65 20 ust specify the
9460: 74 65 73 74 20 70 61 74 74 65 72 6e 20 77 69 74 test pattern wit
9470: 68 20 2d 74 65 73 74 70 61 74 74 22 29 0a 20 20 h -testpatt").
9480: 20 20 20 20 28 65 78 69 74 20 33 29 29 0a 20 20 (exit 3)).
9490: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 28 (else. (
94a0: 69 66 20 28 6e 6f 74 20 28 63 61 72 20 2a 63 6f if (not (car *co
94b0: 6e 66 69 67 69 6e 66 6f 2a 29 29 0a 09 20 20 28 nfiginfo*)).. (
94c0: 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 begin.. (debu
94d0: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
94e0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
94f0: 74 2a 20 22 41 74 74 65 6d 70 74 65 64 20 22 20 t* "Attempted "
9500: 61 63 74 69 6f 6e 20 22 6f 6e 20 74 65 73 74 28 action "on test(
9510: 73 29 20 62 75 74 20 72 75 6e 20 61 72 65 61 20 s) but run area
9520: 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e 6f 74 20 config file not
9530: 66 6f 75 6e 64 22 29 0a 09 20 20 20 20 28 65 78 found").. (ex
9540: 69 74 20 31 29 29 0a 09 20 20 3b 3b 20 70 75 74 it 1)).. ;; put
9550: 20 74 65 73 74 20 70 61 72 61 6d 65 74 65 72 73 test parameters
9560: 20 69 6e 74 6f 20 63 6f 6e 76 65 6e 69 65 6e 74 into convenient
9570: 20 76 61 72 69 61 62 6c 65 73 0a 09 20 20 28 62 variables.. (b
9580: 65 67 69 6e 0a 09 20 20 20 20 3b 3b 20 63 68 65 egin.. ;; che
9590: 63 6b 20 66 6f 72 20 63 6f 72 72 65 63 74 20 76 ck for correct v
95a0: 65 72 73 69 6f 6e 2c 20 65 78 69 74 20 77 69 74 ersion, exit wit
95b0: 68 20 6d 65 73 73 61 67 65 20 69 66 20 6e 6f 74 h message if not
95c0: 20 63 6f 72 72 65 63 74 0a 09 20 20 20 20 28 63 correct.. (c
95d0: 6f 6d 6d 6f 6e 3a 65 78 69 74 2d 6f 6e 2d 76 65 ommon:exit-on-ve
95e0: 72 73 69 6f 6e 2d 63 68 61 6e 67 65 64 29 0a 09 rsion-changed)..
95f0: 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 (runs:operat
9600: 65 2d 6f 6e 20 20 61 63 74 69 6f 6e 0a 09 09 09 e-on action....
9610: 20 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 target....
9620: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 (common:ar
9630: 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 gs-get-runname)
9640: 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 ;; (or (args:ge
9650: 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
9660: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
9670: 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 :runname"))....
9680: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 (common:arg
9690: 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 s-get-testpatt #
96a0: 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d f) ;; (args:get-
96b0: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
96c0: 0a 09 09 09 20 20 20 20 20 20 73 74 61 74 65 3a .... state:
96d0: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
96e0: 74 2d 73 74 61 74 65 29 0a 09 09 09 20 20 20 20 t-state)....
96f0: 20 20 73 74 61 74 75 73 3a 20 28 63 6f 6d 6d 6f status: (commo
9700: 6e 3a 61 72 67 73 2d 67 65 74 2d 73 74 61 74 75 n:args-get-statu
9710: 73 29 0a 09 09 09 20 20 20 20 20 20 6e 65 77 2d s).... new-
9720: 73 74 61 74 65 2d 73 74 61 74 75 73 3a 20 28 61 state-status: (a
9730: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
9740: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 29 t-state-status")
9750: 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ))). (set!
9760: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
9770: 74 29 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 t)))))..(if (arg
9780: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 6d 6f s:get-arg "-remo
9790: 76 65 2d 72 75 6e 73 22 29 0a 20 20 20 20 28 67 ve-runs"). (g
97a0: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
97b0: 0a 20 20 20 20 20 22 2d 72 65 6d 6f 76 65 2d 72 . "-remove-r
97c0: 75 6e 73 22 0a 20 20 20 20 20 22 72 65 6d 6f 76 uns". "remov
97d0: 65 20 72 75 6e 73 22 0a 20 20 20 20 20 28 6c 61 e runs". (la
97e0: 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
97f0: 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c name keys keyval
9800: 73 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 s). (opera
9810: 74 65 2d 6f 6e 20 27 72 65 6d 6f 76 65 2d 72 75 te-on 'remove-ru
9820: 6e 73 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 ns))))..(if (arg
9830: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
9840: 73 74 61 74 65 2d 73 74 61 74 75 73 22 29 0a 20 state-status").
9850: 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
9860: 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 73 65 74 call . "-set
9870: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 0a 20 -state-status".
9880: 20 20 20 20 22 73 65 74 20 73 74 61 74 65 20 61 "set state a
9890: 6e 64 20 73 74 61 74 75 73 22 0a 20 20 20 20 20 nd status".
98a0: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
98b0: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
98c0: 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6f 70 vals). (op
98d0: 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 erate-on 'set-st
98e0: 61 74 65 2d 73 74 61 74 75 73 29 29 29 29 0a 0a ate-status))))..
98f0: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
9900: 74 2d 61 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d t-arg "-set-run-
9910: 73 74 61 74 75 73 22 29 0a 09 28 61 72 67 73 3a status")..(args:
9920: 67 65 74 2d 61 72 67 20 22 2d 67 65 74 2d 72 75 get-arg "-get-ru
9930: 6e 2d 73 74 61 74 75 73 22 29 29 0a 20 20 20 20 n-status")).
9940: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
9950: 6c 0a 20 20 20 20 20 22 2d 73 65 74 2d 72 75 6e l. "-set-run
9960: 2d 73 74 61 74 75 73 22 0a 20 20 20 20 20 22 73 -status". "s
9970: 65 74 20 72 75 6e 20 73 74 61 74 75 73 22 0a 20 et run status".
9980: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
9990: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
99a0: 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 keyvals).
99b0: 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 64 61 74 (let* ((runsdat
99c0: 20 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d (rmt:get-runs-
99d0: 62 79 2d 70 61 74 74 20 6b 65 79 73 20 72 75 6e by-patt keys run
99e0: 6e 61 6d 65 20 0a 09 09 09 09 09 28 63 6f 6d 6d name ......(comm
99f0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 on:args-get-targ
9a00: 65 74 29 0a 09 09 09 09 09 23 66 20 23 66 20 23 et)......#f #f #
9a10: 66 20 23 66 29 29 0a 09 20 20 20 20 20 20 28 68 f #f)).. (h
9a20: 65 61 64 65 72 20 20 20 28 76 65 63 74 6f 72 2d eader (vector-
9a30: 72 65 66 20 72 75 6e 73 64 61 74 20 30 29 29 0a ref runsdat 0)).
9a40: 09 20 20 20 20 20 20 28 72 6f 77 73 20 20 20 20 . (rows
9a50: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e (vector-ref run
9a60: 73 64 61 74 20 31 29 29 29 0a 09 20 28 69 66 20 sdat 1))).. (if
9a70: 28 6e 75 6c 6c 3f 20 72 6f 77 73 29 0a 09 20 20 (null? rows)..
9a80: 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
9a90: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
9aa0: 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
9ab0: 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f 20 6d 61 74 og-port* "No mat
9ac0: 63 68 69 6e 67 20 72 75 6e 20 66 6f 75 6e 64 2e ching run found.
9ad0: 22 29 0a 09 20 20 20 20 20 20 20 28 65 78 69 74 ").. (exit
9ae0: 20 31 29 29 0a 09 20 20 20 20 20 28 6c 65 74 2a 1)).. (let*
9af0: 20 28 28 72 6f 77 20 20 20 20 20 20 28 63 61 72 ((row (car
9b00: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e (vector-ref run
9b10: 73 64 61 74 20 31 29 29 29 0a 09 09 20 20 20 20 sdat 1)))...
9b20: 28 72 75 6e 2d 69 64 20 20 20 28 64 62 3a 67 65 (run-id (db:ge
9b30: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
9b40: 72 20 72 6f 77 20 68 65 61 64 65 72 20 22 69 64 r row header "id
9b50: 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 69 66 "))).. (if
9b60: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9b70: 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 -set-run-status"
9b80: 29 0a 09 09 20 20 20 28 72 6d 74 3a 73 65 74 2d )... (rmt:set-
9b90: 72 75 6e 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 run-status run-i
9ba0: 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
9bb0: 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 "-set-run-status
9bc0: 22 29 20 6d 73 67 3a 20 28 61 72 67 73 3a 67 65 ") msg: (args:ge
9bd0: 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 20 t-arg "-m"))...
9be0: 20 20 28 70 72 69 6e 74 20 28 72 6d 74 3a 67 65 (print (rmt:ge
9bf0: 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 72 75 6e t-run-status run
9c00: 2d 69 64 29 29 0a 09 09 20 20 20 29 29 29 29 29 -id))... )))))
9c10: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
9c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
9c60: 51 75 65 72 79 20 72 75 6e 73 0a 3b 3b 3d 3d 3d Query runs.;;===
9c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9cb0: 3d 3d 3d 0a 0a 3b 3b 20 2d 66 69 65 6c 64 73 20 ===..;; -fields
9cc0: 72 75 6e 73 3a 69 64 2c 74 61 72 67 65 74 2c 72 runs:id,target,r
9cd0: 75 6e 6e 61 6d 65 2c 63 6f 6d 6d 65 6e 74 2b 74 unname,comment+t
9ce0: 65 73 74 73 3a 69 64 2c 74 65 73 74 6e 61 6d 65 ests:id,testname
9cf0: 2c 69 74 65 6d 5f 70 61 74 68 2b 73 74 65 70 73 ,item_path+steps
9d00: 0a 3b 3b 0a 3b 3b 20 63 73 69 3e 20 28 65 78 74 .;;.;; csi> (ext
9d10: 72 61 63 74 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 ract-fields-cons
9d20: 74 72 61 69 6e 74 73 20 22 72 75 6e 73 3a 69 64 traints "runs:id
9d30: 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 2c ,target,runname,
9d40: 63 6f 6d 6d 65 6e 74 2b 74 65 73 74 73 3a 69 64 comment+tests:id
9d50: 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 ,testname,item_p
9d60: 61 74 68 2b 73 74 65 70 73 22 29 0a 3b 3b 20 20 ath+steps").;;
9d70: 20 20 20 20 20 20 20 3d 3e 20 28 28 22 72 75 6e => (("run
9d80: 73 22 20 22 69 64 22 20 22 74 61 72 67 65 74 22 s" "id" "target"
9d90: 20 22 72 75 6e 6e 61 6d 65 22 20 22 63 6f 6d 6d "runname" "comm
9da0: 65 6e 74 22 29 20 28 22 74 65 73 74 73 22 20 22 ent") ("tests" "
9db0: 69 64 22 20 22 74 65 73 74 6e 61 6d 65 22 20 22 id" "testname" "
9dc0: 69 74 65 6d 5f 70 61 74 68 22 29 20 28 22 73 74 item_path") ("st
9dd0: 65 70 73 22 29 29 0a 3b 3b 0a 3b 3b 20 20 20 4e eps")).;;.;; N
9de0: 4f 54 45 3a 20 72 65 6d 65 6d 62 65 72 20 74 68 OTE: remember th
9df0: 61 74 20 74 68 65 20 63 64 72 20 77 69 6c 6c 20 at the cdr will
9e00: 62 65 20 74 68 65 20 6c 69 73 74 20 79 6f 75 20 be the list you
9e10: 65 78 70 65 63 74 20 28 63 64 72 20 28 22 72 75 expect (cdr ("ru
9e20: 6e 73 22 20 22 69 64 22 20 22 74 61 72 67 65 74 ns" "id" "target
9e30: 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 63 6f 6d " "runname" "com
9e40: 6d 65 6e 74 22 29 29 20 3d 3e 20 28 22 69 64 22 ment")) => ("id"
9e50: 20 22 74 61 72 67 65 74 22 20 22 72 75 6e 6e 61 "target" "runna
9e60: 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 0a 3b me" "comment").;
9e70: 3b 20 20 20 20 20 20 20 20 20 61 6e 64 20 73 6f ; and so
9e80: 20 61 6c 69 73 74 2d 72 65 66 20 77 69 6c 6c 20 alist-ref will
9e90: 79 69 65 6c 64 20 77 68 61 74 20 79 6f 75 20 65 yield what you e
9ea0: 78 70 65 63 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 xpect.;;.(define
9eb0: 20 28 65 78 74 72 61 63 74 2d 66 69 65 6c 64 73 (extract-fields
9ec0: 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 66 69 65 -constraints fie
9ed0: 6c 64 73 2d 73 70 65 63 29 0a 20 20 28 6d 61 70 lds-spec). (map
9ee0: 20 28 6c 61 6d 62 64 61 20 28 74 61 62 6c 65 2d (lambda (table-
9ef0: 73 70 65 63 29 20 3b 3b 20 72 75 6e 73 3a 69 64 spec) ;; runs:id
9f00: 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 0a ,target,runname.
9f10: 09 20 28 6c 65 74 20 28 28 64 61 74 20 28 73 74 . (let ((dat (st
9f20: 72 69 6e 67 2d 73 70 6c 69 74 20 74 61 62 6c 65 ring-split table
9f30: 2d 73 70 65 63 20 22 3a 22 29 29 29 20 3b 3b 20 -spec ":"))) ;;
9f40: 28 22 72 75 6e 73 22 20 22 69 64 2c 74 61 72 67 ("runs" "id,targ
9f50: 65 74 2c 72 75 6e 6e 61 6d 65 22 29 0a 09 20 20 et,runname")..
9f60: 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 (if (> (length
9f70: 64 61 74 29 20 31 29 0a 09 20 20 20 20 20 20 20 dat) 1)..
9f80: 28 63 6f 6e 73 20 28 63 61 72 20 64 61 74 29 28 (cons (car dat)(
9f90: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 63 61 string-split (ca
9fa0: 64 72 20 64 61 74 29 20 22 2c 22 29 29 20 3b 3b dr dat) ",")) ;;
9fb0: 20 22 69 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e "id,target,runn
9fc0: 61 6d 65 22 0a 09 20 20 20 20 20 20 20 64 61 74 ame".. dat
9fd0: 29 29 29 0a 20 20 20 20 20 20 20 28 73 74 72 69 ))). (stri
9fe0: 6e 67 2d 73 70 6c 69 74 20 66 69 65 6c 64 73 2d ng-split fields-
9ff0: 73 70 65 63 20 22 2b 22 29 29 29 0a 0a 28 64 65 spec "+")))..(de
a000: 66 69 6e 65 20 28 67 65 74 2d 76 61 6c 75 65 2d fine (get-value-
a010: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 64 61 74 by-fieldname dat
a020: 61 76 65 63 20 74 65 73 74 2d 66 69 65 6c 64 2d avec test-field-
a030: 69 6e 64 65 78 20 66 69 65 6c 64 6e 61 6d 65 29 index fieldname)
a040: 0a 20 20 28 6c 65 74 20 28 28 69 6e 64 78 20 28 . (let ((indx (
a050: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
a060: 65 66 61 75 6c 74 20 74 65 73 74 2d 66 69 65 6c efault test-fiel
a070: 64 2d 69 6e 64 65 78 20 66 69 65 6c 64 6e 61 6d d-index fieldnam
a080: 65 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 e #f))). (if
a090: 69 6e 64 78 0a 09 28 69 66 20 28 3e 3d 20 69 6e indx..(if (>= in
a0a0: 64 78 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 dx (vector-lengt
a0b0: 68 20 64 61 74 61 76 65 63 29 29 0a 09 20 20 20 h datavec))..
a0c0: 20 23 66 20 3b 3b 20 69 6e 64 65 78 20 74 6f 20 #f ;; index to
a0d0: 68 69 67 68 2c 20 73 68 6f 75 6c 64 20 72 61 69 high, should rai
a0e0: 73 65 20 61 6e 20 65 72 72 6f 72 20 49 20 73 75 se an error I su
a0f0: 70 70 6f 73 65 0a 09 20 20 20 20 28 76 65 63 74 ppose.. (vect
a100: 6f 72 2d 72 65 66 20 64 61 74 61 76 65 63 20 69 or-ref datavec i
a110: 6e 64 78 29 29 0a 09 23 66 29 29 29 0a 0a 3b 3b ndx))..#f)))..;;
a120: 20 4e 4f 54 45 3a 20 6c 69 73 74 2d 72 75 6e 73 NOTE: list-runs
a130: 20 61 6e 64 20 6c 69 73 74 2d 64 62 2d 74 61 72 and list-db-tar
a140: 67 65 74 73 20 6f 70 65 72 61 74 65 20 6f 6e 20 gets operate on
a150: 6c 6f 63 61 6c 20 64 62 21 21 21 0a 3b 3b 0a 3b local db!!!.;;.;
a160: 3b 20 49 44 45 41 3a 20 6d 65 67 61 74 65 73 74 ; IDEA: megatest
a170: 20 6c 69 73 74 20 2d 72 75 6e 6e 61 6d 65 20 62 list -runname b
a180: 6c 61 68 25 20 2e 2e 2e 0a 3b 3b 0a 28 69 66 20 lah% ....;;.(if
a190: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
a1a0: 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 0a g "-list-runs").
a1b0: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
a1c0: 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 -list-db-targets
a1d0: 22 29 29 0a 20 20 20 20 28 69 66 20 28 6c 61 75 ")). (if (lau
a1e0: 6e 63 68 3a 73 65 74 75 70 29 0a 09 28 6c 65 74 nch:setup)..(let
a1f0: 2a 20 28 3b 3b 20 28 64 62 73 74 72 75 63 74 20 * (;; (dbstruct
a200: 20 20 20 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 (make-dbr:dbs
a210: 74 72 75 63 74 20 70 61 74 68 3a 20 2a 74 6f 70 truct path: *top
a220: 70 61 74 68 2a 20 6c 6f 63 61 6c 3a 20 28 61 72 path* local: (ar
a230: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 gs:get-arg "-loc
a240: 61 6c 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 al"))).. (
a250: 72 75 6e 70 61 74 74 20 20 20 20 20 28 61 72 67 runpatt (arg
a260: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
a270: 2d 72 75 6e 73 22 29 29 0a 09 20 20 20 20 20 20 -runs"))..
a280: 20 28 74 65 73 74 70 61 74 74 20 20 20 20 28 63 (testpatt (c
a290: 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 ommon:args-get-t
a2a0: 65 73 74 70 61 74 74 20 23 66 29 29 0a 09 20 20 estpatt #f))..
a2b0: 20 20 20 20 20 3b 3b 20 28 69 66 20 28 61 72 67 ;; (if (arg
a2c0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
a2d0: 70 61 74 74 22 29 20 0a 09 20 20 20 20 20 20 20 patt") ..
a2e0: 3b 3b 20 20 09 20 20 20 20 20 20 20 20 28 61 72 ;; . (ar
a2f0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
a300: 74 70 61 74 74 22 29 20 0a 09 20 20 20 20 20 20 tpatt") ..
a310: 20 3b 3b 20 20 09 20 20 20 20 20 20 20 20 22 25 ;; . "%
a320: 22 29 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 ")).. (key
a330: 73 20 20 20 20 20 20 20 20 28 72 6d 74 3a 67 65 s (rmt:ge
a340: 74 2d 6b 65 79 73 29 29 20 3b 3b 20 28 64 62 3a t-keys)) ;; (db:
a350: 67 65 74 2d 6b 65 79 73 20 64 62 73 74 72 75 63 get-keys dbstruc
a360: 74 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 t)).. ;; (
a370: 72 75 6e 73 64 61 20 20 20 74 20 20 28 64 62 3a runsda t (db:
a380: 67 65 74 2d 72 75 6e 73 20 64 62 73 74 72 75 63 get-runs dbstruc
a390: 74 20 72 75 6e 70 61 74 74 20 23 66 20 23 66 20 t runpatt #f #f
a3a0: 27 28 29 29 29 0a 09 20 20 20 20 20 20 20 28 72 '())).. (r
a3b0: 75 6e 73 64 61 74 20 20 20 20 20 28 72 6d 74 3a unsdat (rmt:
a3c0: 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 get-runs-by-patt
a3d0: 20 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 61 74 keys (or runpat
a3e0: 74 20 22 25 22 29 20 28 63 6f 6d 6d 6f 6e 3a 61 t "%") (common:a
a3f0: 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 20 rgs-get-target)
a400: 3b 3b 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 2d ;; (db:get-runs-
a410: 62 79 2d 70 61 74 74 20 64 62 73 74 72 75 63 74 by-patt dbstruct
a420: 20 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 61 74 keys (or runpat
a430: 74 20 22 25 22 29 20 28 63 6f 6d 6d 6f 6e 3a 61 t "%") (common:a
a440: 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 0a rgs-get-target).
a450: 09 09 09 20 20 20 20 20 20 20 20 20 20 20 09 20 ... .
a460: 23 66 20 23 66 20 27 28 22 69 64 22 20 22 72 75 #f #f '("id" "ru
a470: 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 20 22 nname" "state" "
a480: 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 22 20 status" "owner"
a490: 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 22 63 6f "event_time" "co
a4a0: 6d 6d 65 6e 74 22 29 20 30 29 29 0a 09 20 20 20 mment") 0))..
a4b0: 20 20 20 20 28 72 75 6e 73 74 6d 70 20 20 20 20 (runstmp
a4c0: 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 (db:get-rows ru
a4d0: 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 nsdat))..
a4e0: 28 68 65 61 64 65 72 20 20 20 20 20 20 28 64 62 (header (db
a4f0: 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 73 :get-header runs
a500: 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 3b 3b dat)).. ;;
a510: 20 74 68 69 73 20 69 73 20 22 2d 73 69 6e 63 65 this is "-since
a520: 22 20 73 75 70 70 6f 72 74 2e 20 54 68 69 73 20 " support. This
a530: 6c 6f 6f 6b 73 20 61 74 20 6c 61 73 74 20 6d 6f looks at last mo
a540: 64 20 74 69 6d 65 73 20 6f 66 20 3c 72 75 6e 2d d times of <run-
a550: 69 64 3e 2e 64 62 20 66 69 6c 65 73 0a 09 20 20 id>.db files..
a560: 20 20 20 20 20 3b 3b 20 61 6e 64 20 63 6f 6c 6c ;; and coll
a570: 65 63 74 73 20 74 68 6f 73 65 20 6d 6f 64 69 66 ects those modif
a580: 69 65 64 20 73 69 6e 63 65 20 74 68 65 20 2d 73 ied since the -s
a590: 69 6e 63 65 20 74 69 6d 65 2e 0a 09 20 20 20 20 ince time...
a5a0: 20 20 20 28 72 75 6e 73 20 20 20 20 20 20 20 20 (runs
a5b0: 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 6e (if (and (not (n
a5c0: 75 6c 6c 3f 20 72 75 6e 73 74 6d 70 29 29 0a 09 ull? runstmp))..
a5d0: 09 09 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 ... (args:ge
a5e0: 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 22 29 29 t-arg "-since"))
a5f0: 0a 09 09 09 09 28 6c 65 74 20 28 28 63 68 61 6e .....(let ((chan
a600: 67 65 64 2d 69 64 73 20 28 64 62 3a 67 65 74 2d ged-ids (db:get-
a610: 63 68 61 6e 67 65 64 2d 72 75 6e 2d 69 64 73 20 changed-run-ids
a620: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
a630: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
a640: 73 69 6e 63 65 22 29 29 29 29 29 0a 09 09 09 09 since"))))).....
a650: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 (let loop ((he
a660: 64 20 28 63 61 72 20 72 75 6e 73 74 6d 70 29 29 d (car runstmp))
a670: 0a 09 09 09 09 09 20 20 20 20 20 28 74 61 6c 20 ...... (tal
a680: 28 63 64 72 20 72 75 6e 73 74 6d 70 29 29 0a 09 (cdr runstmp))..
a690: 09 09 09 09 20 20 20 20 20 28 72 65 73 20 27 28 .... (res '(
a6a0: 29 29 29 0a 09 09 09 09 20 20 20 20 28 6c 65 74 )))..... (let
a6b0: 20 28 28 6e 65 77 2d 72 65 73 20 28 69 66 20 28 ((new-res (if (
a6c0: 6d 65 6d 62 65 72 20 28 64 62 3a 67 65 74 2d 76 member (db:get-v
a6d0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 68 alue-by-header h
a6e0: 65 64 20 68 65 61 64 65 72 20 22 69 64 22 29 20 ed header "id")
a6f0: 63 68 61 6e 67 65 64 2d 69 64 73 29 0a 09 09 09 changed-ids)....
a700: 09 09 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 ... (cons
a710: 68 65 64 20 72 65 73 29 0a 09 09 09 09 09 09 20 hed res).......
a720: 20 20 20 20 20 20 72 65 73 29 29 29 0a 09 09 09 res)))....
a730: 09 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c . (if (null
a740: 3f 20 74 61 6c 29 0a 09 09 09 09 09 20 20 28 72 ? tal)...... (r
a750: 65 76 65 72 73 65 20 6e 65 77 2d 72 65 73 29 0a everse new-res).
a760: 09 09 09 09 09 20 20 28 6c 6f 6f 70 20 28 63 61 ..... (loop (ca
a770: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 r tal)(cdr tal)
a780: 6e 65 77 2d 72 65 73 29 29 29 29 29 0a 09 09 09 new-res)))))....
a790: 09 72 75 6e 73 74 6d 70 29 29 0a 09 20 20 20 20 .runstmp))..
a7a0: 20 20 20 28 64 62 2d 74 61 72 67 65 74 73 20 20 (db-targets
a7b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
a7c0: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 list-db-targets"
a7d0: 29 29 0a 09 20 20 20 20 20 20 20 28 73 65 65 6e )).. (seen
a7e0: 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 (make-ha
a7f0: 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 20 20 sh-table))..
a800: 20 20 20 28 64 6d 6f 64 65 20 20 20 20 20 20 20 (dmode
a810: 28 6c 65 74 20 28 28 64 20 28 61 72 67 73 3a 67 (let ((d (args:g
a820: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
a830: 65 22 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 e"))).... (
a840: 69 66 20 64 20 28 73 74 72 69 6e 67 2d 3e 73 79 if d (string->sy
a850: 6d 62 6f 6c 20 64 29 20 23 66 29 29 29 0a 09 20 mbol d) #f)))..
a860: 20 20 20 20 20 20 28 64 61 74 61 20 20 20 20 20 (data
a870: 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 (make-hash-ta
a880: 62 6c 65 29 29 0a 09 20 20 20 20 20 20 20 28 66 ble)).. (f
a890: 69 65 6c 64 73 2d 73 70 65 63 20 28 69 66 20 28 ields-spec (if (
a8a0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 66 args:get-arg "-f
a8b0: 69 65 6c 64 73 22 29 0a 09 09 09 09 28 65 78 74 ields").....(ext
a8c0: 72 61 63 74 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 ract-fields-cons
a8d0: 74 72 61 69 6e 74 73 20 28 61 72 67 73 3a 67 65 traints (args:ge
a8e0: 74 2d 61 72 67 20 22 2d 66 69 65 6c 64 73 22 29 t-arg "-fields")
a8f0: 29 0a 09 09 09 09 28 6c 69 73 74 20 28 63 6f 6e ).....(list (con
a900: 73 20 22 72 75 6e 73 22 20 28 61 70 70 65 6e 64 s "runs" (append
a910: 20 6b 65 79 73 20 28 6c 69 73 74 20 22 69 64 22 keys (list "id"
a920: 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 "runname" "stat
a930: 65 22 20 22 73 74 61 74 75 73 22 20 22 6f 77 6e e" "status" "own
a940: 65 72 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 er" "event_time"
a950: 20 22 63 6f 6d 6d 65 6e 74 22 20 22 66 61 69 6c "comment" "fail
a960: 5f 63 6f 75 6e 74 22 20 22 70 61 73 73 5f 63 6f _count" "pass_co
a970: 75 6e 74 22 29 29 29 0a 09 09 09 09 20 20 20 20 unt"))).....
a980: 20 20 28 63 6f 6e 73 20 22 74 65 73 74 73 22 20 (cons "tests"
a990: 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d db:test-record-
a9a0: 66 69 65 6c 64 73 29 20 3b 3b 20 22 69 64 22 20 fields) ;; "id"
a9b0: 22 74 65 73 74 6e 61 6d 65 22 20 22 74 65 73 74 "testname" "test
a9c0: 5f 70 61 74 68 22 29 0a 09 09 09 09 20 20 20 20 _path").....
a9d0: 20 20 28 6c 69 73 74 20 22 73 74 65 70 73 22 20 (list "steps"
a9e0: 22 69 64 22 20 22 73 74 65 70 6e 61 6d 65 22 29 "id" "stepname")
a9f0: 29 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e ))).. (run
aa00: 73 2d 73 70 65 63 20 20 20 28 6c 65 74 20 28 28 s-spec (let ((
aa10: 72 20 28 61 6c 69 73 74 2d 72 65 66 20 22 72 75 r (alist-ref "ru
aa20: 6e 73 22 20 20 66 69 65 6c 64 73 2d 73 70 65 63 ns" fields-spec
aa30: 20 65 71 75 61 6c 3f 29 29 29 20 3b 3b 20 74 68 equal?))) ;; th
aa40: 65 20 63 68 65 63 6b 20 69 73 20 6e 6f 77 20 75 e check is now u
aa50: 6e 6e 65 63 65 73 73 61 72 79 0a 09 09 09 20 20 nnecessary....
aa60: 20 20 20 20 28 69 66 20 28 61 6e 64 20 72 20 28 (if (and r (
aa70: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 29 29 29 20 not (null? r)))
aa80: 72 20 28 6c 69 73 74 20 22 69 64 22 20 29 29 29 r (list "id" )))
aa90: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 73 ).. (tests
aaa0: 2d 73 70 65 63 20 20 28 6c 65 74 20 28 28 74 20 -spec (let ((t
aab0: 28 61 6c 69 73 74 2d 72 65 66 20 22 74 65 73 74 (alist-ref "test
aac0: 73 22 20 66 69 65 6c 64 73 2d 73 70 65 63 20 65 s" fields-spec e
aad0: 71 75 61 6c 3f 29 29 29 0a 09 09 09 20 20 20 20 qual?)))....
aae0: 20 20 28 69 66 20 28 61 6e 64 20 74 20 28 6e 75 (if (and t (nu
aaf0: 6c 6c 3f 20 74 29 29 20 3b 3b 20 61 6c 6c 20 66 ll? t)) ;; all f
ab00: 69 65 6c 64 73 0a 09 09 09 09 20 20 64 62 3a 74 ields..... db:t
ab10: 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 est-record-field
ab20: 73 0a 09 09 09 09 20 20 74 29 29 29 0a 09 20 20 s..... t)))..
ab30: 20 20 20 20 20 28 61 64 6a 2d 74 65 73 74 73 2d (adj-tests-
ab40: 73 70 65 63 20 28 64 65 6c 65 74 65 2d 64 75 70 spec (delete-dup
ab50: 6c 69 63 61 74 65 73 20 28 69 66 20 74 65 73 74 licates (if test
ab60: 73 2d 73 70 65 63 20 28 63 6f 6e 73 20 22 69 64 s-spec (cons "id
ab70: 22 20 74 65 73 74 73 2d 73 70 65 63 29 20 64 62 " tests-spec) db
ab80: 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 :test-record-fie
ab90: 6c 64 73 29 29 29 20 3b 3b 20 27 28 22 69 64 22 lds))) ;; '("id"
aba0: 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 )))).. (st
abb0: 65 70 73 2d 73 70 65 63 20 20 28 61 6c 69 73 74 eps-spec (alist
abc0: 2d 72 65 66 20 22 73 74 65 70 73 22 20 66 69 65 -ref "steps" fie
abd0: 6c 64 73 2d 73 70 65 63 20 65 71 75 61 6c 3f 29 lds-spec equal?)
abe0: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d ).. (test-
abf0: 66 69 65 6c 64 2d 69 6e 64 65 78 20 28 6d 61 6b field-index (mak
ac00: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))).
ac10: 09 20 20 28 69 66 20 28 61 6e 64 20 74 65 73 74 . (if (and test
ac20: 73 2d 73 70 65 63 20 28 6e 6f 74 20 28 6e 75 6c s-spec (not (nul
ac30: 6c 3f 20 74 65 73 74 73 2d 73 70 65 63 29 29 29 l? tests-spec)))
ac40: 20 3b 3b 20 64 6f 20 73 6f 6d 65 20 76 61 6c 69 ;; do some vali
ac50: 64 61 74 69 6f 6e 20 61 6e 64 20 70 72 6f 63 65 dation and proce
ac60: 73 73 69 6e 67 20 6f 66 20 74 68 65 20 74 65 73 ssing of the tes
ac70: 74 2d 73 70 65 63 0a 09 20 20 20 20 20 20 28 6c t-spec.. (l
ac80: 65 74 20 28 28 69 6e 76 61 6c 69 64 2d 74 65 73 et ((invalid-tes
ac90: 74 73 2d 73 70 65 63 20 28 66 69 6c 74 65 72 20 ts-spec (filter
aca0: 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 6f 74 20 (lambda (x)(not
acb0: 28 6d 65 6d 62 65 72 20 78 20 64 62 3a 74 65 73 (member x db:tes
acc0: 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 29 t-record-fields)
acd0: 29 29 20 74 65 73 74 73 2d 73 70 65 63 29 29 29 )) tests-spec)))
ace0: 0a 09 09 28 69 66 20 28 6e 75 6c 6c 3f 20 69 6e ...(if (null? in
acf0: 76 61 6c 69 64 2d 74 65 73 74 73 2d 73 70 65 63 valid-tests-spec
ad00: 29 0a 09 09 20 20 20 20 3b 3b 20 67 65 6e 65 72 )... ;; gener
ad10: 61 74 65 20 74 68 65 20 6c 6f 6f 6b 75 70 20 6d ate the lookup m
ad20: 61 70 20 74 65 73 74 2d 66 69 65 6c 64 2d 6e 61 ap test-field-na
ad30: 6d 65 20 3d 3e 20 69 6e 64 65 78 2d 6e 75 6d 62 me => index-numb
ad40: 65 72 0a 09 09 20 20 20 20 28 6c 65 74 20 6c 6f er... (let lo
ad50: 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 61 64 op ((hed (car ad
ad60: 6a 2d 74 65 73 74 73 2d 73 70 65 63 29 29 0a 09 j-tests-spec))..
ad70: 09 09 20 20 20 20 20 20 20 28 74 61 6c 20 28 63 .. (tal (c
ad80: 64 72 20 61 64 6a 2d 74 65 73 74 73 2d 73 70 65 dr adj-tests-spe
ad90: 63 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 c)).... (i
ada0: 64 78 20 30 29 29 0a 09 09 20 20 20 20 20 20 28 dx 0))... (
adb0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
adc0: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
add0: 20 68 65 64 20 69 64 78 29 0a 09 09 20 20 20 20 hed idx)...
ade0: 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c (if (not (null
adf0: 3f 20 74 61 6c 29 29 28 6c 6f 6f 70 20 28 63 61 ? tal))(loop (ca
ae00: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 28 r tal)(cdr tal)(
ae10: 2b 20 69 64 78 20 31 29 29 29 29 0a 09 09 20 20 + idx 1))))...
ae20: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 (begin...
ae30: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
ae40: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
ae50: 6f 67 2d 70 6f 72 74 2a 20 22 49 6e 76 61 6c 69 og-port* "Invali
ae60: 64 20 74 65 73 74 20 66 69 65 6c 64 73 20 73 70 d test fields sp
ae70: 65 63 69 66 69 65 64 3a 20 22 20 28 73 74 72 69 ecified: " (stri
ae80: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 69 ng-intersperse i
ae90: 6e 76 61 6c 69 64 2d 74 65 73 74 73 2d 73 70 65 nvalid-tests-spe
aea0: 63 20 22 2c 20 22 29 29 0a 09 09 20 20 20 20 20 c ", "))...
aeb0: 20 28 65 78 69 74 29 29 29 29 29 0a 0a 09 20 20 (exit)))))...
aec0: 3b 3b 20 45 61 63 68 20 72 75 6e 0a 09 20 20 28 ;; Each run.. (
aed0: 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 28 6c for-each .. (l
aee0: 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 20 20 20 ambda (run)..
aef0: 20 20 28 6c 65 74 20 28 28 74 61 72 67 65 74 73 (let ((targets
af00: 74 72 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 tr (string-inter
af10: 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d sperse (map (lam
af20: 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 20 bda (x)........
af30: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
af40: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
af50: 65 72 20 78 29 29 0a 09 09 09 09 09 09 20 20 20 er x)).......
af60: 20 20 20 20 6b 65 79 73 29 20 22 2f 22 29 29 29 keys) "/")))
af70: 0a 09 20 20 20 20 20 20 20 28 69 66 20 64 62 2d .. (if db-
af80: 74 61 72 67 65 74 73 0a 09 09 20 20 20 28 69 66 targets... (if
af90: 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 6c (not (hash-tabl
afa0: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 73 65 e-ref/default se
afb0: 65 6e 20 74 61 72 67 65 74 73 74 72 20 23 66 29 en targetstr #f)
afc0: 29 0a 09 09 20 20 20 20 20 20 20 28 62 65 67 69 )... (begi
afd0: 6e 0a 09 09 09 20 28 68 61 73 68 2d 74 61 62 6c n.... (hash-tabl
afe0: 65 2d 73 65 74 21 20 73 65 65 6e 20 74 61 72 67 e-set! seen targ
aff0: 65 74 73 74 72 20 23 74 29 0a 09 09 09 20 3b 3b etstr #t).... ;;
b000: 20 28 70 72 69 6e 74 20 22 5b 22 20 74 61 72 67 (print "[" targ
b010: 65 74 73 74 72 20 22 5d 22 29 29 29 29 0a 09 09 etstr "]"))))...
b020: 09 20 28 69 66 20 28 6e 6f 74 20 64 6d 6f 64 65 . (if (not dmode
b030: 29 0a 09 09 09 20 20 20 20 20 28 70 72 69 6e 74 ).... (print
b040: 20 74 61 72 67 65 74 73 74 72 29 0a 09 09 09 20 targetstr)....
b050: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
b060: 73 65 74 21 20 64 61 74 61 20 22 74 61 72 67 65 set! data "targe
b070: 74 73 22 20 28 63 6f 6e 73 20 74 61 72 67 65 74 ts" (cons target
b080: 73 74 72 20 28 68 61 73 68 2d 74 61 62 6c 65 2d str (hash-table-
b090: 72 65 66 2f 64 65 66 61 75 6c 74 20 64 61 74 61 ref/default data
b0a0: 20 22 74 61 72 67 65 74 73 22 20 27 28 29 29 29 "targets" '()))
b0b0: 29 0a 09 09 09 20 20 20 20 20 29 29 29 0a 09 09 ).... )))...
b0c0: 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 2d 69 (let* ((run-i
b0d0: 64 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 d (db:get-value
b0e0: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
b0f0: 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 09 09 eader "id"))....
b100: 20 20 28 72 75 6e 6e 61 6d 65 20 28 64 62 3a 67 (runname (db:g
b110: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
b120: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 72 er run header "r
b130: 75 6e 6e 61 6d 65 22 29 29 20 0a 09 09 09 20 20 unname")) ....
b140: 28 73 74 61 74 65 73 20 20 28 73 74 72 69 6e 67 (states (string
b150: 2d 73 70 6c 69 74 20 28 6f 72 20 28 61 72 67 73 -split (or (args
b160: 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 65 :get-arg "-state
b170: 22 29 20 22 22 29 20 22 2c 22 29 29 0a 09 09 09 ") "") ","))....
b180: 20 20 28 73 74 61 74 75 73 65 73 20 28 73 74 72 (statuses (str
b190: 69 6e 67 2d 73 70 6c 69 74 20 28 6f 72 20 28 61 ing-split (or (a
b1a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
b1b0: 61 74 75 73 22 29 20 22 22 29 20 22 2c 22 29 29 atus") "") ","))
b1c0: 0a 09 09 09 20 20 28 74 65 73 74 73 20 20 20 28 .... (tests (
b1d0: 69 66 20 74 65 73 74 73 2d 73 70 65 63 0a 09 09 if tests-spec...
b1e0: 09 09 20 20 20 20 20 20 20 28 72 6d 74 3a 67 65 .. (rmt:ge
b1f0: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
b200: 72 75 6e 2d 69 64 20 74 65 73 74 70 61 74 74 20 run-id testpatt
b210: 73 74 61 74 65 73 20 73 74 61 74 75 73 65 73 20 states statuses
b220: 23 66 20 23 66 20 23 66 20 27 74 65 73 74 6e 61 #f #f #f 'testna
b230: 6d 65 20 27 61 73 63 20 3b 3b 20 28 64 62 3a 67 me 'asc ;; (db:g
b240: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
b250: 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 dbstruct run-id
b260: 20 74 65 73 74 70 61 74 74 20 27 28 29 20 27 28 testpatt '() '(
b270: 29 20 23 66 20 23 66 20 23 66 20 27 74 65 73 74 ) #f #f #f 'test
b280: 6e 61 6d 65 20 27 61 73 63 20 0a 09 09 09 09 09 name 'asc ......
b290: 09 09 20 20 20 20 20 3b 3b 20 75 73 65 20 71 72 .. ;; use qr
b2a0: 79 76 61 6c 73 20 69 66 20 74 65 73 74 2d 73 70 yvals if test-sp
b2b0: 65 63 20 70 72 6f 76 69 64 65 64 0a 09 09 09 09 ec provided.....
b2c0: 09 09 09 20 20 20 20 20 28 69 66 20 74 65 73 74 ... (if test
b2d0: 73 2d 73 70 65 63 0a 09 09 09 09 09 09 09 09 20 s-spec.........
b2e0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
b2f0: 72 73 65 20 61 64 6a 2d 74 65 73 74 73 2d 73 70 rse adj-tests-sp
b300: 65 63 20 22 2c 22 29 0a 09 09 09 09 09 09 09 09 ec ",").........
b310: 20 3b 3b 20 64 62 3a 74 65 73 74 2d 72 65 63 6f ;; db:test-reco
b320: 72 64 2d 66 69 65 6c 64 73 0a 09 09 09 09 09 09 rd-fields.......
b330: 09 09 20 23 66 29 0a 09 09 09 09 09 09 09 20 20 .. #f)........
b340: 20 20 20 23 66 0a 09 09 09 09 09 09 09 20 20 20 #f........
b350: 20 20 27 6e 6f 72 6d 61 6c 29 0a 09 09 09 09 20 'normal).....
b360: 20 20 20 20 20 20 27 28 29 29 29 29 0a 09 09 20 '())))...
b370: 20 20 20 20 28 63 61 73 65 20 64 6d 6f 64 65 0a (case dmode.
b380: 09 09 20 20 20 20 20 20 20 28 28 6a 73 6f 6e 20 .. ((json
b390: 6f 64 73 29 0a 09 09 09 28 69 66 20 72 75 6e 73 ods)....(if runs
b3a0: 2d 73 70 65 63 0a 09 09 09 20 20 20 20 28 66 6f -spec.... (fo
b3b0: 72 2d 65 61 63 68 20 0a 09 09 09 20 20 20 20 20 r-each ....
b3c0: 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 2d 6e (lambda (field-n
b3d0: 61 6d 65 29 0a 09 09 09 20 20 20 20 20 20 20 28 ame).... (
b3e0: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
b3f0: 73 65 74 21 20 64 61 74 61 20 28 63 6f 6e 63 20 set! data (conc
b400: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
b410: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
b420: 65 72 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 20 er field-name))
b430: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
b440: 65 20 22 6d 65 74 61 22 20 66 69 65 6c 64 2d 6e e "meta" field-n
b450: 61 6d 65 29 29 0a 09 09 09 20 20 20 20 20 72 75 ame)).... ru
b460: 6e 73 2d 73 70 65 63 29 29 29 0a 09 09 09 3b 3b ns-spec)))....;;
b470: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
b480: 68 2d 73 65 74 21 20 64 61 74 61 20 28 64 62 3a h-set! data (db:
b490: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
b4a0: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 der run header "
b4b0: 73 74 61 74 75 73 22 29 20 20 20 20 20 74 61 72 status") tar
b4c0: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
b4d0: 6d 65 74 61 22 20 22 73 74 61 74 75 73 22 20 20 meta" "status"
b4e0: 20 20 20 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 )....;; (muti
b4f0: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
b500: 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 data (db:get-va
b510: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
b520: 6e 20 68 65 61 64 65 72 20 22 73 74 61 74 65 22 n header "state"
b530: 29 20 20 20 20 20 20 74 61 72 67 65 74 73 74 72 ) targetstr
b540: 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 runname "meta"
b550: 22 73 74 61 74 65 22 20 20 20 20 20 20 29 0a 09 "state" )..
b560: 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 ..;; (mutils:hie
b570: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
b580: 28 63 6f 6e 63 20 28 64 62 3a 67 65 74 2d 76 61 (conc (db:get-va
b590: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
b5a0: 6e 20 68 65 61 64 65 72 20 22 69 64 22 29 29 20 n header "id"))
b5b0: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
b5c0: 6d 65 20 22 6d 65 74 61 22 20 22 69 64 22 20 20 me "meta" "id"
b5d0: 20 20 20 20 20 20 20 29 0a 09 09 09 3b 3b 20 28 )....;; (
b5e0: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
b5f0: 73 65 74 21 20 64 61 74 61 20 28 64 62 3a 67 65 set! data (db:ge
b600: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
b610: 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 65 76 r run header "ev
b620: 65 6e 74 5f 74 69 6d 65 22 29 20 74 61 72 67 65 ent_time") targe
b630: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 tstr runname "me
b640: 74 61 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 ta" "event_time"
b650: 20 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 )....;; (mutils
b660: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
b670: 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 ata (db:get-valu
b680: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
b690: 68 65 61 64 65 72 20 22 63 6f 6d 6d 65 6e 74 22 header "comment"
b6a0: 29 20 20 20 20 74 61 72 67 65 74 73 74 72 20 72 ) targetstr r
b6b0: 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 63 unname "meta" "c
b6c0: 6f 6d 6d 65 6e 74 22 20 20 20 20 29 0a 09 09 09 omment" )....
b6d0: 3b 3b 20 3b 3b 20 61 64 64 20 6c 61 73 74 20 65 ;; ;; add last e
b6e0: 6e 74 72 79 20 74 77 69 63 65 20 2d 20 73 65 65 ntry twice - see
b6f0: 6d 73 20 74 6f 20 62 65 20 61 20 62 75 67 20 69 ms to be a bug i
b700: 6e 20 68 69 65 72 68 61 73 68 3f 0a 09 09 09 3b n hierhash?....;
b710: 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 ; (mutils:hierha
b720: 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 64 62 sh-set! data (db
b730: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
b740: 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 ader run header
b750: 22 63 6f 6d 6d 65 6e 74 22 29 20 20 20 20 74 61 "comment") ta
b760: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
b770: 22 6d 65 74 61 22 20 22 63 6f 6d 6d 65 6e 74 22 "meta" "comment"
b780: 20 20 20 20 29 0a 09 09 20 20 20 20 20 20 20 28 )... (
b790: 65 6c 73 65 0a 09 09 09 28 69 66 20 28 6e 75 6c else....(if (nul
b7a0: 6c 3f 20 72 75 6e 73 2d 73 70 65 63 29 0a 09 09 l? runs-spec)...
b7b0: 09 20 20 20 20 28 70 72 69 6e 74 20 22 52 75 6e . (print "Run
b7c0: 3a 20 22 20 74 61 72 67 65 74 73 74 72 20 22 2f : " targetstr "/
b7d0: 22 20 72 75 6e 6e 61 6d 65 20 0a 09 09 09 09 20 " runname .....
b7e0: 20 20 22 20 73 74 61 74 75 73 3a 20 22 20 28 64 " status: " (d
b7f0: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
b800: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
b810: 20 22 73 74 61 74 65 22 29 0a 09 09 09 09 20 20 "state").....
b820: 20 22 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e " run-id: " run
b830: 2d 69 64 20 22 2c 20 6e 75 6d 62 65 72 20 74 65 -id ", number te
b840: 73 74 73 3a 20 22 20 28 6c 65 6e 67 74 68 20 74 sts: " (length t
b850: 65 73 74 73 29 0a 09 09 09 09 20 20 20 22 20 65 ests)..... " e
b860: 76 65 6e 74 5f 74 69 6d 65 3a 20 22 20 28 64 62 vent_time: " (db
b870: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
b880: 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 ader run header
b890: 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 29 0a 09 "event_time"))..
b8a0: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 .. (begin....
b8b0: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
b8c0: 6d 65 6d 62 65 72 20 22 74 61 72 67 65 74 22 20 member "target"
b8d0: 72 75 6e 73 2d 73 70 65 63 29 29 0a 09 09 09 20 runs-spec))....
b8e0: 20 20 20 20 20 20 20 20 20 3b 3b 20 28 64 69 73 ;; (dis
b8f0: 70 6c 61 79 20 28 63 6f 6e 63 20 22 54 61 72 67 play (conc "Targ
b900: 65 74 3a 20 22 20 74 61 72 67 65 74 73 74 72 29 et: " targetstr)
b910: 29 0a 09 09 09 20 20 20 20 20 20 20 20 20 20 28 ).... (
b920: 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 22 52 display (conc "R
b930: 75 6e 3a 20 22 20 74 61 72 67 65 74 73 74 72 20 un: " targetstr
b940: 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 20 22 29 "/" runname " ")
b950: 29 29 0a 09 09 09 20 20 20 20 20 20 28 66 6f 72 )).... (for
b960: 2d 65 61 63 68 0a 09 09 09 20 20 20 20 20 20 20 -each....
b970: 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 2d 6e (lambda (field-n
b980: 61 6d 65 29 0a 09 09 09 09 20 28 69 66 20 28 65 ame)..... (if (e
b990: 71 75 61 6c 3f 20 66 69 65 6c 64 2d 6e 61 6d 65 qual? field-name
b9a0: 20 22 74 61 72 67 65 74 22 29 0a 09 09 09 09 20 "target").....
b9b0: 20 20 20 20 28 64 69 73 70 6c 61 79 20 28 63 6f (display (co
b9c0: 6e 63 20 22 74 61 72 67 65 74 3a 20 22 20 74 61 nc "target: " ta
b9d0: 72 67 65 74 73 74 72 20 22 20 22 29 29 0a 09 09 rgetstr " "))...
b9e0: 09 09 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 .. (display
b9f0: 28 63 6f 6e 63 20 66 69 65 6c 64 2d 6e 61 6d 65 (conc field-name
ba00: 20 22 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 61 ": " (db:get-va
ba10: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
ba20: 6e 20 68 65 61 64 65 72 20 28 63 6f 6e 63 20 66 n header (conc f
ba30: 69 65 6c 64 2d 6e 61 6d 65 29 29 20 22 20 22 29 ield-name)) " ")
ba40: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 72 75 ))).... ru
ba50: 6e 73 2d 73 70 65 63 29 0a 09 09 09 20 20 20 20 ns-spec)....
ba60: 20 20 28 6e 65 77 6c 69 6e 65 29 29 29 29 29 0a (newline))))).
ba70: 09 09 20 20 20 20 20 20 20 0a 09 09 20 20 20 20 .. ...
ba80: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 20 20 (for-each ...
ba90: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 (lambda (tes
baa0: 74 29 0a 09 09 20 20 20 20 20 20 09 28 68 61 6e t)... .(han
bab0: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
bac0: 09 09 20 65 78 6e 0a 09 09 09 20 28 62 65 67 69 .. exn.... (begi
bad0: 6e 0a 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 n.... (debug:p
bae0: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
baf0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
bb00: 22 42 61 64 20 64 61 74 61 20 69 6e 20 74 65 73 "Bad data in tes
bb10: 74 20 72 65 63 6f 72 64 3f 20 22 20 74 65 73 74 t record? " test
bb20: 29 0a 09 09 09 20 20 20 28 70 72 69 6e 74 20 22 ).... (print "
bb30: 65 78 6e 3d 22 20 28 63 6f 6e 64 69 74 69 6f 6e exn=" (condition
bb40: 2d 3e 6c 69 73 74 20 65 78 6e 29 29 0a 09 09 09 ->list exn))....
bb50: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
bb60: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
bb70: 6f 72 74 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 ort* " message:
bb80: 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 " ((condition-pr
bb90: 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 operty-accessor
bba0: 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 'exn 'message) e
bbb0: 78 6e 29 29 0a 09 09 09 20 20 20 28 70 72 69 6e xn)).... (prin
bbc0: 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 20 28 63 75 t-call-chain (cu
bbd0: 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 74 rrent-error-port
bbe0: 29 29 29 0a 09 09 09 20 28 6c 65 74 2a 20 28 28 ))).... (let* ((
bbf0: 74 65 73 74 2d 69 64 20 20 20 20 20 20 28 69 66 test-id (if
bc00: 20 28 6d 65 6d 62 65 72 20 22 69 64 22 20 20 20 (member "id"
bc10: 20 20 20 20 20 20 20 20 74 65 73 74 73 2d 73 70 tests-sp
bc20: 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 ec)(get-value-by
bc30: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
bc40: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
bc50: 20 22 69 64 22 20 20 20 20 20 20 20 20 20 20 29 "id" )
bc60: 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 #f)) ;; (db:tes
bc70: 74 2d 67 65 74 2d 69 64 20 20 20 20 20 20 20 20 t-get-id
bc80: 20 74 65 73 74 29 29 0a 09 09 09 09 28 74 65 73 test)).....(tes
bc90: 74 6e 61 6d 65 20 20 20 20 20 28 69 66 20 28 6d tname (if (m
bca0: 65 6d 62 65 72 20 22 74 65 73 74 6e 61 6d 65 22 ember "testname"
bcb0: 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 tests-spec)
bcc0: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
bcd0: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
bce0: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 74 t-field-index "t
bcf0: 65 73 74 6e 61 6d 65 22 20 20 20 20 29 20 23 66 estname" ) #f
bd00: 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 )) ;; (db:test-g
bd10: 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 20 74 65 et-testname te
bd20: 73 74 29 29 0a 09 09 09 09 28 69 74 65 6d 70 61 st)).....(itempa
bd30: 74 68 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 th (if (memb
bd40: 65 72 20 22 69 74 65 6d 5f 70 61 74 68 22 20 20 er "item_path"
bd50: 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 tests-spec)(ge
bd60: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
bd70: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
bd80: 69 65 6c 64 2d 69 6e 64 65 78 20 22 69 74 65 6d ield-index "item
bd90: 5f 70 61 74 68 22 20 20 20 29 20 23 66 29 29 20 _path" ) #f))
bda0: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
bdb0: 69 74 65 6d 2d 70 61 74 68 20 20 74 65 73 74 29 item-path test)
bdc0: 29 0a 09 09 09 09 28 63 6f 6d 6d 65 6e 74 20 20 ).....(comment
bdd0: 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 (if (member
bde0: 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 20 20 74 "comment" t
bdf0: 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 ests-spec)(get-v
be00: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
be10: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
be20: 64 2d 69 6e 64 65 78 20 22 63 6f 6d 6d 65 6e 74 d-index "comment
be30: 22 20 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 " ) #f)) ;;
be40: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 6f 6d (db:test-get-com
be50: 6d 65 6e 74 20 20 20 20 74 65 73 74 29 29 0a 09 ment test))..
be60: 09 09 09 28 74 73 74 61 74 65 20 20 20 20 20 20 ...(tstate
be70: 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 73 74 (if (member "st
be80: 61 74 65 22 20 20 20 20 20 20 20 20 74 65 73 74 ate" test
be90: 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 s-spec)(get-valu
bea0: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
beb0: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
bec0: 6e 64 65 78 20 22 73 74 61 74 65 22 20 20 20 20 ndex "state"
bed0: 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 ) #f)) ;; (db
bee0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
bef0: 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 test)).....
bf00: 28 74 73 74 61 74 75 73 20 20 20 20 20 20 28 69 (tstatus (i
bf10: 66 20 28 6d 65 6d 62 65 72 20 22 73 74 61 74 75 f (member "statu
bf20: 73 22 20 20 20 20 20 20 20 74 65 73 74 73 2d 73 s" tests-s
bf30: 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 pec)(get-value-b
bf40: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
bf50: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
bf60: 78 20 22 73 74 61 74 75 73 22 20 20 20 20 20 20 x "status"
bf70: 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 ) #f)) ;; (db:te
bf80: 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 20 20 st-get-status
bf90: 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 65 76 test)).....(ev
bfa0: 65 6e 74 2d 74 69 6d 65 20 20 20 28 69 66 20 28 ent-time (if (
bfb0: 6d 65 6d 62 65 72 20 22 65 76 65 6e 74 5f 74 69 member "event_ti
bfc0: 6d 65 22 20 20 20 74 65 73 74 73 2d 73 70 65 63 me" tests-spec
bfd0: 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 )(get-value-by-f
bfe0: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
bff0: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
c000: 65 76 65 6e 74 5f 74 69 6d 65 22 20 20 29 20 23 event_time" ) #
c010: 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d f)) ;; (db:test-
c020: 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 get-event_time t
c030: 65 73 74 29 29 0a 09 09 09 09 28 72 75 6e 64 69 est)).....(rundi
c040: 72 20 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d r (if (mem
c050: 62 65 72 20 22 72 75 6e 64 69 72 22 20 20 20 20 ber "rundir"
c060: 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 tests-spec)(g
c070: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
c080: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
c090: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e field-index "run
c0a0: 64 69 72 22 20 20 20 20 20 20 29 20 23 66 29 29 dir" ) #f))
c0b0: 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ;; (db:test-get
c0c0: 2d 72 75 6e 64 69 72 20 20 20 20 20 74 65 73 74 -rundir test
c0d0: 29 29 0a 09 09 09 09 28 66 69 6e 61 6c 5f 6c 6f )).....(final_lo
c0e0: 67 66 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 gf (if (member
c0f0: 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 20 20 "final_logf"
c100: 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d tests-spec)(get-
c110: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
c120: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
c130: 6c 64 2d 69 6e 64 65 78 20 22 66 69 6e 61 6c 5f ld-index "final_
c140: 6c 6f 67 66 22 20 20 29 20 23 66 29 29 20 3b 3b logf" ) #f)) ;;
c150: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 69 (db:test-get-fi
c160: 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 74 29 29 0a nal_logf test)).
c170: 09 09 09 09 28 72 75 6e 5f 64 75 72 61 74 69 6f ....(run_duratio
c180: 6e 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 72 n (if (member "r
c190: 75 6e 5f 64 75 72 61 74 69 6f 6e 22 20 74 65 73 un_duration" tes
c1a0: 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c ts-spec)(get-val
c1b0: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
c1c0: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
c1d0: 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 61 74 index "run_durat
c1e0: 69 6f 6e 22 29 20 23 66 29 29 20 3b 3b 20 28 64 ion") #f)) ;; (d
c1f0: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 b:test-get-run_d
c200: 75 72 61 74 69 6f 6e 20 74 65 73 74 29 29 0a 09 uration test))..
c210: 09 09 09 28 66 75 6c 6c 6e 61 6d 65 20 20 20 20 ...(fullname
c220: 20 28 63 6f 6e 63 20 74 65 73 74 6e 61 6d 65 0a (conc testname.
c230: 09 09 09 09 09 09 20 20 20 20 28 69 66 20 28 65 ...... (if (e
c240: 71 75 61 6c 3f 20 69 74 65 6d 70 61 74 68 20 22 qual? itempath "
c250: 22 29 0a 09 09 09 09 09 09 09 22 22 20 0a 09 09 ")........"" ...
c260: 09 09 09 09 09 28 63 6f 6e 63 20 22 28 22 20 69 .....(conc "(" i
c270: 74 65 6d 70 61 74 68 20 22 29 22 29 29 29 29 29 tempath ")")))))
c280: 0a 09 09 09 20 20 20 28 63 61 73 65 20 64 6d 6f .... (case dmo
c290: 64 65 0a 09 09 09 20 20 20 20 20 28 28 6a 73 6f de.... ((jso
c2a0: 6e 20 6f 64 73 29 0a 09 09 09 20 20 20 20 20 20 n ods)....
c2b0: 28 69 66 20 74 65 73 74 73 2d 73 70 65 63 0a 09 (if tests-spec..
c2c0: 09 09 09 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 ... (for-each..
c2d0: 09 09 09 20 20 20 28 6c 61 6d 62 64 61 20 28 66 ... (lambda (f
c2e0: 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 09 20 ield-name).....
c2f0: 20 20 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 (mutils:hier
c300: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 hash-set! data
c310: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
c320: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
c330: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 66 69 t-field-index fi
c340: 65 6c 64 2d 6e 61 6d 65 29 20 74 61 72 67 65 74 eld-name) target
c350: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 str runname "dat
c360: 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 a" (conc test-id
c370: 29 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 0a 09 ) field-name))..
c380: 09 09 09 20 20 20 74 65 73 74 73 2d 73 70 65 63 ... tests-spec
c390: 29 29 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 3b ))).... ;; ;
c3a0: 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 ; (mutils:hierha
c3b0: 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 66 75 sh-set! data fu
c3c0: 6c 6c 6e 61 6d 65 20 20 20 74 61 72 67 65 74 73 llname targets
c3d0: 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 tr runname "data
c3e0: 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 " (conc test-id)
c3f0: 20 22 74 6e 61 6d 65 22 20 20 20 20 20 29 0a 09 "tname" )..
c400: 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 .. ;; (muti
c410: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
c420: 20 64 61 74 61 20 20 74 65 73 74 6e 61 6d 65 20 data testname
c430: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
c440: 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 ame "data" (conc
c450: 20 74 65 73 74 2d 69 64 29 20 22 74 65 73 74 6e test-id) "testn
c460: 61 6d 65 22 20 20 29 0a 09 09 09 20 20 20 20 20 ame" )....
c470: 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 ;; (mutils:hier
c480: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 hash-set! data
c490: 69 74 65 6d 70 61 74 68 20 20 20 74 61 72 67 65 itempath targe
c4a0: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 tstr runname "da
c4b0: 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 ta" (conc test-i
c4c0: 64 29 20 22 69 74 65 6d 70 61 74 68 22 20 20 29 d) "itempath" )
c4d0: 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 .... ;; (mu
c4e0: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
c4f0: 74 21 20 64 61 74 61 20 20 63 6f 6d 6d 65 6e 74 t! data comment
c500: 20 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 targetstr ru
c510: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
c520: 6e 63 20 74 65 73 74 2d 69 64 29 20 22 63 6f 6d nc test-id) "com
c530: 6d 65 6e 74 22 20 20 20 29 0a 09 09 09 20 20 20 ment" )....
c540: 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 ;; (mutils:hi
c550: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
c560: 20 20 74 73 74 61 74 65 20 20 20 20 20 74 61 72 tstate tar
c570: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
c580: 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 data" (conc test
c590: 2d 69 64 29 20 22 73 74 61 74 65 22 20 20 20 20 -id) "state"
c5a0: 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 ).... ;; (
c5b0: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
c5c0: 73 65 74 21 20 64 61 74 61 20 20 74 73 74 61 74 set! data tstat
c5d0: 75 73 20 20 20 20 74 61 72 67 65 74 73 74 72 20 us targetstr
c5e0: 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 runname "data" (
c5f0: 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 73 conc test-id) "s
c600: 74 61 74 75 73 22 20 20 20 20 29 0a 09 09 09 20 tatus" )....
c610: 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a ;; (mutils:
c620: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
c630: 74 61 20 20 72 75 6e 64 69 72 20 20 20 20 20 74 ta rundir t
c640: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
c650: 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 "data" (conc te
c660: 73 74 2d 69 64 29 20 22 72 75 6e 64 69 72 22 20 st-id) "rundir"
c670: 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 ).... ;;
c680: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
c690: 68 2d 73 65 74 21 20 64 61 74 61 20 20 66 69 6e h-set! data fin
c6a0: 61 6c 5f 6c 6f 67 66 20 74 61 72 67 65 74 73 74 al_logf targetst
c6b0: 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 r runname "data"
c6c0: 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 (conc test-id)
c6d0: 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 29 0a 09 09 "final_logf")...
c6e0: 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c . ;; (mutil
c6f0: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
c700: 64 61 74 61 20 20 72 75 6e 5f 64 75 72 61 74 69 data run_durati
c710: 6f 6e 20 74 61 72 67 65 74 73 74 72 20 72 75 6e on targetstr run
c720: 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e name "data" (con
c730: 63 20 74 65 73 74 2d 69 64 29 20 22 72 75 6e 5f c test-id) "run_
c740: 64 75 72 61 74 69 6f 6e 22 29 0a 09 09 09 20 20 duration")....
c750: 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 ;; (mutils:h
c760: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
c770: 61 20 20 65 76 65 6e 74 2d 74 69 6d 65 20 74 61 a event-time ta
c780: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
c790: 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 "data" (conc tes
c7a0: 74 2d 69 64 29 20 22 65 76 65 6e 74 5f 74 69 6d t-id) "event_tim
c7b0: 65 22 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 e").... ;;
c7c0: 3b 3b 20 61 64 64 20 6c 61 73 74 20 65 6e 74 72 ;; add last entr
c7d0: 79 20 74 77 69 63 65 20 2d 20 73 65 65 6d 73 20 y twice - seems
c7e0: 74 6f 20 62 65 20 61 20 62 75 67 20 69 6e 20 68 to be a bug in h
c7f0: 69 65 72 68 61 73 68 3f 0a 09 09 09 20 20 20 20 ierhash?....
c800: 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 ;; (mutils:hie
c810: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
c820: 20 65 76 65 6e 74 2d 74 69 6d 65 20 74 61 72 67 event-time targ
c830: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 etstr runname "d
c840: 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d ata" (conc test-
c850: 69 64 29 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 id) "event_time"
c860: 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 29 0a ).... ;; ).
c870: 09 09 09 20 20 20 20 20 28 65 6c 73 65 0a 09 09 ... (else...
c880: 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 . (if (and
c890: 74 73 74 61 74 65 20 74 73 74 61 74 75 73 20 65 tstate tstatus e
c8a0: 76 65 6e 74 2d 74 69 6d 65 29 0a 09 09 09 09 20 vent-time).....
c8b0: 20 28 66 6f 72 6d 61 74 20 23 74 0a 09 09 09 09 (format #t.....
c8c0: 09 20 20 22 20 20 54 65 73 74 3a 20 7e 32 35 61 . " Test: ~25a
c8d0: 20 53 74 61 74 65 3a 20 7e 31 35 61 20 53 74 61 State: ~15a Sta
c8e0: 74 75 73 3a 20 7e 31 35 61 20 52 75 6e 74 69 6d tus: ~15a Runtim
c8f0: 65 3a 20 7e 35 40 61 73 20 54 69 6d 65 3a 20 7e e: ~5@as Time: ~
c900: 32 32 61 20 48 6f 73 74 3a 20 7e 31 30 61 5c 6e 22a Host: ~10a\n
c910: 22 0a 09 09 09 09 09 20 20 28 69 66 20 66 75 6c "...... (if ful
c920: 6c 6e 61 6d 65 20 66 75 6c 6c 6e 61 6d 65 20 22 lname fullname "
c930: 22 29 0a 09 09 09 09 09 20 20 28 69 66 20 74 73 ")...... (if ts
c940: 74 61 74 65 20 20 20 74 73 74 61 74 65 20 20 20 tate tstate
c950: 22 22 29 0a 09 09 09 09 09 20 20 28 69 66 20 74 "")...... (if t
c960: 73 74 61 74 75 73 20 20 74 73 74 61 74 75 73 20 status tstatus
c970: 20 22 22 29 0a 09 09 09 09 09 20 20 28 67 65 74 "")...... (get
c980: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
c990: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
c9a0: 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 5f 64 eld-index "run_d
c9b0: 75 72 61 74 69 6f 6e 22 29 3b 3b 28 69 66 20 74 uration");;(if t
c9c0: 65 73 74 20 20 20 20 20 28 64 62 3a 74 65 73 74 est (db:test
c9d0: 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f -get-run_duratio
c9e0: 6e 20 74 65 73 74 29 20 22 22 29 0a 09 09 09 09 n test) "").....
c9f0: 09 20 20 28 69 66 20 65 76 65 6e 74 2d 74 69 6d . (if event-tim
ca00: 65 20 65 76 65 6e 74 2d 74 69 6d 65 20 22 22 29 e event-time "")
ca10: 0a 09 09 09 09 09 20 20 28 67 65 74 2d 76 61 6c ...... (get-val
ca20: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
ca30: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
ca40: 69 6e 64 65 78 20 22 68 6f 73 74 22 29 29 20 3b index "host")) ;
ca50: 3b 28 69 66 20 74 65 73 74 20 28 64 62 3a 74 65 ;(if test (db:te
ca60: 73 74 2d 67 65 74 2d 68 6f 73 74 20 74 65 73 74 st-get-host test
ca70: 29 29 20 22 22 29 0a 09 09 09 09 20 20 28 70 72 )) "")..... (pr
ca80: 69 6e 74 20 22 20 20 54 65 73 74 3a 20 22 20 66 int " Test: " f
ca90: 75 6c 6c 6e 61 6d 65 0a 09 09 09 09 09 20 28 69 ullname...... (i
caa0: 66 20 74 73 74 61 74 65 20 20 28 63 6f 6e 63 20 f tstate (conc
cab0: 22 20 53 74 61 74 65 3a 20 22 20 20 74 73 74 61 " State: " tsta
cac0: 74 65 29 20 20 22 22 29 0a 09 09 09 09 09 20 28 te) "")...... (
cad0: 69 66 20 74 73 74 61 74 75 73 20 28 63 6f 6e 63 if tstatus (conc
cae0: 20 22 20 53 74 61 74 75 73 3a 20 22 20 74 73 74 " Status: " tst
caf0: 61 74 75 73 29 20 22 22 29 0a 09 09 09 09 09 20 atus) "")......
cb00: 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 (if (get-value-b
cb10: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
cb20: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
cb30: 78 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 x "run_duration"
cb40: 29 0a 09 09 09 09 09 20 20 20 20 20 28 63 6f 6e )...... (con
cb50: 63 20 22 20 52 75 6e 74 69 6d 65 3a 20 22 20 28 c " Runtime: " (
cb60: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
cb70: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
cb80: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 -field-index "ru
cb90: 6e 5f 64 75 72 61 74 69 6f 6e 22 29 29 0a 09 09 n_duration"))...
cba0: 09 09 09 20 20 20 20 20 22 22 29 0a 09 09 09 09 ... "").....
cbb0: 09 20 28 69 66 20 65 76 65 6e 74 2d 74 69 6d 65 . (if event-time
cbc0: 20 28 63 6f 6e 63 20 22 20 54 69 6d 65 3a 20 22 (conc " Time: "
cbd0: 20 65 76 65 6e 74 2d 74 69 6d 65 29 20 22 22 29 event-time) "")
cbe0: 0a 09 09 09 09 09 20 28 69 66 20 28 67 65 74 2d ...... (if (get-
cbf0: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
cc00: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
cc10: 6c 64 2d 69 6e 64 65 78 20 22 68 6f 73 74 22 29 ld-index "host")
cc20: 0a 09 09 09 09 09 20 20 20 20 20 28 63 6f 6e 63 ...... (conc
cc30: 20 22 20 48 6f 73 74 3a 20 22 20 28 67 65 74 2d " Host: " (get-
cc40: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
cc50: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
cc60: 6c 64 2d 69 6e 64 65 78 20 22 68 6f 73 74 22 29 ld-index "host")
cc70: 29 0a 09 09 09 09 09 20 20 20 20 20 22 22 29 29 )...... ""))
cc80: 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 ).... (if (
cc90: 6e 6f 74 20 28 6f 72 20 28 65 71 75 61 6c 3f 20 not (or (equal?
cca0: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
ccb0: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
ccc0: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 73 t-field-index "s
ccd0: 74 61 74 75 73 22 29 20 22 50 41 53 53 22 29 0a tatus") "PASS").
cce0: 09 09 09 09 09 20 20 20 28 65 71 75 61 6c 3f 20 ..... (equal?
ccf0: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
cd00: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
cd10: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 73 t-field-index "s
cd20: 74 61 74 75 73 22 29 20 22 57 41 52 4e 22 29 0a tatus") "WARN").
cd30: 09 09 09 09 09 20 20 20 28 65 71 75 61 6c 3f 20 ..... (equal?
cd40: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
cd50: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
cd60: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 73 t-field-index "s
cd70: 74 61 74 65 22 29 20 20 22 4e 4f 54 5f 53 54 41 tate") "NOT_STA
cd80: 52 54 45 44 22 29 29 29 0a 09 09 09 09 20 20 28 RTED")))..... (
cd90: 62 65 67 69 6e 0a 09 09 09 09 20 20 20 20 28 70 begin..... (p
cda0: 72 69 6e 74 20 20 20 28 69 66 20 28 67 65 74 2d rint (if (get-
cdb0: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
cdc0: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
cdd0: 6c 64 2d 69 6e 64 65 78 20 22 63 70 75 6c 6f 61 ld-index "cpuloa
cde0: 64 22 29 0a 09 09 09 09 09 09 20 28 63 6f 6e 63 d")....... (conc
cdf0: 20 22 20 20 20 20 20 20 20 20 20 63 70 75 6c 6f " cpulo
ce00: 61 64 3a 20 20 22 20 20 20 28 67 65 74 2d 76 61 ad: " (get-va
ce10: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
ce20: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
ce30: 2d 69 6e 64 65 78 20 22 63 70 75 6c 6f 61 64 22 -index "cpuload"
ce40: 29 29 0a 09 09 09 09 09 09 20 22 22 29 20 3b 3b ))....... "") ;;
ce50: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 70 (db:test-get-cp
ce60: 75 6c 6f 61 64 20 74 65 73 74 29 0a 09 09 09 09 uload test).....
ce70: 09 20 20 20 20 20 28 69 66 20 28 67 65 74 2d 76 . (if (get-v
ce80: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
ce90: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
cea0: 64 2d 69 6e 64 65 78 20 22 64 69 73 6b 66 72 65 d-index "diskfre
ceb0: 65 22 29 0a 09 09 09 09 09 09 20 28 63 6f 6e 63 e")....... (conc
cec0: 20 22 5c 6e 20 20 20 20 20 20 20 20 20 64 69 73 "\n dis
ced0: 6b 66 72 65 65 3a 20 22 20 28 67 65 74 2d 76 61 kfree: " (get-va
cee0: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
cef0: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
cf00: 2d 69 6e 64 65 78 20 22 64 69 73 6b 66 72 65 65 -index "diskfree
cf10: 22 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d ")) ;; (db:test-
cf20: 67 65 74 2d 64 69 73 6b 66 72 65 65 20 74 65 73 get-diskfree tes
cf30: 74 29 0a 09 09 09 09 09 09 20 22 22 29 0a 09 09 t)....... "")...
cf40: 09 09 09 20 20 20 20 20 28 69 66 20 28 67 65 74 ... (if (get
cf50: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
cf60: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
cf70: 65 6c 64 2d 69 6e 64 65 78 20 22 75 6e 61 6d 65 eld-index "uname
cf80: 22 29 0a 09 09 09 09 09 09 20 28 63 6f 6e 63 20 ")....... (conc
cf90: 22 5c 6e 20 20 20 20 20 20 20 20 20 75 6e 61 6d "\n unam
cfa0: 65 3a 20 20 20 20 22 20 28 67 65 74 2d 76 61 6c e: " (get-val
cfb0: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
cfc0: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
cfd0: 69 6e 64 65 78 20 22 75 6e 61 6d 65 22 29 29 20 index "uname"))
cfe0: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
cff0: 75 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 09 09 uname test).....
d000: 09 09 20 22 22 29 0a 09 09 09 09 09 20 20 20 20 .. "")......
d010: 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d (if (get-value-
d020: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
d030: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
d040: 65 78 20 22 72 75 6e 64 69 72 22 29 0a 09 09 09 ex "rundir")....
d050: 09 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 20 20 ... (conc "\n
d060: 20 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 20 rundir:
d070: 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d " (get-value-by-
d080: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
d090: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
d0a0: 22 72 75 6e 64 69 72 22 29 29 20 3b 3b 20 28 64 "rundir")) ;; (d
d0b0: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 b:test-get-rundi
d0c0: 72 20 74 65 73 74 29 0a 09 09 09 09 09 09 20 22 r test)....... "
d0d0: 22 29 0a 3b 3b 09 09 09 09 09 20 20 20 20 20 22 ").;;..... "
d0e0: 5c 6e 20 20 20 20 20 20 20 20 20 72 75 6e 64 69 \n rundi
d0f0: 72 3a 20 20 20 22 20 28 67 65 74 2d 76 61 6c 75 r: " (get-valu
d100: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
d110: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
d120: 6e 64 65 78 20 22 22 29 20 3b 3b 20 28 73 64 62 ndex "") ;; (sdb
d130: 3a 71 72 79 20 27 67 65 74 73 74 72 20 3b 3b 20 :qry 'getstr ;;
d140: 28 66 69 6c 65 64 62 3a 67 65 74 2d 70 61 74 68 (filedb:get-path
d150: 20 2a 66 64 62 2a 20 0a 3b 3b 20 09 09 09 09 09 *fdb* .;; .....
d160: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 (db:test-ge
d170: 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 20 3b t-rundir test) ;
d180: 3b 20 29 0a 09 09 09 09 09 20 20 20 20 20 29 0a ; )...... ).
d190: 09 09 09 09 20 20 20 20 3b 3b 20 45 61 63 68 20 .... ;; Each
d1a0: 74 65 73 74 0a 09 09 09 09 20 20 20 20 3b 3b 20 test..... ;;
d1b0: 44 4f 20 4e 4f 54 20 72 65 6d 6f 74 65 20 72 75 DO NOT remote ru
d1c0: 6e 0a 09 09 09 09 20 20 20 20 28 6c 65 74 20 28 n..... (let (
d1d0: 28 73 74 65 70 73 20 28 72 6d 74 3a 67 65 74 2d (steps (rmt:get-
d1e0: 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 72 steps-for-test r
d1f0: 75 6e 2d 69 64 20 28 64 62 3a 74 65 73 74 2d 67 un-id (db:test-g
d200: 65 74 2d 69 64 20 74 65 73 74 29 29 29 29 20 3b et-id test)))) ;
d210: 3b 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d ; (db:get-steps-
d220: 66 6f 72 2d 74 65 73 74 20 64 62 73 74 72 75 63 for-test dbstruc
d230: 74 20 72 75 6e 2d 69 64 20 28 64 62 3a 74 65 73 t run-id (db:tes
d240: 74 2d 67 65 74 2d 69 64 20 74 65 73 74 29 29 29 t-get-id test)))
d250: 29 0a 09 09 09 09 20 20 20 20 20 20 28 66 6f 72 )..... (for
d260: 2d 65 61 63 68 20 0a 09 09 09 09 20 20 20 20 20 -each .....
d270: 20 20 28 6c 61 6d 62 64 61 20 28 73 74 65 70 29 (lambda (step)
d280: 0a 09 09 09 09 09 20 28 66 6f 72 6d 61 74 20 23 ...... (format #
d290: 74 20 0a 09 09 09 09 09 09 20 22 20 20 20 20 53 t ....... " S
d2a0: 74 65 70 3a 20 7e 32 30 61 20 53 74 61 74 65 3a tep: ~20a State:
d2b0: 20 7e 31 30 61 20 53 74 61 74 75 73 3a 20 7e 31 ~10a Status: ~1
d2c0: 30 61 20 54 69 6d 65 20 7e 32 32 61 5c 6e 22 0a 0a Time ~22a\n".
d2d0: 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 ...... (tdb:step
d2e0: 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 -get-stepname st
d2f0: 65 70 29 0a 09 09 09 09 09 09 20 28 74 64 62 3a ep)....... (tdb:
d300: 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 step-get-state s
d310: 74 65 70 29 0a 09 09 09 09 09 09 20 28 74 64 62 tep)....... (tdb
d320: 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 :step-get-status
d330: 20 73 74 65 70 29 0a 09 09 09 09 09 09 20 28 74 step)....... (t
d340: 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e db:step-get-even
d350: 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 0a 09 t_time step)))..
d360: 09 09 09 20 20 20 20 20 20 20 73 74 65 70 73 29 ... steps)
d370: 29 29 29 29 29 29 29 29 0a 09 09 20 20 20 20 20 ))))))))...
d380: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
d390: 72 67 20 22 2d 73 6f 72 74 22 29 0a 09 09 09 20 rg "-sort")....
d3a0: 20 28 73 6f 72 74 20 74 65 73 74 73 0a 09 09 09 (sort tests....
d3b0: 09 28 6c 61 6d 62 64 61 20 28 61 2d 74 65 73 74 .(lambda (a-test
d3c0: 20 62 2d 74 65 73 74 29 0a 09 09 09 09 20 20 28 b-test)..... (
d3d0: 6c 65 74 2a 20 28 28 6b 65 79 20 20 20 20 28 61 let* ((key (a
d3e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f rgs:get-arg "-so
d3f0: 72 74 22 29 29 0a 09 09 09 09 09 20 28 66 69 72 rt"))...... (fir
d400: 73 74 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 st (get-value-b
d410: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 61 2d 74 65 y-fieldname a-te
d420: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
d430: 64 65 78 20 6b 65 79 29 29 0a 09 09 09 09 09 20 dex key))......
d440: 28 73 65 63 6f 6e 64 20 28 67 65 74 2d 76 61 6c (second (get-val
d450: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
d460: 62 2d 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c b-test test-fiel
d470: 64 2d 69 6e 64 65 78 20 6b 65 79 29 29 29 0a 09 d-index key)))..
d480: 09 09 09 20 20 20 20 28 28 63 6f 6e 64 20 0a 09 ... ((cond ..
d490: 09 09 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 ... ((and (
d4a0: 6e 75 6d 62 65 72 3f 20 66 69 72 73 74 29 28 6e number? first)(n
d4b0: 75 6d 62 65 72 3f 20 73 65 63 6f 6e 64 29 29 20 umber? second))
d4c0: 3c 29 0a 09 09 09 09 20 20 20 20 20 20 28 28 61 <)..... ((a
d4d0: 6e 64 20 28 73 74 72 69 6e 67 3f 20 66 69 72 73 nd (string? firs
d4e0: 74 29 28 73 74 72 69 6e 67 3f 20 73 65 63 6f 6e t)(string? secon
d4f0: 64 29 29 20 73 74 72 69 6e 67 3c 3d 3f 29 0a 09 d)) string<=?)..
d500: 09 09 09 20 20 20 20 20 20 28 65 6c 73 65 20 65 ... (else e
d510: 71 75 61 6c 3f 29 29 0a 09 09 09 09 20 20 20 20 qual?)).....
d520: 20 66 69 72 73 74 20 73 65 63 6f 6e 64 29 29 29 first second)))
d530: 29 0a 09 09 09 20 20 74 65 73 74 73 29 29 29 29 ).... tests))))
d540: 29 29 0a 09 20 20 20 72 75 6e 73 29 0a 09 20 20 )).. runs)..
d550: 28 69 66 20 28 65 71 3f 20 64 6d 6f 64 65 20 27 (if (eq? dmode '
d560: 6a 73 6f 6e 29 28 6a 73 6f 6e 2d 77 72 69 74 65 json)(json-write
d570: 20 64 61 74 61 29 29 0a 09 20 20 28 6c 65 74 2a data)).. (let*
d580: 20 28 28 6d 65 74 61 64 61 74 2d 66 69 65 6c 64 ((metadat-field
d590: 73 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 s (delete-duplic
d5a0: 61 74 65 73 0a 09 09 09 09 20 20 28 61 70 70 65 ates..... (appe
d5b0: 6e 64 20 6b 65 79 73 20 27 28 20 22 72 75 6e 6e nd keys '( "runn
d5c0: 61 6d 65 22 20 22 74 69 6d 65 22 20 22 6f 77 6e ame" "time" "own
d5d0: 65 72 22 20 22 70 61 73 73 5f 63 6f 75 6e 74 22 er" "pass_count"
d5e0: 20 22 66 61 69 6c 5f 63 6f 75 6e 74 22 20 22 73 "fail_count" "s
d5f0: 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 22 tate" "status" "
d600: 63 6f 6d 6d 65 6e 74 22 20 22 69 64 22 29 29 29 comment" "id")))
d610: 29 0a 09 09 20 28 72 75 6e 2d 66 69 65 6c 64 73 )... (run-fields
d620: 20 20 20 20 27 28 0a 09 09 09 09 20 20 22 74 65 '(..... "te
d630: 73 74 6e 61 6d 65 22 0a 09 09 09 09 20 20 22 69 stname"..... "i
d640: 74 65 6d 5f 70 61 74 68 22 0a 09 09 09 09 20 20 tem_path".....
d650: 22 73 74 61 74 65 22 0a 09 09 09 09 20 20 22 73 "state"..... "s
d660: 74 61 74 75 73 22 0a 09 09 09 09 20 20 22 63 6f tatus"..... "co
d670: 6d 6d 65 6e 74 22 0a 09 09 09 09 20 20 22 65 76 mment"..... "ev
d680: 65 6e 74 5f 74 69 6d 65 22 0a 09 09 09 09 20 20 ent_time".....
d690: 22 68 6f 73 74 22 0a 09 09 09 09 20 20 22 72 75 "host"..... "ru
d6a0: 6e 5f 69 64 22 0a 09 09 09 09 20 20 22 72 75 6e n_id"..... "run
d6b0: 5f 64 75 72 61 74 69 6f 6e 22 0a 09 09 09 09 20 _duration".....
d6c0: 20 22 61 74 74 65 6d 70 74 6e 75 6d 22 0a 09 09 "attemptnum"...
d6d0: 09 09 20 20 22 69 64 22 0a 09 09 09 09 20 20 22 .. "id"..... "
d6e0: 61 72 63 68 69 76 65 64 22 0a 09 09 09 09 20 20 archived".....
d6f0: 22 64 69 73 6b 66 72 65 65 22 0a 09 09 09 09 20 "diskfree".....
d700: 20 22 63 70 75 6c 6f 61 64 22 0a 09 09 09 09 20 "cpuload".....
d710: 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 0a 09 09 "final_logf"...
d720: 09 09 20 20 22 73 68 6f 72 74 64 69 72 22 0a 09 .. "shortdir"..
d730: 09 09 09 20 20 22 72 75 6e 64 69 72 22 0a 09 09 ... "rundir"...
d740: 09 09 20 20 22 75 6e 61 6d 65 22 0a 09 09 09 09 .. "uname".....
d750: 20 20 29 0a 09 09 09 09 29 0a 09 09 20 28 6e 65 ).....)... (ne
d760: 77 64 61 74 20 20 20 20 20 20 20 20 20 20 28 63 wdat (c
d770: 6f 6d 6d 6f 6e 3a 74 6f 2d 61 6c 69 73 74 20 64 ommon:to-alist d
d780: 61 74 61 29 29 0a 09 09 20 28 61 6c 6c 72 75 6e ata))... (allrun
d790: 64 61 74 20 20 20 20 20 20 20 28 69 66 20 28 6e dat (if (n
d7a0: 75 6c 6c 3f 20 6e 65 77 64 61 74 29 0a 09 09 09 ull? newdat)....
d7b0: 09 20 20 20 20 20 20 27 28 29 0a 09 09 09 09 20 . '().....
d7c0: 20 20 20 20 20 28 63 61 72 20 28 6d 61 70 20 63 (car (map c
d7d0: 64 72 20 6e 65 77 64 61 74 29 29 29 29 20 3b 3b dr newdat)))) ;;
d7e0: 20 28 63 61 72 20 28 6d 61 70 20 63 64 72 20 28 (car (map cdr (
d7f0: 63 61 72 20 28 6d 61 70 20 63 64 72 20 6e 65 77 car (map cdr new
d800: 64 61 74 29 29 29 29 29 0a 09 09 20 28 72 75 6e dat)))))... (run
d810: 73 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 s (ap
d820: 70 65 6e 64 0a 09 09 09 09 20 20 20 28 6c 69 73 pend..... (lis
d830: 74 20 22 72 75 6e 73 22 20 3b 3b 20 73 68 65 65 t "runs" ;; shee
d840: 74 6e 61 6d 65 0a 09 09 09 09 09 20 6d 65 74 61 tname...... meta
d850: 64 61 74 2d 66 69 65 6c 64 73 29 0a 09 09 09 09 dat-fields).....
d860: 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda
d870: 28 72 75 6e 29 0a 09 09 09 09 09 20 20 3b 3b 20 (run)...... ;;
d880: 28 70 72 69 6e 74 20 22 72 75 6e 3a 20 22 20 72 (print "run: " r
d890: 75 6e 29 0a 09 09 09 09 09 20 20 28 6c 65 74 2a un)...... (let*
d8a0: 20 28 28 72 75 6e 6e 61 6d 65 20 28 63 61 72 20 ((runname (car
d8b0: 72 75 6e 29 29 0a 09 09 09 09 09 09 20 28 72 75 run))....... (ru
d8c0: 6e 64 61 74 20 20 28 63 64 72 20 72 75 6e 29 29 ndat (cdr run))
d8d0: 0a 09 09 09 09 09 09 20 28 6d 65 74 61 64 61 74 ....... (metadat
d8e0: 20 28 6c 65 74 20 28 28 74 6d 70 20 28 61 73 73 (let ((tmp (ass
d8f0: 6f 63 20 22 6d 65 74 61 22 20 72 75 6e 64 61 74 oc "meta" rundat
d900: 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 )))........ (
d910: 69 66 20 74 6d 70 20 28 63 64 72 20 74 6d 70 29 if tmp (cdr tmp)
d920: 20 23 66 29 29 29 29 0a 09 09 09 09 09 20 20 20 #f))))......
d930: 20 3b 3b 20 28 70 72 69 6e 74 20 22 72 75 6e 6e ;; (print "runn
d940: 61 6d 65 3a 20 22 20 72 75 6e 6e 61 6d 65 20 22 ame: " runname "
d950: 5c 6e 5c 6e 72 75 6e 64 61 74 3a 20 22 20 29 28 \n\nrundat: " )(
d960: 70 70 20 72 75 6e 64 61 74 29 28 70 72 69 6e 74 pp rundat)(print
d970: 20 22 5c 6e 5c 6e 6d 65 74 61 64 61 74 3a 20 22 "\n\nmetadat: "
d980: 29 28 70 70 20 6d 65 74 61 64 61 74 29 0a 09 09 )(pp metadat)...
d990: 09 09 09 20 20 20 20 28 69 66 20 6d 65 74 61 64 ... (if metad
d9a0: 61 74 0a 09 09 09 09 09 09 28 6d 61 70 20 28 6c at.......(map (l
d9b0: 61 6d 62 64 61 20 28 66 69 65 6c 64 29 0a 09 09 ambda (field)...
d9c0: 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 .... (let
d9d0: 28 28 74 6d 70 20 28 61 73 73 6f 63 20 66 69 65 ((tmp (assoc fie
d9e0: 6c 64 20 6d 65 74 61 64 61 74 29 29 29 0a 09 09 ld metadat)))...
d9f0: 09 09 09 09 09 20 28 69 66 20 74 6d 70 20 28 63 ..... (if tmp (c
da00: 64 72 20 74 6d 70 29 20 22 22 29 29 29 0a 09 09 dr tmp) "")))...
da10: 09 09 09 09 20 20 20 20 20 6d 65 74 61 64 61 74 .... metadat
da20: 2d 66 69 65 6c 64 73 29 0a 09 09 09 09 09 09 28 -fields).......(
da30: 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 28 64 begin....... (d
da40: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
da50: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
da60: 22 57 41 52 4e 49 4e 47 3a 20 6d 65 74 61 20 64 "WARNING: meta d
da70: 61 74 61 20 66 6f 72 20 72 75 6e 20 22 20 72 75 ata for run " ru
da80: 6e 6e 61 6d 65 20 22 20 6e 6f 74 20 66 6f 75 6e nname " not foun
da90: 64 22 29 0a 09 09 09 09 09 09 20 20 27 28 29 29 d")....... '())
daa0: 29 29 29 0a 09 09 09 09 09 61 6c 6c 72 75 6e 64 )))......allrund
dab0: 61 74 29 29 29 0a 09 09 20 3b 3b 20 27 28 20 28 at)))... ;; '( (
dac0: 20 22 74 61 72 67 65 74 22 20 28 20 22 72 75 6e "target" ( "run
dad0: 6e 61 6d 65 22 20 28 20 22 64 61 74 61 22 20 28 name" ( "data" (
dae0: 20 22 72 75 6e 69 64 22 20 28 20 22 69 64 20 2e "runid" ( "id .
daf0: 20 22 33 37 22 20 29 20 28 20 2e 2e 2e 20 29 29 "37" ) ( ... ))
db00: 29 29 0a 09 09 20 28 72 75 6e 2d 70 61 67 65 73 ))... (run-pages
db10: 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 (map (lamb
db20: 64 61 20 28 74 61 72 67 64 61 74 29 0a 09 09 09 da (targdat)....
db30: 09 09 28 6c 65 74 2a 20 28 28 74 61 72 67 65 74 ..(let* ((target
db40: 20 20 28 63 61 72 20 74 61 72 67 64 61 74 29 29 (car targdat))
db50: 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 72 75 ...... (ru
db60: 6e 73 64 61 74 20 28 63 64 72 20 74 61 72 67 64 nsdat (cdr targd
db70: 61 74 29 29 29 0a 09 09 09 09 09 20 20 28 69 66 at)))...... (if
db80: 20 72 75 6e 73 64 61 74 0a 09 09 09 09 09 20 20 runsdat......
db90: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda
dba0: 20 28 72 75 6e 64 61 74 29 0a 09 09 09 09 09 09 (rundat).......
dbb0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e (let* ((run
dbc0: 6e 61 6d 65 20 20 28 63 61 72 20 72 75 6e 64 61 name (car runda
dbd0: 74 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 t))........ (
dbe0: 72 75 6e 64 61 74 20 20 20 28 63 64 72 20 72 75 rundat (cdr ru
dbf0: 6e 64 61 74 29 29 0a 09 09 09 09 09 09 09 20 20 ndat))........
dc00: 20 20 28 74 65 73 74 73 64 61 74 20 28 6c 65 74 (testsdat (let
dc10: 20 28 28 74 6d 70 20 28 61 73 73 6f 63 20 22 64 ((tmp (assoc "d
dc20: 61 74 61 22 20 72 75 6e 64 61 74 29 29 29 0a 09 ata" rundat)))..
dc30: 09 09 09 09 09 09 09 09 28 69 66 20 74 6d 70 20 ........(if tmp
dc40: 28 63 64 72 20 74 6d 70 29 20 23 66 29 29 29 29 (cdr tmp) #f))))
dc50: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 69 ....... (i
dc60: 66 20 74 65 73 74 73 64 61 74 0a 09 09 09 09 09 f testsdat......
dc70: 09 09 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 .. (let ((test
dc80: 73 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 s (map (lambda (
dc90: 74 65 73 74 29 0a 09 09 09 09 09 09 09 09 09 20 test)..........
dca0: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 (let* ((te
dcb0: 73 74 2d 69 64 20 20 28 63 61 72 20 74 65 73 74 st-id (car test
dcc0: 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 ))...........
dcd0: 20 20 20 28 74 65 73 74 2d 64 61 74 20 28 63 64 (test-dat (cd
dce0: 72 20 74 65 73 74 29 29 29 0a 09 09 09 09 09 09 r test))).......
dcf0: 09 09 09 09 20 28 6d 61 70 20 28 6c 61 6d 62 64 .... (map (lambd
dd00: 61 20 28 66 69 65 6c 64 29 0a 09 09 09 09 09 09 a (field).......
dd10: 09 09 09 09 09 28 6c 65 74 20 28 28 74 6d 70 20 .....(let ((tmp
dd20: 28 61 73 73 6f 63 20 66 69 65 6c 64 20 74 65 73 (assoc field tes
dd30: 74 2d 64 61 74 29 29 29 0a 09 09 09 09 09 09 09 t-dat)))........
dd40: 09 09 09 09 20 20 28 69 66 20 74 6d 70 20 28 63 .... (if tmp (c
dd50: 64 72 20 74 6d 70 29 20 22 22 29 29 29 0a 09 09 dr tmp) "")))...
dd60: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 72 75 ........ ru
dd70: 6e 2d 66 69 65 6c 64 73 29 29 29 0a 09 09 09 09 n-fields))).....
dd80: 09 09 09 09 09 20 20 20 20 20 74 65 73 74 73 64 ..... testsd
dd90: 61 74 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 at)))........
dda0: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 54 61 72 ;; (print "Tar
ddb0: 67 65 74 3a 20 22 20 74 61 72 67 65 74 20 22 2f get: " target "/
ddc0: 22 20 72 75 6e 6e 61 6d 65 20 22 20 74 65 73 74 " runname " test
ddd0: 73 3a 22 29 0a 09 09 09 09 09 09 09 20 20 20 20 s:")........
dde0: 20 3b 3b 20 28 70 70 20 74 65 73 74 73 29 0a 09 ;; (pp tests)..
ddf0: 09 09 09 09 09 09 20 20 20 20 20 28 63 6f 6e 73 ...... (cons
de00: 20 28 63 6f 6e 63 20 74 61 72 67 65 74 20 22 2f (conc target "/
de10: 22 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 " runname)......
de20: 09 09 09 20 20 20 28 63 6f 6e 73 20 28 6c 69 73 ... (cons (lis
de30: 74 20 28 63 6f 6e 63 20 74 61 72 67 65 74 20 22 t (conc target "
de40: 2f 22 20 72 75 6e 6e 61 6d 65 29 29 0a 09 09 09 /" runname))....
de50: 09 09 09 09 09 09 20 28 63 6f 6e 73 20 27 28 29 ...... (cons '()
de60: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
de70: 20 28 63 6f 6e 73 20 72 75 6e 2d 66 69 65 6c 64 (cons run-field
de80: 73 20 74 65 73 74 73 29 29 29 29 29 0a 09 09 09 s tests)))))....
de90: 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 .... (begin...
dea0: 09 09 09 09 09 20 20 20 20 20 28 64 65 62 75 67 ..... (debug
deb0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
dec0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 t-log-port* "WAR
ded0: 4e 49 4e 47 3a 20 72 75 6e 20 22 20 74 61 72 67 NING: run " targ
dee0: 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 et "/" runname "
def0: 20 61 70 70 65 61 72 73 20 74 6f 20 68 61 76 65 appears to have
df00: 20 6e 6f 20 64 61 74 61 22 29 0a 09 09 09 09 09 no data")......
df10: 09 09 20 20 20 20 20 3b 3b 20 28 70 70 20 72 75 .. ;; (pp ru
df20: 6e 64 61 74 29 0a 09 09 09 09 09 09 09 20 20 20 ndat)........
df30: 20 20 27 28 29 29 29 29 29 0a 09 09 09 09 09 09 '())))).......
df40: 20 20 20 72 75 6e 73 64 61 74 29 0a 09 09 09 09 runsdat).....
df50: 09 20 20 20 20 20 20 27 28 29 29 29 29 0a 09 09 . '())))...
df60: 09 09 20 20 20 20 20 20 6e 65 77 64 61 74 29 29 .. newdat))
df70: 20 3b 3b 20 77 65 20 75 73 65 20 6e 65 77 64 61 ;; we use newda
df80: 74 20 74 6f 20 67 65 74 20 74 61 72 67 65 74 0a t to get target.
df90: 09 09 20 28 73 68 65 65 74 73 20 20 20 20 20 20 .. (sheets
dfa0: 20 20 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 (filter (lamb
dfb0: 64 61 20 28 78 29 0a 09 09 09 09 09 20 20 20 28 da (x)...... (
dfc0: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 78 29 29 29 0a not (null? x))).
dfd0: 09 09 09 09 09 20 28 63 6f 6e 73 20 72 75 6e 73 ..... (cons runs
dfe0: 20 28 6d 61 70 20 63 61 72 20 72 75 6e 2d 70 61 (map car run-pa
dff0: 67 65 73 29 29 29 29 29 0a 09 20 20 20 20 3b 3b ges))))).. ;;
e000: 20 28 70 72 69 6e 74 20 22 61 6c 6c 72 75 6e 64 (print "allrund
e010: 61 74 3a 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 at:").. ;; (p
e020: 70 20 61 6c 6c 72 75 6e 64 61 74 29 0a 09 20 20 p allrundat)..
e030: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 72 75 6e ;; (print "run
e040: 73 3a 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 70 s:").. ;; (pp
e050: 20 72 75 6e 73 29 0a 09 20 20 20 20 3b 28 70 72 runs).. ;(pr
e060: 69 6e 74 20 22 73 68 65 65 74 73 3a 20 22 29 0a int "sheets: ").
e070: 09 20 20 20 20 3b 3b 20 28 70 70 20 73 68 65 65 . ;; (pp shee
e080: 74 73 29 0a 09 20 20 20 20 28 69 66 20 28 65 71 ts).. (if (eq
e090: 3f 20 64 6d 6f 64 65 20 27 6f 64 73 29 0a 09 09 ? dmode 'ods)...
e0a0: 28 6c 65 74 2a 20 28 28 74 65 6d 70 64 69 72 20 (let* ((tempdir
e0b0: 20 20 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 (conc "/tmp/"
e0c0: 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e (current-user-n
e0d0: 61 6d 65 29 20 22 2f 22 20 28 72 61 6e 64 6f 6d ame) "/" (random
e0e0: 20 31 30 30 30 30 29 20 22 5f 22 20 28 63 75 72 10000) "_" (cur
e0f0: 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 rent-process-id)
e100: 29 29 0a 09 09 20 20 20 20 20 20 20 28 6f 75 74 ))... (out
e110: 70 75 74 66 69 6c 65 20 28 6f 72 20 28 61 72 67 putfile (or (arg
e120: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 20 s:get-arg "-o")
e130: 22 6f 75 74 2e 6f 64 73 22 29 29 0a 09 09 20 20 "out.ods"))...
e140: 20 20 20 20 20 28 6f 75 66 20 20 20 20 20 20 20 (ouf
e150: 20 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 (if (string-mat
e160: 63 68 20 28 72 65 67 65 78 70 20 22 5e 5b 2f 7e ch (regexp "^[/~
e170: 5d 2b 2e 2a 22 29 20 6f 75 74 70 75 74 66 69 6c ]+.*") outputfil
e180: 65 29 20 3b 3b 20 66 75 6c 6c 20 70 61 74 68 3f e) ;; full path?
e190: 0a 09 09 09 09 20 20 20 20 20 20 20 6f 75 74 70 ..... outp
e1a0: 75 74 66 69 6c 65 0a 09 09 09 09 20 20 20 20 20 utfile.....
e1b0: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 28 (begin...... (
e1c0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
e1d0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
e1e0: 20 22 57 41 52 4e 49 4e 47 3a 20 70 61 74 68 20 "WARNING: path
e1f0: 67 69 76 65 6e 2c 20 22 20 6f 75 74 70 75 74 66 given, " outputf
e200: 69 6c 65 20 22 20 69 73 20 72 65 6c 61 74 69 76 ile " is relativ
e210: 65 2c 20 70 72 65 66 69 78 69 6e 67 20 77 69 74 e, prefixing wit
e220: 68 20 63 75 72 72 65 6e 74 20 64 69 72 65 63 74 h current direct
e230: 6f 72 79 22 29 0a 09 09 09 09 09 20 28 63 6f 6e ory")...... (con
e240: 63 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 c (current-direc
e250: 74 6f 72 79 29 20 22 2f 22 20 6f 75 74 70 75 74 tory) "/" output
e260: 66 69 6c 65 29 29 29 29 29 0a 09 09 20 20 28 63 file)))))... (c
e270: 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 reate-directory
e280: 74 65 6d 70 64 69 72 20 23 74 29 0a 09 09 20 20 tempdir #t)...
e290: 28 6f 64 73 3a 6c 69 73 74 2d 3e 6f 64 73 20 74 (ods:list->ods t
e2a0: 65 6d 70 64 69 72 20 6f 75 66 20 73 68 65 65 74 empdir ouf sheet
e2b0: 73 29 29 29 29 0a 09 20 20 3b 3b 20 28 73 79 73 s)))).. ;; (sys
e2c0: 74 65 6d 20 28 63 6f 6e 63 20 22 72 6d 20 2d 72 tem (conc "rm -r
e2d0: 66 20 22 20 74 65 6d 70 64 69 72 29 29 0a 09 20 f " tempdir))..
e2e0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
e2f0: 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b hing* #t))))..;;
e300: 20 44 6f 6e 27 74 20 74 68 69 6e 6b 20 49 20 6e Don't think I n
e310: 65 65 64 20 74 68 69 73 2e 20 49 6e 63 6f 72 70 eed this. Incorp
e320: 6f 72 61 74 65 64 20 69 6e 74 6f 20 2d 6c 69 73 orated into -lis
e330: 74 2d 72 75 6e 73 20 69 6e 73 74 65 61 64 0a 3b t-runs instead.;
e340: 3b 0a 3b 3b 20 28 69 66 20 28 61 6e 64 20 28 61 ;.;; (if (and (a
e350: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 rgs:get-arg "-si
e360: 6e 63 65 22 29 0a 3b 3b 20 09 20 28 6c 61 75 6e nce").;; . (laun
e370: 63 68 3a 73 65 74 75 70 29 29 0a 3b 3b 20 20 20 ch:setup)).;;
e380: 20 20 28 6c 65 74 2a 20 28 28 73 69 6e 63 65 2d (let* ((since-
e390: 74 69 6d 65 20 28 73 74 72 69 6e 67 2d 3e 6e 75 time (string->nu
e3a0: 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 mber (args:get-a
e3b0: 72 67 20 22 2d 73 69 6e 63 65 22 29 29 29 0a 3b rg "-since"))).;
e3c0: 3b 20 09 20 20 20 28 72 75 6e 2d 69 64 73 20 20 ; . (run-ids
e3d0: 20 20 28 64 62 3a 67 65 74 2d 63 68 61 6e 67 65 (db:get-change
e3e0: 64 2d 72 75 6e 2d 69 64 73 20 73 69 6e 63 65 2d d-run-ids since-
e3f0: 74 69 6d 65 29 29 29 0a 3b 3b 20 20 20 20 20 20 time))).;;
e400: 20 3b 3b 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 ;; (rmt:get-tes
e410: 74 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 ts-for-runs-mind
e420: 61 74 61 20 72 75 6e 2d 69 64 73 20 74 65 73 74 ata run-ids test
e430: 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 patt states stat
e440: 75 73 20 6e 6f 74 2d 69 6e 29 0a 3b 3b 20 20 20 us not-in).;;
e450: 20 20 20 20 28 70 72 69 6e 74 20 28 73 6f 72 74 (print (sort
e460: 20 72 75 6e 2d 69 64 73 20 3c 29 29 0a 3b 3b 20 run-ids <)).;;
e470: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
e480: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
e490: 0a 20 20 20 20 20 20 0a 20 20 20 20 20 20 0a 3b . . .;
e4a0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
e4b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4e0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 =======.;; full
e4f0: 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;==========
e500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
e540: 20 67 65 74 20 6c 6f 63 6b 20 69 6e 20 64 62 20 get lock in db
e550: 66 6f 72 20 66 75 6c 6c 20 72 75 6e 20 66 6f 72 for full run for
e560: 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 0a this directory.
e570: 3b 3b 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 ;; for all tests
e580: 20 77 69 74 68 20 64 65 70 73 0a 3b 3b 20 20 20 with deps.;;
e590: 77 61 6c 6b 20 74 72 65 65 20 6f 66 20 74 65 73 walk tree of tes
e5a0: 74 73 20 74 6f 20 66 69 6e 64 20 68 65 61 64 20 ts to find head
e5b0: 74 61 73 6b 73 0a 3b 3b 20 20 20 61 64 64 20 68 tasks.;; add h
e5c0: 65 61 64 20 74 61 73 6b 73 20 74 6f 20 74 61 73 ead tasks to tas
e5d0: 6b 20 71 75 65 75 65 0a 3b 3b 20 20 20 61 64 64 k queue.;; add
e5e0: 20 64 65 70 65 6e 64 61 6e 74 20 74 61 73 6b 73 dependant tasks
e5f0: 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 20 0a to task queue .
e600: 3b 3b 20 20 20 61 64 64 20 72 65 6d 61 69 6e 69 ;; add remaini
e610: 6e 67 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b ng tasks to task
e620: 20 71 75 65 75 65 0a 3b 3b 20 66 6f 72 20 65 61 queue.;; for ea
e630: 63 68 20 74 61 73 6b 20 69 6e 20 74 61 73 6b 20 ch task in task
e640: 71 75 65 75 65 0a 3b 3b 20 20 20 69 66 20 68 61 queue.;; if ha
e650: 76 65 20 61 64 65 71 75 61 74 65 20 72 65 73 6f ve adequate reso
e660: 75 72 63 65 73 0a 3b 3b 20 20 20 20 20 6c 61 75 urces.;; lau
e670: 6e 63 68 20 74 61 73 6b 0a 3b 3b 20 20 20 65 6c nch task.;; el
e680: 73 65 0a 3b 3b 20 20 20 20 20 70 75 74 20 74 61 se.;; put ta
e690: 73 6b 20 69 6e 20 64 65 66 65 72 72 65 64 20 71 sk in deferred q
e6a0: 75 65 75 65 0a 3b 3b 20 69 66 20 73 74 69 6c 6c ueue.;; if still
e6b0: 20 6f 6b 20 74 6f 20 72 75 6e 20 74 61 73 6b 73 ok to run tasks
e6c0: 0a 3b 3b 20 20 20 70 72 6f 63 65 73 73 20 64 65 .;; process de
e6d0: 66 65 72 72 65 64 20 74 61 73 6b 73 20 70 65 72 ferred tasks per
e6e0: 20 61 62 6f 76 65 20 73 74 65 70 73 0a 0a 3b 3b above steps..;;
e6f0: 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 61 run all tests a
e700: 72 65 20 61 72 65 20 4e 6f 74 20 43 4f 4d 50 4c re are Not COMPL
e710: 45 54 45 44 20 61 6e 64 20 50 41 53 53 20 6f 72 ETED and PASS or
e720: 20 43 48 45 43 4b 0a 28 69 66 20 28 6f 72 20 28 CHECK.(if (or (
e730: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
e740: 75 6e 61 6c 6c 22 29 0a 09 28 61 72 67 73 3a 67 unall")..(args:g
e750: 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a 09 et-arg "-run")..
e760: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
e770: 72 65 72 75 6e 2d 63 6c 65 61 6e 22 29 0a 09 28 rerun-clean")..(
e780: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
e790: 65 72 75 6e 2d 61 6c 6c 22 29 0a 09 28 61 72 67 erun-all")..(arg
e7a0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 s:get-arg "-runt
e7b0: 65 73 74 73 22 29 29 0a 20 20 20 20 28 67 65 6e ests")). (gen
e7c0: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 eral-run-call .
e7d0: 20 20 20 20 22 2d 72 75 6e 61 6c 6c 22 0a 20 20 "-runall".
e7e0: 20 20 20 22 72 75 6e 20 61 6c 6c 20 74 65 73 74 "run all test
e7f0: 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 s". (lambda
e800: 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 (target runname
e810: 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 keys keyvals).
e820: 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 (if (args:g
e830: 65 74 2d 61 72 67 20 22 2d 72 65 72 75 6e 2d 63 et-arg "-rerun-c
e840: 6c 65 61 6e 22 29 20 3b 3b 20 66 69 72 73 74 20 lean") ;; first
e850: 73 65 74 20 73 74 61 74 65 73 2f 73 74 61 74 75 set states/statu
e860: 73 65 73 20 63 6f 72 72 65 63 74 0a 09 20 20 20 ses correct..
e870: 28 6c 65 74 20 28 28 73 74 61 74 65 73 20 20 20 (let ((states
e880: 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (or (configf:loo
e890: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
e8a0: 22 76 61 6c 69 64 76 61 6c 75 65 73 22 20 22 63 "validvalues" "c
e8b0: 6c 65 61 6e 72 65 72 75 6e 2d 73 74 61 74 65 73 leanrerun-states
e8c0: 22 29 0a 09 09 09 20 20 20 20 20 20 20 22 4b 49 ").... "KI
e8d0: 4c 4c 52 45 51 2c 4b 49 4c 4c 45 44 2c 55 4e 4b LLREQ,KILLED,UNK
e8e0: 4e 4f 57 4e 2c 49 4e 43 4f 4d 50 4c 45 54 45 2c NOWN,INCOMPLETE,
e8f0: 53 54 55 43 4b 2c 4e 4f 54 5f 53 54 41 52 54 45 STUCK,NOT_STARTE
e900: 44 22 29 29 0a 09 09 20 28 73 74 61 74 75 73 65 D"))... (statuse
e910: 73 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c s (or (configf:l
e920: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
e930: 2a 20 22 76 61 6c 69 64 76 61 6c 75 65 73 22 20 * "validvalues"
e940: 22 63 6c 65 61 6e 72 65 72 75 6e 2d 73 74 61 74 "cleanrerun-stat
e950: 75 73 65 73 22 29 0a 09 09 09 20 20 20 20 20 20 uses")....
e960: 20 22 46 41 49 4c 2c 49 4e 43 4f 4d 50 4c 45 54 "FAIL,INCOMPLET
e970: 45 2c 41 42 4f 52 54 2c 43 48 45 43 4b 22 29 29 E,ABORT,CHECK"))
e980: 29 0a 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 ).. (hash-ta
e990: 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 ble-set! args:ar
e9a0: 67 2d 68 61 73 68 20 22 2d 70 72 65 63 6c 65 61 g-hash "-preclea
e9b0: 6e 22 20 23 74 29 0a 09 20 20 20 20 20 28 72 75 n" #t).. (ru
e9c0: 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 ns:operate-on 's
e9d0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a et-state-status.
e9e0: 09 09 09 20 20 20 20 20 20 74 61 72 67 65 74 0a ... target.
e9f0: 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e ... (common
ea00: 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d :args-get-runnam
ea10: 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 e) ;; (or (args
ea20: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 :get-arg "-runna
ea30: 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 me")(args:get-ar
ea40: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g ":runname"))..
ea50: 09 09 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 .. "%" ;; (
ea60: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
ea70: 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 testpatt #f) ;;
ea80: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
ea90: 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 testpatt")....
eaa0: 20 20 20 20 73 74 61 74 65 3a 20 20 73 74 61 74 state: stat
eab0: 65 73 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 73 es.... ;; s
eac0: 74 61 74 75 73 3a 20 73 74 61 74 75 73 65 73 0a tatus: statuses.
ead0: 09 09 09 20 20 20 20 20 20 6e 65 77 2d 73 74 61 ... new-sta
eae0: 74 65 2d 73 74 61 74 75 73 3a 20 22 4e 4f 54 5f te-status: "NOT_
eaf0: 53 54 41 52 54 45 44 2c 6e 2f 61 22 29 0a 09 20 STARTED,n/a")..
eb00: 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 (runs:operat
eb10: 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d e-on 'set-state-
eb20: 73 74 61 74 75 73 0a 09 09 09 20 20 20 20 20 20 status....
eb30: 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 20 20 target....
eb40: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
eb50: 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f -runname) ;; (o
eb60: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
eb70: 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 "-runname")(args
eb80: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
eb90: 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 20 22 me")).... "
eba0: 25 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 %" ;; (common:ar
ebb0: 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 gs-get-testpatt
ebc0: 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 #f) ;; (args:get
ebd0: 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 -arg "-testpatt"
ebe0: 29 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 73 74 ).... ;; st
ebf0: 61 74 65 3a 20 20 73 74 61 74 65 73 0a 09 09 09 ate: states....
ec00: 20 20 20 20 20 20 73 74 61 74 75 73 3a 20 73 74 status: st
ec10: 61 74 75 73 65 73 0a 09 09 09 20 20 20 20 20 20 atuses....
ec20: 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 new-state-status
ec30: 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e : "NOT_STARTED,n
ec40: 2f 61 22 29 29 29 0a 20 20 20 20 20 20 20 3b 3b /a"))). ;;
ec50: 20 52 45 52 55 4e 20 41 4c 4c 0a 20 20 20 20 20 RERUN ALL.
ec60: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
ec70: 61 72 67 20 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 arg "-rerun-all"
ec80: 29 20 3b 3b 20 66 69 72 73 74 20 73 65 74 20 73 ) ;; first set s
ec90: 74 61 74 65 73 2f 73 74 61 74 75 73 65 73 20 63 tates/statuses c
eca0: 6f 72 72 65 63 74 0a 09 20 20 20 28 62 65 67 69 orrect.. (begi
ecb0: 6e 0a 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 n.. (hash-ta
ecc0: 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 ble-set! args:ar
ecd0: 67 2d 68 61 73 68 20 22 2d 70 72 65 63 6c 65 61 g-hash "-preclea
ece0: 6e 22 20 23 74 29 0a 09 20 20 20 20 20 28 72 75 n" #t).. (ru
ecf0: 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 ns:operate-on 's
ed00: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a et-state-status.
ed10: 09 09 09 20 20 20 20 20 20 74 61 72 67 65 74 0a ... target.
ed20: 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e ... (common
ed30: 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d :args-get-runnam
ed40: 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 e) ;; (or (args
ed50: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 :get-arg "-runna
ed60: 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 me")(args:get-ar
ed70: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g ":runname"))..
ed80: 09 09 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 .. "%" ;; (
ed90: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
eda0: 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 testpatt #f) ;;
edb0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
edc0: 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 testpatt")....
edd0: 20 20 20 20 73 74 61 74 65 3a 20 20 23 66 0a 09 state: #f..
ede0: 09 09 20 20 20 20 20 20 3b 3b 20 73 74 61 74 75 .. ;; statu
edf0: 73 3a 20 73 74 61 74 75 73 65 73 0a 09 09 09 20 s: statuses....
ee00: 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 new-state-s
ee10: 74 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 tatus: "NOT_STAR
ee20: 54 45 44 2c 6e 2f 61 22 29 0a 09 20 20 20 20 20 TED,n/a")..
ee30: 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e (runs:operate-on
ee40: 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 'set-state-stat
ee50: 75 73 0a 09 09 09 20 20 20 20 20 20 74 61 72 67 us.... targ
ee60: 65 74 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d et.... (com
ee70: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e mon:args-get-run
ee80: 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 name) ;; (or (a
ee90: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
eea0: 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 nname")(args:get
eeb0: 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 -arg ":runname")
eec0: 29 0a 09 09 09 20 20 20 20 20 20 22 25 22 20 3b ).... "%" ;
eed0: 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 ; (common:args-g
eee0: 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 20 et-testpatt #f)
eef0: 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ;; (args:get-arg
ef00: 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 "-testpatt")...
ef10: 09 20 20 20 20 20 20 3b 3b 20 73 74 61 74 65 3a . ;; state:
ef20: 20 20 73 74 61 74 65 73 0a 09 09 09 20 20 20 20 states....
ef30: 20 20 73 74 61 74 75 73 3a 20 23 66 0a 09 09 09 status: #f....
ef40: 20 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d new-state-
ef50: 73 74 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 status: "NOT_STA
ef60: 52 54 45 44 2c 6e 2f 61 22 29 29 29 0a 20 20 20 RTED,n/a"))).
ef70: 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 (runs:run-te
ef80: 73 74 73 20 74 61 72 67 65 74 0a 09 09 20 20 20 sts target...
ef90: 20 20 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 runname...
efa0: 20 20 20 20 20 23 66 20 3b 3b 20 28 63 6f 6d 6d #f ;; (comm
efb0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
efc0: 70 61 74 74 20 23 66 29 0a 09 09 20 20 20 20 20 patt #f)...
efd0: 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 ;; (or (args:g
efe0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
eff0: 74 22 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 t")... ;;
f000: 20 20 20 20 22 25 22 29 0a 09 09 20 20 20 20 20 "%")...
f010: 20 20 75 73 65 72 0a 09 09 20 20 20 20 20 20 20 user...
f020: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 args:arg-hash)))
f030: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
f040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 ===========.;; r
f080: 75 6e 20 6f 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d un one test.;;==
f090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f0a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f0b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f0c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f0d0: 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 ====..;; 1. find
f0e0: 20 74 68 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 the config file
f0f0: 0a 3b 3b 20 32 2e 20 63 68 61 6e 67 65 20 74 6f .;; 2. change to
f100: 20 74 68 65 20 74 65 73 74 20 64 69 72 65 63 74 the test direct
f110: 6f 72 79 0a 3b 3b 20 33 2e 20 75 70 64 61 74 65 ory.;; 3. update
f120: 20 74 68 65 20 64 62 20 77 69 74 68 20 22 74 65 the db with "te
f130: 73 74 20 73 74 61 72 74 65 64 22 20 73 74 61 74 st started" stat
f140: 75 73 2c 20 73 65 74 20 72 75 6e 6e 69 6e 67 20 us, set running
f150: 68 6f 73 74 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 host.;; 4. proce
f160: 73 73 20 6c 61 75 6e 63 68 20 74 68 65 20 74 65 ss launch the te
f170: 73 74 0a 3b 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 st.;; - monit
f180: 6f 72 20 74 68 65 20 70 72 6f 63 65 73 73 2c 20 or the process,
f190: 75 70 64 61 74 65 20 73 74 61 74 73 20 69 6e 20 update stats in
f1a0: 74 68 65 20 64 62 20 65 76 65 72 79 20 32 5e 6e the db every 2^n
f1b0: 20 6d 69 6e 75 74 65 73 0a 3b 3b 20 35 2e 20 61 minutes.;; 5. a
f1c0: 73 20 74 68 65 20 74 65 73 74 20 70 72 6f 63 65 s the test proce
f1d0: 65 64 73 20 69 6e 74 65 72 6e 61 6c 6c 79 20 69 eds internally i
f1e0: 74 20 63 61 6c 6c 73 20 6d 65 67 61 74 65 73 74 t calls megatest
f1f0: 20 61 73 20 65 61 63 68 20 73 74 65 70 20 69 73 as each step is
f200: 0a 3b 3b 20 20 20 20 73 74 61 72 74 65 64 20 61 .;; started a
f210: 6e 64 20 63 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 nd completed.;;
f220: 20 20 20 2d 20 73 74 65 70 20 73 74 61 72 74 65 - step starte
f230: 64 2c 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 d, timestamp.;;
f240: 20 20 20 2d 20 73 74 65 70 20 63 6f 6d 70 6c 65 - step comple
f250: 74 65 64 2c 20 65 78 69 74 20 73 74 61 74 75 73 ted, exit status
f260: 2c 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 , timestamp.;; 6
f270: 2e 20 74 65 73 74 20 70 68 6f 6e 65 20 68 6f 6d . test phone hom
f280: 65 0a 3b 3b 20 20 20 20 2d 20 69 66 20 74 65 73 e.;; - if tes
f290: 74 20 72 75 6e 20 74 69 6d 65 20 3e 20 61 6c 6c t run time > all
f2a0: 6f 77 65 64 20 72 75 6e 20 74 69 6d 65 20 74 68 owed run time th
f2b0: 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 en kill job.;;
f2c0: 20 20 2d 20 69 66 20 63 61 6e 6e 6f 74 20 61 63 - if cannot ac
f2d0: 63 65 73 73 20 64 62 20 3e 20 61 6c 6c 6f 77 65 cess db > allowe
f2e0: 64 20 64 69 73 63 6f 6e 6e 65 63 74 20 74 69 6d d disconnect tim
f2f0: 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a e then kill job.
f300: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
f310: 64 20 3d 3d 20 28 69 66 20 28 6f 72 20 28 61 72 d == (if (or (ar
f320: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
f330: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
f340: 22 2d 72 75 6e 74 65 73 74 73 22 29 29 0a 3b 3b "-runtests")).;;
f350: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
f360: 3d 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e = (general-run
f370: 2d 63 61 6c 6c 20 0a 3b 3b 20 3d 3d 20 64 75 70 -call .;; == dup
f380: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 22 2d licated == "-
f390: 72 75 6e 74 65 73 74 73 22 20 0a 3b 3b 20 3d 3d runtests" .;; ==
f3a0: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
f3b0: 20 20 22 72 75 6e 20 61 20 74 65 73 74 22 20 0a "run a test" .
f3c0: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f3d0: 20 3d 3d 20 20 20 20 28 6c 61 6d 62 64 61 20 28 == (lambda (
f3e0: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
f3f0: 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 3b 3b 20 eys keyvals).;;
f400: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f410: 20 20 20 20 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 ;;.;; == d
f420: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
f430: 20 20 3b 3b 20 4d 61 79 20 6f 72 20 6d 61 79 20 ;; May or may
f440: 6e 6f 74 20 69 6d 70 6c 65 6d 65 6e 74 20 69 74 not implement it
f450: 20 74 68 69 73 20 77 61 79 20 2e 2e 2e 0a 3b 3b this way ....;;
f460: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
f470: 3d 20 20 20 20 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 = ;;.;; ==
f480: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
f490: 20 20 20 3b 3b 20 49 6e 73 65 72 74 20 74 68 69 ;; Insert thi
f4a0: 73 20 72 75 6e 20 69 6e 74 6f 20 74 68 65 20 74 s run into the t
f4b0: 61 73 6b 73 20 71 75 65 75 65 0a 3b 3b 20 3d 3d asks queue.;; ==
f4c0: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
f4d0: 20 20 20 20 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e ;; (open-run
f4e0: 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 61 64 64 -close tasks:add
f4f0: 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 0a tasks:open-db .
f500: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f510: 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 == ;; .
f520: 20 20 20 20 20 22 72 75 6e 74 65 73 74 73 22 20 "runtests"
f530: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
f540: 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 d == ;;
f550: 09 20 20 20 20 20 75 73 65 72 0a 3b 3b 20 3d 3d . user.;; ==
f560: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
f570: 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 ;; .
f580: 74 61 72 67 65 74 0a 3b 3b 20 3d 3d 20 64 75 70 target.;; == dup
f590: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 licated ==
f5a0: 3b 3b 20 20 20 20 09 20 20 20 20 20 72 75 6e 6e ;; . runn
f5b0: 61 6d 65 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 ame.;; == duplic
f5c0: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 ated == ;;
f5d0: 20 20 20 09 20 20 20 20 20 28 61 72 67 73 3a 67 . (args:g
f5e0: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
f5f0: 73 22 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 s").;; == duplic
f600: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 ated == ;;
f610: 20 20 20 09 20 20 20 20 20 23 66 29 29 29 29 0a . #f)))).
f620: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f630: 20 3d 3d 20 20 20 20 20 20 28 72 75 6e 73 3a 72 == (runs:r
f640: 75 6e 2d 74 65 73 74 73 20 74 61 72 67 65 74 0a un-tests target.
f650: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f660: 20 3d 3d 20 09 09 20 20 20 20 20 72 75 6e 6e 61 == .. runna
f670: 6d 65 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 me.;; == duplica
f680: 74 65 64 20 3d 3d 20 09 09 20 20 20 20 20 28 63 ted == .. (c
f690: 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 ommon:args-get-t
f6a0: 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 estpatt #f) ;; (
f6b0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
f6c0: 75 6e 74 65 73 74 73 22 29 0a 3b 3b 20 3d 3d 20 untests").;; ==
f6d0: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 duplicated == ..
f6e0: 20 20 20 20 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 user.;; ==
f6f0: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 duplicated == ..
f700: 20 20 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 args:arg-ha
f710: 73 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d sh))))..;;======
f720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f760: 0a 3b 3b 20 52 6f 6c 6c 75 70 20 69 6e 74 6f 20 .;; Rollup into
f770: 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d a run.;;========
f780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f7a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f7b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
f7c0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
f7d0: 67 20 22 2d 72 6f 6c 6c 75 70 22 29 0a 20 20 20 g "-rollup").
f7e0: 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 (general-run-ca
f7f0: 6c 6c 20 0a 20 20 20 20 20 22 2d 72 6f 6c 6c 75 ll . "-rollu
f800: 70 22 20 0a 20 20 20 20 20 22 72 6f 6c 6c 75 70 p" . "rollup
f810: 20 74 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c tests" . (l
f820: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
f830: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 nname keys keyva
f840: 6c 73 29 0a 20 20 20 20 20 20 20 28 72 75 6e 73 ls). (runs
f850: 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 6b 65 79 73 :rollup-run keys
f860: 0a 09 09 09 6b 65 79 76 61 6c 73 0a 09 09 09 28 ....keyvals....(
f870: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
f880: 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 "-runname")(arg
f890: 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e s:get-arg ":runn
f8a0: 61 6d 65 22 29 20 29 0a 09 09 09 75 73 65 72 29 ame") )....user)
f8b0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
f8c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
f900: 20 4c 6f 63 6b 20 6f 72 20 75 6e 6c 6f 63 6b 20 Lock or unlock
f910: 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d a run.;;========
f920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
f960: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
f970: 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 28 61 t-arg "-lock")(a
f980: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e rgs:get-arg "-un
f990: 6c 6f 63 6b 22 29 29 0a 20 20 20 20 28 67 65 6e lock")). (gen
f9a0: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 eral-run-call .
f9b0: 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 (if (args:ge
f9c0: 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 20 22 t-arg "-lock") "
f9d0: 2d 6c 6f 63 6b 22 20 22 2d 75 6e 6c 6f 63 6b 22 -lock" "-unlock"
f9e0: 29 0a 20 20 20 20 20 22 6c 6f 63 6b 2f 75 6e 6c ). "lock/unl
f9f0: 6f 63 6b 20 74 65 73 74 73 22 20 0a 20 20 20 20 ock tests" .
fa00: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
fa10: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
fa20: 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 72 yvals). (r
fa30: 75 6e 73 3a 68 61 6e 64 6c 65 2d 6c 6f 63 6b 69 uns:handle-locki
fa40: 6e 67 20 0a 09 09 20 20 74 61 72 67 65 74 0a 09 ng ... target..
fa50: 09 20 20 6b 65 79 73 0a 09 09 20 20 28 6f 72 20 . keys... (or
fa60: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
fa70: 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 runname")(args:g
fa80: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
fa90: 22 29 20 29 0a 09 09 20 20 28 61 72 67 73 3a 67 ") )... (args:g
faa0: 65 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 0a et-arg "-lock").
fab0: 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 .. (args:get-ar
fac0: 67 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 09 09 20 g "-unlock")...
fad0: 20 75 73 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d user))))..;;===
fae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
faf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb20: 3d 3d 3d 0a 3b 3b 20 47 65 74 20 70 61 74 68 73 ===.;; Get paths
fb30: 20 74 6f 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d to tests.;;====
fb40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb80: 3d 3d 0a 3b 3b 20 47 65 74 20 74 65 73 74 20 70 ==.;; Get test p
fb90: 61 74 68 73 20 6d 61 74 63 68 69 6e 67 20 74 61 aths matching ta
fba0: 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 rget, runname, a
fbb0: 6e 64 20 74 65 73 74 70 61 74 74 0a 28 69 66 20 nd testpatt.(if
fbc0: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
fbd0: 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 29 g "-test-files")
fbe0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
fbf0: 74 65 73 74 2d 70 61 74 68 73 22 29 29 0a 20 20 test-paths")).
fc00: 20 20 3b 3b 20 69 66 20 77 65 20 61 72 65 20 69 ;; if we are i
fc10: 6e 20 61 20 74 65 73 74 20 75 73 65 20 74 68 65 n a test use the
fc20: 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 61 74 61 MT_CMDINFO data
fc30: 0a 20 20 20 20 28 69 66 20 28 67 65 74 65 6e 76 . (if (getenv
fc40: 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 0a 09 "MT_CMDINFO")..
fc50: 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e 67 (let* ((starting
fc60: 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 72 dir (current-dir
fc70: 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 20 ectory))..
fc80: 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d (cmdinfo (com
fc90: 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 mon:read-encoded
fca0: 2d 73 74 72 69 6e 67 20 28 67 65 74 65 6e 76 20 -string (getenv
fcb0: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a "MT_CMDINFO"))).
fcc0: 09 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f . (transpo
fcd0: 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c rt (assoc/defaul
fce0: 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 t 'transport cmd
fcf0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
fd00: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
fd10: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
fd20: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
fd30: 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
fd40: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
fd50: 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
fd60: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
fd70: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
fd80: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
fd90: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
fda0: 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 (db-host (
fdb0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 assoc/default 'd
fdc0: 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f b-host cmdinfo
fdd0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
fde0: 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 id (assoc/def
fdf0: 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 ault 'run-id
fe00: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
fe10: 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
fe20: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
fe30: 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
fe40: 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 65 20 .. (state
fe50: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
fe60: 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 g ":state"))..
fe70: 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 (status
fe80: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
fe90: 73 74 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 status"))..
fea0: 20 20 28 74 61 72 67 65 74 20 20 20 20 28 61 72 (target (ar
feb0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 gs:get-arg "-tar
fec0: 67 65 74 22 29 29 0a 09 20 20 20 20 20 20 20 28 get")).. (
fed0: 74 6f 70 70 61 74 68 20 20 20 28 61 73 73 6f 63 toppath (assoc
fee0: 2f 64 65 66 61 75 6c 74 20 27 74 6f 70 70 61 74 /default 'toppat
fef0: 68 20 20 20 63 6d 64 69 6e 66 6f 29 29 29 0a 09 h cmdinfo)))..
ff00: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
ff10: 6f 72 79 20 74 6f 70 70 61 74 68 29 0a 09 20 20 ory toppath)..
ff20: 28 69 66 20 28 6e 6f 74 20 74 61 72 67 65 74 29 (if (not target)
ff30: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
ff40: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 .(debug:print-er
ff50: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
ff60: 6f 67 2d 70 6f 72 74 2a 20 22 2d 74 61 72 67 65 og-port* "-targe
ff70: 74 20 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 t is required.")
ff80: 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 ...(exit 1)))..
ff90: 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 (if (not (launc
ffa0: 68 3a 73 65 74 75 70 29 29 0a 09 20 20 20 20 20 h:setup))..
ffb0: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
ffc0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
ffd0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
ffe0: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 67 69 led to setup, gi
fff0: 76 69 6e 67 20 75 70 20 6f 6e 20 2d 74 65 73 74 ving up on -test
10000 2d 70 61 74 68 73 20 6f 72 20 2d 74 65 73 74 2d -paths or -test-
10010 66 69 6c 65 73 2c 20 65 78 69 74 69 6e 67 22 29 files, exiting")
10020 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 ...(exit 1)))..
10030 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 (let* ((keys
10040 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 (rmt:get-keys)
10050 29 0a 09 09 20 3b 3b 20 64 62 3a 74 65 73 74 2d )... ;; db:test-
10060 67 65 74 2d 70 61 74 68 73 20 6d 75 73 74 20 6e get-paths must n
10070 6f 74 20 62 65 20 72 75 6e 20 72 65 6d 6f 74 65 ot be run remote
10080 0a 09 09 20 28 70 61 74 68 73 20 20 20 20 28 74 ... (paths (t
10090 65 73 74 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 ests:test-get-pa
100a0 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 6b 65 79 ths-matching key
100b0 73 20 74 61 72 67 65 74 20 28 61 72 67 73 3a 67 s target (args:g
100c0 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 et-arg "-test-fi
100d0 6c 65 73 22 29 29 29 29 0a 09 20 20 20 20 28 73 les")))).. (s
100e0 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
100f0 67 2a 20 23 74 29 0a 09 20 20 20 20 28 66 6f 72 g* #t).. (for
10100 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 -each (lambda (p
10110 61 74 68 29 0a 09 09 09 28 70 72 69 6e 74 20 70 ath)....(print p
10120 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 70 61 ath))... pa
10130 74 68 73 29 29 29 0a 09 3b 3b 20 65 6c 73 65 20 ths)))..;; else
10140 64 6f 20 61 20 67 65 6e 65 72 61 6c 2d 72 75 6e do a general-run
10150 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 72 61 6c 2d -call..(general-
10160 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 22 2d 74 65 run-call .. "-te
10170 73 74 2d 66 69 6c 65 73 22 0a 09 20 22 47 65 74 st-files".. "Get
10180 20 70 61 74 68 73 20 74 6f 20 74 65 73 74 22 0a paths to test".
10190 09 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 . (lambda (targe
101a0 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
101b0 65 79 76 61 6c 73 29 0a 09 20 20 20 28 6c 65 74 eyvals).. (let
101c0 2a 20 28 28 64 62 20 20 20 20 20 20 20 23 66 29 * ((db #f)
101d0 0a 09 09 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 ... ;; DO NOT r
101e0 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 20 28 70 un remote... (p
101f0 61 74 68 73 20 20 20 20 28 74 65 73 74 73 3a 74 aths (tests:t
10200 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 est-get-paths-ma
10210 74 63 68 69 6e 67 20 6b 65 79 73 20 74 61 72 67 tching keys targ
10220 65 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 et (args:get-arg
10230 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 29 29 "-test-files"))
10240 29 29 0a 09 20 20 20 20 20 28 66 6f 72 2d 65 61 )).. (for-ea
10250 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 74 68 ch (lambda (path
10260 29 0a 09 09 09 20 28 70 72 69 6e 74 20 70 61 74 ).... (print pat
10270 68 29 29 0a 09 09 20 20 20 20 20 20 20 70 61 74 h))... pat
10280 68 73 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d hs))))))..;;====
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 3d 3d 3d 3d 3d 3d 3d 3d ================
102c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
102d0 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 20 74 65 ==.;; Archive te
102e0 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d sts.;;==========
102f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10300 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10310 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10320 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
10330 41 72 63 68 69 76 65 20 74 65 73 74 73 20 6d 61 Archive tests ma
10340 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 tching target, r
10350 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 65 73 74 unname, and test
10360 70 61 74 74 0a 28 69 66 20 28 61 72 67 73 3a 67 patt.(if (args:g
10370 65 74 2d 61 72 67 20 22 2d 61 72 63 68 69 76 65 et-arg "-archive
10380 22 29 0a 20 20 20 20 3b 3b 20 65 6c 73 65 20 64 "). ;; else d
10390 6f 20 61 20 67 65 6e 65 72 61 6c 2d 72 75 6e 2d o a general-run-
103a0 63 61 6c 6c 0a 20 20 20 20 28 67 65 6e 65 72 61 call. (genera
103b0 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 l-run-call .
103c0 20 22 2d 61 72 63 68 69 76 65 22 0a 20 20 20 20 "-archive".
103d0 20 22 41 72 63 68 69 76 65 22 0a 20 20 20 20 20 "Archive".
103e0 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
103f0 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
10400 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6f 70 vals). (op
10410 65 72 61 74 65 2d 6f 6e 20 27 61 72 63 68 69 76 erate-on 'archiv
10420 65 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d e))))..;;=======
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 0a ===============.
10470 3b 3b 20 45 78 74 72 61 63 74 20 61 20 73 70 72 ;; Extract a spr
10480 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 74 68 eadsheet from th
10490 65 20 72 75 6e 73 20 64 61 74 61 62 61 73 65 0a e runs database.
104a0 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
104b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104e0 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
104f0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 rgs:get-arg "-ex
10500 74 72 61 63 74 2d 6f 64 73 22 29 0a 20 20 20 20 tract-ods").
10510 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
10520 6c 0a 20 20 20 20 20 22 2d 65 78 74 72 61 63 74 l. "-extract
10530 2d 6f 64 73 22 0a 20 20 20 20 20 22 4d 61 6b 65 -ods". "Make
10540 20 6f 64 73 20 73 70 72 65 61 64 73 68 65 65 74 ods spreadsheet
10550 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ". (lambda (
10560 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
10570 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 eys keyvals).
10580 20 20 20 20 28 6c 65 74 20 28 28 64 62 73 74 72 (let ((dbstr
10590 75 63 74 20 20 20 28 6d 61 6b 65 2d 64 62 72 3a uct (make-dbr:
105a0 64 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 2a dbstruct path: *
105b0 74 6f 70 70 61 74 68 2a 20 6c 6f 63 61 6c 3a 20 toppath* local:
105c0 23 74 29 29 0a 09 20 20 20 20 20 28 6f 75 74 70 #t)).. (outp
105d0 75 74 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 utfile (args:get
105e0 2d 61 72 67 20 22 2d 65 78 74 72 61 63 74 2d 6f -arg "-extract-o
105f0 64 73 22 29 29 0a 09 20 20 20 20 20 28 72 75 6e ds")).. (run
10600 73 70 61 74 74 20 20 20 28 6f 72 20 28 61 72 67 spatt (or (arg
10610 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
10620 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 ame")(args:get-a
10630 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 29 rg ":runname")))
10640 0a 09 20 20 20 20 20 28 70 61 74 68 6d 6f 64 20 .. (pathmod
10650 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
10660 20 22 2d 70 61 74 68 6d 6f 64 22 29 29 29 0a 09 "-pathmod")))..
10670 20 20 20 20 20 3b 3b 20 28 6b 65 79 76 61 6c 61 ;; (keyvala
10680 6c 69 73 74 20 28 6b 65 79 73 2d 3e 61 6c 69 73 list (keys->alis
10690 74 20 6b 65 79 73 20 22 25 22 29 29 29 0a 09 20 t keys "%")))..
106a0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a (debug:print 2 *
106b0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
106c0 2a 20 22 45 78 74 72 61 63 74 20 6f 64 73 2c 20 * "Extract ods,
106d0 6f 75 74 70 75 74 66 69 6c 65 3a 20 22 20 6f 75 outputfile: " ou
106e0 74 70 75 74 66 69 6c 65 20 22 20 72 75 6e 73 70 tputfile " runsp
106f0 61 74 74 3a 20 22 20 72 75 6e 73 70 61 74 74 20 att: " runspatt
10700 22 20 6b 65 79 76 61 6c 73 3a 20 22 20 6b 65 79 " keyvals: " key
10710 76 61 6c 73 29 0a 09 20 28 64 62 3a 65 78 74 72 vals).. (db:extr
10720 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 73 act-ods-file dbs
10730 74 72 75 63 74 20 6f 75 74 70 75 74 66 69 6c 65 truct outputfile
10740 20 6b 65 79 76 61 6c 73 20 28 69 66 20 72 75 6e keyvals (if run
10750 73 70 61 74 74 20 72 75 6e 73 70 61 74 74 20 22 spatt runspatt "
10760 25 22 29 20 70 61 74 68 6d 6f 64 29 0a 09 20 28 %") pathmod).. (
10770 64 62 3a 63 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 db:close-all dbs
10780 74 72 75 63 74 29 0a 09 20 28 73 65 74 21 20 2a truct).. (set! *
10790 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
107a0 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d )))))..;;=======
107b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
107f0 3b 3b 20 65 78 65 63 75 74 65 20 74 68 65 20 74 ;; execute the t
10800 65 73 74 0a 3b 3b 20 20 20 20 2d 20 67 65 74 73 est.;; - gets
10810 20 63 61 6c 6c 65 64 20 6f 6e 20 72 65 6d 6f 74 called on remot
10820 65 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 72 e host.;; - r
10830 65 63 65 69 76 65 73 20 69 6e 66 6f 20 66 72 6f eceives info fro
10840 6d 20 74 68 65 20 2d 65 78 65 63 75 74 65 20 70 m the -execute p
10850 61 72 61 6d 0a 3b 3b 20 20 20 20 2d 20 70 61 73 aram.;; - pas
10860 73 65 73 20 69 6e 66 6f 20 74 6f 20 73 74 65 70 ses info to step
10870 73 20 76 69 61 20 4d 54 5f 43 4d 44 49 4e 46 4f s via MT_CMDINFO
10880 20 65 6e 76 20 76 61 72 20 28 66 75 74 75 72 65 env var (future
10890 20 69 73 20 74 6f 20 75 73 65 20 61 20 64 6f 74 is to use a dot
108a0 20 66 69 6c 65 29 0a 3b 3b 20 20 20 20 2d 20 67 file).;; - g
108b0 61 74 68 65 72 73 20 68 6f 73 74 20 69 6e 66 6f athers host info
108c0 20 61 6e 64 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d and .;;========
108d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10900 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
10910 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
10920 67 20 22 2d 65 78 65 63 75 74 65 22 29 0a 20 20 g "-execute").
10930 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
10940 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 28 launch:execute (
10950 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
10960 78 65 63 75 74 65 22 29 29 0a 20 20 20 20 20 20 xecute")).
10970 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
10980 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d ing* #t)))..;;==
10990 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109d0 3d 3d 3d 3d 0a 3b 3b 20 72 65 63 6f 76 65 72 20 ====.;; recover
109e0 66 72 6f 6d 20 61 20 74 65 73 74 20 77 68 65 72 from a test wher
109f0 65 20 74 68 65 20 6d 61 6e 61 67 69 6e 67 20 6d e the managing m
10a00 74 65 73 74 20 77 61 73 20 6b 69 6c 6c 65 64 20 test was killed
10a10 62 75 74 20 74 68 65 20 75 6e 64 65 72 6c 79 69 but the underlyi
10a20 6e 67 0a 3b 3b 20 70 72 6f 63 65 73 73 20 6d 69 ng.;; process mi
10a30 67 68 74 20 73 74 69 6c 6c 20 62 65 20 73 61 6c ght still be sal
10a40 76 61 67 65 61 62 6c 65 0a 3b 3b 3d 3d 3d 3d 3d vageable.;;=====
10a50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a90 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 =..(if (args:get
10aa0 2d 61 72 67 20 22 2d 72 65 63 6f 76 65 72 2d 74 -arg "-recover-t
10ab0 65 73 74 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 est"). (let*
10ac0 28 28 70 61 72 61 6d 73 20 28 73 74 72 69 6e 67 ((params (string
10ad0 2d 73 70 6c 69 74 20 28 61 72 67 73 3a 67 65 74 -split (args:get
10ae0 2d 61 72 67 20 22 2d 72 65 63 6f 76 65 72 2d 74 -arg "-recover-t
10af0 65 73 74 22 29 20 22 2c 22 29 29 29 0a 20 20 20 est") ","))).
10b00 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 (if (> (lengt
10b10 68 20 70 61 72 61 6d 73 29 20 31 29 20 3b 3b 20 h params) 1) ;;
10b20 72 75 6e 2d 69 64 20 61 6e 64 20 74 65 73 74 2d run-id and test-
10b30 69 64 0a 09 20 20 28 6c 65 74 20 28 28 72 75 6e id.. (let ((run
10b40 2d 69 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d -id (string->num
10b50 62 65 72 20 28 63 61 72 20 70 61 72 61 6d 73 29 ber (car params)
10b60 29 29 0a 09 09 28 74 65 73 74 2d 69 64 20 28 73 ))...(test-id (s
10b70 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 tring->number (c
10b80 61 64 72 20 70 61 72 61 6d 73 29 29 29 29 0a 09 adr params))))..
10b90 20 20 20 20 28 69 66 20 28 61 6e 64 20 72 75 6e (if (and run
10ba0 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09 09 28 -id test-id)...(
10bb0 62 65 67 69 6e 0a 09 09 20 20 28 6c 61 75 6e 63 begin... (launc
10bc0 68 3a 72 65 63 6f 76 65 72 2d 74 65 73 74 20 72 h:recover-test r
10bd0 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09 un-id test-id)..
10be0 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d . (set! *didsom
10bf0 65 74 68 69 6e 67 2a 20 23 74 29 29 0a 09 09 28 ething* #t))...(
10c00 62 65 67 69 6e 0a 09 09 20 20 28 64 65 62 75 67 begin... (debug
10c10 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
10c20 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
10c30 2a 20 22 62 61 64 20 72 75 6e 2d 69 64 20 6f 72 * "bad run-id or
10c40 20 74 65 73 74 2d 69 64 2c 20 6d 75 73 74 20 62 test-id, must b
10c50 65 20 69 6e 74 65 67 65 72 73 22 29 0a 09 09 20 e integers")...
10c60 20 28 65 78 69 74 20 31 29 29 29 29 29 29 29 0a (exit 1))))))).
10c70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
10c80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10ca0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10cb0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 =========.;; Tes
10cc0 74 20 63 6f 6d 6d 61 6e 64 73 20 28 69 2e 65 2e t commands (i.e.
10cd0 20 66 6f 72 20 75 73 65 20 69 6e 73 69 64 65 20 for use inside
10ce0 74 65 73 74 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d tests).;;=======
10cf0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
10d30 0a 28 64 65 66 69 6e 65 20 28 6d 65 67 61 74 65 .(define (megate
10d40 73 74 3a 73 74 65 70 20 73 74 65 70 20 73 74 61 st:step step sta
10d50 74 65 20 73 74 61 74 75 73 20 6c 6f 67 66 69 6c te status logfil
10d60 65 20 6d 73 67 29 0a 20 20 28 69 66 20 28 6e 6f e msg). (if (no
10d70 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d t (getenv "MT_CM
10d80 44 49 4e 46 4f 22 29 29 0a 20 20 20 20 20 20 28 DINFO")). (
10d90 62 65 67 69 6e 0a 09 28 64 65 62 75 67 3a 70 72 begin..(debug:pr
10da0 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
10db0 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
10dc0 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 MT_CMDINFO env v
10dd0 61 72 20 6e 6f 74 20 73 65 74 2c 20 2d 73 74 65 ar not set, -ste
10de0 70 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 p must be called
10df0 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 *inside* a mega
10e00 74 65 73 74 20 69 6e 76 6f 6b 65 64 20 65 6e 76 test invoked env
10e10 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 28 65 78 ironment!")..(ex
10e20 69 74 20 35 29 29 0a 20 20 20 20 20 20 28 6c 65 it 5)). (le
10e30 74 2a 20 28 28 63 6d 64 69 6e 66 6f 20 20 20 28 t* ((cmdinfo (
10e40 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f common:read-enco
10e50 64 65 64 2d 73 74 72 69 6e 67 20 28 67 65 74 65 ded-string (gete
10e60 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
10e70 29 29 0a 09 20 20 20 20 20 28 74 72 61 6e 73 70 )).. (transp
10e80 6f 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ort (assoc/defau
10e90 6c 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d lt 'transport cm
10ea0 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 dinfo)).. (t
10eb0 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f estpath (assoc/
10ec0 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 default 'testpat
10ed0 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 h cmdinfo))..
10ee0 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 (test-name (a
10ef0 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
10f00 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 st-name cmdinfo)
10f10 29 0a 09 20 20 20 20 20 28 72 75 6e 73 63 72 69 ).. (runscri
10f20 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c pt (assoc/defaul
10f30 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 t 'runscript cmd
10f40 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 64 62 info)).. (db
10f50 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 -host (assoc/d
10f60 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 efault 'db-host
10f70 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
10f80 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 (run-id (as
10f90 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
10fa0 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 -id cmdinfo))
10fb0 0a 09 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 .. (test-id
10fc0 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
10fd0 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 'test-id cmdi
10fe0 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 69 74 65 nfo)).. (ite
10ff0 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 mdat (assoc/de
11000 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 fault 'itemdat
11010 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
11020 20 28 77 6f 72 6b 2d 61 72 65 61 20 28 61 73 73 (work-area (ass
11030 6f 63 2f 64 65 66 61 75 6c 74 20 27 77 6f 72 6b oc/default 'work
11040 2d 61 72 65 61 20 63 6d 64 69 6e 66 6f 29 29 0a -area cmdinfo)).
11050 09 20 20 20 20 20 28 64 62 20 20 20 20 20 20 20 . (db
11060 20 23 66 29 29 0a 09 28 63 68 61 6e 67 65 2d 64 #f))..(change-d
11070 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
11080 68 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 6c 61 h)..(if (not (la
11090 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 unch:setup))..
110a0 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
110b0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
110c0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
110d0 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
110e0 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 up, exiting")..
110f0 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a (exit 1))).
11100 09 28 69 66 20 28 61 6e 64 20 73 74 61 74 65 20 .(if (and state
11110 73 74 61 74 75 73 29 0a 09 20 20 20 20 28 6c 65 status).. (le
11120 74 20 28 28 63 6f 6d 6d 65 6e 74 20 28 6c 61 75 t ((comment (lau
11130 6e 63 68 3a 6c 6f 61 64 2d 6c 6f 67 70 72 6f 2d nch:load-logpro-
11140 64 61 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d dat run-id test-
11150 69 64 20 73 74 65 70 29 29 29 0a 09 20 20 20 20 id step)))..
11160 20 20 3b 3b 20 28 72 6d 74 3a 74 65 73 74 2d 73 ;; (rmt:test-s
11170 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 et-log! run-id t
11180 65 73 74 2d 69 64 20 28 63 6f 6e 63 20 73 74 65 est-id (conc ste
11190 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 29 pname ".html")))
111a0 29 0a 09 20 20 20 20 20 20 28 72 6d 74 3a 74 65 ).. (rmt:te
111b0 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 ststep-set-statu
111c0 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 s! run-id test-i
111d0 64 20 73 74 65 70 20 73 74 61 74 65 20 73 74 61 d step state sta
111e0 74 75 73 20 28 6f 72 20 63 6f 6d 6d 65 6e 74 20 tus (or comment
111f0 6d 73 67 29 20 6c 6f 67 66 69 6c 65 29 29 0a 09 msg) logfile))..
11200 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 (begin..
11210 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
11220 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
11230 6c 6f 67 2d 70 6f 72 74 2a 20 22 59 6f 75 20 6d log-port* "You m
11240 75 73 74 20 73 70 65 63 69 66 79 20 3a 73 74 61 ust specify :sta
11250 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 20 77 te and :status w
11260 69 74 68 20 65 76 65 72 79 20 63 61 6c 6c 20 74 ith every call t
11270 6f 20 2d 73 74 65 70 22 29 0a 09 20 20 20 20 20 o -step")..
11280 20 28 65 78 69 74 20 36 29 29 29 29 29 29 0a 0a (exit 6))))))..
11290 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
112a0 67 20 22 2d 73 74 65 70 22 29 0a 20 20 20 20 28 g "-step"). (
112b0 62 65 67 69 6e 0a 20 20 20 20 20 20 28 6d 65 67 begin. (meg
112c0 61 74 65 73 74 3a 73 74 65 70 20 0a 20 20 20 20 atest:step .
112d0 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
112e0 20 22 2d 73 74 65 70 22 29 0a 20 20 20 20 20 20 "-step").
112f0 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
11300 72 67 20 22 2d 73 74 61 74 65 22 29 28 61 72 67 rg "-state")(arg
11310 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
11320 65 22 29 29 0a 20 20 20 20 20 20 20 28 6f 72 20 e")). (or
11330 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11340 73 74 61 74 75 73 22 29 28 61 72 67 73 3a 67 65 status")(args:ge
11350 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 t-arg ":status")
11360 29 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 ). (args:g
11370 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 et-arg "-setlog"
11380 29 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 ). (args:g
11390 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 20 20 et-arg "-m")).
113a0 20 20 20 20 3b 3b 20 28 69 66 20 64 62 20 28 73 ;; (if db (s
113b0 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
113c0 20 64 62 29 29 0a 20 20 20 20 20 20 28 73 65 74 db)). (set
113d0 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
113e0 20 23 74 29 29 29 0a 20 20 20 20 0a 28 69 66 20 #t))). .(if
113f0 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
11400 67 20 22 2d 73 65 74 6c 6f 67 22 29 20 20 20 20 g "-setlog")
11410 20 20 20 3b 3b 20 73 69 6e 63 65 20 73 65 74 74 ;; since sett
11420 69 6e 67 20 75 70 20 69 73 20 73 6f 20 63 6f 73 ing up is so cos
11430 74 6c 79 20 6c 65 74 73 20 70 69 67 67 79 62 61 tly lets piggyba
11440 63 6b 20 6f 6e 20 2d 74 65 73 74 2d 73 74 61 74 ck on -test-stat
11450 75 73 0a 09 3b 3b 20 20 20 20 20 28 6e 6f 74 20 us..;; (not
11460 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11470 73 74 65 70 22 29 29 29 20 20 3b 3b 20 2d 73 65 step"))) ;; -se
11480 74 6c 6f 67 20 6d 61 79 20 68 61 76 65 20 62 65 tlog may have be
11490 65 6e 20 70 72 6f 63 65 73 73 65 64 20 61 6c 72 en processed alr
114a0 65 61 64 79 20 69 6e 20 74 68 65 20 22 2d 73 74 eady in the "-st
114b0 65 70 22 20 70 72 65 76 69 6f 75 73 0a 09 3b 3b ep" previous..;;
114c0 20 20 20 20 20 4e 45 57 20 50 4f 4c 49 43 59 20 NEW POLICY
114d0 2d 20 2d 73 65 74 6c 6f 67 20 73 65 74 73 20 74 - -setlog sets t
114e0 65 73 74 20 6f 76 65 72 61 6c 6c 20 6c 6f 67 20 est overall log
114f0 6f 6e 20 65 76 65 72 79 20 63 61 6c 6c 2e 0a 09 on every call...
11500 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11510 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 28 61 set-toplog")..(a
11520 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
11530 73 74 2d 73 74 61 74 75 73 22 29 0a 09 28 61 72 st-status")..(ar
11540 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
11550 2d 76 61 6c 75 65 73 22 29 0a 09 28 61 72 67 73 -values")..(args
11560 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d :get-arg "-load-
11570 74 65 73 74 2d 64 61 74 61 22 29 0a 09 28 61 72 test-data")..(ar
11580 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
11590 73 74 65 70 22 29 0a 09 28 61 72 67 73 3a 67 65 step")..(args:ge
115a0 74 2d 61 72 67 20 22 2d 73 75 6d 6d 61 72 69 7a t-arg "-summariz
115b0 65 2d 69 74 65 6d 73 22 29 29 0a 20 20 20 20 28 e-items")). (
115c0 69 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 if (not (getenv
115d0 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 "MT_CMDINFO"))..
115e0 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 (begin.. (debug
115f0 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
11600 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
11610 2a 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e * "MT_CMDINFO en
11620 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 63 v var not set, c
11630 6f 6d 6d 61 6e 64 73 20 2d 74 65 73 74 2d 73 74 ommands -test-st
11640 61 74 75 73 2c 20 2d 72 75 6e 73 74 65 70 20 61 atus, -runstep a
11650 6e 64 20 2d 73 65 74 6c 6f 67 20 6d 75 73 74 20 nd -setlog must
11660 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 64 be called *insid
11670 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 65 6e e* a megatest en
11680 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 20 20 vironment!")..
11690 28 65 78 69 74 20 35 29 29 0a 09 28 6c 65 74 2a (exit 5))..(let*
116a0 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 20 28 ((startingdir (
116b0 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 current-director
116c0 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 6d 64 y)).. (cmd
116d0 69 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 info (common:r
116e0 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 ead-encoded-stri
116f0 6e 67 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 ng (getenv "MT_C
11700 4d 44 49 4e 46 4f 22 29 29 29 0a 09 20 20 20 20 MDINFO")))..
11710 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 (transport (a
11720 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 ssoc/default 'tr
11730 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 ansport cmdinfo)
11740 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 ).. (testp
11750 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
11760 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
11770 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
11780 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 (test-name (ass
11790 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
117a0 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a -name cmdinfo)).
117b0 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 . (runscri
117c0 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c pt (assoc/defaul
117d0 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 t 'runscript cmd
117e0 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
117f0 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 db-host (assoc
11800 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 /default 'db-hos
11810 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
11820 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id
11830 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
11840 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 'run-id cmdin
11850 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 fo)).. (te
11860 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 st-id (assoc/d
11870 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 efault 'test-id
11880 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
11890 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 (itemdat (
118a0 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 assoc/default 'i
118b0 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f temdat cmdinfo
118c0 29 29 0a 09 20 20 20 20 20 20 20 28 77 6f 72 6b )).. (work
118d0 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 65 66 -area (assoc/def
118e0 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 ault 'work-area
118f0 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
11900 20 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 (db #f)
11910 20 3b 3b 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 ;; (open-db))..
11920 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 (state
11930 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
11940 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 ":state"))..
11950 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 61 (status (a
11960 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
11970 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 atus"))..
11980 28 73 74 65 70 6e 61 6d 65 20 20 28 61 72 67 73 (stepname (args
11990 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 :get-arg "-step"
119a0 29 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 ))).. (if (not
119b0 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
119c0 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
119d0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
119e0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
119f0 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
11a00 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 up, exiting")...
11a10 28 65 78 69 74 20 31 29 29 29 0a 0a 09 20 20 28 (exit 1)))... (
11a20 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
11a30 20 22 2d 72 75 6e 73 74 65 70 22 29 28 64 65 62 "-runstep")(deb
11a40 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 ug:print-info 1
11a50 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
11a60 74 2a 20 22 52 75 6e 6e 69 6e 67 20 2d 72 75 6e t* "Running -run
11a70 73 74 65 70 2c 20 66 69 72 73 74 20 63 68 61 6e step, first chan
11a80 67 65 20 74 6f 20 64 69 72 65 63 74 6f 72 79 20 ge to directory
11a90 22 20 77 6f 72 6b 2d 61 72 65 61 29 29 0a 09 20 " work-area))..
11aa0 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
11ab0 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 ry work-area)..
11ac0 20 3b 3b 20 63 61 6e 20 73 65 74 75 70 20 61 73 ;; can setup as
11ad0 20 63 6c 69 65 6e 74 20 66 6f 72 20 73 65 72 76 client for serv
11ae0 65 72 20 6d 6f 64 65 20 6e 6f 77 0a 09 20 20 3b er mode now.. ;
11af0 3b 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 70 29 ; (client:setup)
11b00 0a 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 ... (if (args:g
11b10 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d 74 65 et-arg "-load-te
11b20 73 74 2d 64 61 74 61 22 29 0a 09 20 20 20 20 20 st-data")..
11b30 20 3b 3b 20 68 61 73 20 73 75 62 20 63 6f 6d 6d ;; has sub comm
11b40 61 6e 64 73 20 74 68 61 74 20 61 72 65 20 72 64 ands that are rd
11b50 62 3a 0a 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 b:.. ;; DO
11b60 4e 4f 54 20 70 75 74 20 74 68 69 73 20 6f 6e 65 NOT put this one
11b70 20 69 6e 74 6f 20 65 69 74 68 65 72 20 72 6d 74 into either rmt
11b80 3a 20 6f 72 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c : or open-run-cl
11b90 6f 73 65 0a 09 20 20 20 20 20 20 28 74 64 62 3a ose.. (tdb:
11ba0 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 20 72 load-test-data r
11bb0 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a un-id test-id)).
11bc0 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 . (if (args:get
11bd0 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a -arg "-setlog").
11be0 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 6f . (let ((lo
11bf0 67 66 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 gfname (args:get
11c00 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 29 -arg "-setlog"))
11c10 29 0a 09 09 28 72 6d 74 3a 74 65 73 74 2d 73 65 )...(rmt:test-se
11c20 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 t-log! run-id te
11c30 73 74 2d 69 64 20 6c 6f 67 66 6e 61 6d 65 29 29 st-id logfname))
11c40 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 ).. (if (args:g
11c50 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 et-arg "-set-top
11c60 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 log").. ;;
11c70 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 DO NOT run remot
11c80 65 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 3a e.. (tests:
11c90 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 21 test-set-toplog!
11ca0 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
11cb0 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 e (args:get-arg
11cc0 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 29 29 "-set-toplog")))
11cd0 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 .. (if (args:ge
11ce0 74 2d 61 72 67 20 22 2d 73 75 6d 6d 61 72 69 7a t-arg "-summariz
11cf0 65 2d 69 74 65 6d 73 22 29 0a 09 20 20 20 20 20 e-items")..
11d00 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 ;; DO NOT run r
11d10 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 28 74 65 emote.. (te
11d20 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 sts:summarize-it
11d30 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ems run-id test-
11d40 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 74 29 id test-name #t)
11d50 29 20 3b 3b 20 64 6f 20 66 6f 72 63 65 20 68 65 ) ;; do force he
11d60 72 65 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a re.. (if (args:
11d70 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 get-arg "-runste
11d80 70 22 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 p").. (if (
11d90 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 0a 09 null? remargs)..
11da0 09 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 . (begin...
11db0 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
11dc0 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
11dd0 67 2d 70 6f 72 74 2a 20 22 6e 6f 74 68 69 6e 67 g-port* "nothing
11de0 20 73 70 65 63 69 66 69 65 64 20 74 6f 20 72 75 specified to ru
11df0 6e 21 22 29 0a 09 09 20 20 20 20 28 69 66 20 64 n!")... (if d
11e00 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c b (sqlite3:final
11e10 69 7a 65 21 20 64 62 29 29 0a 09 09 20 20 20 20 ize! db))...
11e20 28 65 78 69 74 20 36 29 29 0a 09 09 20 20 28 6c (exit 6))... (l
11e30 65 74 2a 20 28 28 73 74 65 70 6e 61 6d 65 20 20 et* ((stepname
11e40 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
11e50 2d 72 75 6e 73 74 65 70 22 29 29 0a 09 09 09 20 -runstep"))....
11e60 28 6c 6f 67 70 72 6f 66 69 6c 65 20 28 61 72 67 (logprofile (arg
11e70 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 70 s:get-arg "-logp
11e80 72 6f 22 29 29 0a 09 09 09 20 28 6c 6f 67 66 69 ro")).... (logfi
11e90 6c 65 20 20 20 20 28 63 6f 6e 63 20 73 74 65 70 le (conc step
11ea0 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 29 0a 09 09 name ".log"))...
11eb0 09 20 28 63 6d 64 20 20 20 20 20 20 20 20 28 69 . (cmd (i
11ec0 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 f (null? remargs
11ed0 29 20 23 66 20 28 63 61 72 20 72 65 6d 61 72 67 ) #f (car remarg
11ee0 73 29 29 29 0a 09 09 09 20 28 70 61 72 61 6d 73 s))).... (params
11ef0 20 20 20 20 20 28 69 66 20 63 6d 64 20 28 63 64 (if cmd (cd
11f00 72 20 72 65 6d 61 72 67 73 29 20 27 28 29 29 29 r remargs) '()))
11f10 0a 09 09 09 20 28 65 78 69 74 73 74 61 74 20 20 .... (exitstat
11f20 20 23 66 29 0a 09 09 09 20 28 73 68 65 6c 6c 20 #f).... (shell
11f30 20 20 20 20 20 28 6c 65 74 20 28 28 73 68 20 28 (let ((sh (
11f40 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
11f50 76 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 variable "SHELL"
11f60 29 20 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 ) )).....
11f70 28 69 66 20 73 68 20 0a 09 09 09 09 09 20 20 20 (if sh ......
11f80 28 6c 61 73 74 20 28 73 74 72 69 6e 67 2d 73 70 (last (string-sp
11f90 6c 69 74 20 73 68 20 22 2f 22 29 29 0a 09 09 09 lit sh "/"))....
11fa0 09 09 20 20 20 22 62 61 73 68 22 29 29 29 0a 09 .. "bash")))..
11fb0 09 09 20 28 72 65 64 69 72 20 20 20 20 20 20 28 .. (redir (
11fc0 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy
11fd0 6d 62 6f 6c 20 73 68 65 6c 6c 29 0a 09 09 09 09 mbol shell).....
11fe0 20 20 20 20 20 20 20 28 28 74 63 73 68 20 63 73 ((tcsh cs
11ff0 68 20 6b 73 68 29 20 20 20 20 22 3e 26 22 29 0a h ksh) ">&").
12000 09 09 09 09 20 20 20 20 20 20 20 28 28 7a 73 68 .... ((zsh
12010 20 62 61 73 68 20 73 68 20 61 73 68 29 20 22 32 bash sh ash) "2
12020 3e 26 31 20 3e 22 29 0a 09 09 09 09 20 20 20 20 >&1 >").....
12030 20 20 20 28 65 6c 73 65 20 22 3e 26 22 29 29 29 (else ">&")))
12040 0a 09 09 09 20 28 66 75 6c 6c 63 6d 64 20 20 20 .... (fullcmd
12050 20 28 63 6f 6e 63 20 22 28 22 20 28 73 74 72 69 (conc "(" (stri
12060 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a ng-intersperse .
12070 09 09 09 09 09 09 28 63 6f 6e 73 20 63 6d 64 20 ......(cons cmd
12080 70 61 72 61 6d 73 29 20 22 20 22 29 0a 09 09 09 params) " ")....
12090 09 09 20 20 20 22 29 20 22 20 72 65 64 69 72 20 .. ") " redir
120a0 22 20 22 20 6c 6f 67 66 69 6c 65 29 29 29 0a 09 " " logfile)))..
120b0 09 20 20 20 20 3b 3b 20 6d 61 72 6b 20 74 68 65 . ;; mark the
120c0 20 73 74 61 72 74 20 6f 66 20 74 68 65 20 74 65 start of the te
120d0 73 74 0a 09 09 20 20 20 20 28 72 6d 74 3a 74 65 st... (rmt:te
120e0 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 ststep-set-statu
120f0 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 s! run-id test-i
12100 64 20 73 74 65 70 6e 61 6d 65 20 22 73 74 61 72 d stepname "star
12110 74 22 20 22 6e 2f 61 22 20 28 61 72 67 73 3a 67 t" "n/a" (args:g
12120 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 6c 6f 67 et-arg "-m") log
12130 66 69 6c 65 29 0a 09 09 20 20 20 20 3b 3b 20 72 file)... ;; r
12140 75 6e 20 74 68 65 20 74 65 73 74 20 73 74 65 70 un the test step
12150 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
12160 69 6e 74 2d 69 6e 66 6f 20 32 20 2a 64 65 66 61 int-info 2 *defa
12170 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 ult-log-port* "R
12180 75 6e 6e 69 6e 67 20 5c 22 22 20 66 75 6c 6c 63 unning \"" fullc
12190 6d 64 20 22 5c 22 20 69 6e 20 64 69 72 65 63 74 md "\" in direct
121a0 6f 72 79 20 5c 22 22 20 73 74 61 72 74 69 6e 67 ory \"" starting
121b0 64 69 72 29 0a 09 09 20 20 20 20 28 63 68 61 6e dir)... (chan
121c0 67 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 ge-directory sta
121d0 72 74 69 6e 67 64 69 72 29 0a 09 09 20 20 20 20 rtingdir)...
121e0 28 73 65 74 21 20 65 78 69 74 73 74 61 74 20 28 (set! exitstat (
121f0 73 79 73 74 65 6d 20 66 75 6c 6c 63 6d 64 29 29 system fullcmd))
12200 0a 09 09 20 20 20 20 28 73 65 74 21 20 2a 67 6c ... (set! *gl
12210 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 obalexitstatus*
12220 65 78 69 74 73 74 61 74 29 0a 09 09 20 20 20 20 exitstat)...
12230 3b 3b 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 ;; (change-direc
12240 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
12250 09 20 20 20 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 . ;; run logp
12260 72 6f 20 69 66 20 61 70 70 6c 69 63 61 62 6c 65 ro if applicable
12270 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d 72 75 6e ;; (process-run
12280 20 22 6c 73 22 20 28 6c 69 73 74 20 22 2f 66 6f "ls" (list "/fo
12290 6f 22 20 22 32 3e 26 31 22 20 22 62 6c 61 68 2e o" "2>&1" "blah.
122a0 6c 6f 67 22 29 29 0a 09 09 20 20 20 20 28 69 66 log"))... (if
122b0 20 6c 6f 67 70 72 6f 66 69 6c 65 0a 09 09 09 28 logprofile....(
122c0 6c 65 74 2a 20 28 28 68 74 6d 6c 6c 6f 67 66 69 let* ((htmllogfi
122d0 6c 65 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d le (conc stepnam
122e0 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 09 09 20 e ".html"))....
122f0 20 20 20 20 20 20 28 6f 6c 64 65 78 69 74 73 74 (oldexitst
12300 61 74 20 65 78 69 74 73 74 61 74 29 0a 09 09 09 at exitstat)....
12310 20 20 20 20 20 20 20 28 63 6d 64 20 20 20 20 20 (cmd
12320 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 (string-inte
12330 72 73 70 65 72 73 65 20 28 6c 69 73 74 20 22 6c rsperse (list "l
12340 6f 67 70 72 6f 22 20 6c 6f 67 70 72 6f 66 69 6c ogpro" logprofil
12350 65 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c e htmllogfile "<
12360 22 20 6c 6f 67 66 69 6c 65 20 22 3e 22 20 28 63 " logfile ">" (c
12370 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 5f 6c onc stepname "_l
12380 6f 67 70 72 6f 2e 6c 6f 67 22 29 29 20 22 20 22 ogpro.log")) " "
12390 29 29 29 0a 09 09 09 20 20 28 64 65 62 75 67 3a ))).... (debug:
123a0 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 2a 64 65 print-info 2 *de
123b0 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
123c0 22 72 75 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 "running \"" cmd
123d0 20 22 5c 22 22 29 0a 09 09 09 20 20 28 63 68 61 "\"").... (cha
123e0 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 nge-directory st
123f0 61 72 74 69 6e 67 64 69 72 29 0a 09 09 09 20 20 artingdir)....
12400 28 73 65 74 21 20 65 78 69 74 73 74 61 74 20 28 (set! exitstat (
12410 73 79 73 74 65 6d 20 63 6d 64 29 29 0a 09 09 09 system cmd))....
12420 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 (set! *globale
12430 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 74 73 xitstatus* exits
12440 74 61 74 29 20 3b 3b 20 6e 6f 20 6e 65 63 65 73 tat) ;; no neces
12450 73 61 72 79 0a 09 09 09 20 20 28 63 68 61 6e 67 sary.... (chang
12460 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test
12470 70 61 74 68 29 0a 09 09 09 20 20 28 72 6d 74 3a path).... (rmt:
12480 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 test-set-log! ru
12490 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 68 74 6d n-id test-id htm
124a0 6c 6c 6f 67 66 69 6c 65 29 29 29 0a 09 09 20 20 llogfile)))...
124b0 20 20 28 6c 65 74 20 28 28 6d 73 67 20 28 61 72 (let ((msg (ar
124c0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
124d0 29 29 0a 09 09 20 20 20 20 20 20 28 72 6d 74 3a ))... (rmt:
124e0 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
124f0 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 tus! run-id test
12500 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 65 6e -id stepname "en
12510 64 22 20 65 78 69 74 73 74 61 74 20 6d 73 67 20 d" exitstat msg
12520 6c 6f 67 66 69 6c 65 29 29 0a 09 09 20 20 20 20 logfile))...
12530 29 29 29 0a 09 20 20 28 69 66 20 28 6f 72 20 28 ))).. (if (or (
12540 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
12550 65 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 20 est-status")...
12560 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
12570 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 29 0a 09 -set-values"))..
12580 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 (let ((new
12590 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 status (cond....
125a0 09 28 28 6e 75 6d 62 65 72 3f 20 73 74 61 74 75 .((number? statu
125b0 73 29 20 20 20 20 20 20 20 28 69 66 20 28 65 71 s) (if (eq
125c0 75 61 6c 3f 20 73 74 61 74 75 73 20 30 29 20 22 ual? 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 28 61 6e 64 20 28 73 74 72 69 6e 67 ...((and (string
125f0 3f 20 73 74 61 74 75 73 29 0a 09 09 09 09 20 20 ? status).....
12600 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d (string->num
12610 62 65 72 20 73 74 61 74 75 73 29 29 28 69 66 20 ber status))(if
12620 28 65 71 75 61 6c 3f 20 28 73 74 72 69 6e 67 2d (equal? (string-
12630 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 73 29 20 >number status)
12640 30 29 20 22 50 41 53 53 22 20 22 46 41 49 4c 22 0) "PASS" "FAIL"
12650 29 29 0a 09 09 09 09 28 65 6c 73 65 20 73 74 61 )).....(else sta
12660 74 75 73 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 tus)))... ;;
12670 74 72 61 6e 73 66 65 72 20 72 65 6c 65 76 61 6e transfer relevan
12680 74 20 6b 65 79 73 20 69 6e 74 6f 20 61 20 68 61 t keys into a ha
12690 73 68 20 74 6f 20 62 65 20 70 61 73 73 65 64 20 sh to be passed
126a0 74 6f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 to test-set-stat
126b0 75 73 21 0a 09 09 20 20 20 20 3b 3b 20 63 6f 75 us!... ;; cou
126c0 6c 64 20 75 73 65 20 61 6e 20 61 73 73 6f 63 20 ld use an assoc
126d0 6c 69 73 74 20 49 20 67 75 65 73 73 2e 20 0a 09 list I guess. ..
126e0 09 20 20 20 20 28 6f 74 68 65 72 64 61 74 61 20 . (otherdata
126f0 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 (let ((res (make
12700 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 -hash-table)))..
12710 09 09 09 20 28 66 6f 72 2d 65 61 63 68 20 28 6c ... (for-each (l
12720 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 09 ambda (key).....
12730 09 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a . (if (args:
12740 67 65 74 2d 61 72 67 20 6b 65 79 29 0a 09 09 09 get-arg key)....
12750 09 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ... (hash-table-
12760 73 65 74 21 20 72 65 73 20 6b 65 79 20 28 61 72 set! res key (ar
12770 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 79 29 29 gs:get-arg key))
12780 29 29 0a 09 09 09 09 09 20 20 20 28 6c 69 73 74 ))...... (list
12790 20 22 3a 76 61 6c 75 65 22 20 22 3a 74 6f 6c 22 ":value" ":tol"
127a0 20 22 3a 65 78 70 65 63 74 65 64 22 20 22 3a 66 ":expected" ":f
127b0 69 72 73 74 5f 65 72 72 22 20 22 3a 66 69 72 73 irst_err" ":firs
127c0 74 5f 77 61 72 6e 22 20 22 3a 75 6e 69 74 73 22 t_warn" ":units"
127d0 20 22 3a 63 61 74 65 67 6f 72 79 22 20 22 3a 76 ":category" ":v
127e0 61 72 69 61 62 6c 65 22 29 29 0a 09 09 09 09 20 ariable")).....
127f0 72 65 73 29 29 29 0a 09 09 28 69 66 20 28 61 6e res)))...(if (an
12800 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
12810 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a "-test-status").
12820 09 09 09 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 ... (or (not sta
12830 74 65 29 0a 09 09 09 20 20 20 20 20 28 6e 6f 74 te).... (not
12840 20 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 20 status)))...
12850 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 (begin...
12860 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
12870 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
12880 67 2d 70 6f 72 74 2a 20 22 59 6f 75 20 6d 75 73 g-port* "You mus
12890 74 20 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 t specify :state
128a0 20 61 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 and :status wit
128b0 68 20 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 h every call to
128c0 2d 74 65 73 74 2d 73 74 61 74 75 73 5c 6e 22 20 -test-status\n"
128d0 68 65 6c 70 29 0a 09 09 20 20 20 20 20 20 28 69 help)... (i
128e0 66 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 62 f (sqlite3:datab
128f0 61 73 65 3f 20 64 62 29 28 73 71 6c 69 74 65 33 ase? db)(sqlite3
12900 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
12910 09 09 20 20 20 20 20 20 28 65 78 69 74 20 36 29 .. (exit 6)
12920 29 29 0a 09 09 28 6c 65 74 2a 20 28 28 6d 73 67 ))...(let* ((msg
12930 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
12940 67 20 22 2d 6d 22 29 29 0a 09 09 20 20 20 20 20 g "-m"))...
12950 20 20 28 6e 75 6d 6f 74 68 20 28 6c 65 6e 67 74 (numoth (lengt
12960 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 h (hash-table-ke
12970 79 73 20 6f 74 68 65 72 64 61 74 61 29 29 29 29 ys otherdata))))
12980 0a 09 09 20 20 3b 3b 20 43 6f 6e 76 65 72 74 20 ... ;; Convert
12990 74 6f 20 72 70 63 20 69 6e 73 69 64 65 20 74 68 to rpc inside th
129a0 65 20 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 e tests:test-set
129b0 2d 73 74 61 74 75 73 21 20 63 61 6c 6c 2c 20 6e -status! call, n
129c0 6f 74 20 68 65 72 65 0a 09 09 20 20 28 74 65 73 ot here... (tes
129d0 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ts:test-set-stat
129e0 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d us! run-id test-
129f0 69 64 20 73 74 61 74 65 20 6e 65 77 73 74 61 74 id state newstat
12a00 75 73 20 6d 73 67 20 6f 74 68 65 72 64 61 74 61 us msg otherdata
12a10 20 77 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b work-area: work
12a20 2d 61 72 65 61 29 29 29 29 0a 09 20 20 28 69 66 -area)))).. (if
12a30 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 62 61 (sqlite3:databa
12a40 73 65 3f 20 64 62 29 28 73 71 6c 69 74 65 33 3a se? db)(sqlite3:
12a50 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 finalize! db))..
12a60 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
12a70 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b thing* #t))))..;
12a80 3b 3d 3d 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 0a 3b 3b 20 56 61 72 69 6f =======.;; Vario
12ad0 75 73 20 68 65 6c 70 65 72 20 63 6f 6d 6d 61 6e us helper comman
12ae0 64 73 20 63 61 6e 20 67 6f 20 62 65 6c 6f 77 20 ds can go below
12af0 68 65 72 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d here.;;=========
12b00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
12b40 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
12b50 2d 61 72 67 20 22 2d 73 68 6f 77 6b 65 79 73 22 -arg "-showkeys"
12b60 29 0a 20 20 20 20 20 20 20 20 28 61 72 67 73 3a ). (args:
12b70 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 6b get-arg "-show-k
12b80 65 79 73 22 29 29 0a 20 20 20 20 28 6c 65 74 20 eys")). (let
12b90 28 28 64 62 20 23 66 29 0a 09 20 20 28 6b 65 79 ((db #f).. (key
12ba0 73 20 23 66 29 29 0a 20 20 20 20 20 20 28 69 66 s #f)). (if
12bb0 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
12bc0 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a tup)).. (begin.
12bd0 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
12be0 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
12bf0 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 -port* "Failed t
12c00 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
12c10 22 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ").. (exit 1)
12c20 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 6b )). (set! k
12c30 65 79 73 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 eys (rmt:get-key
12c40 73 29 29 20 3b 3b 20 20 64 62 29 29 0a 20 20 20 s)) ;; db)).
12c50 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
12c60 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 1 *default-log-p
12c70 6f 72 74 2a 20 22 4b 65 79 73 3a 20 22 20 28 73 ort* "Keys: " (s
12c80 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
12c90 65 20 6b 65 79 73 20 22 2c 20 22 29 29 0a 20 20 e keys ", ")).
12ca0 20 20 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 (if (sqlite3
12cb0 3a 64 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 :database? db)(s
12cc0 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
12cd0 20 64 62 29 29 0a 20 20 20 20 20 20 28 73 65 74 db)). (set
12ce0 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
12cf0 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
12d00 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 75 69 22 s:get-arg "-gui"
12d10 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
12d20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
12d30 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
12d40 6f 72 74 2a 20 22 4c 6f 6f 6b 20 61 74 20 74 68 ort* "Look at th
12d50 65 20 64 61 73 68 62 6f 61 72 64 20 66 6f 72 20 e dashboard for
12d60 6e 6f 77 22 29 0a 20 20 20 20 20 20 3b 3b 20 28 now"). ;; (
12d70 6d 65 67 61 74 65 73 74 2d 67 75 69 29 0a 20 20 megatest-gui).
12d80 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
12d90 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
12da0 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
12db0 67 20 22 2d 63 72 65 61 74 65 2d 6d 65 67 61 74 g "-create-megat
12dc0 65 73 74 2d 61 72 65 61 22 29 0a 20 20 20 20 28 est-area"). (
12dd0 62 65 67 69 6e 0a 20 20 20 20 20 20 28 67 65 6e begin. (gen
12de0 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 example:mk-megat
12df0 65 73 74 2e 63 6f 6e 66 69 67 29 0a 20 20 20 20 est.config).
12e00 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
12e10 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
12e20 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
12e30 22 2d 63 72 65 61 74 65 2d 74 65 73 74 22 29 0a "-create-test").
12e40 20 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 6e (let ((testn
12e50 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ame (args:get-ar
12e60 67 20 22 2d 63 72 65 61 74 65 2d 74 65 73 74 22 g "-create-test"
12e70 29 29 29 0a 20 20 20 20 20 20 28 67 65 6e 65 78 ))). (genex
12e80 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 ample:mk-megates
12e90 74 2d 74 65 73 74 20 74 65 73 74 6e 61 6d 65 29 t-test testname)
12ea0 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
12eb0 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
12ec0 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
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 0a 3b 3b 20 55 ===========.;; U
12f10 70 64 61 74 65 20 74 68 65 20 64 61 74 61 62 61 pdate the databa
12f20 73 65 20 73 63 68 65 6d 61 2c 20 63 6c 65 61 6e se schema, clean
12f30 20 75 70 20 74 68 65 20 64 62 0a 3b 3b 3d 3d 3d up the db.;;===
12f40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f80 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
12f90 65 74 2d 61 72 67 20 22 2d 72 65 62 75 69 6c 64 et-arg "-rebuild
12fa0 2d 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e -db"). (begin
12fb0 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
12fc0 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
12fd0 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
12fe0 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
12ff0 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
13000 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
13010 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 p, exiting") ..
13020 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))).
13030 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 ;; keep this
13040 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 one local.
13050 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
13060 20 70 61 74 63 68 2d 64 62 20 23 66 29 0a 20 20 patch-db #f).
13070 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
13080 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
13090 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
130a0 67 20 22 2d 63 6c 65 61 6e 75 70 2d 64 62 22 29 g "-cleanup-db")
130b0 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
130c0 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e (if (not (laun
130d0 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 ch:setup)).. (b
130e0 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 egin.. (debug
130f0 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
13100 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
13110 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
13120 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 iting") .. (e
13130 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 xit 1))). (
13140 63 6f 6d 6d 6f 6e 3a 63 6c 65 61 6e 75 70 2d 64 common:cleanup-d
13150 62 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a b). (set! *
13160 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
13170 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
13180 65 74 2d 61 72 67 20 22 2d 6d 61 72 6b 2d 69 6e et-arg "-mark-in
13190 63 6f 6d 70 6c 65 74 65 73 22 29 0a 20 20 20 20 completes").
131a0 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 (begin. (if
131b0 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
131c0 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a tup)).. (begin.
131d0 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
131e0 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
131f0 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 -port* "Failed t
13200 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
13210 22 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ").. (exit 1)
13220 29 29 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 )). (open-r
13230 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 66 69 6e 64 un-close db:find
13240 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 -and-mark-incomp
13250 6c 65 74 65 20 23 66 29 0a 20 20 20 20 20 20 28 lete #f). (
13260 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
13270 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d ng* #t)))..;;===
13280 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13290 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
132a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
132b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
132c0 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 ===.;; Update th
132d0 65 20 74 65 73 74 73 20 6d 65 74 61 20 64 61 74 e tests meta dat
132e0 61 20 66 72 6f 6d 20 74 68 65 20 74 65 73 74 63 a from the testc
132f0 6f 6e 66 69 67 20 66 69 6c 65 73 0a 3b 3b 3d 3d onfig files.;;==
13300 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13310 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13320 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13330 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13340 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
13350 67 65 74 2d 61 72 67 20 22 2d 75 70 64 61 74 65 get-arg "-update
13360 2d 6d 65 74 61 22 29 0a 20 20 20 20 28 62 65 67 -meta"). (beg
13370 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f in. (if (no
13380 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 t (launch:setup)
13390 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 ).. (begin..
133a0 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
133b0 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
133c0 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 t* "Failed to se
133d0 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a tup, exiting") .
133e0 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a . (exit 1))).
133f0 20 20 20 20 20 20 3b 3b 20 6e 6f 77 20 63 61 6e ;; now can
13400 20 66 69 6e 64 20 6f 75 72 20 64 62 0a 20 20 20 find our db.
13410 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 ;; keep this
13420 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 20 one local.
13430 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
13440 72 75 6e 73 3a 75 70 64 61 74 65 2d 61 6c 6c 2d runs:update-all-
13450 74 65 73 74 5f 6d 65 74 61 20 23 66 29 0a 20 20 test_meta #f).
13460 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
13470 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
13480 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
13490 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
134a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
134b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
134c0 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 ========.;; Star
134d0 74 20 61 20 72 65 70 6c 0a 3b 3b 3d 3d 3d 3d 3d t a repl.;;=====
134e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
134f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13500 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13510 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13520 3d 0a 0a 3b 3b 20 66 61 6b 65 6f 75 74 20 72 65 =..;; fakeout re
13530 61 64 6c 69 6e 65 0a 28 69 6e 63 6c 75 64 65 20 adline.(include
13540 22 72 65 61 64 6c 69 6e 65 2d 66 69 78 2e 73 63 "readline-fix.sc
13550 6d 22 29 0a 0a 28 69 66 20 28 6f 72 20 28 67 65 m")..(if (or (ge
13560 74 65 6e 76 20 22 4d 54 5f 52 55 4e 53 43 52 49 tenv "MT_RUNSCRI
13570 50 54 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d PT")..(args:get-
13580 61 72 67 20 22 2d 72 65 70 6c 22 29 0a 09 28 61 arg "-repl")..(a
13590 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
135a0 61 64 22 29 29 0a 20 20 20 20 28 6c 65 74 2a 20 ad")). (let*
135b0 28 28 74 6f 70 70 61 74 68 20 28 6c 61 75 6e 63 ((toppath (launc
135c0 68 3a 73 65 74 75 70 29 29 0a 09 20 20 20 28 64 h:setup)).. (d
135d0 62 73 74 72 75 63 74 20 28 69 66 20 74 6f 70 70 bstruct (if topp
135e0 61 74 68 20 28 6d 61 6b 65 2d 64 62 72 3a 64 62 ath (make-dbr:db
135f0 73 74 72 75 63 74 20 70 61 74 68 3a 20 74 6f 70 struct path: top
13600 70 61 74 68 20 6c 6f 63 61 6c 3a 20 28 61 72 67 path local: (arg
13610 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 61 s:get-arg "-loca
13620 6c 22 29 29 20 23 66 29 29 29 0a 20 20 20 20 20 l")) #f))).
13630 20 28 69 66 20 64 62 73 74 72 75 63 74 0a 09 20 (if dbstruct..
13640 20 28 63 6f 6e 64 0a 09 20 20 20 28 28 67 65 74 (cond.. ((get
13650 65 6e 76 20 22 4d 54 5f 52 55 4e 53 43 52 49 50 env "MT_RUNSCRIP
13660 54 22 29 0a 09 20 20 20 20 3b 3b 20 48 6f 77 20 T").. ;; How
13670 74 6f 20 72 75 6e 20 6d 65 67 61 74 65 73 74 20 to run megatest
13680 73 63 72 69 70 74 73 0a 09 20 20 20 20 3b 3b 0a scripts.. ;;.
13690 09 20 20 20 20 3b 3b 20 23 21 2f 62 69 6e 2f 62 . ;; #!/bin/b
136a0 61 73 68 0a 09 20 20 20 20 3b 3b 0a 09 20 20 20 ash.. ;;..
136b0 20 3b 3b 20 65 78 70 6f 72 74 20 4d 54 5f 52 55 ;; export MT_RU
136c0 4e 53 43 52 49 50 54 3d 79 65 73 0a 09 20 20 20 NSCRIPT=yes..
136d0 20 3b 3b 20 6d 65 67 61 74 65 73 74 20 3c 3c 20 ;; megatest <<
136e0 45 4f 46 0a 09 20 20 20 20 3b 3b 20 28 70 72 69 EOF.. ;; (pri
136f0 6e 74 20 22 48 65 6c 6c 6f 20 77 6f 72 6c 64 22 nt "Hello world"
13700 29 0a 09 20 20 20 20 3b 3b 20 28 65 78 69 74 29 ).. ;; (exit)
13710 0a 09 20 20 20 20 3b 3b 20 45 4f 46 0a 0a 09 20 .. ;; EOF...
13720 20 20 20 28 72 65 70 6c 29 29 0a 09 20 20 20 28 (repl)).. (
13730 65 6c 73 65 0a 09 20 20 20 20 28 62 65 67 69 6e else.. (begin
13740 0a 09 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 .. (set! *d
13750 62 2a 20 64 62 73 74 72 75 63 74 29 0a 09 20 20 b* dbstruct)..
13760 20 20 20 20 28 73 65 74 21 20 2a 63 6c 69 65 6e (set! *clien
13770 74 2d 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 2d 6d t-non-blocking-m
13780 6f 64 65 2a 20 23 74 29 0a 09 20 20 20 20 20 20 ode* #t)..
13790 28 69 6d 70 6f 72 74 20 65 78 74 72 61 73 29 20 (import extras)
137a0 3b 3b 20 6d 69 67 68 74 20 6e 6f 74 20 62 65 20 ;; might not be
137b0 6e 65 65 64 65 64 0a 09 20 20 20 20 20 20 3b 3b needed.. ;;
137c0 20 28 69 6d 70 6f 72 74 20 63 73 69 29 0a 09 20 (import csi)..
137d0 20 20 20 20 20 28 69 6d 70 6f 72 74 20 72 65 61 (import rea
137e0 64 6c 69 6e 65 29 0a 09 20 20 20 20 20 20 28 69 dline).. (i
137f0 6d 70 6f 72 74 20 61 70 72 6f 70 6f 73 29 0a 09 mport apropos)..
13800 20 20 20 20 20 20 3b 3b 20 28 69 6d 70 6f 72 74 ;; (import
13810 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 (prefix sqlite3
13820 20 73 71 6c 69 74 65 33 3a 29 29 20 3b 3b 20 64 sqlite3:)) ;; d
13830 6f 65 73 6e 27 74 20 77 6f 72 6b 20 2e 2e 2e 0a oesn't work ....
13840 0a 09 20 20 20 20 20 20 28 69 66 20 2a 75 73 65 .. (if *use
13850 2d 6e 65 77 2d 72 65 61 64 6c 69 6e 65 2a 0a 09 -new-readline*..
13860 09 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 . (begin...
13870 28 69 6e 73 74 61 6c 6c 2d 68 69 73 74 6f 72 79 (install-history
13880 2d 66 69 6c 65 20 28 67 65 74 2d 65 6e 76 69 72 -file (get-envir
13890 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
138a0 22 48 4f 4d 45 22 29 20 22 2e 6d 65 67 61 74 65 "HOME") ".megate
138b0 73 74 5f 68 69 73 74 6f 72 79 22 29 20 3b 3b 20 st_history") ;;
138c0 20 5b 68 6f 6d 65 64 69 72 5d 20 5b 66 69 6c 65 [homedir] [file
138d0 6e 61 6d 65 5d 20 5b 6e 6c 69 6e 65 73 5d 29 0a name] [nlines]).
138e0 09 09 20 20 20 20 28 63 75 72 72 65 6e 74 2d 69 .. (current-i
138f0 6e 70 75 74 2d 70 6f 72 74 20 28 6d 61 6b 65 2d nput-port (make-
13900 72 65 61 64 6c 69 6e 65 2d 70 6f 72 74 20 22 6d readline-port "m
13910 65 67 61 74 65 73 74 3e 20 22 29 29 29 0a 09 09 egatest> ")))...
13920 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 (begin... (
13930 67 6e 75 2d 68 69 73 74 6f 72 79 2d 69 6e 73 74 gnu-history-inst
13940 61 6c 6c 2d 66 69 6c 65 2d 6d 61 6e 61 67 65 72 all-file-manager
13950 0a 09 09 20 20 20 20 20 28 73 74 72 69 6e 67 2d ... (string-
13960 61 70 70 65 6e 64 0a 09 09 20 20 20 20 20 20 28 append... (
13970 6f 72 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d or (get-environm
13980 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f ent-variable "HO
13990 4d 45 22 29 20 22 2e 22 29 20 22 2f 2e 6d 65 67 ME") ".") "/.meg
139a0 61 74 65 73 74 5f 68 69 73 74 6f 72 79 22 29 29 atest_history"))
139b0 0a 09 09 20 20 20 20 28 63 75 72 72 65 6e 74 2d ... (current-
139c0 69 6e 70 75 74 2d 70 6f 72 74 20 28 6d 61 6b 65 input-port (make
139d0 2d 67 6e 75 2d 72 65 61 64 6c 69 6e 65 2d 70 6f -gnu-readline-po
139e0 72 74 20 22 6d 65 67 61 74 65 73 74 3e 20 22 29 rt "megatest> ")
139f0 29 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 ))).. (if (
13a00 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
13a10 65 70 6c 22 29 0a 09 09 20 20 28 72 65 70 6c 29 epl")... (repl)
13a20 0a 09 09 20 20 28 6c 6f 61 64 20 28 61 72 67 73 ... (load (args
13a30 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 22 :get-arg "-load"
13a40 29 29 29 0a 09 20 20 20 20 20 20 28 64 62 3a 63 ))).. (db:c
13a50 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 lose-all dbstruc
13a60 74 29 29 0a 09 20 20 20 20 28 65 78 69 74 29 29 t)).. (exit))
13a70 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 ).. (set! *dids
13a80 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 omething* #t))))
13a90 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
13aa0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ab0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ac0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ad0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 57 61 ==========.;; Wa
13ae0 69 74 20 6f 6e 20 61 20 72 75 6e 20 74 6f 20 63 it on a run to c
13af0 6f 6d 70 6c 65 74 65 0a 3b 3b 3d 3d 3d 3d 3d 3d omplete.;;======
13b00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b40 0a 0a 28 69 66 20 28 61 6e 64 20 28 61 72 67 73 ..(if (and (args
13b50 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 2d 77 :get-arg "-run-w
13b60 61 69 74 22 29 0a 09 20 28 6e 6f 74 20 28 6f 72 ait").. (not (or
13b70 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
13b80 2d 72 75 6e 22 29 0a 09 09 20 20 28 61 72 67 73 -run")... (args
13b90 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
13ba0 73 74 73 22 29 29 29 29 20 3b 3b 20 72 75 6e 2d sts")))) ;; run-
13bb0 77 61 69 74 20 69 73 20 62 75 69 6c 74 20 69 6e wait is built in
13bc0 74 6f 20 72 75 6e 74 65 73 74 73 20 6e 6f 77 0a to runtests now.
13bd0 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
13be0 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 (if (not (launc
13bf0 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 65 h:setup)).. (be
13c00 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a gin.. (debug:
13c10 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
13c20 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c -log-port* "Fail
13c30 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
13c40 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 78 ting") .. (ex
13c50 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 6f it 1))). (o
13c60 70 65 72 61 74 65 2d 6f 6e 20 27 72 75 6e 2d 77 perate-on 'run-w
13c70 61 69 74 29 0a 20 20 20 20 20 20 28 73 65 74 21 ait). (set!
13c80 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
13c90 23 74 29 29 29 0a 0a 3b 3b 20 3b 3b 20 3b 3b 20 #t)))..;; ;; ;;
13ca0 72 65 64 6f 20 6d 65 20 3b 3b 20 4e 6f 74 20 63 redo me ;; Not c
13cb0 6f 6e 76 65 72 74 65 64 20 74 6f 20 75 73 65 20 onverted to use
13cc0 64 62 73 74 72 75 63 74 20 79 65 74 0a 3b 3b 20 dbstruct yet.;;
13cd0 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 3b 3b ;; ;; redo me ;;
13ce0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13cf0 65 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d e (if (args:get-
13d00 61 72 67 20 22 2d 63 6f 6e 76 65 72 74 2d 74 6f arg "-convert-to
13d10 2d 6e 6f 72 6d 22 29 0a 3b 3b 20 3b 3b 20 3b 3b -norm").;; ;; ;;
13d20 20 72 65 64 6f 20 6d 65 20 20 20 20 20 28 6c 65 redo me (le
13d30 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 73 65 t* ((toppath (se
13d40 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 3b 3b tup-for-run)).;;
13d50 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
13d60 20 20 20 28 64 62 73 74 72 75 63 74 20 28 69 66 (dbstruct (if
13d70 20 74 6f 70 70 61 74 68 20 28 6d 61 6b 65 2d 64 toppath (make-d
13d80 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 68 br:dbstruct path
13d90 3a 20 74 6f 70 70 61 74 68 20 6c 6f 63 61 6c 3a : toppath local:
13da0 20 23 74 29 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b #t)))).;; ;; ;;
13db0 20 72 65 64 6f 20 6d 65 20 20 20 20 20 20 20 28 redo me (
13dc0 66 6f 72 2d 65 61 63 68 20 0a 3b 3b 20 3b 3b 20 for-each .;; ;;
13dd0 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 20 ;; redo me
13de0 20 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 (lambda (field
13df0 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
13e00 6d 65 20 09 20 28 6c 65 74 20 28 28 64 61 74 20 me . (let ((dat
13e10 27 28 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 '())).;; ;; ;; r
13e20 65 64 6f 20 6d 65 20 09 20 20 20 28 64 65 62 75 edo me . (debu
13e30 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
13e40 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
13e50 2a 20 22 47 65 74 74 69 6e 67 20 64 61 74 61 20 * "Getting data
13e60 66 6f 72 20 66 69 65 6c 64 20 22 20 66 69 65 6c for field " fiel
13e70 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f d).;; ;; ;; redo
13e80 20 6d 65 20 09 20 20 20 28 73 71 6c 69 74 65 33 me . (sqlite3
13e90 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 3b 3b :for-each-row.;;
13ea0 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
13eb0 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 (lambda (id
13ec0 76 61 6c 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 val).;; ;; ;; re
13ed0 64 6f 20 6d 65 20 09 20 20 20 20 20 20 28 73 65 do me . (se
13ee0 74 21 20 64 61 74 20 28 63 6f 6e 73 20 28 6c 69 t! dat (cons (li
13ef0 73 74 20 69 64 20 76 61 6c 29 20 64 61 74 29 29 st id val) dat))
13f00 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
13f10 6d 65 20 09 20 20 20 20 28 64 62 3a 67 65 74 2d me . (db:get-
13f20 64 62 20 64 62 20 72 75 6e 2d 69 64 29 0a 3b 3b db db run-id).;;
13f30 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
13f40 20 20 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 (conc "SELEC
13f50 54 20 69 64 2c 22 20 66 69 65 6c 64 20 22 20 46 T id," field " F
13f60 52 4f 4d 20 74 65 73 74 73 3b 22 29 29 0a 3b 3b ROM tests;")).;;
13f70 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
13f80 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
13f90 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
13fa0 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 6f 75 6e 64 log-port* "found
13fb0 20 22 20 28 6c 65 6e 67 74 68 20 64 61 74 29 20 " (length dat)
13fc0 22 20 69 74 65 6d 73 20 66 6f 72 20 66 69 65 6c " items for fiel
13fd0 64 20 22 20 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b d " field).;; ;;
13fe0 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
13ff0 28 6c 65 74 20 28 28 71 72 79 20 28 73 71 6c 69 (let ((qry (sqli
14000 74 65 33 3a 70 72 65 70 61 72 65 20 64 62 20 28 te3:prepare db (
14010 63 6f 6e 63 20 22 55 50 44 41 54 45 20 74 65 73 conc "UPDATE tes
14020 74 73 20 53 45 54 20 22 20 66 69 65 6c 64 20 22 ts SET " field "
14030 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 =? WHERE id=?;")
14040 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ))).;; ;; ;; red
14050 6f 20 6d 65 20 09 20 20 20 20 20 28 66 6f 72 2d o me . (for-
14060 65 61 63 68 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 each.;; ;; ;; re
14070 64 6f 20 6d 65 20 09 20 20 20 20 20 20 28 6c 61 do me . (la
14080 6d 62 64 61 20 28 69 74 65 6d 29 0a 3b 3b 20 3b mbda (item).;; ;
14090 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 28 ; ;; redo me ..(
140a0 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 3b 3b 20 let ((newval ;;
140b0 28 73 64 62 3a 71 72 79 20 27 67 65 74 69 64 20 (sdb:qry 'getid
140c0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
140d0 65 20 09 09 20 20 20 20 20 20 20 28 63 61 64 72 e .. (cadr
140e0 20 69 74 65 6d 29 29 29 20 3b 3b 20 29 0a 3b 3b item))) ;; ).;;
140f0 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
14100 09 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 . (if (not (equ
14110 61 6c 3f 20 6e 65 77 76 61 6c 20 28 63 61 64 72 al? newval (cadr
14120 20 69 74 65 6d 29 29 29 0a 3b 3b 20 3b 3b 20 3b item))).;; ;; ;
14130 3b 20 72 65 64 6f 20 6d 65 20 09 09 20 20 20 20 ; redo me ..
14140 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
14150 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
14160 6f 67 2d 70 6f 72 74 2a 20 22 43 6f 6e 76 65 72 og-port* "Conver
14170 74 69 6e 67 20 22 20 28 63 61 64 72 20 69 74 65 ting " (cadr ite
14180 6d 29 20 22 20 74 6f 20 22 20 6e 65 77 76 61 6c m) " to " newval
14190 20 22 20 66 6f 72 20 74 65 73 74 20 23 22 20 28 " for test #" (
141a0 63 61 72 20 69 74 65 6d 29 29 29 0a 3b 3b 20 3b car item))).;; ;
141b0 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 20 ; ;; redo me ..
141c0 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
141d0 65 20 71 72 79 20 6e 65 77 76 61 6c 20 28 63 61 e qry newval (ca
141e0 72 20 69 74 65 6d 29 29 29 29 0a 3b 3b 20 3b 3b r item)))).;; ;;
141f0 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
14200 20 20 20 64 61 74 29 0a 3b 3b 20 3b 3b 20 3b 3b dat).;; ;; ;;
14210 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 28 redo me . (
14220 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
14230 21 20 71 72 79 29 29 29 29 0a 3b 3b 20 3b 3b 20 ! qry)))).;; ;;
14240 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 20 ;; redo me
14250 20 20 28 64 62 3a 63 6c 6f 73 65 2d 61 6c 6c 20 (db:close-all
14260 64 62 73 74 72 75 63 74 29 0a 3b 3b 20 3b 3b 20 dbstruct).;; ;;
14270 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 20 ;; redo me
14280 20 20 28 6c 69 73 74 20 22 75 6e 61 6d 65 22 20 (list "uname"
14290 22 72 75 6e 64 69 72 22 20 22 66 69 6e 61 6c 5f "rundir" "final_
142a0 6c 6f 67 66 22 20 22 63 6f 6d 6d 65 6e 74 22 29 logf" "comment")
142b0 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
142c0 6d 65 20 20 20 20 20 20 20 28 73 65 74 21 20 2a me (set! *
142d0 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
142e0 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
142f0 65 74 2d 61 72 67 20 22 2d 69 6d 70 6f 72 74 2d et-arg "-import-
14300 6d 65 67 61 74 65 73 74 2e 64 62 22 29 0a 20 20 megatest.db").
14310 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
14320 64 62 3a 6d 75 6c 74 69 2d 64 62 2d 73 79 6e 63 db:multi-db-sync
14330 20 0a 20 20 20 20 20 20 20 23 66 20 3b 3b 20 64 . #f ;; d
14340 6f 20 61 6c 6c 20 72 75 6e 2d 69 64 73 0a 20 20 o all run-ids.
14350 20 20 20 20 20 27 6b 69 6c 6c 73 65 72 76 65 72 'killserver
14360 73 0a 20 20 20 20 20 20 20 27 64 65 6a 75 6e 6b s. 'dejunk
14370 0a 20 20 20 20 20 20 20 27 61 64 6a 2d 74 65 73 . 'adj-tes
14380 74 69 64 73 0a 20 20 20 20 20 20 20 27 6f 6c 64 tids. 'old
14390 32 6e 65 77 0a 20 20 20 20 20 20 20 3b 3b 20 27 2new. ;; '
143a0 6e 65 77 32 6f 6c 64 0a 20 20 20 20 20 20 20 29 new2old. )
143b0 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
143c0 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
143d0 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
143e0 2d 61 72 67 20 22 2d 73 79 6e 63 2d 74 6f 2d 6d -arg "-sync-to-m
143f0 65 67 61 74 65 73 74 2e 64 62 22 29 0a 20 20 20 egatest.db").
14400 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 64 (begin. (d
14410 62 3a 6d 75 6c 74 69 2d 64 62 2d 73 79 6e 63 20 b:multi-db-sync
14420 0a 20 20 20 20 20 20 20 23 66 20 3b 3b 20 64 6f . #f ;; do
14430 20 61 6c 6c 20 72 75 6e 2d 69 64 73 0a 20 20 20 all run-ids.
14440 20 20 20 20 27 6e 65 77 32 6f 6c 64 0a 20 20 20 'new2old.
14450 20 20 20 20 29 0a 20 20 20 20 20 20 28 73 65 74 ). (set
14460 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
14470 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
14480 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 6e 65 s:get-arg "-gene
14490 72 61 74 65 2d 68 74 6d 6c 22 29 0a 20 20 20 20 rate-html").
144a0 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 (let* ((toppath
144b0 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 (launch:setup)))
144c0 0a 20 20 20 20 20 20 28 69 66 20 28 74 65 73 74 . (if (test
144d0 73 3a 63 72 65 61 74 65 2d 68 74 6d 6c 2d 74 72 s:create-html-tr
144e0 65 65 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 ee #f).
144f0 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
14500 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 0 *default-lo
14510 67 2d 70 6f 72 74 2a 20 22 48 54 4d 4c 20 6f 75 g-port* "HTML ou
14520 74 70 75 74 20 63 72 65 61 74 65 64 20 69 6e 20 tput created in
14530 22 20 74 6f 70 70 61 74 68 20 22 2f 6c 74 2f 72 " toppath "/lt/r
14540 75 6e 73 2d 69 6e 64 65 78 2e 68 74 6d 6c 22 29 uns-index.html")
14550 0a 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 . (debu
14560 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
14570 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 lt-log-port* "Fa
14580 69 6c 65 64 20 74 6f 20 63 72 65 61 74 65 20 48 iled to create H
14590 54 4d 4c 20 6f 75 74 70 75 74 20 69 6e 20 22 20 TML output in "
145a0 74 6f 70 70 61 74 68 20 22 2f 6c 74 2f 72 75 6e toppath "/lt/run
145b0 73 2d 69 6e 64 65 78 2e 68 74 6d 6c 22 29 29 0a s-index.html")).
145c0 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
145d0 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
145e0 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
145f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14600 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14610 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14620 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 ==========.;; Ex
14630 69 74 20 61 6e 64 20 63 6c 65 61 6e 20 75 70 0a it and clean up.
14640 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
14650 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14660 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14670 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14680 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 2a 72 ========..(if *r
14690 75 6e 72 65 6d 6f 74 65 2a 20 28 63 6c 6f 73 65 unremote* (close
146a0 2d 61 6c 6c 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 -all-connections
146b0 21 29 29 0a 0a 28 69 66 20 28 6e 6f 74 20 2a 64 !))..(if (not *d
146c0 69 64 73 6f 6d 65 74 68 69 6e 67 2a 29 0a 20 20 idsomething*).
146d0 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
146e0 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
146f0 72 74 2a 20 68 65 6c 70 29 29 0a 0a 28 73 65 74 rt* help))..(set
14700 21 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a ! *time-to-exit*
14710 20 23 74 29 0a 28 74 68 72 65 61 64 2d 6a 6f 69 #t).(thread-joi
14720 6e 21 20 2a 77 61 74 63 68 64 6f 67 2a 29 0a 0a n! *watchdog*)..
14730 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 2a 67 (if (not (eq? *g
14740 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
14750 20 30 29 29 0a 20 20 20 20 28 69 66 20 28 6f 72 0)). (if (or
14760 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
14770 2d 72 75 6e 22 29 28 61 72 67 73 3a 67 65 74 2d -run")(args:get-
14780 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
14790 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
147a0 72 75 6e 61 6c 6c 22 29 29 0a 20 20 20 20 20 20 runall")).
147b0 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
147c0 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
147d0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
147e0 70 6f 72 74 2a 20 22 4e 4f 54 45 3a 20 53 75 62 port* "NOTE: Sub
147f0 70 72 6f 63 65 73 73 65 73 20 77 69 74 68 20 6e processes with n
14800 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 20 63 6f 64 on-zero exit cod
14810 65 20 64 65 74 65 63 74 65 64 3a 20 22 20 2a 67 e detected: " *g
14820 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
14830 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 78 ). (ex
14840 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 28 it 0)). (
14850 63 61 73 65 20 2a 67 6c 6f 62 61 6c 65 78 69 74 case *globalexit
14860 73 74 61 74 75 73 2a 0a 20 20 20 20 20 20 20 20 status*.
14870 20 28 28 30 29 28 65 78 69 74 20 30 29 29 0a 20 ((0)(exit 0)).
14880 20 20 20 20 20 20 20 20 28 28 31 29 28 65 78 69 ((1)(exi
14890 74 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 28 t 1)). (
148a0 28 32 29 28 65 78 69 74 20 32 29 29 0a 20 20 20 (2)(exit 2)).
148b0 20 20 20 20 20 20 28 65 6c 73 65 20 28 65 78 69 (else (exi
148c0 74 20 33 29 29 29 29 29 0a t 3))))).