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 73 65 2d 64 62 est.db. -use-db
1b10: 2d 63 61 63 68 65 20 20 20 20 20 20 20 20 20 20 -cache
1b20: 20 3a 20 75 73 65 20 63 61 63 68 65 64 20 61 63 : use cached ac
1b30: 63 65 73 73 20 74 6f 20 64 62 20 74 6f 20 72 65 cess to db to re
1b40: 64 75 63 65 20 6c 6f 61 64 0a 20 20 2d 75 70 64 duce load. -upd
1b50: 61 74 65 2d 6d 65 74 61 20 20 20 20 20 20 20 20 ate-meta
1b60: 20 20 20 20 3a 20 75 70 64 61 74 65 20 74 68 65 : update the
1b70: 20 74 65 73 74 73 20 6d 65 74 61 64 61 74 61 20 tests metadata
1b80: 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 0a 20 20 for all tests.
1b90: 2d 73 65 74 76 61 72 73 20 56 41 52 31 3d 76 61 -setvars VAR1=va
1ba0: 6c 31 2c 56 41 52 32 3d 76 61 6c 32 20 3a 20 41 l1,VAR2=val2 : A
1bb0: 64 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 dd environment v
1bc0: 61 72 69 61 62 6c 65 73 20 74 6f 20 61 20 72 75 ariables to a ru
1bd0: 6e 20 4e 42 2f 2f 20 74 68 65 73 65 20 61 72 65 n NB// these are
1be0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c00: 20 20 6f 76 65 72 77 72 69 74 74 65 6e 20 62 79 overwritten by
1c10: 20 76 61 6c 75 65 73 20 73 65 74 20 69 6e 20 63 values set in c
1c20: 6f 6e 66 69 67 20 66 69 6c 65 73 2e 0a 20 20 2d onfig files.. -
1c30: 73 65 72 76 65 72 20 2d 7c 68 6f 73 74 6e 61 6d server -|hostnam
1c40: 65 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 74 e : start t
1c50: 68 65 20 73 65 72 76 65 72 20 28 72 65 64 75 63 he server (reduc
1c60: 65 73 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 6f 6e es contention on
1c70: 20 6d 65 67 61 74 65 73 74 2e 64 62 29 2c 20 75 megatest.db), u
1c80: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
1c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d -
1ca0: 20 74 6f 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c to automaticall
1cb0: 79 20 66 69 67 75 72 65 20 6f 75 74 20 68 6f 73 y figure out hos
1cc0: 74 6e 61 6d 65 0a 20 20 2d 74 72 61 6e 73 70 6f tname. -transpo
1cd0: 72 74 20 68 74 74 70 7c 72 70 63 20 20 20 20 20 rt http|rpc
1ce0: 3a 20 75 73 65 20 68 74 74 70 20 6f 72 20 72 70 : use http or rp
1cf0: 63 20 66 6f 72 20 74 72 61 6e 73 70 6f 72 74 20 c for transport
1d00: 28 64 65 66 61 75 6c 74 20 69 73 20 68 74 74 70 (default is http
1d10: 29 20 0a 20 20 2d 64 61 65 6d 6f 6e 69 7a 65 20 ) . -daemonize
1d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 66 : f
1d30: 6f 72 6b 20 69 6e 74 6f 20 62 61 63 6b 67 72 6f ork into backgro
1d40: 75 6e 64 20 61 6e 64 20 64 69 73 63 6f 6e 6e 65 und and disconne
1d50: 63 74 20 66 72 6f 6d 20 73 74 64 69 6e 2f 6f 75 ct from stdin/ou
1d60: 74 0a 20 20 2d 6c 6f 67 20 6c 6f 67 66 69 6c 65 t. -log logfile
1d70: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 : se
1d80: 6e 64 20 73 74 64 6f 75 74 20 61 6e 64 20 73 74 nd stdout and st
1d90: 64 65 72 72 20 74 6f 20 6c 6f 67 66 69 6c 65 0a derr to logfile.
1da0: 20 20 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 20 -list-servers
1db0: 20 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 : list
1dc0: 20 74 68 65 20 73 65 72 76 65 72 73 20 0a 20 20 the servers .
1dd0: 2d 73 74 6f 70 2d 73 65 72 76 65 72 20 69 64 20 -stop-server id
1de0: 20 20 20 20 20 20 20 20 3a 20 73 74 6f 70 20 73 : stop s
1df0: 65 72 76 65 72 20 73 70 65 63 69 66 69 65 64 20 erver specified
1e00: 62 79 20 69 64 20 28 73 65 65 20 6f 75 74 70 75 by id (see outpu
1e10: 74 20 6f 66 20 2d 6c 69 73 74 2d 73 65 72 76 65 t of -list-serve
1e20: 72 73 29 2c 20 75 73 65 0a 20 20 20 20 20 20 20 rs), use.
1e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e40: 20 20 20 20 20 30 20 74 6f 20 6b 69 6c 6c 20 61 0 to kill a
1e50: 6c 6c 0a 20 20 2d 72 65 70 6c 20 20 20 20 20 20 ll. -repl
1e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 : s
1e70: 74 61 72 74 20 61 20 72 65 70 6c 20 28 75 73 65 tart a repl (use
1e80: 66 75 6c 20 66 6f 72 20 65 78 74 65 6e 64 69 6e ful for extendin
1e90: 67 20 6d 65 67 61 74 65 73 74 29 0a 20 20 2d 6c g megatest). -l
1ea0: 6f 61 64 20 66 69 6c 65 2e 73 63 6d 20 20 20 20 oad file.scm
1eb0: 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 61 6e 64 : load and
1ec0: 20 72 75 6e 20 66 69 6c 65 2e 73 63 6d 0a 20 20 run file.scm.
1ed0: 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 -mark-incomplete
1ee0: 73 20 20 20 20 20 20 20 3a 20 66 69 6e 64 20 61 s : find a
1ef0: 6e 64 20 6d 61 72 6b 20 69 6e 63 6f 6d 70 6c 65 nd mark incomple
1f00: 74 65 20 74 65 73 74 73 0a 20 20 2d 70 69 6e 67 te tests. -ping
1f10: 20 72 75 6e 2d 69 64 7c 68 6f 73 74 3a 70 6f 72 run-id|host:por
1f20: 74 20 20 3a 20 70 69 6e 67 20 73 65 72 76 65 72 t : ping server
1f30: 2c 20 65 78 69 74 20 77 69 74 68 20 30 20 69 66 , exit with 0 if
1f40: 20 66 6f 75 6e 64 0a 20 20 2d 64 65 62 75 67 20 found. -debug
1f50: 4e 7c 4e 2c 4d 2c 4f 2e 2e 2e 20 20 20 20 20 20 N|N,M,O...
1f60: 20 3a 20 65 6e 61 62 6c 65 20 64 65 62 75 67 20 : enable debug
1f70: 30 2d 4e 20 6f 72 20 4e 20 61 6e 64 20 4d 20 61 0-N or N and M a
1f80: 6e 64 20 4f 20 2e 2e 2e 0a 0a 55 74 69 6c 69 74 nd O .....Utilit
1f90: 69 65 73 0a 20 20 2d 65 6e 76 32 66 69 6c 65 20 ies. -env2file
1fa0: 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 3a 20 fname :
1fb0: 77 72 69 74 65 20 74 68 65 20 65 6e 76 69 72 6f write the enviro
1fc0: 6e 6d 65 6e 74 20 74 6f 20 66 6e 61 6d 65 2e 63 nment to fname.c
1fd0: 73 68 20 61 6e 64 20 66 6e 61 6d 65 2e 73 68 0a sh and fname.sh.
1fe0: 20 20 2d 65 6e 76 63 61 70 20 66 6e 61 6d 65 3d -envcap fname=
1ff0: 63 6f 6e 74 65 78 74 20 20 20 3a 20 73 61 76 65 context : save
2000: 20 63 75 72 72 65 6e 74 20 76 61 72 69 61 62 6c current variabl
2010: 65 73 20 6c 61 62 65 6c 65 64 20 61 73 20 63 6f es labeled as co
2020: 6e 74 65 78 74 20 69 6e 20 66 69 6c 65 20 66 6e ntext in file fn
2030: 61 6d 65 0a 20 20 2d 72 65 66 64 62 32 64 61 74 ame. -refdb2dat
2040: 20 72 65 66 64 62 20 20 20 20 20 20 20 20 3a 20 refdb :
2050: 63 6f 6e 76 65 72 74 20 72 65 66 64 62 20 74 6f convert refdb to
2060: 20 73 65 78 70 20 6f 72 20 74 6f 20 66 6f 72 6d sexp or to form
2070: 61 74 20 73 70 65 63 69 66 69 65 64 20 62 79 20 at specified by
2080: 2d 64 75 6d 70 6d 6f 64 65 0a 20 20 20 20 20 20 -dumpmode.
2090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20a0: 20 20 20 20 20 20 66 6f 72 6d 61 74 73 3a 20 70 formats: p
20b0: 65 72 6c 2c 20 72 75 62 79 2c 20 73 71 6c 69 74 erl, ruby, sqlit
20c0: 65 33 2c 20 63 73 76 20 28 66 6f 72 20 63 73 76 e3, csv (for csv
20d0: 20 74 68 65 20 2d 6f 20 70 61 72 61 6d 0a 20 20 the -o param.
20e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20f0: 20 20 20 20 20 20 20 20 20 20 77 69 6c 6c 20 73 will s
2100: 75 62 73 74 69 74 75 74 65 20 25 73 20 66 6f 72 ubstitute %s for
2110: 20 74 68 65 20 73 68 65 65 74 20 6e 61 6d 65 20 the sheet name
2120: 69 6e 20 67 65 6e 65 72 61 74 69 6e 67 20 0a 20 in generating .
2130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2140: 20 20 20 20 20 20 20 20 20 20 20 6d 75 6c 74 69 multi
2150: 70 6c 65 20 73 68 65 65 74 73 29 0a 20 20 2d 6f ple sheets). -o
2160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2170: 20 20 20 20 20 20 3a 20 6f 75 74 70 75 74 20 66 : output f
2180: 69 6c 65 20 66 6f 72 20 72 65 66 64 62 32 64 61 ile for refdb2da
2190: 74 20 28 64 65 66 61 75 6c 74 73 20 74 6f 20 73 t (defaults to s
21a0: 74 64 6f 75 74 29 0a 20 20 2d 61 72 63 68 69 76 tdout). -archiv
21b0: 65 20 63 6d 64 20 20 20 20 20 20 20 20 20 20 20 e cmd
21c0: 20 3a 20 61 72 63 68 69 76 65 20 72 75 6e 73 20 : archive runs
21d0: 73 70 65 63 69 66 69 65 64 20 62 79 20 73 65 6c specified by sel
21e0: 65 63 74 6f 72 73 20 74 6f 20 6f 6e 65 20 6f 66 ectors to one of
21f0: 20 64 69 73 6b 73 20 73 70 65 63 69 66 69 65 64 disks specified
2200: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2210: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 6e 20 in
2220: 74 68 65 20 5b 61 72 63 68 69 76 65 2d 64 69 73 the [archive-dis
2230: 6b 73 5d 20 73 65 63 74 69 6f 6e 2e 0a 20 20 20 ks] section..
2240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2250: 20 20 20 20 20 20 20 20 20 63 6d 64 3a 20 6b 65 cmd: ke
2260: 65 70 2d 68 74 6d 6c 2c 20 72 65 73 74 6f 72 65 ep-html, restore
2270: 2c 20 73 61 76 65 2c 20 73 61 76 65 2d 72 65 6d , save, save-rem
2280: 6f 76 65 0a 20 20 2d 67 65 6e 65 72 61 74 65 2d ove. -generate-
2290: 68 74 6d 6c 20 20 20 20 20 20 20 20 20 20 3a 20 html :
22a0: 63 72 65 61 74 65 20 61 20 73 69 6d 70 6c 65 20 create a simple
22b0: 68 74 6d 6c 20 74 72 65 65 20 66 6f 72 20 62 72 html tree for br
22c0: 6f 77 73 69 6e 67 20 79 6f 75 72 20 72 75 6e 73 owsing your runs
22d0: 0a 0a 53 70 72 65 61 64 73 68 65 65 74 20 67 65 ..Spreadsheet ge
22e0: 6e 65 72 61 74 69 6f 6e 0a 20 20 2d 65 78 74 72 neration. -extr
22f0: 61 63 74 2d 6f 64 73 20 66 6e 61 6d 65 2e 6f 64 act-ods fname.od
2300: 73 20 20 3a 20 65 78 74 72 61 63 74 20 61 6e 20 s : extract an
2310: 6f 70 65 6e 20 64 6f 63 75 6d 65 6e 74 20 73 70 open document sp
2320: 72 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 74 readsheet from t
2330: 68 65 20 64 61 74 61 62 61 73 65 0a 20 20 2d 70 he database. -p
2340: 61 74 68 6d 6f 64 20 70 61 74 68 20 20 20 20 20 athmod path
2350: 20 20 20 20 20 20 3a 20 69 6e 73 65 72 74 20 70 : insert p
2360: 61 74 68 2c 20 69 2e 65 2e 20 70 61 74 68 2f 72 ath, i.e. path/r
2370: 75 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c uname/itempath/l
2380: 6f 67 66 69 6c 65 2e 68 74 6d 6c 0a 20 20 20 20 ogfile.html.
2390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23a0: 20 20 20 20 20 20 20 20 77 69 6c 6c 20 63 6c 65 will cle
23b0: 61 72 20 74 68 65 20 66 69 65 6c 64 20 69 66 20 ar the field if
23c0: 6e 6f 20 72 75 6e 64 69 72 2f 74 65 73 74 6e 61 no rundir/testna
23d0: 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 me/itempath/logf
23e0: 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ile.
23f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2400: 69 66 20 69 74 20 63 6f 6e 74 61 69 6e 73 20 66 if it contains f
2410: 6f 72 77 61 72 64 20 73 6c 61 73 68 65 73 20 74 orward slashes t
2420: 68 65 20 70 61 74 68 20 77 69 6c 6c 20 62 65 20 he path will be
2430: 63 6f 6e 76 65 72 74 65 64 0a 20 20 20 20 20 20 converted.
2440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2450: 20 20 20 20 20 20 74 6f 20 77 69 6e 64 6f 77 73 to windows
2460: 20 73 74 79 6c 65 0a 47 65 74 74 69 6e 67 20 73 style.Getting s
2470: 74 61 72 74 65 64 0a 20 20 2d 63 72 65 61 74 65 tarted. -create
2480: 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 20 20 -megatest-area
2490: 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 61 20 : create a
24a0: 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 skeleton megates
24b0: 74 20 61 72 65 61 2e 20 59 6f 75 20 77 69 6c 6c t area. You will
24c0: 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 be prompted for
24d0: 20 70 61 74 68 73 0a 20 20 2d 63 72 65 61 74 65 paths. -create
24e0: 2d 74 65 73 74 20 74 65 73 74 6e 61 6d 65 20 20 -test testname
24f0: 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 61 20 : create a
2500: 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 skeleton megates
2510: 74 20 74 65 73 74 2e 20 59 6f 75 20 77 69 6c 6c t test. You will
2520: 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 be prompted for
2530: 20 69 6e 66 6f 0a 0a 45 78 61 6d 70 6c 65 73 0a info..Examples.
2540: 0a 23 20 47 65 74 20 74 65 73 74 20 70 61 74 68 .# Get test path
2550: 2c 20 75 73 65 20 27 2e 27 20 74 6f 20 67 65 74 , use '.' to get
2560: 20 61 20 73 69 6e 67 6c 65 20 70 61 74 68 20 6f a single path o
2570: 72 20 61 20 73 70 65 63 69 66 69 63 20 70 61 74 r a specific pat
2580: 68 2f 66 69 6c 65 20 70 61 74 74 65 72 6e 0a 6d h/file pattern.m
2590: 65 67 61 74 65 73 74 20 2d 74 65 73 74 2d 66 69 egatest -test-fi
25a0: 6c 65 73 20 27 6c 6f 67 73 2f 2a 2e 6c 6f 67 27 les 'logs/*.log'
25b0: 20 2d 74 61 72 67 65 74 20 75 62 75 6e 74 75 2f -target ubuntu/
25c0: 6e 25 2f 6e 6f 25 20 2d 72 75 6e 6e 61 6d 65 20 n%/no% -runname
25d0: 77 34 39 25 20 2d 74 65 73 74 70 61 74 74 20 74 w49% -testpatt t
25e0: 65 73 74 5f 6d 74 25 0a 0a 43 61 6c 6c 65 64 20 est_mt%..Called
25f0: 61 73 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 as " (string-int
2600: 65 72 73 70 65 72 73 65 20 28 61 72 67 76 29 20 ersperse (argv)
2610: 22 20 22 29 20 22 0a 56 65 72 73 69 6f 6e 20 22 " ") ".Version "
2620: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f megatest-versio
2630: 6e 20 22 2c 20 62 75 69 6c 74 20 66 72 6f 6d 20 n ", built from
2640: 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 " megatest-fossi
2650: 6c 2d 68 61 73 68 20 29 29 0a 0a 3b 3b 20 20 2d l-hash ))..;; -
2660: 67 75 69 20 20 20 20 20 20 20 20 20 20 20 20 20 gui
2670: 20 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 61 : start a
2680: 20 67 75 69 20 69 6e 74 65 72 66 61 63 65 0a 3b gui interface.;
2690: 3b 20 20 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 ; -config fname
26a0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 6f 76 65 : ove
26b0: 72 72 69 64 65 20 74 68 65 20 72 75 6e 63 6f 6e rride the runcon
26c0: 66 69 67 20 66 69 6c 65 20 77 69 74 68 20 66 6e fig file with fn
26d0: 61 6d 65 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 20 ame..;; process
26e0: 61 72 67 73 0a 28 64 65 66 69 6e 65 20 72 65 6d args.(define rem
26f0: 61 72 67 73 20 28 61 72 67 73 3a 67 65 74 2d 61 args (args:get-a
2700: 72 67 73 20 0a 09 09 20 28 61 72 67 76 29 0a 09 rgs ... (argv)..
2710: 09 20 28 6c 69 73 74 20 20 22 2d 72 75 6e 74 65 . (list "-runte
2720: 73 74 73 22 20 20 3b 3b 20 72 75 6e 20 61 20 73 sts" ;; run a s
2730: 70 65 63 69 66 69 63 20 74 65 73 74 0a 09 09 09 pecific test....
2740: 22 2d 63 6f 6e 66 69 67 22 20 20 20 20 3b 3b 20 "-config" ;;
2750: 6f 76 65 72 72 69 64 65 20 74 68 65 20 63 6f 6e override the con
2760: 66 69 67 20 66 69 6c 65 20 6e 61 6d 65 0a 09 09 fig file name...
2770: 09 22 2d 65 78 65 63 75 74 65 22 20 20 20 3b 3b ."-execute" ;;
2780: 20 72 75 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 run the command
2790: 20 65 6e 63 6f 64 65 64 20 69 6e 20 74 68 65 20 encoded in the
27a0: 62 61 73 65 36 34 20 70 61 72 61 6d 65 74 65 72 base64 parameter
27b0: 0a 09 09 09 22 2d 73 74 65 70 22 0a 09 09 09 22 ...."-step"...."
27c0: 2d 74 61 72 67 65 74 22 0a 09 09 09 22 2d 72 65 -target"...."-re
27d0: 71 74 61 72 67 22 0a 09 09 09 22 3a 72 75 6e 6e qtarg"....":runn
27e0: 61 6d 65 22 0a 09 09 09 22 2d 72 75 6e 6e 61 6d ame"...."-runnam
27f0: 65 22 0a 09 09 09 22 3a 73 74 61 74 65 22 20 20 e"....":state"
2800: 0a 09 09 09 22 2d 73 74 61 74 65 22 0a 09 09 09 ...."-state"....
2810: 22 3a 73 74 61 74 75 73 22 0a 09 09 09 22 2d 73 ":status"...."-s
2820: 74 61 74 75 73 22 0a 09 09 09 22 2d 6c 69 73 74 tatus"...."-list
2830: 2d 72 75 6e 73 22 0a 09 09 09 22 2d 74 65 73 74 -runs"...."-test
2840: 70 61 74 74 22 20 0a 09 09 09 22 2d 69 74 65 6d patt" ...."-item
2850: 70 61 74 74 22 0a 09 09 09 22 2d 73 65 74 6c 6f patt"...."-setlo
2860: 67 22 0a 09 09 09 22 2d 73 65 74 2d 74 6f 70 6c g"...."-set-topl
2870: 6f 67 22 0a 09 09 09 22 2d 72 75 6e 73 74 65 70 og"...."-runstep
2880: 22 0a 09 09 09 22 2d 6c 6f 67 70 72 6f 22 0a 09 "...."-logpro"..
2890: 09 09 22 2d 6d 22 0a 09 09 09 22 2d 72 65 72 75 .."-m"...."-reru
28a0: 6e 22 0a 09 09 09 22 2d 64 61 79 73 22 0a 09 09 n"...."-days"...
28b0: 09 22 2d 72 65 6e 61 6d 65 2d 72 75 6e 22 0a 09 ."-rename-run"..
28c0: 09 09 22 2d 74 6f 22 0a 09 09 09 3b 3b 20 76 61 .."-to"....;; va
28d0: 6c 75 65 73 20 61 6e 64 20 6d 65 73 73 61 67 65 lues and message
28e0: 73 0a 09 09 09 22 3a 63 61 74 65 67 6f 72 79 22 s....":category"
28f0: 0a 09 09 09 22 3a 76 61 72 69 61 62 6c 65 22 0a ....":variable".
2900: 09 09 09 22 3a 76 61 6c 75 65 22 0a 09 09 09 22 ...":value"...."
2910: 3a 65 78 70 65 63 74 65 64 22 0a 09 09 09 22 3a :expected"....":
2920: 74 6f 6c 22 0a 09 09 09 22 3a 75 6e 69 74 73 22 tol"....":units"
2930: 0a 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 09 22 ....;; misc...."
2940: 2d 73 74 61 72 74 2d 64 69 72 22 0a 09 09 09 22 -start-dir"...."
2950: 2d 73 65 72 76 65 72 22 0a 09 09 09 22 2d 73 74 -server"...."-st
2960: 6f 70 2d 73 65 72 76 65 72 22 0a 09 09 09 22 2d op-server"...."-
2970: 74 72 61 6e 73 70 6f 72 74 22 0a 09 09 09 22 2d transport"...."-
2980: 6b 69 6c 6c 2d 73 65 72 76 65 72 22 0a 09 09 09 kill-server"....
2990: 22 2d 70 6f 72 74 22 0a 09 09 09 22 2d 65 78 74 "-port"...."-ext
29a0: 72 61 63 74 2d 6f 64 73 22 0a 09 09 09 22 2d 70 ract-ods"...."-p
29b0: 61 74 68 6d 6f 64 22 0a 09 09 09 22 2d 65 6e 76 athmod"...."-env
29c0: 32 66 69 6c 65 22 0a 09 09 09 22 2d 65 6e 76 63 2file"...."-envc
29d0: 61 70 22 0a 09 09 09 22 2d 65 6e 76 64 65 6c 74 ap"...."-envdelt
29e0: 61 22 0a 09 09 09 22 2d 73 65 74 76 61 72 73 22 a"...."-setvars"
29f0: 0a 09 09 09 22 2d 73 65 74 2d 73 74 61 74 65 2d ...."-set-state-
2a00: 73 74 61 74 75 73 22 0a 09 09 09 22 2d 73 65 74 status"...."-set
2a10: 2d 72 75 6e 2d 73 74 61 74 75 73 22 0a 09 09 09 -run-status"....
2a20: 22 2d 64 65 62 75 67 22 20 3b 3b 20 66 6f 72 20 "-debug" ;; for
2a30: 2a 76 65 72 62 6f 73 69 74 79 2a 20 3e 20 32 0a *verbosity* > 2.
2a40: 09 09 09 22 2d 63 72 65 61 74 65 2d 74 65 73 74 ..."-create-test
2a50: 22 0a 09 09 09 22 2d 6f 76 65 72 72 69 64 65 2d "...."-override-
2a60: 74 69 6d 65 6f 75 74 22 0a 09 09 09 22 2d 74 65 timeout"...."-te
2a70: 73 74 2d 66 69 6c 65 73 22 20 20 3b 3b 20 2d 74 st-files" ;; -t
2a80: 65 73 74 2d 70 61 74 68 73 20 69 73 20 66 6f 72 est-paths is for
2a90: 20 6c 69 73 74 69 6e 67 20 61 6c 6c 0a 09 09 09 listing all....
2aa0: 22 2d 6c 6f 61 64 22 20 20 20 20 20 20 20 20 3b "-load" ;
2ab0: 3b 20 6c 6f 61 64 20 61 6e 64 20 65 78 65 63 74 ; load and exect
2ac0: 75 74 65 20 61 20 73 63 68 65 6d 65 20 66 69 6c ute a scheme fil
2ad0: 65 0a 09 09 09 22 2d 73 65 63 74 69 6f 6e 22 0a e...."-section".
2ae0: 09 09 09 22 2d 76 61 72 22 0a 09 09 09 22 2d 64 ..."-var"...."-d
2af0: 75 6d 70 6d 6f 64 65 22 0a 09 09 09 22 2d 72 75 umpmode"...."-ru
2b00: 6e 2d 69 64 22 0a 09 09 09 22 2d 70 69 6e 67 22 n-id"...."-ping"
2b10: 0a 09 09 09 22 2d 72 65 66 64 62 32 64 61 74 22 ...."-refdb2dat"
2b20: 0a 09 09 09 22 2d 6f 22 0a 09 09 09 22 2d 6c 6f ...."-o"...."-lo
2b30: 67 22 0a 09 09 09 22 2d 61 72 63 68 69 76 65 22 g"...."-archive"
2b40: 0a 09 09 09 22 2d 73 69 6e 63 65 22 0a 09 09 09 ...."-since"....
2b50: 22 2d 66 69 65 6c 64 73 22 0a 09 09 09 22 2d 72 "-fields"...."-r
2b60: 65 63 6f 76 65 72 2d 74 65 73 74 22 20 3b 3b 20 ecover-test" ;;
2b70: 72 75 6e 2d 69 64 2c 74 65 73 74 2d 69 64 20 2d run-id,test-id -
2b80: 20 75 73 65 64 20 69 6e 74 65 72 6e 61 6c 6c 79 used internally
2b90: 20 74 6f 20 72 65 63 6f 76 65 72 20 61 20 74 65 to recover a te
2ba0: 73 74 20 73 74 75 63 6b 20 69 6e 20 52 55 4e 4e st stuck in RUNN
2bb0: 49 4e 47 20 73 74 61 74 65 0a 09 09 09 22 2d 73 ING state...."-s
2bc0: 6f 72 74 22 0a 09 09 09 22 2d 74 61 72 67 65 74 ort"...."-target
2bd0: 2d 64 62 22 0a 09 09 09 22 2d 73 6f 75 72 63 65 -db"...."-source
2be0: 2d 64 62 22 0a 09 09 09 29 0a 20 09 09 20 28 6c -db"....). .. (l
2bf0: 69 73 74 20 20 22 2d 68 22 20 22 2d 68 65 6c 70 ist "-h" "-help
2c00: 22 20 22 2d 2d 68 65 6c 70 22 0a 09 09 09 22 2d " "--help"...."-
2c10: 6d 61 6e 75 61 6c 22 0a 09 09 09 22 2d 76 65 72 manual"...."-ver
2c20: 73 69 6f 6e 22 0a 09 09 20 20 20 20 20 20 20 20 sion"...
2c30: 22 2d 66 6f 72 63 65 22 0a 09 09 20 20 20 20 20 "-force"...
2c40: 20 20 20 22 2d 78 74 65 72 6d 22 0a 09 09 20 20 "-xterm"...
2c50: 20 20 20 20 20 20 22 2d 73 68 6f 77 6b 65 79 73 "-showkeys
2c60: 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d 73 68 "... "-sh
2c70: 6f 77 2d 6b 65 79 73 22 0a 09 09 20 20 20 20 20 ow-keys"...
2c80: 20 20 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 "-test-status
2c90: 22 0a 09 09 09 22 2d 73 65 74 2d 76 61 6c 75 65 "...."-set-value
2ca0: 73 22 0a 09 09 09 22 2d 6c 6f 61 64 2d 74 65 73 s"...."-load-tes
2cb0: 74 2d 64 61 74 61 22 0a 09 09 09 22 2d 73 75 6d t-data"...."-sum
2cc0: 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 0a 09 09 marize-items"...
2cd0: 20 20 20 20 20 20 20 20 22 2d 67 75 69 22 0a 09 "-gui"..
2ce0: 09 09 22 2d 64 61 65 6d 6f 6e 69 7a 65 22 0a 09 .."-daemonize"..
2cf0: 09 09 22 2d 70 72 65 63 6c 65 61 6e 22 0a 09 09 .."-preclean"...
2d00: 09 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 22 0a ."-rerun-clean".
2d10: 09 09 09 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 0a ..."-rerun-all".
2d20: 09 09 09 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 ..."-clean-cache
2d30: 22 0a 09 09 09 22 2d 63 61 63 68 65 2d 64 62 22 "...."-cache-db"
2d40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2d50: 20 20 20 20 20 20 20 20 20 22 2d 75 73 65 2d 64 "-use-d
2d60: 62 2d 63 61 63 68 65 22 0a 09 09 09 3b 3b 20 6d b-cache"....;; m
2d70: 69 73 63 0a 09 09 09 22 2d 72 65 70 6c 22 0a 09 isc...."-repl"..
2d80: 09 09 22 2d 6c 6f 63 6b 22 0a 09 09 09 22 2d 75 .."-lock"...."-u
2d90: 6e 6c 6f 63 6b 22 0a 09 09 09 22 2d 6c 69 73 74 nlock"...."-list
2da0: 2d 73 65 72 76 65 72 73 22 0a 20 20 20 20 20 20 -servers".
2db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2dc0: 20 20 22 2d 72 75 6e 2d 77 61 69 74 22 20 20 20 "-run-wait"
2dd0: 20 20 20 3b 3b 20 77 61 69 74 20 6f 6e 20 61 20 ;; wait on a
2de0: 72 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 run to complete
2df0: 28 69 2e 65 2e 20 6e 6f 20 52 55 4e 4e 49 4e 47 (i.e. no RUNNING
2e00: 29 0a 09 09 09 22 2d 6c 6f 63 61 6c 22 20 20 20 )...."-local"
2e10: 20 20 20 20 20 20 3b 3b 20 72 75 6e 20 73 6f 6d ;; run som
2e20: 65 20 63 6f 6d 6d 61 6e 64 73 20 75 73 69 6e 67 e commands using
2e30: 20 6c 6f 63 61 6c 20 64 62 20 61 63 63 65 73 73 local db access
2e40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2e50: 20 20 20 20 20 20 20 20 20 22 2d 67 65 6e 65 72 "-gener
2e60: 61 74 65 2d 68 74 6d 6c 22 0a 0a 09 09 09 3b 3b ate-html".....;;
2e70: 20 6d 69 73 63 20 71 75 65 72 69 65 73 0a 09 09 misc queries...
2e80: 09 22 2d 6c 69 73 74 2d 64 69 73 6b 73 22 0a 09 ."-list-disks"..
2e90: 09 09 22 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 .."-list-targets
2ea0: 22 0a 09 09 09 22 2d 6c 69 73 74 2d 64 62 2d 74 "...."-list-db-t
2eb0: 61 72 67 65 74 73 22 0a 09 09 09 22 2d 73 68 6f argets"...."-sho
2ec0: 77 2d 72 75 6e 63 6f 6e 66 69 67 22 0a 09 09 09 w-runconfig"....
2ed0: 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 22 0a 09 "-show-config"..
2ee0: 09 09 22 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 6f .."-show-cmdinfo
2ef0: 22 0a 09 09 09 22 2d 67 65 74 2d 72 75 6e 2d 73 "...."-get-run-s
2f00: 74 61 74 75 73 22 0a 0a 09 09 09 3b 3b 20 71 75 tatus".....;; qu
2f10: 65 72 69 65 73 0a 09 09 09 22 2d 74 65 73 74 2d eries...."-test-
2f20: 70 61 74 68 73 22 20 3b 3b 20 67 65 74 20 70 61 paths" ;; get pa
2f30: 74 68 28 73 29 20 74 6f 20 61 20 74 65 73 74 2c th(s) to a test,
2f40: 20 6f 72 64 65 72 65 64 20 62 79 20 79 6f 75 6e ordered by youn
2f50: 67 65 73 74 20 66 69 72 73 74 0a 0a 09 09 09 22 gest first....."
2f60: 2d 72 75 6e 61 6c 6c 22 20 20 20 20 3b 3b 20 72 -runall" ;; r
2f70: 75 6e 20 61 6c 6c 20 74 65 73 74 73 2c 20 72 65 un all tests, re
2f80: 73 70 65 63 74 73 20 2d 74 65 73 74 70 61 74 74 spects -testpatt
2f90: 2c 20 64 65 66 61 75 6c 74 73 20 74 6f 20 25 0a , defaults to %.
2fa0: 09 09 09 22 2d 72 75 6e 22 20 20 20 20 20 20 20 ..."-run"
2fb0: 3b 3b 20 61 6c 69 61 73 20 66 6f 72 20 2d 72 75 ;; alias for -ru
2fc0: 6e 61 6c 6c 0a 09 09 09 22 2d 72 65 6d 6f 76 65 nall...."-remove
2fd0: 2d 72 75 6e 73 22 0a 09 09 09 22 2d 72 65 62 75 -runs"...."-rebu
2fe0: 69 6c 64 2d 64 62 22 0a 09 09 09 22 2d 63 6c 65 ild-db"...."-cle
2ff0: 61 6e 75 70 2d 64 62 22 0a 09 09 09 22 2d 72 6f anup-db"...."-ro
3000: 6c 6c 75 70 22 0a 09 09 09 22 2d 75 70 64 61 74 llup"...."-updat
3010: 65 2d 6d 65 74 61 22 0a 09 09 09 22 2d 63 72 65 e-meta"...."-cre
3020: 61 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 ate-megatest-are
3030: 61 22 0a 09 09 09 22 2d 6d 61 72 6b 2d 69 6e 63 a"...."-mark-inc
3040: 6f 6d 70 6c 65 74 65 73 22 0a 0a 09 09 09 22 2d ompletes"....."-
3050: 63 6f 6e 76 65 72 74 2d 74 6f 2d 6e 6f 72 6d 22 convert-to-norm"
3060: 0a 09 09 09 22 2d 63 6f 6e 76 65 72 74 2d 74 6f ...."-convert-to
3070: 2d 6f 6c 64 22 0a 09 09 09 22 2d 69 6d 70 6f 72 -old"...."-impor
3080: 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 0a 09 t-megatest.db"..
3090: 09 09 22 2d 73 79 6e 63 2d 74 6f 2d 6d 65 67 61 .."-sync-to-mega
30a0: 74 65 73 74 2e 64 62 22 0a 0a 09 09 09 22 2d 6c test.db"....."-l
30b0: 6f 67 67 69 6e 67 22 0a 09 09 09 22 2d 76 22 20 ogging"...."-v"
30c0: 3b 3b 20 76 65 72 62 6f 73 65 20 32 2c 20 6d 6f ;; verbose 2, mo
30d0: 72 65 20 74 68 61 6e 20 6e 6f 72 6d 61 6c 20 28 re than normal (
30e0: 6e 6f 72 6d 61 6c 20 69 73 20 31 29 0a 09 09 09 normal is 1)....
30f0: 22 2d 71 22 20 3b 3b 20 71 75 69 65 74 20 30 2c "-q" ;; quiet 0,
3100: 20 65 72 72 6f 72 73 2f 77 61 72 6e 69 6e 67 73 errors/warnings
3110: 20 6f 6e 6c 79 0a 09 09 20 20 20 20 20 20 20 29 only... )
3120: 0a 09 09 20 61 72 67 73 3a 61 72 67 2d 68 61 73 ... args:arg-has
3130: 68 0a 09 09 20 30 29 29 0a 0a 3b 3b 20 41 64 64 h... 0))..;; Add
3140: 20 61 72 67 73 20 74 68 61 74 20 75 73 65 20 72 args that use r
3150: 65 6d 61 72 67 73 20 68 65 72 65 0a 3b 3b 0a 28 emargs here.;;.(
3160: 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 6e 75 if (and (not (nu
3170: 6c 6c 3f 20 72 65 6d 61 72 67 73 29 29 0a 09 20 ll? remargs))..
3180: 28 6e 6f 74 20 28 6f 72 0a 09 20 20 20 20 20 20 (not (or..
3190: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
31a0: 2d 72 75 6e 73 74 65 70 22 29 0a 09 20 20 20 20 -runstep")..
31b0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
31c0: 20 22 2d 65 6e 76 63 61 70 22 29 0a 09 20 20 20 "-envcap")..
31d0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
31e0: 67 20 22 2d 65 6e 76 64 65 6c 74 61 22 29 0a 09 g "-envdelta")..
31f0: 20 20 20 20 20 20 20 29 0a 09 20 20 20 20 20 20 )..
3200: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
3210: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
3220: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
3230: 55 6e 72 65 63 6f 67 6e 69 73 65 64 20 61 72 67 Unrecognised arg
3240: 75 6d 65 6e 74 73 3a 20 22 20 28 73 74 72 69 6e uments: " (strin
3250: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 69 g-intersperse (i
3260: 66 20 28 6c 69 73 74 3f 20 72 65 6d 61 72 67 73 f (list? remargs
3270: 29 20 72 65 6d 61 72 67 73 20 28 61 72 67 76 29 ) remargs (argv)
3280: 29 20 20 22 20 22 29 29 29 0a 0a 3b 3b 20 69 6d ) " ")))..;; im
3290: 6d 65 64 69 61 74 65 6c 79 20 73 65 74 20 4d 54 mediately set MT
32a0: 5f 54 41 52 47 45 54 20 69 66 20 2d 72 65 71 74 _TARGET if -reqt
32b0: 61 72 67 20 6f 72 20 2d 74 61 72 67 65 74 20 61 arg or -target a
32c0: 72 65 20 61 76 61 69 6c 61 62 6c 65 0a 3b 3b 0a re available.;;.
32d0: 28 6c 65 74 20 28 28 74 61 72 67 20 28 6f 72 20 (let ((targ (or
32e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
32f0: 72 65 71 74 61 72 67 22 29 28 61 72 67 73 3a 67 reqtarg")(args:g
3300: 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 et-arg "-target"
3310: 29 29 29 29 0a 20 20 28 69 66 20 74 61 72 67 20 )))). (if targ
3320: 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 (setenv "MT_TARG
3330: 45 54 22 20 74 61 72 67 29 29 29 0a 0a 3b 3b 20 ET" targ)))..;;
3340: 54 68 65 20 77 61 74 63 68 64 6f 67 20 69 73 20 The watchdog is
3350: 74 6f 20 6b 65 65 70 20 61 6e 20 65 79 65 20 6f to keep an eye o
3360: 6e 20 74 68 69 6e 67 73 20 6c 69 6b 65 20 64 62 n things like db
3370: 20 73 79 6e 63 20 65 74 63 2e 0a 3b 3b 0a 28 64 sync etc..;;.(d
3380: 65 66 69 6e 65 20 2a 77 61 74 63 68 64 6f 67 2a efine *watchdog*
3390: 0a 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 . (make-thread
33a0: 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 . (lambda ().
33b0: 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 (thread-slee
33c0: 70 21 20 30 2e 30 35 29 20 3b 3b 20 64 65 6c 61 p! 0.05) ;; dela
33d0: 79 20 66 6f 72 20 73 74 61 72 74 75 70 0a 20 20 y for startup.
33e0: 20 20 20 28 6c 65 74 20 28 28 6c 65 67 61 63 79 (let ((legacy
33f0: 2d 73 79 6e 63 20 28 63 6f 6d 6d 6f 6e 3a 6c 65 -sync (common:le
3400: 67 61 63 79 2d 73 79 6e 63 2d 72 65 71 75 69 72 gacy-sync-requir
3410: 65 64 29 29 0a 09 20 20 20 28 64 65 62 75 67 2d ed)).. (debug-
3420: 6d 6f 64 65 20 20 28 64 65 62 75 67 3a 64 65 62 mode (debug:deb
3430: 75 67 2d 6d 6f 64 65 20 31 29 29 0a 09 20 20 20 ug-mode 1))..
3440: 28 6c 61 73 74 2d 74 69 6d 65 20 20 20 28 63 75 (last-time (cu
3450: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 rrent-seconds)))
3460: 0a 20 20 20 20 20 20 20 28 69 66 20 28 63 6f 6d . (if (com
3470: 6d 6f 6e 3a 6c 65 67 61 63 79 2d 73 79 6e 63 2d mon:legacy-sync-
3480: 72 65 63 6f 6d 6d 65 6e 64 65 64 29 0a 09 20 20 recommended)..
3490: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 29 0a 09 20 (let loop ()..
34a0: 20 20 20 20 3b 3b 20 73 79 6e 63 20 66 6f 72 20 ;; sync for
34b0: 66 69 6c 65 73 79 73 74 65 6d 20 6c 6f 63 61 6c filesystem local
34c0: 20 64 62 20 77 72 69 74 65 73 0a 09 20 20 20 20 db writes..
34d0: 20 3b 3b 0a 20 20 20 20 20 20 20 20 20 20 20 20 ;;.
34e0: 20 28 6c 65 74 20 28 28 73 74 61 72 74 2d 74 69 (let ((start-ti
34f0: 6d 65 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 me (current-se
3500: 63 6f 6e 64 73 29 29 29 0a 20 20 20 20 20 20 20 conds))).
3510: 20 20 20 20 20 20 20 20 3b 3b 20 64 69 73 61 62 ;; disab
3520: 6c 69 6e 67 20 66 6f 72 20 6e 6f 77 20 28 69 66 ling for now (if
3530: 20 6c 65 67 61 63 79 2d 73 79 6e 63 20 28 63 6f legacy-sync (co
3540: 6d 6d 6f 6e 3a 73 79 6e 63 2d 74 6f 2d 6d 65 67 mmon:sync-to-meg
3550: 61 74 65 73 74 2e 64 62 20 23 66 29 29 0a 09 20 atest.db #f))..
3560: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 64 (if (and d
3570: 65 62 75 67 2d 6d 6f 64 65 0a 09 09 09 28 3e 20 ebug-mode....(>
3580: 28 2d 20 73 74 61 72 74 2d 74 69 6d 65 20 6c 61 (- start-time la
3590: 73 74 2d 74 69 6d 65 29 20 36 30 29 29 0a 09 09 st-time) 60))...
35a0: 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 (begin...
35b0: 20 28 73 65 74 21 20 6c 61 73 74 2d 74 69 6d 65 (set! last-time
35c0: 20 73 74 61 72 74 2d 74 69 6d 65 29 0a 09 09 20 start-time)...
35d0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
35e0: 2d 69 6e 66 6f 20 34 20 2a 64 65 66 61 75 6c 74 -info 4 *default
35f0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 74 69 6d 65 -log-port* "time
3600: 73 74 61 6d 70 20 2d 3e 20 22 20 28 73 65 63 6f stamp -> " (seco
3610: 6e 64 73 2d 3e 74 69 6d 65 2d 73 74 72 69 6e 67 nds->time-string
3620: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
3630: 73 29 29 20 22 2c 20 74 69 6d 65 20 73 69 6e 63 s)) ", time sinc
3640: 65 20 73 74 61 72 74 20 2d 3e 20 22 20 28 73 65 e start -> " (se
3650: 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e 2d 73 65 conds->hr-min-se
3660: 63 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 c (- (current-se
3670: 63 6f 6e 64 73 29 20 2a 74 69 6d 65 2d 7a 65 72 conds) *time-zer
3680: 6f 2a 29 29 29 29 29 29 0a 09 20 20 20 20 20 0a o*)))))).. .
3690: 09 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 67 6f . ;; keep go
36a0: 69 6e 67 20 75 6e 6c 65 73 73 20 74 69 6d 65 20 ing unless time
36b0: 74 6f 20 65 78 69 74 0a 09 20 20 20 20 20 3b 3b to exit.. ;;
36c0: 0a 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 .. (if (not
36d0: 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a 29 0a *time-to-exit*).
36e0: 09 09 20 28 6c 65 74 20 64 65 6c 61 79 2d 6c 6f .. (let delay-lo
36f0: 6f 70 20 28 28 63 6f 75 6e 74 20 30 29 29 0a 09 op ((count 0))..
3700: 09 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f . (if (and (no
3710: 74 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a t *time-to-exit*
3720: 29 0a 09 09 09 20 20 20 20 28 3c 20 63 6f 75 6e ).... (< coun
3730: 74 20 31 31 29 29 20 3b 3b 20 61 70 72 6f 78 20 t 11)) ;; aprox
3740: 35 2d 36 20 73 65 63 6f 6e 64 73 0a 09 09 20 20 5-6 seconds...
3750: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 20 (begin....
3760: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 (thread-sleep! 1
3770: 29 0a 09 09 09 20 28 64 65 6c 61 79 2d 6c 6f 6f ).... (delay-loo
3780: 70 20 28 2b 20 63 6f 75 6e 74 20 31 29 29 29 29 p (+ count 1))))
3790: 0a 09 09 20 20 20 28 6c 6f 6f 70 29 29 29 0a 09 ... (loop)))..
37a0: 20 20 20 20 20 28 69 66 20 28 63 6f 6d 6d 6f 6e (if (common
37b0: 3a 6c 6f 77 2d 6e 6f 69 73 65 2d 70 72 69 6e 74 :low-noise-print
37c0: 20 33 30 29 0a 09 09 20 28 64 65 62 75 67 3a 70 30)... (debug:p
37d0: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
37e0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
37f0: 45 78 69 74 69 6e 67 20 77 61 74 63 68 64 6f 67 Exiting watchdog
3800: 20 74 69 6d 65 72 2c 20 2a 74 69 6d 65 2d 74 6f timer, *time-to
3810: 2d 65 78 69 74 2a 20 3d 20 22 20 2a 74 69 6d 65 -exit* = " *time
3820: 2d 74 6f 2d 65 78 69 74 2a 29 29 29 29 29 0a 20 -to-exit*))))).
3830: 20 20 20 20 22 57 61 74 63 68 64 6f 67 20 74 68 "Watchdog th
3840: 72 65 61 64 22 29 29 29 0a 0a 28 74 68 72 65 61 read")))..(threa
3850: 64 2d 73 74 61 72 74 21 20 2a 77 61 74 63 68 64 d-start! *watchd
3860: 6f 67 2a 29 0a 0a 28 69 66 20 28 61 72 67 73 3a og*)..(if (args:
3870: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 0a get-arg "-log").
3880: 20 20 20 20 28 6c 65 74 20 28 28 6f 75 70 20 28 (let ((oup (
3890: 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 open-output-file
38a0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
38b0: 2d 6c 6f 67 22 29 29 29 29 0a 20 20 20 20 20 20 -log")))).
38c0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
38d0: 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 0 *default-log
38e0: 2d 70 6f 72 74 2a 20 22 53 65 6e 64 69 6e 67 20 -port* "Sending
38f0: 6c 6f 67 20 6f 75 74 70 75 74 20 74 6f 20 22 20 log output to "
3900: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3910: 6c 6f 67 22 29 29 0a 20 20 20 20 20 20 28 73 65 log")). (se
3920: 74 21 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d t! *default-log-
3930: 70 6f 72 74 2a 20 6f 75 70 29 29 29 0a 0a 28 69 port* oup)))..(i
3940: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
3950: 61 72 67 20 22 2d 68 22 29 0a 09 28 61 72 67 73 arg "-h")..(args
3960: 3a 67 65 74 2d 61 72 67 20 22 2d 68 65 6c 70 22 :get-arg "-help"
3970: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
3980: 20 22 2d 2d 68 65 6c 70 22 29 29 0a 20 20 20 20 "--help")).
3990: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 (begin. (pr
39a0: 69 6e 74 20 68 65 6c 70 29 0a 20 20 20 20 20 20 int help).
39b0: 28 65 78 69 74 29 29 29 0a 0a 28 69 66 20 28 61 (exit)))..(if (a
39c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 61 rgs:get-arg "-ma
39d0: 6e 75 61 6c 22 29 0a 20 20 20 20 28 6c 65 74 2a nual"). (let*
39e0: 20 28 28 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 ((htmlviewercmd
39f0: 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f (or (configf:lo
3a00: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
3a10: 20 22 73 65 74 75 70 22 20 22 68 74 6d 6c 76 69 "setup" "htmlvi
3a20: 65 77 65 72 63 6d 64 22 29 0a 09 09 09 20 20 20 ewercmd")....
3a30: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 77 68 69 63 68 (common:which
3a40: 20 27 28 22 66 69 72 65 66 6f 78 22 20 22 61 72 '("firefox" "ar
3a50: 6f 72 61 22 29 29 29 29 0a 09 20 20 20 28 69 6e ora")))).. (in
3a60: 73 74 61 6c 6c 2d 68 6f 6d 65 20 20 28 63 6f 6d stall-home (com
3a70: 6d 6f 6e 3a 67 65 74 2d 69 6e 73 74 61 6c 6c 2d mon:get-install-
3a80: 61 72 65 61 29 29 0a 09 20 20 20 28 6d 61 6e 75 area)).. (manu
3a90: 61 6c 2d 68 74 6d 6c 20 20 20 28 63 6f 6e 63 20 al-html (conc
3aa0: 69 6e 73 74 61 6c 6c 2d 68 6f 6d 65 20 22 2f 73 install-home "/s
3ab0: 68 61 72 65 2f 64 6f 63 73 2f 6d 65 67 61 74 65 hare/docs/megate
3ac0: 73 74 5f 6d 61 6e 75 61 6c 2e 68 74 6d 6c 22 29 st_manual.html")
3ad0: 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 61 6e )). (if (an
3ae0: 64 20 69 6e 73 74 61 6c 6c 2d 68 6f 6d 65 0a 09 d install-home..
3af0: 20 20 20 20 20 20 20 28 66 69 6c 65 2d 65 78 69 (file-exi
3b00: 73 74 73 3f 20 6d 61 6e 75 61 6c 2d 68 74 6d 6c sts? manual-html
3b10: 29 29 0a 09 20 20 28 73 79 73 74 65 6d 20 28 63 )).. (system (c
3b20: 6f 6e 63 20 22 28 22 20 68 74 6d 6c 76 69 65 77 onc "(" htmlview
3b30: 65 72 63 6d 64 20 22 20 22 20 6d 61 6e 75 61 6c ercmd " " manual
3b40: 2d 68 74 6d 6c 20 22 20 29 20 26 22 29 29 0a 09 -html " ) &"))..
3b50: 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 (system (conc
3b60: 22 28 22 20 68 74 6d 6c 76 69 65 77 65 72 63 6d "(" htmlviewercm
3b70: 64 20 22 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b d " http://www.k
3b80: 69 61 74 6f 61 2e 63 6f 6d 2f 63 67 69 2d 62 69 iatoa.com/cgi-bi
3b90: 6e 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 n/fossils/megate
3ba0: 73 74 2f 64 6f 63 2f 74 69 70 2f 64 6f 63 73 2f st/doc/tip/docs/
3bb0: 6d 61 6e 75 61 6c 2f 6d 65 67 61 74 65 73 74 5f manual/megatest_
3bc0: 6d 61 6e 75 61 6c 2e 68 74 6d 6c 20 29 20 26 22 manual.html ) &"
3bd0: 29 29 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 ))). (exit)
3be0: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
3bf0: 74 2d 61 72 67 20 22 2d 73 74 61 72 74 2d 64 69 t-arg "-start-di
3c00: 72 22 29 0a 20 20 20 20 28 69 66 20 28 66 69 6c r"). (if (fil
3c10: 65 2d 65 78 69 73 74 73 3f 20 28 61 72 67 73 3a e-exists? (args:
3c20: 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 74 2d get-arg "-start-
3c30: 64 69 72 22 29 29 0a 09 28 63 68 61 6e 67 65 2d dir"))..(change-
3c40: 64 69 72 65 63 74 6f 72 79 20 28 61 72 67 73 3a directory (args:
3c50: 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 74 2d get-arg "-start-
3c60: 64 69 72 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 dir"))..(begin..
3c70: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
3c80: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
3c90: 6c 6f 67 2d 70 6f 72 74 2a 20 22 6e 6f 6e 2d 65 log-port* "non-e
3ca0: 78 69 73 74 61 6e 74 20 73 74 61 72 74 20 64 69 xistant start di
3cb0: 72 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 r " (args:get-ar
3cc0: 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 20 g "-start-dir")
3cd0: 22 20 73 70 65 63 69 66 69 65 64 2c 20 65 78 69 " specified, exi
3ce0: 74 69 6e 67 2e 22 29 0a 09 20 20 28 65 78 69 74 ting.").. (exit
3cf0: 20 31 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 1))))..(if (arg
3d00: 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 65 72 73 s:get-arg "-vers
3d10: 69 6f 6e 22 29 0a 20 20 20 20 28 62 65 67 69 6e ion"). (begin
3d20: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 28 63 . (print (c
3d30: 6f 6d 6d 6f 6e 3a 76 65 72 73 69 6f 6e 2d 73 69 ommon:version-si
3d40: 67 6e 61 74 75 72 65 29 29 20 3b 3b 20 28 70 72 gnature)) ;; (pr
3d50: 69 6e 74 20 6d 65 67 61 74 65 73 74 2d 76 65 72 int megatest-ver
3d60: 73 69 6f 6e 29 0a 20 20 20 20 20 20 28 65 78 69 sion). (exi
3d70: 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 t)))..(define *d
3d80: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 66 29 idsomething* #f)
3d90: 0a 0a 3b 3b 20 4f 76 65 72 61 6c 6c 20 65 78 69 ..;; Overall exi
3da0: 74 20 68 61 6e 64 6c 69 6e 67 20 73 65 74 75 70 t handling setup
3db0: 20 69 6d 6d 65 64 69 61 74 65 6c 79 0a 3b 3b 0a immediately.;;.
3dc0: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
3dd0: 74 2d 61 72 67 20 22 2d 70 72 6f 63 65 73 73 2d t-arg "-process-
3de0: 72 65 61 70 22 29 29 0a 20 20 20 20 20 20 20 20 reap")).
3df0: 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ;; (args:get-arg
3e00: 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 3b "-runtests")..;
3e10: 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ; (args:get-arg
3e20: 22 2d 65 78 65 63 75 74 65 22 29 0a 09 3b 3b 20 "-execute")..;;
3e30: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3e40: 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a 09 3b remove-runs")..;
3e50: 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ; (args:get-arg
3e60: 22 2d 72 75 6e 73 74 65 70 22 29 29 0a 20 20 20 "-runstep")).
3e70: 20 28 6c 65 74 20 28 28 6f 72 69 67 69 6e 61 6c (let ((original
3e80: 2d 65 78 69 74 20 28 65 78 69 74 2d 68 61 6e 64 -exit (exit-hand
3e90: 6c 65 72 29 29 29 0a 20 20 20 20 20 20 28 65 78 ler))). (ex
3ea0: 69 74 2d 68 61 6e 64 6c 65 72 20 28 6c 61 6d 62 it-handler (lamb
3eb0: 64 61 20 28 23 21 6f 70 74 69 6f 6e 61 6c 20 28 da (#!optional (
3ec0: 65 78 69 74 2d 63 6f 64 65 20 30 29 29 0a 09 09 exit-code 0))...
3ed0: 20 20 20 20 20 20 28 70 72 69 6e 74 66 20 22 50 (printf "P
3ee0: 72 65 70 61 72 69 6e 67 20 74 6f 20 65 78 69 74 reparing to exit
3ef0: 20 77 69 74 68 20 65 78 69 74 20 63 6f 64 65 20 with exit code
3f00: 7e 41 20 2e 2e 2e 5c 6e 22 20 65 78 69 74 2d 63 ~A ...\n" exit-c
3f10: 6f 64 65 29 0a 09 09 20 20 20 20 20 20 28 66 6f ode)... (fo
3f20: 72 2d 65 61 63 68 20 0a 09 09 20 20 20 20 20 20 r-each ...
3f30: 20 28 6c 61 6d 62 64 61 20 28 70 69 64 29 0a 09 (lambda (pid)..
3f40: 09 09 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 .. (handle-excep
3f50: 74 69 6f 6e 73 0a 09 09 09 20 20 65 78 6e 0a 09 tions.... exn..
3f60: 09 09 20 20 23 74 0a 09 09 09 20 20 28 6c 65 74 .. #t.... (let
3f70: 2d 76 61 6c 75 65 73 20 28 28 28 70 69 64 2d 76 -values (((pid-v
3f80: 61 6c 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 al exit-status e
3f90: 78 69 74 2d 63 6f 64 65 29 20 28 70 72 6f 63 65 xit-code) (proce
3fa0: 73 73 2d 77 61 69 74 20 70 69 64 20 23 74 29 29 ss-wait pid #t))
3fb0: 29 0a 09 09 09 09 20 20 20 20 20 20 28 69 66 20 )..... (if
3fc0: 28 6f 72 20 28 65 71 3f 20 70 69 64 2d 76 61 6c (or (eq? pid-val
3fd0: 20 70 69 64 29 0a 09 09 09 09 09 20 20 20 20 20 pid)......
3fe0: 20 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 (eq? pid-val 0)
3ff0: 29 0a 09 09 09 09 09 20 20 28 62 65 67 69 6e 0a )...... (begin.
4000: 09 09 09 09 09 20 20 20 20 28 70 72 69 6e 74 66 ..... (printf
4010: 20 22 53 65 6e 64 69 6e 67 20 73 69 67 6e 61 6c "Sending signal
4020: 2f 74 65 72 6d 20 74 6f 20 7e 41 5c 6e 22 20 70 /term to ~A\n" p
4030: 69 64 29 0a 09 09 09 09 09 20 20 20 20 28 70 72 id)...... (pr
4040: 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 69 64 ocess-signal pid
4050: 20 73 69 67 6e 61 6c 2f 74 65 72 6d 29 29 29 29 signal/term))))
4060: 29 29 0a 09 09 20 20 20 20 20 20 20 28 70 72 6f ))... (pro
4070: 63 65 73 73 3a 63 68 69 6c 64 72 65 6e 20 23 66 cess:children #f
4080: 29 29 0a 09 09 20 20 20 20 20 20 28 6f 72 69 67 ))... (orig
4090: 69 6e 61 6c 2d 65 78 69 74 20 65 78 69 74 2d 63 inal-exit exit-c
40a0: 6f 64 65 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d ode)))))..;;====
40b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40f0: 3d 3d 0a 3b 3b 20 4d 69 73 63 20 73 65 74 75 70 ==.;; Misc setup
4100: 20 73 74 75 66 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d stuff.;;=======
4110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
4150: 0a 28 64 65 62 75 67 3a 73 65 74 75 70 29 0a 0a .(debug:setup)..
4160: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
4170: 67 20 22 2d 6c 6f 67 67 69 6e 67 22 29 28 73 65 g "-logging")(se
4180: 74 21 20 2a 6c 6f 67 67 69 6e 67 2a 20 23 74 29 t! *logging* #t)
4190: 29 0a 0a 28 69 66 20 28 64 65 62 75 67 3a 64 65 )..(if (debug:de
41a0: 62 75 67 2d 6d 6f 64 65 20 33 29 20 3b 3b 20 77 bug-mode 3) ;; w
41b0: 65 20 61 72 65 20 6f 62 76 69 6f 75 73 6c 79 20 e are obviously
41c0: 64 65 62 75 67 67 69 6e 67 0a 20 20 20 20 28 73 debugging. (s
41d0: 65 74 21 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f et! open-run-clo
41e0: 73 65 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 se open-run-clos
41f0: 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e 2d 68 e-no-exception-h
4200: 61 6e 64 6c 69 6e 67 29 29 0a 0a 28 69 66 20 28 andling))..(if (
4210: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 args:get-arg "-i
4220: 74 65 6d 70 61 74 74 22 29 0a 20 20 20 20 28 6c tempatt"). (l
4230: 65 74 20 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e et ((newval (con
4240: 63 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 c (args:get-arg
4250: 22 2d 74 65 73 74 70 61 74 74 22 29 20 22 2f 22 "-testpatt") "/"
4260: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4270: 2d 69 74 65 6d 70 61 74 74 22 29 29 29 29 0a 20 -itempatt")))).
4280: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
4290: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
42a0: 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a -port* "WARNING:
42b0: 20 2d 69 74 65 6d 70 61 74 74 20 68 61 73 20 62 -itempatt has b
42c0: 65 65 6e 20 64 65 70 72 65 63 61 74 65 64 2c 20 een deprecated,
42d0: 70 6c 65 61 73 65 20 75 73 65 20 2d 74 65 73 74 please use -test
42e0: 70 61 74 74 20 74 65 73 74 70 61 74 74 2f 69 74 patt testpatt/it
42f0: 65 6d 70 61 74 74 20 6d 65 74 68 6f 64 2c 20 6e empatt method, n
4300: 65 77 20 74 65 73 74 70 61 74 74 20 69 73 20 22 ew testpatt is "
4310: 6e 65 77 76 61 6c 29 0a 20 20 20 20 20 20 28 68 newval). (h
4320: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 ash-table-set! a
4330: 72 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 74 rgs:arg-hash "-t
4340: 65 73 74 70 61 74 74 22 20 6e 65 77 76 61 6c 29 estpatt" newval)
4350: 0a 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 . (hash-tab
4360: 6c 65 2d 64 65 6c 65 74 65 21 20 61 72 67 73 3a le-delete! args:
4370: 61 72 67 2d 68 61 73 68 20 22 2d 69 74 65 6d 70 arg-hash "-itemp
4380: 61 74 74 22 29 29 29 0a 0a 28 69 66 20 28 61 72 att")))..(if (ar
4390: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
43a0: 74 65 73 74 73 22 29 0a 20 20 20 20 28 64 65 62 tests"). (deb
43b0: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
43c0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 ult-log-port* "W
43d0: 41 52 4e 49 4e 47 3a 20 5c 22 2d 72 75 6e 74 65 ARNING: \"-runte
43e0: 73 74 73 5c 22 20 69 73 20 64 65 70 72 65 63 61 sts\" is depreca
43f0: 74 65 64 2e 20 55 73 65 20 5c 22 2d 72 75 6e 5c ted. Use \"-run\
4400: 22 20 77 69 74 68 20 5c 22 2d 74 65 73 74 70 61 " with \"-testpa
4410: 74 74 5c 22 20 69 6e 73 74 65 61 64 22 29 29 0a tt\" instead")).
4420: 0a 28 6f 6e 2d 65 78 69 74 20 73 74 64 2d 65 78 .(on-exit std-ex
4430: 69 74 2d 70 72 6f 63 65 64 75 72 65 29 0a 0a 3b it-procedure)..;
4440: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
4450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4460: 3d 3d 3d 3d 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 0a 3b 3b 20 4d 69 73 63 20 =======.;; Misc
4490: 67 65 6e 65 72 61 6c 20 63 61 6c 6c 73 0a 3b 3b general calls.;;
44a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44e0: 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 6e 64 ======..(if (and
44f0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4500: 2d 63 61 63 68 65 2d 64 62 22 29 0a 20 20 20 20 -cache-db").
4510: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
4520: 72 67 20 22 2d 73 6f 75 72 63 65 2d 64 62 22 29 rg "-source-db")
4530: 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 ). (let* ((te
4540: 6d 70 2d 64 69 72 20 28 6f 72 20 28 61 72 67 73 mp-dir (or (args
4550: 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 :get-arg "-targe
4560: 74 2d 64 62 22 29 20 28 63 72 65 61 74 65 2d 64 t-db") (create-d
4570: 69 72 65 63 74 6f 72 79 20 28 63 6f 6e 63 20 22 irectory (conc "
4580: 2f 74 6d 70 2f 22 20 28 67 65 74 65 6e 76 20 22 /tmp/" (getenv "
4590: 55 53 45 52 22 29 20 22 2f 22 20 28 73 74 72 69 USER") "/" (stri
45a0: 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 28 63 75 ng-translate (cu
45b0: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
45c0: 20 22 2f 22 20 22 5f 22 29 29 29 29 29 0a 20 20 "/" "_"))))).
45d0: 20 20 20 20 20 20 20 20 20 28 74 61 72 67 65 74 (target
45e0: 2d 64 62 20 28 63 6f 6e 63 20 74 65 6d 70 2d 64 -db (conc temp-d
45f0: 69 72 20 22 2f 63 61 63 68 65 64 2e 64 62 22 29 ir "/cached.db")
4600: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 73 6f ). (so
4610: 75 72 63 65 2d 64 62 20 28 61 72 67 73 3a 67 65 urce-db (args:ge
4620: 74 2d 61 72 67 20 22 2d 73 6f 75 72 63 65 2d 64 t-arg "-source-d
4630: 62 22 29 29 29 20 20 20 20 20 20 20 20 0a 20 20 b"))) .
4640: 20 20 20 20 28 64 62 3a 63 61 63 68 65 2d 66 6f (db:cache-fo
4650: 72 2d 72 65 61 64 2d 6f 6e 6c 79 20 73 6f 75 72 r-read-only sour
4660: 63 65 2d 64 62 20 74 61 72 67 65 74 2d 64 62 29 ce-db target-db)
4670: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
4680: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
4690: 29 0a 0a 3b 3b 20 68 61 6e 64 6c 65 20 61 20 63 )..;; handle a c
46a0: 6c 65 61 6e 2d 63 61 63 68 65 20 72 65 71 75 65 lean-cache reque
46b0: 73 74 20 61 73 20 65 61 72 6c 79 20 61 73 20 70 st as early as p
46c0: 6f 73 73 69 62 6c 65 0a 3b 3b 0a 28 69 66 20 28 ossible.;;.(if (
46d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 args:get-arg "-c
46e0: 6c 65 61 6e 2d 63 61 63 68 65 22 29 0a 20 20 20 lean-cache").
46f0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 73 (begin. (s
4700: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
4710: 67 2a 20 23 74 29 20 3b 3b 20 73 75 70 70 72 65 g* #t) ;; suppre
4720: 73 73 20 74 68 65 20 68 65 6c 70 20 6f 75 74 70 ss the help outp
4730: 75 74 2e 0a 20 20 20 20 20 20 28 69 66 20 28 67 ut.. (if (g
4740: 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 etenv "MT_TARGET
4750: 22 29 20 3b 3b 20 6e 6f 20 70 6f 69 6e 74 20 69 ") ;; no point i
4760: 6e 20 74 72 79 69 6e 67 20 69 66 20 6e 6f 20 74 n trying if no t
4770: 61 72 67 65 74 0a 09 20 20 28 69 66 20 28 61 72 arget.. (if (ar
4780: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
4790: 6e 61 6d 65 22 29 0a 09 20 20 20 20 20 20 28 6c name").. (l
47a0: 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 20 28 et* ((toppath (
47b0: 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 launch:setup))..
47c0: 09 20 20 20 20 20 28 6c 69 6e 6b 74 72 65 65 20 . (linktree
47d0: 28 69 66 20 74 6f 70 70 61 74 68 20 28 63 6f 6e (if toppath (con
47e0: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e figf:lookup *con
47f0: 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 figdat* "setup"
4800: 22 6c 69 6e 6b 74 72 65 65 22 29 29 29 0a 09 09 "linktree")))...
4810: 20 20 20 20 20 28 72 75 6e 74 6f 70 20 20 20 28 (runtop (
4820: 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 22 2f conc linktree "/
4830: 22 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 41 " (getenv "MT_TA
4840: 52 47 45 54 22 29 20 22 2f 22 20 28 61 72 67 73 RGET") "/" (args
4850: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 :get-arg "-runna
4860: 6d 65 22 29 29 29 0a 09 09 20 20 20 20 20 28 66 me")))... (f
4870: 69 6c 65 73 20 20 20 20 28 69 66 20 28 66 69 6c iles (if (fil
4880: 65 2d 65 78 69 73 74 73 3f 20 72 75 6e 74 6f 70 e-exists? runtop
4890: 29 0a 09 09 09 09 20 20 20 28 61 70 70 65 6e 64 )..... (append
48a0: 20 28 67 6c 6f 62 20 28 63 6f 6e 63 20 72 75 6e (glob (conc run
48b0: 74 6f 70 20 22 2f 2e 6d 65 67 61 74 65 73 74 2a top "/.megatest*
48c0: 22 29 29 0a 09 09 09 09 09 20 20 20 28 67 6c 6f "))...... (glo
48d0: 62 20 28 63 6f 6e 63 20 72 75 6e 74 6f 70 20 22 b (conc runtop "
48e0: 2f 2e 72 75 6e 63 6f 6e 66 69 67 2a 22 29 29 29 /.runconfig*")))
48f0: 0a 09 09 09 09 20 20 20 27 28 29 29 29 29 0a 09 ..... '())))..
4900: 09 28 69 66 20 28 6e 75 6c 6c 3f 20 66 69 6c 65 .(if (null? file
4910: 73 29 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a s)... (debug:
4920: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
4930: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
4940: 22 4e 6f 20 63 61 63 68 65 64 20 6d 65 67 61 74 "No cached megat
4950: 65 73 74 20 6f 72 20 72 75 6e 63 6f 6e 66 69 67 est or runconfig
4960: 73 20 66 69 6c 65 73 20 66 6f 75 6e 64 2e 20 4e s files found. N
4970: 6f 6e 65 20 72 65 6d 6f 76 65 64 2e 22 29 0a 09 one removed.")..
4980: 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 . (begin...
4990: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
49a0: 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
49b0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 65 6d 6f -log-port* "Remo
49c0: 76 69 6e 67 20 63 61 63 68 65 64 20 66 69 6c 65 ving cached file
49d0: 73 3a 5c 6e 20 20 20 20 22 20 28 73 74 72 69 6e s:\n " (strin
49e0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 69 g-intersperse fi
49f0: 6c 65 73 20 22 5c 6e 20 20 20 20 22 29 29 0a 09 les "\n "))..
4a00: 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 . (for-each
4a10: 20 0a 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 ... (lamb
4a20: 64 61 20 28 66 29 0a 09 09 09 20 28 68 61 6e 64 da (f).... (hand
4a30: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 le-exceptions...
4a40: 09 20 20 20 20 20 65 78 6e 0a 09 09 09 20 20 20 . exn....
4a50: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
4a60: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
4a70: 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 46 61 rt* "WARNING: Fa
4a80: 69 6c 65 64 20 74 6f 20 72 65 6d 6f 76 65 20 66 iled to remove f
4a90: 69 6c 65 20 22 20 66 29 0a 09 09 09 20 20 20 28 ile " f).... (
4aa0: 64 65 6c 65 74 65 2d 66 69 6c 65 20 66 29 29 29 delete-file f)))
4ab0: 0a 09 09 20 20 20 20 20 20 20 66 69 6c 65 73 29 ... files)
4ac0: 29 29 29 0a 09 20 20 20 20 20 20 28 64 65 62 75 ))).. (debu
4ad0: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
4ae0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
4af0: 74 2a 20 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 t* "-clean-cache
4b00: 20 72 65 71 75 69 72 65 73 20 2d 72 75 6e 6e 61 requires -runna
4b10: 6d 65 2e 22 29 29 0a 09 20 20 28 64 65 62 75 67 me.")).. (debug
4b20: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
4b30: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
4b40: 2a 20 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 20 * "-clean-cache
4b50: 72 65 71 75 69 72 65 73 20 2d 74 61 72 67 65 74 requires -target
4b60: 20 6f 72 20 2d 72 65 71 74 61 72 67 22 29 29 29 or -reqtarg")))
4b70: 29 0a 09 20 20 20 20 0a 09 20 20 0a 28 69 66 20 ).. .. .(if
4b80: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4b90: 65 6e 76 32 66 69 6c 65 22 29 0a 20 20 20 20 28 env2file"). (
4ba0: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 73 61 76 begin. (sav
4bb0: 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 e-environment-as
4bc0: 2d 66 69 6c 65 73 20 28 61 72 67 73 3a 67 65 74 -files (args:get
4bd0: 2d 61 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 -arg "-env2file"
4be0: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
4bf0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
4c00: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
4c10: 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 69 et-arg "-list-di
4c20: 73 6b 73 22 29 0a 20 20 20 20 28 6c 65 74 20 28 sks"). (let (
4c30: 28 74 6f 70 70 61 74 68 20 28 6c 61 75 6e 63 68 (toppath (launch
4c40: 3a 73 65 74 75 70 29 29 29 0a 20 20 20 20 20 20 :setup))).
4c50: 28 70 72 69 6e 74 20 0a 20 20 20 20 20 20 20 28 (print . (
4c60: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
4c70: 73 65 20 0a 09 28 6d 61 70 20 28 6c 61 6d 62 64 se ..(map (lambd
4c80: 61 20 28 78 29 0a 09 20 20 20 20 20 20 20 28 73 a (x).. (s
4c90: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
4ca0: 65 20 0a 09 09 78 0a 09 09 22 20 3d 3e 20 22 29 e ...x..." => ")
4cb0: 29 0a 09 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a ).. (common:
4cc0: 67 65 74 2d 64 69 73 6b 73 20 2a 63 6f 6e 66 69 get-disks *confi
4cd0: 67 64 61 74 2a 29 29 0a 09 22 5c 6e 22 29 29 0a gdat*)).."\n")).
4ce0: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
4cf0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
4d00: 0a 0a 3b 3b 20 63 73 76 20 70 72 6f 63 65 73 73 ..;; csv process
4d10: 69 6e 67 20 72 65 63 6f 72 64 0a 28 64 65 66 69 ing record.(defi
4d20: 6e 65 20 28 6d 61 6b 65 2d 72 65 66 64 62 3a 63 ne (make-refdb:c
4d30: 73 76 29 0a 20 20 28 76 65 63 74 6f 72 20 0a 20 sv). (vector .
4d40: 20 20 28 6d 61 6b 65 2d 73 70 61 72 73 65 2d 61 (make-sparse-a
4d50: 72 72 61 79 29 0a 20 20 20 28 6d 61 6b 65 2d 68 rray). (make-h
4d60: 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 20 28 6d ash-table). (m
4d70: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 0a ake-hash-table).
4d80: 20 20 20 30 0a 20 20 20 30 29 29 0a 28 64 65 66 0. 0)).(def
4d90: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 ine-inline (refd
4da0: 62 3a 63 73 76 2d 67 65 74 2d 73 76 65 63 20 20 b:csv-get-svec
4db0: 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 vec) (vect
4dc0: 6f 72 2d 72 65 66 20 20 76 65 63 20 30 29 29 0a or-ref vec 0)).
4dd0: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
4de0: 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 72 6f refdb:csv-get-ro
4df0: 77 73 20 20 20 20 20 76 65 63 29 20 20 20 20 28 ws vec) (
4e00: 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 vector-ref vec
4e10: 31 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 1)).(define-inli
4e20: 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 ne (refdb:csv-ge
4e30: 74 2d 63 6f 6c 73 20 20 20 20 20 76 65 63 29 20 t-cols vec)
4e40: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 (vector-ref
4e50: 76 65 63 20 32 29 29 0a 28 64 65 66 69 6e 65 2d vec 2)).(define-
4e60: 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 inline (refdb:cs
4e70: 76 2d 67 65 74 2d 6d 61 78 72 6f 77 20 20 20 76 v-get-maxrow v
4e80: 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 ec) (vector-r
4e90: 65 66 20 20 76 65 63 20 33 29 29 0a 28 64 65 66 ef vec 3)).(def
4ea0: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 ine-inline (refd
4eb0: 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 63 6f 6c b:csv-get-maxcol
4ec0: 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 vec) (vect
4ed0: 6f 72 2d 72 65 66 20 20 76 65 63 20 34 29 29 0a or-ref vec 4)).
4ee0: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
4ef0: 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 73 76 refdb:csv-set-sv
4f00: 65 63 21 20 20 20 20 76 65 63 20 76 61 6c 29 28 ec! vec val)(
4f10: 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 vector-set! vec
4f20: 30 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 0 val)).(define-
4f30: 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 inline (refdb:cs
4f40: 76 2d 73 65 74 2d 72 6f 77 73 21 20 20 20 20 76 v-set-rows! v
4f50: 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 ec val)(vector-s
4f60: 65 74 21 20 76 65 63 20 31 20 76 61 6c 29 29 0a et! vec 1 val)).
4f70: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
4f80: 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 63 6f refdb:csv-set-co
4f90: 6c 73 21 20 20 20 20 76 65 63 20 76 61 6c 29 28 ls! vec val)(
4fa0: 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 vector-set! vec
4fb0: 32 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 2 val)).(define-
4fc0: 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 inline (refdb:cs
4fd0: 76 2d 73 65 74 2d 6d 61 78 72 6f 77 21 20 20 76 v-set-maxrow! v
4fe0: 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 ec val)(vector-s
4ff0: 65 74 21 20 76 65 63 20 33 20 76 61 6c 29 29 0a et! vec 3 val)).
5000: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
5010: 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d 61 refdb:csv-set-ma
5020: 78 63 6f 6c 21 20 20 76 65 63 20 76 61 6c 29 28 xcol! vec val)(
5030: 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 vector-set! vec
5040: 34 20 76 61 6c 29 29 0a 0a 28 64 65 66 69 6e 65 4 val))..(define
5050: 20 28 67 65 74 2d 64 61 74 20 72 65 73 75 6c 74 (get-dat result
5060: 73 20 73 68 65 65 74 6e 61 6d 65 29 0a 20 20 28 s sheetname). (
5070: 6f 72 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 or (hash-table-r
5080: 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 75 6c ef/default resul
5090: 74 73 20 73 68 65 65 74 6e 61 6d 65 20 23 66 29 ts sheetname #f)
50a0: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 6d . (let ((tm
50b0: 70 2d 76 65 63 20 20 28 6d 61 6b 65 2d 72 65 66 p-vec (make-ref
50c0: 64 62 3a 63 73 76 29 29 29 0a 09 28 68 61 73 68 db:csv)))..(hash
50d0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 75 -table-set! resu
50e0: 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 20 74 6d lts sheetname tm
50f0: 70 2d 76 65 63 29 0a 09 74 6d 70 2d 76 65 63 29 p-vec)..tmp-vec)
5100: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
5110: 74 2d 61 72 67 20 22 2d 72 65 66 64 62 32 64 61 t-arg "-refdb2da
5120: 74 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 t"). (let* ((
5130: 69 6e 70 75 74 2d 64 62 20 28 61 72 67 73 3a 67 input-db (args:g
5140: 65 74 2d 61 72 67 20 22 2d 72 65 66 64 62 32 64 et-arg "-refdb2d
5150: 61 74 22 29 29 0a 09 20 20 20 28 6f 75 74 2d 66 at")).. (out-f
5160: 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ile (args:get-ar
5170: 67 20 22 2d 6f 22 29 29 0a 09 20 20 20 28 6f 75 g "-o")).. (ou
5180: 74 2d 66 6d 74 20 20 28 6f 72 20 28 61 72 67 73 t-fmt (or (args
5190: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
51a0: 6f 64 65 22 29 20 22 73 63 68 65 6d 65 22 29 29 ode") "scheme"))
51b0: 0a 09 20 20 20 28 6f 75 74 2d 70 6f 72 74 20 28 .. (out-port (
51c0: 69 66 20 28 61 6e 64 20 6f 75 74 2d 66 69 6c 65 if (and out-file
51d0: 20 0a 09 09 09 20 20 20 20 20 20 28 6e 6f 74 20 .... (not
51e0: 28 6d 65 6d 62 65 72 20 6f 75 74 2d 66 6d 74 20 (member out-fmt
51f0: 27 28 22 73 71 6c 69 74 65 33 22 20 22 63 73 76 '("sqlite3" "csv
5200: 22 29 29 29 29 0a 09 09 09 20 28 6f 70 65 6e 2d ")))).... (open-
5210: 6f 75 74 70 75 74 2d 66 69 6c 65 20 6f 75 74 2d output-file out-
5220: 66 69 6c 65 29 0a 09 09 09 20 28 63 75 72 72 65 file).... (curre
5230: 6e 74 2d 6f 75 74 70 75 74 2d 70 6f 72 74 29 29 nt-output-port))
5240: 29 0a 09 20 20 20 28 72 65 73 2d 64 61 74 61 20 ).. (res-data
5250: 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 72 65 (configf:read-re
5260: 66 64 62 20 69 6e 70 75 74 2d 64 62 29 29 0a 09 fdb input-db))..
5270: 20 20 20 28 64 61 74 61 20 20 20 20 20 28 63 61 (data (ca
5280: 72 20 72 65 73 2d 64 61 74 61 29 29 0a 09 20 20 r res-data))..
5290: 20 28 6d 73 67 20 20 20 20 20 20 28 63 61 64 72 (msg (cadr
52a0: 20 72 65 73 2d 64 61 74 61 29 29 29 0a 20 20 20 res-data))).
52b0: 20 20 20 28 69 66 20 28 6e 6f 74 20 64 61 74 61 (if (not data
52c0: 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ).. (debug:prin
52d0: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
52e0: 2d 70 6f 72 74 2a 20 22 42 61 64 20 69 6e 70 75 -port* "Bad inpu
52f0: 74 3f 20 64 61 74 61 3d 22 20 64 61 74 61 29 20 t? data=" data)
5300: 3b 3b 20 73 6f 6d 65 20 65 72 72 6f 72 20 6f 63 ;; some error oc
5310: 63 75 72 72 65 64 0a 09 20 20 28 77 69 74 68 2d curred.. (with-
5320: 6f 75 74 70 75 74 2d 74 6f 2d 70 6f 72 74 20 6f output-to-port o
5330: 75 74 2d 70 6f 72 74 0a 09 20 20 20 20 28 6c 61 ut-port.. (la
5340: 6d 62 64 61 20 28 29 0a 09 20 20 20 20 20 20 28 mbda ().. (
5350: 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy
5360: 6d 62 6f 6c 20 6f 75 74 2d 66 6d 74 29 0a 09 09 mbol out-fmt)...
5370: 28 28 73 63 68 65 6d 65 29 28 70 70 20 64 61 74 ((scheme)(pp dat
5380: 61 29 29 0a 09 09 28 28 70 65 72 6c 29 0a 09 09 a))...((perl)...
5390: 20 3b 3b 20 28 70 72 69 6e 74 20 22 25 68 61 73 ;; (print "%has
53a0: 68 20 3d 20 28 22 29 0a 09 09 20 3b 3b 20 20 20 h = (")... ;;
53b0: 20 20 20 20 20 6b 65 79 31 20 3d 3e 20 27 76 61 key1 => 'va
53c0: 6c 75 65 31 27 2c 0a 09 09 20 3b 3b 20 20 20 20 lue1',... ;;
53d0: 20 20 20 20 6b 65 79 32 20 3d 3e 20 27 76 61 6c key2 => 'val
53e0: 75 65 32 27 2c 0a 09 09 20 3b 3b 20 20 20 20 20 ue2',... ;;
53f0: 20 20 20 6b 65 79 33 20 3d 3e 20 27 76 61 6c 75 key3 => 'valu
5400: 65 33 27 2c 0a 09 09 20 3b 3b 20 29 3b 0a 09 09 e3',... ;; );...
5410: 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c (configf:map-al
5420: 6c 2d 68 69 65 72 2d 61 6c 69 73 74 20 0a 09 09 l-hier-alist ...
5430: 20 20 64 61 74 61 20 0a 09 09 20 20 28 6c 61 6d data ... (lam
5440: 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 bda (sheetname s
5450: 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 ectionname varna
5460: 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 28 70 me val)... (p
5470: 72 69 6e 74 20 22 24 64 61 74 61 7b 5c 22 22 20 rint "$data{\""
5480: 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 7d 7b 5c sheetname "\"}{\
5490: 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 "" sectionname "
54a0: 5c 22 7d 7b 5c 22 22 20 76 61 72 6e 61 6d 65 20 \"}{\"" varname
54b0: 22 5c 22 7d 20 3d 20 5c 22 22 20 76 61 6c 20 22 "\"} = \"" val "
54c0: 5c 22 3b 22 29 29 29 29 0a 09 09 28 28 70 79 74 \";"))))...((pyt
54d0: 68 6f 6e 20 72 75 62 79 29 0a 09 09 20 28 70 72 hon ruby)... (pr
54e0: 69 6e 74 20 22 64 61 74 61 3d 7b 7d 22 29 0a 09 int "data={}")..
54f0: 09 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 . (configf:map-a
5500: 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 0a 09 09 ll-hier-alist...
5510: 20 20 64 61 74 61 0a 09 09 20 20 28 6c 61 6d 62 data... (lamb
5520: 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 65 da (sheetname se
5530: 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d ctionname varnam
5540: 65 20 76 61 6c 29 0a 09 09 20 20 20 20 28 70 72 e val)... (pr
5550: 69 6e 74 20 22 64 61 74 61 5b 5c 22 22 20 73 68 int "data[\"" sh
5560: 65 65 74 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 22 eetname "\"][\""
5570: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 5c 22 sectionname "\"
5580: 5d 5b 5c 22 22 20 76 61 72 6e 61 6d 65 20 22 5c ][\"" varname "\
5590: 22 5d 20 3d 20 5c 22 22 20 76 61 6c 20 22 5c 22 "] = \"" val "\"
55a0: 22 29 29 0a 09 09 20 20 69 6e 69 74 70 72 6f 63 "))... initproc
55b0: 31 3a 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 28 1:... (lambda (
55c0: 73 68 65 65 74 6e 61 6d 65 29 0a 09 09 20 20 20 sheetname)...
55d0: 20 28 70 72 69 6e 74 20 22 64 61 74 61 5b 5c 22 (print "data[\"
55e0: 22 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 5d " sheetname "\"]
55f0: 20 3d 20 7b 7d 22 29 29 0a 09 09 20 20 69 6e 69 = {}"))... ini
5600: 74 70 72 6f 63 32 3a 0a 09 09 20 20 28 6c 61 6d tproc2:... (lam
5610: 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 bda (sheetname s
5620: 65 63 74 69 6f 6e 6e 61 6d 65 29 0a 09 09 20 20 ectionname)...
5630: 20 20 28 70 72 69 6e 74 20 22 64 61 74 61 5b 5c (print "data[\
5640: 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 "" sheetname "\"
5650: 5d 5b 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d ][\"" sectionnam
5660: 65 20 22 5c 22 5d 20 3d 20 7b 7d 22 29 29 29 29 e "\"] = {}"))))
5670: 0a 09 09 28 28 63 73 76 29 0a 09 09 20 28 6c 65 ...((csv)... (le
5680: 74 2a 20 28 28 72 65 73 75 6c 74 73 20 20 28 6d t* ((results (m
5690: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
56a0: 20 3b 3b 20 28 6d 61 6b 65 2d 73 70 61 72 73 65 ;; (make-sparse
56b0: 2d 61 72 72 61 79 29 29 29 0a 09 09 09 28 72 6f -array)))....(ro
56c0: 77 2d 63 6f 6c 73 20 28 6d 61 6b 65 2d 68 61 73 w-cols (make-has
56d0: 68 2d 74 61 62 6c 65 29 29 29 20 3b 3b 20 68 61 h-table))) ;; ha
56e0: 73 68 20 6f 66 20 68 61 73 68 65 73 20 77 68 65 sh of hashes whe
56f0: 72 65 20 73 65 63 74 69 6f 6e 20 3d 3e 20 68 74 re section => ht
5700: 20 7b 20 72 6f 77 2d 3c 6e 61 6d 65 3e 20 3d 3e { row-<name> =>
5710: 20 6e 75 6d 20 6f 72 20 63 6f 6c 2d 3c 6e 61 6d num or col-<nam
5720: 65 3e 20 3d 3e 20 6e 75 6d 0a 09 09 20 20 20 3b e> => num... ;
5730: 3b 20 28 70 72 69 6e 74 20 22 64 61 74 61 3d 22 ; (print "data="
5740: 29 0a 09 09 20 20 20 3b 3b 20 28 70 70 20 64 61 )... ;; (pp da
5750: 74 61 29 0a 09 09 20 20 20 28 63 6f 6e 66 69 67 ta)... (config
5760: 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 f:map-all-hier-a
5770: 6c 69 73 74 0a 09 09 20 20 20 20 64 61 74 61 0a list... data.
5780: 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 .. (lambda (s
5790: 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e heetname section
57a0: 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c name varname val
57b0: 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 28 70 72 )... ;; (pr
57c0: 69 6e 74 20 22 73 68 65 65 74 6e 61 6d 65 3a 20 int "sheetname:
57d0: 22 20 73 68 65 65 74 6e 61 6d 65 20 22 2c 20 73 " sheetname ", s
57e0: 65 63 74 69 6f 6e 6e 61 6d 65 3a 20 22 20 73 65 ectionname: " se
57f0: 63 74 69 6f 6e 6e 61 6d 65 20 22 2c 20 76 61 72 ctionname ", var
5800: 6e 61 6d 65 3a 20 22 20 76 61 72 6e 61 6d 65 20 name: " varname
5810: 22 2c 20 76 61 6c 3a 20 22 20 76 61 6c 29 0a 09 ", val: " val)..
5820: 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 64 . (let* ((d
5830: 61 74 20 20 20 20 20 20 28 67 65 74 2d 64 61 74 at (get-dat
5840: 20 72 65 73 75 6c 74 73 20 73 68 65 65 74 6e 61 results sheetna
5850: 6d 65 29 29 0a 09 09 09 20 20 20 20 20 28 76 65 me)).... (ve
5860: 63 20 20 20 20 20 20 28 72 65 66 64 62 3a 63 73 c (refdb:cs
5870: 76 2d 67 65 74 2d 73 76 65 63 20 64 61 74 29 29 v-get-svec dat))
5880: 0a 09 09 09 20 20 20 20 20 28 72 6f 77 6e 61 6d .... (rownam
5890: 65 73 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 es (refdb:csv-ge
58a0: 74 2d 72 6f 77 73 20 64 61 74 29 29 0a 09 09 09 t-rows dat))....
58b0: 20 20 20 20 20 28 63 6f 6c 6e 61 6d 65 73 20 28 (colnames (
58c0: 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 63 6f refdb:csv-get-co
58d0: 6c 73 20 64 61 74 29 29 0a 09 09 09 20 20 20 20 ls dat))....
58e0: 20 28 63 75 72 72 72 6f 77 6e 20 28 68 61 73 68 (currrown (hash
58f0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
5900: 6c 74 20 72 6f 77 6e 61 6d 65 73 20 76 61 72 6e lt rownames varn
5910: 61 6d 65 20 23 66 29 29 0a 09 09 09 20 20 20 20 ame #f))....
5920: 20 28 63 75 72 72 63 6f 6c 6e 20 28 68 61 73 68 (currcoln (hash
5930: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
5940: 6c 74 20 63 6f 6c 6e 61 6d 65 73 20 73 65 63 74 lt colnames sect
5950: 69 6f 6e 6e 61 6d 65 20 23 66 29 29 0a 09 09 09 ionname #f))....
5960: 20 20 20 20 20 28 72 6f 77 6e 20 20 20 20 20 28 (rown (
5970: 6f 72 20 63 75 72 72 72 6f 77 6e 20 0a 09 09 09 or currrown ....
5980: 09 09 20 20 20 28 6c 65 74 2a 20 28 28 6c 61 73 .. (let* ((las
5990: 74 6e 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d tn (refdb:csv-
59a0: 67 65 74 2d 6d 61 78 72 6f 77 20 64 61 74 29 29 get-maxrow dat))
59b0: 0a 09 09 09 09 09 09 20 20 28 6e 65 77 72 6f 77 ....... (newrow
59c0: 6e 20 28 2b 20 6c 61 73 74 6e 20 31 29 29 29 0a n (+ lastn 1))).
59d0: 09 09 09 09 09 20 20 20 20 20 28 72 65 66 64 62 ..... (refdb
59e0: 3a 63 73 76 2d 73 65 74 2d 6d 61 78 72 6f 77 21 :csv-set-maxrow!
59f0: 20 64 61 74 20 6e 65 77 72 6f 77 6e 29 0a 09 09 dat newrown)...
5a00: 09 09 09 20 20 20 20 20 6e 65 77 72 6f 77 6e 29 ... newrown)
5a10: 29 29 0a 09 09 09 20 20 20 20 20 28 63 6f 6c 6e )).... (coln
5a20: 20 20 20 20 20 28 6f 72 20 63 75 72 72 63 6f 6c (or currcol
5a30: 6e 20 0a 09 09 09 09 09 20 20 20 28 6c 65 74 2a n ...... (let*
5a40: 20 28 28 6c 61 73 74 6e 20 20 20 28 72 65 66 64 ((lastn (refd
5a50: 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 63 6f 6c b:csv-get-maxcol
5a60: 20 64 61 74 29 29 0a 09 09 09 09 09 09 20 20 28 dat))....... (
5a70: 6e 65 77 63 6f 6c 6e 20 28 2b 20 6c 61 73 74 6e newcoln (+ lastn
5a80: 20 31 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 1)))......
5a90: 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d (refdb:csv-set-m
5aa0: 61 78 63 6f 6c 21 20 64 61 74 20 6e 65 77 63 6f axcol! dat newco
5ab0: 6c 6e 29 0a 09 09 09 09 09 20 20 20 20 20 6e 65 ln)...... ne
5ac0: 77 63 6f 6c 6e 29 29 29 29 0a 09 09 09 28 69 66 wcoln))))....(if
5ad0: 20 28 6e 6f 74 20 28 73 70 61 72 73 65 2d 61 72 (not (sparse-ar
5ae0: 72 61 79 2d 72 65 66 20 76 65 63 20 30 20 63 6f ray-ref vec 0 co
5af0: 6c 6e 29 29 20 3b 3b 20 28 65 71 3f 20 72 6f 77 ln)) ;; (eq? row
5b00: 6e 20 30 29 0a 09 09 09 20 20 20 20 28 62 65 67 n 0).... (beg
5b10: 69 6e 0a 09 09 09 20 20 20 20 20 20 28 73 70 61 in.... (spa
5b20: 72 73 65 2d 61 72 72 61 79 2d 73 65 74 21 20 76 rse-array-set! v
5b30: 65 63 20 30 20 63 6f 6c 6e 20 73 65 63 74 69 6f ec 0 coln sectio
5b40: 6e 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 20 nname)....
5b50: 3b 3b 20 28 70 72 69 6e 74 20 22 73 70 61 72 73 ;; (print "spars
5b60: 65 2d 61 72 72 61 79 2d 72 65 66 20 22 20 30 20 e-array-ref " 0
5b70: 22 2c 22 20 63 6f 6c 6e 20 22 3d 22 20 28 73 70 "," coln "=" (sp
5b80: 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 76 arse-array-ref v
5b90: 65 63 20 30 20 63 6f 6c 6e 29 29 0a 09 09 09 20 ec 0 coln))....
5ba0: 20 20 20 20 20 29 29 0a 09 09 09 28 69 66 20 28 ))....(if (
5bb0: 6e 6f 74 20 28 73 70 61 72 73 65 2d 61 72 72 61 not (sparse-arra
5bc0: 79 2d 72 65 66 20 76 65 63 20 72 6f 77 6e 20 30 y-ref vec rown 0
5bd0: 29 29 20 3b 3b 20 28 65 71 3f 20 63 6f 6c 6e 20 )) ;; (eq? coln
5be0: 30 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e 0).... (begin
5bf0: 0a 09 09 09 20 20 20 20 20 20 28 73 70 61 72 73 .... (spars
5c00: 65 2d 61 72 72 61 79 2d 73 65 74 21 20 76 65 63 e-array-set! vec
5c10: 20 72 6f 77 6e 20 30 20 76 61 72 6e 61 6d 65 29 rown 0 varname)
5c20: 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 28 70 72 .... ;; (pr
5c30: 69 6e 74 20 22 73 70 61 72 73 65 2d 61 72 72 61 int "sparse-arra
5c40: 79 2d 72 65 66 20 22 20 72 6f 77 6e 20 22 2c 22 y-ref " rown ","
5c50: 20 30 20 22 3d 22 20 28 73 70 61 72 73 65 2d 61 0 "=" (sparse-a
5c60: 72 72 61 79 2d 72 65 66 20 76 65 63 20 72 6f 77 rray-ref vec row
5c70: 6e 20 30 29 29 0a 09 09 09 20 20 20 20 20 20 29 n 0)).... )
5c80: 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 63 75 )....(if (not cu
5c90: 72 72 72 6f 77 6e 29 28 68 61 73 68 2d 74 61 62 rrrown)(hash-tab
5ca0: 6c 65 2d 73 65 74 21 20 72 6f 77 6e 61 6d 65 73 le-set! rownames
5cb0: 20 76 61 72 6e 61 6d 65 20 72 6f 77 6e 29 29 0a varname rown)).
5cc0: 09 09 09 28 69 66 20 28 6e 6f 74 20 63 75 72 72 ...(if (not curr
5cd0: 63 6f 6c 6e 29 28 68 61 73 68 2d 74 61 62 6c 65 coln)(hash-table
5ce0: 2d 73 65 74 21 20 63 6f 6c 6e 61 6d 65 73 20 73 -set! colnames s
5cf0: 65 63 74 69 6f 6e 6e 61 6d 65 20 63 6f 6c 6e 29 ectionname coln)
5d00: 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e 74 20 22 )....;; (print "
5d10: 64 61 74 3d 22 20 64 61 74 20 22 2c 20 72 6f 77 dat=" dat ", row
5d20: 6e 3d 22 20 72 6f 77 6e 20 22 2c 20 63 6f 6c 6e n=" rown ", coln
5d30: 3d 22 20 63 6f 6c 6e 29 0a 09 09 09 28 73 70 61 =" coln)....(spa
5d40: 72 73 65 2d 61 72 72 61 79 2d 73 65 74 21 20 76 rse-array-set! v
5d50: 65 63 20 72 6f 77 6e 20 63 6f 6c 6e 20 76 61 6c ec rown coln val
5d60: 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e 74 20 22 )....;; (print "
5d70: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 sparse-array-ref
5d80: 20 22 20 72 6f 77 6e 20 22 2c 22 20 63 6f 6c 6e " rown "," coln
5d90: 20 22 3d 22 20 28 73 70 61 72 73 65 2d 61 72 72 "=" (sparse-arr
5da0: 61 79 2d 72 65 66 20 76 65 63 20 72 6f 77 6e 20 ay-ref vec rown
5db0: 63 6f 6c 6e 29 29 0a 09 09 09 29 29 29 0a 09 09 coln))....)))...
5dc0: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 (for-each...
5dd0: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 65 (lambda (shee
5de0: 74 6e 61 6d 65 29 0a 09 09 20 20 20 20 20 20 28 tname)... (
5df0: 6c 65 74 2a 20 28 28 73 68 65 65 74 64 61 74 20 let* ((sheetdat
5e00: 28 67 65 74 2d 64 61 74 20 72 65 73 75 6c 74 73 (get-dat results
5e10: 20 73 68 65 65 74 6e 61 6d 65 29 29 0a 09 09 09 sheetname))....
5e20: 20 20 20 20 20 28 73 76 65 63 20 20 20 20 20 28 (svec (
5e30: 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 73 76 refdb:csv-get-sv
5e40: 65 63 20 73 68 65 65 74 64 61 74 29 29 0a 09 09 ec sheetdat))...
5e50: 09 20 20 20 20 20 28 6d 61 78 72 6f 77 20 20 20 . (maxrow
5e60: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d (refdb:csv-get-m
5e70: 61 78 72 6f 77 20 73 68 65 65 74 64 61 74 29 29 axrow sheetdat))
5e80: 0a 09 09 09 20 20 20 20 20 28 6d 61 78 63 6f 6c .... (maxcol
5e90: 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 (refdb:csv-ge
5ea0: 74 2d 6d 61 78 63 6f 6c 20 73 68 65 65 74 64 61 t-maxcol sheetda
5eb0: 74 29 29 0a 09 09 09 20 20 20 20 20 28 66 6e 61 t)).... (fna
5ec0: 6d 65 20 20 20 20 28 69 66 20 6f 75 74 2d 66 69 me (if out-fi
5ed0: 6c 65 20 0a 09 09 09 09 09 20 20 20 28 73 74 72 le ...... (str
5ee0: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 22 ing-substitute "
5ef0: 25 73 22 20 73 68 65 65 74 6e 61 6d 65 20 6f 75 %s" sheetname ou
5f00: 74 2d 66 69 6c 65 29 20 3b 3b 20 22 2f 66 6f 6f t-file) ;; "/foo
5f10: 2f 62 61 72 2f 25 73 2e 63 73 76 22 29 0a 09 09 /bar/%s.csv")...
5f20: 09 09 09 20 20 20 28 63 6f 6e 63 20 73 68 65 65 ... (conc shee
5f30: 74 6e 61 6d 65 20 22 2e 63 73 76 22 29 29 29 29 tname ".csv"))))
5f40: 0a 09 09 09 28 77 69 74 68 2d 6f 75 74 70 75 74 ....(with-output
5f50: 2d 74 6f 2d 66 69 6c 65 20 66 6e 61 6d 65 0a 09 -to-file fname..
5f60: 09 09 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 .. (lambda ()..
5f70: 09 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 .. ;; (print
5f80: 22 53 68 65 65 74 6e 61 6d 65 3a 20 22 20 73 68 "Sheetname: " sh
5f90: 65 65 74 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 eetname)....
5fa0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 6f 77 20 (let loop ((row
5fb0: 20 20 20 20 20 20 30 29 0a 09 09 09 09 20 20 20 0).....
5fc0: 20 20 20 20 28 63 6f 6c 20 20 20 20 20 20 20 30 (col 0
5fd0: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 63 75 )..... (cu
5fe0: 72 72 2d 72 6f 77 20 27 28 29 29 0a 09 09 09 09 rr-row '()).....
5ff0: 20 20 20 20 20 20 20 28 72 65 73 75 6c 74 20 20 (result
6000: 20 27 28 29 29 29 0a 09 09 09 20 20 20 20 20 20 '()))....
6010: 28 6c 65 74 2a 20 28 28 76 61 6c 20 28 73 70 61 (let* ((val (spa
6020: 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 73 76 rse-array-ref sv
6030: 65 63 20 72 6f 77 20 63 6f 6c 29 29 0a 09 09 09 ec row col))....
6040: 09 20 20 20 20 20 28 64 69 73 70 2d 76 61 6c 20 . (disp-val
6050: 28 69 66 20 76 61 6c 0a 09 09 09 09 09 09 20 20 (if val.......
6060: 20 28 63 6f 6e 63 20 22 5c 22 22 20 76 61 6c 20 (conc "\"" val
6070: 22 5c 22 22 29 0a 09 09 09 09 09 09 20 20 20 22 "\"")....... "
6080: 22 29 29 29 0a 09 09 09 09 28 69 66 20 28 3e 20 "))).....(if (>
6090: 63 6f 6c 20 30 29 28 64 69 73 70 6c 61 79 20 22 col 0)(display "
60a0: 2c 22 29 29 0a 09 09 09 09 28 64 69 73 70 6c 61 ,")).....(displa
60b0: 79 20 64 69 73 70 2d 76 61 6c 29 0a 09 09 09 09 y disp-val).....
60c0: 28 63 6f 6e 64 0a 09 09 09 09 20 28 28 3e 20 72 (cond..... ((> r
60d0: 6f 77 20 6d 61 78 72 6f 77 29 28 64 69 73 70 6c ow maxrow)(displ
60e0: 61 79 20 22 5c 6e 22 29 20 72 65 73 75 6c 74 29 ay "\n") result)
60f0: 0a 09 09 09 09 20 28 28 3e 3d 20 63 6f 6c 20 6d ..... ((>= col m
6100: 61 78 63 6f 6c 29 0a 09 09 09 09 20 20 28 64 69 axcol)..... (di
6110: 73 70 6c 61 79 20 22 5c 6e 22 29 0a 09 09 09 09 splay "\n").....
6120: 20 20 28 6c 6f 6f 70 20 28 2b 20 72 6f 77 20 31 (loop (+ row 1
6130: 29 20 30 20 27 28 29 20 28 61 70 70 65 6e 64 20 ) 0 '() (append
6140: 72 65 73 75 6c 74 20 28 6c 69 73 74 20 63 75 72 result (list cur
6150: 72 2d 72 6f 77 29 29 29 29 0a 09 09 09 09 20 28 r-row))))..... (
6160: 65 6c 73 65 0a 09 09 09 09 20 20 28 6c 6f 6f 70 else..... (loop
6170: 20 72 6f 77 20 28 2b 20 63 6f 6c 20 31 29 20 28 row (+ col 1) (
6180: 61 70 70 65 6e 64 20 63 75 72 72 2d 72 6f 77 20 append curr-row
6190: 28 6c 69 73 74 20 76 61 6c 29 29 20 72 65 73 75 (list val)) resu
61a0: 6c 74 29 29 29 29 29 29 29 29 29 0a 09 09 20 20 lt)))))))))...
61b0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 (hash-table-ke
61c0: 79 73 20 72 65 73 75 6c 74 73 29 29 29 29 0a 09 ys results))))..
61d0: 09 28 28 73 71 6c 69 74 65 33 29 0a 09 09 20 28 .((sqlite3)... (
61e0: 6c 65 74 2a 20 28 28 64 62 2d 66 69 6c 65 20 20 let* ((db-file
61f0: 20 28 6f 72 20 6f 75 74 2d 66 69 6c 65 20 28 70 (or out-file (p
6200: 61 74 68 6e 61 6d 65 2d 66 69 6c 65 20 69 6e 70 athname-file inp
6210: 75 74 2d 64 62 29 29 29 0a 09 09 09 28 64 62 2d ut-db)))....(db-
6220: 65 78 69 73 74 73 20 28 66 69 6c 65 2d 65 78 69 exists (file-exi
6230: 73 74 73 3f 20 64 62 2d 66 69 6c 65 29 29 0a 09 sts? db-file))..
6240: 09 09 28 64 62 20 20 20 20 20 20 20 20 28 73 71 ..(db (sq
6250: 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 74 61 62 lite3:open-datab
6260: 61 73 65 20 64 62 2d 66 69 6c 65 29 29 29 0a 09 ase db-file)))..
6270: 09 20 20 20 28 69 66 20 28 6e 6f 74 20 64 62 2d . (if (not db-
6280: 65 78 69 73 74 73 29 28 73 71 6c 69 74 65 33 3a exists)(sqlite3:
6290: 65 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 execute db "CREA
62a0: 54 45 20 54 41 42 4c 45 20 64 61 74 61 20 28 73 TE TABLE data (s
62b0: 68 65 65 74 2c 73 65 63 74 69 6f 6e 2c 76 61 72 heet,section,var
62c0: 2c 76 61 6c 29 3b 22 29 29 0a 09 09 20 20 20 28 ,val);"))... (
62d0: 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d configf:map-all-
62e0: 68 69 65 72 2d 61 6c 69 73 74 0a 09 09 20 20 20 hier-alist...
62f0: 20 64 61 74 61 0a 09 09 20 20 20 20 28 6c 61 6d data... (lam
6300: 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 bda (sheetname s
6310: 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 ectionname varna
6320: 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 20 20 me val)...
6330: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
6340: 20 64 62 0a 09 09 09 09 20 20 20 20 20 20 20 22 db..... "
6350: 49 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 INSERT OR REPLAC
6360: 45 20 49 4e 54 4f 20 64 61 74 61 20 28 73 68 65 E INTO data (she
6370: 65 74 2c 73 65 63 74 69 6f 6e 2c 76 61 72 2c 76 et,section,var,v
6380: 61 6c 29 20 56 41 4c 55 45 53 20 28 3f 2c 3f 2c al) VALUES (?,?,
6390: 3f 2c 3f 29 3b 22 0a 09 09 09 09 20 20 20 20 20 ?,?);".....
63a0: 20 20 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 sheetname sect
63b0: 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 ionname varname
63c0: 76 61 6c 29 29 29 0a 09 09 20 20 20 28 73 71 6c val)))... (sql
63d0: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
63e0: 62 29 29 29 0a 09 09 28 65 6c 73 65 0a 09 09 20 b)))...(else...
63f0: 28 70 70 20 64 61 74 61 29 29 29 29 29 29 0a 20 (pp data)))))).
6400: 20 20 20 20 20 28 69 66 20 6f 75 74 2d 66 69 6c (if out-fil
6410: 65 20 28 63 6c 6f 73 65 2d 6f 75 74 70 75 74 2d e (close-output-
6420: 70 6f 72 74 20 6f 75 74 2d 70 6f 72 74 29 29 0a port out-port)).
6430: 20 20 20 20 20 20 28 65 78 69 74 29 20 3b 3b 20 (exit) ;;
6440: 79 65 73 2c 20 62 65 6e 64 69 6e 67 20 74 68 65 yes, bending the
6450: 20 72 75 6c 65 73 20 68 65 72 65 20 2d 20 6e 65 rules here - ne
6460: 65 64 20 74 6f 20 65 78 69 74 20 73 69 6e 63 65 ed to exit since
6470: 20 74 68 69 73 20 69 73 20 61 20 75 74 69 6c 69 this is a utili
6480: 74 79 0a 20 20 20 20 20 20 29 29 0a 0a 28 69 66 ty. ))..(if
6490: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
64a0: 2d 70 69 6e 67 22 29 0a 20 20 20 20 28 6c 65 74 -ping"). (let
64b0: 2a 20 28 28 72 75 6e 2d 69 64 20 20 20 20 20 20 * ((run-id
64c0: 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 (string->numbe
64d0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
64e0: 22 2d 72 75 6e 2d 69 64 22 29 29 29 0a 09 20 20 "-run-id")))..
64f0: 20 28 68 6f 73 74 3a 70 6f 72 74 20 20 20 20 20 (host:port
6500: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6510: 70 69 6e 67 22 29 29 29 0a 20 20 20 20 20 20 28 ping"))). (
6520: 73 65 72 76 65 72 3a 70 69 6e 67 20 72 75 6e 2d server:ping run-
6530: 69 64 20 68 6f 73 74 3a 70 6f 72 74 29 29 29 0a id host:port))).
6540: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
6550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 61 70 =========.;; Cap
6590: 74 75 72 65 2c 20 73 61 76 65 20 61 6e 64 20 6d ture, save and m
65a0: 61 6e 69 70 75 6c 61 74 65 20 65 6e 76 69 72 6f anipulate enviro
65b0: 6e 6d 65 6e 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d nments.;;=======
65c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
65d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
65e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
65f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
6600: 0a 3b 3b 20 4e 4f 54 45 3a 20 4b 65 65 70 20 74 .;; NOTE: Keep t
6610: 68 65 73 65 20 61 62 6f 76 65 20 74 68 65 20 73 hese above the s
6620: 65 63 74 69 6f 6e 20 77 68 65 72 65 20 74 68 65 ection where the
6630: 20 73 65 72 76 65 72 20 6f 72 20 63 6c 69 65 6e server or clien
6640: 74 20 63 6f 64 65 20 69 73 20 73 65 74 75 70 0a t code is setup.
6650: 0a 28 6c 65 74 20 28 28 65 6e 76 63 61 70 20 28 .(let ((envcap (
6660: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
6670: 6e 76 63 61 70 22 29 29 29 0a 20 20 28 69 66 20 nvcap"))). (if
6680: 65 6e 76 63 61 70 0a 20 20 20 20 20 20 28 6c 65 envcap. (le
6690: 74 2a 20 28 28 64 62 20 20 20 20 20 20 28 65 6e t* ((db (en
66a0: 76 3a 6f 70 65 6e 2d 64 62 20 28 69 66 20 28 6e v:open-db (if (n
66b0: 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 22 65 ull? remargs) "e
66c0: 6e 76 64 61 74 2e 64 62 22 20 28 63 61 72 20 72 nvdat.db" (car r
66d0: 65 6d 61 72 67 73 29 29 29 29 29 0a 09 28 65 6e emargs)))))..(en
66e0: 76 3a 73 61 76 65 2d 65 6e 76 2d 76 61 72 73 20 v:save-env-vars
66f0: 64 62 20 65 6e 76 63 61 70 29 0a 09 28 65 6e 76 db envcap)..(env
6700: 3a 63 6c 6f 73 65 2d 64 61 74 61 62 61 73 65 20 :close-database
6710: 64 62 29 0a 09 28 73 65 74 21 20 2a 64 69 64 73 db)..(set! *dids
6720: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 omething* #t))))
6730: 0a 0a 3b 3b 20 64 65 6c 74 61 20 22 6c 61 6e 67 ..;; delta "lang
6740: 75 61 67 65 22 20 77 69 6c 6c 20 65 76 65 6e 74 uage" will event
6750: 75 61 6c 6c 79 20 62 65 20 72 65 73 3d 61 2b 62 ually be res=a+b
6760: 2d 63 20 62 75 74 20 66 6f 72 20 6e 6f 77 20 69 -c but for now i
6770: 74 20 69 73 20 6a 75 73 74 20 72 65 73 3d 61 2d t is just res=a-
6780: 62 20 0a 3b 3b 0a 28 6c 65 74 20 28 28 65 6e 76 b .;;.(let ((env
6790: 64 65 6c 74 61 20 28 61 72 67 73 3a 67 65 74 2d delta (args:get-
67a0: 61 72 67 20 22 2d 65 6e 76 64 65 6c 74 61 22 29 arg "-envdelta")
67b0: 29 29 0a 20 20 28 69 66 20 65 6e 76 64 65 6c 74 )). (if envdelt
67c0: 61 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 6d a. (let ((m
67d0: 61 74 63 68 20 28 73 74 72 69 6e 67 2d 73 70 6c atch (string-spl
67e0: 69 74 20 65 6e 76 64 65 6c 74 61 20 22 2d 22 29 it envdelta "-")
67f0: 29 29 3b 3b 20 28 73 74 72 69 6e 67 2d 6d 61 74 ));; (string-mat
6800: 63 68 20 22 28 5b 61 2d 7a 30 2d 39 5f 5d 2b 29 ch "([a-z0-9_]+)
6810: 3d 28 5b 61 2d 7a 30 2d 39 5f 5c 5c 2d 2c 5d 2b =([a-z0-9_\\-,]+
6820: 29 22 20 65 6e 76 64 65 6c 74 61 29 29 29 0a 09 )" envdelta)))..
6830: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
6840: 6d 61 74 63 68 29 29 0a 09 20 20 20 20 28 6c 65 match)).. (le
6850: 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 20 28 t* ((db (
6860: 65 6e 76 3a 6f 70 65 6e 2d 64 62 20 28 69 66 20 env:open-db (if
6870: 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 (null? remargs)
6880: 22 65 6e 76 64 61 74 2e 64 62 22 20 28 63 61 72 "envdat.db" (car
6890: 20 72 65 6d 61 72 67 73 29 29 29 29 0a 09 09 20 remargs))))...
68a0: 20 20 3b 3b 20 28 72 65 73 63 74 78 20 20 20 20 ;; (resctx
68b0: 28 63 61 64 72 20 6d 61 74 63 68 29 29 0a 09 09 (cadr match))...
68c0: 20 20 20 3b 3b 20 28 65 71 75 6e 20 20 20 20 20 ;; (equn
68d0: 20 28 63 61 64 64 72 20 6d 61 74 63 68 29 29 0a (caddr match)).
68e0: 09 09 20 20 20 28 70 61 72 74 73 20 20 20 20 20 .. (parts
68f0: 6d 61 74 63 68 29 20 3b 3b 20 28 73 74 72 69 6e match) ;; (strin
6900: 67 2d 73 70 6c 69 74 20 65 71 75 6e 20 22 2d 22 g-split equn "-"
6910: 29 29 0a 09 09 20 20 20 28 6d 69 6e 75 65 6e 64 ))... (minuend
6920: 20 20 20 28 63 61 72 20 70 61 72 74 73 29 29 0a (car parts)).
6930: 09 09 20 20 20 28 73 75 62 74 72 61 65 6e 64 20 .. (subtraend
6940: 28 63 61 64 72 20 70 61 72 74 73 29 29 0a 09 09 (cadr parts))...
6950: 20 20 20 28 61 64 64 65 64 20 20 20 20 20 28 65 (added (e
6960: 6e 76 3a 67 65 74 2d 61 64 64 65 64 20 20 20 64 nv:get-added d
6970: 62 20 6d 69 6e 75 65 6e 64 20 73 75 62 74 72 61 b minuend subtra
6980: 65 6e 64 29 29 0a 09 09 20 20 20 28 72 65 6d 6f end))... (remo
6990: 76 65 64 20 20 20 28 65 6e 76 3a 67 65 74 2d 72 ved (env:get-r
69a0: 65 6d 6f 76 65 64 20 64 62 20 6d 69 6e 75 65 6e emoved db minuen
69b0: 64 20 73 75 62 74 72 61 65 6e 64 29 29 0a 09 09 d subtraend))...
69c0: 20 20 20 28 63 68 61 6e 67 65 64 20 20 20 28 65 (changed (e
69d0: 6e 76 3a 67 65 74 2d 63 68 61 6e 67 65 64 20 64 nv:get-changed d
69e0: 62 20 6d 69 6e 75 65 6e 64 20 73 75 62 74 72 61 b minuend subtra
69f0: 65 6e 64 29 29 29 0a 09 20 20 20 20 20 20 3b 3b end))).. ;;
6a00: 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 (pp (hash-table
6a10: 2d 3e 61 6c 69 73 74 20 61 64 64 65 64 29 29 0a ->alist added)).
6a20: 09 20 20 20 20 20 20 3b 3b 20 28 70 70 20 28 68 . ;; (pp (h
6a30: 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 ash-table->alist
6a40: 20 72 65 6d 6f 76 65 64 29 29 0a 09 20 20 20 20 removed))..
6a50: 20 20 3b 3b 20 28 70 70 20 28 68 61 73 68 2d 74 ;; (pp (hash-t
6a60: 61 62 6c 65 2d 3e 61 6c 69 73 74 20 63 68 61 6e able->alist chan
6a70: 67 65 64 29 29 0a 09 20 20 20 20 20 20 28 69 66 ged)).. (if
6a80: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6a90: 2d 6f 22 29 0a 09 09 20 20 28 77 69 74 68 2d 6f -o")... (with-o
6aa0: 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 0a 09 09 utput-to-file...
6ab0: 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
6ac0: 61 72 67 20 22 2d 6f 22 29 0a 09 09 20 20 20 20 arg "-o")...
6ad0: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 20 20 (lambda ()...
6ae0: 20 20 20 28 65 6e 76 3a 70 72 69 6e 74 20 61 64 (env:print ad
6af0: 64 65 64 20 72 65 6d 6f 76 65 64 20 63 68 61 6e ded removed chan
6b00: 67 65 64 29 29 29 0a 09 09 20 20 28 65 6e 76 3a ged)))... (env:
6b10: 70 72 69 6e 74 20 61 64 64 65 64 20 72 65 6d 6f print added remo
6b20: 76 65 64 20 63 68 61 6e 67 65 64 29 29 0a 09 20 ved changed))..
6b30: 20 20 20 20 20 28 65 6e 76 3a 63 6c 6f 73 65 2d (env:close-
6b40: 64 61 74 61 62 61 73 65 20 64 62 29 0a 09 20 20 database db)..
6b50: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
6b60: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 0a 09 20 mething* #t))..
6b70: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
6b80: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
6b90: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 50 61 72 61 -log-port* "Para
6ba0: 6d 65 74 65 72 20 74 6f 20 2d 65 6e 76 64 65 6c meter to -envdel
6bb0: 74 61 20 73 68 6f 75 6c 64 20 62 65 20 6e 65 77 ta should be new
6bc0: 3d 73 74 61 72 2d 65 6e 64 22 29 29 29 29 29 0a =star-end"))))).
6bd0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
6be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 =========.;; Sta
6c20: 72 74 20 74 68 65 20 73 65 72 76 65 72 20 2d 20 rt the server -
6c30: 63 61 6e 20 62 65 20 64 6f 6e 65 20 69 6e 20 63 can be done in c
6c40: 6f 6e 6a 75 6e 63 74 69 6f 6e 20 77 69 74 68 20 onjunction with
6c50: 2d 72 75 6e 61 6c 6c 20 6f 72 20 2d 72 75 6e 74 -runall or -runt
6c60: 65 73 74 73 20 28 6f 6e 65 20 64 61 79 2e 2e 2e ests (one day...
6c70: 29 0a 3b 3b 20 20 20 77 65 20 73 74 61 72 74 20 ).;; we start
6c80: 74 68 65 20 73 65 72 76 65 72 20 69 66 20 6e 6f the server if no
6c90: 74 20 72 75 6e 6e 69 6e 67 20 65 6c 73 65 20 73 t running else s
6ca0: 74 61 72 74 20 74 68 65 20 63 6c 69 65 6e 74 20 tart the client
6cb0: 74 68 72 65 61 64 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d thread.;;=======
6cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
6d00: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
6d10: 72 67 20 22 2d 73 65 72 76 65 72 22 29 0a 0a 20 rg "-server")..
6d20: 20 20 20 3b 3b 20 53 65 72 76 65 72 3f 20 53 74 ;; Server? St
6d30: 61 72 74 20 75 70 20 68 65 72 65 2e 0a 20 20 20 art up here..
6d40: 20 3b 3b 0a 20 20 20 20 28 6c 65 74 20 28 28 74 ;;. (let ((t
6d50: 6c 20 20 20 20 20 20 20 20 28 6c 61 75 6e 63 68 l (launch
6d60: 3a 73 65 74 75 70 29 29 0a 09 20 20 28 72 75 6e :setup)).. (run
6d70: 2d 69 64 20 20 20 20 28 61 6e 64 20 28 61 72 67 -id (and (arg
6d80: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 2d s:get-arg "-run-
6d90: 69 64 22 29 0a 09 09 09 20 20 28 73 74 72 69 6e id").... (strin
6da0: 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a g->number (args:
6db0: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 2d 69 64 get-arg "-run-id
6dc0: 22 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ")))).
6dd0: 28 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 20 (transport-type
6de0: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
6df0: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
6e00: 67 20 22 2d 74 72 61 6e 73 70 6f 72 74 22 29 20 g "-transport")
6e10: 22 68 74 74 70 22 29 29 29 29 0a 20 20 20 20 20 "http")))).
6e20: 20 28 69 66 20 72 75 6e 2d 69 64 0a 09 20 20 28 (if run-id.. (
6e30: 62 65 67 69 6e 0a 09 20 20 20 20 28 73 65 72 76 begin.. (serv
6e40: 65 72 3a 6c 61 75 6e 63 68 20 72 75 6e 2d 69 64 er:launch run-id
6e50: 20 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 29 transport-type)
6e60: 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 .. (set! *did
6e70: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 0a something* #t)).
6e80: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
6e90: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
6ea0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 73 65 72 76 -log-port* "serv
6eb0: 65 72 20 72 65 71 75 69 72 65 73 20 72 75 6e 2d er requires run-
6ec0: 69 64 20 62 65 20 73 70 65 63 69 66 69 65 64 20 id be specified
6ed0: 77 69 74 68 20 2d 72 75 6e 2d 69 64 22 29 29 29 with -run-id")))
6ee0: 0a 0a 20 20 20 20 3b 3b 20 4e 6f 74 20 61 20 73 .. ;; Not a s
6ef0: 65 72 76 65 72 3f 20 54 68 69 73 20 73 65 63 74 erver? This sect
6f00: 69 6f 6e 20 77 69 6c 6c 20 64 65 63 69 64 65 20 ion will decide
6f10: 68 6f 77 20 74 6f 20 63 6f 6d 6d 75 6e 69 63 61 how to communica
6f20: 74 65 0a 20 20 20 20 3b 3b 0a 20 20 20 20 3b 3b te. ;;. ;;
6f30: 20 20 53 65 74 75 70 20 63 6c 69 65 6e 74 20 66 Setup client f
6f40: 6f 72 20 61 6c 6c 20 65 78 70 65 63 74 20 6c 69 or all expect li
6f50: 73 74 65 64 20 68 65 72 65 0a 20 20 20 20 28 69 sted here. (i
6f60: 66 20 28 6e 75 6c 6c 3f 20 28 6c 73 65 74 2d 69 f (null? (lset-i
6f70: 6e 74 65 72 73 65 63 74 69 6f 6e 20 0a 09 09 65 ntersection ...e
6f80: 71 75 61 6c 3f 0a 09 09 28 68 61 73 68 2d 74 61 qual?...(hash-ta
6f90: 62 6c 65 2d 6b 65 79 73 20 61 72 67 73 3a 61 72 ble-keys args:ar
6fa0: 67 2d 68 61 73 68 29 0a 09 09 27 28 22 2d 6c 69 g-hash)...'("-li
6fb0: 73 74 2d 73 65 72 76 65 72 73 22 0a 09 09 20 20 st-servers"...
6fc0: 22 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 0a 20 "-stop-server".
6fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fe0: 20 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 0a "-kill-server".
6ff0: 09 09 20 20 22 2d 73 68 6f 77 2d 63 6d 64 69 6e .. "-show-cmdin
7000: 66 6f 22 0a 09 09 20 20 22 2d 6c 69 73 74 2d 72 fo"... "-list-r
7010: 75 6e 73 22 0a 09 09 20 20 22 2d 70 69 6e 67 22 uns"... "-ping"
7020: 29 29 29 0a 09 28 69 66 20 28 6c 61 75 6e 63 68 )))..(if (launch
7030: 3a 73 65 74 75 70 29 0a 09 20 20 20 20 28 6c 65 :setup).. (le
7040: 74 20 28 28 72 75 6e 2d 69 64 20 20 20 20 28 61 t ((run-id (a
7050: 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 nd (args:get-arg
7060: 20 22 2d 72 75 6e 2d 69 64 22 29 0a 09 09 09 09 "-run-id").....
7070: 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 (string->numbe
7080: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
7090: 22 2d 72 75 6e 2d 69 64 22 29 29 29 29 29 0a 09 "-run-id")))))..
70a0: 20 20 20 20 20 20 3b 3b 20 28 73 65 74 21 20 2a ;; (set! *
70b0: 66 64 62 2a 20 20 20 28 66 69 6c 65 64 62 3a 6f fdb* (filedb:o
70c0: 70 65 6e 2d 64 62 20 28 63 6f 6e 63 20 2a 74 6f pen-db (conc *to
70d0: 70 70 61 74 68 2a 20 22 2f 64 62 2f 70 61 74 68 ppath* "/db/path
70e0: 73 2e 64 62 22 29 29 29 0a 09 20 20 20 20 20 20 s.db")))..
70f0: 3b 3b 20 69 66 20 6e 6f 74 20 6c 69 73 74 20 6f ;; if not list o
7100: 72 20 6b 69 6c 6c 20 74 68 65 6e 20 73 74 61 72 r kill then star
7110: 74 20 61 20 63 6c 69 65 6e 74 20 28 69 66 20 61 t a client (if a
7120: 70 70 72 6f 70 72 69 61 74 65 29 0a 09 20 20 20 ppropriate)..
7130: 20 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 (if (or (args
7140: 2d 64 65 66 69 6e 65 64 3f 20 22 2d 68 22 20 22 -defined? "-h" "
7150: 2d 76 65 72 73 69 6f 6e 22 20 22 2d 63 72 65 61 -version" "-crea
7160: 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 te-megatest-area
7170: 22 20 22 2d 63 72 65 61 74 65 2d 74 65 73 74 22 " "-create-test"
7180: 29 0a 09 09 20 20 20 20 20 20 28 65 71 3f 20 28 )... (eq? (
7190: 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 length (hash-tab
71a0: 6c 65 2d 6b 65 79 73 20 61 72 67 73 3a 61 72 67 le-keys args:arg
71b0: 2d 68 61 73 68 29 29 20 30 29 29 0a 09 09 20 20 -hash)) 0))...
71c0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
71d0: 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 1 *default-log
71e0: 2d 70 6f 72 74 2a 20 22 53 65 72 76 65 72 20 63 -port* "Server c
71f0: 6f 6e 6e 65 63 74 69 6f 6e 20 6e 6f 74 20 6e 65 onnection not ne
7200: 65 64 65 64 22 29 0a 09 09 20 20 28 62 65 67 69 eded")... (begi
7210: 6e 0a 09 09 20 20 20 20 3b 3b 20 28 69 66 20 72 n... ;; (if r
7220: 75 6e 2d 69 64 20 0a 09 09 20 20 20 20 3b 3b 20 un-id ... ;;
7230: 20 20 20 20 28 63 6c 69 65 6e 74 3a 6c 61 75 6e (client:laun
7240: 63 68 20 72 75 6e 2d 69 64 29 20 0a 09 09 20 20 ch run-id) ...
7250: 20 20 3b 3b 20 20 20 20 20 28 63 6c 69 65 6e 74 ;; (client
7260: 3a 6c 61 75 6e 63 68 20 30 29 20 20 20 20 20 20 :launch 0)
7270: 3b 3b 20 77 69 74 68 6f 75 74 20 72 75 6e 2d 69 ;; without run-i
7280: 64 20 77 65 27 6c 6c 20 73 74 61 72 74 20 61 20 d we'll start a
7290: 73 65 72 76 65 72 20 66 6f 72 20 22 30 22 0a 09 server for "0"..
72a0: 09 20 20 20 20 23 74 0a 09 09 20 20 20 20 29 29 . #t... ))
72b0: 29 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 ))))..(if (or (a
72c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
72d0: 73 74 2d 73 65 72 76 65 72 73 22 29 0a 09 28 61 st-servers")..(a
72e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
72f0: 6f 70 2d 73 65 72 76 65 72 22 29 0a 20 20 20 20 op-server").
7300: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
7310: 67 20 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 g "-kill-server"
7320: 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c )). (let ((tl
7330: 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
7340: 29 0a 20 20 20 20 20 20 28 69 66 20 74 6c 20 0a ). (if tl .
7350: 09 20 20 28 6c 65 74 2a 20 28 28 74 64 62 64 61 . (let* ((tdbda
7360: 74 20 20 28 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 t (tasks:open-d
7370: 62 29 29 0a 09 09 20 28 73 65 72 76 65 72 73 20 b))... (servers
7380: 28 74 61 73 6b 73 3a 67 65 74 2d 61 6c 6c 2d 73 (tasks:get-all-s
7390: 65 72 76 65 72 73 20 28 64 62 3a 64 65 6c 61 79 ervers (db:delay
73a0: 2d 69 66 2d 62 75 73 79 20 74 64 62 64 61 74 29 -if-busy tdbdat)
73b0: 29 29 0a 09 09 20 28 66 6d 74 73 74 72 20 20 22 ))... (fmtstr "
73c0: 7e 35 61 7e 31 32 61 7e 38 61 7e 32 30 61 7e 32 ~5a~12a~8a~20a~2
73d0: 34 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 4a~10a~10a~10a~1
73e0: 30 61 5c 6e 22 29 0a 09 09 20 28 73 65 72 76 65 0a\n")... (serve
73f0: 72 73 2d 74 6f 2d 6b 69 6c 6c 20 27 28 29 29 0a rs-to-kill '()).
7400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7410: 20 28 6b 69 6c 6c 2d 73 77 69 74 63 68 20 20 28 (kill-switch (
7420: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
7430: 20 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 29 "-kill-server")
7440: 20 22 2d 39 22 20 22 22 29 29 0a 20 20 20 20 20 "-9" "")).
7450: 20 20 20 20 20 20 20 20 20 20 20 20 28 6b 69 6c (kil
7460: 6c 69 6e 66 6f 20 20 20 28 6f 72 20 28 61 72 67 linfo (or (arg
7470: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 6f 70 s:get-arg "-stop
7480: 2d 73 65 72 76 65 72 22 29 20 28 61 72 67 73 3a -server") (args:
7490: 67 65 74 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 get-arg "-kill-s
74a0: 65 72 76 65 72 22 29 20 29 29 0a 09 09 20 28 6b erver") ))... (k
74b0: 68 6f 73 74 2d 70 6f 72 74 20 28 69 66 20 6b 69 host-port (if ki
74c0: 6c 6c 69 6e 66 6f 20 28 69 66 20 28 73 75 62 73 llinfo (if (subs
74d0: 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 3a 22 20 tring-index ":"
74e0: 6b 69 6c 6c 69 6e 66 6f 29 28 73 74 72 69 6e 67 killinfo)(string
74f0: 2d 73 70 6c 69 74 20 22 3a 22 29 20 23 66 29 20 -split ":") #f)
7500: 23 66 29 29 0a 09 09 20 28 73 69 64 20 20 20 20 #f))... (sid
7510: 20 20 20 20 28 69 66 20 6b 69 6c 6c 69 6e 66 6f (if killinfo
7520: 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d (if (substring-
7530: 69 6e 64 65 78 20 22 3a 22 20 6b 69 6c 6c 69 6e index ":" killin
7540: 66 6f 29 20 23 66 20 28 73 74 72 69 6e 67 2d 3e fo) #f (string->
7550: 6e 75 6d 62 65 72 20 6b 69 6c 6c 69 6e 66 6f 29 number killinfo)
7560: 29 20 23 66 29 29 29 0a 09 20 20 20 20 28 66 6f ) #f))).. (fo
7570: 72 6d 61 74 20 23 74 20 66 6d 74 73 74 72 20 22 rmat #t fmtstr "
7580: 49 64 22 20 22 4d 54 76 65 72 22 20 22 50 69 64 Id" "MTver" "Pid
7590: 22 20 22 48 6f 73 74 22 20 22 49 6e 74 65 72 66 " "Host" "Interf
75a0: 61 63 65 3a 4f 75 74 50 6f 72 74 22 20 22 49 6e ace:OutPort" "In
75b0: 50 6f 72 74 22 20 22 4c 61 73 74 42 65 61 74 22 Port" "LastBeat"
75c0: 20 22 53 74 61 74 65 22 20 22 54 72 61 6e 73 70 "State" "Transp
75d0: 6f 72 74 22 29 0a 09 20 20 20 20 28 66 6f 72 6d ort").. (form
75e0: 61 74 20 23 74 20 66 6d 74 73 74 72 20 22 3d 3d at #t fmtstr "==
75f0: 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 20 " "=====" "==="
7600: 22 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d "====" "========
7610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d =========" "====
7620: 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 ==" "========" "
7630: 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d =====" "========
7640: 3d 22 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 =").. (for-ea
7650: 63 68 20 0a 09 20 20 20 20 20 28 6c 61 6d 62 64 ch .. (lambd
7660: 61 20 28 73 65 72 76 65 72 29 0a 09 20 20 20 20 a (server)..
7670: 20 20 20 28 6c 65 74 2a 20 28 28 69 64 20 20 20 (let* ((id
7680: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re
7690: 66 20 73 65 72 76 65 72 20 30 29 29 0a 09 09 20 f server 0))...
76a0: 20 20 20 20 20 28 70 69 64 20 20 20 20 20 20 20 (pid
76b0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
76c0: 76 65 72 20 31 29 29 0a 09 09 20 20 20 20 20 20 ver 1))...
76d0: 28 68 6f 73 74 6e 61 6d 65 20 20 20 28 76 65 63 (hostname (vec
76e0: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 32 tor-ref server 2
76f0: 29 29 0a 09 09 20 20 20 20 20 20 28 69 6e 74 65 ))... (inte
7700: 72 66 61 63 65 20 20 28 76 65 63 74 6f 72 2d 72 rface (vector-r
7710: 65 66 20 73 65 72 76 65 72 20 33 29 29 20 0a 09 ef server 3)) ..
7720: 09 20 20 20 20 20 20 28 70 75 6c 6c 70 6f 72 74 . (pullport
7730: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
7740: 65 72 76 65 72 20 34 29 29 0a 09 09 20 20 20 20 erver 4))...
7750: 20 20 28 70 75 62 70 6f 72 74 20 20 20 20 28 76 (pubport (v
7760: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
7770: 20 35 29 29 0a 09 09 20 20 20 20 20 20 28 73 74 5))... (st
7780: 61 72 74 2d 74 69 6d 65 20 28 76 65 63 74 6f 72 art-time (vector
7790: 2d 72 65 66 20 73 65 72 76 65 72 20 36 29 29 0a -ref server 6)).
77a0: 09 09 20 20 20 20 20 20 28 70 72 69 6f 72 69 74 .. (priorit
77b0: 79 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 y (vector-ref
77c0: 73 65 72 76 65 72 20 37 29 29 0a 09 09 20 20 20 server 7))...
77d0: 20 20 20 28 73 74 61 74 65 20 20 20 20 20 20 28 (state (
77e0: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
77f0: 72 20 38 29 29 0a 09 09 20 20 20 20 20 20 28 6d r 8))... (m
7800: 74 2d 76 65 72 20 20 20 20 20 28 76 65 63 74 6f t-ver (vecto
7810: 72 2d 72 65 66 20 73 65 72 76 65 72 20 39 29 29 r-ref server 9))
7820: 0a 09 09 20 20 20 20 20 20 28 6c 61 73 74 2d 75 ... (last-u
7830: 70 64 61 74 65 20 28 76 65 63 74 6f 72 2d 72 65 pdate (vector-re
7840: 66 20 73 65 72 76 65 72 20 31 30 29 29 20 0a 09 f server 10)) ..
7850: 09 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 . (transpor
7860: 74 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 t (vector-ref s
7870: 65 72 76 65 72 20 31 31 29 29 0a 09 09 20 20 20 erver 11))...
7880: 20 20 20 28 6b 69 6c 6c 65 64 20 20 20 20 20 23 (killed #
7890: 66 29 0a 09 09 20 20 20 20 20 20 28 73 74 61 74 f)... (stat
78a0: 75 73 20 20 20 20 20 28 3c 20 6c 61 73 74 2d 75 us (< last-u
78b0: 70 64 61 74 65 20 32 30 29 29 29 0a 09 09 20 3b pdate 20)))... ;
78c0: 3b 20 20 20 28 7a 6d 71 2d 73 6f 63 6b 65 74 73 ; (zmq-sockets
78d0: 20 28 69 66 20 73 74 61 74 75 73 20 28 73 65 72 (if status (ser
78e0: 76 65 72 3a 63 6c 69 65 6e 74 2d 63 6f 6e 6e 65 ver:client-conne
78f0: 63 74 20 68 6f 73 74 6e 61 6d 65 20 70 6f 72 74 ct hostname port
7900: 29 20 23 66 29 29 29 0a 09 09 20 3b 3b 20 6e 6f ) #f)))... ;; no
7910: 20 6e 65 65 64 20 74 6f 20 6c 6f 67 69 6e 20 61 need to login a
7920: 73 20 73 74 61 74 75 73 20 6f 66 20 23 74 20 69 s status of #t i
7930: 6e 64 69 63 61 74 65 73 20 77 65 20 61 72 65 20 ndicates we are
7940: 63 6f 6e 6e 65 63 74 69 6e 67 20 74 6f 20 63 6f connecting to co
7950: 72 72 65 63 74 20 0a 09 09 20 3b 3b 20 73 65 72 rrect ... ;; ser
7960: 76 65 72 0a 09 09 20 28 69 66 20 28 65 71 75 61 ver... (if (equa
7970: 6c 3f 20 73 74 61 74 65 20 22 64 65 61 64 22 29 l? state "dead")
7980: 0a 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 6c ... (if (> l
7990: 61 73 74 2d 75 70 64 61 74 65 20 28 2a 20 32 35 ast-update (* 25
79a0: 20 36 30 20 36 30 29 29 20 3b 3b 20 6b 65 65 70 60 60)) ;; keep
79b0: 20 72 65 63 6f 72 64 73 20 61 72 6f 75 6e 64 20 records around
79c0: 66 6f 72 20 73 6c 69 67 68 6c 79 20 6f 76 65 72 for slighly over
79d0: 20 61 20 64 61 79 2e 0a 09 09 09 20 28 74 61 73 a day..... (tas
79e0: 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 ks:server-deregi
79f0: 73 74 65 72 20 28 64 62 3a 64 65 6c 61 79 2d 69 ster (db:delay-i
7a00: 66 2d 62 75 73 79 20 74 64 62 64 61 74 29 20 68 f-busy tdbdat) h
7a10: 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 74 ostname pullport
7a20: 3a 20 70 75 6c 6c 70 6f 72 74 20 70 69 64 3a 20 : pullport pid:
7a30: 70 69 64 20 61 63 74 69 6f 6e 3a 20 27 64 65 6c pid action: 'del
7a40: 65 74 65 29 29 0a 09 09 20 20 20 20 20 28 69 66 ete))... (if
7a50: 20 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 (> last-update
7a60: 32 30 29 20 20 20 20 20 20 20 20 3b 3b 20 4d 61 20) ;; Ma
7a70: 72 6b 20 61 73 20 64 65 61 64 20 69 66 20 6e 6f rk as dead if no
7a80: 74 20 75 70 64 61 74 65 64 20 69 6e 20 6c 61 73 t updated in las
7a90: 74 20 32 30 20 73 65 63 6f 6e 64 73 0a 09 09 09 t 20 seconds....
7aa0: 20 28 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 (tasks:server-d
7ab0: 65 72 65 67 69 73 74 65 72 20 28 64 62 3a 64 65 eregister (db:de
7ac0: 6c 61 79 2d 69 66 2d 62 75 73 79 20 74 64 62 64 lay-if-busy tdbd
7ad0: 61 74 29 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c at) hostname pul
7ae0: 6c 70 6f 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 lport: pullport
7af0: 70 69 64 3a 20 70 69 64 29 29 29 0a 09 09 20 28 pid: pid)))... (
7b00: 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 74 72 format #t fmtstr
7b10: 20 69 64 20 6d 74 2d 76 65 72 20 70 69 64 20 68 id mt-ver pid h
7b20: 6f 73 74 6e 61 6d 65 20 28 63 6f 6e 63 20 69 6e ostname (conc in
7b30: 74 65 72 66 61 63 65 20 22 3a 22 20 70 75 6c 6c terface ":" pull
7b40: 70 6f 72 74 29 20 70 75 62 70 6f 72 74 20 6c 61 port) pubport la
7b50: 73 74 2d 75 70 64 61 74 65 0a 09 09 09 20 28 69 st-update.... (i
7b60: 66 20 73 74 61 74 75 73 20 22 61 6c 69 76 65 22 f status "alive"
7b70: 20 22 64 65 61 64 22 29 20 74 72 61 6e 73 70 6f "dead") transpo
7b80: 72 74 29 0a 09 09 20 28 69 66 20 28 6f 72 20 28 rt)... (if (or (
7b90: 65 71 75 61 6c 3f 20 69 64 20 73 69 64 29 0a 09 equal? id sid)..
7ba0: 09 09 20 28 65 71 75 61 6c 3f 20 73 69 64 20 30 .. (equal? sid 0
7bb0: 29 29 20 3b 3b 20 6b 69 6c 6c 20 61 6c 6c 2f 61 )) ;; kill all/a
7bc0: 6e 79 0a 09 09 20 20 20 20 20 28 62 65 67 69 6e ny... (begin
7bd0: 0a 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 ... (debug
7be0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 :print-info 0 *d
7bf0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
7c00: 20 22 41 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 "Attempting to
7c10: 6b 69 6c 6c 20 22 6b 69 6c 6c 2d 73 77 69 74 63 kill "kill-switc
7c20: 68 22 20 73 65 72 76 65 72 20 77 69 74 68 20 70 h" server with p
7c30: 69 64 20 22 20 70 69 64 29 0a 09 09 20 20 20 20 id " pid)...
7c40: 20 20 20 28 74 61 73 6b 73 3a 6b 69 6c 6c 2d 73 (tasks:kill-s
7c50: 65 72 76 65 72 20 68 6f 73 74 6e 61 6d 65 20 70 erver hostname p
7c60: 69 64 20 6b 69 6c 6c 2d 73 77 69 74 63 68 3a 20 id kill-switch:
7c70: 6b 69 6c 6c 2d 73 77 69 74 63 68 29 29 29 29 29 kill-switch)))))
7c80: 0a 09 20 20 20 20 20 73 65 72 76 65 72 73 29 0a .. servers).
7c90: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
7ca0: 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c t-info 1 *defaul
7cb0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 44 6f 6e t-log-port* "Don
7cc0: 65 20 77 69 74 68 20 6c 69 73 74 73 65 72 76 65 e with listserve
7cd0: 72 73 22 29 0a 09 20 20 20 20 28 73 65 74 21 20 rs").. (set!
7ce0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
7cf0: 74 29 0a 09 20 20 20 20 28 65 78 69 74 29 29 20 t).. (exit))
7d00: 3b 3b 20 6d 75 73 74 20 64 6f 2c 20 77 6f 75 6c ;; must do, woul
7d10: 64 20 68 61 76 65 20 74 6f 20 61 64 64 20 63 68 d have to add ch
7d20: 65 63 6b 73 20 74 6f 20 6d 61 6e 79 2f 61 6c 6c ecks to many/all
7d30: 20 63 61 6c 6c 73 20 62 65 6c 6f 77 0a 09 20 20 calls below..
7d40: 28 65 78 69 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d (exit))))..;;===
7d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d90: 3d 3d 3d 0a 3b 3b 20 57 65 69 72 64 20 73 70 65 ===.;; Weird spe
7da0: 63 69 61 6c 20 63 61 6c 6c 73 20 74 68 61 74 20 cial calls that
7db0: 6e 65 65 64 20 74 6f 20 72 75 6e 20 2a 61 66 74 need to run *aft
7dc0: 65 72 2a 20 74 68 65 20 73 65 72 76 65 72 20 68 er* the server h
7dd0: 61 73 20 73 74 61 72 74 65 64 3f 0a 3b 3b 3d 3d as started?.;;==
7de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7e20: 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
7e30: 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 74 get-arg "-list-t
7e40: 61 72 67 65 74 73 22 29 0a 20 20 20 20 28 6c 65 argets"). (le
7e50: 74 20 28 28 74 61 72 67 65 74 73 20 28 63 6f 6d t ((targets (com
7e60: 6d 6f 6e 3a 67 65 74 2d 72 75 6e 63 6f 6e 66 69 mon:get-runconfi
7e70: 67 2d 74 61 72 67 65 74 73 29 29 29 0a 20 20 20 g-targets))).
7e80: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
7e90: 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 1 *default-log-p
7ea0: 6f 72 74 2a 20 22 46 6f 75 6e 64 20 22 28 6c 65 ort* "Found "(le
7eb0: 6e 67 74 68 20 74 61 72 67 65 74 73 29 20 22 20 ngth targets) "
7ec0: 74 61 72 67 65 74 73 22 29 0a 20 20 20 20 20 20 targets").
7ed0: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
7ee0: 79 6d 62 6f 6c 20 28 6f 72 20 28 61 72 67 73 3a ymbol (or (args:
7ef0: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
7f00: 64 65 22 29 20 22 61 6c 69 73 74 22 29 29 0a 09 de") "alist"))..
7f10: 28 28 61 6c 69 73 74 29 0a 09 20 28 66 6f 72 2d ((alist).. (for-
7f20: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 78 29 each (lambda (x)
7f30: 0a 09 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e ... ;; (prin
7f40: 74 20 22 5b 22 20 78 20 22 5d 22 29 29 0a 09 09 t "[" x "]"))...
7f50: 20 20 20 20 20 28 70 72 69 6e 74 20 78 29 29 0a (print x)).
7f60: 09 09 20 20 20 74 61 72 67 65 74 73 29 29 0a 09 .. targets))..
7f70: 28 28 6a 73 6f 6e 29 0a 09 20 28 6a 73 6f 6e 2d ((json).. (json-
7f80: 77 72 69 74 65 20 74 61 72 67 65 74 73 29 29 0a write targets)).
7f90: 09 28 65 6c 73 65 0a 09 20 28 64 65 62 75 67 3a .(else.. (debug:
7fa0: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
7fb0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
7fc0: 20 22 64 75 6d 70 20 6f 75 74 70 75 74 20 66 6f "dump output fo
7fd0: 72 6d 61 74 20 22 20 28 61 72 67 73 3a 67 65 74 rmat " (args:get
7fe0: 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 -arg "-dumpmode"
7ff0: 29 20 22 20 6e 6f 74 20 73 75 70 70 6f 72 74 65 ) " not supporte
8000: 64 20 66 6f 72 20 2d 6c 69 73 74 2d 74 61 72 67 d for -list-targ
8010: 65 74 73 22 29 29 29 0a 20 20 20 20 20 20 28 73 ets"))). (s
8020: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
8030: 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 63 61 63 g* #t)))..;; cac
8040: 68 65 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 he the runconfig
8050: 73 20 69 6e 20 24 4d 54 5f 4c 49 4e 4b 54 52 45 s in $MT_LINKTRE
8060: 45 2f 24 4d 54 5f 54 41 52 47 45 54 2f 24 4d 54 E/$MT_TARGET/$MT
8070: 5f 52 55 4e 4e 41 4d 45 2f 2e 72 75 6e 63 6f 6e _RUNNAME/.runcon
8080: 66 69 67 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 fig.;;.(define (
8090: 66 75 6c 6c 2d 72 75 6e 63 6f 6e 66 69 67 73 2d full-runconfigs-
80a0: 72 65 61 64 29 0a 3b 3b 20 69 6e 20 74 68 65 20 read).;; in the
80b0: 65 6e 76 70 72 6f 63 65 73 73 69 6e 67 20 62 72 envprocessing br
80c0: 61 6e 63 68 20 74 68 65 20 62 65 6c 6f 77 20 63 anch the below c
80d0: 6f 64 65 20 72 65 70 6c 61 63 65 73 20 74 68 65 ode replaces the
80e0: 20 66 75 72 74 68 65 72 20 62 65 6c 6f 77 20 63 further below c
80f0: 6f 64 65 0a 3b 3b 20 20 28 69 66 20 28 65 71 3f ode.;; (if (eq?
8100: 20 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 2a 20 *configstatus*
8110: 27 66 75 6c 6c 64 61 74 61 29 0a 3b 3b 20 20 20 'fulldata).;;
8120: 20 20 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 *runconfigdat
8130: 2a 0a 3b 3b 20 20 20 20 20 20 28 62 65 67 69 6e *.;; (begin
8140: 0a 3b 3b 09 28 6c 61 75 6e 63 68 3a 73 65 74 75 .;;.(launch:setu
8150: 70 29 0a 3b 3b 09 2a 72 75 6e 63 6f 6e 66 69 67 p).;;.*runconfig
8160: 64 61 74 2a 29 29 29 0a 0a 20 20 28 6c 65 74 2a dat*))).. (let*
8170: 20 28 28 72 75 6e 64 69 72 20 28 69 66 20 28 61 ((rundir (if (a
8180: 6e 64 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 4c nd (getenv "MT_L
8190: 49 4e 4b 54 52 45 45 22 29 28 67 65 74 65 6e 76 INKTREE")(getenv
81a0: 20 22 4d 54 5f 54 41 52 47 45 54 22 29 28 67 65 "MT_TARGET")(ge
81b0: 74 65 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 tenv "MT_RUNNAME
81c0: 22 29 29 0a 09 09 20 20 20 20 20 28 63 6f 6e 63 "))... (conc
81d0: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 4c 49 4e (getenv "MT_LIN
81e0: 4b 54 52 45 45 22 29 20 22 2f 22 20 28 67 65 74 KTREE") "/" (get
81f0: 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 env "MT_TARGET")
8200: 20 22 2f 22 20 28 67 65 74 65 6e 76 20 22 4d 54 "/" (getenv "MT
8210: 5f 52 55 4e 4e 41 4d 45 22 29 29 0a 09 09 20 20 _RUNNAME"))...
8220: 20 20 20 23 66 29 29 0a 09 20 28 63 66 67 66 20 #f)).. (cfgf
8230: 20 20 28 69 66 20 72 75 6e 64 69 72 20 28 63 6f (if rundir (co
8240: 6e 63 20 72 75 6e 64 69 72 20 22 2f 2e 72 75 6e nc rundir "/.run
8250: 63 6f 6e 66 69 67 2e 22 20 6d 65 67 61 74 65 73 config." megates
8260: 74 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 t-version "-" me
8270: 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 gatest-fossil-ha
8280: 73 68 29 20 23 66 29 29 29 0a 20 20 20 20 28 69 sh) #f))). (i
8290: 66 20 28 61 6e 64 20 63 66 67 66 0a 09 20 20 20 f (and cfgf..
82a0: 20 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 (file-exists?
82b0: 63 66 67 66 29 0a 09 20 20 20 20 20 28 66 69 6c cfgf).. (fil
82c0: 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 e-write-access?
82d0: 63 66 67 66 29 29 0a 09 28 63 6f 6e 66 69 67 66 cfgf))..(configf
82e0: 3a 72 65 61 64 2d 61 6c 69 73 74 20 63 66 67 66 :read-alist cfgf
82f0: 29 0a 09 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 )..(let* ((keys
8300: 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 (rmt:get-keys)
8310: 29 0a 09 20 20 20 20 20 20 20 28 74 61 72 67 65 ).. (targe
8320: 74 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 t (common:args-g
8330: 65 74 2d 74 61 72 67 65 74 29 29 0a 09 20 20 20 et-target))..
8340: 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 28 69 (key-vals (i
8350: 66 20 74 61 72 67 65 74 20 28 6b 65 79 73 3a 74 f target (keys:t
8360: 61 72 67 65 74 2d 3e 6b 65 79 76 61 6c 20 6b 65 arget->keyval ke
8370: 79 73 20 74 61 72 67 65 74 29 20 23 66 29 29 0a ys target) #f)).
8380: 09 20 20 20 20 20 20 20 28 73 65 63 74 69 6f 6e . (section
8390: 73 20 28 69 66 20 74 61 72 67 65 74 20 28 6c 69 s (if target (li
83a0: 73 74 20 22 64 65 66 61 75 6c 74 22 20 74 61 72 st "default" tar
83b0: 67 65 74 29 20 23 66 29 29 0a 09 20 20 20 20 20 get) #f))..
83c0: 20 20 28 64 61 74 61 20 20 20 20 20 28 62 65 67 (data (beg
83d0: 69 6e 0a 09 09 09 20 20 20 28 73 65 74 65 6e 76 in.... (setenv
83e0: 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f "MT_RUN_AREA_HO
83f0: 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 ME" *toppath*)..
8400: 09 09 20 20 20 28 69 66 20 6b 65 79 2d 76 61 6c .. (if key-val
8410: 73 0a 09 09 09 20 20 20 20 20 20 20 28 66 6f 72 s.... (for
8420: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b -each (lambda (k
8430: 74 29 0a 09 09 09 09 09 20 20 20 28 73 65 74 65 t)...... (sete
8440: 6e 76 20 28 63 61 72 20 6b 74 29 20 28 63 61 64 nv (car kt) (cad
8450: 72 20 6b 74 29 29 29 0a 09 09 09 09 09 20 6b 65 r kt)))...... ke
8460: 79 2d 76 61 6c 73 29 29 0a 09 09 09 20 20 20 28 y-vals)).... (
8470: 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 6f 6e read-config (con
8480: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 c *toppath* "/ru
8490: 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 nconfigs.config"
84a0: 29 20 23 66 20 23 74 20 73 65 63 74 69 6f 6e 73 ) #f #t sections
84b0: 3a 20 73 65 63 74 69 6f 6e 73 29 29 29 29 0a 09 : sections))))..
84c0: 20 20 28 69 66 20 28 61 6e 64 20 72 75 6e 64 69 (if (and rundi
84d0: 72 20 3b 3b 20 68 61 76 65 20 61 6c 6c 20 6e 65 r ;; have all ne
84e0: 65 64 65 64 20 76 61 72 69 61 62 6c 65 73 73 0a eded variabless.
84f0: 09 09 20 20 20 28 64 69 72 65 63 74 6f 72 79 2d .. (directory-
8500: 65 78 69 73 74 73 3f 20 72 75 6e 64 69 72 29 0a exists? rundir).
8510: 09 09 20 20 20 28 66 69 6c 65 2d 77 72 69 74 65 .. (file-write
8520: 2d 61 63 63 65 73 73 3f 20 72 75 6e 64 69 72 29 -access? rundir)
8530: 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ).. (begin.
8540: 09 09 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 65 ..(configf:write
8550: 2d 61 6c 69 73 74 20 64 61 74 61 20 63 66 67 66 -alist data cfgf
8560: 29 0a 09 09 3b 3b 20 66 6f 72 63 65 20 72 65 2d )...;; force re-
8570: 72 65 61 64 20 6f 66 20 6d 65 67 61 74 65 73 74 read of megatest
8580: 2e 63 6f 6e 66 69 67 20 2d 20 74 68 69 73 20 72 .config - this r
8590: 65 73 6f 6c 76 65 73 20 63 69 72 63 75 6c 61 72 esolves circular
85a0: 20 72 65 66 65 72 65 6e 63 65 73 20 62 65 74 77 references betw
85b0: 65 65 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e een megatest.con
85c0: 66 69 67 0a 09 09 28 6c 61 75 6e 63 68 3a 73 65 fig...(launch:se
85d0: 74 75 70 20 66 6f 72 63 65 3a 20 23 74 29 0a 09 tup force: #t)..
85e0: 09 28 6c 61 75 6e 63 68 3a 63 61 63 68 65 2d 63 .(launch:cache-c
85f0: 6f 6e 66 69 67 29 29 29 20 3b 3b 20 77 65 20 63 onfig))) ;; we c
8600: 61 6e 20 73 61 66 65 6c 79 20 63 61 63 68 65 20 an safely cache
8610: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 megatest.config
8620: 73 69 6e 63 65 20 77 65 20 68 61 76 65 20 61 20 since we have a
8630: 76 61 6c 69 64 20 72 75 6e 63 6f 6e 66 69 67 0a valid runconfig.
8640: 09 20 20 64 61 74 61 29 29 29 29 0a 0a 28 69 66 . data))))..(if
8650: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8660: 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 22 -show-runconfig"
8670: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 ). (let ((tl
8680: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 (launch:setup)))
8690: 0a 20 20 20 20 20 20 28 70 75 73 68 2d 64 69 72 . (push-dir
86a0: 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a ectory *toppath*
86b0: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 ). (let ((d
86c0: 61 74 61 20 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e ata (full-runcon
86d0: 66 69 67 73 2d 72 65 61 64 29 29 29 0a 09 3b 3b figs-read)))..;;
86e0: 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c keep this one l
86f0: 6f 63 61 6c 0a 09 28 63 6f 6e 64 0a 09 20 28 28 ocal..(cond.. ((
8700: 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 and (args:get-ar
8710: 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 0a 09 20 g "-section")..
8720: 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
8730: 61 72 67 20 22 2d 76 61 72 22 29 29 0a 09 20 20 arg "-var"))..
8740: 28 6c 65 74 20 28 28 76 61 6c 20 28 6f 72 20 28 (let ((val (or (
8750: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 configf:lookup d
8760: 61 74 61 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ata (args:get-ar
8770: 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 28 61 72 g "-section")(ar
8780: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 gs:get-arg "-var
8790: 22 29 29 0a 09 09 09 20 28 63 6f 6e 66 69 67 66 ")).... (configf
87a0: 3a 6c 6f 6f 6b 75 70 20 64 61 74 61 20 22 64 65 :lookup data "de
87b0: 66 61 75 6c 74 22 20 28 61 72 67 73 3a 67 65 74 fault" (args:get
87c0: 2d 61 72 67 20 22 2d 76 61 72 22 29 29 29 29 29 -arg "-var")))))
87d0: 0a 09 20 20 20 20 28 69 66 20 76 61 6c 20 28 70 .. (if val (p
87e0: 72 69 6e 74 20 76 61 6c 29 29 29 29 0a 09 20 28 rint val)))).. (
87f0: 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 (not (args:get-a
8800: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 29 rg "-dumpmode"))
8810: 0a 09 20 20 28 70 70 20 28 68 61 73 68 2d 74 61 .. (pp (hash-ta
8820: 62 6c 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 29 ble->alist data)
8830: 29 29 0a 09 20 28 28 73 74 72 69 6e 67 3d 3f 20 )).. ((string=?
8840: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8850: 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e dumpmode") "json
8860: 22 29 0a 09 20 20 28 6a 73 6f 6e 2d 77 72 69 74 ").. (json-writ
8870: 65 20 64 61 74 61 29 29 0a 09 20 28 28 73 74 72 e data)).. ((str
8880: 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d ing=? (args:get-
8890: 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 arg "-dumpmode")
88a0: 20 22 69 6e 69 22 29 0a 09 20 20 28 63 6f 6e 66 "ini").. (conf
88b0: 69 67 66 3a 63 6f 6e 66 69 67 2d 3e 69 6e 69 20 igf:config->ini
88c0: 64 61 74 61 29 29 0a 09 20 28 65 6c 73 65 0a 09 data)).. (else..
88d0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
88e0: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
88f0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 64 75 6d 70 log-port* "-dump
8900: 6d 6f 64 65 20 6f 66 20 22 20 28 61 72 67 73 3a mode of " (args:
8910: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
8920: 64 65 22 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 de") " not recog
8930: 6e 69 73 65 64 22 29 29 29 0a 09 28 73 65 74 21 nised")))..(set!
8940: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
8950: 23 74 29 29 0a 20 20 20 20 20 20 28 70 6f 70 2d #t)). (pop-
8960: 64 69 72 65 63 74 6f 72 79 29 29 29 0a 0a 28 69 directory)))..(i
8970: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
8980: 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 22 29 0a "-show-config").
8990: 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 20 20 (let ((tl
89a0: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
89b0: 09 20 20 28 64 61 74 61 20 2a 63 6f 6e 66 69 67 . (data *config
89c0: 64 61 74 2a 29 29 20 3b 3b 20 28 72 65 61 64 2d dat*)) ;; (read-
89d0: 63 6f 6e 66 69 67 20 22 6d 65 67 61 74 65 73 74 config "megatest
89e0: 2e 63 6f 6e 66 69 67 22 20 23 66 20 23 74 29 29 .config" #f #t))
89f0: 29 0a 20 20 20 20 20 20 28 70 75 73 68 2d 64 69 ). (push-di
8a00: 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 rectory *toppath
8a10: 2a 29 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 *). ;; keep
8a20: 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a this one local.
8a30: 20 20 20 20 20 20 28 63 6f 6e 64 20 0a 20 20 20 (cond .
8a40: 20 20 20 20 28 28 61 6e 64 20 28 61 72 67 73 3a ((and (args:
8a50: 67 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f get-arg "-sectio
8a60: 6e 22 29 0a 09 20 20 20 20 20 28 61 72 67 73 3a n").. (args:
8a70: 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 get-arg "-var"))
8a80: 0a 09 28 6c 65 74 20 28 28 76 61 6c 20 28 63 6f ..(let ((val (co
8a90: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 nfigf:lookup dat
8aa0: 61 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 a (args:get-arg
8ab0: 22 2d 73 65 63 74 69 6f 6e 22 29 28 61 72 67 73 "-section")(args
8ac0: 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 :get-arg "-var")
8ad0: 29 29 29 0a 09 20 20 28 69 66 20 76 61 6c 20 28 ))).. (if val (
8ae0: 70 72 69 6e 74 20 76 61 6c 29 29 29 29 0a 0a 20 print val))))..
8af0: 20 20 20 20 20 20 3b 3b 20 70 72 69 6e 74 20 6a ;; print j
8b00: 75 73 74 20 61 20 73 65 63 74 69 6f 6e 20 69 66 ust a section if
8b10: 20 6f 6e 6c 79 20 2d 73 65 63 74 69 6f 6e 0a 0a only -section..
8b20: 20 20 20 20 20 20 20 28 28 6e 6f 74 20 28 61 72 ((not (ar
8b30: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d gs:get-arg "-dum
8b40: 70 6d 6f 64 65 22 29 29 0a 09 28 70 70 20 28 68 pmode"))..(pp (h
8b50: 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 ash-table->alist
8b60: 20 64 61 74 61 29 29 29 0a 20 20 20 20 20 20 20 data))).
8b70: 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 ((string=? (args
8b80: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
8b90: 6f 64 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 28 ode") "json")..(
8ba0: 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 29 json-write data)
8bb0: 29 0a 20 20 20 20 20 20 20 28 28 73 74 72 69 6e ). ((strin
8bc0: 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 g=? (args:get-ar
8bd0: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
8be0: 69 6e 69 22 29 0a 09 28 63 6f 6e 66 69 67 66 3a ini")..(configf:
8bf0: 63 6f 6e 66 69 67 2d 3e 69 6e 69 20 64 61 74 61 config->ini data
8c00: 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65 0a )). (else.
8c10: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 .(debug:print-er
8c20: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
8c30: 6f 67 2d 70 6f 72 74 2a 20 22 2d 64 75 6d 70 6d og-port* "-dumpm
8c40: 6f 64 65 20 6f 66 20 22 20 28 61 72 67 73 3a 67 ode of " (args:g
8c50: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
8c60: 65 22 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 6e e") " not recogn
8c70: 69 73 65 64 22 29 29 29 0a 20 20 20 20 20 20 28 ised"))). (
8c80: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
8c90: 6e 67 2a 20 23 74 29 0a 20 20 20 20 20 20 28 70 ng* #t). (p
8ca0: 6f 70 2d 64 69 72 65 63 74 6f 72 79 29 29 29 0a op-directory))).
8cb0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
8cc0: 72 67 20 22 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 rg "-show-cmdinf
8cd0: 6f 22 29 0a 20 20 20 20 28 69 66 20 28 6f 72 20 o"). (if (or
8ce0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
8cf0: 76 61 6c 75 65 22 29 28 67 65 74 65 6e 76 20 22 value")(getenv "
8d00: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 28 MT_CMDINFO"))..(
8d10: 6c 65 74 20 28 28 64 61 74 61 20 28 63 6f 6d 6d let ((data (comm
8d20: 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d on:read-encoded-
8d30: 73 74 72 69 6e 67 20 28 6f 72 20 28 61 72 67 73 string (or (args
8d40: 3a 67 65 74 2d 61 72 67 20 22 3a 76 61 6c 75 65 :get-arg ":value
8d50: 22 29 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d ")(getenv "MT_CM
8d60: 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 28 DINFO"))))).. (
8d70: 69 66 20 28 65 71 75 61 6c 3f 20 28 61 72 67 73 if (equal? (args
8d80: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
8d90: 6f 64 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 20 ode") "json")..
8da0: 20 20 20 20 20 28 6a 73 6f 6e 2d 77 72 69 74 65 (json-write
8db0: 20 64 61 74 61 29 0a 09 20 20 20 20 20 20 28 70 data).. (p
8dc0: 70 20 64 61 74 61 29 29 0a 09 20 20 28 73 65 74 p data)).. (set
8dd0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
8de0: 20 23 74 29 29 0a 09 28 64 65 62 75 67 3a 70 72 #t))..(debug:pr
8df0: 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
8e00: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 65 ult-log-port* "e
8e10: 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 nvironment varia
8e20: 62 6c 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 69 ble MT_CMDINFO i
8e30: 73 20 6e 6f 74 20 73 65 74 22 29 29 29 0a 0a 3b s not set")))..;
8e40: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
8e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e80: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 65 6d 6f 76 =======.;; Remov
8e90: 65 20 6f 6c 64 20 72 75 6e 28 73 29 0a 3b 3b 3d e old run(s).;;=
8ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ee0: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 69 6e 63 65 20 =====..;; since
8ef0: 73 65 76 65 72 61 6c 20 61 63 74 69 6f 6e 73 20 several actions
8f00: 63 61 6e 20 62 65 20 73 70 65 63 69 66 69 65 64 can be specified
8f10: 20 6f 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 on the command
8f20: 6c 69 6e 65 20 74 68 65 20 72 65 6d 6f 76 61 6c line the removal
8f30: 0a 3b 3b 20 69 73 20 64 6f 6e 65 20 66 69 72 73 .;; is done firs
8f40: 74 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 72 61 t.(define (opera
8f50: 74 65 2d 6f 6e 20 61 63 74 69 6f 6e 29 0a 20 20 te-on action).
8f60: 28 6c 65 74 2a 20 28 28 72 75 6e 72 65 63 20 28 (let* ((runrec (
8f70: 72 75 6e 73 3a 72 75 6e 72 65 63 2d 6d 61 6b 65 runs:runrec-make
8f80: 2d 72 65 63 6f 72 64 29 29 0a 09 20 28 74 61 72 -record)).. (tar
8f90: 67 65 74 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 get (common:args
8fa0: 2d 67 65 74 2d 74 61 72 67 65 74 29 29 29 0a 20 -get-target))).
8fb0: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 (cond. ((
8fc0: 6e 6f 74 20 74 61 72 67 65 74 29 0a 20 20 20 20 not target).
8fd0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
8fe0: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
8ff0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 69 log-port* "Missi
9000: 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 ng required para
9010: 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 meter for " acti
9020: 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 on ", you must s
9030: 70 65 63 69 66 79 20 2d 74 61 72 67 65 74 20 6f pecify -target o
9040: 72 20 2d 72 65 71 74 61 72 67 22 29 0a 20 20 20 r -reqtarg").
9050: 20 20 20 28 65 78 69 74 20 31 29 29 0a 20 20 20 (exit 1)).
9060: 20 20 28 28 6e 6f 74 20 28 6f 72 20 28 61 72 67 ((not (or (arg
9070: 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e s:get-arg ":runn
9080: 61 6d 65 22 29 0a 09 20 20 20 20 20 20 20 28 61 ame").. (a
9090: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
90a0: 6e 6e 61 6d 65 22 29 29 29 0a 20 20 20 20 20 20 nname"))).
90b0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
90c0: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
90d0: 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 69 6e 67 g-port* "Missing
90e0: 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 required parame
90f0: 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f 6e ter for " action
9100: 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 ", you must spe
9110: 63 69 66 79 20 74 68 65 20 72 75 6e 20 6e 61 6d cify the run nam
9120: 65 20 70 61 74 74 65 72 6e 20 77 69 74 68 20 2d e pattern with -
9130: 72 75 6e 6e 61 6d 65 20 70 61 74 74 22 29 0a 20 runname patt").
9140: 20 20 20 20 20 28 65 78 69 74 20 32 29 29 0a 20 (exit 2)).
9150: 20 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a ((not (args:
9160: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
9170: 74 74 22 29 29 0a 20 20 20 20 20 20 28 64 65 62 tt")). (deb
9180: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
9190: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
91a0: 72 74 2a 20 22 4d 69 73 73 69 6e 67 20 72 65 71 rt* "Missing req
91b0: 75 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 uired parameter
91c0: 66 6f 72 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 for " action ",
91d0: 79 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 you must specify
91e0: 20 74 68 65 20 74 65 73 74 20 70 61 74 74 65 72 the test patter
91f0: 6e 20 77 69 74 68 20 2d 74 65 73 74 70 61 74 74 n with -testpatt
9200: 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 33 "). (exit 3
9210: 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 )). (else.
9220: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 63 61 (if (not (ca
9230: 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 29 r *configinfo*))
9240: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
9250: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
9260: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
9270: 67 2d 70 6f 72 74 2a 20 22 41 74 74 65 6d 70 74 g-port* "Attempt
9280: 65 64 20 22 20 61 63 74 69 6f 6e 20 22 6f 6e 20 ed " action "on
9290: 74 65 73 74 28 73 29 20 62 75 74 20 72 75 6e 20 test(s) but run
92a0: 61 72 65 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 area config file
92b0: 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 09 20 20 not found")..
92c0: 20 20 28 65 78 69 74 20 31 29 29 0a 09 20 20 3b (exit 1)).. ;
92d0: 3b 20 70 75 74 20 74 65 73 74 20 70 61 72 61 6d ; put test param
92e0: 65 74 65 72 73 20 69 6e 74 6f 20 63 6f 6e 76 65 eters into conve
92f0: 6e 69 65 6e 74 20 76 61 72 69 61 62 6c 65 73 0a nient variables.
9300: 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 3b . (begin.. ;
9310: 3b 20 63 68 65 63 6b 20 66 6f 72 20 63 6f 72 72 ; check for corr
9320: 65 63 74 20 76 65 72 73 69 6f 6e 2c 20 65 78 69 ect version, exi
9330: 74 20 77 69 74 68 20 6d 65 73 73 61 67 65 20 69 t with message i
9340: 66 20 6e 6f 74 20 63 6f 72 72 65 63 74 0a 09 20 f not correct..
9350: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 65 78 69 74 2d (common:exit-
9360: 6f 6e 2d 76 65 72 73 69 6f 6e 2d 63 68 61 6e 67 on-version-chang
9370: 65 64 29 0a 09 20 20 20 20 28 72 75 6e 73 3a 6f ed).. (runs:o
9380: 70 65 72 61 74 65 2d 6f 6e 20 20 61 63 74 69 6f perate-on actio
9390: 6e 0a 09 09 09 20 20 20 20 20 20 74 61 72 67 65 n.... targe
93a0: 74 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d t.... (comm
93b0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e on:args-get-runn
93c0: 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 ame) ;; (or (ar
93d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
93e0: 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d name")(args:get-
93f0: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 arg ":runname"))
9400: 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f .... (commo
9410: 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 n:args-get-testp
9420: 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 att #f) ;; (args
9430: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 :get-arg "-testp
9440: 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 20 73 att").... s
9450: 74 61 74 65 3a 20 28 63 6f 6d 6d 6f 6e 3a 61 72 tate: (common:ar
9460: 67 73 2d 67 65 74 2d 73 74 61 74 65 29 0a 09 09 gs-get-state)...
9470: 09 20 20 20 20 20 20 73 74 61 74 75 73 3a 20 28 . status: (
9480: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
9490: 73 74 61 74 75 73 29 0a 09 09 09 20 20 20 20 20 status)....
94a0: 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 new-state-statu
94b0: 73 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 s: (args:get-arg
94c0: 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 "-set-state-sta
94d0: 74 75 73 22 29 29 29 29 0a 20 20 20 20 20 20 28 tus")))). (
94e0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
94f0: 6e 67 2a 20 23 74 29 29 29 29 29 0a 0a 28 69 66 ng* #t)))))..(if
9500: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9510: 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a 20 -remove-runs").
9520: 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
9530: 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 65 6d call . "-rem
9540: 6f 76 65 2d 72 75 6e 73 22 0a 20 20 20 20 20 22 ove-runs". "
9550: 72 65 6d 6f 76 65 20 72 75 6e 73 22 0a 20 20 20 remove runs".
9560: 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 (lambda (targe
9570: 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
9580: 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 eyvals). (
9590: 6f 70 65 72 61 74 65 2d 6f 6e 20 27 72 65 6d 6f operate-on 'remo
95a0: 76 65 2d 72 75 6e 73 29 29 29 29 0a 0a 28 69 66 ve-runs))))..(if
95b0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
95c0: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
95d0: 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c s"). (general
95e0: 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 -run-call .
95f0: 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 "-set-state-stat
9600: 75 73 22 0a 20 20 20 20 20 22 73 65 74 20 73 74 us". "set st
9610: 61 74 65 20 61 6e 64 20 73 74 61 74 75 73 22 0a ate and status".
9620: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 (lambda (ta
9630: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
9640: 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 s keyvals).
9650: 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 (operate-on 's
9660: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 et-state-status)
9670: 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 )))..(if (or (ar
9680: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
9690: 2d 72 75 6e 2d 73 74 61 74 75 73 22 29 0a 09 28 -run-status")..(
96a0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 args:get-arg "-g
96b0: 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 29 29 et-run-status"))
96c0: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
96d0: 6e 2d 63 61 6c 6c 0a 20 20 20 20 20 22 2d 73 65 n-call. "-se
96e0: 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 0a 20 20 t-run-status".
96f0: 20 20 20 22 73 65 74 20 72 75 6e 20 73 74 61 74 "set run stat
9700: 75 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 us". (lambda
9710: 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 (target runname
9720: 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 keys keyvals).
9730: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 (let* ((ru
9740: 6e 73 64 61 74 20 20 28 72 6d 74 3a 67 65 74 2d nsdat (rmt:get-
9750: 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 6b 65 79 runs-by-patt key
9760: 73 20 72 75 6e 6e 61 6d 65 20 0a 09 09 09 09 09 s runname ......
9770: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
9780: 2d 74 61 72 67 65 74 29 0a 09 09 09 09 09 23 66 -target)......#f
9790: 20 23 66 20 23 66 20 23 66 29 29 0a 09 20 20 20 #f #f #f))..
97a0: 20 20 20 28 68 65 61 64 65 72 20 20 20 28 76 65 (header (ve
97b0: 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 ctor-ref runsdat
97c0: 20 30 29 29 0a 09 20 20 20 20 20 20 28 72 6f 77 0)).. (row
97d0: 73 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 s (vector-re
97e0: 66 20 72 75 6e 73 64 61 74 20 31 29 29 29 0a 09 f runsdat 1)))..
97f0: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 6f 77 73 (if (null? rows
9800: 29 0a 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ).. (begin..
9810: 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
9820: 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
9830: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e ult-log-port* "N
9840: 6f 20 6d 61 74 63 68 69 6e 67 20 72 75 6e 20 66 o matching run f
9850: 6f 75 6e 64 2e 22 29 0a 09 20 20 20 20 20 20 20 ound.")..
9860: 28 65 78 69 74 20 31 29 29 0a 09 20 20 20 20 20 (exit 1))..
9870: 28 6c 65 74 2a 20 28 28 72 6f 77 20 20 20 20 20 (let* ((row
9880: 20 28 63 61 72 20 28 76 65 63 74 6f 72 2d 72 65 (car (vector-re
9890: 66 20 72 75 6e 73 64 61 74 20 31 29 29 29 0a 09 f runsdat 1)))..
98a0: 09 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 28 . (run-id (
98b0: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
98c0: 68 65 61 64 65 72 20 72 6f 77 20 68 65 61 64 65 header row heade
98d0: 72 20 22 69 64 22 29 29 29 0a 09 20 20 20 20 20 r "id")))..
98e0: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
98f0: 61 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 arg "-set-run-st
9900: 61 74 75 73 22 29 0a 09 09 20 20 20 28 72 6d 74 atus")... (rmt
9910: 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 :set-run-status
9920: 72 75 6e 2d 69 64 20 28 61 72 67 73 3a 67 65 74 run-id (args:get
9930: 2d 61 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 -arg "-set-run-s
9940: 74 61 74 75 73 22 29 20 6d 73 67 3a 20 28 61 72 tatus") msg: (ar
9950: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
9960: 29 0a 09 09 20 20 20 28 70 72 69 6e 74 20 28 72 )... (print (r
9970: 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 mt:get-run-statu
9980: 73 20 72 75 6e 2d 69 64 29 29 0a 09 09 20 20 20 s run-id))...
9990: 29 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d )))))))..;;=====
99a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99e0: 3d 0a 3b 3b 20 51 75 65 72 79 20 72 75 6e 73 0a =.;; Query runs.
99f0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
9a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a30: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 2d 66 69 ========..;; -fi
9a40: 65 6c 64 73 20 72 75 6e 73 3a 69 64 2c 74 61 72 elds runs:id,tar
9a50: 67 65 74 2c 72 75 6e 6e 61 6d 65 2c 63 6f 6d 6d get,runname,comm
9a60: 65 6e 74 2b 74 65 73 74 73 3a 69 64 2c 74 65 73 ent+tests:id,tes
9a70: 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2b tname,item_path+
9a80: 73 74 65 70 73 0a 3b 3b 0a 3b 3b 20 63 73 69 3e steps.;;.;; csi>
9a90: 20 28 65 78 74 72 61 63 74 2d 66 69 65 6c 64 73 (extract-fields
9aa0: 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 22 72 75 -constraints "ru
9ab0: 6e 73 3a 69 64 2c 74 61 72 67 65 74 2c 72 75 6e ns:id,target,run
9ac0: 6e 61 6d 65 2c 63 6f 6d 6d 65 6e 74 2b 74 65 73 name,comment+tes
9ad0: 74 73 3a 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 ts:id,testname,i
9ae0: 74 65 6d 5f 70 61 74 68 2b 73 74 65 70 73 22 29 tem_path+steps")
9af0: 0a 3b 3b 20 20 20 20 20 20 20 20 20 3d 3e 20 28 .;; => (
9b00: 28 22 72 75 6e 73 22 20 22 69 64 22 20 22 74 61 ("runs" "id" "ta
9b10: 72 67 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 20 rget" "runname"
9b20: 22 63 6f 6d 6d 65 6e 74 22 29 20 28 22 74 65 73 "comment") ("tes
9b30: 74 73 22 20 22 69 64 22 20 22 74 65 73 74 6e 61 ts" "id" "testna
9b40: 6d 65 22 20 22 69 74 65 6d 5f 70 61 74 68 22 29 me" "item_path")
9b50: 20 28 22 73 74 65 70 73 22 29 29 0a 3b 3b 0a 3b ("steps")).;;.;
9b60: 3b 20 20 20 4e 4f 54 45 3a 20 72 65 6d 65 6d 62 ; NOTE: rememb
9b70: 65 72 20 74 68 61 74 20 74 68 65 20 63 64 72 20 er that the cdr
9b80: 77 69 6c 6c 20 62 65 20 74 68 65 20 6c 69 73 74 will be the list
9b90: 20 79 6f 75 20 65 78 70 65 63 74 20 28 63 64 72 you expect (cdr
9ba0: 20 28 22 72 75 6e 73 22 20 22 69 64 22 20 22 74 ("runs" "id" "t
9bb0: 61 72 67 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 arget" "runname"
9bc0: 20 22 63 6f 6d 6d 65 6e 74 22 29 29 20 3d 3e 20 "comment")) =>
9bd0: 28 22 69 64 22 20 22 74 61 72 67 65 74 22 20 22 ("id" "target" "
9be0: 72 75 6e 6e 61 6d 65 22 20 22 63 6f 6d 6d 65 6e runname" "commen
9bf0: 74 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 61 t").;; a
9c00: 6e 64 20 73 6f 20 61 6c 69 73 74 2d 72 65 66 20 nd so alist-ref
9c10: 77 69 6c 6c 20 79 69 65 6c 64 20 77 68 61 74 20 will yield what
9c20: 79 6f 75 20 65 78 70 65 63 74 0a 3b 3b 0a 28 64 you expect.;;.(d
9c30: 65 66 69 6e 65 20 28 65 78 74 72 61 63 74 2d 66 efine (extract-f
9c40: 69 65 6c 64 73 2d 63 6f 6e 73 74 72 61 69 6e 74 ields-constraint
9c50: 73 20 66 69 65 6c 64 73 2d 73 70 65 63 29 0a 20 s fields-spec).
9c60: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 74 (map (lambda (t
9c70: 61 62 6c 65 2d 73 70 65 63 29 20 3b 3b 20 72 75 able-spec) ;; ru
9c80: 6e 73 3a 69 64 2c 74 61 72 67 65 74 2c 72 75 6e ns:id,target,run
9c90: 6e 61 6d 65 0a 09 20 28 6c 65 74 20 28 28 64 61 name.. (let ((da
9ca0: 74 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 t (string-split
9cb0: 74 61 62 6c 65 2d 73 70 65 63 20 22 3a 22 29 29 table-spec ":"))
9cc0: 29 20 3b 3b 20 28 22 72 75 6e 73 22 20 22 69 64 ) ;; ("runs" "id
9cd0: 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 22 ,target,runname"
9ce0: 29 0a 09 20 20 20 28 69 66 20 28 3e 20 28 6c 65 ).. (if (> (le
9cf0: 6e 67 74 68 20 64 61 74 29 20 31 29 0a 09 20 20 ngth dat) 1)..
9d00: 20 20 20 20 20 28 63 6f 6e 73 20 28 63 61 72 20 (cons (car
9d10: 64 61 74 29 28 73 74 72 69 6e 67 2d 73 70 6c 69 dat)(string-spli
9d20: 74 20 28 63 61 64 72 20 64 61 74 29 20 22 2c 22 t (cadr dat) ","
9d30: 29 29 20 3b 3b 20 22 69 64 2c 74 61 72 67 65 74 )) ;; "id,target
9d40: 2c 72 75 6e 6e 61 6d 65 22 0a 09 20 20 20 20 20 ,runname"..
9d50: 20 20 64 61 74 29 29 29 0a 20 20 20 20 20 20 20 dat))).
9d60: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 66 69 (string-split fi
9d70: 65 6c 64 73 2d 73 70 65 63 20 22 2b 22 29 29 29 elds-spec "+")))
9d80: 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d 76 ..(define (get-v
9d90: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
9da0: 65 20 64 61 74 61 76 65 63 20 74 65 73 74 2d 66 e datavec test-f
9db0: 69 65 6c 64 2d 69 6e 64 65 78 20 66 69 65 6c 64 ield-index field
9dc0: 6e 61 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 69 name). (let ((i
9dd0: 6e 64 78 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ndx (hash-table-
9de0: 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 ref/default test
9df0: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 66 69 65 -field-index fie
9e00: 6c 64 6e 61 6d 65 20 23 66 29 29 29 0a 20 20 20 ldname #f))).
9e10: 20 28 69 66 20 69 6e 64 78 0a 09 28 69 66 20 28 (if indx..(if (
9e20: 3e 3d 20 69 6e 64 78 20 28 76 65 63 74 6f 72 2d >= indx (vector-
9e30: 6c 65 6e 67 74 68 20 64 61 74 61 76 65 63 29 29 length datavec))
9e40: 0a 09 20 20 20 20 23 66 20 3b 3b 20 69 6e 64 65 .. #f ;; inde
9e50: 78 20 74 6f 6f 20 68 69 67 68 2c 20 73 68 6f 75 x too high, shou
9e60: 6c 64 20 72 61 69 73 65 20 61 6e 20 65 72 72 6f ld raise an erro
9e70: 72 20 49 20 73 75 70 70 6f 73 65 0a 09 20 20 20 r I suppose..
9e80: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 64 61 74 (vector-ref dat
9e90: 61 76 65 63 20 69 6e 64 78 29 29 0a 09 23 66 29 avec indx))..#f)
9ea0: 29 29 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 6c 69 73 ))..;; NOTE: lis
9eb0: 74 2d 72 75 6e 73 20 61 6e 64 20 6c 69 73 74 2d t-runs and list-
9ec0: 64 62 2d 74 61 72 67 65 74 73 20 6f 70 65 72 61 db-targets opera
9ed0: 74 65 20 6f 6e 20 6c 6f 63 61 6c 20 64 62 21 21 te on local db!!
9ee0: 21 0a 3b 3b 0a 3b 3b 20 49 44 45 41 3a 20 6d 65 !.;;.;; IDEA: me
9ef0: 67 61 74 65 73 74 20 6c 69 73 74 20 2d 72 75 6e gatest list -run
9f00: 6e 61 6d 65 20 62 6c 61 68 25 20 2e 2e 2e 0a 3b name blah% ....;
9f10: 3b 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a ;.(if (or (args:
9f20: 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 get-arg "-list-r
9f30: 75 6e 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 uns")..(args:get
9f40: 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 -arg "-list-db-t
9f50: 61 72 67 65 74 73 22 29 29 0a 20 20 20 20 28 69 argets")). (i
9f60: 66 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 f (launch:setup)
9f70: 0a 09 28 6c 65 74 2a 20 28 3b 3b 20 28 64 62 73 ..(let* (;; (dbs
9f80: 74 72 75 63 74 20 20 20 20 28 6d 61 6b 65 2d 64 truct (make-d
9f90: 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 68 br:dbstruct path
9fa0: 3a 20 2a 74 6f 70 70 61 74 68 2a 20 6c 6f 63 61 : *toppath* loca
9fb0: 6c 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 l: (args:get-arg
9fc0: 20 22 2d 6c 6f 63 61 6c 22 29 29 29 0a 09 20 20 "-local")))..
9fd0: 20 20 20 20 20 28 72 75 6e 70 61 74 74 20 20 20 (runpatt
9fe0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
9ff0: 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 29 0a 20 "-list-runs")).
a000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
a010: 63 63 65 73 73 2d 6d 6f 64 65 20 28 64 62 3a 67 ccess-mode (db:g
a020: 65 74 2d 61 63 63 65 73 73 2d 6d 6f 64 65 29 29 et-access-mode))
a030: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 61 .. (testpa
a040: 74 74 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 tt (common:ar
a050: 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 gs-get-testpatt
a060: 23 66 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 #f)).. ;;
a070: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
a080: 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 20 0a g "-testpatt") .
a090: 09 20 20 20 20 20 20 20 3b 3b 20 20 09 20 20 20 . ;; .
a0a0: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
a0b0: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 20 rg "-testpatt")
a0c0: 0a 09 20 20 20 20 20 20 20 3b 3b 20 20 09 20 20 .. ;; .
a0d0: 20 20 20 20 20 20 22 25 22 29 29 0a 09 20 20 20 "%"))..
a0e0: 20 20 20 20 28 6b 65 79 73 20 20 20 20 20 20 20 (keys
a0f0: 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 (rmt:get-keys))
a100: 20 3b 3b 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 ;; (db:get-keys
a110: 20 64 62 73 74 72 75 63 74 29 29 0a 09 20 20 20 dbstruct))..
a120: 20 20 20 20 3b 3b 20 28 72 75 6e 73 64 61 74 20 ;; (runsdat
a130: 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 20 64 62 (db:get-runs db
a140: 73 74 72 75 63 74 20 72 75 6e 70 61 74 74 20 23 struct runpatt #
a150: 66 20 23 66 20 27 28 29 29 29 0a 09 3b 3b 20 28 f #f '()))..;; (
a160: 72 75 6e 73 64 61 74 20 20 20 20 20 28 72 6d 74 runsdat (rmt
a170: 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 :get-runs-by-pat
a180: 74 20 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 61 t keys (or runpa
a190: 74 74 20 22 25 22 29 20 28 63 6f 6d 6d 6f 6e 3a tt "%") (common:
a1a0: 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 args-get-target)
a1b0: 20 3b 3b 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 ;; (db:get-runs
a1c0: 2d 62 79 2d 70 61 74 74 20 64 62 73 74 72 75 63 -by-patt dbstruc
a1d0: 74 20 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 61 t keys (or runpa
a1e0: 74 74 20 22 25 22 29 20 28 63 6f 6d 6d 6f 6e 3a tt "%") (common:
a1f0: 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 args-get-target)
a200: 0a 09 3b 3b 20 09 09 20 20 20 20 20 20 20 20 20 ..;; ..
a210: 20 20 09 20 23 66 20 23 66 20 27 28 22 69 64 22 . #f #f '("id"
a220: 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 "runname" "stat
a230: 65 22 20 22 73 74 61 74 75 73 22 20 22 6f 77 6e e" "status" "own
a240: 65 72 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 er" "event_time"
a250: 20 22 63 6f 6d 6d 65 6e 74 22 29 20 30 29 29 0a "comment") 0)).
a260: 09 20 20 20 20 20 20 20 28 72 75 6e 73 64 61 74 . (runsdat
a270: 20 20 20 20 20 28 64 62 3a 64 69 73 70 61 74 63 (db:dispatc
a280: 68 2d 71 75 65 72 79 20 61 63 63 65 73 73 2d 6d h-query access-m
a290: 6f 64 65 20 72 6d 74 3a 67 65 74 2d 72 75 6e 73 ode rmt:get-runs
a2a0: 2d 62 79 2d 70 61 74 74 20 64 62 3a 67 65 74 2d -by-patt db:get-
a2b0: 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 6b 65 79 runs-by-patt key
a2c0: 73 20 28 6f 72 20 72 75 6e 70 61 74 74 20 22 25 s (or runpatt "%
a2d0: 22 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 ") .
a2e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a2f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a300: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
a310: 2d 74 61 72 67 65 74 29 20 23 66 20 23 66 20 27 -target) #f #f '
a320: 28 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 ("id" "runname"
a330: 22 73 74 61 74 65 22 20 22 73 74 61 74 75 73 22 "state" "status"
a340: 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f "owner" "event_
a350: 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 time" "comment")
a360: 20 30 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 0)).. (ru
a370: 6e 73 74 6d 70 20 20 20 20 20 28 64 62 3a 67 65 nstmp (db:ge
a380: 74 2d 72 6f 77 73 20 72 75 6e 73 64 61 74 29 29 t-rows runsdat))
a390: 0a 09 20 20 20 20 20 20 20 28 68 65 61 64 65 72 .. (header
a3a0: 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 68 65 (db:get-he
a3b0: 61 64 65 72 20 72 75 6e 73 64 61 74 29 29 0a 09 ader runsdat))..
a3c0: 20 20 20 20 20 20 20 3b 3b 20 74 68 69 73 20 69 ;; this i
a3d0: 73 20 22 2d 73 69 6e 63 65 22 20 73 75 70 70 6f s "-since" suppo
a3e0: 72 74 2e 20 54 68 69 73 20 6c 6f 6f 6b 73 20 61 rt. This looks a
a3f0: 74 20 6c 61 73 74 20 6d 6f 64 20 74 69 6d 65 73 t last mod times
a400: 20 6f 66 20 3c 72 75 6e 2d 69 64 3e 2e 64 62 20 of <run-id>.db
a410: 66 69 6c 65 73 0a 09 20 20 20 20 20 20 20 3b 3b files.. ;;
a420: 20 61 6e 64 20 63 6f 6c 6c 65 63 74 73 20 74 68 and collects th
a430: 6f 73 65 20 6d 6f 64 69 66 69 65 64 20 73 69 6e ose modified sin
a440: 63 65 20 74 68 65 20 2d 73 69 6e 63 65 20 74 69 ce the -since ti
a450: 6d 65 2e 0a 09 20 20 20 20 20 20 20 28 72 75 6e me... (run
a460: 73 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e s (if (an
a470: 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 75 d (not (null? ru
a480: 6e 73 74 6d 70 29 29 0a 09 09 09 09 20 20 20 20 nstmp)).....
a490: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
a4a0: 2d 73 69 6e 63 65 22 29 29 0a 09 09 09 09 28 6c -since")).....(l
a4b0: 65 74 20 28 28 63 68 61 6e 67 65 64 2d 69 64 73 et ((changed-ids
a4c0: 20 28 64 62 3a 67 65 74 2d 63 68 61 6e 67 65 64 (db:get-changed
a4d0: 2d 72 75 6e 2d 69 64 73 20 28 73 74 72 69 6e 67 -run-ids (string
a4e0: 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 ->number (args:g
a4f0: 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 22 29 et-arg "-since")
a500: 29 29 29 29 0a 09 09 09 09 20 20 28 6c 65 74 20 ))))..... (let
a510: 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 loop ((hed (car
a520: 72 75 6e 73 74 6d 70 29 29 0a 09 09 09 09 09 20 runstmp))......
a530: 20 20 20 20 28 74 61 6c 20 28 63 64 72 20 72 75 (tal (cdr ru
a540: 6e 73 74 6d 70 29 29 0a 09 09 09 09 09 20 20 20 nstmp))......
a550: 20 20 28 72 65 73 20 27 28 29 29 29 0a 09 09 09 (res '()))....
a560: 09 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 2d . (let ((new-
a570: 72 65 73 20 28 69 66 20 28 6d 65 6d 62 65 72 20 res (if (member
a580: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
a590: 2d 68 65 61 64 65 72 20 68 65 64 20 68 65 61 64 -header hed head
a5a0: 65 72 20 22 69 64 22 29 20 63 68 61 6e 67 65 64 er "id") changed
a5b0: 2d 69 64 73 29 0a 09 09 09 09 09 09 20 20 20 20 -ids).......
a5c0: 20 20 20 28 63 6f 6e 73 20 68 65 64 20 72 65 73 (cons hed res
a5d0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 72 )....... r
a5e0: 65 73 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 es))).....
a5f0: 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a (if (null? tal).
a600: 09 09 09 09 09 20 20 28 72 65 76 65 72 73 65 20 ..... (reverse
a610: 6e 65 77 2d 72 65 73 29 0a 09 09 09 09 09 20 20 new-res)......
a620: 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 (loop (car tal)(
a630: 63 64 72 20 74 61 6c 29 20 6e 65 77 2d 72 65 73 cdr tal) new-res
a640: 29 29 29 29 29 0a 09 09 09 09 72 75 6e 73 74 6d ))))).....runstm
a650: 70 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d p)).. (db-
a660: 74 61 72 67 65 74 73 20 20 28 61 72 67 73 3a 67 targets (args:g
a670: 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 et-arg "-list-db
a680: 2d 74 61 72 67 65 74 73 22 29 29 0a 09 20 20 20 -targets"))..
a690: 20 20 20 20 28 73 65 65 6e 20 20 20 20 20 20 20 (seen
a6a0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
a6b0: 65 29 29 0a 09 20 20 20 20 20 20 20 28 64 6d 6f e)).. (dmo
a6c0: 64 65 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 de (let ((
a6d0: 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
a6e0: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 29 29 0a 09 "-dumpmode")))..
a6f0: 09 09 20 20 20 20 20 20 28 69 66 20 64 20 28 73 .. (if d (s
a700: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 64 29 tring->symbol d)
a710: 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 28 #f))).. (
a720: 64 61 74 61 20 20 20 20 20 20 20 20 28 6d 61 6b data (mak
a730: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 e-hash-table))..
a740: 20 20 20 20 20 20 20 28 66 69 65 6c 64 73 2d 73 (fields-s
a750: 70 65 63 20 28 69 66 20 28 61 72 67 73 3a 67 65 pec (if (args:ge
a760: 74 2d 61 72 67 20 22 2d 66 69 65 6c 64 73 22 29 t-arg "-fields")
a770: 0a 09 09 09 09 28 65 78 74 72 61 63 74 2d 66 69 .....(extract-fi
a780: 65 6c 64 73 2d 63 6f 6e 73 74 72 61 69 6e 74 73 elds-constraints
a790: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
a7a0: 2d 66 69 65 6c 64 73 22 29 29 0a 09 09 09 09 28 -fields")).....(
a7b0: 6c 69 73 74 20 28 63 6f 6e 73 20 22 72 75 6e 73 list (cons "runs
a7c0: 22 20 28 61 70 70 65 6e 64 20 6b 65 79 73 20 28 " (append keys (
a7d0: 6c 69 73 74 20 22 69 64 22 20 22 72 75 6e 6e 61 list "id" "runna
a7e0: 6d 65 22 20 22 73 74 61 74 65 22 20 22 73 74 61 me" "state" "sta
a7f0: 74 75 73 22 20 22 6f 77 6e 65 72 22 20 22 65 76 tus" "owner" "ev
a800: 65 6e 74 5f 74 69 6d 65 22 20 22 63 6f 6d 6d 65 ent_time" "comme
a810: 6e 74 22 20 22 66 61 69 6c 5f 63 6f 75 6e 74 22 nt" "fail_count"
a820: 20 22 70 61 73 73 5f 63 6f 75 6e 74 22 29 29 29 "pass_count")))
a830: 0a 09 09 09 09 20 20 20 20 20 20 28 63 6f 6e 73 ..... (cons
a840: 20 22 74 65 73 74 73 22 20 20 64 62 3a 74 65 73 "tests" db:tes
a850: 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 29 t-record-fields)
a860: 20 3b 3b 20 22 69 64 22 20 22 74 65 73 74 6e 61 ;; "id" "testna
a870: 6d 65 22 20 22 74 65 73 74 5f 70 61 74 68 22 29 me" "test_path")
a880: 0a 09 09 09 09 20 20 20 20 20 20 28 6c 69 73 74 ..... (list
a890: 20 22 73 74 65 70 73 22 20 22 69 64 22 20 22 73 "steps" "id" "s
a8a0: 74 65 70 6e 61 6d 65 22 29 29 29 29 0a 09 20 20 tepname"))))..
a8b0: 20 20 20 20 20 28 72 75 6e 73 2d 73 70 65 63 20 (runs-spec
a8c0: 20 20 28 6c 65 74 20 28 28 72 20 28 61 6c 69 73 (let ((r (alis
a8d0: 74 2d 72 65 66 20 22 72 75 6e 73 22 20 20 66 69 t-ref "runs" fi
a8e0: 65 6c 64 73 2d 73 70 65 63 20 65 71 75 61 6c 3f elds-spec equal?
a8f0: 29 29 29 20 3b 3b 20 74 68 65 20 63 68 65 63 6b ))) ;; the check
a900: 20 69 73 20 6e 6f 77 20 75 6e 6e 65 63 65 73 73 is now unnecess
a910: 61 72 79 0a 09 09 09 20 20 20 20 20 20 28 69 66 ary.... (if
a920: 20 28 61 6e 64 20 72 20 28 6e 6f 74 20 28 6e 75 (and r (not (nu
a930: 6c 6c 3f 20 72 29 29 29 20 72 20 28 6c 69 73 74 ll? r))) r (list
a940: 20 22 69 64 22 20 29 29 29 29 0a 09 20 20 20 20 "id" ))))..
a950: 20 20 20 28 74 65 73 74 73 2d 73 70 65 63 20 20 (tests-spec
a960: 28 6c 65 74 20 28 28 74 20 28 61 6c 69 73 74 2d (let ((t (alist-
a970: 72 65 66 20 22 74 65 73 74 73 22 20 66 69 65 6c ref "tests" fiel
a980: 64 73 2d 73 70 65 63 20 65 71 75 61 6c 3f 29 29 ds-spec equal?))
a990: 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 ).... (if (
a9a0: 61 6e 64 20 74 20 28 6e 75 6c 6c 3f 20 74 29 29 and t (null? t))
a9b0: 20 3b 3b 20 61 6c 6c 20 66 69 65 6c 64 73 0a 09 ;; all fields..
a9c0: 09 09 09 20 20 64 62 3a 74 65 73 74 2d 72 65 63 ... db:test-rec
a9d0: 6f 72 64 2d 66 69 65 6c 64 73 0a 09 09 09 09 20 ord-fields.....
a9e0: 20 74 29 29 29 0a 09 20 20 20 20 20 20 20 28 61 t))).. (a
a9f0: 64 6a 2d 74 65 73 74 73 2d 73 70 65 63 20 28 64 dj-tests-spec (d
aa00: 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 elete-duplicates
aa10: 20 28 69 66 20 74 65 73 74 73 2d 73 70 65 63 20 (if tests-spec
aa20: 28 63 6f 6e 73 20 22 69 64 22 20 74 65 73 74 73 (cons "id" tests
aa30: 2d 73 70 65 63 29 20 64 62 3a 74 65 73 74 2d 72 -spec) db:test-r
aa40: 65 63 6f 72 64 2d 66 69 65 6c 64 73 29 29 29 20 ecord-fields)))
aa50: 3b 3b 20 27 28 22 69 64 22 29 29 29 29 0a 09 20 ;; '("id"))))..
aa60: 20 20 20 20 20 20 28 73 74 65 70 73 2d 73 70 65 (steps-spe
aa70: 63 20 20 28 61 6c 69 73 74 2d 72 65 66 20 22 73 c (alist-ref "s
aa80: 74 65 70 73 22 20 66 69 65 6c 64 73 2d 73 70 65 teps" fields-spe
aa90: 63 20 65 71 75 61 6c 3f 29 29 0a 09 20 20 20 20 c equal?))..
aaa0: 20 20 20 28 74 65 73 74 2d 66 69 65 6c 64 2d 69 (test-field-i
aab0: 6e 64 65 78 20 28 6d 61 6b 65 2d 68 61 73 68 2d ndex (make-hash-
aac0: 74 61 62 6c 65 29 29 29 0a 09 20 20 28 69 66 20 table))).. (if
aad0: 28 61 6e 64 20 74 65 73 74 73 2d 73 70 65 63 20 (and tests-spec
aae0: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 65 73 74 (not (null? test
aaf0: 73 2d 73 70 65 63 29 29 29 20 3b 3b 20 64 6f 20 s-spec))) ;; do
ab00: 73 6f 6d 65 20 76 61 6c 69 64 61 74 69 6f 6e 20 some validation
ab10: 61 6e 64 20 70 72 6f 63 65 73 73 69 6e 67 20 6f and processing o
ab20: 66 20 74 68 65 20 74 65 73 74 2d 73 70 65 63 0a f the test-spec.
ab30: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 6e . (let ((in
ab40: 76 61 6c 69 64 2d 74 65 73 74 73 2d 73 70 65 63 valid-tests-spec
ab50: 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 (filter (lambda
ab60: 20 28 78 29 28 6e 6f 74 20 28 6d 65 6d 62 65 72 (x)(not (member
ab70: 20 78 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 x db:test-recor
ab80: 64 2d 66 69 65 6c 64 73 29 29 29 20 74 65 73 74 d-fields))) test
ab90: 73 2d 73 70 65 63 29 29 29 0a 09 09 28 69 66 20 s-spec)))...(if
aba0: 28 6e 75 6c 6c 3f 20 69 6e 76 61 6c 69 64 2d 74 (null? invalid-t
abb0: 65 73 74 73 2d 73 70 65 63 29 0a 09 09 20 20 20 ests-spec)...
abc0: 20 3b 3b 20 67 65 6e 65 72 61 74 65 20 74 68 65 ;; generate the
abd0: 20 6c 6f 6f 6b 75 70 20 6d 61 70 20 74 65 73 74 lookup map test
abe0: 2d 66 69 65 6c 64 2d 6e 61 6d 65 20 3d 3e 20 69 -field-name => i
abf0: 6e 64 65 78 2d 6e 75 6d 62 65 72 0a 09 09 20 20 ndex-number...
ac00: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 (let loop ((he
ac10: 64 20 28 63 61 72 20 61 64 6a 2d 74 65 73 74 73 d (car adj-tests
ac20: 2d 73 70 65 63 29 29 0a 09 09 09 20 20 20 20 20 -spec))....
ac30: 20 20 28 74 61 6c 20 28 63 64 72 20 61 64 6a 2d (tal (cdr adj-
ac40: 74 65 73 74 73 2d 73 70 65 63 29 29 0a 09 09 09 tests-spec))....
ac50: 20 20 20 20 20 20 20 28 69 64 78 20 30 29 29 0a (idx 0)).
ac60: 09 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 .. (hash-ta
ac70: 62 6c 65 2d 73 65 74 21 20 74 65 73 74 2d 66 69 ble-set! test-fi
ac80: 65 6c 64 2d 69 6e 64 65 78 20 68 65 64 20 69 64 eld-index hed id
ac90: 78 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 x)... (if (
aca0: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 not (null? tal))
acb0: 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 (loop (car tal)(
acc0: 63 64 72 20 74 61 6c 29 28 2b 20 69 64 78 20 31 cdr tal)(+ idx 1
acd0: 29 29 29 29 0a 09 09 20 20 20 20 28 62 65 67 69 ))))... (begi
ace0: 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 67 n... (debug
acf0: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
ad00: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
ad10: 2a 20 22 49 6e 76 61 6c 69 64 20 74 65 73 74 20 * "Invalid test
ad20: 66 69 65 6c 64 73 20 73 70 65 63 69 66 69 65 64 fields specified
ad30: 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 : " (string-inte
ad40: 72 73 70 65 72 73 65 20 69 6e 76 61 6c 69 64 2d rsperse invalid-
ad50: 74 65 73 74 73 2d 73 70 65 63 20 22 2c 20 22 29 tests-spec ", ")
ad60: 29 0a 09 09 20 20 20 20 20 20 28 65 78 69 74 29 )... (exit)
ad70: 29 29 29 29 0a 0a 09 20 20 3b 3b 20 45 61 63 68 ))))... ;; Each
ad80: 20 72 75 6e 0a 09 20 20 28 66 6f 72 2d 65 61 63 run.. (for-eac
ad90: 68 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 h .. (lambda (
ada0: 72 75 6e 29 0a 09 20 20 20 20 20 28 6c 65 74 20 run).. (let
adb0: 28 28 74 61 72 67 65 74 73 74 72 20 28 73 74 72 ((targetstr (str
adc0: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
add0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 (map (lambda (x)
ade0: 0a 09 09 09 09 09 09 09 20 28 64 62 3a 67 65 74 ........ (db:get
adf0: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
ae00: 20 72 75 6e 20 68 65 61 64 65 72 20 78 29 29 0a run header x)).
ae10: 09 09 09 09 09 09 20 20 20 20 20 20 20 6b 65 79 ...... key
ae20: 73 29 20 22 2f 22 29 29 29 0a 09 20 20 20 20 20 s) "/")))..
ae30: 20 20 28 69 66 20 64 62 2d 74 61 72 67 65 74 73 (if db-targets
ae40: 0a 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ... (if (not (
ae50: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
ae60: 65 66 61 75 6c 74 20 73 65 65 6e 20 74 61 72 67 efault seen targ
ae70: 65 74 73 74 72 20 23 66 29 29 0a 09 09 20 20 20 etstr #f))...
ae80: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 20 28 (begin.... (
ae90: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
aea0: 73 65 65 6e 20 74 61 72 67 65 74 73 74 72 20 23 seen targetstr #
aeb0: 74 29 0a 09 09 09 20 3b 3b 20 28 70 72 69 6e 74 t).... ;; (print
aec0: 20 22 5b 22 20 74 61 72 67 65 74 73 74 72 20 22 "[" targetstr "
aed0: 5d 22 29 29 29 29 0a 09 09 09 20 28 69 66 20 28 ]")))).... (if (
aee0: 6e 6f 74 20 64 6d 6f 64 65 29 0a 09 09 09 20 20 not dmode)....
aef0: 20 20 20 28 70 72 69 6e 74 20 74 61 72 67 65 74 (print target
af00: 73 74 72 29 0a 09 09 09 20 20 20 20 20 28 68 61 str).... (ha
af10: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 64 61 sh-table-set! da
af20: 74 61 20 22 74 61 72 67 65 74 73 22 20 28 63 6f ta "targets" (co
af30: 6e 73 20 74 61 72 67 65 74 73 74 72 20 28 68 61 ns targetstr (ha
af40: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
af50: 61 75 6c 74 20 64 61 74 61 20 22 74 61 72 67 65 ault data "targe
af60: 74 73 22 20 27 28 29 29 29 29 0a 09 09 09 20 20 ts" '())))....
af70: 20 20 20 29 29 29 0a 09 09 20 20 20 28 6c 65 74 )))... (let
af80: 2a 20 28 28 72 75 6e 2d 69 64 20 20 28 64 62 3a * ((run-id (db:
af90: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
afa0: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 der run header "
afb0: 69 64 22 29 29 0a 09 09 09 20 20 28 72 75 6e 6e id")).... (runn
afc0: 61 6d 65 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 ame (db:get-valu
afd0: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
afe0: 68 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 header "runname"
aff0: 29 29 20 0a 09 09 09 20 20 28 73 74 61 74 65 73 )) .... (states
b000: 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 (string-split
b010: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
b020: 67 20 22 2d 73 74 61 74 65 22 29 20 22 22 29 20 g "-state") "")
b030: 22 2c 22 29 29 0a 09 09 09 20 20 28 73 74 61 74 ",")).... (stat
b040: 75 73 65 73 20 28 73 74 72 69 6e 67 2d 73 70 6c uses (string-spl
b050: 69 74 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 it (or (args:get
b060: 2d 61 72 67 20 22 2d 73 74 61 74 75 73 22 29 20 -arg "-status")
b070: 22 22 29 20 22 2c 22 29 29 0a 09 09 09 20 20 28 "") ",")).... (
b080: 74 65 73 74 73 20 20 20 28 69 66 20 74 65 73 74 tests (if test
b090: 73 2d 73 70 65 63 0a 09 09 09 09 20 20 20 20 20 s-spec.....
b0a0: 20 20 28 64 62 3a 64 69 73 70 61 74 63 68 2d 71 (db:dispatch-q
b0b0: 75 65 72 79 20 61 63 63 65 73 73 2d 6d 6f 64 65 uery access-mode
b0c0: 20 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 rmt:get-tests-f
b0d0: 6f 72 2d 72 75 6e 20 64 62 3a 67 65 74 2d 74 65 or-run db:get-te
b0e0: 73 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d sts-for-run run-
b0f0: 69 64 20 74 65 73 74 70 61 74 74 20 73 74 61 74 id testpatt stat
b100: 65 73 20 73 74 61 74 75 73 65 73 20 23 66 20 23 es statuses #f #
b110: 66 20 23 66 20 27 74 65 73 74 6e 61 6d 65 20 27 f #f 'testname '
b120: 61 73 63 20 3b 3b 20 28 64 62 3a 67 65 74 2d 74 asc ;; (db:get-t
b130: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 73 ests-for-run dbs
b140: 74 72 75 63 74 20 72 75 6e 2d 69 64 20 74 65 73 truct run-id tes
b150: 74 70 61 74 74 20 27 28 29 20 27 28 29 20 23 66 tpatt '() '() #f
b160: 20 23 66 20 23 66 20 27 74 65 73 74 6e 61 6d 65 #f #f 'testname
b170: 20 27 61 73 63 20 0a 09 09 09 09 09 09 09 20 20 'asc ........
b180: 20 20 20 3b 3b 20 75 73 65 20 71 72 79 76 61 6c ;; use qryval
b190: 73 20 69 66 20 74 65 73 74 2d 73 70 65 63 20 70 s if test-spec p
b1a0: 72 6f 76 69 64 65 64 0a 09 09 09 09 09 09 09 20 rovided........
b1b0: 20 20 20 20 28 69 66 20 74 65 73 74 73 2d 73 70 (if tests-sp
b1c0: 65 63 0a 09 09 09 09 09 09 09 09 20 28 73 74 72 ec......... (str
b1d0: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
b1e0: 61 64 6a 2d 74 65 73 74 73 2d 73 70 65 63 20 22 adj-tests-spec "
b1f0: 2c 22 29 0a 09 09 09 09 09 09 09 09 20 3b 3b 20 ,")......... ;;
b200: 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 db:test-record-f
b210: 69 65 6c 64 73 0a 09 09 09 09 09 09 09 09 20 23 ields......... #
b220: 66 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 23 f)........ #
b230: 66 0a 09 09 09 09 09 09 09 20 20 20 20 20 27 6e f........ 'n
b240: 6f 72 6d 61 6c 29 0a 09 09 09 09 20 20 20 20 20 ormal).....
b250: 20 20 27 28 29 29 29 29 0a 09 09 20 20 20 20 20 '())))...
b260: 28 63 61 73 65 20 64 6d 6f 64 65 0a 09 09 20 20 (case dmode...
b270: 20 20 20 20 20 28 28 6a 73 6f 6e 20 6f 64 73 29 ((json ods)
b280: 0a 09 09 09 28 69 66 20 72 75 6e 73 2d 73 70 65 ....(if runs-spe
b290: 63 0a 09 09 09 20 20 20 20 28 66 6f 72 2d 65 61 c.... (for-ea
b2a0: 63 68 20 0a 09 09 09 20 20 20 20 20 28 6c 61 6d ch .... (lam
b2b0: 62 64 61 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 bda (field-name)
b2c0: 0a 09 09 09 20 20 20 20 20 20 20 28 6d 75 74 69 .... (muti
b2d0: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
b2e0: 20 64 61 74 61 20 28 63 6f 6e 63 20 28 64 62 3a data (conc (db:
b2f0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
b300: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 66 der run header f
b310: 69 65 6c 64 2d 6e 61 6d 65 29 29 20 74 61 72 67 ield-name)) targ
b320: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d etstr runname "m
b330: 65 74 61 22 20 66 69 65 6c 64 2d 6e 61 6d 65 29 eta" field-name)
b340: 29 0a 09 09 09 20 20 20 20 20 72 75 6e 73 2d 73 ).... runs-s
b350: 70 65 63 29 29 29 0a 09 09 09 3b 3b 20 28 6d 75 pec)))....;; (mu
b360: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
b370: 74 21 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d t! data (db:get-
b380: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
b390: 72 75 6e 20 68 65 61 64 65 72 20 22 73 74 61 74 run header "stat
b3a0: 75 73 22 29 20 20 20 20 20 74 61 72 67 65 74 73 us") targets
b3b0: 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 tr runname "meta
b3c0: 22 20 22 73 74 61 74 75 73 22 20 20 20 20 20 29 " "status" )
b3d0: 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 ....;; (mutils:h
b3e0: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
b3f0: 61 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d a (db:get-value-
b400: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
b410: 61 64 65 72 20 22 73 74 61 74 65 22 29 20 20 20 ader "state")
b420: 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e targetstr run
b430: 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 73 74 61 name "meta" "sta
b440: 74 65 22 20 20 20 20 20 20 29 0a 09 09 09 3b 3b te" )....;;
b450: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
b460: 68 2d 73 65 74 21 20 64 61 74 61 20 28 63 6f 6e h-set! data (con
b470: 63 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d c (db:get-value-
b480: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
b490: 61 64 65 72 20 22 69 64 22 29 29 20 20 74 61 72 ader "id")) tar
b4a0: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
b4b0: 6d 65 74 61 22 20 22 69 64 22 20 20 20 20 20 20 meta" "id"
b4c0: 20 20 20 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 )....;; (muti
b4d0: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
b4e0: 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 data (db:get-va
b4f0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
b500: 6e 20 68 65 61 64 65 72 20 22 65 76 65 6e 74 5f n header "event_
b510: 74 69 6d 65 22 29 20 74 61 72 67 65 74 73 74 72 time") targetstr
b520: 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 runname "meta"
b530: 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 29 0a 09 "event_time" )..
b540: 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 ..;; (mutils:hie
b550: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
b560: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
b570: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
b580: 65 72 20 22 63 6f 6d 6d 65 6e 74 22 29 20 20 20 er "comment")
b590: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
b5a0: 6d 65 20 22 6d 65 74 61 22 20 22 63 6f 6d 6d 65 me "meta" "comme
b5b0: 6e 74 22 20 20 20 20 29 0a 09 09 09 3b 3b 20 3b nt" )....;; ;
b5c0: 3b 20 61 64 64 20 6c 61 73 74 20 65 6e 74 72 79 ; add last entry
b5d0: 20 74 77 69 63 65 20 2d 20 73 65 65 6d 73 20 74 twice - seems t
b5e0: 6f 20 62 65 20 61 20 62 75 67 20 69 6e 20 68 69 o be a bug in hi
b5f0: 65 72 68 61 73 68 3f 0a 09 09 09 3b 3b 20 28 6d erhash?....;; (m
b600: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
b610: 65 74 21 20 64 61 74 61 20 28 64 62 3a 67 65 74 et! data (db:get
b620: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
b630: 20 72 75 6e 20 68 65 61 64 65 72 20 22 63 6f 6d run header "com
b640: 6d 65 6e 74 22 29 20 20 20 20 74 61 72 67 65 74 ment") target
b650: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 str runname "met
b660: 61 22 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 a" "comment"
b670: 29 0a 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 )... (else
b680: 0a 09 09 09 28 69 66 20 28 6e 75 6c 6c 3f 20 72 ....(if (null? r
b690: 75 6e 73 2d 73 70 65 63 29 0a 09 09 09 20 20 20 uns-spec)....
b6a0: 20 28 70 72 69 6e 74 20 22 52 75 6e 3a 20 22 20 (print "Run: "
b6b0: 74 61 72 67 65 74 73 74 72 20 22 2f 22 20 72 75 targetstr "/" ru
b6c0: 6e 6e 61 6d 65 20 0a 09 09 09 09 20 20 20 22 20 nname ..... "
b6d0: 73 74 61 74 75 73 3a 20 22 20 28 64 62 3a 67 65 status: " (db:ge
b6e0: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
b6f0: 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 73 74 r run header "st
b700: 61 74 65 22 29 0a 09 09 09 09 20 20 20 22 20 72 ate")..... " r
b710: 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 un-id: " run-id
b720: 22 2c 20 6e 75 6d 62 65 72 20 74 65 73 74 73 3a ", number tests:
b730: 20 22 20 28 6c 65 6e 67 74 68 20 74 65 73 74 73 " (length tests
b740: 29 0a 09 09 09 09 20 20 20 22 20 65 76 65 6e 74 )..... " event
b750: 5f 74 69 6d 65 3a 20 22 20 28 64 62 3a 67 65 74 _time: " (db:get
b760: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
b770: 20 72 75 6e 20 68 65 61 64 65 72 20 22 65 76 65 run header "eve
b780: 6e 74 5f 74 69 6d 65 22 29 29 0a 09 09 09 20 20 nt_time"))....
b790: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 (begin....
b7a0: 20 20 28 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 (if (not (memb
b7b0: 65 72 20 22 74 61 72 67 65 74 22 20 72 75 6e 73 er "target" runs
b7c0: 2d 73 70 65 63 29 29 0a 09 09 09 20 20 20 20 20 -spec))....
b7d0: 20 20 20 20 20 3b 3b 20 28 64 69 73 70 6c 61 79 ;; (display
b7e0: 20 28 63 6f 6e 63 20 22 54 61 72 67 65 74 3a 20 (conc "Target:
b7f0: 22 20 74 61 72 67 65 74 73 74 72 29 29 0a 09 09 " targetstr))...
b800: 09 20 20 20 20 20 20 20 20 20 20 28 64 69 73 70 . (disp
b810: 6c 61 79 20 28 63 6f 6e 63 20 22 52 75 6e 3a 20 lay (conc "Run:
b820: 22 20 74 61 72 67 65 74 73 74 72 20 22 2f 22 20 " targetstr "/"
b830: 72 75 6e 6e 61 6d 65 20 22 20 22 29 29 29 0a 09 runname " ")))..
b840: 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 .. (for-eac
b850: 68 0a 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d h.... (lam
b860: 62 64 61 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 bda (field-name)
b870: 0a 09 09 09 09 20 28 69 66 20 28 65 71 75 61 6c ..... (if (equal
b880: 3f 20 66 69 65 6c 64 2d 6e 61 6d 65 20 22 74 61 ? field-name "ta
b890: 72 67 65 74 22 29 0a 09 09 09 09 20 20 20 20 20 rget").....
b8a0: 28 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 22 (display (conc "
b8b0: 74 61 72 67 65 74 3a 20 22 20 74 61 72 67 65 74 target: " target
b8c0: 73 74 72 20 22 20 22 29 29 0a 09 09 09 09 20 20 str " ")).....
b8d0: 20 20 20 28 64 69 73 70 6c 61 79 20 28 63 6f 6e (display (con
b8e0: 63 20 66 69 65 6c 64 2d 6e 61 6d 65 20 22 3a 20 c field-name ":
b8f0: 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d " (db:get-value-
b900: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
b910: 61 64 65 72 20 28 63 6f 6e 63 20 66 69 65 6c 64 ader (conc field
b920: 2d 6e 61 6d 65 29 29 20 22 20 22 29 29 29 29 0a -name)) " ")))).
b930: 09 09 09 20 20 20 20 20 20 20 72 75 6e 73 2d 73 ... runs-s
b940: 70 65 63 29 0a 09 09 09 20 20 20 20 20 20 28 6e pec).... (n
b950: 65 77 6c 69 6e 65 29 29 29 29 29 0a 09 09 20 20 ewline)))))...
b960: 20 20 20 20 20 0a 09 09 20 20 20 20 20 28 66 6f ... (fo
b970: 72 2d 65 61 63 68 20 0a 09 09 20 20 20 20 20 20 r-each ...
b980: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 (lambda (test)..
b990: 09 20 20 20 20 20 20 09 28 68 61 6e 64 6c 65 2d . .(handle-
b9a0: 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 20 65 exceptions.... e
b9b0: 78 6e 0a 09 09 09 20 28 62 65 67 69 6e 0a 09 09 xn.... (begin...
b9c0: 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
b9d0: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
b9e0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 42 61 64 t-log-port* "Bad
b9f0: 20 64 61 74 61 20 69 6e 20 74 65 73 74 20 72 65 data in test re
ba00: 63 6f 72 64 3f 20 22 20 74 65 73 74 29 0a 09 09 cord? " test)...
ba10: 09 20 20 20 28 70 72 69 6e 74 20 22 65 78 6e 3d . (print "exn=
ba20: 22 20 28 63 6f 6e 64 69 74 69 6f 6e 2d 3e 6c 69 " (condition->li
ba30: 73 74 20 65 78 6e 29 29 0a 09 09 09 20 20 20 28 st exn)).... (
ba40: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
ba50: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
ba60: 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 28 28 " message: " ((
ba70: 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 condition-proper
ba80: 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e ty-accessor 'exn
ba90: 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 'message) exn))
baa0: 0a 09 09 09 20 20 20 28 70 72 69 6e 74 2d 63 61 .... (print-ca
bab0: 6c 6c 2d 63 68 61 69 6e 20 28 63 75 72 72 65 6e ll-chain (curren
bac0: 74 2d 65 72 72 6f 72 2d 70 6f 72 74 29 29 29 0a t-error-port))).
bad0: 09 09 09 20 28 6c 65 74 2a 20 28 28 74 65 73 74 ... (let* ((test
bae0: 2d 69 64 20 20 20 20 20 20 28 69 66 20 28 6d 65 -id (if (me
baf0: 6d 62 65 72 20 22 69 64 22 20 20 20 20 20 20 20 mber "id"
bb00: 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 tests-spec)(
bb10: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
bb20: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
bb30: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 69 64 -field-index "id
bb40: 22 20 20 20 20 20 20 20 20 20 20 29 20 23 66 29 " ) #f)
bb50: 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 ) ;; (db:test-ge
bb60: 74 2d 69 64 20 20 20 20 20 20 20 20 20 74 65 73 t-id tes
bb70: 74 29 29 0a 09 09 09 09 28 74 65 73 74 6e 61 6d t)).....(testnam
bb80: 65 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 e (if (membe
bb90: 72 20 22 74 65 73 74 6e 61 6d 65 22 20 20 20 20 r "testname"
bba0: 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 tests-spec)(get
bbb0: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
bbc0: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
bbd0: 65 6c 64 2d 69 6e 64 65 78 20 22 74 65 73 74 6e eld-index "testn
bbe0: 61 6d 65 22 20 20 20 20 29 20 23 66 29 29 20 3b ame" ) #f)) ;
bbf0: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 ; (db:test-get-t
bc00: 65 73 74 6e 61 6d 65 20 20 20 74 65 73 74 29 29 estname test))
bc10: 0a 09 09 09 09 28 69 74 65 6d 70 61 74 68 20 20 .....(itempath
bc20: 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 (if (member "
bc30: 69 74 65 6d 5f 70 61 74 68 22 20 20 20 20 74 65 item_path" te
bc40: 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 sts-spec)(get-va
bc50: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
bc60: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
bc70: 2d 69 6e 64 65 78 20 22 69 74 65 6d 5f 70 61 74 -index "item_pat
bc80: 68 22 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 h" ) #f)) ;; (
bc90: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d db:test-get-item
bca0: 2d 70 61 74 68 20 20 74 65 73 74 29 29 0a 09 09 -path test))...
bcb0: 09 09 28 63 6f 6d 6d 65 6e 74 20 20 20 20 20 20 ..(comment
bcc0: 28 69 66 20 28 6d 65 6d 62 65 72 20 22 63 6f 6d (if (member "com
bcd0: 6d 65 6e 74 22 20 20 20 20 20 20 74 65 73 74 73 ment" tests
bce0: 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 -spec)(get-value
bcf0: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
bd00: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
bd10: 64 65 78 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 dex "comment"
bd20: 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a ) #f)) ;; (db:
bd30: 74 65 73 74 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 test-get-comment
bd40: 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 test)).....(
bd50: 74 73 74 61 74 65 20 20 20 20 20 20 20 28 69 66 tstate (if
bd60: 20 28 6d 65 6d 62 65 72 20 22 73 74 61 74 65 22 (member "state"
bd70: 20 20 20 20 20 20 20 20 74 65 73 74 73 2d 73 70 tests-sp
bd80: 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 ec)(get-value-by
bd90: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
bda0: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
bdb0: 20 22 73 74 61 74 65 22 20 20 20 20 20 20 20 29 "state" )
bdc0: 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 #f)) ;; (db:tes
bdd0: 74 2d 67 65 74 2d 73 74 61 74 65 20 20 20 20 20 t-get-state
bde0: 20 74 65 73 74 29 29 0a 09 09 09 09 28 74 73 74 test)).....(tst
bdf0: 61 74 75 73 20 20 20 20 20 20 28 69 66 20 28 6d atus (if (m
be00: 65 6d 62 65 72 20 22 73 74 61 74 75 73 22 20 20 ember "status"
be10: 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 tests-spec)
be20: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
be30: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
be40: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 73 t-field-index "s
be50: 74 61 74 75 73 22 20 20 20 20 20 20 29 20 23 66 tatus" ) #f
be60: 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 )) ;; (db:test-g
be70: 65 74 2d 73 74 61 74 75 73 20 20 20 20 20 74 65 et-status te
be80: 73 74 29 29 0a 09 09 09 09 28 65 76 65 6e 74 2d st)).....(event-
be90: 74 69 6d 65 20 20 20 28 69 66 20 28 6d 65 6d 62 time (if (memb
bea0: 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 er "event_time"
beb0: 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 tests-spec)(ge
bec0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
bed0: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
bee0: 69 65 6c 64 2d 69 6e 64 65 78 20 22 65 76 65 6e ield-index "even
bef0: 74 5f 74 69 6d 65 22 20 20 29 20 23 66 29 29 20 t_time" ) #f))
bf00: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
bf10: 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 event_time test)
bf20: 29 0a 09 09 09 09 28 72 75 6e 64 69 72 20 20 20 ).....(rundir
bf30: 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 (if (member
bf40: 22 72 75 6e 64 69 72 22 20 20 20 20 20 20 20 74 "rundir" t
bf50: 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 ests-spec)(get-v
bf60: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
bf70: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
bf80: 64 2d 69 6e 64 65 78 20 22 72 75 6e 64 69 72 22 d-index "rundir"
bf90: 20 20 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 ) #f)) ;;
bfa0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e (db:test-get-run
bfb0: 64 69 72 20 20 20 20 20 74 65 73 74 29 29 0a 09 dir test))..
bfc0: 09 09 09 28 66 69 6e 61 6c 5f 6c 6f 67 66 20 20 ...(final_logf
bfd0: 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 66 69 (if (member "fi
bfe0: 6e 61 6c 5f 6c 6f 67 66 22 20 20 20 74 65 73 74 nal_logf" test
bff0: 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 s-spec)(get-valu
c000: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
c010: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
c020: 6e 64 65 78 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 ndex "final_logf
c030: 22 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 " ) #f)) ;; (db
c040: 3a 74 65 73 74 2d 67 65 74 2d 66 69 6e 61 6c 5f :test-get-final_
c050: 6c 6f 67 66 20 74 65 73 74 29 29 0a 09 09 09 09 logf test)).....
c060: 28 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 28 69 (run_duration (i
c070: 66 20 28 6d 65 6d 62 65 72 20 22 72 75 6e 5f 64 f (member "run_d
c080: 75 72 61 74 69 6f 6e 22 20 74 65 73 74 73 2d 73 uration" tests-s
c090: 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 pec)(get-value-b
c0a0: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
c0b0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
c0c0: 78 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 x "run_duration"
c0d0: 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 ) #f)) ;; (db:te
c0e0: 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 st-get-run_durat
c0f0: 69 6f 6e 20 74 65 73 74 29 29 0a 09 09 09 09 28 ion test)).....(
c100: 66 75 6c 6c 6e 61 6d 65 20 20 20 20 20 28 63 6f fullname (co
c110: 6e 63 20 74 65 73 74 6e 61 6d 65 0a 09 09 09 09 nc testname.....
c120: 09 09 20 20 20 20 28 69 66 20 28 65 71 75 61 6c .. (if (equal
c130: 3f 20 69 74 65 6d 70 61 74 68 20 22 22 29 0a 09 ? itempath "")..
c140: 09 09 09 09 09 09 22 22 20 0a 09 09 09 09 09 09 ......"" .......
c150: 09 28 63 6f 6e 63 20 22 28 22 20 69 74 65 6d 70 .(conc "(" itemp
c160: 61 74 68 20 22 29 22 29 29 29 29 29 0a 09 09 09 ath ")")))))....
c170: 20 20 20 28 63 61 73 65 20 64 6d 6f 64 65 0a 09 (case dmode..
c180: 09 09 20 20 20 20 20 28 28 6a 73 6f 6e 20 6f 64 .. ((json od
c190: 73 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 s).... (if
c1a0: 74 65 73 74 73 2d 73 70 65 63 0a 09 09 09 09 20 tests-spec.....
c1b0: 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 09 20 (for-each.....
c1c0: 20 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 (lambda (field
c1d0: 2d 6e 61 6d 65 29 0a 09 09 09 09 20 20 20 20 20 -name).....
c1e0: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
c1f0: 2d 73 65 74 21 20 64 61 74 61 20 20 28 67 65 74 -set! data (get
c200: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
c210: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
c220: 65 6c 64 2d 69 6e 64 65 78 20 66 69 65 6c 64 2d eld-index field-
c230: 6e 61 6d 65 29 20 74 61 72 67 65 74 73 74 72 20 name) targetstr
c240: 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 runname "data" (
c250: 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 66 69 conc test-id) fi
c260: 65 6c 64 2d 6e 61 6d 65 29 29 0a 09 09 09 09 20 eld-name)).....
c270: 20 20 74 65 73 74 73 2d 73 70 65 63 29 29 29 0a tests-spec))).
c280: 09 09 09 20 20 20 20 20 3b 3b 20 3b 3b 20 28 6d ... ;; ;; (m
c290: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
c2a0: 65 74 21 20 64 61 74 61 20 20 66 75 6c 6c 6e 61 et! data fullna
c2b0: 6d 65 20 20 20 74 61 72 67 65 74 73 74 72 20 72 me targetstr r
c2c0: 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 unname "data" (c
c2d0: 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 74 6e onc test-id) "tn
c2e0: 61 6d 65 22 20 20 20 20 20 29 0a 09 09 09 20 20 ame" )....
c2f0: 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 ;; (mutils:h
c300: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
c310: 61 20 20 74 65 73 74 6e 61 6d 65 20 20 20 74 61 a testname ta
c320: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
c330: 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 "data" (conc tes
c340: 74 2d 69 64 29 20 22 74 65 73 74 6e 61 6d 65 22 t-id) "testname"
c350: 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 ).... ;;
c360: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
c370: 2d 73 65 74 21 20 64 61 74 61 20 20 69 74 65 6d -set! data item
c380: 70 61 74 68 20 20 20 74 61 72 67 65 74 73 74 72 path targetstr
c390: 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 runname "data"
c3a0: 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 (conc test-id) "
c3b0: 69 74 65 6d 70 61 74 68 22 20 20 29 0a 09 09 09 itempath" )....
c3c0: 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 ;; (mutils
c3d0: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
c3e0: 61 74 61 20 20 63 6f 6d 6d 65 6e 74 20 20 20 20 ata comment
c3f0: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
c400: 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 e "data" (conc t
c410: 65 73 74 2d 69 64 29 20 22 63 6f 6d 6d 65 6e 74 est-id) "comment
c420: 22 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b " ).... ;;
c430: 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 (mutils:hierha
c440: 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 74 73 sh-set! data ts
c450: 74 61 74 65 20 20 20 20 20 74 61 72 67 65 74 73 tate targets
c460: 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 tr runname "data
c470: 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 " (conc test-id)
c480: 20 22 73 74 61 74 65 22 20 20 20 20 20 29 0a 09 "state" )..
c490: 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 .. ;; (muti
c4a0: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
c4b0: 20 64 61 74 61 20 20 74 73 74 61 74 75 73 20 20 data tstatus
c4c0: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
c4d0: 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 ame "data" (conc
c4e0: 20 74 65 73 74 2d 69 64 29 20 22 73 74 61 74 75 test-id) "statu
c4f0: 73 22 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 s" )....
c500: 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 ;; (mutils:hier
c510: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 hash-set! data
c520: 72 75 6e 64 69 72 20 20 20 20 20 74 61 72 67 65 rundir targe
c530: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 tstr runname "da
c540: 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 ta" (conc test-i
c550: 64 29 20 22 72 75 6e 64 69 72 22 20 20 20 20 29 d) "rundir" )
c560: 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 .... ;; (mu
c570: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
c580: 74 21 20 64 61 74 61 20 20 66 69 6e 61 6c 5f 6c t! data final_l
c590: 6f 67 66 20 74 61 72 67 65 74 73 74 72 20 72 75 ogf targetstr ru
c5a0: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
c5b0: 6e 63 20 74 65 73 74 2d 69 64 29 20 22 66 69 6e nc test-id) "fin
c5c0: 61 6c 5f 6c 6f 67 66 22 29 0a 09 09 09 20 20 20 al_logf")....
c5d0: 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 ;; (mutils:hi
c5e0: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
c5f0: 20 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 run_duration t
c600: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
c610: 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 "data" (conc te
c620: 73 74 2d 69 64 29 20 22 72 75 6e 5f 64 75 72 61 st-id) "run_dura
c630: 74 69 6f 6e 22 29 0a 09 09 09 20 20 20 20 20 3b tion").... ;
c640: 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ; (mutils:hierh
c650: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 65 ash-set! data e
c660: 76 65 6e 74 2d 74 69 6d 65 20 74 61 72 67 65 74 vent-time target
c670: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 str runname "dat
c680: 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 a" (conc test-id
c690: 29 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 0a ) "event_time").
c6a0: 09 09 09 20 20 20 20 20 3b 3b 20 20 3b 3b 20 61 ... ;; ;; a
c6b0: 64 64 20 6c 61 73 74 20 65 6e 74 72 79 20 74 77 dd last entry tw
c6c0: 69 63 65 20 2d 20 73 65 65 6d 73 20 74 6f 20 62 ice - seems to b
c6d0: 65 20 61 20 62 75 67 20 69 6e 20 68 69 65 72 68 e a bug in hierh
c6e0: 61 73 68 3f 0a 09 09 09 20 20 20 20 20 3b 3b 20 ash?.... ;;
c6f0: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
c700: 68 2d 73 65 74 21 20 64 61 74 61 20 20 65 76 65 h-set! data eve
c710: 6e 74 2d 74 69 6d 65 20 74 61 72 67 65 74 73 74 nt-time targetst
c720: 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 r runname "data"
c730: 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 (conc test-id)
c740: 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 0a 09 09 "event_time")...
c750: 09 20 20 20 20 20 3b 3b 20 20 29 0a 09 09 09 20 . ;; )....
c760: 20 20 20 20 28 65 6c 73 65 0a 09 09 09 20 20 20 (else....
c770: 20 20 20 28 69 66 20 28 61 6e 64 20 74 73 74 61 (if (and tsta
c780: 74 65 20 74 73 74 61 74 75 73 20 65 76 65 6e 74 te tstatus event
c790: 2d 74 69 6d 65 29 0a 09 09 09 09 20 20 28 66 6f -time)..... (fo
c7a0: 72 6d 61 74 20 23 74 0a 09 09 09 09 09 20 20 22 rmat #t...... "
c7b0: 20 20 54 65 73 74 3a 20 7e 32 35 61 20 53 74 61 Test: ~25a Sta
c7c0: 74 65 3a 20 7e 31 35 61 20 53 74 61 74 75 73 3a te: ~15a Status:
c7d0: 20 7e 31 35 61 20 52 75 6e 74 69 6d 65 3a 20 7e ~15a Runtime: ~
c7e0: 35 40 61 73 20 54 69 6d 65 3a 20 7e 32 32 61 20 5@as Time: ~22a
c7f0: 48 6f 73 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 Host: ~10a\n"...
c800: 09 09 09 20 20 28 69 66 20 66 75 6c 6c 6e 61 6d ... (if fullnam
c810: 65 20 66 75 6c 6c 6e 61 6d 65 20 22 22 29 0a 09 e fullname "")..
c820: 09 09 09 09 20 20 28 69 66 20 74 73 74 61 74 65 .... (if tstate
c830: 20 20 20 74 73 74 61 74 65 20 20 20 22 22 29 0a tstate "").
c840: 09 09 09 09 09 20 20 28 69 66 20 74 73 74 61 74 ..... (if tstat
c850: 75 73 20 20 74 73 74 61 74 75 73 20 20 22 22 29 us tstatus "")
c860: 0a 09 09 09 09 09 20 20 28 67 65 74 2d 76 61 6c ...... (get-val
c870: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
c880: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
c890: 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 61 74 index "run_durat
c8a0: 69 6f 6e 22 29 3b 3b 28 69 66 20 74 65 73 74 20 ion");;(if test
c8b0: 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 (db:test-get
c8c0: 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 -run_duration te
c8d0: 73 74 29 20 22 22 29 0a 09 09 09 09 09 20 20 28 st) "")...... (
c8e0: 69 66 20 65 76 65 6e 74 2d 74 69 6d 65 20 65 76 if event-time ev
c8f0: 65 6e 74 2d 74 69 6d 65 20 22 22 29 0a 09 09 09 ent-time "")....
c900: 09 09 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 .. (get-value-b
c910: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
c920: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
c930: 78 20 22 68 6f 73 74 22 29 29 20 3b 3b 28 69 66 x "host")) ;;(if
c940: 20 74 65 73 74 20 28 64 62 3a 74 65 73 74 2d 67 test (db:test-g
c950: 65 74 2d 68 6f 73 74 20 74 65 73 74 29 29 20 22 et-host test)) "
c960: 22 29 0a 09 09 09 09 20 20 28 70 72 69 6e 74 20 ")..... (print
c970: 22 20 20 54 65 73 74 3a 20 22 20 66 75 6c 6c 6e " Test: " fulln
c980: 61 6d 65 0a 09 09 09 09 09 20 28 69 66 20 74 73 ame...... (if ts
c990: 74 61 74 65 20 20 28 63 6f 6e 63 20 22 20 53 74 tate (conc " St
c9a0: 61 74 65 3a 20 22 20 20 74 73 74 61 74 65 29 20 ate: " tstate)
c9b0: 20 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 74 "")...... (if t
c9c0: 73 74 61 74 75 73 20 28 63 6f 6e 63 20 22 20 53 status (conc " S
c9d0: 74 61 74 75 73 3a 20 22 20 74 73 74 61 74 75 73 tatus: " tstatus
c9e0: 29 20 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 ) "")...... (if
c9f0: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
ca00: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
ca10: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 t-field-index "r
ca20: 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 0a 09 09 un_duration")...
ca30: 09 09 09 20 20 20 20 20 28 63 6f 6e 63 20 22 20 ... (conc "
ca40: 52 75 6e 74 69 6d 65 3a 20 22 20 28 67 65 74 2d Runtime: " (get-
ca50: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
ca60: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
ca70: 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 ld-index "run_du
ca80: 72 61 74 69 6f 6e 22 29 29 0a 09 09 09 09 09 20 ration"))......
ca90: 20 20 20 20 22 22 29 0a 09 09 09 09 09 20 28 69 "")...... (i
caa0: 66 20 65 76 65 6e 74 2d 74 69 6d 65 20 28 63 6f f event-time (co
cab0: 6e 63 20 22 20 54 69 6d 65 3a 20 22 20 65 76 65 nc " Time: " eve
cac0: 6e 74 2d 74 69 6d 65 29 20 22 22 29 0a 09 09 09 nt-time) "")....
cad0: 09 09 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 .. (if (get-valu
cae0: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
caf0: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
cb00: 6e 64 65 78 20 22 68 6f 73 74 22 29 0a 09 09 09 ndex "host")....
cb10: 09 09 20 20 20 20 20 28 63 6f 6e 63 20 22 20 48 .. (conc " H
cb20: 6f 73 74 3a 20 22 20 28 67 65 74 2d 76 61 6c 75 ost: " (get-valu
cb30: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
cb40: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
cb50: 6e 64 65 78 20 22 68 6f 73 74 22 29 29 0a 09 09 ndex "host"))...
cb60: 09 09 09 20 20 20 20 20 22 22 29 29 29 0a 09 09 ... "")))...
cb70: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
cb80: 28 6f 72 20 28 65 71 75 61 6c 3f 20 28 67 65 74 (or (equal? (get
cb90: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
cba0: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
cbb0: 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 75 eld-index "statu
cbc0: 73 22 29 20 22 50 41 53 53 22 29 0a 09 09 09 09 s") "PASS").....
cbd0: 09 20 20 20 28 65 71 75 61 6c 3f 20 28 67 65 74 . (equal? (get
cbe0: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
cbf0: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
cc00: 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 75 eld-index "statu
cc10: 73 22 29 20 22 57 41 52 4e 22 29 0a 09 09 09 09 s") "WARN").....
cc20: 09 20 20 20 28 65 71 75 61 6c 3f 20 28 67 65 74 . (equal? (get
cc30: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
cc40: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
cc50: 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 65 eld-index "state
cc60: 22 29 20 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 ") "NOT_STARTED
cc70: 22 29 29 29 0a 09 09 09 09 20 20 28 62 65 67 69 ")))..... (begi
cc80: 6e 0a 09 09 09 09 20 20 20 20 28 70 72 69 6e 74 n..... (print
cc90: 20 20 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 (if (get-valu
cca0: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
ccb0: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
ccc0: 6e 64 65 78 20 22 63 70 75 6c 6f 61 64 22 29 0a ndex "cpuload").
ccd0: 09 09 09 09 09 09 20 28 63 6f 6e 63 20 22 20 20 ...... (conc "
cce0: 20 20 20 20 20 20 20 63 70 75 6c 6f 61 64 3a 20 cpuload:
ccf0: 20 22 20 20 20 28 67 65 74 2d 76 61 6c 75 65 2d " (get-value-
cd00: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
cd10: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
cd20: 65 78 20 22 63 70 75 6c 6f 61 64 22 29 29 0a 09 ex "cpuload"))..
cd30: 09 09 09 09 09 20 22 22 29 20 3b 3b 20 28 64 62 ..... "") ;; (db
cd40: 3a 74 65 73 74 2d 67 65 74 2d 63 70 75 6c 6f 61 :test-get-cpuloa
cd50: 64 20 74 65 73 74 29 0a 09 09 09 09 09 20 20 20 d test)......
cd60: 20 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 (if (get-value
cd70: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
cd80: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
cd90: 64 65 78 20 22 64 69 73 6b 66 72 65 65 22 29 0a dex "diskfree").
cda0: 09 09 09 09 09 09 20 28 63 6f 6e 63 20 22 5c 6e ...... (conc "\n
cdb0: 20 20 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 diskfre
cdc0: 65 3a 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d e: " (get-value-
cdd0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
cde0: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
cdf0: 65 78 20 22 64 69 73 6b 66 72 65 65 22 29 29 20 ex "diskfree"))
ce00: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
ce10: 64 69 73 6b 66 72 65 65 20 74 65 73 74 29 0a 09 diskfree test)..
ce20: 09 09 09 09 09 20 22 22 29 0a 09 09 09 09 09 20 ..... "")......
ce30: 20 20 20 20 28 69 66 20 28 67 65 74 2d 76 61 6c (if (get-val
ce40: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
ce50: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
ce60: 69 6e 64 65 78 20 22 75 6e 61 6d 65 22 29 0a 09 index "uname")..
ce70: 09 09 09 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 ..... (conc "\n
ce80: 20 20 20 20 20 20 20 20 75 6e 61 6d 65 3a 20 20 uname:
ce90: 20 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 " (get-value-b
cea0: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
ceb0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
cec0: 78 20 22 75 6e 61 6d 65 22 29 29 20 3b 3b 20 28 x "uname")) ;; (
ced0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 75 6e 61 6d db:test-get-unam
cee0: 65 20 74 65 73 74 29 0a 09 09 09 09 09 09 20 22 e test)....... "
cef0: 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 ")...... (if
cf00: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
cf10: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
cf20: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
cf30: 72 75 6e 64 69 72 22 29 0a 09 09 09 09 09 09 20 rundir").......
cf40: 28 63 6f 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 (conc "\n
cf50: 20 20 72 75 6e 64 69 72 3a 20 20 20 22 20 28 67 rundir: " (g
cf60: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
cf70: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
cf80: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e field-index "run
cf90: 64 69 72 22 29 29 20 3b 3b 20 28 64 62 3a 74 65 dir")) ;; (db:te
cfa0: 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 st-get-rundir te
cfb0: 73 74 29 0a 09 09 09 09 09 09 20 22 22 29 0a 3b st)....... "").;
cfc0: 3b 09 09 09 09 09 20 20 20 20 20 22 5c 6e 20 20 ;..... "\n
cfd0: 20 20 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 rundir:
cfe0: 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 " (get-value-by
cff0: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
d000: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
d010: 20 22 22 29 20 3b 3b 20 28 73 64 62 3a 71 72 79 "") ;; (sdb:qry
d020: 20 27 67 65 74 73 74 72 20 3b 3b 20 28 66 69 6c 'getstr ;; (fil
d030: 65 64 62 3a 67 65 74 2d 70 61 74 68 20 2a 66 64 edb:get-path *fd
d040: 62 2a 20 0a 3b 3b 20 09 09 09 09 09 20 20 20 20 b* .;; .....
d050: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru
d060: 6e 64 69 72 20 74 65 73 74 29 20 3b 3b 20 29 0a ndir test) ;; ).
d070: 09 09 09 09 09 20 20 20 20 20 29 0a 09 09 09 09 ..... ).....
d080: 20 20 20 20 3b 3b 20 45 61 63 68 20 74 65 73 74 ;; Each test
d090: 0a 09 09 09 09 20 20 20 20 3b 3b 20 44 4f 20 4e ..... ;; DO N
d0a0: 4f 54 20 72 65 6d 6f 74 65 20 72 75 6e 0a 09 09 OT remote run...
d0b0: 09 09 20 20 20 20 28 6c 65 74 20 28 28 73 74 65 .. (let ((ste
d0c0: 70 73 20 28 64 62 3a 64 69 73 70 61 74 63 68 2d ps (db:dispatch-
d0d0: 71 75 65 72 79 20 61 63 63 65 73 73 2d 6d 6f 64 query access-mod
d0e0: 65 20 72 6d 74 3a 67 65 74 2d 73 74 65 70 73 2d e rmt:get-steps-
d0f0: 66 6f 72 2d 74 65 73 74 20 64 62 3a 67 65 74 2d for-test db:get-
d100: 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 72 steps-for-test r
d110: 75 6e 2d 69 64 20 28 64 62 3a 74 65 73 74 2d 67 un-id (db:test-g
d120: 65 74 2d 69 64 20 74 65 73 74 29 29 29 29 20 3b et-id test)))) ;
d130: 3b 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d ; (db:get-steps-
d140: 66 6f 72 2d 74 65 73 74 20 64 62 73 74 72 75 63 for-test dbstruc
d150: 74 20 72 75 6e 2d 69 64 20 28 64 62 3a 74 65 73 t run-id (db:tes
d160: 74 2d 67 65 74 2d 69 64 20 74 65 73 74 29 29 29 t-get-id test)))
d170: 29 0a 09 09 09 09 20 20 20 20 20 20 28 66 6f 72 )..... (for
d180: 2d 65 61 63 68 20 0a 09 09 09 09 20 20 20 20 20 -each .....
d190: 20 20 28 6c 61 6d 62 64 61 20 28 73 74 65 70 29 (lambda (step)
d1a0: 0a 09 09 09 09 09 20 28 66 6f 72 6d 61 74 20 23 ...... (format #
d1b0: 74 20 0a 09 09 09 09 09 09 20 22 20 20 20 20 53 t ....... " S
d1c0: 74 65 70 3a 20 7e 32 30 61 20 53 74 61 74 65 3a tep: ~20a State:
d1d0: 20 7e 31 30 61 20 53 74 61 74 75 73 3a 20 7e 31 ~10a Status: ~1
d1e0: 30 61 20 54 69 6d 65 20 7e 32 32 61 5c 6e 22 0a 0a Time ~22a\n".
d1f0: 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 ...... (tdb:step
d200: 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 -get-stepname st
d210: 65 70 29 0a 09 09 09 09 09 09 20 28 74 64 62 3a ep)....... (tdb:
d220: 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 step-get-state s
d230: 74 65 70 29 0a 09 09 09 09 09 09 20 28 74 64 62 tep)....... (tdb
d240: 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 :step-get-status
d250: 20 73 74 65 70 29 0a 09 09 09 09 09 09 20 28 74 step)....... (t
d260: 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e db:step-get-even
d270: 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 0a 09 t_time step)))..
d280: 09 09 09 20 20 20 20 20 20 20 73 74 65 70 73 29 ... steps)
d290: 29 29 29 29 29 29 29 29 0a 09 09 20 20 20 20 20 ))))))))...
d2a0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
d2b0: 72 67 20 22 2d 73 6f 72 74 22 29 0a 09 09 09 20 rg "-sort")....
d2c0: 20 28 73 6f 72 74 20 74 65 73 74 73 0a 09 09 09 (sort tests....
d2d0: 09 28 6c 61 6d 62 64 61 20 28 61 2d 74 65 73 74 .(lambda (a-test
d2e0: 20 62 2d 74 65 73 74 29 0a 09 09 09 09 20 20 28 b-test)..... (
d2f0: 6c 65 74 2a 20 28 28 6b 65 79 20 20 20 20 28 61 let* ((key (a
d300: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f rgs:get-arg "-so
d310: 72 74 22 29 29 0a 09 09 09 09 09 20 28 66 69 72 rt"))...... (fir
d320: 73 74 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 st (get-value-b
d330: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 61 2d 74 65 y-fieldname a-te
d340: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
d350: 64 65 78 20 6b 65 79 29 29 0a 09 09 09 09 09 20 dex key))......
d360: 28 73 65 63 6f 6e 64 20 28 67 65 74 2d 76 61 6c (second (get-val
d370: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
d380: 62 2d 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c b-test test-fiel
d390: 64 2d 69 6e 64 65 78 20 6b 65 79 29 29 29 0a 09 d-index key)))..
d3a0: 09 09 09 20 20 20 20 28 28 63 6f 6e 64 20 0a 09 ... ((cond ..
d3b0: 09 09 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 ... ((and (
d3c0: 6e 75 6d 62 65 72 3f 20 66 69 72 73 74 29 28 6e number? first)(n
d3d0: 75 6d 62 65 72 3f 20 73 65 63 6f 6e 64 29 29 20 umber? second))
d3e0: 3c 29 0a 09 09 09 09 20 20 20 20 20 20 28 28 61 <)..... ((a
d3f0: 6e 64 20 28 73 74 72 69 6e 67 3f 20 66 69 72 73 nd (string? firs
d400: 74 29 28 73 74 72 69 6e 67 3f 20 73 65 63 6f 6e t)(string? secon
d410: 64 29 29 20 73 74 72 69 6e 67 3c 3d 3f 29 0a 09 d)) string<=?)..
d420: 09 09 09 20 20 20 20 20 20 28 65 6c 73 65 20 65 ... (else e
d430: 71 75 61 6c 3f 29 29 0a 09 09 09 09 20 20 20 20 qual?)).....
d440: 20 66 69 72 73 74 20 73 65 63 6f 6e 64 29 29 29 first second)))
d450: 29 0a 09 09 09 20 20 74 65 73 74 73 29 29 29 29 ).... tests))))
d460: 29 29 0a 09 20 20 20 72 75 6e 73 29 0a 09 20 20 )).. runs)..
d470: 28 69 66 20 28 65 71 3f 20 64 6d 6f 64 65 20 27 (if (eq? dmode '
d480: 6a 73 6f 6e 29 28 6a 73 6f 6e 2d 77 72 69 74 65 json)(json-write
d490: 20 64 61 74 61 29 29 0a 09 20 20 28 6c 65 74 2a data)).. (let*
d4a0: 20 28 28 6d 65 74 61 64 61 74 2d 66 69 65 6c 64 ((metadat-field
d4b0: 73 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 s (delete-duplic
d4c0: 61 74 65 73 0a 09 09 09 09 20 20 28 61 70 70 65 ates..... (appe
d4d0: 6e 64 20 6b 65 79 73 20 27 28 20 22 72 75 6e 6e nd keys '( "runn
d4e0: 61 6d 65 22 20 22 74 69 6d 65 22 20 22 6f 77 6e ame" "time" "own
d4f0: 65 72 22 20 22 70 61 73 73 5f 63 6f 75 6e 74 22 er" "pass_count"
d500: 20 22 66 61 69 6c 5f 63 6f 75 6e 74 22 20 22 73 "fail_count" "s
d510: 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 22 tate" "status" "
d520: 63 6f 6d 6d 65 6e 74 22 20 22 69 64 22 29 29 29 comment" "id")))
d530: 29 0a 09 09 20 28 72 75 6e 2d 66 69 65 6c 64 73 )... (run-fields
d540: 20 20 20 20 27 28 0a 09 09 09 09 20 20 22 74 65 '(..... "te
d550: 73 74 6e 61 6d 65 22 0a 09 09 09 09 20 20 22 69 stname"..... "i
d560: 74 65 6d 5f 70 61 74 68 22 0a 09 09 09 09 20 20 tem_path".....
d570: 22 73 74 61 74 65 22 0a 09 09 09 09 20 20 22 73 "state"..... "s
d580: 74 61 74 75 73 22 0a 09 09 09 09 20 20 22 63 6f tatus"..... "co
d590: 6d 6d 65 6e 74 22 0a 09 09 09 09 20 20 22 65 76 mment"..... "ev
d5a0: 65 6e 74 5f 74 69 6d 65 22 0a 09 09 09 09 20 20 ent_time".....
d5b0: 22 68 6f 73 74 22 0a 09 09 09 09 20 20 22 72 75 "host"..... "ru
d5c0: 6e 5f 69 64 22 0a 09 09 09 09 20 20 22 72 75 6e n_id"..... "run
d5d0: 5f 64 75 72 61 74 69 6f 6e 22 0a 09 09 09 09 20 _duration".....
d5e0: 20 22 61 74 74 65 6d 70 74 6e 75 6d 22 0a 09 09 "attemptnum"...
d5f0: 09 09 20 20 22 69 64 22 0a 09 09 09 09 20 20 22 .. "id"..... "
d600: 61 72 63 68 69 76 65 64 22 0a 09 09 09 09 20 20 archived".....
d610: 22 64 69 73 6b 66 72 65 65 22 0a 09 09 09 09 20 "diskfree".....
d620: 20 22 63 70 75 6c 6f 61 64 22 0a 09 09 09 09 20 "cpuload".....
d630: 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 0a 09 09 "final_logf"...
d640: 09 09 20 20 22 73 68 6f 72 74 64 69 72 22 0a 09 .. "shortdir"..
d650: 09 09 09 20 20 22 72 75 6e 64 69 72 22 0a 09 09 ... "rundir"...
d660: 09 09 20 20 22 75 6e 61 6d 65 22 0a 09 09 09 09 .. "uname".....
d670: 20 20 29 0a 09 09 09 09 29 0a 09 09 20 28 6e 65 ).....)... (ne
d680: 77 64 61 74 20 20 20 20 20 20 20 20 20 20 28 63 wdat (c
d690: 6f 6d 6d 6f 6e 3a 74 6f 2d 61 6c 69 73 74 20 64 ommon:to-alist d
d6a0: 61 74 61 29 29 0a 09 09 20 28 61 6c 6c 72 75 6e ata))... (allrun
d6b0: 64 61 74 20 20 20 20 20 20 20 28 69 66 20 28 6e dat (if (n
d6c0: 75 6c 6c 3f 20 6e 65 77 64 61 74 29 0a 09 09 09 ull? newdat)....
d6d0: 09 20 20 20 20 20 20 27 28 29 0a 09 09 09 09 20 . '().....
d6e0: 20 20 20 20 20 28 63 61 72 20 28 6d 61 70 20 63 (car (map c
d6f0: 64 72 20 6e 65 77 64 61 74 29 29 29 29 20 3b 3b dr newdat)))) ;;
d700: 20 28 63 61 72 20 28 6d 61 70 20 63 64 72 20 28 (car (map cdr (
d710: 63 61 72 20 28 6d 61 70 20 63 64 72 20 6e 65 77 car (map cdr new
d720: 64 61 74 29 29 29 29 29 0a 09 09 20 28 72 75 6e dat)))))... (run
d730: 73 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 s (ap
d740: 70 65 6e 64 0a 09 09 09 09 20 20 20 28 6c 69 73 pend..... (lis
d750: 74 20 22 72 75 6e 73 22 20 3b 3b 20 73 68 65 65 t "runs" ;; shee
d760: 74 6e 61 6d 65 0a 09 09 09 09 09 20 6d 65 74 61 tname...... meta
d770: 64 61 74 2d 66 69 65 6c 64 73 29 0a 09 09 09 09 dat-fields).....
d780: 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda
d790: 28 72 75 6e 29 0a 09 09 09 09 09 20 20 3b 3b 20 (run)...... ;;
d7a0: 28 70 72 69 6e 74 20 22 72 75 6e 3a 20 22 20 72 (print "run: " r
d7b0: 75 6e 29 0a 09 09 09 09 09 20 20 28 6c 65 74 2a un)...... (let*
d7c0: 20 28 28 72 75 6e 6e 61 6d 65 20 28 63 61 72 20 ((runname (car
d7d0: 72 75 6e 29 29 0a 09 09 09 09 09 09 20 28 72 75 run))....... (ru
d7e0: 6e 64 61 74 20 20 28 63 64 72 20 72 75 6e 29 29 ndat (cdr run))
d7f0: 0a 09 09 09 09 09 09 20 28 6d 65 74 61 64 61 74 ....... (metadat
d800: 20 28 6c 65 74 20 28 28 74 6d 70 20 28 61 73 73 (let ((tmp (ass
d810: 6f 63 20 22 6d 65 74 61 22 20 72 75 6e 64 61 74 oc "meta" rundat
d820: 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 )))........ (
d830: 69 66 20 74 6d 70 20 28 63 64 72 20 74 6d 70 29 if tmp (cdr tmp)
d840: 20 23 66 29 29 29 29 0a 09 09 09 09 09 20 20 20 #f))))......
d850: 20 3b 3b 20 28 70 72 69 6e 74 20 22 72 75 6e 6e ;; (print "runn
d860: 61 6d 65 3a 20 22 20 72 75 6e 6e 61 6d 65 20 22 ame: " runname "
d870: 5c 6e 5c 6e 72 75 6e 64 61 74 3a 20 22 20 29 28 \n\nrundat: " )(
d880: 70 70 20 72 75 6e 64 61 74 29 28 70 72 69 6e 74 pp rundat)(print
d890: 20 22 5c 6e 5c 6e 6d 65 74 61 64 61 74 3a 20 22 "\n\nmetadat: "
d8a0: 29 28 70 70 20 6d 65 74 61 64 61 74 29 0a 09 09 )(pp metadat)...
d8b0: 09 09 09 20 20 20 20 28 69 66 20 6d 65 74 61 64 ... (if metad
d8c0: 61 74 0a 09 09 09 09 09 09 28 6d 61 70 20 28 6c at.......(map (l
d8d0: 61 6d 62 64 61 20 28 66 69 65 6c 64 29 0a 09 09 ambda (field)...
d8e0: 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 .... (let
d8f0: 28 28 74 6d 70 20 28 61 73 73 6f 63 20 66 69 65 ((tmp (assoc fie
d900: 6c 64 20 6d 65 74 61 64 61 74 29 29 29 0a 09 09 ld metadat)))...
d910: 09 09 09 09 09 20 28 69 66 20 74 6d 70 20 28 63 ..... (if tmp (c
d920: 64 72 20 74 6d 70 29 20 22 22 29 29 29 0a 09 09 dr tmp) "")))...
d930: 09 09 09 09 20 20 20 20 20 6d 65 74 61 64 61 74 .... metadat
d940: 2d 66 69 65 6c 64 73 29 0a 09 09 09 09 09 09 28 -fields).......(
d950: 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 28 64 begin....... (d
d960: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
d970: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
d980: 22 57 41 52 4e 49 4e 47 3a 20 6d 65 74 61 20 64 "WARNING: meta d
d990: 61 74 61 20 66 6f 72 20 72 75 6e 20 22 20 72 75 ata for run " ru
d9a0: 6e 6e 61 6d 65 20 22 20 6e 6f 74 20 66 6f 75 6e nname " not foun
d9b0: 64 22 29 0a 09 09 09 09 09 09 20 20 27 28 29 29 d")....... '())
d9c0: 29 29 29 0a 09 09 09 09 09 61 6c 6c 72 75 6e 64 )))......allrund
d9d0: 61 74 29 29 29 0a 09 09 20 3b 3b 20 27 28 20 28 at)))... ;; '( (
d9e0: 20 22 74 61 72 67 65 74 22 20 28 20 22 72 75 6e "target" ( "run
d9f0: 6e 61 6d 65 22 20 28 20 22 64 61 74 61 22 20 28 name" ( "data" (
da00: 20 22 72 75 6e 69 64 22 20 28 20 22 69 64 20 2e "runid" ( "id .
da10: 20 22 33 37 22 20 29 20 28 20 2e 2e 2e 20 29 29 "37" ) ( ... ))
da20: 29 29 0a 09 09 20 28 72 75 6e 2d 70 61 67 65 73 ))... (run-pages
da30: 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 (map (lamb
da40: 64 61 20 28 74 61 72 67 64 61 74 29 0a 09 09 09 da (targdat)....
da50: 09 09 28 6c 65 74 2a 20 28 28 74 61 72 67 65 74 ..(let* ((target
da60: 20 20 28 63 61 72 20 74 61 72 67 64 61 74 29 29 (car targdat))
da70: 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 72 75 ...... (ru
da80: 6e 73 64 61 74 20 28 63 64 72 20 74 61 72 67 64 nsdat (cdr targd
da90: 61 74 29 29 29 0a 09 09 09 09 09 20 20 28 69 66 at)))...... (if
daa0: 20 72 75 6e 73 64 61 74 0a 09 09 09 09 09 20 20 runsdat......
dab0: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda
dac0: 20 28 72 75 6e 64 61 74 29 0a 09 09 09 09 09 09 (rundat).......
dad0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e (let* ((run
dae0: 6e 61 6d 65 20 20 28 63 61 72 20 72 75 6e 64 61 name (car runda
daf0: 74 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 t))........ (
db00: 72 75 6e 64 61 74 20 20 20 28 63 64 72 20 72 75 rundat (cdr ru
db10: 6e 64 61 74 29 29 0a 09 09 09 09 09 09 09 20 20 ndat))........
db20: 20 20 28 74 65 73 74 73 64 61 74 20 28 6c 65 74 (testsdat (let
db30: 20 28 28 74 6d 70 20 28 61 73 73 6f 63 20 22 64 ((tmp (assoc "d
db40: 61 74 61 22 20 72 75 6e 64 61 74 29 29 29 0a 09 ata" rundat)))..
db50: 09 09 09 09 09 09 09 09 28 69 66 20 74 6d 70 20 ........(if tmp
db60: 28 63 64 72 20 74 6d 70 29 20 23 66 29 29 29 29 (cdr tmp) #f))))
db70: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 69 ....... (i
db80: 66 20 74 65 73 74 73 64 61 74 0a 09 09 09 09 09 f testsdat......
db90: 09 09 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 .. (let ((test
dba0: 73 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 s (map (lambda (
dbb0: 74 65 73 74 29 0a 09 09 09 09 09 09 09 09 09 20 test)..........
dbc0: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 (let* ((te
dbd0: 73 74 2d 69 64 20 20 28 63 61 72 20 74 65 73 74 st-id (car test
dbe0: 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 ))...........
dbf0: 20 20 20 28 74 65 73 74 2d 64 61 74 20 28 63 64 (test-dat (cd
dc00: 72 20 74 65 73 74 29 29 29 0a 09 09 09 09 09 09 r test))).......
dc10: 09 09 09 09 20 28 6d 61 70 20 28 6c 61 6d 62 64 .... (map (lambd
dc20: 61 20 28 66 69 65 6c 64 29 0a 09 09 09 09 09 09 a (field).......
dc30: 09 09 09 09 09 28 6c 65 74 20 28 28 74 6d 70 20 .....(let ((tmp
dc40: 28 61 73 73 6f 63 20 66 69 65 6c 64 20 74 65 73 (assoc field tes
dc50: 74 2d 64 61 74 29 29 29 0a 09 09 09 09 09 09 09 t-dat)))........
dc60: 09 09 09 09 20 20 28 69 66 20 74 6d 70 20 28 63 .... (if tmp (c
dc70: 64 72 20 74 6d 70 29 20 22 22 29 29 29 0a 09 09 dr tmp) "")))...
dc80: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 72 75 ........ ru
dc90: 6e 2d 66 69 65 6c 64 73 29 29 29 0a 09 09 09 09 n-fields))).....
dca0: 09 09 09 09 09 20 20 20 20 20 74 65 73 74 73 64 ..... testsd
dcb0: 61 74 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 at)))........
dcc0: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 54 61 72 ;; (print "Tar
dcd0: 67 65 74 3a 20 22 20 74 61 72 67 65 74 20 22 2f get: " target "/
dce0: 22 20 72 75 6e 6e 61 6d 65 20 22 20 74 65 73 74 " runname " test
dcf0: 73 3a 22 29 0a 09 09 09 09 09 09 09 20 20 20 20 s:")........
dd00: 20 3b 3b 20 28 70 70 20 74 65 73 74 73 29 0a 09 ;; (pp tests)..
dd10: 09 09 09 09 09 09 20 20 20 20 20 28 63 6f 6e 73 ...... (cons
dd20: 20 28 63 6f 6e 63 20 74 61 72 67 65 74 20 22 2f (conc target "/
dd30: 22 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 " runname)......
dd40: 09 09 09 20 20 20 28 63 6f 6e 73 20 28 6c 69 73 ... (cons (lis
dd50: 74 20 28 63 6f 6e 63 20 74 61 72 67 65 74 20 22 t (conc target "
dd60: 2f 22 20 72 75 6e 6e 61 6d 65 29 29 0a 09 09 09 /" runname))....
dd70: 09 09 09 09 09 09 20 28 63 6f 6e 73 20 27 28 29 ...... (cons '()
dd80: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
dd90: 20 28 63 6f 6e 73 20 72 75 6e 2d 66 69 65 6c 64 (cons run-field
dda0: 73 20 74 65 73 74 73 29 29 29 29 29 0a 09 09 09 s tests)))))....
ddb0: 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 .... (begin...
ddc0: 09 09 09 09 09 20 20 20 20 20 28 64 65 62 75 67 ..... (debug
ddd0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
dde0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 t-log-port* "WAR
ddf0: 4e 49 4e 47 3a 20 72 75 6e 20 22 20 74 61 72 67 NING: run " targ
de00: 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 et "/" runname "
de10: 20 61 70 70 65 61 72 73 20 74 6f 20 68 61 76 65 appears to have
de20: 20 6e 6f 20 64 61 74 61 22 29 0a 09 09 09 09 09 no data")......
de30: 09 09 20 20 20 20 20 3b 3b 20 28 70 70 20 72 75 .. ;; (pp ru
de40: 6e 64 61 74 29 0a 09 09 09 09 09 09 09 20 20 20 ndat)........
de50: 20 20 27 28 29 29 29 29 29 0a 09 09 09 09 09 09 '())))).......
de60: 20 20 20 72 75 6e 73 64 61 74 29 0a 09 09 09 09 runsdat).....
de70: 09 20 20 20 20 20 20 27 28 29 29 29 29 0a 09 09 . '())))...
de80: 09 09 20 20 20 20 20 20 6e 65 77 64 61 74 29 29 .. newdat))
de90: 20 3b 3b 20 77 65 20 75 73 65 20 6e 65 77 64 61 ;; we use newda
dea0: 74 20 74 6f 20 67 65 74 20 74 61 72 67 65 74 0a t to get target.
deb0: 09 09 20 28 73 68 65 65 74 73 20 20 20 20 20 20 .. (sheets
dec0: 20 20 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 (filter (lamb
ded0: 64 61 20 28 78 29 0a 09 09 09 09 09 20 20 20 28 da (x)...... (
dee0: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 78 29 29 29 0a not (null? x))).
def0: 09 09 09 09 09 20 28 63 6f 6e 73 20 72 75 6e 73 ..... (cons runs
df00: 20 28 6d 61 70 20 63 61 72 20 72 75 6e 2d 70 61 (map car run-pa
df10: 67 65 73 29 29 29 29 29 0a 09 20 20 20 20 3b 3b ges))))).. ;;
df20: 20 28 70 72 69 6e 74 20 22 61 6c 6c 72 75 6e 64 (print "allrund
df30: 61 74 3a 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 at:").. ;; (p
df40: 70 20 61 6c 6c 72 75 6e 64 61 74 29 0a 09 20 20 p allrundat)..
df50: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 72 75 6e ;; (print "run
df60: 73 3a 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 70 s:").. ;; (pp
df70: 20 72 75 6e 73 29 0a 09 20 20 20 20 3b 28 70 72 runs).. ;(pr
df80: 69 6e 74 20 22 73 68 65 65 74 73 3a 20 22 29 0a int "sheets: ").
df90: 09 20 20 20 20 3b 3b 20 28 70 70 20 73 68 65 65 . ;; (pp shee
dfa0: 74 73 29 0a 09 20 20 20 20 28 69 66 20 28 65 71 ts).. (if (eq
dfb0: 3f 20 64 6d 6f 64 65 20 27 6f 64 73 29 0a 09 09 ? dmode 'ods)...
dfc0: 28 6c 65 74 2a 20 28 28 74 65 6d 70 64 69 72 20 (let* ((tempdir
dfd0: 20 20 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 (conc "/tmp/"
dfe0: 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e (current-user-n
dff0: 61 6d 65 29 20 22 2f 22 20 28 72 61 6e 64 6f 6d ame) "/" (random
e000: 20 31 30 30 30 30 29 20 22 5f 22 20 28 63 75 72 10000) "_" (cur
e010: 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 rent-process-id)
e020: 29 29 0a 09 09 20 20 20 20 20 20 20 28 6f 75 74 ))... (out
e030: 70 75 74 66 69 6c 65 20 28 6f 72 20 28 61 72 67 putfile (or (arg
e040: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 20 s:get-arg "-o")
e050: 22 6f 75 74 2e 6f 64 73 22 29 29 0a 09 09 20 20 "out.ods"))...
e060: 20 20 20 20 20 28 6f 75 66 20 20 20 20 20 20 20 (ouf
e070: 20 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 (if (string-mat
e080: 63 68 20 28 72 65 67 65 78 70 20 22 5e 5b 2f 7e ch (regexp "^[/~
e090: 5d 2b 2e 2a 22 29 20 6f 75 74 70 75 74 66 69 6c ]+.*") outputfil
e0a0: 65 29 20 3b 3b 20 66 75 6c 6c 20 70 61 74 68 3f e) ;; full path?
e0b0: 0a 09 09 09 09 20 20 20 20 20 20 20 6f 75 74 70 ..... outp
e0c0: 75 74 66 69 6c 65 0a 09 09 09 09 20 20 20 20 20 utfile.....
e0d0: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 28 (begin...... (
e0e0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
e0f0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
e100: 20 22 57 41 52 4e 49 4e 47 3a 20 70 61 74 68 20 "WARNING: path
e110: 67 69 76 65 6e 2c 20 22 20 6f 75 74 70 75 74 66 given, " outputf
e120: 69 6c 65 20 22 20 69 73 20 72 65 6c 61 74 69 76 ile " is relativ
e130: 65 2c 20 70 72 65 66 69 78 69 6e 67 20 77 69 74 e, prefixing wit
e140: 68 20 63 75 72 72 65 6e 74 20 64 69 72 65 63 74 h current direct
e150: 6f 72 79 22 29 0a 09 09 09 09 09 20 28 63 6f 6e ory")...... (con
e160: 63 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 c (current-direc
e170: 74 6f 72 79 29 20 22 2f 22 20 6f 75 74 70 75 74 tory) "/" output
e180: 66 69 6c 65 29 29 29 29 29 0a 09 09 20 20 28 63 file)))))... (c
e190: 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 reate-directory
e1a0: 74 65 6d 70 64 69 72 20 23 74 29 0a 09 09 20 20 tempdir #t)...
e1b0: 28 6f 64 73 3a 6c 69 73 74 2d 3e 6f 64 73 20 74 (ods:list->ods t
e1c0: 65 6d 70 64 69 72 20 6f 75 66 20 73 68 65 65 74 empdir ouf sheet
e1d0: 73 29 29 29 29 0a 09 20 20 3b 3b 20 28 73 79 73 s)))).. ;; (sys
e1e0: 74 65 6d 20 28 63 6f 6e 63 20 22 72 6d 20 2d 72 tem (conc "rm -r
e1f0: 66 20 22 20 74 65 6d 70 64 69 72 29 29 0a 09 20 f " tempdir))..
e200: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
e210: 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b hing* #t))))..;;
e220: 20 44 6f 6e 27 74 20 74 68 69 6e 6b 20 49 20 6e Don't think I n
e230: 65 65 64 20 74 68 69 73 2e 20 49 6e 63 6f 72 70 eed this. Incorp
e240: 6f 72 61 74 65 64 20 69 6e 74 6f 20 2d 6c 69 73 orated into -lis
e250: 74 2d 72 75 6e 73 20 69 6e 73 74 65 61 64 0a 3b t-runs instead.;
e260: 3b 0a 3b 3b 20 28 69 66 20 28 61 6e 64 20 28 61 ;.;; (if (and (a
e270: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 rgs:get-arg "-si
e280: 6e 63 65 22 29 0a 3b 3b 20 09 20 28 6c 61 75 6e nce").;; . (laun
e290: 63 68 3a 73 65 74 75 70 29 29 0a 3b 3b 20 20 20 ch:setup)).;;
e2a0: 20 20 28 6c 65 74 2a 20 28 28 73 69 6e 63 65 2d (let* ((since-
e2b0: 74 69 6d 65 20 28 73 74 72 69 6e 67 2d 3e 6e 75 time (string->nu
e2c0: 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 mber (args:get-a
e2d0: 72 67 20 22 2d 73 69 6e 63 65 22 29 29 29 0a 3b rg "-since"))).;
e2e0: 3b 20 09 20 20 20 28 72 75 6e 2d 69 64 73 20 20 ; . (run-ids
e2f0: 20 20 28 64 62 3a 67 65 74 2d 63 68 61 6e 67 65 (db:get-change
e300: 64 2d 72 75 6e 2d 69 64 73 20 73 69 6e 63 65 2d d-run-ids since-
e310: 74 69 6d 65 29 29 29 0a 3b 3b 20 20 20 20 20 20 time))).;;
e320: 20 3b 3b 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 ;; (rmt:get-tes
e330: 74 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 ts-for-runs-mind
e340: 61 74 61 20 72 75 6e 2d 69 64 73 20 74 65 73 74 ata run-ids test
e350: 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 patt states stat
e360: 75 73 20 6e 6f 74 2d 69 6e 29 0a 3b 3b 20 20 20 us not-in).;;
e370: 20 20 20 20 28 70 72 69 6e 74 20 28 73 6f 72 74 (print (sort
e380: 20 72 75 6e 2d 69 64 73 20 3c 29 29 0a 3b 3b 20 run-ids <)).;;
e390: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
e3a0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
e3b0: 0a 20 20 20 20 20 20 0a 20 20 20 20 20 20 0a 3b . . .;
e3c0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
e3d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e3e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e3f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e400: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 =======.;; full
e410: 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;==========
e420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
e460: 20 67 65 74 20 6c 6f 63 6b 20 69 6e 20 64 62 20 get lock in db
e470: 66 6f 72 20 66 75 6c 6c 20 72 75 6e 20 66 6f 72 for full run for
e480: 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 0a this directory.
e490: 3b 3b 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 ;; for all tests
e4a0: 20 77 69 74 68 20 64 65 70 73 0a 3b 3b 20 20 20 with deps.;;
e4b0: 77 61 6c 6b 20 74 72 65 65 20 6f 66 20 74 65 73 walk tree of tes
e4c0: 74 73 20 74 6f 20 66 69 6e 64 20 68 65 61 64 20 ts to find head
e4d0: 74 61 73 6b 73 0a 3b 3b 20 20 20 61 64 64 20 68 tasks.;; add h
e4e0: 65 61 64 20 74 61 73 6b 73 20 74 6f 20 74 61 73 ead tasks to tas
e4f0: 6b 20 71 75 65 75 65 0a 3b 3b 20 20 20 61 64 64 k queue.;; add
e500: 20 64 65 70 65 6e 64 61 6e 74 20 74 61 73 6b 73 dependant tasks
e510: 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 20 0a to task queue .
e520: 3b 3b 20 20 20 61 64 64 20 72 65 6d 61 69 6e 69 ;; add remaini
e530: 6e 67 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b ng tasks to task
e540: 20 71 75 65 75 65 0a 3b 3b 20 66 6f 72 20 65 61 queue.;; for ea
e550: 63 68 20 74 61 73 6b 20 69 6e 20 74 61 73 6b 20 ch task in task
e560: 71 75 65 75 65 0a 3b 3b 20 20 20 69 66 20 68 61 queue.;; if ha
e570: 76 65 20 61 64 65 71 75 61 74 65 20 72 65 73 6f ve adequate reso
e580: 75 72 63 65 73 0a 3b 3b 20 20 20 20 20 6c 61 75 urces.;; lau
e590: 6e 63 68 20 74 61 73 6b 0a 3b 3b 20 20 20 65 6c nch task.;; el
e5a0: 73 65 0a 3b 3b 20 20 20 20 20 70 75 74 20 74 61 se.;; put ta
e5b0: 73 6b 20 69 6e 20 64 65 66 65 72 72 65 64 20 71 sk in deferred q
e5c0: 75 65 75 65 0a 3b 3b 20 69 66 20 73 74 69 6c 6c ueue.;; if still
e5d0: 20 6f 6b 20 74 6f 20 72 75 6e 20 74 61 73 6b 73 ok to run tasks
e5e0: 0a 3b 3b 20 20 20 70 72 6f 63 65 73 73 20 64 65 .;; process de
e5f0: 66 65 72 72 65 64 20 74 61 73 6b 73 20 70 65 72 ferred tasks per
e600: 20 61 62 6f 76 65 20 73 74 65 70 73 0a 0a 3b 3b above steps..;;
e610: 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 61 run all tests a
e620: 72 65 20 61 72 65 20 4e 6f 74 20 43 4f 4d 50 4c re are Not COMPL
e630: 45 54 45 44 20 61 6e 64 20 50 41 53 53 20 6f 72 ETED and PASS or
e640: 20 43 48 45 43 4b 0a 28 69 66 20 28 6f 72 20 28 CHECK.(if (or (
e650: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
e660: 75 6e 61 6c 6c 22 29 0a 09 28 61 72 67 73 3a 67 unall")..(args:g
e670: 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a 09 et-arg "-run")..
e680: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
e690: 72 65 72 75 6e 2d 63 6c 65 61 6e 22 29 0a 09 28 rerun-clean")..(
e6a0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
e6b0: 65 72 75 6e 2d 61 6c 6c 22 29 0a 09 28 61 72 67 erun-all")..(arg
e6c0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 s:get-arg "-runt
e6d0: 65 73 74 73 22 29 29 0a 20 20 20 20 28 67 65 6e ests")). (gen
e6e0: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 eral-run-call .
e6f0: 20 20 20 20 22 2d 72 75 6e 61 6c 6c 22 0a 20 20 "-runall".
e700: 20 20 20 22 72 75 6e 20 61 6c 6c 20 74 65 73 74 "run all test
e710: 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 s". (lambda
e720: 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 (target runname
e730: 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 keys keyvals).
e740: 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 (if (args:g
e750: 65 74 2d 61 72 67 20 22 2d 72 65 72 75 6e 2d 63 et-arg "-rerun-c
e760: 6c 65 61 6e 22 29 20 3b 3b 20 66 69 72 73 74 20 lean") ;; first
e770: 73 65 74 20 73 74 61 74 65 73 2f 73 74 61 74 75 set states/statu
e780: 73 65 73 20 63 6f 72 72 65 63 74 0a 09 20 20 20 ses correct..
e790: 28 6c 65 74 20 28 28 73 74 61 74 65 73 20 20 20 (let ((states
e7a0: 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (or (configf:loo
e7b0: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
e7c0: 22 76 61 6c 69 64 76 61 6c 75 65 73 22 20 22 63 "validvalues" "c
e7d0: 6c 65 61 6e 72 65 72 75 6e 2d 73 74 61 74 65 73 leanrerun-states
e7e0: 22 29 0a 09 09 09 20 20 20 20 20 20 20 22 4b 49 ").... "KI
e7f0: 4c 4c 52 45 51 2c 4b 49 4c 4c 45 44 2c 55 4e 4b LLREQ,KILLED,UNK
e800: 4e 4f 57 4e 2c 49 4e 43 4f 4d 50 4c 45 54 45 2c NOWN,INCOMPLETE,
e810: 53 54 55 43 4b 2c 4e 4f 54 5f 53 54 41 52 54 45 STUCK,NOT_STARTE
e820: 44 22 29 29 0a 09 09 20 28 73 74 61 74 75 73 65 D"))... (statuse
e830: 73 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c s (or (configf:l
e840: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
e850: 2a 20 22 76 61 6c 69 64 76 61 6c 75 65 73 22 20 * "validvalues"
e860: 22 63 6c 65 61 6e 72 65 72 75 6e 2d 73 74 61 74 "cleanrerun-stat
e870: 75 73 65 73 22 29 0a 09 09 09 20 20 20 20 20 20 uses")....
e880: 20 22 46 41 49 4c 2c 49 4e 43 4f 4d 50 4c 45 54 "FAIL,INCOMPLET
e890: 45 2c 41 42 4f 52 54 2c 43 48 45 43 4b 22 29 29 E,ABORT,CHECK"))
e8a0: 29 0a 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 ).. (hash-ta
e8b0: 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 ble-set! args:ar
e8c0: 67 2d 68 61 73 68 20 22 2d 70 72 65 63 6c 65 61 g-hash "-preclea
e8d0: 6e 22 20 23 74 29 0a 09 20 20 20 20 20 28 72 75 n" #t).. (ru
e8e0: 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 ns:operate-on 's
e8f0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a et-state-status.
e900: 09 09 09 20 20 20 20 20 20 74 61 72 67 65 74 0a ... target.
e910: 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e ... (common
e920: 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d :args-get-runnam
e930: 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 e) ;; (or (args
e940: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 :get-arg "-runna
e950: 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 me")(args:get-ar
e960: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g ":runname"))..
e970: 09 09 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 .. "%" ;; (
e980: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
e990: 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 testpatt #f) ;;
e9a0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
e9b0: 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 testpatt")....
e9c0: 20 20 20 20 73 74 61 74 65 3a 20 20 73 74 61 74 state: stat
e9d0: 65 73 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 73 es.... ;; s
e9e0: 74 61 74 75 73 3a 20 73 74 61 74 75 73 65 73 0a tatus: statuses.
e9f0: 09 09 09 20 20 20 20 20 20 6e 65 77 2d 73 74 61 ... new-sta
ea00: 74 65 2d 73 74 61 74 75 73 3a 20 22 4e 4f 54 5f te-status: "NOT_
ea10: 53 54 41 52 54 45 44 2c 6e 2f 61 22 29 0a 09 20 STARTED,n/a")..
ea20: 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 (runs:operat
ea30: 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d e-on 'set-state-
ea40: 73 74 61 74 75 73 0a 09 09 09 20 20 20 20 20 20 status....
ea50: 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 20 20 target....
ea60: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
ea70: 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f -runname) ;; (o
ea80: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
ea90: 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 "-runname")(args
eaa0: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
eab0: 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 20 22 me")).... "
eac0: 25 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 %" ;; (common:ar
ead0: 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 gs-get-testpatt
eae0: 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 #f) ;; (args:get
eaf0: 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 -arg "-testpatt"
eb00: 29 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 73 74 ).... ;; st
eb10: 61 74 65 3a 20 20 73 74 61 74 65 73 0a 09 09 09 ate: states....
eb20: 20 20 20 20 20 20 73 74 61 74 75 73 3a 20 73 74 status: st
eb30: 61 74 75 73 65 73 0a 09 09 09 20 20 20 20 20 20 atuses....
eb40: 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 new-state-status
eb50: 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e : "NOT_STARTED,n
eb60: 2f 61 22 29 29 29 0a 20 20 20 20 20 20 20 3b 3b /a"))). ;;
eb70: 20 52 45 52 55 4e 20 41 4c 4c 0a 20 20 20 20 20 RERUN ALL.
eb80: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
eb90: 61 72 67 20 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 arg "-rerun-all"
eba0: 29 20 3b 3b 20 66 69 72 73 74 20 73 65 74 20 73 ) ;; first set s
ebb0: 74 61 74 65 73 2f 73 74 61 74 75 73 65 73 20 63 tates/statuses c
ebc0: 6f 72 72 65 63 74 0a 09 20 20 20 28 62 65 67 69 orrect.. (begi
ebd0: 6e 0a 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 n.. (hash-ta
ebe0: 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 ble-set! args:ar
ebf0: 67 2d 68 61 73 68 20 22 2d 70 72 65 63 6c 65 61 g-hash "-preclea
ec00: 6e 22 20 23 74 29 0a 09 20 20 20 20 20 28 72 75 n" #t).. (ru
ec10: 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 ns:operate-on 's
ec20: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a et-state-status.
ec30: 09 09 09 20 20 20 20 20 20 74 61 72 67 65 74 0a ... target.
ec40: 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e ... (common
ec50: 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d :args-get-runnam
ec60: 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 e) ;; (or (args
ec70: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 :get-arg "-runna
ec80: 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 me")(args:get-ar
ec90: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g ":runname"))..
eca0: 09 09 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 .. "%" ;; (
ecb0: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
ecc0: 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 testpatt #f) ;;
ecd0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
ece0: 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 testpatt")....
ecf0: 20 20 20 20 73 74 61 74 65 3a 20 20 23 66 0a 09 state: #f..
ed00: 09 09 20 20 20 20 20 20 3b 3b 20 73 74 61 74 75 .. ;; statu
ed10: 73 3a 20 73 74 61 74 75 73 65 73 0a 09 09 09 20 s: statuses....
ed20: 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 new-state-s
ed30: 74 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 tatus: "NOT_STAR
ed40: 54 45 44 2c 6e 2f 61 22 29 0a 09 20 20 20 20 20 TED,n/a")..
ed50: 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e (runs:operate-on
ed60: 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 'set-state-stat
ed70: 75 73 0a 09 09 09 20 20 20 20 20 20 74 61 72 67 us.... targ
ed80: 65 74 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d et.... (com
ed90: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e mon:args-get-run
eda0: 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 name) ;; (or (a
edb0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
edc0: 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 nname")(args:get
edd0: 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 -arg ":runname")
ede0: 29 0a 09 09 09 20 20 20 20 20 20 22 25 22 20 3b ).... "%" ;
edf0: 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 ; (common:args-g
ee00: 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 20 et-testpatt #f)
ee10: 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ;; (args:get-arg
ee20: 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 "-testpatt")...
ee30: 09 20 20 20 20 20 20 3b 3b 20 73 74 61 74 65 3a . ;; state:
ee40: 20 20 73 74 61 74 65 73 0a 09 09 09 20 20 20 20 states....
ee50: 20 20 73 74 61 74 75 73 3a 20 23 66 0a 09 09 09 status: #f....
ee60: 20 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d new-state-
ee70: 73 74 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 status: "NOT_STA
ee80: 52 54 45 44 2c 6e 2f 61 22 29 29 29 0a 20 20 20 RTED,n/a"))).
ee90: 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 (runs:run-te
eea0: 73 74 73 20 74 61 72 67 65 74 0a 09 09 20 20 20 sts target...
eeb0: 20 20 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 runname...
eec0: 20 20 20 20 20 23 66 20 3b 3b 20 28 63 6f 6d 6d #f ;; (comm
eed0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
eee0: 70 61 74 74 20 23 66 29 0a 09 09 20 20 20 20 20 patt #f)...
eef0: 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 ;; (or (args:g
ef00: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
ef10: 74 22 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 t")... ;;
ef20: 20 20 20 20 22 25 22 29 0a 09 09 20 20 20 20 20 "%")...
ef30: 20 20 75 73 65 72 0a 09 09 20 20 20 20 20 20 20 user...
ef40: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 args:arg-hash)))
ef50: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
ef60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ef70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ef80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ef90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 ===========.;; r
efa0: 75 6e 20 6f 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d un one test.;;==
efb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
efc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
efd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
efe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eff0: 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 ====..;; 1. find
f000: 20 74 68 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 the config file
f010: 0a 3b 3b 20 32 2e 20 63 68 61 6e 67 65 20 74 6f .;; 2. change to
f020: 20 74 68 65 20 74 65 73 74 20 64 69 72 65 63 74 the test direct
f030: 6f 72 79 0a 3b 3b 20 33 2e 20 75 70 64 61 74 65 ory.;; 3. update
f040: 20 74 68 65 20 64 62 20 77 69 74 68 20 22 74 65 the db with "te
f050: 73 74 20 73 74 61 72 74 65 64 22 20 73 74 61 74 st started" stat
f060: 75 73 2c 20 73 65 74 20 72 75 6e 6e 69 6e 67 20 us, set running
f070: 68 6f 73 74 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 host.;; 4. proce
f080: 73 73 20 6c 61 75 6e 63 68 20 74 68 65 20 74 65 ss launch the te
f090: 73 74 0a 3b 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 st.;; - monit
f0a0: 6f 72 20 74 68 65 20 70 72 6f 63 65 73 73 2c 20 or the process,
f0b0: 75 70 64 61 74 65 20 73 74 61 74 73 20 69 6e 20 update stats in
f0c0: 74 68 65 20 64 62 20 65 76 65 72 79 20 32 5e 6e the db every 2^n
f0d0: 20 6d 69 6e 75 74 65 73 0a 3b 3b 20 35 2e 20 61 minutes.;; 5. a
f0e0: 73 20 74 68 65 20 74 65 73 74 20 70 72 6f 63 65 s the test proce
f0f0: 65 64 73 20 69 6e 74 65 72 6e 61 6c 6c 79 20 69 eds internally i
f100: 74 20 63 61 6c 6c 73 20 6d 65 67 61 74 65 73 74 t calls megatest
f110: 20 61 73 20 65 61 63 68 20 73 74 65 70 20 69 73 as each step is
f120: 0a 3b 3b 20 20 20 20 73 74 61 72 74 65 64 20 61 .;; started a
f130: 6e 64 20 63 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 nd completed.;;
f140: 20 20 20 2d 20 73 74 65 70 20 73 74 61 72 74 65 - step starte
f150: 64 2c 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 d, timestamp.;;
f160: 20 20 20 2d 20 73 74 65 70 20 63 6f 6d 70 6c 65 - step comple
f170: 74 65 64 2c 20 65 78 69 74 20 73 74 61 74 75 73 ted, exit status
f180: 2c 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 , timestamp.;; 6
f190: 2e 20 74 65 73 74 20 70 68 6f 6e 65 20 68 6f 6d . test phone hom
f1a0: 65 0a 3b 3b 20 20 20 20 2d 20 69 66 20 74 65 73 e.;; - if tes
f1b0: 74 20 72 75 6e 20 74 69 6d 65 20 3e 20 61 6c 6c t run time > all
f1c0: 6f 77 65 64 20 72 75 6e 20 74 69 6d 65 20 74 68 owed run time th
f1d0: 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 en kill job.;;
f1e0: 20 20 2d 20 69 66 20 63 61 6e 6e 6f 74 20 61 63 - if cannot ac
f1f0: 63 65 73 73 20 64 62 20 3e 20 61 6c 6c 6f 77 65 cess db > allowe
f200: 64 20 64 69 73 63 6f 6e 6e 65 63 74 20 74 69 6d d disconnect tim
f210: 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a e then kill job.
f220: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
f230: 64 20 3d 3d 20 28 69 66 20 28 6f 72 20 28 61 72 d == (if (or (ar
f240: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
f250: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
f260: 22 2d 72 75 6e 74 65 73 74 73 22 29 29 0a 3b 3b "-runtests")).;;
f270: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
f280: 3d 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e = (general-run
f290: 2d 63 61 6c 6c 20 0a 3b 3b 20 3d 3d 20 64 75 70 -call .;; == dup
f2a0: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 22 2d licated == "-
f2b0: 72 75 6e 74 65 73 74 73 22 20 0a 3b 3b 20 3d 3d runtests" .;; ==
f2c0: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
f2d0: 20 20 22 72 75 6e 20 61 20 74 65 73 74 22 20 0a "run a test" .
f2e0: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f2f0: 20 3d 3d 20 20 20 20 28 6c 61 6d 62 64 61 20 28 == (lambda (
f300: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
f310: 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 3b 3b 20 eys keyvals).;;
f320: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f330: 20 20 20 20 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 ;;.;; == d
f340: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
f350: 20 20 3b 3b 20 4d 61 79 20 6f 72 20 6d 61 79 20 ;; May or may
f360: 6e 6f 74 20 69 6d 70 6c 65 6d 65 6e 74 20 69 74 not implement it
f370: 20 74 68 69 73 20 77 61 79 20 2e 2e 2e 0a 3b 3b this way ....;;
f380: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
f390: 3d 20 20 20 20 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 = ;;.;; ==
f3a0: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
f3b0: 20 20 20 3b 3b 20 49 6e 73 65 72 74 20 74 68 69 ;; Insert thi
f3c0: 73 20 72 75 6e 20 69 6e 74 6f 20 74 68 65 20 74 s run into the t
f3d0: 61 73 6b 73 20 71 75 65 75 65 0a 3b 3b 20 3d 3d asks queue.;; ==
f3e0: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
f3f0: 20 20 20 20 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e ;; (open-run
f400: 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 61 64 64 -close tasks:add
f410: 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 0a tasks:open-db .
f420: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f430: 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 == ;; .
f440: 20 20 20 20 20 22 72 75 6e 74 65 73 74 73 22 20 "runtests"
f450: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
f460: 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 d == ;;
f470: 09 20 20 20 20 20 75 73 65 72 0a 3b 3b 20 3d 3d . user.;; ==
f480: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
f490: 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 ;; .
f4a0: 74 61 72 67 65 74 0a 3b 3b 20 3d 3d 20 64 75 70 target.;; == dup
f4b0: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 licated ==
f4c0: 3b 3b 20 20 20 20 09 20 20 20 20 20 72 75 6e 6e ;; . runn
f4d0: 61 6d 65 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 ame.;; == duplic
f4e0: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 ated == ;;
f4f0: 20 20 20 09 20 20 20 20 20 28 61 72 67 73 3a 67 . (args:g
f500: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
f510: 73 22 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 s").;; == duplic
f520: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 ated == ;;
f530: 20 20 20 09 20 20 20 20 20 23 66 29 29 29 29 0a . #f)))).
f540: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f550: 20 3d 3d 20 20 20 20 20 20 28 72 75 6e 73 3a 72 == (runs:r
f560: 75 6e 2d 74 65 73 74 73 20 74 61 72 67 65 74 0a un-tests target.
f570: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f580: 20 3d 3d 20 09 09 20 20 20 20 20 72 75 6e 6e 61 == .. runna
f590: 6d 65 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 me.;; == duplica
f5a0: 74 65 64 20 3d 3d 20 09 09 20 20 20 20 20 28 63 ted == .. (c
f5b0: 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 ommon:args-get-t
f5c0: 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 estpatt #f) ;; (
f5d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
f5e0: 75 6e 74 65 73 74 73 22 29 0a 3b 3b 20 3d 3d 20 untests").;; ==
f5f0: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 duplicated == ..
f600: 20 20 20 20 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 user.;; ==
f610: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 duplicated == ..
f620: 20 20 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 args:arg-ha
f630: 73 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d sh))))..;;======
f640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f680: 0a 3b 3b 20 52 6f 6c 6c 75 70 20 69 6e 74 6f 20 .;; Rollup into
f690: 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d a run.;;========
f6a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f6b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f6c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f6d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
f6e0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
f6f0: 67 20 22 2d 72 6f 6c 6c 75 70 22 29 0a 20 20 20 g "-rollup").
f700: 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 (general-run-ca
f710: 6c 6c 20 0a 20 20 20 20 20 22 2d 72 6f 6c 6c 75 ll . "-rollu
f720: 70 22 20 0a 20 20 20 20 20 22 72 6f 6c 6c 75 70 p" . "rollup
f730: 20 74 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c tests" . (l
f740: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
f750: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 nname keys keyva
f760: 6c 73 29 0a 20 20 20 20 20 20 20 28 72 75 6e 73 ls). (runs
f770: 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 6b 65 79 73 :rollup-run keys
f780: 0a 09 09 09 6b 65 79 76 61 6c 73 0a 09 09 09 28 ....keyvals....(
f790: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
f7a0: 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 "-runname")(arg
f7b0: 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e s:get-arg ":runn
f7c0: 61 6d 65 22 29 20 29 0a 09 09 09 75 73 65 72 29 ame") )....user)
f7d0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
f7e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f7f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
f820: 20 4c 6f 63 6b 20 6f 72 20 75 6e 6c 6f 63 6b 20 Lock or unlock
f830: 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d a run.;;========
f840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
f880: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
f890: 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 28 61 t-arg "-lock")(a
f8a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e rgs:get-arg "-un
f8b0: 6c 6f 63 6b 22 29 29 0a 20 20 20 20 28 67 65 6e lock")). (gen
f8c0: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 eral-run-call .
f8d0: 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 (if (args:ge
f8e0: 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 20 22 t-arg "-lock") "
f8f0: 2d 6c 6f 63 6b 22 20 22 2d 75 6e 6c 6f 63 6b 22 -lock" "-unlock"
f900: 29 0a 20 20 20 20 20 22 6c 6f 63 6b 2f 75 6e 6c ). "lock/unl
f910: 6f 63 6b 20 74 65 73 74 73 22 20 0a 20 20 20 20 ock tests" .
f920: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
f930: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
f940: 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 72 yvals). (r
f950: 75 6e 73 3a 68 61 6e 64 6c 65 2d 6c 6f 63 6b 69 uns:handle-locki
f960: 6e 67 20 0a 09 09 20 20 74 61 72 67 65 74 0a 09 ng ... target..
f970: 09 20 20 6b 65 79 73 0a 09 09 20 20 28 6f 72 20 . keys... (or
f980: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
f990: 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 runname")(args:g
f9a0: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
f9b0: 22 29 20 29 0a 09 09 20 20 28 61 72 67 73 3a 67 ") )... (args:g
f9c0: 65 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 0a et-arg "-lock").
f9d0: 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 .. (args:get-ar
f9e0: 67 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 09 09 20 g "-unlock")...
f9f0: 20 75 73 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d user))))..;;===
fa00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa40: 3d 3d 3d 0a 3b 3b 20 47 65 74 20 70 61 74 68 73 ===.;; Get paths
fa50: 20 74 6f 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d to tests.;;====
fa60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fa90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
faa0: 3d 3d 0a 3b 3b 20 47 65 74 20 74 65 73 74 20 70 ==.;; Get test p
fab0: 61 74 68 73 20 6d 61 74 63 68 69 6e 67 20 74 61 aths matching ta
fac0: 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 rget, runname, a
fad0: 6e 64 20 74 65 73 74 70 61 74 74 0a 28 69 66 20 nd testpatt.(if
fae0: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
faf0: 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 29 g "-test-files")
fb00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
fb10: 74 65 73 74 2d 70 61 74 68 73 22 29 29 0a 20 20 test-paths")).
fb20: 20 20 3b 3b 20 69 66 20 77 65 20 61 72 65 20 69 ;; if we are i
fb30: 6e 20 61 20 74 65 73 74 20 75 73 65 20 74 68 65 n a test use the
fb40: 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 61 74 61 MT_CMDINFO data
fb50: 0a 20 20 20 20 28 69 66 20 28 67 65 74 65 6e 76 . (if (getenv
fb60: 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 0a 09 "MT_CMDINFO")..
fb70: 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e 67 (let* ((starting
fb80: 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 72 dir (current-dir
fb90: 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 20 ectory))..
fba0: 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d (cmdinfo (com
fbb0: 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 mon:read-encoded
fbc0: 2d 73 74 72 69 6e 67 20 28 67 65 74 65 6e 76 20 -string (getenv
fbd0: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a "MT_CMDINFO"))).
fbe0: 09 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f . (transpo
fbf0: 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c rt (assoc/defaul
fc00: 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 t 'transport cmd
fc10: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
fc20: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
fc30: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
fc40: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
fc50: 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
fc60: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
fc70: 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
fc80: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
fc90: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
fca0: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
fcb0: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
fcc0: 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 (db-host (
fcd0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 assoc/default 'd
fce0: 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f b-host cmdinfo
fcf0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
fd00: 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 id (assoc/def
fd10: 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 ault 'run-id
fd20: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
fd30: 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
fd40: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
fd50: 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
fd60: 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 65 20 .. (state
fd70: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
fd80: 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 g ":state"))..
fd90: 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 (status
fda0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
fdb0: 73 74 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 status"))..
fdc0: 20 20 28 74 61 72 67 65 74 20 20 20 20 28 61 72 (target (ar
fdd0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 gs:get-arg "-tar
fde0: 67 65 74 22 29 29 0a 09 20 20 20 20 20 20 20 28 get")).. (
fdf0: 74 6f 70 70 61 74 68 20 20 20 28 61 73 73 6f 63 toppath (assoc
fe00: 2f 64 65 66 61 75 6c 74 20 27 74 6f 70 70 61 74 /default 'toppat
fe10: 68 20 20 20 63 6d 64 69 6e 66 6f 29 29 29 0a 09 h cmdinfo)))..
fe20: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
fe30: 6f 72 79 20 74 6f 70 70 61 74 68 29 0a 09 20 20 ory toppath)..
fe40: 28 69 66 20 28 6e 6f 74 20 74 61 72 67 65 74 29 (if (not target)
fe50: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
fe60: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 .(debug:print-er
fe70: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
fe80: 6f 67 2d 70 6f 72 74 2a 20 22 2d 74 61 72 67 65 og-port* "-targe
fe90: 74 20 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 t is required.")
fea0: 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 ...(exit 1)))..
feb0: 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 (if (not (launc
fec0: 68 3a 73 65 74 75 70 29 29 0a 09 20 20 20 20 20 h:setup))..
fed0: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
fee0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
fef0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
ff00: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 67 69 led to setup, gi
ff10: 76 69 6e 67 20 75 70 20 6f 6e 20 2d 74 65 73 74 ving up on -test
ff20: 2d 70 61 74 68 73 20 6f 72 20 2d 74 65 73 74 2d -paths or -test-
ff30: 66 69 6c 65 73 2c 20 65 78 69 74 69 6e 67 22 29 files, exiting")
ff40: 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 ...(exit 1)))..
ff50: 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 (let* ((keys
ff60: 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 (rmt:get-keys)
ff70: 29 0a 09 09 20 3b 3b 20 64 62 3a 74 65 73 74 2d )... ;; db:test-
ff80: 67 65 74 2d 70 61 74 68 73 20 6d 75 73 74 20 6e get-paths must n
ff90: 6f 74 20 62 65 20 72 75 6e 20 72 65 6d 6f 74 65 ot be run remote
ffa0: 0a 09 09 20 28 70 61 74 68 73 20 20 20 20 28 74 ... (paths (t
ffb0: 65 73 74 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 ests:test-get-pa
ffc0: 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 6b 65 79 ths-matching key
ffd0: 73 20 74 61 72 67 65 74 20 28 61 72 67 73 3a 67 s target (args:g
ffe0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 et-arg "-test-fi
fff0: 6c 65 73 22 29 29 29 29 0a 09 20 20 20 20 28 73 les")))).. (s
10000 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
10010 67 2a 20 23 74 29 0a 09 20 20 20 20 28 66 6f 72 g* #t).. (for
10020 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 -each (lambda (p
10030 61 74 68 29 0a 09 09 09 28 70 72 69 6e 74 20 70 ath)....(print p
10040 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 70 61 ath))... pa
10050 74 68 73 29 29 29 0a 09 3b 3b 20 65 6c 73 65 20 ths)))..;; else
10060 64 6f 20 61 20 67 65 6e 65 72 61 6c 2d 72 75 6e do a general-run
10070 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 72 61 6c 2d -call..(general-
10080 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 22 2d 74 65 run-call .. "-te
10090 73 74 2d 66 69 6c 65 73 22 0a 09 20 22 47 65 74 st-files".. "Get
100a0 20 70 61 74 68 73 20 74 6f 20 74 65 73 74 22 0a paths to test".
100b0 09 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 . (lambda (targe
100c0 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
100d0 65 79 76 61 6c 73 29 0a 09 20 20 20 28 6c 65 74 eyvals).. (let
100e0 2a 20 28 28 64 62 20 20 20 20 20 20 20 23 66 29 * ((db #f)
100f0 0a 09 09 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 ... ;; DO NOT r
10100 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 20 28 70 un remote... (p
10110 61 74 68 73 20 20 20 20 28 74 65 73 74 73 3a 74 aths (tests:t
10120 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 est-get-paths-ma
10130 74 63 68 69 6e 67 20 6b 65 79 73 20 74 61 72 67 tching keys targ
10140 65 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 et (args:get-arg
10150 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 29 29 "-test-files"))
10160 29 29 0a 09 20 20 20 20 20 28 66 6f 72 2d 65 61 )).. (for-ea
10170 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 74 68 ch (lambda (path
10180 29 0a 09 09 09 20 28 70 72 69 6e 74 20 70 61 74 ).... (print pat
10190 68 29 29 0a 09 09 20 20 20 20 20 20 20 70 61 74 h))... pat
101a0 68 73 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d hs))))))..;;====
101b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
101c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
101d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
101e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
101f0 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 20 74 65 ==.;; Archive te
10200 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d sts.;;==========
10210 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10220 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10230 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10240 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
10250 41 72 63 68 69 76 65 20 74 65 73 74 73 20 6d 61 Archive tests ma
10260 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 tching target, r
10270 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 65 73 74 unname, and test
10280 70 61 74 74 0a 28 69 66 20 28 61 72 67 73 3a 67 patt.(if (args:g
10290 65 74 2d 61 72 67 20 22 2d 61 72 63 68 69 76 65 et-arg "-archive
102a0 22 29 0a 20 20 20 20 3b 3b 20 65 6c 73 65 20 64 "). ;; else d
102b0 6f 20 61 20 67 65 6e 65 72 61 6c 2d 72 75 6e 2d o a general-run-
102c0 63 61 6c 6c 0a 20 20 20 20 28 67 65 6e 65 72 61 call. (genera
102d0 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 l-run-call .
102e0 20 22 2d 61 72 63 68 69 76 65 22 0a 20 20 20 20 "-archive".
102f0 20 22 41 72 63 68 69 76 65 22 0a 20 20 20 20 20 "Archive".
10300 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
10310 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
10320 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6f 70 vals). (op
10330 65 72 61 74 65 2d 6f 6e 20 27 61 72 63 68 69 76 erate-on 'archiv
10340 65 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d e))))..;;=======
10350 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10360 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10370 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10380 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
10390 3b 3b 20 45 78 74 72 61 63 74 20 61 20 73 70 72 ;; Extract a spr
103a0 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 74 68 eadsheet from th
103b0 65 20 72 75 6e 73 20 64 61 74 61 62 61 73 65 0a e runs database.
103c0 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
103d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
103e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
103f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10400 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
10410 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 rgs:get-arg "-ex
10420 74 72 61 63 74 2d 6f 64 73 22 29 0a 20 20 20 20 tract-ods").
10430 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
10440 6c 0a 20 20 20 20 20 22 2d 65 78 74 72 61 63 74 l. "-extract
10450 2d 6f 64 73 22 0a 20 20 20 20 20 22 4d 61 6b 65 -ods". "Make
10460 20 6f 64 73 20 73 70 72 65 61 64 73 68 65 65 74 ods spreadsheet
10470 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ". (lambda (
10480 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
10490 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 eys keyvals).
104a0 20 20 20 20 28 6c 65 74 20 28 28 64 62 73 74 72 (let ((dbstr
104b0 75 63 74 20 20 20 28 6d 61 6b 65 2d 64 62 72 3a uct (make-dbr:
104c0 64 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 2a dbstruct path: *
104d0 74 6f 70 70 61 74 68 2a 20 6c 6f 63 61 6c 3a 20 toppath* local:
104e0 23 74 29 29 0a 09 20 20 20 20 20 28 6f 75 74 70 #t)).. (outp
104f0 75 74 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 utfile (args:get
10500 2d 61 72 67 20 22 2d 65 78 74 72 61 63 74 2d 6f -arg "-extract-o
10510 64 73 22 29 29 0a 09 20 20 20 20 20 28 72 75 6e ds")).. (run
10520 73 70 61 74 74 20 20 20 28 6f 72 20 28 61 72 67 spatt (or (arg
10530 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
10540 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 ame")(args:get-a
10550 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 29 rg ":runname")))
10560 0a 09 20 20 20 20 20 28 70 61 74 68 6d 6f 64 20 .. (pathmod
10570 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
10580 20 22 2d 70 61 74 68 6d 6f 64 22 29 29 29 0a 09 "-pathmod")))..
10590 20 20 20 20 20 3b 3b 20 28 6b 65 79 76 61 6c 61 ;; (keyvala
105a0 6c 69 73 74 20 28 6b 65 79 73 2d 3e 61 6c 69 73 list (keys->alis
105b0 74 20 6b 65 79 73 20 22 25 22 29 29 29 0a 09 20 t keys "%")))..
105c0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a (debug:print 2 *
105d0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
105e0 2a 20 22 45 78 74 72 61 63 74 20 6f 64 73 2c 20 * "Extract ods,
105f0 6f 75 74 70 75 74 66 69 6c 65 3a 20 22 20 6f 75 outputfile: " ou
10600 74 70 75 74 66 69 6c 65 20 22 20 72 75 6e 73 70 tputfile " runsp
10610 61 74 74 3a 20 22 20 72 75 6e 73 70 61 74 74 20 att: " runspatt
10620 22 20 6b 65 79 76 61 6c 73 3a 20 22 20 6b 65 79 " keyvals: " key
10630 76 61 6c 73 29 0a 09 20 28 64 62 3a 65 78 74 72 vals).. (db:extr
10640 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 73 act-ods-file dbs
10650 74 72 75 63 74 20 6f 75 74 70 75 74 66 69 6c 65 truct outputfile
10660 20 6b 65 79 76 61 6c 73 20 28 69 66 20 72 75 6e keyvals (if run
10670 73 70 61 74 74 20 72 75 6e 73 70 61 74 74 20 22 spatt runspatt "
10680 25 22 29 20 70 61 74 68 6d 6f 64 29 0a 09 20 28 %") pathmod).. (
10690 64 62 3a 63 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 db:close-all dbs
106a0 74 72 75 63 74 29 0a 09 20 28 73 65 74 21 20 2a truct).. (set! *
106b0 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
106c0 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d )))))..;;=======
106d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
106e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
106f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10700 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
10710 3b 3b 20 65 78 65 63 75 74 65 20 74 68 65 20 74 ;; execute the t
10720 65 73 74 0a 3b 3b 20 20 20 20 2d 20 67 65 74 73 est.;; - gets
10730 20 63 61 6c 6c 65 64 20 6f 6e 20 72 65 6d 6f 74 called on remot
10740 65 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 72 e host.;; - r
10750 65 63 65 69 76 65 73 20 69 6e 66 6f 20 66 72 6f eceives info fro
10760 6d 20 74 68 65 20 2d 65 78 65 63 75 74 65 20 70 m the -execute p
10770 61 72 61 6d 0a 3b 3b 20 20 20 20 2d 20 70 61 73 aram.;; - pas
10780 73 65 73 20 69 6e 66 6f 20 74 6f 20 73 74 65 70 ses info to step
10790 73 20 76 69 61 20 4d 54 5f 43 4d 44 49 4e 46 4f s via MT_CMDINFO
107a0 20 65 6e 76 20 76 61 72 20 28 66 75 74 75 72 65 env var (future
107b0 20 69 73 20 74 6f 20 75 73 65 20 61 20 64 6f 74 is to use a dot
107c0 20 66 69 6c 65 29 0a 3b 3b 20 20 20 20 2d 20 67 file).;; - g
107d0 61 74 68 65 72 73 20 68 6f 73 74 20 69 6e 66 6f athers host info
107e0 20 61 6e 64 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d and .;;========
107f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10800 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10810 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10820 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
10830 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
10840 67 20 22 2d 65 78 65 63 75 74 65 22 29 0a 20 20 g "-execute").
10850 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
10860 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 28 launch:execute (
10870 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
10880 78 65 63 75 74 65 22 29 29 0a 20 20 20 20 20 20 xecute")).
10890 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
108a0 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d ing* #t)))..;;==
108b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 72 65 63 6f 76 65 72 20 ====.;; recover
10900 66 72 6f 6d 20 61 20 74 65 73 74 20 77 68 65 72 from a test wher
10910 65 20 74 68 65 20 6d 61 6e 61 67 69 6e 67 20 6d e the managing m
10920 74 65 73 74 20 77 61 73 20 6b 69 6c 6c 65 64 20 test was killed
10930 62 75 74 20 74 68 65 20 75 6e 64 65 72 6c 79 69 but the underlyi
10940 6e 67 0a 3b 3b 20 70 72 6f 63 65 73 73 20 6d 69 ng.;; process mi
10950 67 68 74 20 73 74 69 6c 6c 20 62 65 20 73 61 6c ght still be sal
10960 76 61 67 65 61 62 6c 65 0a 3b 3b 3d 3d 3d 3d 3d vageable.;;=====
10970 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10980 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10990 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109b0 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 =..(if (args:get
109c0 2d 61 72 67 20 22 2d 72 65 63 6f 76 65 72 2d 74 -arg "-recover-t
109d0 65 73 74 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 est"). (let*
109e0 28 28 70 61 72 61 6d 73 20 28 73 74 72 69 6e 67 ((params (string
109f0 2d 73 70 6c 69 74 20 28 61 72 67 73 3a 67 65 74 -split (args:get
10a00 2d 61 72 67 20 22 2d 72 65 63 6f 76 65 72 2d 74 -arg "-recover-t
10a10 65 73 74 22 29 20 22 2c 22 29 29 29 0a 20 20 20 est") ","))).
10a20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 (if (> (lengt
10a30 68 20 70 61 72 61 6d 73 29 20 31 29 20 3b 3b 20 h params) 1) ;;
10a40 72 75 6e 2d 69 64 20 61 6e 64 20 74 65 73 74 2d run-id and test-
10a50 69 64 0a 09 20 20 28 6c 65 74 20 28 28 72 75 6e id.. (let ((run
10a60 2d 69 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d -id (string->num
10a70 62 65 72 20 28 63 61 72 20 70 61 72 61 6d 73 29 ber (car params)
10a80 29 29 0a 09 09 28 74 65 73 74 2d 69 64 20 28 73 ))...(test-id (s
10a90 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 tring->number (c
10aa0 61 64 72 20 70 61 72 61 6d 73 29 29 29 29 0a 09 adr params))))..
10ab0 20 20 20 20 28 69 66 20 28 61 6e 64 20 72 75 6e (if (and run
10ac0 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09 09 28 -id test-id)...(
10ad0 62 65 67 69 6e 0a 09 09 20 20 28 6c 61 75 6e 63 begin... (launc
10ae0 68 3a 72 65 63 6f 76 65 72 2d 74 65 73 74 20 72 h:recover-test r
10af0 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09 un-id test-id)..
10b00 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d . (set! *didsom
10b10 65 74 68 69 6e 67 2a 20 23 74 29 29 0a 09 09 28 ething* #t))...(
10b20 62 65 67 69 6e 0a 09 09 20 20 28 64 65 62 75 67 begin... (debug
10b30 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
10b40 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
10b50 2a 20 22 62 61 64 20 72 75 6e 2d 69 64 20 6f 72 * "bad run-id or
10b60 20 74 65 73 74 2d 69 64 2c 20 6d 75 73 74 20 62 test-id, must b
10b70 65 20 69 6e 74 65 67 65 72 73 22 29 0a 09 09 20 e integers")...
10b80 20 28 65 78 69 74 20 31 29 29 29 29 29 29 29 0a (exit 1))))))).
10b90 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
10ba0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10bb0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10bc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10bd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 =========.;; Tes
10be0 74 20 63 6f 6d 6d 61 6e 64 73 20 28 69 2e 65 2e t commands (i.e.
10bf0 20 66 6f 72 20 75 73 65 20 69 6e 73 69 64 65 20 for use inside
10c00 74 65 73 74 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d tests).;;=======
10c10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
10c50 0a 28 64 65 66 69 6e 65 20 28 6d 65 67 61 74 65 .(define (megate
10c60 73 74 3a 73 74 65 70 20 73 74 65 70 20 73 74 61 st:step step sta
10c70 74 65 20 73 74 61 74 75 73 20 6c 6f 67 66 69 6c te status logfil
10c80 65 20 6d 73 67 29 0a 20 20 28 69 66 20 28 6e 6f e msg). (if (no
10c90 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d t (getenv "MT_CM
10ca0 44 49 4e 46 4f 22 29 29 0a 20 20 20 20 20 20 28 DINFO")). (
10cb0 62 65 67 69 6e 0a 09 28 64 65 62 75 67 3a 70 72 begin..(debug:pr
10cc0 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
10cd0 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
10ce0 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 MT_CMDINFO env v
10cf0 61 72 20 6e 6f 74 20 73 65 74 2c 20 2d 73 74 65 ar not set, -ste
10d00 70 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 p must be called
10d10 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 *inside* a mega
10d20 74 65 73 74 20 69 6e 76 6f 6b 65 64 20 65 6e 76 test invoked env
10d30 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 28 65 78 ironment!")..(ex
10d40 69 74 20 35 29 29 0a 20 20 20 20 20 20 28 6c 65 it 5)). (le
10d50 74 2a 20 28 28 63 6d 64 69 6e 66 6f 20 20 20 28 t* ((cmdinfo (
10d60 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f common:read-enco
10d70 64 65 64 2d 73 74 72 69 6e 67 20 28 67 65 74 65 ded-string (gete
10d80 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
10d90 29 29 0a 09 20 20 20 20 20 28 74 72 61 6e 73 70 )).. (transp
10da0 6f 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ort (assoc/defau
10db0 6c 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d lt 'transport cm
10dc0 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 dinfo)).. (t
10dd0 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f estpath (assoc/
10de0 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 default 'testpat
10df0 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 h cmdinfo))..
10e00 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 (test-name (a
10e10 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
10e20 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 st-name cmdinfo)
10e30 29 0a 09 20 20 20 20 20 28 72 75 6e 73 63 72 69 ).. (runscri
10e40 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c pt (assoc/defaul
10e50 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 t 'runscript cmd
10e60 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 64 62 info)).. (db
10e70 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 -host (assoc/d
10e80 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 efault 'db-host
10e90 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
10ea0 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 (run-id (as
10eb0 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
10ec0 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 -id cmdinfo))
10ed0 0a 09 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 .. (test-id
10ee0 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
10ef0 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 'test-id cmdi
10f00 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 69 74 65 nfo)).. (ite
10f10 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 mdat (assoc/de
10f20 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 fault 'itemdat
10f30 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
10f40 20 28 77 6f 72 6b 2d 61 72 65 61 20 28 61 73 73 (work-area (ass
10f50 6f 63 2f 64 65 66 61 75 6c 74 20 27 77 6f 72 6b oc/default 'work
10f60 2d 61 72 65 61 20 63 6d 64 69 6e 66 6f 29 29 0a -area cmdinfo)).
10f70 09 20 20 20 20 20 28 64 62 20 20 20 20 20 20 20 . (db
10f80 20 23 66 29 29 0a 09 28 63 68 61 6e 67 65 2d 64 #f))..(change-d
10f90 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
10fa0 68 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 6c 61 h)..(if (not (la
10fb0 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 unch:setup))..
10fc0 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
10fd0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
10fe0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
10ff0 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
11000 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 up, exiting")..
11010 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a (exit 1))).
11020 09 28 69 66 20 28 61 6e 64 20 73 74 61 74 65 20 .(if (and state
11030 73 74 61 74 75 73 29 0a 09 20 20 20 20 28 6c 65 status).. (le
11040 74 20 28 28 63 6f 6d 6d 65 6e 74 20 28 6c 61 75 t ((comment (lau
11050 6e 63 68 3a 6c 6f 61 64 2d 6c 6f 67 70 72 6f 2d nch:load-logpro-
11060 64 61 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d dat run-id test-
11070 69 64 20 73 74 65 70 29 29 29 0a 09 20 20 20 20 id step)))..
11080 20 20 3b 3b 20 28 72 6d 74 3a 74 65 73 74 2d 73 ;; (rmt:test-s
11090 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 et-log! run-id t
110a0 65 73 74 2d 69 64 20 28 63 6f 6e 63 20 73 74 65 est-id (conc ste
110b0 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 29 pname ".html")))
110c0 29 0a 09 20 20 20 20 20 20 28 72 6d 74 3a 74 65 ).. (rmt:te
110d0 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 ststep-set-statu
110e0 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 s! run-id test-i
110f0 64 20 73 74 65 70 20 73 74 61 74 65 20 73 74 61 d step state sta
11100 74 75 73 20 28 6f 72 20 63 6f 6d 6d 65 6e 74 20 tus (or comment
11110 6d 73 67 29 20 6c 6f 67 66 69 6c 65 29 29 0a 09 msg) logfile))..
11120 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 (begin..
11130 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
11140 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
11150 6c 6f 67 2d 70 6f 72 74 2a 20 22 59 6f 75 20 6d log-port* "You m
11160 75 73 74 20 73 70 65 63 69 66 79 20 3a 73 74 61 ust specify :sta
11170 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 20 77 te and :status w
11180 69 74 68 20 65 76 65 72 79 20 63 61 6c 6c 20 74 ith every call t
11190 6f 20 2d 73 74 65 70 22 29 0a 09 20 20 20 20 20 o -step")..
111a0 20 28 65 78 69 74 20 36 29 29 29 29 29 29 0a 0a (exit 6))))))..
111b0 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
111c0 67 20 22 2d 73 74 65 70 22 29 0a 20 20 20 20 28 g "-step"). (
111d0 62 65 67 69 6e 0a 20 20 20 20 20 20 28 6d 65 67 begin. (meg
111e0 61 74 65 73 74 3a 73 74 65 70 20 0a 20 20 20 20 atest:step .
111f0 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
11200 20 22 2d 73 74 65 70 22 29 0a 20 20 20 20 20 20 "-step").
11210 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
11220 72 67 20 22 2d 73 74 61 74 65 22 29 28 61 72 67 rg "-state")(arg
11230 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
11240 65 22 29 29 0a 20 20 20 20 20 20 20 28 6f 72 20 e")). (or
11250 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11260 73 74 61 74 75 73 22 29 28 61 72 67 73 3a 67 65 status")(args:ge
11270 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 t-arg ":status")
11280 29 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 ). (args:g
11290 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 et-arg "-setlog"
112a0 29 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 ). (args:g
112b0 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 20 20 et-arg "-m")).
112c0 20 20 20 20 3b 3b 20 28 69 66 20 64 62 20 28 73 ;; (if db (s
112d0 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
112e0 20 64 62 29 29 0a 20 20 20 20 20 20 28 73 65 74 db)). (set
112f0 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
11300 20 23 74 29 29 29 0a 20 20 20 20 0a 28 69 66 20 #t))). .(if
11310 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
11320 67 20 22 2d 73 65 74 6c 6f 67 22 29 20 20 20 20 g "-setlog")
11330 20 20 20 3b 3b 20 73 69 6e 63 65 20 73 65 74 74 ;; since sett
11340 69 6e 67 20 75 70 20 69 73 20 73 6f 20 63 6f 73 ing up is so cos
11350 74 6c 79 20 6c 65 74 73 20 70 69 67 67 79 62 61 tly lets piggyba
11360 63 6b 20 6f 6e 20 2d 74 65 73 74 2d 73 74 61 74 ck on -test-stat
11370 75 73 0a 09 3b 3b 20 20 20 20 20 28 6e 6f 74 20 us..;; (not
11380 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11390 73 74 65 70 22 29 29 29 20 20 3b 3b 20 2d 73 65 step"))) ;; -se
113a0 74 6c 6f 67 20 6d 61 79 20 68 61 76 65 20 62 65 tlog may have be
113b0 65 6e 20 70 72 6f 63 65 73 73 65 64 20 61 6c 72 en processed alr
113c0 65 61 64 79 20 69 6e 20 74 68 65 20 22 2d 73 74 eady in the "-st
113d0 65 70 22 20 70 72 65 76 69 6f 75 73 0a 09 3b 3b ep" previous..;;
113e0 20 20 20 20 20 4e 45 57 20 50 4f 4c 49 43 59 20 NEW POLICY
113f0 2d 20 2d 73 65 74 6c 6f 67 20 73 65 74 73 20 74 - -setlog sets t
11400 65 73 74 20 6f 76 65 72 61 6c 6c 20 6c 6f 67 20 est overall log
11410 6f 6e 20 65 76 65 72 79 20 63 61 6c 6c 2e 0a 09 on every call...
11420 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11430 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 28 61 set-toplog")..(a
11440 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
11450 73 74 2d 73 74 61 74 75 73 22 29 0a 09 28 61 72 st-status")..(ar
11460 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
11470 2d 76 61 6c 75 65 73 22 29 0a 09 28 61 72 67 73 -values")..(args
11480 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d :get-arg "-load-
11490 74 65 73 74 2d 64 61 74 61 22 29 0a 09 28 61 72 test-data")..(ar
114a0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
114b0 73 74 65 70 22 29 0a 09 28 61 72 67 73 3a 67 65 step")..(args:ge
114c0 74 2d 61 72 67 20 22 2d 73 75 6d 6d 61 72 69 7a t-arg "-summariz
114d0 65 2d 69 74 65 6d 73 22 29 29 0a 20 20 20 20 28 e-items")). (
114e0 69 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 if (not (getenv
114f0 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 "MT_CMDINFO"))..
11500 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 (begin.. (debug
11510 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
11520 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
11530 2a 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e * "MT_CMDINFO en
11540 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 63 v var not set, c
11550 6f 6d 6d 61 6e 64 73 20 2d 74 65 73 74 2d 73 74 ommands -test-st
11560 61 74 75 73 2c 20 2d 72 75 6e 73 74 65 70 20 61 atus, -runstep a
11570 6e 64 20 2d 73 65 74 6c 6f 67 20 6d 75 73 74 20 nd -setlog must
11580 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 64 be called *insid
11590 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 65 6e e* a megatest en
115a0 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 20 20 vironment!")..
115b0 28 65 78 69 74 20 35 29 29 0a 09 28 6c 65 74 2a (exit 5))..(let*
115c0 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 20 28 ((startingdir (
115d0 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 current-director
115e0 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 6d 64 y)).. (cmd
115f0 69 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 info (common:r
11600 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 ead-encoded-stri
11610 6e 67 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 ng (getenv "MT_C
11620 4d 44 49 4e 46 4f 22 29 29 29 0a 09 20 20 20 20 MDINFO")))..
11630 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 (transport (a
11640 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 ssoc/default 'tr
11650 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 ansport cmdinfo)
11660 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 ).. (testp
11670 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
11680 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
11690 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
116a0 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 (test-name (ass
116b0 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
116c0 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a -name cmdinfo)).
116d0 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 . (runscri
116e0 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c pt (assoc/defaul
116f0 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 t 'runscript cmd
11700 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
11710 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 db-host (assoc
11720 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 /default 'db-hos
11730 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
11740 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id
11750 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
11760 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 'run-id cmdin
11770 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 fo)).. (te
11780 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 st-id (assoc/d
11790 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 efault 'test-id
117a0 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
117b0 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 (itemdat (
117c0 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 assoc/default 'i
117d0 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f temdat cmdinfo
117e0 29 29 0a 09 20 20 20 20 20 20 20 28 77 6f 72 6b )).. (work
117f0 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 65 66 -area (assoc/def
11800 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 ault 'work-area
11810 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
11820 20 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 (db #f)
11830 20 3b 3b 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 ;; (open-db))..
11840 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 (state
11850 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
11860 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 ":state"))..
11870 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 61 (status (a
11880 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
11890 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 atus"))..
118a0 28 73 74 65 70 6e 61 6d 65 20 20 28 61 72 67 73 (stepname (args
118b0 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 :get-arg "-step"
118c0 29 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 ))).. (if (not
118d0 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
118e0 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
118f0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
11900 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
11910 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
11920 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 up, exiting")...
11930 28 65 78 69 74 20 31 29 29 29 0a 0a 09 20 20 28 (exit 1)))... (
11940 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
11950 20 22 2d 72 75 6e 73 74 65 70 22 29 28 64 65 62 "-runstep")(deb
11960 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 ug:print-info 1
11970 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
11980 74 2a 20 22 52 75 6e 6e 69 6e 67 20 2d 72 75 6e t* "Running -run
11990 73 74 65 70 2c 20 66 69 72 73 74 20 63 68 61 6e step, first chan
119a0 67 65 20 74 6f 20 64 69 72 65 63 74 6f 72 79 20 ge to directory
119b0 22 20 77 6f 72 6b 2d 61 72 65 61 29 29 0a 09 20 " work-area))..
119c0 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
119d0 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 ry work-area)..
119e0 20 3b 3b 20 63 61 6e 20 73 65 74 75 70 20 61 73 ;; can setup as
119f0 20 63 6c 69 65 6e 74 20 66 6f 72 20 73 65 72 76 client for serv
11a00 65 72 20 6d 6f 64 65 20 6e 6f 77 0a 09 20 20 3b er mode now.. ;
11a10 3b 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 70 29 ; (client:setup)
11a20 0a 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 ... (if (args:g
11a30 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d 74 65 et-arg "-load-te
11a40 73 74 2d 64 61 74 61 22 29 0a 09 20 20 20 20 20 st-data")..
11a50 20 3b 3b 20 68 61 73 20 73 75 62 20 63 6f 6d 6d ;; has sub comm
11a60 61 6e 64 73 20 74 68 61 74 20 61 72 65 20 72 64 ands that are rd
11a70 62 3a 0a 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 b:.. ;; DO
11a80 4e 4f 54 20 70 75 74 20 74 68 69 73 20 6f 6e 65 NOT put this one
11a90 20 69 6e 74 6f 20 65 69 74 68 65 72 20 72 6d 74 into either rmt
11aa0 3a 20 6f 72 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c : or open-run-cl
11ab0 6f 73 65 0a 09 20 20 20 20 20 20 28 74 64 62 3a ose.. (tdb:
11ac0 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 20 72 load-test-data r
11ad0 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a un-id test-id)).
11ae0 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 . (if (args:get
11af0 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a -arg "-setlog").
11b00 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 6f . (let ((lo
11b10 67 66 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 gfname (args:get
11b20 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 29 -arg "-setlog"))
11b30 29 0a 09 09 28 72 6d 74 3a 74 65 73 74 2d 73 65 )...(rmt:test-se
11b40 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 t-log! run-id te
11b50 73 74 2d 69 64 20 6c 6f 67 66 6e 61 6d 65 29 29 st-id logfname))
11b60 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 ).. (if (args:g
11b70 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 et-arg "-set-top
11b80 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 log").. ;;
11b90 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 DO NOT run remot
11ba0 65 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 3a e.. (tests:
11bb0 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 21 test-set-toplog!
11bc0 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
11bd0 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 e (args:get-arg
11be0 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 29 29 "-set-toplog")))
11bf0 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 .. (if (args:ge
11c00 74 2d 61 72 67 20 22 2d 73 75 6d 6d 61 72 69 7a t-arg "-summariz
11c10 65 2d 69 74 65 6d 73 22 29 0a 09 20 20 20 20 20 e-items")..
11c20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 ;; DO NOT run r
11c30 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 28 74 65 emote.. (te
11c40 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 sts:summarize-it
11c50 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ems run-id test-
11c60 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 74 29 id test-name #t)
11c70 29 20 3b 3b 20 64 6f 20 66 6f 72 63 65 20 68 65 ) ;; do force he
11c80 72 65 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a re.. (if (args:
11c90 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 get-arg "-runste
11ca0 70 22 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 p").. (if (
11cb0 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 0a 09 null? remargs)..
11cc0 09 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 . (begin...
11cd0 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
11ce0 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
11cf0 67 2d 70 6f 72 74 2a 20 22 6e 6f 74 68 69 6e 67 g-port* "nothing
11d00 20 73 70 65 63 69 66 69 65 64 20 74 6f 20 72 75 specified to ru
11d10 6e 21 22 29 0a 09 09 20 20 20 20 28 69 66 20 64 n!")... (if d
11d20 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c b (sqlite3:final
11d30 69 7a 65 21 20 64 62 29 29 0a 09 09 20 20 20 20 ize! db))...
11d40 28 65 78 69 74 20 36 29 29 0a 09 09 20 20 28 6c (exit 6))... (l
11d50 65 74 2a 20 28 28 73 74 65 70 6e 61 6d 65 20 20 et* ((stepname
11d60 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
11d70 2d 72 75 6e 73 74 65 70 22 29 29 0a 09 09 09 20 -runstep"))....
11d80 28 6c 6f 67 70 72 6f 66 69 6c 65 20 28 61 72 67 (logprofile (arg
11d90 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 70 s:get-arg "-logp
11da0 72 6f 22 29 29 0a 09 09 09 20 28 6c 6f 67 66 69 ro")).... (logfi
11db0 6c 65 20 20 20 20 28 63 6f 6e 63 20 73 74 65 70 le (conc step
11dc0 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 29 0a 09 09 name ".log"))...
11dd0 09 20 28 63 6d 64 20 20 20 20 20 20 20 20 28 69 . (cmd (i
11de0 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 f (null? remargs
11df0 29 20 23 66 20 28 63 61 72 20 72 65 6d 61 72 67 ) #f (car remarg
11e00 73 29 29 29 0a 09 09 09 20 28 70 61 72 61 6d 73 s))).... (params
11e10 20 20 20 20 20 28 69 66 20 63 6d 64 20 28 63 64 (if cmd (cd
11e20 72 20 72 65 6d 61 72 67 73 29 20 27 28 29 29 29 r remargs) '()))
11e30 0a 09 09 09 20 28 65 78 69 74 73 74 61 74 20 20 .... (exitstat
11e40 20 23 66 29 0a 09 09 09 20 28 73 68 65 6c 6c 20 #f).... (shell
11e50 20 20 20 20 20 28 6c 65 74 20 28 28 73 68 20 28 (let ((sh (
11e60 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
11e70 76 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 variable "SHELL"
11e80 29 20 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 ) )).....
11e90 28 69 66 20 73 68 20 0a 09 09 09 09 09 20 20 20 (if sh ......
11ea0 28 6c 61 73 74 20 28 73 74 72 69 6e 67 2d 73 70 (last (string-sp
11eb0 6c 69 74 20 73 68 20 22 2f 22 29 29 0a 09 09 09 lit sh "/"))....
11ec0 09 09 20 20 20 22 62 61 73 68 22 29 29 29 0a 09 .. "bash")))..
11ed0 09 09 20 28 72 65 64 69 72 20 20 20 20 20 20 28 .. (redir (
11ee0 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy
11ef0 6d 62 6f 6c 20 73 68 65 6c 6c 29 0a 09 09 09 09 mbol shell).....
11f00 20 20 20 20 20 20 20 28 28 74 63 73 68 20 63 73 ((tcsh cs
11f10 68 20 6b 73 68 29 20 20 20 20 22 3e 26 22 29 0a h ksh) ">&").
11f20 09 09 09 09 20 20 20 20 20 20 20 28 28 7a 73 68 .... ((zsh
11f30 20 62 61 73 68 20 73 68 20 61 73 68 29 20 22 32 bash sh ash) "2
11f40 3e 26 31 20 3e 22 29 0a 09 09 09 09 20 20 20 20 >&1 >").....
11f50 20 20 20 28 65 6c 73 65 20 22 3e 26 22 29 29 29 (else ">&")))
11f60 0a 09 09 09 20 28 66 75 6c 6c 63 6d 64 20 20 20 .... (fullcmd
11f70 20 28 63 6f 6e 63 20 22 28 22 20 28 73 74 72 69 (conc "(" (stri
11f80 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a ng-intersperse .
11f90 09 09 09 09 09 09 28 63 6f 6e 73 20 63 6d 64 20 ......(cons cmd
11fa0 70 61 72 61 6d 73 29 20 22 20 22 29 0a 09 09 09 params) " ")....
11fb0 09 09 20 20 20 22 29 20 22 20 72 65 64 69 72 20 .. ") " redir
11fc0 22 20 22 20 6c 6f 67 66 69 6c 65 29 29 29 0a 09 " " logfile)))..
11fd0 09 20 20 20 20 3b 3b 20 6d 61 72 6b 20 74 68 65 . ;; mark the
11fe0 20 73 74 61 72 74 20 6f 66 20 74 68 65 20 74 65 start of the te
11ff0 73 74 0a 09 09 20 20 20 20 28 72 6d 74 3a 74 65 st... (rmt:te
12000 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 ststep-set-statu
12010 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 s! run-id test-i
12020 64 20 73 74 65 70 6e 61 6d 65 20 22 73 74 61 72 d stepname "star
12030 74 22 20 22 6e 2f 61 22 20 28 61 72 67 73 3a 67 t" "n/a" (args:g
12040 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 6c 6f 67 et-arg "-m") log
12050 66 69 6c 65 29 0a 09 09 20 20 20 20 3b 3b 20 72 file)... ;; r
12060 75 6e 20 74 68 65 20 74 65 73 74 20 73 74 65 70 un the test step
12070 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
12080 69 6e 74 2d 69 6e 66 6f 20 32 20 2a 64 65 66 61 int-info 2 *defa
12090 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 ult-log-port* "R
120a0 75 6e 6e 69 6e 67 20 5c 22 22 20 66 75 6c 6c 63 unning \"" fullc
120b0 6d 64 20 22 5c 22 20 69 6e 20 64 69 72 65 63 74 md "\" in direct
120c0 6f 72 79 20 5c 22 22 20 73 74 61 72 74 69 6e 67 ory \"" starting
120d0 64 69 72 29 0a 09 09 20 20 20 20 28 63 68 61 6e dir)... (chan
120e0 67 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 ge-directory sta
120f0 72 74 69 6e 67 64 69 72 29 0a 09 09 20 20 20 20 rtingdir)...
12100 28 73 65 74 21 20 65 78 69 74 73 74 61 74 20 28 (set! exitstat (
12110 73 79 73 74 65 6d 20 66 75 6c 6c 63 6d 64 29 29 system fullcmd))
12120 0a 09 09 20 20 20 20 28 73 65 74 21 20 2a 67 6c ... (set! *gl
12130 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 obalexitstatus*
12140 65 78 69 74 73 74 61 74 29 0a 09 09 20 20 20 20 exitstat)...
12150 3b 3b 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 ;; (change-direc
12160 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
12170 09 20 20 20 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 . ;; run logp
12180 72 6f 20 69 66 20 61 70 70 6c 69 63 61 62 6c 65 ro if applicable
12190 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d 72 75 6e ;; (process-run
121a0 20 22 6c 73 22 20 28 6c 69 73 74 20 22 2f 66 6f "ls" (list "/fo
121b0 6f 22 20 22 32 3e 26 31 22 20 22 62 6c 61 68 2e o" "2>&1" "blah.
121c0 6c 6f 67 22 29 29 0a 09 09 20 20 20 20 28 69 66 log"))... (if
121d0 20 6c 6f 67 70 72 6f 66 69 6c 65 0a 09 09 09 28 logprofile....(
121e0 6c 65 74 2a 20 28 28 68 74 6d 6c 6c 6f 67 66 69 let* ((htmllogfi
121f0 6c 65 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d le (conc stepnam
12200 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 09 09 20 e ".html"))....
12210 20 20 20 20 20 20 28 6f 6c 64 65 78 69 74 73 74 (oldexitst
12220 61 74 20 65 78 69 74 73 74 61 74 29 0a 09 09 09 at exitstat)....
12230 20 20 20 20 20 20 20 28 63 6d 64 20 20 20 20 20 (cmd
12240 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 (string-inte
12250 72 73 70 65 72 73 65 20 28 6c 69 73 74 20 22 6c rsperse (list "l
12260 6f 67 70 72 6f 22 20 6c 6f 67 70 72 6f 66 69 6c ogpro" logprofil
12270 65 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c e htmllogfile "<
12280 22 20 6c 6f 67 66 69 6c 65 20 22 3e 22 20 28 63 " logfile ">" (c
12290 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 5f 6c onc stepname "_l
122a0 6f 67 70 72 6f 2e 6c 6f 67 22 29 29 20 22 20 22 ogpro.log")) " "
122b0 29 29 29 0a 09 09 09 20 20 28 64 65 62 75 67 3a ))).... (debug:
122c0 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 2a 64 65 print-info 2 *de
122d0 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
122e0 22 72 75 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 "running \"" cmd
122f0 20 22 5c 22 22 29 0a 09 09 09 20 20 28 63 68 61 "\"").... (cha
12300 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 nge-directory st
12310 61 72 74 69 6e 67 64 69 72 29 0a 09 09 09 20 20 artingdir)....
12320 28 73 65 74 21 20 65 78 69 74 73 74 61 74 20 28 (set! exitstat (
12330 73 79 73 74 65 6d 20 63 6d 64 29 29 0a 09 09 09 system cmd))....
12340 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 (set! *globale
12350 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 74 73 xitstatus* exits
12360 74 61 74 29 20 3b 3b 20 6e 6f 20 6e 65 63 65 73 tat) ;; no neces
12370 73 61 72 79 0a 09 09 09 20 20 28 63 68 61 6e 67 sary.... (chang
12380 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test
12390 70 61 74 68 29 0a 09 09 09 20 20 28 72 6d 74 3a path).... (rmt:
123a0 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 test-set-log! ru
123b0 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 68 74 6d n-id test-id htm
123c0 6c 6c 6f 67 66 69 6c 65 29 29 29 0a 09 09 20 20 llogfile)))...
123d0 20 20 28 6c 65 74 20 28 28 6d 73 67 20 28 61 72 (let ((msg (ar
123e0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
123f0 29 29 0a 09 09 20 20 20 20 20 20 28 72 6d 74 3a ))... (rmt:
12400 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
12410 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 tus! run-id test
12420 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 65 6e -id stepname "en
12430 64 22 20 65 78 69 74 73 74 61 74 20 6d 73 67 20 d" exitstat msg
12440 6c 6f 67 66 69 6c 65 29 29 0a 09 09 20 20 20 20 logfile))...
12450 29 29 29 0a 09 20 20 28 69 66 20 28 6f 72 20 28 ))).. (if (or (
12460 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
12470 65 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 20 est-status")...
12480 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
12490 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 29 0a 09 -set-values"))..
124a0 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 (let ((new
124b0 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 status (cond....
124c0 09 28 28 6e 75 6d 62 65 72 3f 20 73 74 61 74 75 .((number? statu
124d0 73 29 20 20 20 20 20 20 20 28 69 66 20 28 65 71 s) (if (eq
124e0 75 61 6c 3f 20 73 74 61 74 75 73 20 30 29 20 22 ual? status 0) "
124f0 50 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 PASS" "FAIL"))..
12500 09 09 09 28 28 61 6e 64 20 28 73 74 72 69 6e 67 ...((and (string
12510 3f 20 73 74 61 74 75 73 29 0a 09 09 09 09 20 20 ? status).....
12520 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d (string->num
12530 62 65 72 20 73 74 61 74 75 73 29 29 28 69 66 20 ber status))(if
12540 28 65 71 75 61 6c 3f 20 28 73 74 72 69 6e 67 2d (equal? (string-
12550 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 73 29 20 >number status)
12560 30 29 20 22 50 41 53 53 22 20 22 46 41 49 4c 22 0) "PASS" "FAIL"
12570 29 29 0a 09 09 09 09 28 65 6c 73 65 20 73 74 61 )).....(else sta
12580 74 75 73 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 tus)))... ;;
12590 74 72 61 6e 73 66 65 72 20 72 65 6c 65 76 61 6e transfer relevan
125a0 74 20 6b 65 79 73 20 69 6e 74 6f 20 61 20 68 61 t keys into a ha
125b0 73 68 20 74 6f 20 62 65 20 70 61 73 73 65 64 20 sh to be passed
125c0 74 6f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 to test-set-stat
125d0 75 73 21 0a 09 09 20 20 20 20 3b 3b 20 63 6f 75 us!... ;; cou
125e0 6c 64 20 75 73 65 20 61 6e 20 61 73 73 6f 63 20 ld use an assoc
125f0 6c 69 73 74 20 49 20 67 75 65 73 73 2e 20 0a 09 list I guess. ..
12600 09 20 20 20 20 28 6f 74 68 65 72 64 61 74 61 20 . (otherdata
12610 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 (let ((res (make
12620 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 -hash-table)))..
12630 09 09 09 20 28 66 6f 72 2d 65 61 63 68 20 28 6c ... (for-each (l
12640 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 09 ambda (key).....
12650 09 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a . (if (args:
12660 67 65 74 2d 61 72 67 20 6b 65 79 29 0a 09 09 09 get-arg key)....
12670 09 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ... (hash-table-
12680 73 65 74 21 20 72 65 73 20 6b 65 79 20 28 61 72 set! res key (ar
12690 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 79 29 29 gs:get-arg key))
126a0 29 29 0a 09 09 09 09 09 20 20 20 28 6c 69 73 74 ))...... (list
126b0 20 22 3a 76 61 6c 75 65 22 20 22 3a 74 6f 6c 22 ":value" ":tol"
126c0 20 22 3a 65 78 70 65 63 74 65 64 22 20 22 3a 66 ":expected" ":f
126d0 69 72 73 74 5f 65 72 72 22 20 22 3a 66 69 72 73 irst_err" ":firs
126e0 74 5f 77 61 72 6e 22 20 22 3a 75 6e 69 74 73 22 t_warn" ":units"
126f0 20 22 3a 63 61 74 65 67 6f 72 79 22 20 22 3a 76 ":category" ":v
12700 61 72 69 61 62 6c 65 22 29 29 0a 09 09 09 09 20 ariable")).....
12710 72 65 73 29 29 29 0a 09 09 28 69 66 20 28 61 6e res)))...(if (an
12720 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
12730 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a "-test-status").
12740 09 09 09 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 ... (or (not sta
12750 74 65 29 0a 09 09 09 20 20 20 20 20 28 6e 6f 74 te).... (not
12760 20 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 20 status)))...
12770 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 (begin...
12780 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
12790 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
127a0 67 2d 70 6f 72 74 2a 20 22 59 6f 75 20 6d 75 73 g-port* "You mus
127b0 74 20 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 t specify :state
127c0 20 61 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 and :status wit
127d0 68 20 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 h every call to
127e0 2d 74 65 73 74 2d 73 74 61 74 75 73 5c 6e 22 20 -test-status\n"
127f0 68 65 6c 70 29 0a 09 09 20 20 20 20 20 20 28 69 help)... (i
12800 66 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 62 f (sqlite3:datab
12810 61 73 65 3f 20 64 62 29 28 73 71 6c 69 74 65 33 ase? db)(sqlite3
12820 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
12830 09 09 20 20 20 20 20 20 28 65 78 69 74 20 36 29 .. (exit 6)
12840 29 29 0a 09 09 28 6c 65 74 2a 20 28 28 6d 73 67 ))...(let* ((msg
12850 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
12860 67 20 22 2d 6d 22 29 29 0a 09 09 20 20 20 20 20 g "-m"))...
12870 20 20 28 6e 75 6d 6f 74 68 20 28 6c 65 6e 67 74 (numoth (lengt
12880 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 h (hash-table-ke
12890 79 73 20 6f 74 68 65 72 64 61 74 61 29 29 29 29 ys otherdata))))
128a0 0a 09 09 20 20 3b 3b 20 43 6f 6e 76 65 72 74 20 ... ;; Convert
128b0 74 6f 20 72 70 63 20 69 6e 73 69 64 65 20 74 68 to rpc inside th
128c0 65 20 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 e tests:test-set
128d0 2d 73 74 61 74 75 73 21 20 63 61 6c 6c 2c 20 6e -status! call, n
128e0 6f 74 20 68 65 72 65 0a 09 09 20 20 28 74 65 73 ot here... (tes
128f0 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ts:test-set-stat
12900 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d us! run-id test-
12910 69 64 20 73 74 61 74 65 20 6e 65 77 73 74 61 74 id state newstat
12920 75 73 20 6d 73 67 20 6f 74 68 65 72 64 61 74 61 us msg otherdata
12930 20 77 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b work-area: work
12940 2d 61 72 65 61 29 29 29 29 0a 09 20 20 28 69 66 -area)))).. (if
12950 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 62 61 (sqlite3:databa
12960 73 65 3f 20 64 62 29 28 73 71 6c 69 74 65 33 3a se? db)(sqlite3:
12970 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 finalize! db))..
12980 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
12990 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b thing* #t))))..;
129a0 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
129b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
129c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
129d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
129e0 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 56 61 72 69 6f =======.;; Vario
129f0 75 73 20 68 65 6c 70 65 72 20 63 6f 6d 6d 61 6e us helper comman
12a00 64 73 20 63 61 6e 20 67 6f 20 62 65 6c 6f 77 20 ds can go below
12a10 68 65 72 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d here.;;=========
12a20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
12a60 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
12a70 2d 61 72 67 20 22 2d 73 68 6f 77 6b 65 79 73 22 -arg "-showkeys"
12a80 29 0a 20 20 20 20 20 20 20 20 28 61 72 67 73 3a ). (args:
12a90 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 6b get-arg "-show-k
12aa0 65 79 73 22 29 29 0a 20 20 20 20 28 6c 65 74 20 eys")). (let
12ab0 28 28 64 62 20 23 66 29 0a 09 20 20 28 6b 65 79 ((db #f).. (key
12ac0 73 20 23 66 29 29 0a 20 20 20 20 20 20 28 69 66 s #f)). (if
12ad0 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
12ae0 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a tup)).. (begin.
12af0 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
12b00 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
12b10 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 -port* "Failed t
12b20 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
12b30 22 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ").. (exit 1)
12b40 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 6b )). (set! k
12b50 65 79 73 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 eys (rmt:get-key
12b60 73 29 29 20 3b 3b 20 20 64 62 29 29 0a 20 20 20 s)) ;; db)).
12b70 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
12b80 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 1 *default-log-p
12b90 6f 72 74 2a 20 22 4b 65 79 73 3a 20 22 20 28 73 ort* "Keys: " (s
12ba0 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
12bb0 65 20 6b 65 79 73 20 22 2c 20 22 29 29 0a 20 20 e keys ", ")).
12bc0 20 20 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 (if (sqlite3
12bd0 3a 64 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 :database? db)(s
12be0 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
12bf0 20 64 62 29 29 0a 20 20 20 20 20 20 28 73 65 74 db)). (set
12c00 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
12c10 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
12c20 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 75 69 22 s:get-arg "-gui"
12c30 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
12c40 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
12c50 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
12c60 6f 72 74 2a 20 22 4c 6f 6f 6b 20 61 74 20 74 68 ort* "Look at th
12c70 65 20 64 61 73 68 62 6f 61 72 64 20 66 6f 72 20 e dashboard for
12c80 6e 6f 77 22 29 0a 20 20 20 20 20 20 3b 3b 20 28 now"). ;; (
12c90 6d 65 67 61 74 65 73 74 2d 67 75 69 29 0a 20 20 megatest-gui).
12ca0 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
12cb0 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
12cc0 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
12cd0 67 20 22 2d 63 72 65 61 74 65 2d 6d 65 67 61 74 g "-create-megat
12ce0 65 73 74 2d 61 72 65 61 22 29 0a 20 20 20 20 28 est-area"). (
12cf0 62 65 67 69 6e 0a 20 20 20 20 20 20 28 67 65 6e begin. (gen
12d00 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 example:mk-megat
12d10 65 73 74 2e 63 6f 6e 66 69 67 29 0a 20 20 20 20 est.config).
12d20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
12d30 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
12d40 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
12d50 22 2d 63 72 65 61 74 65 2d 74 65 73 74 22 29 0a "-create-test").
12d60 20 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 6e (let ((testn
12d70 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ame (args:get-ar
12d80 67 20 22 2d 63 72 65 61 74 65 2d 74 65 73 74 22 g "-create-test"
12d90 29 29 29 0a 20 20 20 20 20 20 28 67 65 6e 65 78 ))). (genex
12da0 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 ample:mk-megates
12db0 74 2d 74 65 73 74 20 74 65 73 74 6e 61 6d 65 29 t-test testname)
12dc0 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
12dd0 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
12de0 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
12df0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 ===========.;; U
12e30 70 64 61 74 65 20 74 68 65 20 64 61 74 61 62 61 pdate the databa
12e40 73 65 20 73 63 68 65 6d 61 2c 20 63 6c 65 61 6e se schema, clean
12e50 20 75 70 20 74 68 65 20 64 62 0a 3b 3b 3d 3d 3d up the db.;;===
12e60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ea0 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
12eb0 65 74 2d 61 72 67 20 22 2d 72 65 62 75 69 6c 64 et-arg "-rebuild
12ec0 2d 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e -db"). (begin
12ed0 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
12ee0 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
12ef0 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
12f00 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
12f10 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
12f20 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
12f30 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 p, exiting") ..
12f40 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))).
12f50 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 ;; keep this
12f60 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 one local.
12f70 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
12f80 20 70 61 74 63 68 2d 64 62 20 23 66 29 0a 20 20 patch-db #f).
12f90 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
12fa0 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
12fb0 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
12fc0 67 20 22 2d 63 6c 65 61 6e 75 70 2d 64 62 22 29 g "-cleanup-db")
12fd0 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
12fe0 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e (if (not (laun
12ff0 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 ch:setup)).. (b
13000 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 egin.. (debug
13010 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
13020 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
13030 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
13040 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 iting") .. (e
13050 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 xit 1))). (
13060 63 6f 6d 6d 6f 6e 3a 63 6c 65 61 6e 75 70 2d 64 common:cleanup-d
13070 62 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a b). (set! *
13080 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
13090 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
130a0 65 74 2d 61 72 67 20 22 2d 6d 61 72 6b 2d 69 6e et-arg "-mark-in
130b0 63 6f 6d 70 6c 65 74 65 73 22 29 0a 20 20 20 20 completes").
130c0 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 (begin. (if
130d0 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
130e0 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a tup)).. (begin.
130f0 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
13100 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
13110 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 -port* "Failed t
13120 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
13130 22 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ").. (exit 1)
13140 29 29 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 )). (open-r
13150 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 66 69 6e 64 un-close db:find
13160 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 -and-mark-incomp
13170 6c 65 74 65 20 23 66 29 0a 20 20 20 20 20 20 28 lete #f). (
13180 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
13190 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d ng* #t)))..;;===
131a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131e0 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 ===.;; Update th
131f0 65 20 74 65 73 74 73 20 6d 65 74 61 20 64 61 74 e tests meta dat
13200 61 20 66 72 6f 6d 20 74 68 65 20 74 65 73 74 63 a from the testc
13210 6f 6e 66 69 67 20 66 69 6c 65 73 0a 3b 3b 3d 3d onfig files.;;==
13220 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13230 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13240 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13250 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13260 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
13270 67 65 74 2d 61 72 67 20 22 2d 75 70 64 61 74 65 get-arg "-update
13280 2d 6d 65 74 61 22 29 0a 20 20 20 20 28 62 65 67 -meta"). (beg
13290 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f in. (if (no
132a0 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 t (launch:setup)
132b0 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 ).. (begin..
132c0 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
132d0 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
132e0 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 t* "Failed to se
132f0 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a tup, exiting") .
13300 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a . (exit 1))).
13310 20 20 20 20 20 20 3b 3b 20 6e 6f 77 20 63 61 6e ;; now can
13320 20 66 69 6e 64 20 6f 75 72 20 64 62 0a 20 20 20 find our db.
13330 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 ;; keep this
13340 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 20 one local.
13350 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
13360 72 75 6e 73 3a 75 70 64 61 74 65 2d 61 6c 6c 2d runs:update-all-
13370 74 65 73 74 5f 6d 65 74 61 20 23 66 29 0a 20 20 test_meta #f).
13380 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
13390 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
133a0 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
133b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
133c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
133d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
133e0 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 ========.;; Star
133f0 74 20 61 20 72 65 70 6c 0a 3b 3b 3d 3d 3d 3d 3d t a repl.;;=====
13400 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13410 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13420 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13430 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13440 3d 0a 0a 3b 3b 20 66 61 6b 65 6f 75 74 20 72 65 =..;; fakeout re
13450 61 64 6c 69 6e 65 0a 28 69 6e 63 6c 75 64 65 20 adline.(include
13460 22 72 65 61 64 6c 69 6e 65 2d 66 69 78 2e 73 63 "readline-fix.sc
13470 6d 22 29 0a 0a 28 69 66 20 28 6f 72 20 28 67 65 m")..(if (or (ge
13480 74 65 6e 76 20 22 4d 54 5f 52 55 4e 53 43 52 49 tenv "MT_RUNSCRI
13490 50 54 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d PT")..(args:get-
134a0 61 72 67 20 22 2d 72 65 70 6c 22 29 0a 09 28 61 arg "-repl")..(a
134b0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
134c0 61 64 22 29 29 0a 20 20 20 20 28 6c 65 74 2a 20 ad")). (let*
134d0 28 28 74 6f 70 70 61 74 68 20 28 6c 61 75 6e 63 ((toppath (launc
134e0 68 3a 73 65 74 75 70 29 29 0a 09 20 20 20 28 64 h:setup)).. (d
134f0 62 73 74 72 75 63 74 20 28 69 66 20 74 6f 70 70 bstruct (if topp
13500 61 74 68 20 28 64 62 3a 73 65 74 75 70 29 29 29 ath (db:setup)))
13510 29 20 3b 3b 20 6d 61 6b 65 2d 64 62 72 3a 64 62 ) ;; make-dbr:db
13520 73 74 72 75 63 74 20 70 61 74 68 3a 20 74 6f 70 struct path: top
13530 70 61 74 68 20 6c 6f 63 61 6c 3a 20 28 61 72 67 path local: (arg
13540 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 61 s:get-arg "-loca
13550 6c 22 29 29 20 23 66 29 29 29 0a 20 20 20 20 20 l")) #f))).
13560 20 28 69 66 20 64 62 73 74 72 75 63 74 0a 09 20 (if dbstruct..
13570 20 28 63 6f 6e 64 0a 09 20 20 20 28 28 67 65 74 (cond.. ((get
13580 65 6e 76 20 22 4d 54 5f 52 55 4e 53 43 52 49 50 env "MT_RUNSCRIP
13590 54 22 29 0a 09 20 20 20 20 3b 3b 20 48 6f 77 20 T").. ;; How
135a0 74 6f 20 72 75 6e 20 6d 65 67 61 74 65 73 74 20 to run megatest
135b0 73 63 72 69 70 74 73 0a 09 20 20 20 20 3b 3b 0a scripts.. ;;.
135c0 09 20 20 20 20 3b 3b 20 23 21 2f 62 69 6e 2f 62 . ;; #!/bin/b
135d0 61 73 68 0a 09 20 20 20 20 3b 3b 0a 09 20 20 20 ash.. ;;..
135e0 20 3b 3b 20 65 78 70 6f 72 74 20 4d 54 5f 52 55 ;; export MT_RU
135f0 4e 53 43 52 49 50 54 3d 79 65 73 0a 09 20 20 20 NSCRIPT=yes..
13600 20 3b 3b 20 6d 65 67 61 74 65 73 74 20 3c 3c 20 ;; megatest <<
13610 45 4f 46 0a 09 20 20 20 20 3b 3b 20 28 70 72 69 EOF.. ;; (pri
13620 6e 74 20 22 48 65 6c 6c 6f 20 77 6f 72 6c 64 22 nt "Hello world"
13630 29 0a 09 20 20 20 20 3b 3b 20 28 65 78 69 74 29 ).. ;; (exit)
13640 0a 09 20 20 20 20 3b 3b 20 45 4f 46 0a 0a 09 20 .. ;; EOF...
13650 20 20 20 28 72 65 70 6c 29 29 0a 09 20 20 20 28 (repl)).. (
13660 65 6c 73 65 0a 09 20 20 20 20 28 62 65 67 69 6e else.. (begin
13670 0a 09 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 .. (set! *d
13680 62 2a 20 64 62 73 74 72 75 63 74 29 0a 09 20 20 b* dbstruct)..
13690 20 20 20 20 28 69 6d 70 6f 72 74 20 65 78 74 72 (import extr
136a0 61 73 29 20 3b 3b 20 6d 69 67 68 74 20 6e 6f 74 as) ;; might not
136b0 20 62 65 20 6e 65 65 64 65 64 0a 09 20 20 20 20 be needed..
136c0 20 20 3b 3b 20 28 69 6d 70 6f 72 74 20 63 73 69 ;; (import csi
136d0 29 0a 09 20 20 20 20 20 20 28 69 6d 70 6f 72 74 ).. (import
136e0 20 72 65 61 64 6c 69 6e 65 29 0a 09 20 20 20 20 readline)..
136f0 20 20 28 69 6d 70 6f 72 74 20 61 70 72 6f 70 6f (import apropo
13700 73 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 69 6d s).. ;; (im
13710 70 6f 72 74 20 28 70 72 65 66 69 78 20 73 71 6c port (prefix sql
13720 69 74 65 33 20 73 71 6c 69 74 65 33 3a 29 29 20 ite3 sqlite3:))
13730 3b 3b 20 64 6f 65 73 6e 27 74 20 77 6f 72 6b 20 ;; doesn't work
13740 2e 2e 2e 0a 0a 09 20 20 20 20 20 20 28 69 66 20 ...... (if
13750 2a 75 73 65 2d 6e 65 77 2d 72 65 61 64 6c 69 6e *use-new-readlin
13760 65 2a 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 e*... (begin...
13770 20 20 20 20 28 69 6e 73 74 61 6c 6c 2d 68 69 73 (install-his
13780 74 6f 72 79 2d 66 69 6c 65 20 28 67 65 74 2d 65 tory-file (get-e
13790 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
137a0 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2e 6d 65 ble "HOME") ".me
137b0 67 61 74 65 73 74 5f 68 69 73 74 6f 72 79 22 29 gatest_history")
137c0 20 3b 3b 20 20 5b 68 6f 6d 65 64 69 72 5d 20 5b ;; [homedir] [
137d0 66 69 6c 65 6e 61 6d 65 5d 20 5b 6e 6c 69 6e 65 filename] [nline
137e0 73 5d 29 0a 09 09 20 20 20 20 28 63 75 72 72 65 s])... (curre
137f0 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 20 28 6d nt-input-port (m
13800 61 6b 65 2d 72 65 61 64 6c 69 6e 65 2d 70 6f 72 ake-readline-por
13810 74 20 22 6d 65 67 61 74 65 73 74 3e 20 22 29 29 t "megatest> "))
13820 29 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 )... (begin...
13830 20 20 20 28 67 6e 75 2d 68 69 73 74 6f 72 79 2d (gnu-history-
13840 69 6e 73 74 61 6c 6c 2d 66 69 6c 65 2d 6d 61 6e install-file-man
13850 61 67 65 72 0a 09 09 20 20 20 20 20 28 73 74 72 ager... (str
13860 69 6e 67 2d 61 70 70 65 6e 64 0a 09 09 20 20 20 ing-append...
13870 20 20 20 28 6f 72 20 28 67 65 74 2d 65 6e 76 69 (or (get-envi
13880 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
13890 20 22 48 4f 4d 45 22 29 20 22 2e 22 29 20 22 2f "HOME") ".") "/
138a0 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 74 6f 72 .megatest_histor
138b0 79 22 29 29 0a 09 09 20 20 20 20 28 63 75 72 72 y"))... (curr
138c0 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 20 28 ent-input-port (
138d0 6d 61 6b 65 2d 67 6e 75 2d 72 65 61 64 6c 69 6e make-gnu-readlin
138e0 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 65 73 74 e-port "megatest
138f0 3e 20 22 29 29 29 29 0a 09 20 20 20 20 20 20 28 > ")))).. (
13900 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
13910 20 22 2d 72 65 70 6c 22 29 0a 09 09 20 20 28 72 "-repl")... (r
13920 65 70 6c 29 0a 09 09 20 20 28 6c 6f 61 64 20 28 epl)... (load (
13930 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
13940 6f 61 64 22 29 29 29 0a 09 20 20 20 20 20 20 3b oad"))).. ;
13950 3b 20 28 64 62 3a 63 6c 6f 73 65 2d 61 6c 6c 20 ; (db:close-all
13960 64 62 73 74 72 75 63 74 29 20 3c 3d 20 74 61 6b dbstruct) <= tak
13970 65 6e 20 63 61 72 65 20 6f 66 20 62 79 20 6f 6e en care of by on
13980 2d 65 78 69 74 20 63 61 6c 6c 0a 09 20 20 20 20 -exit call..
13990 20 20 29 0a 09 20 20 20 20 28 65 78 69 74 29 29 ).. (exit))
139a0 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 ).. (set! *dids
139b0 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 omething* #t))))
139c0 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
139d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
139e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
139f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13a00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 57 61 ==========.;; Wa
13a10 69 74 20 6f 6e 20 61 20 72 75 6e 20 74 6f 20 63 it on a run to c
13a20 6f 6d 70 6c 65 74 65 0a 3b 3b 3d 3d 3d 3d 3d 3d omplete.;;======
13a30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13a40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13a50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13a60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13a70 0a 0a 28 69 66 20 28 61 6e 64 20 28 61 72 67 73 ..(if (and (args
13a80 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 2d 77 :get-arg "-run-w
13a90 61 69 74 22 29 0a 09 20 28 6e 6f 74 20 28 6f 72 ait").. (not (or
13aa0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
13ab0 2d 72 75 6e 22 29 0a 09 09 20 20 28 61 72 67 73 -run")... (args
13ac0 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
13ad0 73 74 73 22 29 29 29 29 20 3b 3b 20 72 75 6e 2d sts")))) ;; run-
13ae0 77 61 69 74 20 69 73 20 62 75 69 6c 74 20 69 6e wait is built in
13af0 74 6f 20 72 75 6e 74 65 73 74 73 20 6e 6f 77 0a to runtests now.
13b00 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
13b10 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 (if (not (launc
13b20 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 65 h:setup)).. (be
13b30 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a gin.. (debug:
13b40 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
13b50 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c -log-port* "Fail
13b60 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
13b70 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 78 ting") .. (ex
13b80 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 6f it 1))). (o
13b90 70 65 72 61 74 65 2d 6f 6e 20 27 72 75 6e 2d 77 perate-on 'run-w
13ba0 61 69 74 29 0a 20 20 20 20 20 20 28 73 65 74 21 ait). (set!
13bb0 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
13bc0 23 74 29 29 29 0a 0a 3b 3b 20 3b 3b 20 3b 3b 20 #t)))..;; ;; ;;
13bd0 72 65 64 6f 20 6d 65 20 3b 3b 20 4e 6f 74 20 63 redo me ;; Not c
13be0 6f 6e 76 65 72 74 65 64 20 74 6f 20 75 73 65 20 onverted to use
13bf0 64 62 73 74 72 75 63 74 20 79 65 74 0a 3b 3b 20 dbstruct yet.;;
13c00 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 3b 3b ;; ;; redo me ;;
13c10 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13c20 65 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d e (if (args:get-
13c30 61 72 67 20 22 2d 63 6f 6e 76 65 72 74 2d 74 6f arg "-convert-to
13c40 2d 6e 6f 72 6d 22 29 0a 3b 3b 20 3b 3b 20 3b 3b -norm").;; ;; ;;
13c50 20 72 65 64 6f 20 6d 65 20 20 20 20 20 28 6c 65 redo me (le
13c60 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 73 65 t* ((toppath (se
13c70 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 3b 3b tup-for-run)).;;
13c80 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
13c90 20 20 20 28 64 62 73 74 72 75 63 74 20 28 69 66 (dbstruct (if
13ca0 20 74 6f 70 70 61 74 68 20 28 6d 61 6b 65 2d 64 toppath (make-d
13cb0 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 68 br:dbstruct path
13cc0 3a 20 74 6f 70 70 61 74 68 20 6c 6f 63 61 6c 3a : toppath local:
13cd0 20 23 74 29 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b #t)))).;; ;; ;;
13ce0 20 72 65 64 6f 20 6d 65 20 20 20 20 20 20 20 28 redo me (
13cf0 66 6f 72 2d 65 61 63 68 20 0a 3b 3b 20 3b 3b 20 for-each .;; ;;
13d00 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 20 ;; redo me
13d10 20 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 (lambda (field
13d20 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
13d30 6d 65 20 09 20 28 6c 65 74 20 28 28 64 61 74 20 me . (let ((dat
13d40 27 28 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 '())).;; ;; ;; r
13d50 65 64 6f 20 6d 65 20 09 20 20 20 28 64 65 62 75 edo me . (debu
13d60 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
13d70 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
13d80 2a 20 22 47 65 74 74 69 6e 67 20 64 61 74 61 20 * "Getting data
13d90 66 6f 72 20 66 69 65 6c 64 20 22 20 66 69 65 6c for field " fiel
13da0 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f d).;; ;; ;; redo
13db0 20 6d 65 20 09 20 20 20 28 73 71 6c 69 74 65 33 me . (sqlite3
13dc0 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 3b 3b :for-each-row.;;
13dd0 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
13de0 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 (lambda (id
13df0 76 61 6c 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 val).;; ;; ;; re
13e00 64 6f 20 6d 65 20 09 20 20 20 20 20 20 28 73 65 do me . (se
13e10 74 21 20 64 61 74 20 28 63 6f 6e 73 20 28 6c 69 t! dat (cons (li
13e20 73 74 20 69 64 20 76 61 6c 29 20 64 61 74 29 29 st id val) dat))
13e30 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
13e40 6d 65 20 09 20 20 20 20 28 64 62 3a 67 65 74 2d me . (db:get-
13e50 64 62 20 64 62 20 72 75 6e 2d 69 64 29 0a 3b 3b db db run-id).;;
13e60 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
13e70 20 20 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 (conc "SELEC
13e80 54 20 69 64 2c 22 20 66 69 65 6c 64 20 22 20 46 T id," field " F
13e90 52 4f 4d 20 74 65 73 74 73 3b 22 29 29 0a 3b 3b ROM tests;")).;;
13ea0 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
13eb0 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
13ec0 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
13ed0 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 6f 75 6e 64 log-port* "found
13ee0 20 22 20 28 6c 65 6e 67 74 68 20 64 61 74 29 20 " (length dat)
13ef0 22 20 69 74 65 6d 73 20 66 6f 72 20 66 69 65 6c " items for fiel
13f00 64 20 22 20 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b d " field).;; ;;
13f10 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
13f20 28 6c 65 74 20 28 28 71 72 79 20 28 73 71 6c 69 (let ((qry (sqli
13f30 74 65 33 3a 70 72 65 70 61 72 65 20 64 62 20 28 te3:prepare db (
13f40 63 6f 6e 63 20 22 55 50 44 41 54 45 20 74 65 73 conc "UPDATE tes
13f50 74 73 20 53 45 54 20 22 20 66 69 65 6c 64 20 22 ts SET " field "
13f60 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 =? WHERE id=?;")
13f70 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ))).;; ;; ;; red
13f80 6f 20 6d 65 20 09 20 20 20 20 20 28 66 6f 72 2d o me . (for-
13f90 65 61 63 68 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 each.;; ;; ;; re
13fa0 64 6f 20 6d 65 20 09 20 20 20 20 20 20 28 6c 61 do me . (la
13fb0 6d 62 64 61 20 28 69 74 65 6d 29 0a 3b 3b 20 3b mbda (item).;; ;
13fc0 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 28 ; ;; redo me ..(
13fd0 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 3b 3b 20 let ((newval ;;
13fe0 28 73 64 62 3a 71 72 79 20 27 67 65 74 69 64 20 (sdb:qry 'getid
13ff0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
14000 65 20 09 09 20 20 20 20 20 20 20 28 63 61 64 72 e .. (cadr
14010 20 69 74 65 6d 29 29 29 20 3b 3b 20 29 0a 3b 3b item))) ;; ).;;
14020 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
14030 09 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 . (if (not (equ
14040 61 6c 3f 20 6e 65 77 76 61 6c 20 28 63 61 64 72 al? newval (cadr
14050 20 69 74 65 6d 29 29 29 0a 3b 3b 20 3b 3b 20 3b item))).;; ;; ;
14060 3b 20 72 65 64 6f 20 6d 65 20 09 09 20 20 20 20 ; redo me ..
14070 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
14080 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
14090 6f 67 2d 70 6f 72 74 2a 20 22 43 6f 6e 76 65 72 og-port* "Conver
140a0 74 69 6e 67 20 22 20 28 63 61 64 72 20 69 74 65 ting " (cadr ite
140b0 6d 29 20 22 20 74 6f 20 22 20 6e 65 77 76 61 6c m) " to " newval
140c0 20 22 20 66 6f 72 20 74 65 73 74 20 23 22 20 28 " for test #" (
140d0 63 61 72 20 69 74 65 6d 29 29 29 0a 3b 3b 20 3b car item))).;; ;
140e0 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 20 ; ;; redo me ..
140f0 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
14100 65 20 71 72 79 20 6e 65 77 76 61 6c 20 28 63 61 e qry newval (ca
14110 72 20 69 74 65 6d 29 29 29 29 0a 3b 3b 20 3b 3b r item)))).;; ;;
14120 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
14130 20 20 20 64 61 74 29 0a 3b 3b 20 3b 3b 20 3b 3b dat).;; ;; ;;
14140 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 28 redo me . (
14150 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
14160 21 20 71 72 79 29 29 29 29 0a 3b 3b 20 3b 3b 20 ! qry)))).;; ;;
14170 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 20 ;; redo me
14180 20 20 28 64 62 3a 63 6c 6f 73 65 2d 61 6c 6c 20 (db:close-all
14190 64 62 73 74 72 75 63 74 29 0a 3b 3b 20 3b 3b 20 dbstruct).;; ;;
141a0 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 20 ;; redo me
141b0 20 20 28 6c 69 73 74 20 22 75 6e 61 6d 65 22 20 (list "uname"
141c0 22 72 75 6e 64 69 72 22 20 22 66 69 6e 61 6c 5f "rundir" "final_
141d0 6c 6f 67 66 22 20 22 63 6f 6d 6d 65 6e 74 22 29 logf" "comment")
141e0 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
141f0 6d 65 20 20 20 20 20 20 20 28 73 65 74 21 20 2a me (set! *
14200 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
14210 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
14220 65 74 2d 61 72 67 20 22 2d 69 6d 70 6f 72 74 2d et-arg "-import-
14230 6d 65 67 61 74 65 73 74 2e 64 62 22 29 0a 20 20 megatest.db").
14240 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
14250 64 62 3a 6d 75 6c 74 69 2d 64 62 2d 73 79 6e 63 db:multi-db-sync
14260 20 0a 20 20 20 20 20 20 20 23 66 20 3b 3b 20 64 . #f ;; d
14270 6f 20 61 6c 6c 20 72 75 6e 2d 69 64 73 0a 20 20 o all run-ids.
14280 20 20 20 20 20 27 6b 69 6c 6c 73 65 72 76 65 72 'killserver
14290 73 0a 20 20 20 20 20 20 20 27 64 65 6a 75 6e 6b s. 'dejunk
142a0 0a 20 20 20 20 20 20 20 27 61 64 6a 2d 74 65 73 . 'adj-tes
142b0 74 69 64 73 0a 20 20 20 20 20 20 20 27 6f 6c 64 tids. 'old
142c0 32 6e 65 77 0a 20 20 20 20 20 20 20 3b 3b 20 27 2new. ;; '
142d0 6e 65 77 32 6f 6c 64 0a 20 20 20 20 20 20 20 29 new2old. )
142e0 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
142f0 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
14300 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
14310 2d 61 72 67 20 22 2d 73 79 6e 63 2d 74 6f 2d 6d -arg "-sync-to-m
14320 65 67 61 74 65 73 74 2e 64 62 22 29 0a 20 20 20 egatest.db").
14330 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 64 (begin. (d
14340 62 3a 6d 75 6c 74 69 2d 64 62 2d 73 79 6e 63 20 b:multi-db-sync
14350 0a 20 20 20 20 20 20 20 23 66 20 3b 3b 20 64 6f . #f ;; do
14360 20 61 6c 6c 20 72 75 6e 2d 69 64 73 0a 20 20 20 all run-ids.
14370 20 20 20 20 27 6e 65 77 32 6f 6c 64 0a 20 20 20 'new2old.
14380 20 20 20 20 29 0a 20 20 20 20 20 20 28 73 65 74 ). (set
14390 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
143a0 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
143b0 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 6e 65 s:get-arg "-gene
143c0 72 61 74 65 2d 68 74 6d 6c 22 29 0a 20 20 20 20 rate-html").
143d0 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 (let* ((toppath
143e0 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 (launch:setup)))
143f0 0a 20 20 20 20 20 20 28 69 66 20 28 74 65 73 74 . (if (test
14400 73 3a 63 72 65 61 74 65 2d 68 74 6d 6c 2d 74 72 s:create-html-tr
14410 65 65 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 ee #f).
14420 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
14430 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 0 *default-lo
14440 67 2d 70 6f 72 74 2a 20 22 48 54 4d 4c 20 6f 75 g-port* "HTML ou
14450 74 70 75 74 20 63 72 65 61 74 65 64 20 69 6e 20 tput created in
14460 22 20 74 6f 70 70 61 74 68 20 22 2f 6c 74 2f 72 " toppath "/lt/r
14470 75 6e 73 2d 69 6e 64 65 78 2e 68 74 6d 6c 22 29 uns-index.html")
14480 0a 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 . (debu
14490 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
144a0 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 lt-log-port* "Fa
144b0 69 6c 65 64 20 74 6f 20 63 72 65 61 74 65 20 48 iled to create H
144c0 54 4d 4c 20 6f 75 74 70 75 74 20 69 6e 20 22 20 TML output in "
144d0 74 6f 70 70 61 74 68 20 22 2f 6c 74 2f 72 75 6e toppath "/lt/run
144e0 73 2d 69 6e 64 65 78 2e 68 74 6d 6c 22 29 29 0a s-index.html")).
144f0 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
14500 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
14510 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
14520 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14530 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14540 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14550 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 ==========.;; Ex
14560 69 74 20 61 6e 64 20 63 6c 65 61 6e 20 75 70 0a it and clean up.
14570 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
14580 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14590 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
145a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
145b0 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 2a 72 ========..(if *r
145c0 75 6e 72 65 6d 6f 74 65 2a 20 28 63 6c 6f 73 65 unremote* (close
145d0 2d 61 6c 6c 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 -all-connections
145e0 21 29 29 0a 0a 28 69 66 20 28 6e 6f 74 20 2a 64 !))..(if (not *d
145f0 69 64 73 6f 6d 65 74 68 69 6e 67 2a 29 0a 20 20 idsomething*).
14600 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
14610 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
14620 72 74 2a 20 68 65 6c 70 29 29 0a 0a 28 73 65 74 rt* help))..(set
14630 21 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a ! *time-to-exit*
14640 20 23 74 29 0a 28 74 68 72 65 61 64 2d 6a 6f 69 #t).(thread-joi
14650 6e 21 20 2a 77 61 74 63 68 64 6f 67 2a 29 0a 0a n! *watchdog*)..
14660 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 2a 67 (if (not (eq? *g
14670 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
14680 20 30 29 29 0a 20 20 20 20 28 69 66 20 28 6f 72 0)). (if (or
14690 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
146a0 2d 72 75 6e 22 29 28 61 72 67 73 3a 67 65 74 2d -run")(args:get-
146b0 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
146c0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
146d0 72 75 6e 61 6c 6c 22 29 29 0a 20 20 20 20 20 20 runall")).
146e0 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
146f0 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
14700 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
14710 70 6f 72 74 2a 20 22 4e 4f 54 45 3a 20 53 75 62 port* "NOTE: Sub
14720 70 72 6f 63 65 73 73 65 73 20 77 69 74 68 20 6e processes with n
14730 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 20 63 6f 64 on-zero exit cod
14740 65 20 64 65 74 65 63 74 65 64 3a 20 22 20 2a 67 e detected: " *g
14750 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
14760 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 78 ). (ex
14770 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 28 it 0)). (
14780 63 61 73 65 20 2a 67 6c 6f 62 61 6c 65 78 69 74 case *globalexit
14790 73 74 61 74 75 73 2a 0a 20 20 20 20 20 20 20 20 status*.
147a0 20 28 28 30 29 28 65 78 69 74 20 30 29 29 0a 20 ((0)(exit 0)).
147b0 20 20 20 20 20 20 20 20 28 28 31 29 28 65 78 69 ((1)(exi
147c0 74 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 28 t 1)). (
147d0 28 32 29 28 65 78 69 74 20 32 29 29 0a 20 20 20 (2)(exit 2)).
147e0 20 20 20 20 20 20 28 65 6c 73 65 20 28 65 78 69 (else (exi
147f0 74 20 33 29 29 29 29 29 0a t 3))))).