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 20 20 2d 6d 6f 64 65 20 context. -mode
0f60: 6b 65 79 20 20 20 20 20 20 20 20 20 20 20 20 20 key
0f70: 20 20 3a 20 6c 6f 61 64 20 74 65 73 74 70 61 74 : load testpat
0f80: 74 20 66 72 6f 6d 20 3c 6b 65 79 3e 20 69 6e 20 t from <key> in
0f90: 72 75 6e 63 6f 6e 66 69 67 73 20 69 6e 73 74 65 runconfigs inste
0fa0: 61 64 20 6f 66 20 64 65 66 61 75 6c 74 20 54 45 ad of default TE
0fb0: 53 54 50 41 54 54 0a 20 20 2d 74 61 67 65 78 70 STPATT. -tagexp
0fc0: 72 20 74 61 67 31 2c 74 61 67 32 25 2c 2e 2e 20 r tag1,tag2%,..
0fd0: 20 3a 20 73 65 6c 65 63 74 20 74 65 73 74 73 20 : select tests
0fe0: 77 69 74 68 20 74 61 67 73 20 6d 61 74 63 68 69 with tags matchi
0ff0: 6e 67 20 65 78 70 72 65 73 73 69 6f 6e 0a 0a 54 ng expression..T
1000: 65 73 74 20 68 65 6c 70 65 72 73 20 28 66 6f 72 est helpers (for
1010: 20 75 73 65 20 69 6e 73 69 64 65 20 74 65 73 74 use inside test
1020: 73 29 0a 20 20 2d 73 74 65 70 20 73 74 65 70 6e s). -step stepn
1030: 61 6d 65 0a 20 20 2d 74 65 73 74 2d 73 74 61 74 ame. -test-stat
1040: 75 73 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 us :
1050: 73 65 74 20 74 68 65 20 73 74 61 74 65 20 61 6e set the state an
1060: 64 20 73 74 61 74 75 73 20 6f 66 20 61 20 74 65 d status of a te
1070: 73 74 20 28 75 73 65 20 3a 73 74 61 74 65 20 61 st (use :state a
1080: 6e 64 20 3a 73 74 61 74 75 73 29 0a 20 20 2d 73 nd :status). -s
1090: 65 74 6c 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 20 etlog logfname
10a0: 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 : set the
10b0: 70 61 74 68 2f 66 69 6c 65 6e 61 6d 65 20 74 6f path/filename to
10c0: 20 74 68 65 20 66 69 6e 61 6c 20 6c 6f 67 20 72 the final log r
10d0: 65 6c 61 74 69 76 65 20 74 6f 20 74 68 65 20 74 elative to the t
10e0: 65 73 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 est.
10f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1100: 64 69 72 65 63 74 6f 72 79 2e 20 6d 61 79 20 62 directory. may b
1110: 65 20 75 73 65 64 20 77 69 74 68 20 2d 74 65 73 e used with -tes
1120: 74 2d 73 74 61 74 75 73 0a 20 20 2d 73 65 74 2d t-status. -set-
1130: 74 6f 70 6c 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 toplog logfname
1140: 20 20 20 3a 20 73 65 74 20 74 68 65 20 6f 76 65 : set the ove
1150: 72 61 6c 6c 20 6c 6f 67 20 66 6f 72 20 61 20 73 rall log for a s
1160: 75 69 74 65 20 6f 66 20 73 75 62 2d 74 65 73 74 uite of sub-test
1170: 73 0a 20 20 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 s. -summarize-i
1180: 74 65 6d 73 20 20 20 20 20 20 20 20 3a 20 66 6f tems : fo
1190: 72 20 61 6e 20 69 74 65 6d 69 7a 65 64 20 74 65 r an itemized te
11a0: 73 74 20 63 72 65 61 74 65 20 61 20 73 75 6d 6d st create a summ
11b0: 61 72 79 20 68 74 6d 6c 20 0a 20 20 2d 6d 20 63 ary html . -m c
11c0: 6f 6d 6d 65 6e 74 20 20 20 20 20 20 20 20 20 20 omment
11d0: 20 20 20 20 3a 20 69 6e 73 65 72 74 20 61 20 63 : insert a c
11e0: 6f 6d 6d 65 6e 74 20 66 6f 72 20 74 68 69 73 20 omment for this
11f0: 74 65 73 74 0a 0a 54 65 73 74 20 64 61 74 61 20 test..Test data
1200: 63 61 70 74 75 72 65 0a 20 20 2d 73 65 74 2d 76 capture. -set-v
1210: 61 6c 75 65 73 20 20 20 20 20 20 20 20 20 20 20 alues
1220: 20 20 3a 20 75 70 64 61 74 65 20 6f 72 20 73 65 : update or se
1230: 74 20 76 61 6c 75 65 73 20 69 6e 20 74 68 65 20 t values in the
1240: 74 65 73 74 64 61 74 61 20 74 61 62 6c 65 0a 20 testdata table.
1250: 20 3a 63 61 74 65 67 6f 72 79 20 20 20 20 20 20 :category
1260: 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 : set t
1270: 68 65 20 63 61 74 65 67 6f 72 79 20 66 69 65 6c he category fiel
1280: 64 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a d (optional). :
1290: 76 61 72 69 61 62 6c 65 20 20 20 20 20 20 20 20 variable
12a0: 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 : set the
12b0: 20 76 61 72 69 61 62 6c 65 20 6e 61 6d 65 20 28 variable name (
12c0: 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 6c optional). :val
12d0: 75 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ue
12e0: 20 20 20 20 3a 20 76 61 6c 75 65 20 6d 65 61 73 : value meas
12f0: 75 72 65 64 20 28 72 65 71 75 69 72 65 64 29 0a ured (required).
1300: 20 20 3a 65 78 70 65 63 74 65 64 20 20 20 20 20 :expected
1310: 20 20 20 20 20 20 20 20 20 20 3a 20 76 61 6c 75 : valu
1320: 65 20 65 78 70 65 63 74 65 64 20 28 72 65 71 75 e expected (requ
1330: 69 72 65 64 29 0a 20 20 3a 74 6f 6c 20 20 20 20 ired). :tol
1340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1350: 3a 20 7c 76 61 6c 75 65 2d 65 78 70 65 63 74 7c : |value-expect|
1360: 20 3c 3d 20 74 6f 6c 20 28 72 65 71 75 69 72 65 <= tol (require
1370: 64 2c 20 63 61 6e 20 62 65 20 3c 2c 20 3e 2c 20 d, can be <, >,
1380: 3e 3d 2c 20 3c 3d 20 6f 72 20 6e 75 6d 62 65 72 >=, <= or number
1390: 29 0a 20 20 3a 75 6e 69 74 73 20 20 20 20 20 20 ). :units
13a0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6e 61 : na
13b0: 6d 65 20 6f 66 20 74 68 65 20 75 6e 69 74 73 20 me of the units
13c0: 66 6f 72 20 76 61 6c 75 65 2c 20 65 78 70 65 63 for value, expec
13d0: 74 65 64 5f 76 61 6c 75 65 20 65 74 63 2e 20 28 ted_value etc. (
13e0: 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 2d 6c 6f 61 optional). -loa
13f0: 64 2d 74 65 73 74 2d 64 61 74 61 20 20 20 20 20 d-test-data
1400: 20 20 20 20 3a 20 72 65 61 64 20 74 65 73 74 20 : read test
1410: 73 70 65 63 69 66 69 63 20 64 61 74 61 20 66 6f specific data fo
1420: 72 20 73 74 6f 72 61 67 65 20 69 6e 20 74 68 65 r storage in the
1430: 20 74 65 73 74 5f 64 61 74 61 20 74 61 62 6c 65 test_data table
1440: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1450: 20 20 20 20 20 20 20 20 20 20 20 20 20 66 72 6f fro
1460: 6d 20 73 74 61 6e 64 61 72 64 20 69 6e 2e 20 45 m standard in. E
1470: 61 63 68 20 6c 69 6e 65 20 69 73 20 63 6f 6d 6d ach line is comm
1480: 61 20 64 65 6c 69 6d 69 74 65 64 20 77 69 74 68 a delimited with
1490: 20 66 6f 75 72 0a 20 20 20 20 20 20 20 20 20 20 four.
14a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14b0: 20 20 66 69 65 6c 64 73 20 63 61 74 65 67 6f 72 fields categor
14c0: 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 6c 75 65 y,variable,value
14d0: 2c 63 6f 6d 6d 65 6e 74 0a 0a 51 75 65 72 69 65 ,comment..Querie
14e0: 73 0a 20 20 2d 6c 69 73 74 2d 72 75 6e 73 20 70 s. -list-runs p
14f0: 61 74 74 20 20 20 20 20 20 20 20 20 3a 20 6c 69 att : li
1500: 73 74 20 72 75 6e 73 20 6d 61 74 63 68 69 6e 67 st runs matching
1510: 20 70 61 74 74 65 72 6e 20 5c 22 70 61 74 74 5c pattern \"patt\
1520: 22 2c 20 25 20 69 73 20 74 68 65 20 77 69 6c 64 ", % is the wild
1530: 63 61 72 64 0a 20 20 2d 73 68 6f 77 2d 6b 65 79 card. -show-key
1540: 73 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a s :
1550: 20 73 68 6f 77 20 74 68 65 20 6b 65 79 73 20 75 show the keys u
1560: 73 65 64 20 69 6e 20 74 68 69 73 20 6d 65 67 61 sed in this mega
1570: 74 65 73 74 20 73 65 74 75 70 0a 20 20 2d 74 65 test setup. -te
1580: 73 74 2d 66 69 6c 65 73 20 74 61 72 67 70 61 74 st-files targpat
1590: 74 20 20 20 20 3a 20 67 65 74 20 74 68 65 20 6d t : get the m
15a0: 6f 73 74 20 72 65 63 65 6e 74 20 74 65 73 74 20 ost recent test
15b0: 70 61 74 68 2f 66 69 6c 65 20 6d 61 74 63 68 69 path/file matchi
15c0: 6e 67 20 74 61 72 67 70 61 74 74 20 65 2e 67 2e ng targpatt e.g.
15d0: 20 25 2f 25 20 6f 72 20 27 2a 2e 6c 6f 67 27 0a %/% or '*.log'.
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 20 72 65 74 75 retu
1600: 72 6e 73 20 6c 69 73 74 20 73 6f 72 74 65 64 20 rns list sorted
1610: 62 79 20 61 67 65 20 61 73 63 65 6e 64 69 6e 67 by age ascending
1620: 2c 20 73 65 65 20 65 78 61 6d 70 6c 65 73 20 62 , see examples b
1630: 65 6c 6f 77 0a 20 20 2d 74 65 73 74 2d 70 61 74 elow. -test-pat
1640: 68 73 20 20 20 20 20 20 20 20 20 20 20 20 20 3a hs :
1650: 20 67 65 74 20 74 68 65 20 74 65 73 74 20 70 61 get the test pa
1660: 74 68 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 ths matching tar
1670: 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 69 74 get, runname, it
1680: 65 6d 20 61 6e 64 20 74 65 73 74 0a 20 20 20 20 em and test.
1690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16a0: 20 20 20 20 20 20 20 20 70 61 74 74 65 72 6e 73 patterns
16b0: 2e 0a 20 20 2d 6c 69 73 74 2d 64 69 73 6b 73 20 .. -list-disks
16c0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 69 : li
16d0: 73 74 20 74 68 65 20 64 69 73 6b 73 20 61 76 61 st the disks ava
16e0: 69 6c 61 62 6c 65 20 66 6f 72 20 73 74 6f 72 69 ilable for stori
16f0: 6e 67 20 72 75 6e 73 0a 20 20 2d 6c 69 73 74 2d ng runs. -list-
1700: 74 61 72 67 65 74 73 20 20 20 20 20 20 20 20 20 targets
1710: 20 20 3a 20 6c 69 73 74 20 74 68 65 20 74 61 72 : list the tar
1720: 67 65 74 73 20 69 6e 20 72 75 6e 63 6f 6e 66 69 gets in runconfi
1730: 67 73 2e 63 6f 6e 66 69 67 0a 20 20 2d 6c 69 73 gs.config. -lis
1740: 74 2d 64 62 2d 74 61 72 67 65 74 73 20 20 20 20 t-db-targets
1750: 20 20 20 20 3a 20 6c 69 73 74 20 74 68 65 20 74 : list the t
1760: 61 72 67 65 74 20 63 6f 6d 62 69 6e 61 74 69 6f arget combinatio
1770: 6e 73 20 75 73 65 64 20 69 6e 20 74 68 65 20 64 ns used in the d
1780: 62 0a 20 20 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 b. -show-config
1790: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 64 75 : du
17a0: 6d 70 20 74 68 65 20 69 6e 74 65 72 6e 61 6c 20 mp the internal
17b0: 72 65 70 72 65 73 65 6e 74 61 74 69 6f 6e 20 6f representation o
17c0: 66 20 74 68 65 20 6d 65 67 61 74 65 73 74 2e 63 f the megatest.c
17d0: 6f 6e 66 69 67 20 66 69 6c 65 0a 20 20 2d 73 68 onfig file. -sh
17e0: 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 20 20 20 20 ow-runconfig
17f0: 20 20 20 20 20 3a 20 64 75 6d 70 20 74 68 65 20 : dump the
1800: 69 6e 74 65 72 6e 61 6c 20 72 65 70 72 65 73 65 internal represe
1810: 6e 74 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 72 ntation of the r
1820: 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 unconfigs.config
1830: 20 66 69 6c 65 0a 20 20 2d 64 75 6d 70 6d 6f 64 file. -dumpmod
1840: 65 20 4d 4f 44 45 20 20 20 20 20 20 20 20 20 20 e MODE
1850: 3a 20 64 75 6d 70 20 69 6e 20 4d 4f 44 45 20 66 : dump in MODE f
1860: 6f 72 6d 61 74 20 69 6e 73 74 65 61 64 20 6f 66 ormat instead of
1870: 20 73 65 78 70 72 2c 20 4d 4f 44 45 3d 6a 73 6f sexpr, MODE=jso
1880: 6e 2c 69 6e 69 2c 73 65 78 70 20 65 74 63 2e 0a n,ini,sexp etc..
1890: 20 20 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 6f 20 -show-cmdinfo
18a0: 20 20 20 20 20 20 20 20 20 20 3a 20 64 75 6d 70 : dump
18b0: 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 69 6e 66 the command inf
18c0: 6f 20 66 6f 72 20 61 20 74 65 73 74 20 28 72 75 o for a test (ru
18d0: 6e 20 69 6e 20 74 65 73 74 20 65 6e 76 69 72 6f n in test enviro
18e0: 6e 6d 65 6e 74 29 0a 20 20 2d 73 65 63 74 69 6f nment). -sectio
18f0: 6e 20 73 65 63 74 69 6f 6e 4e 61 6d 65 0a 20 20 n sectionName.
1900: 2d 76 61 72 20 76 61 72 4e 61 6d 65 20 20 20 20 -var varName
1910: 20 20 20 20 20 20 20 20 3a 20 66 6f 72 20 63 6f : for co
1920: 6e 66 69 67 20 61 6e 64 20 72 75 6e 63 6f 6e 66 nfig and runconf
1930: 69 67 20 6c 6f 6f 6b 75 70 20 76 61 6c 75 65 20 ig lookup value
1940: 66 6f 72 20 73 65 63 74 69 6f 6e 4e 61 6d 65 20 for sectionName
1950: 76 61 72 4e 61 6d 65 0a 20 20 2d 73 69 6e 63 65 varName. -since
1960: 20 4e 20 20 20 20 20 20 20 20 20 20 20 20 20 20 N
1970: 20 20 3a 20 67 65 74 20 6c 69 73 74 20 6f 66 20 : get list of
1980: 72 75 6e 73 20 63 68 61 6e 67 65 64 20 73 69 6e runs changed sin
1990: 63 65 20 74 69 6d 65 20 4e 20 28 55 6e 69 78 20 ce time N (Unix
19a0: 73 65 63 6f 6e 64 73 29 0a 20 20 2d 66 69 65 6c seconds). -fiel
19b0: 64 73 20 66 69 65 6c 64 73 70 65 63 20 20 20 20 ds fieldspec
19c0: 20 20 20 3a 20 66 69 65 6c 64 73 20 74 6f 20 69 : fields to i
19d0: 6e 63 6c 75 64 65 20 69 6e 20 6a 73 6f 6e 20 64 nclude in json d
19e0: 75 6d 70 3b 20 72 75 6e 73 3a 69 64 2c 72 75 6e ump; runs:id,run
19f0: 61 6d 65 2b 74 65 73 74 73 3a 74 65 73 74 6e 61 ame+tests:testna
1a00: 6d 65 2b 73 74 65 70 73 0a 20 20 2d 73 6f 72 74 me+steps. -sort
1a10: 20 66 69 65 6c 64 6e 61 6d 65 20 20 20 20 20 20 fieldname
1a20: 20 20 20 3a 20 69 6e 20 2d 6c 69 73 74 2d 72 75 : in -list-ru
1a30: 6e 73 20 73 6f 72 74 20 74 65 73 74 73 20 62 79 ns sort tests by
1a40: 20 74 68 69 73 20 66 69 65 6c 64 0a 0a 4d 69 73 this field..Mis
1a50: 63 20 0a 20 20 2d 73 74 61 72 74 2d 64 69 72 20 c . -start-dir
1a60: 70 61 74 68 20 20 20 20 20 20 20 20 20 3a 20 73 path : s
1a70: 77 69 74 63 68 20 74 6f 20 74 68 69 73 20 64 69 witch to this di
1a80: 72 65 63 74 6f 72 79 20 62 65 66 6f 72 65 20 72 rectory before r
1a90: 75 6e 6e 69 6e 67 20 6d 65 67 61 74 65 73 74 0a unning megatest.
1aa0: 20 20 2d 72 65 62 75 69 6c 64 2d 64 62 20 20 20 -rebuild-db
1ab0: 20 20 20 20 20 20 20 20 20 20 3a 20 62 72 69 6e : brin
1ac0: 67 20 74 68 65 20 64 61 74 61 62 61 73 65 20 73 g the database s
1ad0: 63 68 65 6d 61 20 75 70 20 74 6f 20 64 61 74 65 chema up to date
1ae0: 0a 20 20 2d 63 6c 65 61 6e 75 70 2d 64 62 20 20 . -cleanup-db
1af0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 6d : rem
1b00: 6f 76 65 20 61 6e 79 20 6f 72 70 68 61 6e 20 72 ove any orphan r
1b10: 65 63 6f 72 64 73 2c 20 76 61 63 75 75 6d 20 74 ecords, vacuum t
1b20: 68 65 20 64 62 0a 20 20 2d 69 6d 70 6f 72 74 2d he db. -import-
1b30: 6d 65 67 61 74 65 73 74 2e 64 62 20 20 20 20 20 megatest.db
1b40: 3a 20 6d 69 67 72 61 74 65 20 61 20 64 61 74 61 : migrate a data
1b50: 62 61 73 65 20 66 72 6f 6d 20 76 31 2e 35 35 20 base from v1.55
1b60: 73 65 72 69 65 73 20 74 6f 20 76 31 2e 36 30 20 series to v1.60
1b70: 73 65 72 69 65 73 0a 20 20 2d 73 79 6e 63 2d 74 series. -sync-t
1b80: 6f 2d 6d 65 67 61 74 65 73 74 2e 64 62 20 20 20 o-megatest.db
1b90: 20 3a 20 6d 69 67 72 61 74 65 20 64 61 74 61 20 : migrate data
1ba0: 62 61 63 6b 20 74 6f 20 6d 65 67 61 74 65 73 74 back to megatest
1bb0: 2e 64 62 0a 20 20 2d 75 73 65 2d 64 62 2d 63 61 .db. -use-db-ca
1bc0: 63 68 65 20 20 20 20 20 20 20 20 20 20 20 3a 20 che :
1bd0: 75 73 65 20 63 61 63 68 65 64 20 61 63 63 65 73 use cached acces
1be0: 73 20 74 6f 20 64 62 20 74 6f 20 72 65 64 75 63 s to db to reduc
1bf0: 65 20 6c 6f 61 64 0a 20 20 2d 75 70 64 61 74 65 e load. -update
1c00: 2d 6d 65 74 61 20 20 20 20 20 20 20 20 20 20 20 -meta
1c10: 20 3a 20 75 70 64 61 74 65 20 74 68 65 20 74 65 : update the te
1c20: 73 74 73 20 6d 65 74 61 64 61 74 61 20 66 6f 72 sts metadata for
1c30: 20 61 6c 6c 20 74 65 73 74 73 0a 20 20 2d 73 65 all tests. -se
1c40: 74 76 61 72 73 20 56 41 52 31 3d 76 61 6c 31 2c tvars VAR1=val1,
1c50: 56 41 52 32 3d 76 61 6c 32 20 3a 20 41 64 64 20 VAR2=val2 : Add
1c60: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 environment vari
1c70: 61 62 6c 65 73 20 74 6f 20 61 20 72 75 6e 20 4e ables to a run N
1c80: 42 2f 2f 20 74 68 65 73 65 20 61 72 65 0a 20 20 B// these are.
1c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6f o
1cb0: 76 65 72 77 72 69 74 74 65 6e 20 62 79 20 76 61 verwritten by va
1cc0: 6c 75 65 73 20 73 65 74 20 69 6e 20 63 6f 6e 66 lues set in conf
1cd0: 69 67 20 66 69 6c 65 73 2e 0a 20 20 2d 73 65 72 ig files.. -ser
1ce0: 76 65 72 20 2d 7c 68 6f 73 74 6e 61 6d 65 20 20 ver -|hostname
1cf0: 20 20 20 20 3a 20 73 74 61 72 74 20 74 68 65 20 : start the
1d00: 73 65 72 76 65 72 20 28 72 65 64 75 63 65 73 20 server (reduces
1d10: 63 6f 6e 74 65 6e 74 69 6f 6e 20 6f 6e 20 6d 65 contention on me
1d20: 67 61 74 65 73 74 2e 64 62 29 2c 20 75 73 65 0a gatest.db), use.
1d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d40: 20 20 20 20 20 20 20 20 20 20 20 20 2d 20 74 6f - to
1d50: 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c 79 20 66 automatically f
1d60: 69 67 75 72 65 20 6f 75 74 20 68 6f 73 74 6e 61 igure out hostna
1d70: 6d 65 0a 20 20 2d 74 72 61 6e 73 70 6f 72 74 20 me. -transport
1d80: 68 74 74 70 7c 72 70 63 20 20 20 20 20 3a 20 75 http|rpc : u
1d90: 73 65 20 68 74 74 70 20 6f 72 20 72 70 63 20 66 se http or rpc f
1da0: 6f 72 20 74 72 61 6e 73 70 6f 72 74 20 28 64 65 or transport (de
1db0: 66 61 75 6c 74 20 69 73 20 68 74 74 70 29 20 0a fault is http) .
1dc0: 20 20 2d 64 61 65 6d 6f 6e 69 7a 65 20 20 20 20 -daemonize
1dd0: 20 20 20 20 20 20 20 20 20 20 3a 20 66 6f 72 6b : fork
1de0: 20 69 6e 74 6f 20 62 61 63 6b 67 72 6f 75 6e 64 into background
1df0: 20 61 6e 64 20 64 69 73 63 6f 6e 6e 65 63 74 20 and disconnect
1e00: 66 72 6f 6d 20 73 74 64 69 6e 2f 6f 75 74 0a 20 from stdin/out.
1e10: 20 2d 6c 6f 67 20 6c 6f 67 66 69 6c 65 20 20 20 -log logfile
1e20: 20 20 20 20 20 20 20 20 20 3a 20 73 65 6e 64 20 : send
1e30: 73 74 64 6f 75 74 20 61 6e 64 20 73 74 64 65 72 stdout and stder
1e40: 72 20 74 6f 20 6c 6f 67 66 69 6c 65 0a 20 20 2d r to logfile. -
1e50: 6c 69 73 74 2d 73 65 72 76 65 72 73 20 20 20 20 list-servers
1e60: 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 : list th
1e70: 65 20 73 65 72 76 65 72 73 20 0a 20 20 2d 73 74 e servers . -st
1e80: 6f 70 2d 73 65 72 76 65 72 20 69 64 20 20 20 20 op-server id
1e90: 20 20 20 20 20 3a 20 73 74 6f 70 20 73 65 72 76 : stop serv
1ea0: 65 72 20 73 70 65 63 69 66 69 65 64 20 62 79 20 er specified by
1eb0: 69 64 20 28 73 65 65 20 6f 75 74 70 75 74 20 6f id (see output o
1ec0: 66 20 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 29 f -list-servers)
1ed0: 2c 20 75 73 65 0a 20 20 20 20 20 20 20 20 20 20 , use.
1ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ef0: 20 20 30 20 74 6f 20 6b 69 6c 6c 20 61 6c 6c 0a 0 to kill all.
1f00: 20 20 2d 72 65 70 6c 20 20 20 20 20 20 20 20 20 -repl
1f10: 20 20 20 20 20 20 20 20 20 20 3a 20 73 74 61 72 : star
1f20: 74 20 61 20 72 65 70 6c 20 28 75 73 65 66 75 6c t a repl (useful
1f30: 20 66 6f 72 20 65 78 74 65 6e 64 69 6e 67 20 6d for extending m
1f40: 65 67 61 74 65 73 74 29 0a 20 20 2d 6c 6f 61 64 egatest). -load
1f50: 20 66 69 6c 65 2e 73 63 6d 20 20 20 20 20 20 20 file.scm
1f60: 20 20 20 3a 20 6c 6f 61 64 20 61 6e 64 20 72 75 : load and ru
1f70: 6e 20 66 69 6c 65 2e 73 63 6d 0a 20 20 2d 6d 61 n file.scm. -ma
1f80: 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 20 20 rk-incompletes
1f90: 20 20 20 20 20 3a 20 66 69 6e 64 20 61 6e 64 20 : find and
1fa0: 6d 61 72 6b 20 69 6e 63 6f 6d 70 6c 65 74 65 20 mark incomplete
1fb0: 74 65 73 74 73 0a 20 20 2d 70 69 6e 67 20 72 75 tests. -ping ru
1fc0: 6e 2d 69 64 7c 68 6f 73 74 3a 70 6f 72 74 20 20 n-id|host:port
1fd0: 3a 20 70 69 6e 67 20 73 65 72 76 65 72 2c 20 65 : ping server, e
1fe0: 78 69 74 20 77 69 74 68 20 30 20 69 66 20 66 6f xit with 0 if fo
1ff0: 75 6e 64 0a 20 20 2d 64 65 62 75 67 20 4e 7c 4e und. -debug N|N
2000: 2c 4d 2c 4f 2e 2e 2e 20 20 20 20 20 20 20 3a 20 ,M,O... :
2010: 65 6e 61 62 6c 65 20 64 65 62 75 67 20 30 2d 4e enable debug 0-N
2020: 20 6f 72 20 4e 20 61 6e 64 20 4d 20 61 6e 64 20 or N and M and
2030: 4f 20 2e 2e 2e 0a 0a 55 74 69 6c 69 74 69 65 73 O .....Utilities
2040: 0a 20 20 2d 65 6e 76 32 66 69 6c 65 20 66 6e 61 . -env2file fna
2050: 6d 65 20 20 20 20 20 20 20 20 20 3a 20 77 72 69 me : wri
2060: 74 65 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 te the environme
2070: 6e 74 20 74 6f 20 66 6e 61 6d 65 2e 63 73 68 20 nt to fname.csh
2080: 61 6e 64 20 66 6e 61 6d 65 2e 73 68 0a 20 20 2d and fname.sh. -
2090: 65 6e 76 63 61 70 20 66 6e 61 6d 65 3d 63 6f 6e envcap fname=con
20a0: 74 65 78 74 20 20 20 3a 20 73 61 76 65 20 63 75 text : save cu
20b0: 72 72 65 6e 74 20 76 61 72 69 61 62 6c 65 73 20 rrent variables
20c0: 6c 61 62 65 6c 65 64 20 61 73 20 63 6f 6e 74 65 labeled as conte
20d0: 78 74 20 69 6e 20 66 69 6c 65 20 66 6e 61 6d 65 xt in file fname
20e0: 0a 20 20 2d 72 65 66 64 62 32 64 61 74 20 72 65 . -refdb2dat re
20f0: 66 64 62 20 20 20 20 20 20 20 20 3a 20 63 6f 6e fdb : con
2100: 76 65 72 74 20 72 65 66 64 62 20 74 6f 20 73 65 vert refdb to se
2110: 78 70 20 6f 72 20 74 6f 20 66 6f 72 6d 61 74 20 xp or to format
2120: 73 70 65 63 69 66 69 65 64 20 62 79 20 2d 64 75 specified by -du
2130: 6d 70 6d 6f 64 65 0a 20 20 20 20 20 20 20 20 20 mpmode.
2140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2150: 20 20 20 66 6f 72 6d 61 74 73 3a 20 70 65 72 6c formats: perl
2160: 2c 20 72 75 62 79 2c 20 73 71 6c 69 74 65 33 2c , ruby, sqlite3,
2170: 20 63 73 76 20 28 66 6f 72 20 63 73 76 20 74 68 csv (for csv th
2180: 65 20 2d 6f 20 70 61 72 61 6d 0a 20 20 20 20 20 e -o param.
2190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21a0: 20 20 20 20 20 20 20 77 69 6c 6c 20 73 75 62 73 will subs
21b0: 74 69 74 75 74 65 20 25 73 20 66 6f 72 20 74 68 titute %s for th
21c0: 65 20 73 68 65 65 74 20 6e 61 6d 65 20 69 6e 20 e sheet name in
21d0: 67 65 6e 65 72 61 74 69 6e 67 20 0a 20 20 20 20 generating .
21e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21f0: 20 20 20 20 20 20 20 20 6d 75 6c 74 69 70 6c 65 multiple
2200: 20 73 68 65 65 74 73 29 0a 20 20 2d 6f 20 20 20 sheets). -o
2210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2220: 20 20 20 3a 20 6f 75 74 70 75 74 20 66 69 6c 65 : output file
2230: 20 66 6f 72 20 72 65 66 64 62 32 64 61 74 20 28 for refdb2dat (
2240: 64 65 66 61 75 6c 74 73 20 74 6f 20 73 74 64 6f defaults to stdo
2250: 75 74 29 0a 20 20 2d 61 72 63 68 69 76 65 20 63 ut). -archive c
2260: 6d 64 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 md :
2270: 61 72 63 68 69 76 65 20 72 75 6e 73 20 73 70 65 archive runs spe
2280: 63 69 66 69 65 64 20 62 79 20 73 65 6c 65 63 74 cified by select
2290: 6f 72 73 20 74 6f 20 6f 6e 65 20 6f 66 20 64 69 ors to one of di
22a0: 73 6b 73 20 73 70 65 63 69 66 69 65 64 0a 20 20 sks specified.
22b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22c0: 20 20 20 20 20 20 20 20 20 20 69 6e 20 74 68 65 in the
22d0: 20 5b 61 72 63 68 69 76 65 2d 64 69 73 6b 73 5d [archive-disks]
22e0: 20 73 65 63 74 69 6f 6e 2e 0a 20 20 20 20 20 20 section..
22f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2300: 20 20 20 20 20 20 63 6d 64 3a 20 6b 65 65 70 2d cmd: keep-
2310: 68 74 6d 6c 2c 20 72 65 73 74 6f 72 65 2c 20 73 html, restore, s
2320: 61 76 65 2c 20 73 61 76 65 2d 72 65 6d 6f 76 65 ave, save-remove
2330: 0a 20 20 2d 67 65 6e 65 72 61 74 65 2d 68 74 6d . -generate-htm
2340: 6c 20 20 20 20 20 20 20 20 20 20 3a 20 63 72 65 l : cre
2350: 61 74 65 20 61 20 73 69 6d 70 6c 65 20 68 74 6d ate a simple htm
2360: 6c 20 74 72 65 65 20 66 6f 72 20 62 72 6f 77 73 l tree for brows
2370: 69 6e 67 20 79 6f 75 72 20 72 75 6e 73 0a 0a 53 ing your runs..S
2380: 70 72 65 61 64 73 68 65 65 74 20 67 65 6e 65 72 preadsheet gener
2390: 61 74 69 6f 6e 0a 20 20 2d 65 78 74 72 61 63 74 ation. -extract
23a0: 2d 6f 64 73 20 66 6e 61 6d 65 2e 6f 64 73 20 20 -ods fname.ods
23b0: 3a 20 65 78 74 72 61 63 74 20 61 6e 20 6f 70 65 : extract an ope
23c0: 6e 20 64 6f 63 75 6d 65 6e 74 20 73 70 72 65 61 n document sprea
23d0: 64 73 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 dsheet from the
23e0: 64 61 74 61 62 61 73 65 0a 20 20 2d 70 61 74 68 database. -path
23f0: 6d 6f 64 20 70 61 74 68 20 20 20 20 20 20 20 20 mod path
2400: 20 20 20 3a 20 69 6e 73 65 72 74 20 70 61 74 68 : insert path
2410: 2c 20 69 2e 65 2e 20 70 61 74 68 2f 72 75 6e 61 , i.e. path/runa
2420: 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 me/itempath/logf
2430: 69 6c 65 2e 68 74 6d 6c 0a 20 20 20 20 20 20 20 ile.html.
2440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2450: 20 20 20 20 20 77 69 6c 6c 20 63 6c 65 61 72 20 will clear
2460: 74 68 65 20 66 69 65 6c 64 20 69 66 20 6e 6f 20 the field if no
2470: 72 75 6e 64 69 72 2f 74 65 73 74 6e 61 6d 65 2f rundir/testname/
2480: 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 69 6c 65 itempath/logfile
2490: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
24a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 if
24b0: 69 74 20 63 6f 6e 74 61 69 6e 73 20 66 6f 72 77 it contains forw
24c0: 61 72 64 20 73 6c 61 73 68 65 73 20 74 68 65 20 ard slashes the
24d0: 70 61 74 68 20 77 69 6c 6c 20 62 65 20 63 6f 6e path will be con
24e0: 76 65 72 74 65 64 0a 20 20 20 20 20 20 20 20 20 verted.
24f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2500: 20 20 20 74 6f 20 77 69 6e 64 6f 77 73 20 73 74 to windows st
2510: 79 6c 65 0a 47 65 74 74 69 6e 67 20 73 74 61 72 yle.Getting star
2520: 74 65 64 0a 20 20 2d 63 72 65 61 74 65 2d 6d 65 ted. -create-me
2530: 67 61 74 65 73 74 2d 61 72 65 61 20 20 20 20 20 gatest-area
2540: 20 20 3a 20 63 72 65 61 74 65 20 61 20 73 6b 65 : create a ske
2550: 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 74 20 61 leton megatest a
2560: 72 65 61 2e 20 59 6f 75 20 77 69 6c 6c 20 62 65 rea. You will be
2570: 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 20 70 61 prompted for pa
2580: 74 68 73 0a 20 20 2d 63 72 65 61 74 65 2d 74 65 ths. -create-te
2590: 73 74 20 74 65 73 74 6e 61 6d 65 20 20 20 20 20 st testname
25a0: 20 20 3a 20 63 72 65 61 74 65 20 61 20 73 6b 65 : create a ske
25b0: 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 74 20 74 leton megatest t
25c0: 65 73 74 2e 20 59 6f 75 20 77 69 6c 6c 20 62 65 est. You will be
25d0: 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 20 69 6e prompted for in
25e0: 66 6f 0a 0a 45 78 61 6d 70 6c 65 73 0a 0a 23 20 fo..Examples..#
25f0: 47 65 74 20 74 65 73 74 20 70 61 74 68 2c 20 75 Get test path, u
2600: 73 65 20 27 2e 27 20 74 6f 20 67 65 74 20 61 20 se '.' to get a
2610: 73 69 6e 67 6c 65 20 70 61 74 68 20 6f 72 20 61 single path or a
2620: 20 73 70 65 63 69 66 69 63 20 70 61 74 68 2f 66 specific path/f
2630: 69 6c 65 20 70 61 74 74 65 72 6e 0a 6d 65 67 61 ile pattern.mega
2640: 74 65 73 74 20 2d 74 65 73 74 2d 66 69 6c 65 73 test -test-files
2650: 20 27 6c 6f 67 73 2f 2a 2e 6c 6f 67 27 20 2d 74 'logs/*.log' -t
2660: 61 72 67 65 74 20 75 62 75 6e 74 75 2f 6e 25 2f arget ubuntu/n%/
2670: 6e 6f 25 20 2d 72 75 6e 6e 61 6d 65 20 77 34 39 no% -runname w49
2680: 25 20 2d 74 65 73 74 70 61 74 74 20 74 65 73 74 % -testpatt test
2690: 5f 6d 74 25 0a 0a 43 61 6c 6c 65 64 20 61 73 20 _mt%..Called as
26a0: 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 " (string-inters
26b0: 70 65 72 73 65 20 28 61 72 67 76 29 20 22 20 22 perse (argv) " "
26c0: 29 20 22 0a 56 65 72 73 69 6f 6e 20 22 20 6d 65 ) ".Version " me
26d0: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 gatest-version "
26e0: 2c 20 62 75 69 6c 74 20 66 72 6f 6d 20 22 20 6d , built from " m
26f0: 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 egatest-fossil-h
2700: 61 73 68 20 29 29 0a 0a 3b 3b 20 20 2d 67 75 69 ash ))..;; -gui
2710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2720: 20 20 20 20 3a 20 73 74 61 72 74 20 61 20 67 75 : start a gu
2730: 69 20 69 6e 74 65 72 66 61 63 65 0a 3b 3b 20 20 i interface.;;
2740: 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 20 20 -config fname
2750: 20 20 20 20 20 20 20 20 3a 20 6f 76 65 72 72 69 : overri
2760: 64 65 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 de the runconfig
2770: 20 66 69 6c 65 20 77 69 74 68 20 66 6e 61 6d 65 file with fname
2780: 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 20 61 72 67 ..;; process arg
2790: 73 0a 28 64 65 66 69 6e 65 20 72 65 6d 61 72 67 s.(define remarg
27a0: 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 73 s (args:get-args
27b0: 20 0a 09 09 20 28 61 72 67 76 29 0a 09 09 20 28 ... (argv)... (
27c0: 6c 69 73 74 20 20 22 2d 72 75 6e 74 65 73 74 73 list "-runtests
27d0: 22 20 20 3b 3b 20 72 75 6e 20 61 20 73 70 65 63 " ;; run a spec
27e0: 69 66 69 63 20 74 65 73 74 0a 09 09 09 22 2d 63 ific test...."-c
27f0: 6f 6e 66 69 67 22 20 20 20 20 3b 3b 20 6f 76 65 onfig" ;; ove
2800: 72 72 69 64 65 20 74 68 65 20 63 6f 6e 66 69 67 rride the config
2810: 20 66 69 6c 65 20 6e 61 6d 65 0a 09 09 09 22 2d file name...."-
2820: 65 78 65 63 75 74 65 22 20 20 20 3b 3b 20 72 75 execute" ;; ru
2830: 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 65 6e n the command en
2840: 63 6f 64 65 64 20 69 6e 20 74 68 65 20 62 61 73 coded in the bas
2850: 65 36 34 20 70 61 72 61 6d 65 74 65 72 0a 09 09 e64 parameter...
2860: 09 22 2d 73 74 65 70 22 0a 09 09 09 22 2d 74 61 ."-step"...."-ta
2870: 72 67 65 74 22 0a 09 09 09 22 2d 72 65 71 74 61 rget"...."-reqta
2880: 72 67 22 0a 09 09 09 22 3a 72 75 6e 6e 61 6d 65 rg"....":runname
2890: 22 0a 09 09 09 22 2d 72 75 6e 6e 61 6d 65 22 0a "...."-runname".
28a0: 09 09 09 22 3a 73 74 61 74 65 22 20 20 0a 09 09 ...":state" ...
28b0: 09 22 2d 73 74 61 74 65 22 0a 09 09 09 22 3a 73 ."-state"....":s
28c0: 74 61 74 75 73 22 0a 09 09 09 22 2d 73 74 61 74 tatus"...."-stat
28d0: 75 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d 72 75 us"...."-list-ru
28e0: 6e 73 22 0a 09 09 09 22 2d 74 65 73 74 70 61 74 ns"...."-testpat
28f0: 74 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t".
2900: 20 20 20 20 20 20 20 20 20 20 20 22 2d 6d 6f 64 "-mod
2910: 65 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 e".
2920: 20 20 20 20 20 20 20 20 20 20 20 22 2d 74 61 67 "-tag
2930: 65 78 70 72 22 0a 09 09 09 22 2d 69 74 65 6d 70 expr"...."-itemp
2940: 61 74 74 22 0a 09 09 09 22 2d 73 65 74 6c 6f 67 att"...."-setlog
2950: 22 0a 09 09 09 22 2d 73 65 74 2d 74 6f 70 6c 6f "...."-set-toplo
2960: 67 22 0a 09 09 09 22 2d 72 75 6e 73 74 65 70 22 g"...."-runstep"
2970: 0a 09 09 09 22 2d 6c 6f 67 70 72 6f 22 0a 09 09 ...."-logpro"...
2980: 09 22 2d 6d 22 0a 09 09 09 22 2d 72 65 72 75 6e ."-m"...."-rerun
2990: 22 0a 09 09 09 22 2d 64 61 79 73 22 0a 09 09 09 "...."-days"....
29a0: 22 2d 72 65 6e 61 6d 65 2d 72 75 6e 22 0a 09 09 "-rename-run"...
29b0: 09 22 2d 74 6f 22 0a 09 09 09 3b 3b 20 76 61 6c ."-to"....;; val
29c0: 75 65 73 20 61 6e 64 20 6d 65 73 73 61 67 65 73 ues and messages
29d0: 0a 09 09 09 22 3a 63 61 74 65 67 6f 72 79 22 0a ....":category".
29e0: 09 09 09 22 3a 76 61 72 69 61 62 6c 65 22 0a 09 ...":variable"..
29f0: 09 09 22 3a 76 61 6c 75 65 22 0a 09 09 09 22 3a ..":value"....":
2a00: 65 78 70 65 63 74 65 64 22 0a 09 09 09 22 3a 74 expected"....":t
2a10: 6f 6c 22 0a 09 09 09 22 3a 75 6e 69 74 73 22 0a ol"....":units".
2a20: 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 09 22 2d ...;; misc...."-
2a30: 73 74 61 72 74 2d 64 69 72 22 0a 09 09 09 22 2d start-dir"...."-
2a40: 73 65 72 76 65 72 22 0a 09 09 09 22 2d 73 74 6f server"...."-sto
2a50: 70 2d 73 65 72 76 65 72 22 0a 09 09 09 22 2d 74 p-server"...."-t
2a60: 72 61 6e 73 70 6f 72 74 22 0a 09 09 09 22 2d 6b ransport"...."-k
2a70: 69 6c 6c 2d 73 65 72 76 65 72 22 0a 09 09 09 22 ill-server"...."
2a80: 2d 70 6f 72 74 22 0a 09 09 09 22 2d 65 78 74 72 -port"...."-extr
2a90: 61 63 74 2d 6f 64 73 22 0a 09 09 09 22 2d 70 61 act-ods"...."-pa
2aa0: 74 68 6d 6f 64 22 0a 09 09 09 22 2d 65 6e 76 32 thmod"...."-env2
2ab0: 66 69 6c 65 22 0a 09 09 09 22 2d 65 6e 76 63 61 file"...."-envca
2ac0: 70 22 0a 09 09 09 22 2d 65 6e 76 64 65 6c 74 61 p"...."-envdelta
2ad0: 22 0a 09 09 09 22 2d 73 65 74 76 61 72 73 22 0a "...."-setvars".
2ae0: 09 09 09 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 ..."-set-state-s
2af0: 74 61 74 75 73 22 0a 09 09 09 22 2d 73 65 74 2d tatus"...."-set-
2b00: 72 75 6e 2d 73 74 61 74 75 73 22 0a 09 09 09 22 run-status"...."
2b10: 2d 64 65 62 75 67 22 20 3b 3b 20 66 6f 72 20 2a -debug" ;; for *
2b20: 76 65 72 62 6f 73 69 74 79 2a 20 3e 20 32 0a 09 verbosity* > 2..
2b30: 09 09 22 2d 63 72 65 61 74 65 2d 74 65 73 74 22 .."-create-test"
2b40: 0a 09 09 09 22 2d 6f 76 65 72 72 69 64 65 2d 74 ...."-override-t
2b50: 69 6d 65 6f 75 74 22 0a 09 09 09 22 2d 74 65 73 imeout"...."-tes
2b60: 74 2d 66 69 6c 65 73 22 20 20 3b 3b 20 2d 74 65 t-files" ;; -te
2b70: 73 74 2d 70 61 74 68 73 20 69 73 20 66 6f 72 20 st-paths is for
2b80: 6c 69 73 74 69 6e 67 20 61 6c 6c 0a 09 09 09 22 listing all...."
2b90: 2d 6c 6f 61 64 22 20 20 20 20 20 20 20 20 3b 3b -load" ;;
2ba0: 20 6c 6f 61 64 20 61 6e 64 20 65 78 65 63 74 75 load and exectu
2bb0: 74 65 20 61 20 73 63 68 65 6d 65 20 66 69 6c 65 te a scheme file
2bc0: 0a 09 09 09 22 2d 73 65 63 74 69 6f 6e 22 0a 09 ...."-section"..
2bd0: 09 09 22 2d 76 61 72 22 0a 09 09 09 22 2d 64 75 .."-var"...."-du
2be0: 6d 70 6d 6f 64 65 22 0a 09 09 09 22 2d 72 75 6e mpmode"...."-run
2bf0: 2d 69 64 22 0a 09 09 09 22 2d 70 69 6e 67 22 0a -id"...."-ping".
2c00: 09 09 09 22 2d 72 65 66 64 62 32 64 61 74 22 0a ..."-refdb2dat".
2c10: 09 09 09 22 2d 6f 22 0a 09 09 09 22 2d 6c 6f 67 ..."-o"...."-log
2c20: 22 0a 09 09 09 22 2d 61 72 63 68 69 76 65 22 0a "...."-archive".
2c30: 09 09 09 22 2d 73 69 6e 63 65 22 0a 09 09 09 22 ..."-since"...."
2c40: 2d 66 69 65 6c 64 73 22 0a 09 09 09 22 2d 72 65 -fields"...."-re
2c50: 63 6f 76 65 72 2d 74 65 73 74 22 20 3b 3b 20 72 cover-test" ;; r
2c60: 75 6e 2d 69 64 2c 74 65 73 74 2d 69 64 20 2d 20 un-id,test-id -
2c70: 75 73 65 64 20 69 6e 74 65 72 6e 61 6c 6c 79 20 used internally
2c80: 74 6f 20 72 65 63 6f 76 65 72 20 61 20 74 65 73 to recover a tes
2c90: 74 20 73 74 75 63 6b 20 69 6e 20 52 55 4e 4e 49 t stuck in RUNNI
2ca0: 4e 47 20 73 74 61 74 65 0a 09 09 09 22 2d 73 6f NG state...."-so
2cb0: 72 74 22 0a 09 09 09 22 2d 74 61 72 67 65 74 2d rt"...."-target-
2cc0: 64 62 22 0a 09 09 09 22 2d 73 6f 75 72 63 65 2d db"...."-source-
2cd0: 64 62 22 0a 09 09 09 29 0a 20 09 09 20 28 6c 69 db"....). .. (li
2ce0: 73 74 20 20 22 2d 68 22 20 22 2d 68 65 6c 70 22 st "-h" "-help"
2cf0: 20 22 2d 2d 68 65 6c 70 22 0a 09 09 09 22 2d 6d "--help"...."-m
2d00: 61 6e 75 61 6c 22 0a 09 09 09 22 2d 76 65 72 73 anual"...."-vers
2d10: 69 6f 6e 22 0a 09 09 20 20 20 20 20 20 20 20 22 ion"... "
2d20: 2d 66 6f 72 63 65 22 0a 09 09 20 20 20 20 20 20 -force"...
2d30: 20 20 22 2d 78 74 65 72 6d 22 0a 09 09 20 20 20 "-xterm"...
2d40: 20 20 20 20 20 22 2d 73 68 6f 77 6b 65 79 73 22 "-showkeys"
2d50: 0a 09 09 20 20 20 20 20 20 20 20 22 2d 73 68 6f ... "-sho
2d60: 77 2d 6b 65 79 73 22 0a 09 09 20 20 20 20 20 20 w-keys"...
2d70: 20 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 "-test-status"
2d80: 0a 09 09 09 22 2d 73 65 74 2d 76 61 6c 75 65 73 ...."-set-values
2d90: 22 0a 09 09 09 22 2d 6c 6f 61 64 2d 74 65 73 74 "...."-load-test
2da0: 2d 64 61 74 61 22 0a 09 09 09 22 2d 73 75 6d 6d -data"...."-summ
2db0: 61 72 69 7a 65 2d 69 74 65 6d 73 22 0a 09 09 20 arize-items"...
2dc0: 20 20 20 20 20 20 20 22 2d 67 75 69 22 0a 09 09 "-gui"...
2dd0: 09 22 2d 64 61 65 6d 6f 6e 69 7a 65 22 0a 09 09 ."-daemonize"...
2de0: 09 22 2d 70 72 65 63 6c 65 61 6e 22 0a 09 09 09 ."-preclean"....
2df0: 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 22 0a 09 "-rerun-clean"..
2e00: 09 09 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 0a 09 .."-rerun-all"..
2e10: 09 09 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 22 .."-clean-cache"
2e20: 0a 09 09 09 22 2d 63 61 63 68 65 2d 64 62 22 0a ...."-cache-db".
2e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e40: 20 20 20 20 20 20 20 20 22 2d 75 73 65 2d 64 62 "-use-db
2e50: 2d 63 61 63 68 65 22 0a 09 09 09 3b 3b 20 6d 69 -cache"....;; mi
2e60: 73 63 0a 09 09 09 22 2d 72 65 70 6c 22 0a 09 09 sc...."-repl"...
2e70: 09 22 2d 6c 6f 63 6b 22 0a 09 09 09 22 2d 75 6e ."-lock"...."-un
2e80: 6c 6f 63 6b 22 0a 09 09 09 22 2d 6c 69 73 74 2d lock"...."-list-
2e90: 73 65 72 76 65 72 73 22 0a 20 20 20 20 20 20 20 servers".
2ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2eb0: 20 22 2d 72 75 6e 2d 77 61 69 74 22 20 20 20 20 "-run-wait"
2ec0: 20 20 3b 3b 20 77 61 69 74 20 6f 6e 20 61 20 72 ;; wait on a r
2ed0: 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 28 un to complete (
2ee0: 69 2e 65 2e 20 6e 6f 20 52 55 4e 4e 49 4e 47 29 i.e. no RUNNING)
2ef0: 0a 09 09 09 22 2d 6c 6f 63 61 6c 22 20 20 20 20 ...."-local"
2f00: 20 20 20 20 20 3b 3b 20 72 75 6e 20 73 6f 6d 65 ;; run some
2f10: 20 63 6f 6d 6d 61 6e 64 73 20 75 73 69 6e 67 20 commands using
2f20: 6c 6f 63 61 6c 20 64 62 20 61 63 63 65 73 73 0a local db access.
2f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f40: 20 20 20 20 20 20 20 20 22 2d 67 65 6e 65 72 61 "-genera
2f50: 74 65 2d 68 74 6d 6c 22 0a 0a 09 09 09 3b 3b 20 te-html".....;;
2f60: 6d 69 73 63 20 71 75 65 72 69 65 73 0a 09 09 09 misc queries....
2f70: 22 2d 6c 69 73 74 2d 64 69 73 6b 73 22 0a 09 09 "-list-disks"...
2f80: 09 22 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 22 ."-list-targets"
2f90: 0a 09 09 09 22 2d 6c 69 73 74 2d 64 62 2d 74 61 ...."-list-db-ta
2fa0: 72 67 65 74 73 22 0a 09 09 09 22 2d 73 68 6f 77 rgets"...."-show
2fb0: 2d 72 75 6e 63 6f 6e 66 69 67 22 0a 09 09 09 22 -runconfig"...."
2fc0: 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 22 0a 09 09 -show-config"...
2fd0: 09 22 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 6f 22 ."-show-cmdinfo"
2fe0: 0a 09 09 09 22 2d 67 65 74 2d 72 75 6e 2d 73 74 ...."-get-run-st
2ff0: 61 74 75 73 22 0a 0a 09 09 09 3b 3b 20 71 75 65 atus".....;; que
3000: 72 69 65 73 0a 09 09 09 22 2d 74 65 73 74 2d 70 ries...."-test-p
3010: 61 74 68 73 22 20 3b 3b 20 67 65 74 20 70 61 74 aths" ;; get pat
3020: 68 28 73 29 20 74 6f 20 61 20 74 65 73 74 2c 20 h(s) to a test,
3030: 6f 72 64 65 72 65 64 20 62 79 20 79 6f 75 6e 67 ordered by young
3040: 65 73 74 20 66 69 72 73 74 0a 0a 09 09 09 22 2d est first....."-
3050: 72 75 6e 61 6c 6c 22 20 20 20 20 3b 3b 20 72 75 runall" ;; ru
3060: 6e 20 61 6c 6c 20 74 65 73 74 73 2c 20 72 65 73 n all tests, res
3070: 70 65 63 74 73 20 2d 74 65 73 74 70 61 74 74 2c pects -testpatt,
3080: 20 64 65 66 61 75 6c 74 73 20 74 6f 20 25 0a 09 defaults to %..
3090: 09 09 22 2d 72 75 6e 22 20 20 20 20 20 20 20 3b .."-run" ;
30a0: 3b 20 61 6c 69 61 73 20 66 6f 72 20 2d 72 75 6e ; alias for -run
30b0: 61 6c 6c 0a 09 09 09 22 2d 72 65 6d 6f 76 65 2d all...."-remove-
30c0: 72 75 6e 73 22 0a 09 09 09 22 2d 72 65 62 75 69 runs"...."-rebui
30d0: 6c 64 2d 64 62 22 0a 09 09 09 22 2d 63 6c 65 61 ld-db"...."-clea
30e0: 6e 75 70 2d 64 62 22 0a 09 09 09 22 2d 72 6f 6c nup-db"...."-rol
30f0: 6c 75 70 22 0a 09 09 09 22 2d 75 70 64 61 74 65 lup"...."-update
3100: 2d 6d 65 74 61 22 0a 09 09 09 22 2d 63 72 65 61 -meta"...."-crea
3110: 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 te-megatest-area
3120: 22 0a 09 09 09 22 2d 6d 61 72 6b 2d 69 6e 63 6f "...."-mark-inco
3130: 6d 70 6c 65 74 65 73 22 0a 0a 09 09 09 22 2d 63 mpletes"....."-c
3140: 6f 6e 76 65 72 74 2d 74 6f 2d 6e 6f 72 6d 22 0a onvert-to-norm".
3150: 09 09 09 22 2d 63 6f 6e 76 65 72 74 2d 74 6f 2d ..."-convert-to-
3160: 6f 6c 64 22 0a 09 09 09 22 2d 69 6d 70 6f 72 74 old"...."-import
3170: 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 0a 09 09 -megatest.db"...
3180: 09 22 2d 73 79 6e 63 2d 74 6f 2d 6d 65 67 61 74 ."-sync-to-megat
3190: 65 73 74 2e 64 62 22 0a 0a 09 09 09 22 2d 6c 6f est.db"....."-lo
31a0: 67 67 69 6e 67 22 0a 09 09 09 22 2d 76 22 20 3b gging"...."-v" ;
31b0: 3b 20 76 65 72 62 6f 73 65 20 32 2c 20 6d 6f 72 ; verbose 2, mor
31c0: 65 20 74 68 61 6e 20 6e 6f 72 6d 61 6c 20 28 6e e than normal (n
31d0: 6f 72 6d 61 6c 20 69 73 20 31 29 0a 09 09 09 22 ormal is 1)...."
31e0: 2d 71 22 20 3b 3b 20 71 75 69 65 74 20 30 2c 20 -q" ;; quiet 0,
31f0: 65 72 72 6f 72 73 2f 77 61 72 6e 69 6e 67 73 20 errors/warnings
3200: 6f 6e 6c 79 0a 09 09 20 20 20 20 20 20 20 29 0a only... ).
3210: 09 09 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 .. args:arg-hash
3220: 0a 09 09 20 30 29 29 0a 0a 3b 3b 20 41 64 64 20 ... 0))..;; Add
3230: 61 72 67 73 20 74 68 61 74 20 75 73 65 20 72 65 args that use re
3240: 6d 61 72 67 73 20 68 65 72 65 0a 3b 3b 0a 28 69 margs here.;;.(i
3250: 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 6e 75 6c f (and (not (nul
3260: 6c 3f 20 72 65 6d 61 72 67 73 29 29 0a 09 20 28 l? remargs)).. (
3270: 6e 6f 74 20 28 6f 72 0a 09 20 20 20 20 20 20 20 not (or..
3280: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3290: 72 75 6e 73 74 65 70 22 29 0a 09 20 20 20 20 20 runstep")..
32a0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
32b0: 22 2d 65 6e 76 63 61 70 22 29 0a 09 20 20 20 20 "-envcap")..
32c0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
32d0: 20 22 2d 65 6e 76 64 65 6c 74 61 22 29 0a 09 20 "-envdelta")..
32e0: 20 20 20 20 20 20 29 0a 09 20 20 20 20 20 20 29 ).. )
32f0: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
3300: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
3310: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 ult-log-port* "U
3320: 6e 72 65 63 6f 67 6e 69 73 65 64 20 61 72 67 75 nrecognised argu
3330: 6d 65 6e 74 73 3a 20 22 20 28 73 74 72 69 6e 67 ments: " (string
3340: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 69 66 -intersperse (if
3350: 20 28 6c 69 73 74 3f 20 72 65 6d 61 72 67 73 29 (list? remargs)
3360: 20 72 65 6d 61 72 67 73 20 28 61 72 67 76 29 29 remargs (argv))
3370: 20 20 22 20 22 29 29 29 0a 0a 3b 3b 20 69 6d 6d " ")))..;; imm
3380: 65 64 69 61 74 65 6c 79 20 73 65 74 20 4d 54 5f ediately set MT_
3390: 54 41 52 47 45 54 20 69 66 20 2d 72 65 71 74 61 TARGET if -reqta
33a0: 72 67 20 6f 72 20 2d 74 61 72 67 65 74 20 61 72 rg or -target ar
33b0: 65 20 61 76 61 69 6c 61 62 6c 65 0a 3b 3b 0a 28 e available.;;.(
33c0: 6c 65 74 20 28 28 74 61 72 67 20 28 6f 72 20 28 let ((targ (or (
33d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
33e0: 65 71 74 61 72 67 22 29 28 61 72 67 73 3a 67 65 eqtarg")(args:ge
33f0: 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 t-arg "-target")
3400: 29 29 29 0a 20 20 28 69 66 20 74 61 72 67 20 28 ))). (if targ (
3410: 73 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 setenv "MT_TARGE
3420: 54 22 20 74 61 72 67 29 29 29 0a 0a 3b 3b 20 54 T" targ)))..;; T
3430: 68 65 20 77 61 74 63 68 64 6f 67 20 69 73 20 74 he watchdog is t
3440: 6f 20 6b 65 65 70 20 61 6e 20 65 79 65 20 6f 6e o keep an eye on
3450: 20 74 68 69 6e 67 73 20 6c 69 6b 65 20 64 62 20 things like db
3460: 73 79 6e 63 20 65 74 63 2e 0a 3b 3b 0a 28 64 65 sync etc..;;.(de
3470: 66 69 6e 65 20 2a 77 61 74 63 68 64 6f 67 2a 20 fine *watchdog*
3480: 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 63 6f 6d (make-thread com
3490: 6d 6f 6e 3a 77 61 74 63 68 64 6f 67 20 22 57 61 mon:watchdog "Wa
34a0: 74 63 68 64 6f 67 20 74 68 72 65 61 64 22 29 29 tchdog thread"))
34b0: 0a 0a 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 ..(thread-start!
34c0: 20 2a 77 61 74 63 68 64 6f 67 2a 29 0a 0a 28 69 *watchdog*)..(i
34d0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
34e0: 22 2d 6c 6f 67 22 29 0a 20 20 20 20 28 6c 65 74 "-log"). (let
34f0: 20 28 28 6f 75 70 20 28 6f 70 65 6e 2d 6f 75 74 ((oup (open-out
3500: 70 75 74 2d 66 69 6c 65 20 28 61 72 67 73 3a 67 put-file (args:g
3510: 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 29 29 et-arg "-log")))
3520: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
3530: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
3540: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
3550: 53 65 6e 64 69 6e 67 20 6c 6f 67 20 6f 75 74 70 Sending log outp
3560: 75 74 20 74 6f 20 22 20 28 61 72 67 73 3a 67 65 ut to " (args:ge
3570: 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 29 0a 20 t-arg "-log")).
3580: 20 20 20 20 20 28 73 65 74 21 20 2a 64 65 66 61 (set! *defa
3590: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 6f 75 ult-log-port* ou
35a0: 70 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 p)))..(if (or (a
35b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 22 rgs:get-arg "-h"
35c0: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
35d0: 20 22 2d 68 65 6c 70 22 29 0a 09 28 61 72 67 73 "-help")..(args
35e0: 3a 67 65 74 2d 61 72 67 20 22 2d 2d 68 65 6c 70 :get-arg "--help
35f0: 22 29 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 ")). (begin.
3600: 20 20 20 20 20 28 70 72 69 6e 74 20 68 65 6c 70 (print help
3610: 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 29 ). (exit)))
3620: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
3630: 61 72 67 20 22 2d 6d 61 6e 75 61 6c 22 29 0a 20 arg "-manual").
3640: 20 20 20 28 6c 65 74 2a 20 28 28 68 74 6d 6c 76 (let* ((htmlv
3650: 69 65 77 65 72 63 6d 64 20 28 6f 72 20 28 63 6f iewercmd (or (co
3660: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f nfigf:lookup *co
3670: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
3680: 20 22 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 22 "htmlviewercmd"
3690: 29 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d ).... (comm
36a0: 6f 6e 3a 77 68 69 63 68 20 27 28 22 66 69 72 65 on:which '("fire
36b0: 66 6f 78 22 20 22 61 72 6f 72 61 22 29 29 29 29 fox" "arora"))))
36c0: 0a 09 20 20 20 28 69 6e 73 74 61 6c 6c 2d 68 6f .. (install-ho
36d0: 6d 65 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d me (common:get-
36e0: 69 6e 73 74 61 6c 6c 2d 61 72 65 61 29 29 0a 09 install-area))..
36f0: 20 20 20 28 6d 61 6e 75 61 6c 2d 68 74 6d 6c 20 (manual-html
3700: 20 20 28 63 6f 6e 63 20 69 6e 73 74 61 6c 6c 2d (conc install-
3710: 68 6f 6d 65 20 22 2f 73 68 61 72 65 2f 64 6f 63 home "/share/doc
3720: 73 2f 6d 65 67 61 74 65 73 74 5f 6d 61 6e 75 61 s/megatest_manua
3730: 6c 2e 68 74 6d 6c 22 29 29 29 0a 20 20 20 20 20 l.html"))).
3740: 20 28 69 66 20 28 61 6e 64 20 69 6e 73 74 61 6c (if (and instal
3750: 6c 2d 68 6f 6d 65 0a 09 20 20 20 20 20 20 20 28 l-home.. (
3760: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6d 61 6e file-exists? man
3770: 75 61 6c 2d 68 74 6d 6c 29 29 0a 09 20 20 28 73 ual-html)).. (s
3780: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 28 22 20 ystem (conc "("
3790: 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 22 20 htmlviewercmd "
37a0: 22 20 6d 61 6e 75 61 6c 2d 68 74 6d 6c 20 22 20 " manual-html "
37b0: 29 20 26 22 29 29 0a 09 20 20 28 73 79 73 74 65 ) &")).. (syste
37c0: 6d 20 28 63 6f 6e 63 20 22 28 22 20 68 74 6d 6c m (conc "(" html
37d0: 76 69 65 77 65 72 63 6d 64 20 22 20 68 74 74 70 viewercmd " http
37e0: 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f ://www.kiatoa.co
37f0: 6d 2f 63 67 69 2d 62 69 6e 2f 66 6f 73 73 69 6c m/cgi-bin/fossil
3800: 73 2f 6d 65 67 61 74 65 73 74 2f 64 6f 63 2f 74 s/megatest/doc/t
3810: 69 70 2f 64 6f 63 73 2f 6d 61 6e 75 61 6c 2f 6d ip/docs/manual/m
3820: 65 67 61 74 65 73 74 5f 6d 61 6e 75 61 6c 2e 68 egatest_manual.h
3830: 74 6d 6c 20 29 20 26 22 29 29 29 0a 20 20 20 20 tml ) &"))).
3840: 20 20 28 65 78 69 74 29 29 29 0a 0a 28 69 66 20 (exit)))..(if
3850: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3860: 73 74 61 72 74 2d 64 69 72 22 29 0a 20 20 20 20 start-dir").
3870: 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 (if (file-exists
3880: 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ? (args:get-arg
3890: 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 0a 09 "-start-dir"))..
38a0: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
38b0: 79 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 y (args:get-arg
38c0: 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 0a 09 "-start-dir"))..
38d0: 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 (begin.. (debug
38e0: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
38f0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
3900: 2a 20 22 6e 6f 6e 2d 65 78 69 73 74 61 6e 74 20 * "non-existant
3910: 73 74 61 72 74 20 64 69 72 20 22 20 28 61 72 67 start dir " (arg
3920: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 s:get-arg "-star
3930: 74 2d 64 69 72 22 29 20 22 20 73 70 65 63 69 66 t-dir") " specif
3940: 69 65 64 2c 20 65 78 69 74 69 6e 67 2e 22 29 0a ied, exiting.").
3950: 09 20 20 28 65 78 69 74 20 31 29 29 29 29 0a 0a . (exit 1))))..
3960: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
3970: 67 20 22 2d 76 65 72 73 69 6f 6e 22 29 0a 20 20 g "-version").
3980: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
3990: 70 72 69 6e 74 20 28 63 6f 6d 6d 6f 6e 3a 76 65 print (common:ve
39a0: 72 73 69 6f 6e 2d 73 69 67 6e 61 74 75 72 65 29 rsion-signature)
39b0: 29 20 3b 3b 20 28 70 72 69 6e 74 20 6d 65 67 61 ) ;; (print mega
39c0: 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 20 test-version).
39d0: 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a 28 64 (exit)))..(d
39e0: 65 66 69 6e 65 20 2a 64 69 64 73 6f 6d 65 74 68 efine *didsometh
39f0: 69 6e 67 2a 20 23 66 29 0a 0a 3b 3b 20 4f 76 65 ing* #f)..;; Ove
3a00: 72 61 6c 6c 20 65 78 69 74 20 68 61 6e 64 6c 69 rall exit handli
3a10: 6e 67 20 73 65 74 75 70 20 69 6d 6d 65 64 69 61 ng setup immedia
3a20: 74 65 6c 79 0a 3b 3b 0a 28 69 66 20 28 6f 72 20 tely.;;.(if (or
3a30: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3a40: 70 72 6f 63 65 73 73 2d 72 65 61 70 22 29 29 0a process-reap")).
3a50: 20 20 20 20 20 20 20 20 3b 3b 20 28 61 72 67 73 ;; (args
3a60: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
3a70: 73 74 73 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a sts")..;; (args:
3a80: 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 get-arg "-execut
3a90: 65 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a 67 65 e")..;; (args:ge
3aa0: 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d 72 t-arg "-remove-r
3ab0: 75 6e 73 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a uns")..;; (args:
3ac0: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 get-arg "-runste
3ad0: 70 22 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 p")). (let ((
3ae0: 6f 72 69 67 69 6e 61 6c 2d 65 78 69 74 20 28 65 original-exit (e
3af0: 78 69 74 2d 68 61 6e 64 6c 65 72 29 29 29 0a 20 xit-handler))).
3b00: 20 20 20 20 20 28 65 78 69 74 2d 68 61 6e 64 6c (exit-handl
3b10: 65 72 20 28 6c 61 6d 62 64 61 20 28 23 21 6f 70 er (lambda (#!op
3b20: 74 69 6f 6e 61 6c 20 28 65 78 69 74 2d 63 6f 64 tional (exit-cod
3b30: 65 20 30 29 29 0a 09 09 20 20 20 20 20 20 28 70 e 0))... (p
3b40: 72 69 6e 74 66 20 22 50 72 65 70 61 72 69 6e 67 rintf "Preparing
3b50: 20 74 6f 20 65 78 69 74 20 77 69 74 68 20 65 78 to exit with ex
3b60: 69 74 20 63 6f 64 65 20 7e 41 20 2e 2e 2e 5c 6e it code ~A ...\n
3b70: 22 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 20 " exit-code)...
3b80: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
3b90: 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda
3ba0: 20 28 70 69 64 29 0a 09 09 09 20 28 68 61 6e 64 (pid).... (hand
3bb0: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 le-exceptions...
3bc0: 09 20 20 65 78 6e 0a 09 09 09 20 20 23 74 0a 09 . exn.... #t..
3bd0: 09 09 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 .. (let-values
3be0: 28 28 28 70 69 64 2d 76 61 6c 20 65 78 69 74 2d (((pid-val exit-
3bf0: 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 status exit-code
3c00: 29 20 28 70 72 6f 63 65 73 73 2d 77 61 69 74 20 ) (process-wait
3c10: 70 69 64 20 23 74 29 29 29 0a 09 09 09 09 20 20 pid #t))).....
3c20: 20 20 20 20 28 69 66 20 28 6f 72 20 28 65 71 3f (if (or (eq?
3c30: 20 70 69 64 2d 76 61 6c 20 70 69 64 29 0a 09 09 pid-val pid)...
3c40: 09 09 09 20 20 20 20 20 20 28 65 71 3f 20 70 69 ... (eq? pi
3c50: 64 2d 76 61 6c 20 30 29 29 0a 09 09 09 09 09 20 d-val 0))......
3c60: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 (begin......
3c70: 20 28 70 72 69 6e 74 66 20 22 53 65 6e 64 69 6e (printf "Sendin
3c80: 67 20 73 69 67 6e 61 6c 2f 74 65 72 6d 20 74 6f g signal/term to
3c90: 20 7e 41 5c 6e 22 20 70 69 64 29 0a 09 09 09 09 ~A\n" pid).....
3ca0: 09 20 20 20 20 28 70 72 6f 63 65 73 73 2d 73 69 . (process-si
3cb0: 67 6e 61 6c 20 70 69 64 20 73 69 67 6e 61 6c 2f gnal pid signal/
3cc0: 74 65 72 6d 29 29 29 29 29 29 0a 09 09 20 20 20 term))))))...
3cd0: 20 20 20 20 28 70 72 6f 63 65 73 73 3a 63 68 69 (process:chi
3ce0: 6c 64 72 65 6e 20 23 66 29 29 0a 09 09 20 20 20 ldren #f))...
3cf0: 20 20 20 28 6f 72 69 67 69 6e 61 6c 2d 65 78 69 (original-exi
3d00: 74 20 65 78 69 74 2d 63 6f 64 65 29 29 29 29 29 t exit-code)))))
3d10: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
3d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 ==========.;; Mi
3d60: 73 63 20 73 65 74 75 70 20 73 74 75 66 66 0a 3b sc setup stuff.;
3d70: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
3d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3db0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 62 75 67 3a =======..(debug:
3dc0: 73 65 74 75 70 29 0a 0a 28 69 66 20 28 61 72 67 setup)..(if (arg
3dd0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 67 s:get-arg "-logg
3de0: 69 6e 67 22 29 28 73 65 74 21 20 2a 6c 6f 67 67 ing")(set! *logg
3df0: 69 6e 67 2a 20 23 74 29 29 0a 0a 28 69 66 20 28 ing* #t))..(if (
3e00: 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 debug:debug-mode
3e10: 20 33 29 20 3b 3b 20 77 65 20 61 72 65 20 6f 62 3) ;; we are ob
3e20: 76 69 6f 75 73 6c 79 20 64 65 62 75 67 67 69 6e viously debuggin
3e30: 67 0a 20 20 20 20 28 73 65 74 21 20 6f 70 65 6e g. (set! open
3e40: 2d 72 75 6e 2d 63 6c 6f 73 65 20 6f 70 65 6e 2d -run-close open-
3e50: 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 run-close-no-exc
3e60: 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 29 eption-handling)
3e70: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
3e80: 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 -arg "-itempatt"
3e90: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 ). (let ((new
3ea0: 76 61 6c 20 28 63 6f 6e 63 20 28 61 72 67 73 3a val (conc (args:
3eb0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
3ec0: 74 74 22 29 20 22 2f 22 20 28 61 72 67 73 3a 67 tt") "/" (args:g
3ed0: 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 et-arg "-itempat
3ee0: 74 22 29 29 29 29 0a 20 20 20 20 20 20 28 64 65 t")))). (de
3ef0: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
3f00: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
3f10: 57 41 52 4e 49 4e 47 3a 20 2d 69 74 65 6d 70 61 WARNING: -itempa
3f20: 74 74 20 68 61 73 20 62 65 65 6e 20 64 65 70 72 tt has been depr
3f30: 65 63 61 74 65 64 2c 20 70 6c 65 61 73 65 20 75 ecated, please u
3f40: 73 65 20 2d 74 65 73 74 70 61 74 74 20 74 65 73 se -testpatt tes
3f50: 74 70 61 74 74 2f 69 74 65 6d 70 61 74 74 20 6d tpatt/itempatt m
3f60: 65 74 68 6f 64 2c 20 6e 65 77 20 74 65 73 74 70 ethod, new testp
3f70: 61 74 74 20 69 73 20 22 6e 65 77 76 61 6c 29 0a att is "newval).
3f80: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
3f90: 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 2d e-set! args:arg-
3fa0: 68 61 73 68 20 22 2d 74 65 73 74 70 61 74 74 22 hash "-testpatt"
3fb0: 20 6e 65 77 76 61 6c 29 0a 20 20 20 20 20 20 28 newval). (
3fc0: 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 hash-table-delet
3fd0: 65 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 e! args:arg-hash
3fe0: 20 22 2d 69 74 65 6d 70 61 74 74 22 29 29 29 0a "-itempatt"))).
3ff0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
4000: 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a rg "-runtests").
4010: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
4020: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
4030: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
4040: 5c 22 2d 72 75 6e 74 65 73 74 73 5c 22 20 69 73 \"-runtests\" is
4050: 20 64 65 70 72 65 63 61 74 65 64 2e 20 55 73 65 deprecated. Use
4060: 20 5c 22 2d 72 75 6e 5c 22 20 77 69 74 68 20 5c \"-run\" with \
4070: 22 2d 74 65 73 74 70 61 74 74 5c 22 20 69 6e 73 "-testpatt\" ins
4080: 74 65 61 64 22 29 29 0a 0a 28 6f 6e 2d 65 78 69 tead"))..(on-exi
4090: 74 20 73 74 64 2d 65 78 69 74 2d 70 72 6f 63 65 t std-exit-proce
40a0: 64 75 72 65 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d dure)..;;=======
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 0a ===============.
40f0: 3b 3b 20 4d 69 73 63 20 67 65 6e 65 72 61 6c 20 ;; Misc general
4100: 63 61 6c 6c 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d calls.;;========
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 0a 0a ==============..
4150: 28 69 66 20 28 61 6e 64 20 28 61 72 67 73 3a 67 (if (and (args:g
4160: 65 74 2d 61 72 67 20 22 2d 63 61 63 68 65 2d 64 et-arg "-cache-d
4170: 62 22 29 0a 20 20 20 20 20 20 20 20 20 28 61 72 b"). (ar
4180: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f 75 gs:get-arg "-sou
4190: 72 63 65 2d 64 62 22 29 29 0a 20 20 20 20 28 6c rce-db")). (l
41a0: 65 74 2a 20 28 28 74 65 6d 70 2d 64 69 72 20 28 et* ((temp-dir (
41b0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
41c0: 20 22 2d 74 61 72 67 65 74 2d 64 62 22 29 20 28 "-target-db") (
41d0: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
41e0: 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 28 (conc "/tmp/" (
41f0: 67 65 74 65 6e 76 20 22 55 53 45 52 22 29 20 22 getenv "USER") "
4200: 2f 22 20 28 73 74 72 69 6e 67 2d 74 72 61 6e 73 /" (string-trans
4210: 6c 61 74 65 20 28 63 75 72 72 65 6e 74 2d 64 69 late (current-di
4220: 72 65 63 74 6f 72 79 29 20 22 2f 22 20 22 5f 22 rectory) "/" "_"
4230: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
4240: 20 28 74 61 72 67 65 74 2d 64 62 20 28 63 6f 6e (target-db (con
4250: 63 20 74 65 6d 70 2d 64 69 72 20 22 2f 63 61 63 c temp-dir "/cac
4260: 68 65 64 2e 64 62 22 29 29 0a 20 20 20 20 20 20 hed.db")).
4270: 20 20 20 20 20 28 73 6f 75 72 63 65 2d 64 62 20 (source-db
4280: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4290: 73 6f 75 72 63 65 2d 64 62 22 29 29 29 20 20 20 source-db")))
42a0: 20 20 20 20 20 0a 20 20 20 20 20 20 28 64 62 3a . (db:
42b0: 63 61 63 68 65 2d 66 6f 72 2d 72 65 61 64 2d 6f cache-for-read-o
42c0: 6e 6c 79 20 73 6f 75 72 63 65 2d 64 62 20 74 61 nly source-db ta
42d0: 72 67 65 74 2d 64 62 29 0a 20 20 20 20 20 20 28 rget-db). (
42e0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
42f0: 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 68 61 ng* #t)))..;; ha
4300: 6e 64 6c 65 20 61 20 63 6c 65 61 6e 2d 63 61 63 ndle a clean-cac
4310: 68 65 20 72 65 71 75 65 73 74 20 61 73 20 65 61 he request as ea
4320: 72 6c 79 20 61 73 20 70 6f 73 73 69 62 6c 65 0a rly as possible.
4330: 3b 3b 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 ;;.(if (args:get
4340: 2d 61 72 67 20 22 2d 63 6c 65 61 6e 2d 63 61 63 -arg "-clean-cac
4350: 68 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a he"). (begin.
4360: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
4370: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 20 3b something* #t) ;
4380: 3b 20 73 75 70 70 72 65 73 73 20 74 68 65 20 68 ; suppress the h
4390: 65 6c 70 20 6f 75 74 70 75 74 2e 0a 20 20 20 20 elp output..
43a0: 20 20 28 69 66 20 28 67 65 74 65 6e 76 20 22 4d (if (getenv "M
43b0: 54 5f 54 41 52 47 45 54 22 29 20 3b 3b 20 6e 6f T_TARGET") ;; no
43c0: 20 70 6f 69 6e 74 20 69 6e 20 74 72 79 69 6e 67 point in trying
43d0: 20 69 66 20 6e 6f 20 74 61 72 67 65 74 0a 09 20 if no target..
43e0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
43f0: 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 0a 09 rg "-runname")..
4400: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f (let* ((to
4410: 70 70 61 74 68 20 20 28 6c 61 75 6e 63 68 3a 73 ppath (launch:s
4420: 65 74 75 70 29 29 0a 09 09 20 20 20 20 20 28 6c etup))... (l
4430: 69 6e 6b 74 72 65 65 20 28 69 66 20 74 6f 70 70 inktree (if topp
4440: 61 74 68 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f ath (configf:loo
4450: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
4460: 22 73 65 74 75 70 22 20 22 6c 69 6e 6b 74 72 65 "setup" "linktre
4470: 65 22 29 29 29 0a 09 09 20 20 20 20 20 28 72 75 e")))... (ru
4480: 6e 74 6f 70 20 20 20 28 63 6f 6e 63 20 6c 69 6e ntop (conc lin
4490: 6b 74 72 65 65 20 22 2f 22 20 28 67 65 74 65 6e ktree "/" (geten
44a0: 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 20 22 v "MT_TARGET") "
44b0: 2f 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 /" (args:get-arg
44c0: 20 22 2d 72 75 6e 6e 61 6d 65 22 29 29 29 0a 09 "-runname")))..
44d0: 09 20 20 20 20 20 28 66 69 6c 65 73 20 20 20 20 . (files
44e0: 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 (if (file-exists
44f0: 3f 20 72 75 6e 74 6f 70 29 0a 09 09 09 09 20 20 ? runtop).....
4500: 20 28 61 70 70 65 6e 64 20 28 67 6c 6f 62 20 28 (append (glob (
4510: 63 6f 6e 63 20 72 75 6e 74 6f 70 20 22 2f 2e 6d conc runtop "/.m
4520: 65 67 61 74 65 73 74 2a 22 29 29 0a 09 09 09 09 egatest*")).....
4530: 09 20 20 20 28 67 6c 6f 62 20 28 63 6f 6e 63 20 . (glob (conc
4540: 72 75 6e 74 6f 70 20 22 2f 2e 72 75 6e 63 6f 6e runtop "/.runcon
4550: 66 69 67 2a 22 29 29 29 0a 09 09 09 09 20 20 20 fig*"))).....
4560: 27 28 29 29 29 29 0a 09 09 28 69 66 20 28 6e 75 '())))...(if (nu
4570: 6c 6c 3f 20 66 69 6c 65 73 29 0a 09 09 20 20 20 ll? files)...
4580: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
4590: 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 0 *default-lo
45a0: 67 2d 70 6f 72 74 2a 20 22 4e 6f 20 63 61 63 68 g-port* "No cach
45b0: 65 64 20 6d 65 67 61 74 65 73 74 20 6f 72 20 72 ed megatest or r
45c0: 75 6e 63 6f 6e 66 69 67 73 20 66 69 6c 65 73 20 unconfigs files
45d0: 66 6f 75 6e 64 2e 20 4e 6f 6e 65 20 72 65 6d 6f found. None remo
45e0: 76 65 64 2e 22 29 0a 09 09 20 20 20 20 28 62 65 ved.")... (be
45f0: 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 gin... (deb
4600: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
4610: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
4620: 74 2a 20 22 52 65 6d 6f 76 69 6e 67 20 63 61 63 t* "Removing cac
4630: 68 65 64 20 66 69 6c 65 73 3a 5c 6e 20 20 20 20 hed files:\n
4640: 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 " (string-inters
4650: 70 65 72 73 65 20 66 69 6c 65 73 20 22 5c 6e 20 perse files "\n
4660: 20 20 20 22 29 29 0a 09 09 20 20 20 20 20 20 28 "))... (
4670: 66 6f 72 2d 65 61 63 68 20 0a 09 09 20 20 20 20 for-each ...
4680: 20 20 20 28 6c 61 6d 62 64 61 20 28 66 29 0a 09 (lambda (f)..
4690: 09 09 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 .. (handle-excep
46a0: 74 69 6f 6e 73 0a 09 09 09 20 20 20 20 20 65 78 tions.... ex
46b0: 6e 0a 09 09 09 20 20 20 20 20 28 64 65 62 75 67 n.... (debug
46c0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
46d0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 t-log-port* "WAR
46e0: 4e 49 4e 47 3a 20 46 61 69 6c 65 64 20 74 6f 20 NING: Failed to
46f0: 72 65 6d 6f 76 65 20 66 69 6c 65 20 22 20 66 29 remove file " f)
4700: 0a 09 09 09 20 20 20 28 64 65 6c 65 74 65 2d 66 .... (delete-f
4710: 69 6c 65 20 66 29 29 29 0a 09 09 20 20 20 20 20 ile f)))...
4720: 20 20 66 69 6c 65 73 29 29 29 29 0a 09 20 20 20 files))))..
4730: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
4740: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
4750: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 63 6c 65 -log-port* "-cle
4760: 61 6e 2d 63 61 63 68 65 20 72 65 71 75 69 72 65 an-cache require
4770: 73 20 2d 72 75 6e 6e 61 6d 65 2e 22 29 29 0a 09 s -runname."))..
4780: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
4790: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
47a0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 63 6c 65 61 log-port* "-clea
47b0: 6e 2d 63 61 63 68 65 20 72 65 71 75 69 72 65 73 n-cache requires
47c0: 20 2d 74 61 72 67 65 74 20 6f 72 20 2d 72 65 71 -target or -req
47d0: 74 61 72 67 22 29 29 29 29 0a 09 20 20 20 20 0a targ")))).. .
47e0: 09 20 20 0a 28 69 66 20 28 61 72 67 73 3a 67 65 . .(if (args:ge
47f0: 74 2d 61 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 t-arg "-env2file
4800: 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
4810: 20 20 20 20 28 73 61 76 65 2d 65 6e 76 69 72 6f (save-enviro
4820: 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 28 nment-as-files (
4830: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
4840: 6e 76 32 66 69 6c 65 22 29 29 0a 20 20 20 20 20 nv2file")).
4850: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
4860: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 hing* #t)))..(if
4870: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4880: 2d 6c 69 73 74 2d 64 69 73 6b 73 22 29 0a 20 20 -list-disks").
4890: 20 20 28 6c 65 74 20 28 28 74 6f 70 70 61 74 68 (let ((toppath
48a0: 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
48b0: 29 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 0a ). (print .
48c0: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 (string-i
48d0: 6e 74 65 72 73 70 65 72 73 65 20 0a 09 28 6d 61 ntersperse ..(ma
48e0: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 p (lambda (x)..
48f0: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e (string-in
4900: 74 65 72 73 70 65 72 73 65 20 0a 09 09 78 0a 09 tersperse ...x..
4910: 09 22 20 3d 3e 20 22 29 29 0a 09 20 20 20 20 20 ." => "))..
4920: 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 64 69 73 6b (common:get-disk
4930: 73 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 29 0a s *configdat*)).
4940: 09 22 5c 6e 22 29 29 0a 20 20 20 20 20 20 28 73 ."\n")). (s
4950: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
4960: 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 63 73 76 g* #t)))..;; csv
4970: 20 70 72 6f 63 65 73 73 69 6e 67 20 72 65 63 6f processing reco
4980: 72 64 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 rd.(define (make
4990: 2d 72 65 66 64 62 3a 63 73 76 29 0a 20 20 28 76 -refdb:csv). (v
49a0: 65 63 74 6f 72 20 0a 20 20 20 28 6d 61 6b 65 2d ector . (make-
49b0: 73 70 61 72 73 65 2d 61 72 72 61 79 29 0a 20 20 sparse-array).
49c0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
49d0: 65 29 0a 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 e). (make-hash
49e0: 2d 74 61 62 6c 65 29 0a 20 20 20 30 0a 20 20 20 -table). 0.
49f0: 30 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 0)).(define-inli
4a00: 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 ne (refdb:csv-ge
4a10: 74 2d 73 76 65 63 20 20 20 20 20 76 65 63 29 20 t-svec vec)
4a20: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 (vector-ref
4a30: 76 65 63 20 30 29 29 0a 28 64 65 66 69 6e 65 2d vec 0)).(define-
4a40: 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 inline (refdb:cs
4a50: 76 2d 67 65 74 2d 72 6f 77 73 20 20 20 20 20 76 v-get-rows v
4a60: 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 ec) (vector-r
4a70: 65 66 20 20 76 65 63 20 31 29 29 0a 28 64 65 66 ef vec 1)).(def
4a80: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 ine-inline (refd
4a90: 62 3a 63 73 76 2d 67 65 74 2d 63 6f 6c 73 20 20 b:csv-get-cols
4aa0: 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 vec) (vect
4ab0: 6f 72 2d 72 65 66 20 20 76 65 63 20 32 29 29 0a or-ref vec 2)).
4ac0: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
4ad0: 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 refdb:csv-get-ma
4ae0: 78 72 6f 77 20 20 20 76 65 63 29 20 20 20 20 28 xrow vec) (
4af0: 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 vector-ref vec
4b00: 33 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 3)).(define-inli
4b10: 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 ne (refdb:csv-ge
4b20: 74 2d 6d 61 78 63 6f 6c 20 20 20 76 65 63 29 20 t-maxcol vec)
4b30: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 (vector-ref
4b40: 76 65 63 20 34 29 29 0a 28 64 65 66 69 6e 65 2d vec 4)).(define-
4b50: 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 inline (refdb:cs
4b60: 76 2d 73 65 74 2d 73 76 65 63 21 20 20 20 20 76 v-set-svec! v
4b70: 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 ec val)(vector-s
4b80: 65 74 21 20 76 65 63 20 30 20 76 61 6c 29 29 0a et! vec 0 val)).
4b90: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
4ba0: 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 72 6f refdb:csv-set-ro
4bb0: 77 73 21 20 20 20 20 76 65 63 20 76 61 6c 29 28 ws! vec val)(
4bc0: 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 vector-set! vec
4bd0: 31 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 1 val)).(define-
4be0: 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 inline (refdb:cs
4bf0: 76 2d 73 65 74 2d 63 6f 6c 73 21 20 20 20 20 76 v-set-cols! v
4c00: 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 ec val)(vector-s
4c10: 65 74 21 20 76 65 63 20 32 20 76 61 6c 29 29 0a et! vec 2 val)).
4c20: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
4c30: 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d 61 refdb:csv-set-ma
4c40: 78 72 6f 77 21 20 20 76 65 63 20 76 61 6c 29 28 xrow! vec val)(
4c50: 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 vector-set! vec
4c60: 33 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 3 val)).(define-
4c70: 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 inline (refdb:cs
4c80: 76 2d 73 65 74 2d 6d 61 78 63 6f 6c 21 20 20 76 v-set-maxcol! v
4c90: 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 ec val)(vector-s
4ca0: 65 74 21 20 76 65 63 20 34 20 76 61 6c 29 29 0a et! vec 4 val)).
4cb0: 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d 64 61 .(define (get-da
4cc0: 74 20 72 65 73 75 6c 74 73 20 73 68 65 65 74 6e t results sheetn
4cd0: 61 6d 65 29 0a 20 20 28 6f 72 20 28 68 61 73 68 ame). (or (hash
4ce0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
4cf0: 6c 74 20 72 65 73 75 6c 74 73 20 73 68 65 65 74 lt results sheet
4d00: 6e 61 6d 65 20 23 66 29 0a 20 20 20 20 20 20 28 name #f). (
4d10: 6c 65 74 20 28 28 74 6d 70 2d 76 65 63 20 20 28 let ((tmp-vec (
4d20: 6d 61 6b 65 2d 72 65 66 64 62 3a 63 73 76 29 29 make-refdb:csv))
4d30: 29 0a 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 )..(hash-table-s
4d40: 65 74 21 20 72 65 73 75 6c 74 73 20 73 68 65 65 et! results shee
4d50: 74 6e 61 6d 65 20 74 6d 70 2d 76 65 63 29 0a 09 tname tmp-vec)..
4d60: 74 6d 70 2d 76 65 63 29 29 29 0a 0a 28 69 66 20 tmp-vec)))..(if
4d70: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4d80: 72 65 66 64 62 32 64 61 74 22 29 0a 20 20 20 20 refdb2dat").
4d90: 28 6c 65 74 2a 20 28 28 69 6e 70 75 74 2d 64 62 (let* ((input-db
4da0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4db0: 2d 72 65 66 64 62 32 64 61 74 22 29 29 0a 09 20 -refdb2dat"))..
4dc0: 20 20 28 6f 75 74 2d 66 69 6c 65 20 28 61 72 67 (out-file (arg
4dd0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 29 s:get-arg "-o"))
4de0: 0a 09 20 20 20 28 6f 75 74 2d 66 6d 74 20 20 28 .. (out-fmt (
4df0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
4e00: 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 73 "-dumpmode") "s
4e10: 63 68 65 6d 65 22 29 29 0a 09 20 20 20 28 6f 75 cheme")).. (ou
4e20: 74 2d 70 6f 72 74 20 28 69 66 20 28 61 6e 64 20 t-port (if (and
4e30: 6f 75 74 2d 66 69 6c 65 20 0a 09 09 09 20 20 20 out-file ....
4e40: 20 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 (not (member
4e50: 6f 75 74 2d 66 6d 74 20 27 28 22 73 71 6c 69 74 out-fmt '("sqlit
4e60: 65 33 22 20 22 63 73 76 22 29 29 29 29 0a 09 09 e3" "csv"))))...
4e70: 09 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 . (open-output-f
4e80: 69 6c 65 20 6f 75 74 2d 66 69 6c 65 29 0a 09 09 ile out-file)...
4e90: 09 20 28 63 75 72 72 65 6e 74 2d 6f 75 74 70 75 . (current-outpu
4ea0: 74 2d 70 6f 72 74 29 29 29 0a 09 20 20 20 28 72 t-port))).. (r
4eb0: 65 73 2d 64 61 74 61 20 28 63 6f 6e 66 69 67 66 es-data (configf
4ec0: 3a 72 65 61 64 2d 72 65 66 64 62 20 69 6e 70 75 :read-refdb inpu
4ed0: 74 2d 64 62 29 29 0a 09 20 20 20 28 64 61 74 61 t-db)).. (data
4ee0: 20 20 20 20 20 28 63 61 72 20 72 65 73 2d 64 61 (car res-da
4ef0: 74 61 29 29 0a 09 20 20 20 28 6d 73 67 20 20 20 ta)).. (msg
4f00: 20 20 20 28 63 61 64 72 20 72 65 73 2d 64 61 74 (cadr res-dat
4f10: 61 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 a))). (if (
4f20: 6e 6f 74 20 64 61 74 61 29 0a 09 20 20 28 64 65 not data).. (de
4f30: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
4f40: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4f50: 42 61 64 20 69 6e 70 75 74 3f 20 64 61 74 61 3d Bad input? data=
4f60: 22 20 64 61 74 61 29 20 3b 3b 20 73 6f 6d 65 20 " data) ;; some
4f70: 65 72 72 6f 72 20 6f 63 63 75 72 72 65 64 0a 09 error occurred..
4f80: 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 (with-output-t
4f90: 6f 2d 70 6f 72 74 20 6f 75 74 2d 70 6f 72 74 0a o-port out-port.
4fa0: 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a . (lambda ().
4fb0: 09 20 20 20 20 20 20 28 63 61 73 65 20 28 73 74 . (case (st
4fc0: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 6f 75 74 ring->symbol out
4fd0: 2d 66 6d 74 29 0a 09 09 28 28 73 63 68 65 6d 65 -fmt)...((scheme
4fe0: 29 28 70 70 20 64 61 74 61 29 29 0a 09 09 28 28 )(pp data))...((
4ff0: 70 65 72 6c 29 0a 09 09 20 3b 3b 20 28 70 72 69 perl)... ;; (pri
5000: 6e 74 20 22 25 68 61 73 68 20 3d 20 28 22 29 0a nt "%hash = (").
5010: 09 09 20 3b 3b 20 20 20 20 20 20 20 20 6b 65 79 .. ;; key
5020: 31 20 3d 3e 20 27 76 61 6c 75 65 31 27 2c 0a 09 1 => 'value1',..
5030: 09 20 3b 3b 20 20 20 20 20 20 20 20 6b 65 79 32 . ;; key2
5040: 20 3d 3e 20 27 76 61 6c 75 65 32 27 2c 0a 09 09 => 'value2',...
5050: 20 3b 3b 20 20 20 20 20 20 20 20 6b 65 79 33 20 ;; key3
5060: 3d 3e 20 27 76 61 6c 75 65 33 27 2c 0a 09 09 20 => 'value3',...
5070: 3b 3b 20 29 3b 0a 09 09 20 28 63 6f 6e 66 69 67 ;; );... (config
5080: 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 f:map-all-hier-a
5090: 6c 69 73 74 20 0a 09 09 20 20 64 61 74 61 20 0a list ... data .
50a0: 09 09 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 .. (lambda (she
50b0: 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 etname sectionna
50c0: 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 0a me varname val).
50d0: 09 09 20 20 20 20 28 70 72 69 6e 74 20 22 24 64 .. (print "$d
50e0: 61 74 61 7b 5c 22 22 20 73 68 65 65 74 6e 61 6d ata{\"" sheetnam
50f0: 65 20 22 5c 22 7d 7b 5c 22 22 20 73 65 63 74 69 e "\"}{\"" secti
5100: 6f 6e 6e 61 6d 65 20 22 5c 22 7d 7b 5c 22 22 20 onname "\"}{\""
5110: 76 61 72 6e 61 6d 65 20 22 5c 22 7d 20 3d 20 5c varname "\"} = \
5120: 22 22 20 76 61 6c 20 22 5c 22 3b 22 29 29 29 29 "" val "\";"))))
5130: 0a 09 09 28 28 70 79 74 68 6f 6e 20 72 75 62 79 ...((python ruby
5140: 29 0a 09 09 20 28 70 72 69 6e 74 20 22 64 61 74 )... (print "dat
5150: 61 3d 7b 7d 22 29 0a 09 09 20 28 63 6f 6e 66 69 a={}")... (confi
5160: 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d gf:map-all-hier-
5170: 61 6c 69 73 74 0a 09 09 20 20 64 61 74 61 0a 09 alist... data..
5180: 09 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 65 . (lambda (shee
5190: 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d tname sectionnam
51a0: 65 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 0a 09 e varname val)..
51b0: 09 20 20 20 20 28 70 72 69 6e 74 20 22 64 61 74 . (print "dat
51c0: 61 5b 5c 22 22 20 73 68 65 65 74 6e 61 6d 65 20 a[\"" sheetname
51d0: 22 5c 22 5d 5b 5c 22 22 20 73 65 63 74 69 6f 6e "\"][\"" section
51e0: 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 22 20 76 61 name "\"][\"" va
51f0: 72 6e 61 6d 65 20 22 5c 22 5d 20 3d 20 5c 22 22 rname "\"] = \""
5200: 20 76 61 6c 20 22 5c 22 22 29 29 0a 09 09 20 20 val "\""))...
5210: 69 6e 69 74 70 72 6f 63 31 3a 0a 09 09 20 20 28 initproc1:... (
5220: 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d lambda (sheetnam
5230: 65 29 0a 09 09 20 20 20 20 28 70 72 69 6e 74 20 e)... (print
5240: 22 64 61 74 61 5b 5c 22 22 20 73 68 65 65 74 6e "data[\"" sheetn
5250: 61 6d 65 20 22 5c 22 5d 20 3d 20 7b 7d 22 29 29 ame "\"] = {}"))
5260: 0a 09 09 20 20 69 6e 69 74 70 72 6f 63 32 3a 0a ... initproc2:.
5270: 09 09 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 .. (lambda (she
5280: 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 etname sectionna
5290: 6d 65 29 0a 09 09 20 20 20 20 28 70 72 69 6e 74 me)... (print
52a0: 20 22 64 61 74 61 5b 5c 22 22 20 73 68 65 65 74 "data[\"" sheet
52b0: 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 22 20 73 65 name "\"][\"" se
52c0: 63 74 69 6f 6e 6e 61 6d 65 20 22 5c 22 5d 20 3d ctionname "\"] =
52d0: 20 7b 7d 22 29 29 29 29 0a 09 09 28 28 63 73 76 {}"))))...((csv
52e0: 29 0a 09 09 20 28 6c 65 74 2a 20 28 28 72 65 73 )... (let* ((res
52f0: 75 6c 74 73 20 20 28 6d 61 6b 65 2d 68 61 73 68 ults (make-hash
5300: 2d 74 61 62 6c 65 29 29 20 3b 3b 20 28 6d 61 6b -table)) ;; (mak
5310: 65 2d 73 70 61 72 73 65 2d 61 72 72 61 79 29 29 e-sparse-array))
5320: 29 0a 09 09 09 28 72 6f 77 2d 63 6f 6c 73 20 28 )....(row-cols (
5330: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
5340: 29 29 20 3b 3b 20 68 61 73 68 20 6f 66 20 68 61 )) ;; hash of ha
5350: 73 68 65 73 20 77 68 65 72 65 20 73 65 63 74 69 shes where secti
5360: 6f 6e 20 3d 3e 20 68 74 20 7b 20 72 6f 77 2d 3c on => ht { row-<
5370: 6e 61 6d 65 3e 20 3d 3e 20 6e 75 6d 20 6f 72 20 name> => num or
5380: 63 6f 6c 2d 3c 6e 61 6d 65 3e 20 3d 3e 20 6e 75 col-<name> => nu
5390: 6d 0a 09 09 20 20 20 3b 3b 20 28 70 72 69 6e 74 m... ;; (print
53a0: 20 22 64 61 74 61 3d 22 29 0a 09 09 20 20 20 3b "data=")... ;
53b0: 3b 20 28 70 70 20 64 61 74 61 29 0a 09 09 20 20 ; (pp data)...
53c0: 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c (configf:map-al
53d0: 6c 2d 68 69 65 72 2d 61 6c 69 73 74 0a 09 09 20 l-hier-alist...
53e0: 20 20 20 64 61 74 61 0a 09 09 20 20 20 20 28 6c data... (l
53f0: 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 ambda (sheetname
5400: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 sectionname var
5410: 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 name val)...
5420: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 68 65 ;; (print "she
5430: 65 74 6e 61 6d 65 3a 20 22 20 73 68 65 65 74 6e etname: " sheetn
5440: 61 6d 65 20 22 2c 20 73 65 63 74 69 6f 6e 6e 61 ame ", sectionna
5450: 6d 65 3a 20 22 20 73 65 63 74 69 6f 6e 6e 61 6d me: " sectionnam
5460: 65 20 22 2c 20 76 61 72 6e 61 6d 65 3a 20 22 20 e ", varname: "
5470: 76 61 72 6e 61 6d 65 20 22 2c 20 76 61 6c 3a 20 varname ", val:
5480: 22 20 76 61 6c 29 0a 09 09 20 20 20 20 20 20 28 " val)... (
5490: 6c 65 74 2a 20 28 28 64 61 74 20 20 20 20 20 20 let* ((dat
54a0: 28 67 65 74 2d 64 61 74 20 72 65 73 75 6c 74 73 (get-dat results
54b0: 20 73 68 65 65 74 6e 61 6d 65 29 29 0a 09 09 09 sheetname))....
54c0: 20 20 20 20 20 28 76 65 63 20 20 20 20 20 20 28 (vec (
54d0: 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 73 76 refdb:csv-get-sv
54e0: 65 63 20 64 61 74 29 29 0a 09 09 09 20 20 20 20 ec dat))....
54f0: 20 28 72 6f 77 6e 61 6d 65 73 20 28 72 65 66 64 (rownames (refd
5500: 62 3a 63 73 76 2d 67 65 74 2d 72 6f 77 73 20 64 b:csv-get-rows d
5510: 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 63 6f at)).... (co
5520: 6c 6e 61 6d 65 73 20 28 72 65 66 64 62 3a 63 73 lnames (refdb:cs
5530: 76 2d 67 65 74 2d 63 6f 6c 73 20 64 61 74 29 29 v-get-cols dat))
5540: 0a 09 09 09 20 20 20 20 20 28 63 75 72 72 72 6f .... (currro
5550: 77 6e 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 wn (hash-table-r
5560: 65 66 2f 64 65 66 61 75 6c 74 20 72 6f 77 6e 61 ef/default rowna
5570: 6d 65 73 20 76 61 72 6e 61 6d 65 20 23 66 29 29 mes varname #f))
5580: 0a 09 09 09 20 20 20 20 20 28 63 75 72 72 63 6f .... (currco
5590: 6c 6e 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ln (hash-table-r
55a0: 65 66 2f 64 65 66 61 75 6c 74 20 63 6f 6c 6e 61 ef/default colna
55b0: 6d 65 73 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 mes sectionname
55c0: 23 66 29 29 0a 09 09 09 20 20 20 20 20 28 72 6f #f)).... (ro
55d0: 77 6e 20 20 20 20 20 28 6f 72 20 63 75 72 72 72 wn (or currr
55e0: 6f 77 6e 20 0a 09 09 09 09 09 20 20 20 28 6c 65 own ...... (le
55f0: 74 2a 20 28 28 6c 61 73 74 6e 20 20 20 28 72 65 t* ((lastn (re
5600: 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 72 fdb:csv-get-maxr
5610: 6f 77 20 64 61 74 29 29 0a 09 09 09 09 09 09 20 ow dat)).......
5620: 20 28 6e 65 77 72 6f 77 6e 20 28 2b 20 6c 61 73 (newrown (+ las
5630: 74 6e 20 31 29 29 29 0a 09 09 09 09 09 20 20 20 tn 1)))......
5640: 20 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 (refdb:csv-set
5650: 2d 6d 61 78 72 6f 77 21 20 64 61 74 20 6e 65 77 -maxrow! dat new
5660: 72 6f 77 6e 29 0a 09 09 09 09 09 20 20 20 20 20 rown)......
5670: 6e 65 77 72 6f 77 6e 29 29 29 0a 09 09 09 20 20 newrown)))....
5680: 20 20 20 28 63 6f 6c 6e 20 20 20 20 20 28 6f 72 (coln (or
5690: 20 63 75 72 72 63 6f 6c 6e 20 0a 09 09 09 09 09 currcoln ......
56a0: 20 20 20 28 6c 65 74 2a 20 28 28 6c 61 73 74 6e (let* ((lastn
56b0: 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 (refdb:csv-ge
56c0: 74 2d 6d 61 78 63 6f 6c 20 64 61 74 29 29 0a 09 t-maxcol dat))..
56d0: 09 09 09 09 09 20 20 28 6e 65 77 63 6f 6c 6e 20 ..... (newcoln
56e0: 28 2b 20 6c 61 73 74 6e 20 31 29 29 29 0a 09 09 (+ lastn 1)))...
56f0: 09 09 09 20 20 20 20 20 28 72 65 66 64 62 3a 63 ... (refdb:c
5700: 73 76 2d 73 65 74 2d 6d 61 78 63 6f 6c 21 20 64 sv-set-maxcol! d
5710: 61 74 20 6e 65 77 63 6f 6c 6e 29 0a 09 09 09 09 at newcoln).....
5720: 09 20 20 20 20 20 6e 65 77 63 6f 6c 6e 29 29 29 . newcoln)))
5730: 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 28 73 )....(if (not (s
5740: 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 parse-array-ref
5750: 76 65 63 20 30 20 63 6f 6c 6e 29 29 20 3b 3b 20 vec 0 coln)) ;;
5760: 28 65 71 3f 20 72 6f 77 6e 20 30 29 0a 09 09 09 (eq? rown 0)....
5770: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 (begin....
5780: 20 20 20 20 28 73 70 61 72 73 65 2d 61 72 72 61 (sparse-arra
5790: 79 2d 73 65 74 21 20 76 65 63 20 30 20 63 6f 6c y-set! vec 0 col
57a0: 6e 20 73 65 63 74 69 6f 6e 6e 61 6d 65 29 0a 09 n sectionname)..
57b0: 09 09 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e .. ;; (prin
57c0: 74 20 22 73 70 61 72 73 65 2d 61 72 72 61 79 2d t "sparse-array-
57d0: 72 65 66 20 22 20 30 20 22 2c 22 20 63 6f 6c 6e ref " 0 "," coln
57e0: 20 22 3d 22 20 28 73 70 61 72 73 65 2d 61 72 72 "=" (sparse-arr
57f0: 61 79 2d 72 65 66 20 76 65 63 20 30 20 63 6f 6c ay-ref vec 0 col
5800: 6e 29 29 0a 09 09 09 20 20 20 20 20 20 29 29 0a n)).... )).
5810: 09 09 09 28 69 66 20 28 6e 6f 74 20 28 73 70 61 ...(if (not (spa
5820: 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 76 65 rse-array-ref ve
5830: 63 20 72 6f 77 6e 20 30 29 29 20 3b 3b 20 28 65 c rown 0)) ;; (e
5840: 71 3f 20 63 6f 6c 6e 20 30 29 0a 09 09 09 20 20 q? coln 0)....
5850: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 (begin....
5860: 20 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d (sparse-array-
5870: 73 65 74 21 20 76 65 63 20 72 6f 77 6e 20 30 20 set! vec rown 0
5880: 76 61 72 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 varname)....
5890: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 70 61 ;; (print "spa
58a0: 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 22 20 rse-array-ref "
58b0: 72 6f 77 6e 20 22 2c 22 20 30 20 22 3d 22 20 28 rown "," 0 "=" (
58c0: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 sparse-array-ref
58d0: 20 76 65 63 20 72 6f 77 6e 20 30 29 29 0a 09 09 vec rown 0))...
58e0: 09 20 20 20 20 20 20 29 29 0a 09 09 09 28 69 66 . ))....(if
58f0: 20 28 6e 6f 74 20 63 75 72 72 72 6f 77 6e 29 28 (not currrown)(
5900: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
5910: 72 6f 77 6e 61 6d 65 73 20 76 61 72 6e 61 6d 65 rownames varname
5920: 20 72 6f 77 6e 29 29 0a 09 09 09 28 69 66 20 28 rown))....(if (
5930: 6e 6f 74 20 63 75 72 72 63 6f 6c 6e 29 28 68 61 not currcoln)(ha
5940: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 63 6f sh-table-set! co
5950: 6c 6e 61 6d 65 73 20 73 65 63 74 69 6f 6e 6e 61 lnames sectionna
5960: 6d 65 20 63 6f 6c 6e 29 29 0a 09 09 09 3b 3b 20 me coln))....;;
5970: 28 70 72 69 6e 74 20 22 64 61 74 3d 22 20 64 61 (print "dat=" da
5980: 74 20 22 2c 20 72 6f 77 6e 3d 22 20 72 6f 77 6e t ", rown=" rown
5990: 20 22 2c 20 63 6f 6c 6e 3d 22 20 63 6f 6c 6e 29 ", coln=" coln)
59a0: 0a 09 09 09 28 73 70 61 72 73 65 2d 61 72 72 61 ....(sparse-arra
59b0: 79 2d 73 65 74 21 20 76 65 63 20 72 6f 77 6e 20 y-set! vec rown
59c0: 63 6f 6c 6e 20 76 61 6c 29 0a 09 09 09 3b 3b 20 coln val)....;;
59d0: 28 70 72 69 6e 74 20 22 73 70 61 72 73 65 2d 61 (print "sparse-a
59e0: 72 72 61 79 2d 72 65 66 20 22 20 72 6f 77 6e 20 rray-ref " rown
59f0: 22 2c 22 20 63 6f 6c 6e 20 22 3d 22 20 28 73 70 "," coln "=" (sp
5a00: 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 76 arse-array-ref v
5a10: 65 63 20 72 6f 77 6e 20 63 6f 6c 6e 29 29 0a 09 ec rown coln))..
5a20: 09 09 29 29 29 0a 09 09 20 20 20 28 66 6f 72 2d ..)))... (for-
5a30: 65 61 63 68 0a 09 09 20 20 20 20 28 6c 61 6d 62 each... (lamb
5a40: 64 61 20 28 73 68 65 65 74 6e 61 6d 65 29 0a 09 da (sheetname)..
5a50: 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 73 . (let* ((s
5a60: 68 65 65 74 64 61 74 20 28 67 65 74 2d 64 61 74 heetdat (get-dat
5a70: 20 72 65 73 75 6c 74 73 20 73 68 65 65 74 6e 61 results sheetna
5a80: 6d 65 29 29 0a 09 09 09 20 20 20 20 20 28 73 76 me)).... (sv
5a90: 65 63 20 20 20 20 20 28 72 65 66 64 62 3a 63 73 ec (refdb:cs
5aa0: 76 2d 67 65 74 2d 73 76 65 63 20 73 68 65 65 74 v-get-svec sheet
5ab0: 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 6d dat)).... (m
5ac0: 61 78 72 6f 77 20 20 20 28 72 65 66 64 62 3a 63 axrow (refdb:c
5ad0: 73 76 2d 67 65 74 2d 6d 61 78 72 6f 77 20 73 68 sv-get-maxrow sh
5ae0: 65 65 74 64 61 74 29 29 0a 09 09 09 20 20 20 20 eetdat))....
5af0: 20 28 6d 61 78 63 6f 6c 20 20 20 28 72 65 66 64 (maxcol (refd
5b00: 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 63 6f 6c b:csv-get-maxcol
5b10: 20 73 68 65 65 74 64 61 74 29 29 0a 09 09 09 20 sheetdat))....
5b20: 20 20 20 20 28 66 6e 61 6d 65 20 20 20 20 28 69 (fname (i
5b30: 66 20 6f 75 74 2d 66 69 6c 65 20 0a 09 09 09 09 f out-file .....
5b40: 09 20 20 20 28 73 74 72 69 6e 67 2d 73 75 62 73 . (string-subs
5b50: 74 69 74 75 74 65 20 22 25 73 22 20 73 68 65 65 titute "%s" shee
5b60: 74 6e 61 6d 65 20 6f 75 74 2d 66 69 6c 65 29 20 tname out-file)
5b70: 3b 3b 20 22 2f 66 6f 6f 2f 62 61 72 2f 25 73 2e ;; "/foo/bar/%s.
5b80: 63 73 76 22 29 0a 09 09 09 09 09 20 20 20 28 63 csv")...... (c
5b90: 6f 6e 63 20 73 68 65 65 74 6e 61 6d 65 20 22 2e onc sheetname ".
5ba0: 63 73 76 22 29 29 29 29 0a 09 09 09 28 77 69 74 csv"))))....(wit
5bb0: 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 h-output-to-file
5bc0: 20 66 6e 61 6d 65 0a 09 09 09 20 20 28 6c 61 6d fname.... (lam
5bd0: 62 64 61 20 28 29 0a 09 09 09 20 20 20 20 3b 3b bda ().... ;;
5be0: 20 28 70 72 69 6e 74 20 22 53 68 65 65 74 6e 61 (print "Sheetna
5bf0: 6d 65 3a 20 22 20 73 68 65 65 74 6e 61 6d 65 29 me: " sheetname)
5c00: 0a 09 09 09 20 20 20 20 28 6c 65 74 20 6c 6f 6f .... (let loo
5c10: 70 20 28 28 72 6f 77 20 20 20 20 20 20 20 30 29 p ((row 0)
5c20: 0a 09 09 09 09 20 20 20 20 20 20 20 28 63 6f 6c ..... (col
5c30: 20 20 20 20 20 20 20 30 29 0a 09 09 09 09 20 20 0).....
5c40: 20 20 20 20 20 28 63 75 72 72 2d 72 6f 77 20 27 (curr-row '
5c50: 28 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 ())..... (
5c60: 72 65 73 75 6c 74 20 20 20 27 28 29 29 29 0a 09 result '()))..
5c70: 09 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 .. (let* ((
5c80: 76 61 6c 20 28 73 70 61 72 73 65 2d 61 72 72 61 val (sparse-arra
5c90: 79 2d 72 65 66 20 73 76 65 63 20 72 6f 77 20 63 y-ref svec row c
5ca0: 6f 6c 29 29 0a 09 09 09 09 20 20 20 20 20 28 64 ol))..... (d
5cb0: 69 73 70 2d 76 61 6c 20 28 69 66 20 76 61 6c 0a isp-val (if val.
5cc0: 09 09 09 09 09 09 20 20 20 28 63 6f 6e 63 20 22 ...... (conc "
5cd0: 5c 22 22 20 76 61 6c 20 22 5c 22 22 29 0a 09 09 \"" val "\"")...
5ce0: 09 09 09 09 20 20 20 22 22 29 29 29 0a 09 09 09 .... "")))....
5cf0: 09 28 69 66 20 28 3e 20 63 6f 6c 20 30 29 28 64 .(if (> col 0)(d
5d00: 69 73 70 6c 61 79 20 22 2c 22 29 29 0a 09 09 09 isplay ","))....
5d10: 09 28 64 69 73 70 6c 61 79 20 64 69 73 70 2d 76 .(display disp-v
5d20: 61 6c 29 0a 09 09 09 09 28 63 6f 6e 64 0a 09 09 al).....(cond...
5d30: 09 09 20 28 28 3e 20 72 6f 77 20 6d 61 78 72 6f .. ((> row maxro
5d40: 77 29 28 64 69 73 70 6c 61 79 20 22 5c 6e 22 29 w)(display "\n")
5d50: 20 72 65 73 75 6c 74 29 0a 09 09 09 09 20 28 28 result)..... ((
5d60: 3e 3d 20 63 6f 6c 20 6d 61 78 63 6f 6c 29 0a 09 >= col maxcol)..
5d70: 09 09 09 20 20 28 64 69 73 70 6c 61 79 20 22 5c ... (display "\
5d80: 6e 22 29 0a 09 09 09 09 20 20 28 6c 6f 6f 70 20 n")..... (loop
5d90: 28 2b 20 72 6f 77 20 31 29 20 30 20 27 28 29 20 (+ row 1) 0 '()
5da0: 28 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 28 (append result (
5db0: 6c 69 73 74 20 63 75 72 72 2d 72 6f 77 29 29 29 list curr-row)))
5dc0: 29 0a 09 09 09 09 20 28 65 6c 73 65 0a 09 09 09 )..... (else....
5dd0: 09 20 20 28 6c 6f 6f 70 20 72 6f 77 20 28 2b 20 . (loop row (+
5de0: 63 6f 6c 20 31 29 20 28 61 70 70 65 6e 64 20 63 col 1) (append c
5df0: 75 72 72 2d 72 6f 77 20 28 6c 69 73 74 20 76 61 urr-row (list va
5e00: 6c 29 29 20 72 65 73 75 6c 74 29 29 29 29 29 29 l)) result))))))
5e10: 29 29 29 0a 09 09 20 20 20 20 28 68 61 73 68 2d )))... (hash-
5e20: 74 61 62 6c 65 2d 6b 65 79 73 20 72 65 73 75 6c table-keys resul
5e30: 74 73 29 29 29 29 0a 09 09 28 28 73 71 6c 69 74 ts))))...((sqlit
5e40: 65 33 29 0a 09 09 20 28 6c 65 74 2a 20 28 28 64 e3)... (let* ((d
5e50: 62 2d 66 69 6c 65 20 20 20 28 6f 72 20 6f 75 74 b-file (or out
5e60: 2d 66 69 6c 65 20 28 70 61 74 68 6e 61 6d 65 2d -file (pathname-
5e70: 66 69 6c 65 20 69 6e 70 75 74 2d 64 62 29 29 29 file input-db)))
5e80: 0a 09 09 09 28 64 62 2d 65 78 69 73 74 73 20 28 ....(db-exists (
5e90: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 62 2d file-exists? db-
5ea0: 66 69 6c 65 29 29 0a 09 09 09 28 64 62 20 20 20 file))....(db
5eb0: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 6f 70 (sqlite3:op
5ec0: 65 6e 2d 64 61 74 61 62 61 73 65 20 64 62 2d 66 en-database db-f
5ed0: 69 6c 65 29 29 29 0a 09 09 20 20 20 28 69 66 20 ile)))... (if
5ee0: 28 6e 6f 74 20 64 62 2d 65 78 69 73 74 73 29 28 (not db-exists)(
5ef0: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
5f00: 64 62 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 db "CREATE TABLE
5f10: 20 64 61 74 61 20 28 73 68 65 65 74 2c 73 65 63 data (sheet,sec
5f20: 74 69 6f 6e 2c 76 61 72 2c 76 61 6c 29 3b 22 29 tion,var,val);")
5f30: 29 0a 09 09 20 20 20 28 63 6f 6e 66 69 67 66 3a )... (configf:
5f40: 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 map-all-hier-ali
5f50: 73 74 0a 09 09 20 20 20 20 64 61 74 61 0a 09 09 st... data...
5f60: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 (lambda (she
5f70: 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 etname sectionna
5f80: 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 0a me varname val).
5f90: 09 09 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 .. (sqlite3
5fa0: 3a 65 78 65 63 75 74 65 20 64 62 0a 09 09 09 09 :execute db.....
5fb0: 20 20 20 20 20 20 20 22 49 4e 53 45 52 54 20 4f "INSERT O
5fc0: 52 20 52 45 50 4c 41 43 45 20 49 4e 54 4f 20 64 R REPLACE INTO d
5fd0: 61 74 61 20 28 73 68 65 65 74 2c 73 65 63 74 69 ata (sheet,secti
5fe0: 6f 6e 2c 76 61 72 2c 76 61 6c 29 20 56 41 4c 55 on,var,val) VALU
5ff0: 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 29 3b 22 0a 09 ES (?,?,?,?);"..
6000: 09 09 09 20 20 20 20 20 20 20 73 68 65 65 74 6e ... sheetn
6010: 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 ame sectionname
6020: 76 61 72 6e 61 6d 65 20 76 61 6c 29 29 29 0a 09 varname val)))..
6030: 09 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e . (sqlite3:fin
6040: 61 6c 69 7a 65 21 20 64 62 29 29 29 0a 09 09 28 alize! db)))...(
6050: 65 6c 73 65 0a 09 09 20 28 70 70 20 64 61 74 61 else... (pp data
6060: 29 29 29 29 29 29 0a 20 20 20 20 20 20 28 69 66 )))))). (if
6070: 20 6f 75 74 2d 66 69 6c 65 20 28 63 6c 6f 73 65 out-file (close
6080: 2d 6f 75 74 70 75 74 2d 70 6f 72 74 20 6f 75 74 -output-port out
6090: 2d 70 6f 72 74 29 29 0a 20 20 20 20 20 20 28 65 -port)). (e
60a0: 78 69 74 29 20 3b 3b 20 79 65 73 2c 20 62 65 6e xit) ;; yes, ben
60b0: 64 69 6e 67 20 74 68 65 20 72 75 6c 65 73 20 68 ding the rules h
60c0: 65 72 65 20 2d 20 6e 65 65 64 20 74 6f 20 65 78 ere - need to ex
60d0: 69 74 20 73 69 6e 63 65 20 74 68 69 73 20 69 73 it since this is
60e0: 20 61 20 75 74 69 6c 69 74 79 0a 20 20 20 20 20 a utility.
60f0: 20 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ))..(if (args:g
6100: 65 74 2d 61 72 67 20 22 2d 70 69 6e 67 22 29 0a et-arg "-ping").
6110: 20 20 20 20 28 6c 65 74 2a 20 28 28 73 65 72 76 (let* ((serv
6120: 65 72 2d 69 64 20 20 20 20 20 28 73 74 72 69 6e er-id (strin
6130: 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a g->number (args:
6140: 67 65 74 2d 61 72 67 20 22 2d 70 69 6e 67 22 29 get-arg "-ping")
6150: 29 29 20 3b 3b 20 65 78 74 72 61 63 74 20 72 75 )) ;; extract ru
6160: 6e 2d 69 64 20 28 69 2e 65 2e 20 6e 6f 20 22 3a n-id (i.e. no ":
6170: 22 0a 09 20 20 20 28 68 6f 73 74 3a 70 6f 72 74 ".. (host:port
6180: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
6190: 72 67 20 22 2d 70 69 6e 67 22 29 29 29 0a 20 20 rg "-ping"))).
61a0: 20 20 20 20 28 73 65 72 76 65 72 3a 70 69 6e 67 (server:ping
61b0: 20 28 6f 72 20 73 65 72 76 65 72 2d 69 64 20 68 (or server-id h
61c0: 6f 73 74 3a 70 6f 72 74 29 20 64 6f 2d 65 78 69 ost:port) do-exi
61d0: 74 3a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d t: #t)))..;;====
61e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
61f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6220: 3d 3d 0a 3b 3b 20 43 61 70 74 75 72 65 2c 20 73 ==.;; Capture, s
6230: 61 76 65 20 61 6e 64 20 6d 61 6e 69 70 75 6c 61 ave and manipula
6240: 74 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 73 0a te environments.
6250: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
6260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6290: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f 54 ========..;; NOT
62a0: 45 3a 20 4b 65 65 70 20 74 68 65 73 65 20 61 62 E: Keep these ab
62b0: 6f 76 65 20 74 68 65 20 73 65 63 74 69 6f 6e 20 ove the section
62c0: 77 68 65 72 65 20 74 68 65 20 73 65 72 76 65 72 where the server
62d0: 20 6f 72 20 63 6c 69 65 6e 74 20 63 6f 64 65 20 or client code
62e0: 69 73 20 73 65 74 75 70 0a 0a 28 6c 65 74 20 28 is setup..(let (
62f0: 28 65 6e 76 63 61 70 20 28 61 72 67 73 3a 67 65 (envcap (args:ge
6300: 74 2d 61 72 67 20 22 2d 65 6e 76 63 61 70 22 29 t-arg "-envcap")
6310: 29 29 0a 20 20 28 69 66 20 65 6e 76 63 61 70 0a )). (if envcap.
6320: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 64 62 (let* ((db
6330: 20 20 20 20 20 20 28 65 6e 76 3a 6f 70 65 6e 2d (env:open-
6340: 64 62 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 db (if (null? re
6350: 6d 61 72 67 73 29 20 22 65 6e 76 64 61 74 2e 64 margs) "envdat.d
6360: 62 22 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 b" (car remargs)
6370: 29 29 29 29 0a 09 28 65 6e 76 3a 73 61 76 65 2d ))))..(env:save-
6380: 65 6e 76 2d 76 61 72 73 20 64 62 20 65 6e 76 63 env-vars db envc
6390: 61 70 29 0a 09 28 65 6e 76 3a 63 6c 6f 73 65 2d ap)..(env:close-
63a0: 64 61 74 61 62 61 73 65 20 64 62 29 0a 09 28 73 database db)..(s
63b0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
63c0: 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 20 64 65 g* #t))))..;; de
63d0: 6c 74 61 20 22 6c 61 6e 67 75 61 67 65 22 20 77 lta "language" w
63e0: 69 6c 6c 20 65 76 65 6e 74 75 61 6c 6c 79 20 62 ill eventually b
63f0: 65 20 72 65 73 3d 61 2b 62 2d 63 20 62 75 74 20 e res=a+b-c but
6400: 66 6f 72 20 6e 6f 77 20 69 74 20 69 73 20 6a 75 for now it is ju
6410: 73 74 20 72 65 73 3d 61 2d 62 20 0a 3b 3b 0a 28 st res=a-b .;;.(
6420: 6c 65 74 20 28 28 65 6e 76 64 65 6c 74 61 20 28 let ((envdelta (
6430: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
6440: 6e 76 64 65 6c 74 61 22 29 29 29 0a 20 20 28 69 nvdelta"))). (i
6450: 66 20 65 6e 76 64 65 6c 74 61 0a 20 20 20 20 20 f envdelta.
6460: 20 28 6c 65 74 20 28 28 6d 61 74 63 68 20 28 73 (let ((match (s
6470: 74 72 69 6e 67 2d 73 70 6c 69 74 20 65 6e 76 64 tring-split envd
6480: 65 6c 74 61 20 22 2d 22 29 29 29 3b 3b 20 28 73 elta "-")));; (s
6490: 74 72 69 6e 67 2d 6d 61 74 63 68 20 22 28 5b 61 tring-match "([a
64a0: 2d 7a 30 2d 39 5f 5d 2b 29 3d 28 5b 61 2d 7a 30 -z0-9_]+)=([a-z0
64b0: 2d 39 5f 5c 5c 2d 2c 5d 2b 29 22 20 65 6e 76 64 -9_\\-,]+)" envd
64c0: 65 6c 74 61 29 29 29 0a 09 28 69 66 20 28 6e 6f elta)))..(if (no
64d0: 74 20 28 6e 75 6c 6c 3f 20 6d 61 74 63 68 29 29 t (null? match))
64e0: 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 64 62 .. (let* ((db
64f0: 20 20 20 20 20 20 20 20 28 65 6e 76 3a 6f 70 65 (env:ope
6500: 6e 2d 64 62 20 28 69 66 20 28 6e 75 6c 6c 3f 20 n-db (if (null?
6510: 72 65 6d 61 72 67 73 29 20 22 65 6e 76 64 61 74 remargs) "envdat
6520: 2e 64 62 22 20 28 63 61 72 20 72 65 6d 61 72 67 .db" (car remarg
6530: 73 29 29 29 29 0a 09 09 20 20 20 3b 3b 20 28 72 s))))... ;; (r
6540: 65 73 63 74 78 20 20 20 20 28 63 61 64 72 20 6d esctx (cadr m
6550: 61 74 63 68 29 29 0a 09 09 20 20 20 3b 3b 20 28 atch))... ;; (
6560: 65 71 75 6e 20 20 20 20 20 20 28 63 61 64 64 72 equn (caddr
6570: 20 6d 61 74 63 68 29 29 0a 09 09 20 20 20 28 70 match))... (p
6580: 61 72 74 73 20 20 20 20 20 6d 61 74 63 68 29 20 arts match)
6590: 3b 3b 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 ;; (string-split
65a0: 20 65 71 75 6e 20 22 2d 22 29 29 0a 09 09 20 20 equn "-"))...
65b0: 20 28 6d 69 6e 75 65 6e 64 20 20 20 28 63 61 72 (minuend (car
65c0: 20 70 61 72 74 73 29 29 0a 09 09 20 20 20 28 73 parts))... (s
65d0: 75 62 74 72 61 65 6e 64 20 28 63 61 64 72 20 70 ubtraend (cadr p
65e0: 61 72 74 73 29 29 0a 09 09 20 20 20 28 61 64 64 arts))... (add
65f0: 65 64 20 20 20 20 20 28 65 6e 76 3a 67 65 74 2d ed (env:get-
6600: 61 64 64 65 64 20 20 20 64 62 20 6d 69 6e 75 65 added db minue
6610: 6e 64 20 73 75 62 74 72 61 65 6e 64 29 29 0a 09 nd subtraend))..
6620: 09 20 20 20 28 72 65 6d 6f 76 65 64 20 20 20 28 . (removed (
6630: 65 6e 76 3a 67 65 74 2d 72 65 6d 6f 76 65 64 20 env:get-removed
6640: 64 62 20 6d 69 6e 75 65 6e 64 20 73 75 62 74 72 db minuend subtr
6650: 61 65 6e 64 29 29 0a 09 09 20 20 20 28 63 68 61 aend))... (cha
6660: 6e 67 65 64 20 20 20 28 65 6e 76 3a 67 65 74 2d nged (env:get-
6670: 63 68 61 6e 67 65 64 20 64 62 20 6d 69 6e 75 65 changed db minue
6680: 6e 64 20 73 75 62 74 72 61 65 6e 64 29 29 29 0a nd subtraend))).
6690: 09 20 20 20 20 20 20 3b 3b 20 28 70 70 20 28 68 . ;; (pp (h
66a0: 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 ash-table->alist
66b0: 20 61 64 64 65 64 29 29 0a 09 20 20 20 20 20 20 added))..
66c0: 3b 3b 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 ;; (pp (hash-tab
66d0: 6c 65 2d 3e 61 6c 69 73 74 20 72 65 6d 6f 76 65 le->alist remove
66e0: 64 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 70 d)).. ;; (p
66f0: 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 p (hash-table->a
6700: 6c 69 73 74 20 63 68 61 6e 67 65 64 29 29 0a 09 list changed))..
6710: 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a (if (args:
6720: 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 0a 09 09 get-arg "-o")...
6730: 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 (with-output-t
6740: 6f 2d 66 69 6c 65 0a 09 09 20 20 20 20 20 20 28 o-file... (
6750: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f args:get-arg "-o
6760: 22 29 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 61 ")... (lambda
6770: 20 28 29 0a 09 09 20 20 20 20 20 20 28 65 6e 76 ()... (env
6780: 3a 70 72 69 6e 74 20 61 64 64 65 64 20 72 65 6d :print added rem
6790: 6f 76 65 64 20 63 68 61 6e 67 65 64 29 29 29 0a oved changed))).
67a0: 09 09 20 20 28 65 6e 76 3a 70 72 69 6e 74 20 61 .. (env:print a
67b0: 64 64 65 64 20 72 65 6d 6f 76 65 64 20 63 68 61 dded removed cha
67c0: 6e 67 65 64 29 29 0a 09 20 20 20 20 20 20 28 65 nged)).. (e
67d0: 6e 76 3a 63 6c 6f 73 65 2d 64 61 74 61 62 61 73 nv:close-databas
67e0: 65 20 64 62 29 0a 09 20 20 20 20 20 20 28 73 65 e db).. (se
67f0: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
6800: 2a 20 23 74 29 29 0a 09 20 20 20 20 28 64 65 62 * #t)).. (deb
6810: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
6820: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
6830: 72 74 2a 20 22 50 61 72 61 6d 65 74 65 72 20 74 rt* "Parameter t
6840: 6f 20 2d 65 6e 76 64 65 6c 74 61 20 73 68 6f 75 o -envdelta shou
6850: 6c 64 20 62 65 20 6e 65 77 3d 73 74 61 72 2d 65 ld be new=star-e
6860: 6e 64 22 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d nd")))))..;;====
6870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
68a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
68b0: 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 74 68 65 20 ==.;; Start the
68c0: 73 65 72 76 65 72 20 2d 20 63 61 6e 20 62 65 20 server - can be
68d0: 64 6f 6e 65 20 69 6e 20 63 6f 6e 6a 75 6e 63 74 done in conjunct
68e0: 69 6f 6e 20 77 69 74 68 20 2d 72 75 6e 61 6c 6c ion with -runall
68f0: 20 6f 72 20 2d 72 75 6e 74 65 73 74 73 20 28 6f or -runtests (o
6900: 6e 65 20 64 61 79 2e 2e 2e 29 0a 3b 3b 20 20 20 ne day...).;;
6910: 77 65 20 73 74 61 72 74 20 74 68 65 20 73 65 72 we start the ser
6920: 76 65 72 20 69 66 20 6e 6f 74 20 72 75 6e 6e 69 ver if not runni
6930: 6e 67 20 65 6c 73 65 20 73 74 61 72 74 20 74 68 ng else start th
6940: 65 20 63 6c 69 65 6e 74 20 74 68 72 65 61 64 0a e client thread.
6950: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
6960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6990: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
69a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
69b0: 72 76 65 72 22 29 0a 0a 20 20 20 20 3b 3b 20 53 rver").. ;; S
69c0: 65 72 76 65 72 3f 20 53 74 61 72 74 20 75 70 20 erver? Start up
69d0: 68 65 72 65 2e 0a 20 20 20 20 3b 3b 0a 20 20 20 here.. ;;.
69e0: 20 28 6c 65 74 20 28 28 74 6c 20 20 20 20 20 20 (let ((tl
69f0: 20 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 (launch:setup)
6a00: 29 0a 09 3b 3b 20 28 72 75 6e 2d 69 64 20 20 20 )..;; (run-id
6a10: 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d (and (args:get-
6a20: 61 72 67 20 22 2d 72 75 6e 2d 69 64 22 29 0a 09 arg "-run-id")..
6a30: 3b 3b 20 09 09 20 20 28 73 74 72 69 6e 67 2d 3e ;; .. (string->
6a40: 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 number (args:get
6a50: 2d 61 72 67 20 22 2d 72 75 6e 2d 69 64 22 29 29 -arg "-run-id"))
6a60: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 74 72 )). (tr
6a70: 61 6e 73 70 6f 72 74 2d 74 79 70 65 20 28 73 74 ansport-type (st
6a80: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 ring->symbol (or
6a90: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6aa0: 2d 74 72 61 6e 73 70 6f 72 74 22 29 20 22 68 74 -transport") "ht
6ab0: 74 70 22 29 29 29 29 0a 20 20 20 20 20 20 3b 3b tp")))). ;;
6ac0: 20 28 69 66 20 72 75 6e 2d 69 64 0a 20 20 20 20 (if run-id.
6ad0: 20 20 3b 3b 20 20 20 28 62 65 67 69 6e 0a 20 20 ;; (begin.
6ae0: 20 20 20 20 28 73 65 72 76 65 72 3a 6c 61 75 6e (server:laun
6af0: 63 68 20 30 20 74 72 61 6e 73 70 6f 72 74 2d 74 ch 0 transport-t
6b00: 79 70 65 29 0a 20 20 20 20 20 20 28 73 65 74 21 ype). (set!
6b10: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
6b20: 23 74 29 29 29 0a 3b 3b 20 20 20 20 20 3b 3b 20 #t))).;; ;;
6b30: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
6b40: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
6b50: 67 2d 70 6f 72 74 2a 20 22 73 65 72 76 65 72 20 g-port* "server
6b60: 72 65 71 75 69 72 65 73 20 72 75 6e 2d 69 64 20 requires run-id
6b70: 62 65 20 73 70 65 63 69 66 69 65 64 20 77 69 74 be specified wit
6b80: 68 20 2d 72 75 6e 2d 69 64 22 29 29 29 0a 3b 3b h -run-id"))).;;
6b90: 20 0a 3b 3b 20 20 20 20 20 3b 3b 20 4e 6f 74 20 .;; ;; Not
6ba0: 61 20 73 65 72 76 65 72 3f 20 54 68 69 73 20 73 a server? This s
6bb0: 65 63 74 69 6f 6e 20 77 69 6c 6c 20 64 65 63 69 ection will deci
6bc0: 64 65 20 68 6f 77 20 74 6f 20 63 6f 6d 6d 75 6e de how to commun
6bd0: 69 63 61 74 65 0a 3b 3b 20 20 20 20 20 3b 3b 0a icate.;; ;;.
6be0: 3b 3b 20 20 20 20 20 3b 3b 20 20 53 65 74 75 70 ;; ;; Setup
6bf0: 20 63 6c 69 65 6e 74 20 66 6f 72 20 61 6c 6c 20 client for all
6c00: 65 78 70 65 63 74 20 6c 69 73 74 65 64 20 68 65 expect listed he
6c10: 72 65 0a 3b 3b 20 20 20 20 20 28 69 66 20 28 6e re.;; (if (n
6c20: 75 6c 6c 3f 20 28 6c 73 65 74 2d 69 6e 74 65 72 ull? (lset-inter
6c30: 73 65 63 74 69 6f 6e 20 0a 3b 3b 20 09 09 65 71 section .;; ..eq
6c40: 75 61 6c 3f 0a 3b 3b 20 09 09 28 68 61 73 68 2d ual?.;; ..(hash-
6c50: 74 61 62 6c 65 2d 6b 65 79 73 20 61 72 67 73 3a table-keys args:
6c60: 61 72 67 2d 68 61 73 68 29 0a 3b 3b 20 09 09 27 arg-hash).;; ..'
6c70: 28 22 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 ("-list-servers"
6c80: 0a 3b 3b 20 09 09 20 20 22 2d 73 74 6f 70 2d 73 .;; .. "-stop-s
6c90: 65 72 76 65 72 22 0a 3b 3b 20 20 20 20 20 20 20 erver".;;
6ca0: 20 20 20 20 20 20 20 20 20 20 20 20 22 2d 6b 69 "-ki
6cb0: 6c 6c 2d 73 65 72 76 65 72 22 0a 3b 3b 20 09 09 ll-server".;; ..
6cc0: 20 20 22 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 6f "-show-cmdinfo
6cd0: 22 0a 3b 3b 20 09 09 20 20 22 2d 6c 69 73 74 2d ".;; .. "-list-
6ce0: 72 75 6e 73 22 0a 3b 3b 20 09 09 20 20 22 2d 70 runs".;; .. "-p
6cf0: 69 6e 67 22 29 29 29 0a 3b 3b 20 09 28 69 66 20 ing"))).;; .(if
6d00: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 0a 3b (launch:setup).;
6d10: 3b 20 09 20 20 20 20 28 6c 65 74 20 28 28 72 75 ; . (let ((ru
6d20: 6e 2d 69 64 20 20 20 20 28 61 6e 64 20 28 61 72 n-id (and (ar
6d30: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
6d40: 2d 69 64 22 29 0a 3b 3b 20 09 09 09 09 20 20 28 -id").;; .... (
6d50: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
6d60: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
6d70: 75 6e 2d 69 64 22 29 29 29 29 29 0a 3b 3b 20 09 un-id"))))).;; .
6d80: 20 20 20 20 20 20 3b 3b 20 28 73 65 74 21 20 2a ;; (set! *
6d90: 66 64 62 2a 20 20 20 28 66 69 6c 65 64 62 3a 6f fdb* (filedb:o
6da0: 70 65 6e 2d 64 62 20 28 63 6f 6e 63 20 2a 74 6f pen-db (conc *to
6db0: 70 70 61 74 68 2a 20 22 2f 64 62 2f 70 61 74 68 ppath* "/db/path
6dc0: 73 2e 64 62 22 29 29 29 0a 3b 3b 20 09 20 20 20 s.db"))).;; .
6dd0: 20 20 20 3b 3b 20 69 66 20 6e 6f 74 20 6c 69 73 ;; if not lis
6de0: 74 20 6f 72 20 6b 69 6c 6c 20 74 68 65 6e 20 73 t or kill then s
6df0: 74 61 72 74 20 61 20 63 6c 69 65 6e 74 20 28 69 tart a client (i
6e00: 66 20 61 70 70 72 6f 70 72 69 61 74 65 29 0a 3b f appropriate).;
6e10: 3b 20 09 20 20 20 20 20 20 28 69 66 20 28 6f 72 ; . (if (or
6e20: 20 28 61 72 67 73 2d 64 65 66 69 6e 65 64 3f 20 (args-defined?
6e30: 22 2d 68 22 20 22 2d 76 65 72 73 69 6f 6e 22 20 "-h" "-version"
6e40: 22 2d 63 72 65 61 74 65 2d 6d 65 67 61 74 65 73 "-create-megates
6e50: 74 2d 61 72 65 61 22 20 22 2d 63 72 65 61 74 65 t-area" "-create
6e60: 2d 74 65 73 74 22 29 0a 3b 3b 20 09 09 20 20 20 -test").;; ..
6e70: 20 20 20 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 (eq? (length
6e80: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
6e90: 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 args:arg-hash))
6ea0: 20 30 29 29 0a 3b 3b 20 09 09 20 20 28 64 65 62 0)).;; .. (deb
6eb0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 ug:print-info 1
6ec0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
6ed0: 74 2a 20 22 53 65 72 76 65 72 20 63 6f 6e 6e 65 t* "Server conne
6ee0: 63 74 69 6f 6e 20 6e 6f 74 20 6e 65 65 64 65 64 ction not needed
6ef0: 22 29 0a 3b 3b 20 09 09 20 20 28 62 65 67 69 6e ").;; .. (begin
6f00: 0a 3b 3b 20 09 09 20 20 20 20 3b 3b 20 28 69 66 .;; .. ;; (if
6f10: 20 72 75 6e 2d 69 64 20 0a 3b 3b 20 09 09 20 20 run-id .;; ..
6f20: 20 20 3b 3b 20 20 20 20 20 28 63 6c 69 65 6e 74 ;; (client
6f30: 3a 6c 61 75 6e 63 68 20 72 75 6e 2d 69 64 29 20 :launch run-id)
6f40: 0a 3b 3b 20 09 09 20 20 20 20 3b 3b 20 20 20 20 .;; .. ;;
6f50: 20 28 63 6c 69 65 6e 74 3a 6c 61 75 6e 63 68 20 (client:launch
6f60: 30 29 20 20 20 20 20 20 3b 3b 20 77 69 74 68 6f 0) ;; witho
6f70: 75 74 20 72 75 6e 2d 69 64 20 77 65 27 6c 6c 20 ut run-id we'll
6f80: 73 74 61 72 74 20 61 20 73 65 72 76 65 72 20 66 start a server f
6f90: 6f 72 20 22 30 22 0a 3b 3b 20 09 09 20 20 20 20 or "0".;; ..
6fa0: 23 74 0a 3b 3b 20 09 09 20 20 20 20 29 29 29 29 #t.;; .. ))))
6fb0: 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 ))..(if (or (arg
6fc0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
6fd0: 2d 73 65 72 76 65 72 73 22 29 0a 09 28 61 72 67 -servers")..(arg
6fe0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 6f 70 s:get-arg "-stop
6ff0: 2d 73 65 72 76 65 72 22 29 0a 20 20 20 20 20 20 -server").
7000: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
7010: 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 29 29 "-kill-server"))
7020: 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 28 . (let ((tl (
7030: 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 0a launch:setup))).
7040: 20 20 20 20 20 20 28 69 66 20 74 6c 20 0a 09 20 (if tl ..
7050: 20 28 6c 65 74 2a 20 28 28 74 64 62 64 61 74 20 (let* ((tdbdat
7060: 20 28 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 (tasks:open-db)
7070: 29 0a 09 09 20 28 73 65 72 76 65 72 73 20 28 74 )... (servers (t
7080: 61 73 6b 73 3a 67 65 74 2d 61 6c 6c 2d 73 65 72 asks:get-all-ser
7090: 76 65 72 73 20 28 64 62 3a 64 65 6c 61 79 2d 69 vers (db:delay-i
70a0: 66 2d 62 75 73 79 20 74 64 62 64 61 74 29 29 29 f-busy tdbdat)))
70b0: 0a 09 09 20 28 66 6d 74 73 74 72 20 20 22 7e 35 ... (fmtstr "~5
70c0: 61 7e 31 32 61 7e 38 61 7e 32 30 61 7e 32 34 61 a~12a~8a~20a~24a
70d0: 7e 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 ~10a~10a~10a~10a
70e0: 5c 6e 22 29 0a 09 09 20 28 73 65 72 76 65 72 73 \n")... (servers
70f0: 2d 74 6f 2d 6b 69 6c 6c 20 27 28 29 29 0a 20 20 -to-kill '()).
7100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
7110: 6b 69 6c 6c 2d 73 77 69 74 63 68 20 20 28 69 66 kill-switch (if
7120: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7130: 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 29 20 22 -kill-server") "
7140: 2d 39 22 20 22 22 29 29 0a 20 20 20 20 20 20 20 -9" "")).
7150: 20 20 20 20 20 20 20 20 20 20 28 6b 69 6c 6c 69 (killi
7160: 6e 66 6f 20 20 20 28 6f 72 20 28 61 72 67 73 3a nfo (or (args:
7170: 67 65 74 2d 61 72 67 20 22 2d 73 74 6f 70 2d 73 get-arg "-stop-s
7180: 65 72 76 65 72 22 29 20 28 61 72 67 73 3a 67 65 erver") (args:ge
7190: 74 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 72 t-arg "-kill-ser
71a0: 76 65 72 22 29 20 29 29 0a 09 09 20 28 6b 68 6f ver") ))... (kho
71b0: 73 74 2d 70 6f 72 74 20 28 69 66 20 6b 69 6c 6c st-port (if kill
71c0: 69 6e 66 6f 20 28 69 66 20 28 73 75 62 73 74 72 info (if (substr
71d0: 69 6e 67 2d 69 6e 64 65 78 20 22 3a 22 20 6b 69 ing-index ":" ki
71e0: 6c 6c 69 6e 66 6f 29 28 73 74 72 69 6e 67 2d 73 llinfo)(string-s
71f0: 70 6c 69 74 20 22 3a 22 29 20 23 66 29 20 23 66 plit ":") #f) #f
7200: 29 29 0a 09 09 20 28 73 69 64 20 20 20 20 20 20 ))... (sid
7210: 20 20 28 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 (if killinfo (
7220: 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e if (substring-in
7230: 64 65 78 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f dex ":" killinfo
7240: 29 20 23 66 20 28 73 74 72 69 6e 67 2d 3e 6e 75 ) #f (string->nu
7250: 6d 62 65 72 20 6b 69 6c 6c 69 6e 66 6f 29 29 20 mber killinfo))
7260: 23 66 29 29 29 0a 09 20 20 20 20 28 66 6f 72 6d #f))).. (form
7270: 61 74 20 23 74 20 66 6d 74 73 74 72 20 22 49 64 at #t fmtstr "Id
7280: 22 20 22 4d 54 76 65 72 22 20 22 50 69 64 22 20 " "MTver" "Pid"
7290: 22 48 6f 73 74 22 20 22 49 6e 74 65 72 66 61 63 "Host" "Interfac
72a0: 65 3a 4f 75 74 50 6f 72 74 22 20 22 49 6e 50 6f e:OutPort" "InPo
72b0: 72 74 22 20 22 4c 61 73 74 42 65 61 74 22 20 22 rt" "LastBeat" "
72c0: 53 74 61 74 65 22 20 22 54 72 61 6e 73 70 6f 72 State" "Transpor
72d0: 74 22 29 0a 09 20 20 20 20 28 66 6f 72 6d 61 74 t").. (format
72e0: 20 23 74 20 66 6d 74 73 74 72 20 22 3d 3d 22 20 #t fmtstr "=="
72f0: 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 20 22 3d "=====" "===" "=
7300: 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ===" "==========
7310: 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d =======" "======
7320: 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d " "========" "==
7330: 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 ===" "========="
7340: 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 ).. (for-each
7350: 20 0a 09 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
7360: 28 73 65 72 76 65 72 29 0a 09 20 20 20 20 20 20 (server)..
7370: 20 28 6c 65 74 2a 20 28 28 69 64 20 20 20 20 20 (let* ((id
7380: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
7390: 73 65 72 76 65 72 20 30 29 29 0a 09 09 20 20 20 server 0))...
73a0: 20 20 20 28 70 69 64 20 20 20 20 20 20 20 20 28 (pid (
73b0: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
73c0: 72 20 31 29 29 0a 09 09 20 20 20 20 20 20 28 68 r 1))... (h
73d0: 6f 73 74 6e 61 6d 65 20 20 20 28 76 65 63 74 6f ostname (vecto
73e0: 72 2d 72 65 66 20 73 65 72 76 65 72 20 32 29 29 r-ref server 2))
73f0: 0a 09 09 20 20 20 20 20 20 28 69 6e 74 65 72 66 ... (interf
7400: 61 63 65 20 20 28 76 65 63 74 6f 72 2d 72 65 66 ace (vector-ref
7410: 20 73 65 72 76 65 72 20 33 29 29 20 0a 09 09 20 server 3)) ...
7420: 20 20 20 20 20 28 70 75 6c 6c 70 6f 72 74 20 20 (pullport
7430: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
7440: 76 65 72 20 34 29 29 0a 09 09 20 20 20 20 20 20 ver 4))...
7450: 28 70 75 62 70 6f 72 74 20 20 20 20 28 76 65 63 (pubport (vec
7460: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 35 tor-ref server 5
7470: 29 29 0a 09 09 20 20 20 20 20 20 28 73 74 61 72 ))... (star
7480: 74 2d 74 69 6d 65 20 28 76 65 63 74 6f 72 2d 72 t-time (vector-r
7490: 65 66 20 73 65 72 76 65 72 20 36 29 29 0a 09 09 ef server 6))...
74a0: 20 20 20 20 20 20 28 70 72 69 6f 72 69 74 79 20 (priority
74b0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
74c0: 72 76 65 72 20 37 29 29 0a 09 09 20 20 20 20 20 rver 7))...
74d0: 20 28 73 74 61 74 65 20 20 20 20 20 20 28 76 65 (state (ve
74e0: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
74f0: 38 29 29 0a 09 09 20 20 20 20 20 20 28 6d 74 2d 8))... (mt-
7500: 76 65 72 20 20 20 20 20 28 76 65 63 74 6f 72 2d ver (vector-
7510: 72 65 66 20 73 65 72 76 65 72 20 39 29 29 0a 09 ref server 9))..
7520: 09 20 20 20 20 20 20 28 6c 61 73 74 2d 75 70 64 . (last-upd
7530: 61 74 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ate (vector-ref
7540: 73 65 72 76 65 72 20 31 30 29 29 20 0a 09 09 20 server 10)) ...
7550: 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 (transport
7560: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
7570: 76 65 72 20 31 31 29 29 0a 09 09 20 20 20 20 20 ver 11))...
7580: 20 28 6b 69 6c 6c 65 64 20 20 20 20 20 23 66 29 (killed #f)
7590: 0a 09 09 20 20 20 20 20 20 28 73 74 61 74 75 73 ... (status
75a0: 20 20 20 20 20 28 3c 20 6c 61 73 74 2d 75 70 64 (< last-upd
75b0: 61 74 65 20 32 30 29 29 29 0a 09 09 20 3b 3b 20 ate 20)))... ;;
75c0: 20 20 28 7a 6d 71 2d 73 6f 63 6b 65 74 73 20 28 (zmq-sockets (
75d0: 69 66 20 73 74 61 74 75 73 20 28 73 65 72 76 65 if status (serve
75e0: 72 3a 63 6c 69 65 6e 74 2d 63 6f 6e 6e 65 63 74 r:client-connect
75f0: 20 68 6f 73 74 6e 61 6d 65 20 70 6f 72 74 29 20 hostname port)
7600: 23 66 29 29 29 0a 09 09 20 3b 3b 20 6e 6f 20 6e #f)))... ;; no n
7610: 65 65 64 20 74 6f 20 6c 6f 67 69 6e 20 61 73 20 eed to login as
7620: 73 74 61 74 75 73 20 6f 66 20 23 74 20 69 6e 64 status of #t ind
7630: 69 63 61 74 65 73 20 77 65 20 61 72 65 20 63 6f icates we are co
7640: 6e 6e 65 63 74 69 6e 67 20 74 6f 20 63 6f 72 72 nnecting to corr
7650: 65 63 74 20 0a 09 09 20 3b 3b 20 73 65 72 76 65 ect ... ;; serve
7660: 72 0a 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f r... (if (equal?
7670: 20 73 74 61 74 65 20 22 64 65 61 64 22 29 0a 09 state "dead")..
7680: 09 20 20 20 20 20 28 69 66 20 28 3e 20 6c 61 73 . (if (> las
7690: 74 2d 75 70 64 61 74 65 20 28 2a 20 32 35 20 36 t-update (* 25 6
76a0: 30 20 36 30 29 29 20 3b 3b 20 6b 65 65 70 20 72 0 60)) ;; keep r
76b0: 65 63 6f 72 64 73 20 61 72 6f 75 6e 64 20 66 6f ecords around fo
76c0: 72 20 73 6c 69 67 68 6c 79 20 6f 76 65 72 20 61 r slighly over a
76d0: 20 64 61 79 2e 0a 09 09 09 20 28 74 61 73 6b 73 day..... (tasks
76e0: 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 :server-deregist
76f0: 65 72 20 28 64 62 3a 64 65 6c 61 79 2d 69 66 2d er (db:delay-if-
7700: 62 75 73 79 20 74 64 62 64 61 74 29 20 68 6f 73 busy tdbdat) hos
7710: 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 74 3a 20 tname pullport:
7720: 70 75 6c 6c 70 6f 72 74 20 70 69 64 3a 20 70 69 pullport pid: pi
7730: 64 20 61 63 74 69 6f 6e 3a 20 27 64 65 6c 65 74 d action: 'delet
7740: 65 29 29 0a 09 09 20 20 20 20 20 28 69 66 20 28 e))... (if (
7750: 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 32 30 > last-update 20
7760: 29 20 20 20 20 20 20 20 20 3b 3b 20 4d 61 72 6b ) ;; Mark
7770: 20 61 73 20 64 65 61 64 20 69 66 20 6e 6f 74 20 as dead if not
7780: 75 70 64 61 74 65 64 20 69 6e 20 6c 61 73 74 20 updated in last
7790: 32 30 20 73 65 63 6f 6e 64 73 0a 09 09 09 20 28 20 seconds.... (
77a0: 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 tasks:server-der
77b0: 65 67 69 73 74 65 72 20 28 64 62 3a 64 65 6c 61 egister (db:dela
77c0: 79 2d 69 66 2d 62 75 73 79 20 74 64 62 64 61 74 y-if-busy tdbdat
77d0: 29 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 ) hostname pullp
77e0: 6f 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 70 69 ort: pullport pi
77f0: 64 3a 20 70 69 64 29 29 29 0a 09 09 20 28 66 6f d: pid)))... (fo
7800: 72 6d 61 74 20 23 74 20 66 6d 74 73 74 72 20 69 rmat #t fmtstr i
7810: 64 20 6d 74 2d 76 65 72 20 70 69 64 20 68 6f 73 d mt-ver pid hos
7820: 74 6e 61 6d 65 20 28 63 6f 6e 63 20 69 6e 74 65 tname (conc inte
7830: 72 66 61 63 65 20 22 3a 22 20 70 75 6c 6c 70 6f rface ":" pullpo
7840: 72 74 29 20 70 75 62 70 6f 72 74 20 6c 61 73 74 rt) pubport last
7850: 2d 75 70 64 61 74 65 0a 09 09 09 20 28 69 66 20 -update.... (if
7860: 73 74 61 74 75 73 20 22 61 6c 69 76 65 22 20 22 status "alive" "
7870: 64 65 61 64 22 29 20 74 72 61 6e 73 70 6f 72 74 dead") transport
7880: 29 0a 09 09 20 28 69 66 20 28 6f 72 20 28 65 71 )... (if (or (eq
7890: 75 61 6c 3f 20 69 64 20 73 69 64 29 0a 09 09 09 ual? id sid)....
78a0: 20 28 65 71 75 61 6c 3f 20 73 69 64 20 30 29 29 (equal? sid 0))
78b0: 20 3b 3b 20 6b 69 6c 6c 20 61 6c 6c 2f 61 6e 79 ;; kill all/any
78c0: 0a 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ... (begin..
78d0: 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
78e0: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
78f0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
7900: 41 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 6b 69 Attempting to ki
7910: 6c 6c 20 22 6b 69 6c 6c 2d 73 77 69 74 63 68 22 ll "kill-switch"
7920: 20 73 65 72 76 65 72 20 77 69 74 68 20 70 69 64 server with pid
7930: 20 22 20 70 69 64 29 0a 09 09 20 20 20 20 20 20 " pid)...
7940: 20 28 74 61 73 6b 73 3a 6b 69 6c 6c 2d 73 65 72 (tasks:kill-ser
7950: 76 65 72 20 68 6f 73 74 6e 61 6d 65 20 70 69 64 ver hostname pid
7960: 20 6b 69 6c 6c 2d 73 77 69 74 63 68 3a 20 6b 69 kill-switch: ki
7970: 6c 6c 2d 73 77 69 74 63 68 29 29 29 29 29 0a 09 ll-switch)))))..
7980: 20 20 20 20 20 73 65 72 76 65 72 73 29 0a 09 20 servers)..
7990: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
79a0: 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d info 1 *default-
79b0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 44 6f 6e 65 20 log-port* "Done
79c0: 77 69 74 68 20 6c 69 73 74 73 65 72 76 65 72 73 with listservers
79d0: 22 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 ").. (set! *d
79e0: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
79f0: 0a 09 20 20 20 20 28 65 78 69 74 29 29 20 3b 3b .. (exit)) ;;
7a00: 20 6d 75 73 74 20 64 6f 2c 20 77 6f 75 6c 64 20 must do, would
7a10: 68 61 76 65 20 74 6f 20 61 64 64 20 63 68 65 63 have to add chec
7a20: 6b 73 20 74 6f 20 6d 61 6e 79 2f 61 6c 6c 20 63 ks to many/all c
7a30: 61 6c 6c 73 20 62 65 6c 6f 77 0a 09 20 20 28 65 alls below.. (e
7a40: 78 69 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d xit))))..;;=====
7a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7a90: 3d 0a 3b 3b 20 57 65 69 72 64 20 73 70 65 63 69 =.;; Weird speci
7aa0: 61 6c 20 63 61 6c 6c 73 20 74 68 61 74 20 6e 65 al calls that ne
7ab0: 65 64 20 74 6f 20 72 75 6e 20 2a 61 66 74 65 72 ed to run *after
7ac0: 2a 20 74 68 65 20 73 65 72 76 65 72 20 68 61 73 * the server has
7ad0: 20 73 74 61 72 74 65 64 3f 0a 3b 3b 3d 3d 3d 3d started?.;;====
7ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b20: 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ==..(if (args:ge
7b30: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 74 61 72 t-arg "-list-tar
7b40: 67 65 74 73 22 29 0a 20 20 20 20 28 69 66 20 28 gets"). (if (
7b50: 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 0a 20 20 launch:setup).
7b60: 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 61 72 (let ((tar
7b70: 67 65 74 73 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 gets (common:get
7b80: 2d 72 75 6e 63 6f 6e 66 69 67 2d 74 61 72 67 65 -runconfig-targe
7b90: 74 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ts))).
7ba0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 2a (debug:print 1 *
7bb0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
7bc0: 2a 20 22 46 6f 75 6e 64 20 22 28 6c 65 6e 67 74 * "Found "(lengt
7bd0: 68 20 74 61 72 67 65 74 73 29 20 22 20 74 61 72 h targets) " tar
7be0: 67 65 74 73 22 29 0a 20 20 20 20 20 20 20 20 20 gets").
7bf0: 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e (case (string->
7c00: 73 79 6d 62 6f 6c 20 28 6f 72 20 28 61 72 67 73 symbol (or (args
7c10: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
7c20: 6f 64 65 22 29 20 22 61 6c 69 73 74 22 29 29 0a ode") "alist")).
7c30: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 61 6c ((al
7c40: 69 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 ist).
7c50: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
7c60: 62 64 61 20 28 78 29 0a 20 20 20 20 20 20 20 20 bda (x).
7c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c80: 20 3b 3b 20 28 70 72 69 6e 74 20 22 5b 22 20 78 ;; (print "[" x
7c90: 20 22 5d 22 29 29 0a 20 20 20 20 20 20 20 20 20 "]")).
7ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7cb0: 28 70 72 69 6e 74 20 78 29 29 0a 20 20 20 20 20 (print x)).
7cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7cd0: 20 20 74 61 72 67 65 74 73 29 29 0a 20 20 20 20 targets)).
7ce0: 20 20 20 20 20 20 20 20 28 28 6a 73 6f 6e 29 0a ((json).
7cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6a 73 (js
7d00: 6f 6e 2d 77 72 69 74 65 20 74 61 72 67 65 74 73 on-write targets
7d10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
7d20: 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else.
7d30: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
7d40: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
7d50: 6c 6f 67 2d 70 6f 72 74 2a 20 22 64 75 6d 70 20 log-port* "dump
7d60: 6f 75 74 70 75 74 20 66 6f 72 6d 61 74 20 22 20 output format "
7d70: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7d80: 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f 74 dumpmode") " not
7d90: 20 73 75 70 70 6f 72 74 65 64 20 66 6f 72 20 2d supported for -
7da0: 6c 69 73 74 2d 74 61 72 67 65 74 73 22 29 29 29 list-targets")))
7db0: 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 . (set!
7dc0: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
7dd0: 23 74 29 29 29 29 0a 0a 3b 3b 20 63 61 63 68 65 #t))))..;; cache
7de0: 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 73 20 the runconfigs
7df0: 69 6e 20 24 4d 54 5f 4c 49 4e 4b 54 52 45 45 2f in $MT_LINKTREE/
7e00: 24 4d 54 5f 54 41 52 47 45 54 2f 24 4d 54 5f 52 $MT_TARGET/$MT_R
7e10: 55 4e 4e 41 4d 45 2f 2e 72 75 6e 63 6f 6e 66 69 UNNAME/.runconfi
7e20: 67 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 66 75 g.;;.(define (fu
7e30: 6c 6c 2d 72 75 6e 63 6f 6e 66 69 67 73 2d 72 65 ll-runconfigs-re
7e40: 61 64 29 0a 3b 3b 20 69 6e 20 74 68 65 20 65 6e ad).;; in the en
7e50: 76 70 72 6f 63 65 73 73 69 6e 67 20 62 72 61 6e vprocessing bran
7e60: 63 68 20 74 68 65 20 62 65 6c 6f 77 20 63 6f 64 ch the below cod
7e70: 65 20 72 65 70 6c 61 63 65 73 20 74 68 65 20 66 e replaces the f
7e80: 75 72 74 68 65 72 20 62 65 6c 6f 77 20 63 6f 64 urther below cod
7e90: 65 0a 3b 3b 20 20 28 69 66 20 28 65 71 3f 20 2a e.;; (if (eq? *
7ea0: 63 6f 6e 66 69 67 73 74 61 74 75 73 2a 20 27 66 configstatus* 'f
7eb0: 75 6c 6c 64 61 74 61 29 0a 3b 3b 20 20 20 20 20 ulldata).;;
7ec0: 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 0a *runconfigdat*.
7ed0: 3b 3b 20 20 20 20 20 20 28 62 65 67 69 6e 0a 3b ;; (begin.;
7ee0: 3b 09 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 ;.(launch:setup)
7ef0: 0a 3b 3b 09 2a 72 75 6e 63 6f 6e 66 69 67 64 61 .;;.*runconfigda
7f00: 74 2a 29 29 29 0a 0a 20 20 28 6c 65 74 2a 20 28 t*))).. (let* (
7f10: 28 72 75 6e 64 69 72 20 28 69 66 20 28 61 6e 64 (rundir (if (and
7f20: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 4c 49 4e (getenv "MT_LIN
7f30: 4b 54 52 45 45 22 29 28 67 65 74 65 6e 76 20 22 KTREE")(getenv "
7f40: 4d 54 5f 54 41 52 47 45 54 22 29 28 67 65 74 65 MT_TARGET")(gete
7f50: 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 29 nv "MT_RUNNAME")
7f60: 29 0a 09 09 20 20 20 20 20 28 63 6f 6e 63 20 28 )... (conc (
7f70: 67 65 74 65 6e 76 20 22 4d 54 5f 4c 49 4e 4b 54 getenv "MT_LINKT
7f80: 52 45 45 22 29 20 22 2f 22 20 28 67 65 74 65 6e REE") "/" (geten
7f90: 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 20 22 v "MT_TARGET") "
7fa0: 2f 22 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 /" (getenv "MT_R
7fb0: 55 4e 4e 41 4d 45 22 29 29 0a 09 09 20 20 20 20 UNNAME"))...
7fc0: 20 23 66 29 29 0a 09 20 28 63 66 67 66 20 20 20 #f)).. (cfgf
7fd0: 28 69 66 20 72 75 6e 64 69 72 20 28 63 6f 6e 63 (if rundir (conc
7fe0: 20 72 75 6e 64 69 72 20 22 2f 2e 72 75 6e 63 6f rundir "/.runco
7ff0: 6e 66 69 67 2e 22 20 6d 65 67 61 74 65 73 74 2d nfig." megatest-
8000: 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 61 version "-" mega
8010: 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 test-fossil-hash
8020: 29 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 ) #f))). (if
8030: 28 61 6e 64 20 63 66 67 66 0a 09 20 20 20 20 20 (and cfgf..
8040: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 63 66 (file-exists? cf
8050: 67 66 29 0a 09 20 20 20 20 20 28 66 69 6c 65 2d gf).. (file-
8060: 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 63 66 write-access? cf
8070: 67 66 29 29 0a 09 28 63 6f 6e 66 69 67 66 3a 72 gf))..(configf:r
8080: 65 61 64 2d 61 6c 69 73 74 20 63 66 67 66 29 0a ead-alist cfgf).
8090: 09 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 .(let* ((keys
80a0: 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 0a (rmt:get-keys)).
80b0: 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 20 . (target
80c0: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
80d0: 2d 74 61 72 67 65 74 29 29 0a 09 20 20 20 20 20 -target))..
80e0: 20 20 28 6b 65 79 2d 76 61 6c 73 20 28 69 66 20 (key-vals (if
80f0: 74 61 72 67 65 74 20 28 6b 65 79 73 3a 74 61 72 target (keys:tar
8100: 67 65 74 2d 3e 6b 65 79 76 61 6c 20 6b 65 79 73 get->keyval keys
8110: 20 74 61 72 67 65 74 29 20 23 66 29 29 0a 09 20 target) #f))..
8120: 20 20 20 20 20 20 28 73 65 63 74 69 6f 6e 73 20 (sections
8130: 28 69 66 20 74 61 72 67 65 74 20 28 6c 69 73 74 (if target (list
8140: 20 22 64 65 66 61 75 6c 74 22 20 74 61 72 67 65 "default" targe
8150: 74 29 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 t) #f))..
8160: 28 64 61 74 61 20 20 20 20 20 28 62 65 67 69 6e (data (begin
8170: 0a 09 09 09 20 20 20 28 73 65 74 65 6e 76 20 22 .... (setenv "
8180: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
8190: 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 09 09 " *toppath*)....
81a0: 20 20 20 28 69 66 20 6b 65 79 2d 76 61 6c 73 0a (if key-vals.
81b0: 09 09 09 20 20 20 20 20 20 20 28 66 6f 72 2d 65 ... (for-e
81c0: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 74 29 ach (lambda (kt)
81d0: 0a 09 09 09 09 09 20 20 20 28 73 65 74 65 6e 76 ...... (setenv
81e0: 20 28 63 61 72 20 6b 74 29 20 28 63 61 64 72 20 (car kt) (cadr
81f0: 6b 74 29 29 29 0a 09 09 09 09 09 20 6b 65 79 2d kt)))...... key-
8200: 76 61 6c 73 29 29 0a 09 09 09 20 20 20 28 72 65 vals)).... (re
8210: 61 64 2d 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 ad-config (conc
8220: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e 63 *toppath* "/runc
8230: 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 20 onfigs.config")
8240: 23 66 20 23 74 20 73 65 63 74 69 6f 6e 73 3a 20 #f #t sections:
8250: 73 65 63 74 69 6f 6e 73 29 29 29 29 0a 09 20 20 sections))))..
8260: 28 69 66 20 28 61 6e 64 20 72 75 6e 64 69 72 20 (if (and rundir
8270: 3b 3b 20 68 61 76 65 20 61 6c 6c 20 6e 65 65 64 ;; have all need
8280: 65 64 20 76 61 72 69 61 62 6c 65 73 73 0a 09 09 ed variabless...
8290: 20 20 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 (directory-ex
82a0: 69 73 74 73 3f 20 72 75 6e 64 69 72 29 0a 09 09 ists? rundir)...
82b0: 20 20 20 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 (file-write-a
82c0: 63 63 65 73 73 3f 20 72 75 6e 64 69 72 29 29 0a ccess? rundir)).
82d0: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
82e0: 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 (configf:write-a
82f0: 6c 69 73 74 20 64 61 74 61 20 63 66 67 66 29 0a list data cfgf).
8300: 09 09 3b 3b 20 66 6f 72 63 65 20 72 65 2d 72 65 ..;; force re-re
8310: 61 64 20 6f 66 20 6d 65 67 61 74 65 73 74 2e 63 ad of megatest.c
8320: 6f 6e 66 69 67 20 2d 20 74 68 69 73 20 72 65 73 onfig - this res
8330: 6f 6c 76 65 73 20 63 69 72 63 75 6c 61 72 20 72 olves circular r
8340: 65 66 65 72 65 6e 63 65 73 20 62 65 74 77 65 65 eferences betwee
8350: 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 n megatest.confi
8360: 67 0a 09 09 28 6c 61 75 6e 63 68 3a 73 65 74 75 g...(launch:setu
8370: 70 20 66 6f 72 63 65 3a 20 23 74 29 0a 09 09 28 p force: #t)...(
8380: 6c 61 75 6e 63 68 3a 63 61 63 68 65 2d 63 6f 6e launch:cache-con
8390: 66 69 67 29 29 29 20 3b 3b 20 77 65 20 63 61 6e fig))) ;; we can
83a0: 20 73 61 66 65 6c 79 20 63 61 63 68 65 20 6d 65 safely cache me
83b0: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 73 69 gatest.config si
83c0: 6e 63 65 20 77 65 20 68 61 76 65 20 61 20 76 61 nce we have a va
83d0: 6c 69 64 20 72 75 6e 63 6f 6e 66 69 67 0a 09 20 lid runconfig..
83e0: 20 64 61 74 61 29 29 29 29 0a 0a 28 69 66 20 28 data))))..(if (
83f0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
8400: 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 22 29 0a how-runconfig").
8410: 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 28 6c (let ((tl (l
8420: 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 0a 20 aunch:setup))).
8430: 20 20 20 20 20 28 70 75 73 68 2d 64 69 72 65 63 (push-direc
8440: 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 0a tory *toppath*).
8450: 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 61 74 (let ((dat
8460: 61 20 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e 66 69 a (full-runconfi
8470: 67 73 2d 72 65 61 64 29 29 29 0a 09 3b 3b 20 6b gs-read)))..;; k
8480: 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 eep this one loc
8490: 61 6c 0a 09 28 63 6f 6e 64 0a 09 20 28 28 61 6e al..(cond.. ((an
84a0: 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
84b0: 22 2d 73 65 63 74 69 6f 6e 22 29 0a 09 20 20 20 "-section")..
84c0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
84d0: 67 20 22 2d 76 61 72 22 29 29 0a 09 20 20 28 6c g "-var")).. (l
84e0: 65 74 20 28 28 76 61 6c 20 28 6f 72 20 28 63 6f et ((val (or (co
84f0: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 nfigf:lookup dat
8500: 61 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 a (args:get-arg
8510: 22 2d 73 65 63 74 69 6f 6e 22 29 28 61 72 67 73 "-section")(args
8520: 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 :get-arg "-var")
8530: 29 0a 09 09 09 20 28 63 6f 6e 66 69 67 66 3a 6c ).... (configf:l
8540: 6f 6f 6b 75 70 20 64 61 74 61 20 22 64 65 66 61 ookup data "defa
8550: 75 6c 74 22 20 28 61 72 67 73 3a 67 65 74 2d 61 ult" (args:get-a
8560: 72 67 20 22 2d 76 61 72 22 29 29 29 29 29 0a 09 rg "-var")))))..
8570: 20 20 20 20 28 69 66 20 76 61 6c 20 28 70 72 69 (if val (pri
8580: 6e 74 20 76 61 6c 29 29 29 29 0a 09 20 28 28 6e nt val)))).. ((n
8590: 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
85a0: 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 29 0a 09 "-dumpmode"))..
85b0: 20 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c (pp (hash-tabl
85c0: 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 29 29 29 e->alist data)))
85d0: 0a 09 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 .. ((string=? (a
85e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
85f0: 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 29 mpmode") "json")
8600: 0a 09 20 20 28 6a 73 6f 6e 2d 77 72 69 74 65 20 .. (json-write
8610: 64 61 74 61 29 29 0a 09 20 28 28 73 74 72 69 6e data)).. ((strin
8620: 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 g=? (args:get-ar
8630: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
8640: 69 6e 69 22 29 0a 09 20 20 28 63 6f 6e 66 69 67 ini").. (config
8650: 66 3a 63 6f 6e 66 69 67 2d 3e 69 6e 69 20 64 61 f:config->ini da
8660: 74 61 29 29 0a 09 20 28 65 6c 73 65 0a 09 20 20 ta)).. (else..
8670: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
8680: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
8690: 67 2d 70 6f 72 74 2a 20 22 2d 64 75 6d 70 6d 6f g-port* "-dumpmo
86a0: 64 65 20 6f 66 20 22 20 28 61 72 67 73 3a 67 65 de of " (args:ge
86b0: 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 t-arg "-dumpmode
86c0: 22 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 6e 69 ") " not recogni
86d0: 73 65 64 22 29 29 29 0a 09 28 73 65 74 21 20 2a sed")))..(set! *
86e0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
86f0: 29 29 0a 20 20 20 20 20 20 28 70 6f 70 2d 64 69 )). (pop-di
8700: 72 65 63 74 6f 72 79 29 29 29 0a 0a 28 69 66 20 rectory)))..(if
8710: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8720: 73 68 6f 77 2d 63 6f 6e 66 69 67 22 29 0a 20 20 show-config").
8730: 20 20 28 6c 65 74 20 28 28 74 6c 20 20 20 28 6c (let ((tl (l
8740: 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 aunch:setup))..
8750: 20 28 64 61 74 61 20 2a 63 6f 6e 66 69 67 64 61 (data *configda
8760: 74 2a 29 29 20 3b 3b 20 28 72 65 61 64 2d 63 6f t*)) ;; (read-co
8770: 6e 66 69 67 20 22 6d 65 67 61 74 65 73 74 2e 63 nfig "megatest.c
8780: 6f 6e 66 69 67 22 20 23 66 20 23 74 29 29 29 0a onfig" #f #t))).
8790: 20 20 20 20 20 20 28 70 75 73 68 2d 64 69 72 65 (push-dire
87a0: 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 ctory *toppath*)
87b0: 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 . ;; keep t
87c0: 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 his one local.
87d0: 20 20 20 20 28 63 6f 6e 64 20 0a 20 20 20 20 20 (cond .
87e0: 20 20 28 28 61 6e 64 20 28 61 72 67 73 3a 67 65 ((and (args:ge
87f0: 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 t-arg "-section"
8800: 29 0a 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 ).. (args:ge
8810: 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 0a 09 t-arg "-var"))..
8820: 28 6c 65 74 20 28 28 76 61 6c 20 28 63 6f 6e 66 (let ((val (conf
8830: 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 61 20 igf:lookup data
8840: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8850: 73 65 63 74 69 6f 6e 22 29 28 61 72 67 73 3a 67 section")(args:g
8860: 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 29 et-arg "-var")))
8870: 29 0a 09 20 20 28 69 66 20 76 61 6c 20 28 70 72 ).. (if val (pr
8880: 69 6e 74 20 76 61 6c 29 29 29 29 0a 0a 20 20 20 int val))))..
8890: 20 20 20 20 3b 3b 20 70 72 69 6e 74 20 6a 75 73 ;; print jus
88a0: 74 20 61 20 73 65 63 74 69 6f 6e 20 69 66 20 6f t a section if o
88b0: 6e 6c 79 20 2d 73 65 63 74 69 6f 6e 0a 0a 20 20 nly -section..
88c0: 20 20 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 ((not (args
88d0: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
88e0: 6f 64 65 22 29 29 0a 09 28 70 70 20 28 68 61 73 ode"))..(pp (has
88f0: 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 64 h-table->alist d
8900: 61 74 61 29 29 29 0a 20 20 20 20 20 20 20 28 28 ata))). ((
8910: 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 string=? (args:g
8920: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
8930: 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 28 6a 73 e") "json")..(js
8940: 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 29 29 0a on-write data)).
8950: 20 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 3d ((string=
8960: 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ? (args:get-arg
8970: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 69 6e "-dumpmode") "in
8980: 69 22 29 0a 09 28 63 6f 6e 66 69 67 66 3a 63 6f i")..(configf:co
8990: 6e 66 69 67 2d 3e 69 6e 69 20 64 61 74 61 29 29 nfig->ini data))
89a0: 0a 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 . (else..(
89b0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
89c0: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
89d0: 2d 70 6f 72 74 2a 20 22 2d 64 75 6d 70 6d 6f 64 -port* "-dumpmod
89e0: 65 20 6f 66 20 22 20 28 61 72 67 73 3a 67 65 74 e of " (args:get
89f0: 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 -arg "-dumpmode"
8a00: 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 6e 69 73 ) " not recognis
8a10: 65 64 22 29 29 29 0a 20 20 20 20 20 20 28 73 65 ed"))). (se
8a20: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
8a30: 2a 20 23 74 29 0a 20 20 20 20 20 20 28 70 6f 70 * #t). (pop
8a40: 2d 64 69 72 65 63 74 6f 72 79 29 29 29 0a 0a 28 -directory)))..(
8a50: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
8a60: 20 22 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 6f 22 "-show-cmdinfo"
8a70: 29 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 61 ). (if (or (a
8a80: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 76 61 rgs:get-arg ":va
8a90: 6c 75 65 22 29 28 67 65 74 65 6e 76 20 22 4d 54 lue")(getenv "MT
8aa0: 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 28 6c 65 _CMDINFO"))..(le
8ab0: 74 20 28 28 64 61 74 61 20 28 63 6f 6d 6d 6f 6e t ((data (common
8ac0: 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 74 :read-encoded-st
8ad0: 72 69 6e 67 20 28 6f 72 20 28 61 72 67 73 3a 67 ring (or (args:g
8ae0: 65 74 2d 61 72 67 20 22 3a 76 61 6c 75 65 22 29 et-arg ":value")
8af0: 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (getenv "MT_CMDI
8b00: 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 28 69 66 NFO"))))).. (if
8b10: 20 28 65 71 75 61 6c 3f 20 28 61 72 67 73 3a 67 (equal? (args:g
8b20: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
8b30: 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 20 20 20 e") "json")..
8b40: 20 20 20 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 (json-write d
8b50: 61 74 61 29 0a 09 20 20 20 20 20 20 28 70 70 20 ata).. (pp
8b60: 64 61 74 61 29 29 0a 09 20 20 28 73 65 74 21 20 data)).. (set!
8b70: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
8b80: 74 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e t))..(debug:prin
8b90: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
8ba0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 65 6e 76 t-log-port* "env
8bb0: 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c ironment variabl
8bc0: 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 69 73 20 e MT_CMDINFO is
8bd0: 6e 6f 74 20 73 65 74 22 29 29 29 0a 0a 3b 3b 3d not set")))..;;=
8be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c20: 3d 3d 3d 3d 3d 0a 3b 3b 20 52 65 6d 6f 76 65 20 =====.;; Remove
8c30: 6f 6c 64 20 72 75 6e 28 73 29 0a 3b 3b 3d 3d 3d old run(s).;;===
8c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c80: 3d 3d 3d 0a 0a 3b 3b 20 73 69 6e 63 65 20 73 65 ===..;; since se
8c90: 76 65 72 61 6c 20 61 63 74 69 6f 6e 73 20 63 61 veral actions ca
8ca0: 6e 20 62 65 20 73 70 65 63 69 66 69 65 64 20 6f n be specified o
8cb0: 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 6c 69 n the command li
8cc0: 6e 65 20 74 68 65 20 72 65 6d 6f 76 61 6c 0a 3b ne the removal.;
8cd0: 3b 20 69 73 20 64 6f 6e 65 20 66 69 72 73 74 0a ; is done first.
8ce0: 28 64 65 66 69 6e 65 20 28 6f 70 65 72 61 74 65 (define (operate
8cf0: 2d 6f 6e 20 61 63 74 69 6f 6e 29 0a 20 20 28 6c -on action). (l
8d00: 65 74 2a 20 28 28 72 75 6e 72 65 63 20 28 72 75 et* ((runrec (ru
8d10: 6e 73 3a 72 75 6e 72 65 63 2d 6d 61 6b 65 2d 72 ns:runrec-make-r
8d20: 65 63 6f 72 64 29 29 0a 09 20 28 74 61 72 67 65 ecord)).. (targe
8d30: 74 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 t (common:args-g
8d40: 65 74 2d 74 61 72 67 65 74 29 29 29 0a 20 20 20 et-target))).
8d50: 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 6e 6f (cond. ((no
8d60: 74 20 74 61 72 67 65 74 29 0a 20 20 20 20 20 20 t target).
8d70: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
8d80: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
8d90: 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 69 6e 67 g-port* "Missing
8da0: 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 required parame
8db0: 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f 6e ter for " action
8dc0: 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 ", you must spe
8dd0: 63 69 66 79 20 2d 74 61 72 67 65 74 20 6f 72 20 cify -target or
8de0: 2d 72 65 71 74 61 72 67 22 29 0a 20 20 20 20 20 -reqtarg").
8df0: 20 28 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 (exit 1)).
8e00: 28 28 6e 6f 74 20 28 6f 72 20 28 61 72 67 73 3a ((not (or (args:
8e10: 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d get-arg ":runnam
8e20: 65 22 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 e").. (arg
8e30: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
8e40: 61 6d 65 22 29 29 29 0a 20 20 20 20 20 20 28 64 ame"))). (d
8e50: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
8e60: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
8e70: 70 6f 72 74 2a 20 22 4d 69 73 73 69 6e 67 20 72 port* "Missing r
8e80: 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 74 65 equired paramete
8e90: 72 20 66 6f 72 20 22 20 61 63 74 69 6f 6e 20 22 r for " action "
8ea0: 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 69 , you must speci
8eb0: 66 79 20 74 68 65 20 72 75 6e 20 6e 61 6d 65 20 fy the run name
8ec0: 70 61 74 74 65 72 6e 20 77 69 74 68 20 2d 72 75 pattern with -ru
8ed0: 6e 6e 61 6d 65 20 70 61 74 74 22 29 0a 20 20 20 nname patt").
8ee0: 20 20 20 28 65 78 69 74 20 32 29 29 0a 20 20 20 (exit 2)).
8ef0: 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 ((not (args:ge
8f00: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
8f10: 22 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 ")). (debug
8f20: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
8f30: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
8f40: 2a 20 22 4d 69 73 73 69 6e 67 20 72 65 71 75 69 * "Missing requi
8f50: 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 6f red parameter fo
8f60: 72 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f r " action ", yo
8f70: 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 74 u must specify t
8f80: 68 65 20 74 65 73 74 20 70 61 74 74 65 72 6e 20 he test pattern
8f90: 77 69 74 68 20 2d 74 65 73 74 70 61 74 74 22 29 with -testpatt")
8fa0: 0a 20 20 20 20 20 20 28 65 78 69 74 20 33 29 29 . (exit 3))
8fb0: 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 . (else.
8fc0: 20 20 28 69 66 20 28 6e 6f 74 20 28 63 61 72 20 (if (not (car
8fd0: 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 29 0a 09 *configinfo*))..
8fe0: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 (begin.. (d
8ff0: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
9000: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
9010: 70 6f 72 74 2a 20 22 41 74 74 65 6d 70 74 65 64 port* "Attempted
9020: 20 22 20 61 63 74 69 6f 6e 20 22 6f 6e 20 74 65 " action "on te
9030: 73 74 28 73 29 20 62 75 74 20 72 75 6e 20 61 72 st(s) but run ar
9040: 65 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e ea config file n
9050: 6f 74 20 66 6f 75 6e 64 22 29 0a 09 20 20 20 20 ot found")..
9060: 28 65 78 69 74 20 31 29 29 0a 09 20 20 3b 3b 20 (exit 1)).. ;;
9070: 70 75 74 20 74 65 73 74 20 70 61 72 61 6d 65 74 put test paramet
9080: 65 72 73 20 69 6e 74 6f 20 63 6f 6e 76 65 6e 69 ers into conveni
9090: 65 6e 74 20 76 61 72 69 61 62 6c 65 73 0a 09 20 ent variables..
90a0: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 3b 3b 20 (begin.. ;;
90b0: 63 68 65 63 6b 20 66 6f 72 20 63 6f 72 72 65 63 check for correc
90c0: 74 20 76 65 72 73 69 6f 6e 2c 20 65 78 69 74 20 t version, exit
90d0: 77 69 74 68 20 6d 65 73 73 61 67 65 20 69 66 20 with message if
90e0: 6e 6f 74 20 63 6f 72 72 65 63 74 0a 09 20 20 20 not correct..
90f0: 20 28 63 6f 6d 6d 6f 6e 3a 65 78 69 74 2d 6f 6e (common:exit-on
9100: 2d 76 65 72 73 69 6f 6e 2d 63 68 61 6e 67 65 64 -version-changed
9110: 29 0a 09 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 ).. (runs:ope
9120: 72 61 74 65 2d 6f 6e 20 20 61 63 74 69 6f 6e 0a rate-on action.
9130: 09 09 09 20 20 20 20 20 20 74 61 72 67 65 74 0a ... target.
9140: 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e ... (common
9150: 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d :args-get-runnam
9160: 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 e) ;; (or (args
9170: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 :get-arg "-runna
9180: 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 me")(args:get-ar
9190: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g ":runname"))..
91a0: 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a .. (common:
91b0: 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 args-get-testpat
91c0: 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 t #f) ;; (args:g
91d0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
91e0: 74 22 29 0a 09 09 09 20 20 20 20 20 20 73 74 61 t").... sta
91f0: 74 65 3a 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 te: (common:args
9200: 2d 67 65 74 2d 73 74 61 74 65 29 0a 09 09 09 20 -get-state)....
9210: 20 20 20 20 20 73 74 61 74 75 73 3a 20 28 63 6f status: (co
9220: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 73 74 mmon:args-get-st
9230: 61 74 75 73 29 0a 09 09 09 20 20 20 20 20 20 6e atus).... n
9240: 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a ew-state-status:
9250: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9260: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
9270: 73 22 29 29 29 29 0a 20 20 20 20 20 20 28 73 65 s")))). (se
9280: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
9290: 2a 20 23 74 29 29 29 29 29 0a 0a 28 69 66 20 28 * #t)))))..(if (
92a0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
92b0: 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a 20 20 20 emove-runs").
92c0: 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 (general-run-ca
92d0: 6c 6c 20 0a 20 20 20 20 20 22 2d 72 65 6d 6f 76 ll . "-remov
92e0: 65 2d 72 75 6e 73 22 0a 20 20 20 20 20 22 72 65 e-runs". "re
92f0: 6d 6f 76 65 20 72 75 6e 73 22 0a 20 20 20 20 20 move runs".
9300: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
9310: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
9320: 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6f 70 vals). (op
9330: 65 72 61 74 65 2d 6f 6e 20 27 72 65 6d 6f 76 65 erate-on 'remove
9340: 2d 72 75 6e 73 29 29 29 29 0a 0a 28 69 66 20 28 -runs))))..(if (
9350: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
9360: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 et-state-status"
9370: 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 ). (general-r
9380: 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d un-call . "-
9390: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
93a0: 22 0a 20 20 20 20 20 22 73 65 74 20 73 74 61 74 ". "set stat
93b0: 65 20 61 6e 64 20 73 74 61 74 75 73 22 0a 20 20 e and status".
93c0: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
93d0: 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
93e0: 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 keyvals).
93f0: 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 (operate-on 'set
9400: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 29 29 -state-status)))
9410: 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 )..(if (or (args
9420: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 72 :get-arg "-set-r
9430: 75 6e 2d 73 74 61 74 75 73 22 29 0a 09 28 61 72 un-status")..(ar
9440: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 74 gs:get-arg "-get
9450: 2d 72 75 6e 2d 73 74 61 74 75 73 22 29 29 0a 20 -run-status")).
9460: 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
9470: 63 61 6c 6c 0a 20 20 20 20 20 22 2d 73 65 74 2d call. "-set-
9480: 72 75 6e 2d 73 74 61 74 75 73 22 0a 20 20 20 20 run-status".
9490: 20 22 73 65 74 20 72 75 6e 20 73 74 61 74 75 73 "set run status
94a0: 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ". (lambda (
94b0: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
94c0: 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 eys keyvals).
94d0: 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 (let* ((runs
94e0: 64 61 74 20 20 28 72 6d 74 3a 67 65 74 2d 72 75 dat (rmt:get-ru
94f0: 6e 73 2d 62 79 2d 70 61 74 74 20 6b 65 79 73 20 ns-by-patt keys
9500: 72 75 6e 6e 61 6d 65 20 0a 09 09 09 09 09 28 63 runname ......(c
9510: 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 ommon:args-get-t
9520: 61 72 67 65 74 29 0a 09 09 09 09 09 23 66 20 23 arget)......#f #
9530: 66 20 23 66 20 23 66 29 29 0a 09 20 20 20 20 20 f #f #f))..
9540: 20 28 68 65 61 64 65 72 20 20 20 28 76 65 63 74 (header (vect
9550: 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 30 or-ref runsdat 0
9560: 29 29 0a 09 20 20 20 20 20 20 28 72 6f 77 73 20 )).. (rows
9570: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
9580: 72 75 6e 73 64 61 74 20 31 29 29 29 0a 09 20 28 runsdat 1))).. (
9590: 69 66 20 28 6e 75 6c 6c 3f 20 72 6f 77 73 29 0a if (null? rows).
95a0: 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 . (begin..
95b0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
95c0: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
95d0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f 20 t-log-port* "No
95e0: 6d 61 74 63 68 69 6e 67 20 72 75 6e 20 66 6f 75 matching run fou
95f0: 6e 64 2e 22 29 0a 09 20 20 20 20 20 20 20 28 65 nd.").. (e
9600: 78 69 74 20 31 29 29 0a 09 20 20 20 20 20 28 6c xit 1)).. (l
9610: 65 74 2a 20 28 28 72 6f 77 20 20 20 20 20 20 28 et* ((row (
9620: 63 61 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 car (vector-ref
9630: 72 75 6e 73 64 61 74 20 31 29 29 29 0a 09 09 20 runsdat 1)))...
9640: 20 20 20 28 72 75 6e 2d 69 64 20 20 20 28 64 62 (run-id (db
9650: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
9660: 61 64 65 72 20 72 6f 77 20 68 65 61 64 65 72 20 ader row header
9670: 22 69 64 22 29 29 29 0a 09 20 20 20 20 20 20 20 "id")))..
9680: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
9690: 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 g "-set-run-stat
96a0: 75 73 22 29 0a 09 09 20 20 20 28 72 6d 74 3a 73 us")... (rmt:s
96b0: 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 72 75 et-run-status ru
96c0: 6e 2d 69 64 20 28 61 72 67 73 3a 67 65 74 2d 61 n-id (args:get-a
96d0: 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 rg "-set-run-sta
96e0: 74 75 73 22 29 20 6d 73 67 3a 20 28 61 72 67 73 tus") msg: (args
96f0: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a :get-arg "-m")).
9700: 09 09 20 20 20 28 70 72 69 6e 74 20 28 72 6d 74 .. (print (rmt
9710: 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 :get-run-status
9720: 72 75 6e 2d 69 64 29 29 0a 09 09 20 20 20 29 29 run-id))... ))
9730: 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d )))))..;;=======
9740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
9780: 3b 3b 20 51 75 65 72 79 20 72 75 6e 73 0a 3b 3b ;; Query runs.;;
9790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97d0: 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 2d 66 69 65 6c ======..;; -fiel
97e0: 64 73 20 72 75 6e 73 3a 69 64 2c 74 61 72 67 65 ds runs:id,targe
97f0: 74 2c 72 75 6e 6e 61 6d 65 2c 63 6f 6d 6d 65 6e t,runname,commen
9800: 74 2b 74 65 73 74 73 3a 69 64 2c 74 65 73 74 6e t+tests:id,testn
9810: 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2b 73 74 ame,item_path+st
9820: 65 70 73 0a 3b 3b 0a 3b 3b 20 63 73 69 3e 20 28 eps.;;.;; csi> (
9830: 65 78 74 72 61 63 74 2d 66 69 65 6c 64 73 2d 63 extract-fields-c
9840: 6f 6e 73 74 72 61 69 6e 74 73 20 22 72 75 6e 73 onstraints "runs
9850: 3a 69 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 :id,target,runna
9860: 6d 65 2c 63 6f 6d 6d 65 6e 74 2b 74 65 73 74 73 me,comment+tests
9870: 3a 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 :id,testname,ite
9880: 6d 5f 70 61 74 68 2b 73 74 65 70 73 22 29 0a 3b m_path+steps").;
9890: 3b 20 20 20 20 20 20 20 20 20 3d 3e 20 28 28 22 ; => (("
98a0: 72 75 6e 73 22 20 22 69 64 22 20 22 74 61 72 67 runs" "id" "targ
98b0: 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 63 et" "runname" "c
98c0: 6f 6d 6d 65 6e 74 22 29 20 28 22 74 65 73 74 73 omment") ("tests
98d0: 22 20 22 69 64 22 20 22 74 65 73 74 6e 61 6d 65 " "id" "testname
98e0: 22 20 22 69 74 65 6d 5f 70 61 74 68 22 29 20 28 " "item_path") (
98f0: 22 73 74 65 70 73 22 29 29 0a 3b 3b 0a 3b 3b 20 "steps")).;;.;;
9900: 20 20 4e 4f 54 45 3a 20 72 65 6d 65 6d 62 65 72 NOTE: remember
9910: 20 74 68 61 74 20 74 68 65 20 63 64 72 20 77 69 that the cdr wi
9920: 6c 6c 20 62 65 20 74 68 65 20 6c 69 73 74 20 79 ll be the list y
9930: 6f 75 20 65 78 70 65 63 74 20 28 63 64 72 20 28 ou expect (cdr (
9940: 22 72 75 6e 73 22 20 22 69 64 22 20 22 74 61 72 "runs" "id" "tar
9950: 67 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 get" "runname" "
9960: 63 6f 6d 6d 65 6e 74 22 29 29 20 3d 3e 20 28 22 comment")) => ("
9970: 69 64 22 20 22 74 61 72 67 65 74 22 20 22 72 75 id" "target" "ru
9980: 6e 6e 61 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 nname" "comment"
9990: 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 61 6e 64 ).;; and
99a0: 20 73 6f 20 61 6c 69 73 74 2d 72 65 66 20 77 69 so alist-ref wi
99b0: 6c 6c 20 79 69 65 6c 64 20 77 68 61 74 20 79 6f ll yield what yo
99c0: 75 20 65 78 70 65 63 74 0a 3b 3b 0a 28 64 65 66 u expect.;;.(def
99d0: 69 6e 65 20 28 65 78 74 72 61 63 74 2d 66 69 65 ine (extract-fie
99e0: 6c 64 73 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 lds-constraints
99f0: 66 69 65 6c 64 73 2d 73 70 65 63 29 0a 20 20 28 fields-spec). (
9a00: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 74 61 62 map (lambda (tab
9a10: 6c 65 2d 73 70 65 63 29 20 3b 3b 20 72 75 6e 73 le-spec) ;; runs
9a20: 3a 69 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 :id,target,runna
9a30: 6d 65 0a 09 20 28 6c 65 74 20 28 28 64 61 74 20 me.. (let ((dat
9a40: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 74 61 (string-split ta
9a50: 62 6c 65 2d 73 70 65 63 20 22 3a 22 29 29 29 20 ble-spec ":")))
9a60: 3b 3b 20 28 22 72 75 6e 73 22 20 22 69 64 2c 74 ;; ("runs" "id,t
9a70: 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 22 29 0a arget,runname").
9a80: 09 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 . (if (> (leng
9a90: 74 68 20 64 61 74 29 20 31 29 0a 09 20 20 20 20 th dat) 1)..
9aa0: 20 20 20 28 63 6f 6e 73 20 28 63 61 72 20 64 61 (cons (car da
9ab0: 74 29 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 t)(string-split
9ac0: 28 63 61 64 72 20 64 61 74 29 20 22 2c 22 29 29 (cadr dat) ","))
9ad0: 20 3b 3b 20 22 69 64 2c 74 61 72 67 65 74 2c 72 ;; "id,target,r
9ae0: 75 6e 6e 61 6d 65 22 0a 09 20 20 20 20 20 20 20 unname"..
9af0: 64 61 74 29 29 29 0a 20 20 20 20 20 20 20 28 73 dat))). (s
9b00: 74 72 69 6e 67 2d 73 70 6c 69 74 20 66 69 65 6c tring-split fiel
9b10: 64 73 2d 73 70 65 63 20 22 2b 22 29 29 29 0a 0a ds-spec "+")))..
9b20: 28 64 65 66 69 6e 65 20 28 67 65 74 2d 76 61 6c (define (get-val
9b30: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
9b40: 64 61 74 61 76 65 63 20 74 65 73 74 2d 66 69 65 datavec test-fie
9b50: 6c 64 2d 69 6e 64 65 78 20 66 69 65 6c 64 6e 61 ld-index fieldna
9b60: 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 69 6e 64 me). (let ((ind
9b70: 78 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 x (hash-table-re
9b80: 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 2d 66 f/default test-f
9b90: 69 65 6c 64 2d 69 6e 64 65 78 20 66 69 65 6c 64 ield-index field
9ba0: 6e 61 6d 65 20 23 66 29 29 29 0a 20 20 20 20 28 name #f))). (
9bb0: 69 66 20 69 6e 64 78 0a 09 28 69 66 20 28 3e 3d if indx..(if (>=
9bc0: 20 69 6e 64 78 20 28 76 65 63 74 6f 72 2d 6c 65 indx (vector-le
9bd0: 6e 67 74 68 20 64 61 74 61 76 65 63 29 29 0a 09 ngth datavec))..
9be0: 20 20 20 20 23 66 20 3b 3b 20 69 6e 64 65 78 20 #f ;; index
9bf0: 74 6f 6f 20 68 69 67 68 2c 20 73 68 6f 75 6c 64 too high, should
9c00: 20 72 61 69 73 65 20 61 6e 20 65 72 72 6f 72 20 raise an error
9c10: 49 20 73 75 70 70 6f 73 65 0a 09 20 20 20 20 28 I suppose.. (
9c20: 76 65 63 74 6f 72 2d 72 65 66 20 64 61 74 61 76 vector-ref datav
9c30: 65 63 20 69 6e 64 78 29 29 0a 09 23 66 29 29 29 ec indx))..#f)))
9c40: 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 6c 69 73 74 2d ..;; NOTE: list-
9c50: 72 75 6e 73 20 61 6e 64 20 6c 69 73 74 2d 64 62 runs and list-db
9c60: 2d 74 61 72 67 65 74 73 20 6f 70 65 72 61 74 65 -targets operate
9c70: 20 6f 6e 20 6c 6f 63 61 6c 20 64 62 21 21 21 0a on local db!!!.
9c80: 3b 3b 0a 3b 3b 20 49 44 45 41 3a 20 6d 65 67 61 ;;.;; IDEA: mega
9c90: 74 65 73 74 20 6c 69 73 74 20 2d 72 75 6e 6e 61 test list -runna
9ca0: 6d 65 20 62 6c 61 68 25 20 2e 2e 2e 0a 3b 3b 0a me blah% ....;;.
9cb0: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
9cc0: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e t-arg "-list-run
9cd0: 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 s")..(args:get-a
9ce0: 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 rg "-list-db-tar
9cf0: 67 65 74 73 22 29 29 0a 20 20 20 20 28 69 66 20 gets")). (if
9d00: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 0a 09 (launch:setup)..
9d10: 28 6c 65 74 2a 20 28 3b 3b 20 28 64 62 73 74 72 (let* (;; (dbstr
9d20: 75 63 74 20 20 20 20 28 6d 61 6b 65 2d 64 62 72 uct (make-dbr
9d30: 3a 64 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 :dbstruct path:
9d40: 2a 74 6f 70 70 61 74 68 2a 20 6c 6f 63 61 6c 3a *toppath* local:
9d50: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9d60: 2d 6c 6f 63 61 6c 22 29 29 29 0a 09 20 20 20 20 -local")))..
9d70: 20 20 20 28 72 75 6e 70 61 74 74 20 20 20 20 20 (runpatt
9d80: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
9d90: 6c 69 73 74 2d 72 75 6e 73 22 29 29 0a 20 20 20 list-runs")).
9da0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 63 63 (acc
9db0: 65 73 73 2d 6d 6f 64 65 20 28 64 62 3a 67 65 74 ess-mode (db:get
9dc0: 2d 61 63 63 65 73 73 2d 6d 6f 64 65 29 29 0a 09 -access-mode))..
9dd0: 20 20 20 20 20 20 20 28 74 65 73 74 70 61 74 74 (testpatt
9de0: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 (common:args
9df0: 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 -get-testpatt #f
9e00: 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 69 )).. ;; (i
9e10: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
9e20: 22 2d 74 65 73 74 70 61 74 74 22 29 20 0a 09 20 "-testpatt") ..
9e30: 20 20 20 20 20 20 3b 3b 20 20 09 20 20 20 20 20 ;; .
9e40: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
9e50: 20 22 2d 74 65 73 74 70 61 74 74 22 29 20 0a 09 "-testpatt") ..
9e60: 20 20 20 20 20 20 20 3b 3b 20 20 09 20 20 20 20 ;; .
9e70: 20 20 20 20 22 25 22 29 29 0a 09 20 20 20 20 20 "%"))..
9e80: 20 20 28 6b 65 79 73 20 20 20 20 20 20 20 20 28 (keys (
9e90: 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 20 3b rmt:get-keys)) ;
9ea0: 3b 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 ; (db:get-keys d
9eb0: 62 73 74 72 75 63 74 29 29 0a 09 20 20 20 20 20 bstruct))..
9ec0: 20 20 3b 3b 20 28 72 75 6e 73 64 61 74 20 20 28 ;; (runsdat (
9ed0: 64 62 3a 67 65 74 2d 72 75 6e 73 20 64 62 73 74 db:get-runs dbst
9ee0: 72 75 63 74 20 72 75 6e 70 61 74 74 20 23 66 20 ruct runpatt #f
9ef0: 23 66 20 27 28 29 29 29 0a 09 3b 3b 20 28 72 75 #f '()))..;; (ru
9f00: 6e 73 64 61 74 20 20 20 20 20 28 72 6d 74 3a 67 nsdat (rmt:g
9f10: 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 et-runs-by-patt
9f20: 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 61 74 74 keys (or runpatt
9f30: 20 22 25 22 29 20 28 63 6f 6d 6d 6f 6e 3a 61 72 "%") (common:ar
9f40: 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 20 3b gs-get-target) ;
9f50: 3b 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 2d 62 ; (db:get-runs-b
9f60: 79 2d 70 61 74 74 20 64 62 73 74 72 75 63 74 20 y-patt dbstruct
9f70: 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 61 74 74 keys (or runpatt
9f80: 20 22 25 22 29 20 28 63 6f 6d 6d 6f 6e 3a 61 72 "%") (common:ar
9f90: 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 0a 09 gs-get-target)..
9fa0: 3b 3b 20 09 09 20 20 20 20 20 20 20 20 20 20 20 ;; ..
9fb0: 09 20 23 66 20 23 66 20 27 28 22 69 64 22 20 22 . #f #f '("id" "
9fc0: 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 runname" "state"
9fd0: 20 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 "status" "owner
9fe0: 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 22 " "event_time" "
9ff0: 63 6f 6d 6d 65 6e 74 22 29 20 30 29 29 0a 09 20 comment") 0))..
a000: 20 20 20 20 20 20 28 72 75 6e 73 64 61 74 20 20 (runsdat
a010: 20 20 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 (rmt:get-runs
a020: 2d 62 79 2d 70 61 74 74 20 6b 65 79 73 20 28 6f -by-patt keys (o
a030: 72 20 72 75 6e 70 61 74 74 20 22 25 22 29 20 0a r runpatt "%") .
a040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a070: 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 (common:args-g
a080: 65 74 2d 74 61 72 67 65 74 29 20 23 66 20 23 66 et-target) #f #f
a090: 20 27 28 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 '("id" "runname
a0a0: 22 20 22 73 74 61 74 65 22 20 22 73 74 61 74 75 " "state" "statu
a0b0: 73 22 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e s" "owner" "even
a0c0: 74 5f 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 t_time" "comment
a0d0: 22 29 20 30 29 29 0a 09 20 20 20 20 20 20 20 28 ") 0)).. (
a0e0: 72 75 6e 73 74 6d 70 20 20 20 20 20 28 64 62 3a runstmp (db:
a0f0: 67 65 74 2d 72 6f 77 73 20 72 75 6e 73 64 61 74 get-rows runsdat
a100: 29 29 0a 09 20 20 20 20 20 20 20 28 68 65 61 64 )).. (head
a110: 65 72 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d er (db:get-
a120: 68 65 61 64 65 72 20 72 75 6e 73 64 61 74 29 29 header runsdat))
a130: 0a 09 20 20 20 20 20 20 20 3b 3b 20 74 68 69 73 .. ;; this
a140: 20 69 73 20 22 2d 73 69 6e 63 65 22 20 73 75 70 is "-since" sup
a150: 70 6f 72 74 2e 20 54 68 69 73 20 6c 6f 6f 6b 73 port. This looks
a160: 20 61 74 20 6c 61 73 74 20 6d 6f 64 20 74 69 6d at last mod tim
a170: 65 73 20 6f 66 20 3c 72 75 6e 2d 69 64 3e 2e 64 es of <run-id>.d
a180: 62 20 66 69 6c 65 73 0a 09 20 20 20 20 20 20 20 b files..
a190: 3b 3b 20 61 6e 64 20 63 6f 6c 6c 65 63 74 73 20 ;; and collects
a1a0: 74 68 6f 73 65 20 6d 6f 64 69 66 69 65 64 20 73 those modified s
a1b0: 69 6e 63 65 20 74 68 65 20 2d 73 69 6e 63 65 20 ince the -since
a1c0: 74 69 6d 65 2e 0a 09 20 20 20 20 20 20 20 28 72 time... (r
a1d0: 75 6e 73 20 20 20 20 20 20 20 20 72 75 6e 73 74 uns runst
a1e0: 6d 70 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 mp).
a1f0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 ;; (
a200: 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 6e 75 if (and (not (nu
a210: 6c 6c 3f 20 72 75 6e 73 74 6d 70 29 29 0a 09 09 ll? runstmp))...
a220: 09 3b 3b 20 20 20 20 20 20 20 20 28 61 72 67 73 .;; (args
a230: 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 :get-arg "-since
a240: 22 29 29 0a 09 09 09 3b 3b 20 20 20 28 6c 65 74 "))....;; (let
a250: 20 28 28 63 68 61 6e 67 65 64 2d 69 64 73 20 28 ((changed-ids (
a260: 64 62 3a 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 db:get-changed-r
a270: 75 6e 2d 69 64 73 20 28 73 74 72 69 6e 67 2d 3e un-ids (string->
a280: 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 number (args:get
a290: 2d 61 72 67 20 22 2d 73 69 6e 63 65 22 29 29 29 -arg "-since")))
a2a0: 29 29 0a 09 09 09 3b 3b 20 20 20 20 20 28 6c 65 ))....;; (le
a2b0: 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 t loop ((hed (ca
a2c0: 72 20 72 75 6e 73 74 6d 70 29 29 0a 09 09 09 3b r runstmp))....;
a2d0: 3b 20 20 20 09 20 20 20 20 20 28 74 61 6c 20 28 ; . (tal (
a2e0: 63 64 72 20 72 75 6e 73 74 6d 70 29 29 0a 09 09 cdr runstmp))...
a2f0: 09 3b 3b 20 20 20 09 20 20 20 20 20 28 72 65 73 .;; . (res
a300: 20 27 28 29 29 29 0a 09 09 09 3b 3b 20 20 20 20 '()))....;;
a310: 20 20 20 28 6c 65 74 20 28 28 6e 65 77 2d 72 65 (let ((new-re
a320: 73 20 28 69 66 20 28 6d 65 6d 62 65 72 20 28 64 s (if (member (d
a330: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
a340: 65 61 64 65 72 20 68 65 64 20 68 65 61 64 65 72 eader hed header
a350: 20 22 69 64 22 29 20 63 68 61 6e 67 65 64 2d 69 "id") changed-i
a360: 64 73 29 0a 09 09 09 3b 3b 20 20 20 09 09 20 20 ds)....;; ..
a370: 20 20 20 20 20 28 63 6f 6e 73 20 68 65 64 20 72 (cons hed r
a380: 65 73 29 0a 09 09 09 3b 3b 20 20 20 09 09 20 20 es)....;; ..
a390: 20 20 20 20 20 72 65 73 29 29 29 0a 09 09 09 3b res)))....;
a3a0: 3b 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e ; (if (n
a3b0: 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 09 3b 3b 20 ull? tal)....;;
a3c0: 20 20 09 20 20 28 72 65 76 65 72 73 65 20 6e 65 . (reverse ne
a3d0: 77 2d 72 65 73 29 0a 09 09 09 3b 3b 20 20 20 09 w-res)....;; .
a3e0: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c (loop (car tal
a3f0: 29 28 63 64 72 20 74 61 6c 29 20 6e 65 77 2d 72 )(cdr tal) new-r
a400: 65 73 29 29 29 29 29 0a 09 09 09 3b 3b 20 20 20 es)))))....;;
a410: 72 75 6e 73 74 6d 70 29 29 0a 09 20 20 20 20 20 runstmp))..
a420: 20 20 28 64 62 2d 74 61 72 67 65 74 73 20 20 28 (db-targets (
a430: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
a440: 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 29 ist-db-targets")
a450: 29 0a 09 20 20 20 20 20 20 20 28 73 65 65 6e 20 ).. (seen
a460: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 (make-has
a470: 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 20 20 20 h-table))..
a480: 20 20 28 64 6d 6f 64 65 20 20 20 20 20 20 20 28 (dmode (
a490: 6c 65 74 20 28 28 64 20 28 61 72 67 73 3a 67 65 let ((d (args:ge
a4a0: 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 t-arg "-dumpmode
a4b0: 22 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 "))).... (i
a4c0: 66 20 64 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d f d (string->sym
a4d0: 62 6f 6c 20 64 29 20 23 66 29 29 29 0a 09 20 20 bol d) #f)))..
a4e0: 20 20 20 20 20 28 64 61 74 61 20 20 20 20 20 20 (data
a4f0: 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 (make-hash-tab
a500: 6c 65 29 29 0a 09 20 20 20 20 20 20 20 28 66 69 le)).. (fi
a510: 65 6c 64 73 2d 73 70 65 63 20 28 69 66 20 28 61 elds-spec (if (a
a520: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 66 69 rgs:get-arg "-fi
a530: 65 6c 64 73 22 29 0a 09 09 09 09 28 65 78 74 72 elds").....(extr
a540: 61 63 74 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 74 act-fields-const
a550: 72 61 69 6e 74 73 20 28 61 72 67 73 3a 67 65 74 raints (args:get
a560: 2d 61 72 67 20 22 2d 66 69 65 6c 64 73 22 29 29 -arg "-fields"))
a570: 0a 09 09 09 09 28 6c 69 73 74 20 28 63 6f 6e 73 .....(list (cons
a580: 20 22 72 75 6e 73 22 20 28 61 70 70 65 6e 64 20 "runs" (append
a590: 6b 65 79 73 20 28 6c 69 73 74 20 22 69 64 22 20 keys (list "id"
a5a0: 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 "runname" "state
a5b0: 22 20 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 " "status" "owne
a5c0: 72 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 r" "event_time"
a5d0: 22 63 6f 6d 6d 65 6e 74 22 20 22 66 61 69 6c 5f "comment" "fail_
a5e0: 63 6f 75 6e 74 22 20 22 70 61 73 73 5f 63 6f 75 count" "pass_cou
a5f0: 6e 74 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 nt"))).....
a600: 20 28 63 6f 6e 73 20 22 74 65 73 74 73 22 20 20 (cons "tests"
a610: 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 db:test-record-f
a620: 69 65 6c 64 73 29 20 3b 3b 20 22 69 64 22 20 22 ields) ;; "id" "
a630: 74 65 73 74 6e 61 6d 65 22 20 22 74 65 73 74 5f testname" "test_
a640: 70 61 74 68 22 29 0a 09 09 09 09 20 20 20 20 20 path").....
a650: 20 28 6c 69 73 74 20 22 73 74 65 70 73 22 20 22 (list "steps" "
a660: 69 64 22 20 22 73 74 65 70 6e 61 6d 65 22 29 29 id" "stepname"))
a670: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 )).. (runs
a680: 2d 73 70 65 63 20 20 20 28 6c 65 74 20 28 28 72 -spec (let ((r
a690: 20 28 61 6c 69 73 74 2d 72 65 66 20 22 72 75 6e (alist-ref "run
a6a0: 73 22 20 20 66 69 65 6c 64 73 2d 73 70 65 63 20 s" fields-spec
a6b0: 65 71 75 61 6c 3f 29 29 29 20 3b 3b 20 74 68 65 equal?))) ;; the
a6c0: 20 63 68 65 63 6b 20 69 73 20 6e 6f 77 20 75 6e check is now un
a6d0: 6e 65 63 65 73 73 61 72 79 0a 09 09 09 20 20 20 necessary....
a6e0: 20 20 20 28 69 66 20 28 61 6e 64 20 72 20 28 6e (if (and r (n
a6f0: 6f 74 20 28 6e 75 6c 6c 3f 20 72 29 29 29 20 72 ot (null? r))) r
a700: 20 28 6c 69 73 74 20 22 69 64 22 20 29 29 29 29 (list "id" ))))
a710: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 73 2d .. (tests-
a720: 73 70 65 63 20 20 28 6c 65 74 20 28 28 74 20 28 spec (let ((t (
a730: 61 6c 69 73 74 2d 72 65 66 20 22 74 65 73 74 73 alist-ref "tests
a740: 22 20 66 69 65 6c 64 73 2d 73 70 65 63 20 65 71 " fields-spec eq
a750: 75 61 6c 3f 29 29 29 0a 09 09 09 20 20 20 20 20 ual?)))....
a760: 20 28 69 66 20 28 61 6e 64 20 74 20 28 6e 75 6c (if (and t (nul
a770: 6c 3f 20 74 29 29 20 3b 3b 20 61 6c 6c 20 66 69 l? t)) ;; all fi
a780: 65 6c 64 73 0a 09 09 09 09 20 20 64 62 3a 74 65 elds..... db:te
a790: 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 st-record-fields
a7a0: 0a 09 09 09 09 20 20 74 29 29 29 0a 09 20 20 20 ..... t)))..
a7b0: 20 20 20 20 28 61 64 6a 2d 74 65 73 74 73 2d 73 (adj-tests-s
a7c0: 70 65 63 20 28 64 65 6c 65 74 65 2d 64 75 70 6c pec (delete-dupl
a7d0: 69 63 61 74 65 73 20 28 69 66 20 74 65 73 74 73 icates (if tests
a7e0: 2d 73 70 65 63 20 28 63 6f 6e 73 20 22 69 64 22 -spec (cons "id"
a7f0: 20 74 65 73 74 73 2d 73 70 65 63 29 20 64 62 3a tests-spec) db:
a800: 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c test-record-fiel
a810: 64 73 29 29 29 20 3b 3b 20 27 28 22 69 64 22 29 ds))) ;; '("id")
a820: 29 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 65 ))).. (ste
a830: 70 73 2d 73 70 65 63 20 20 28 61 6c 69 73 74 2d ps-spec (alist-
a840: 72 65 66 20 22 73 74 65 70 73 22 20 66 69 65 6c ref "steps" fiel
a850: 64 73 2d 73 70 65 63 20 65 71 75 61 6c 3f 29 29 ds-spec equal?))
a860: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 66 .. (test-f
a870: 69 65 6c 64 2d 69 6e 64 65 78 20 28 6d 61 6b 65 ield-index (make
a880: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 -hash-table)))..
a890: 20 20 28 69 66 20 28 61 6e 64 20 74 65 73 74 73 (if (and tests
a8a0: 2d 73 70 65 63 20 28 6e 6f 74 20 28 6e 75 6c 6c -spec (not (null
a8b0: 3f 20 74 65 73 74 73 2d 73 70 65 63 29 29 29 20 ? tests-spec)))
a8c0: 3b 3b 20 64 6f 20 73 6f 6d 65 20 76 61 6c 69 64 ;; do some valid
a8d0: 61 74 69 6f 6e 20 61 6e 64 20 70 72 6f 63 65 73 ation and proces
a8e0: 73 69 6e 67 20 6f 66 20 74 68 65 20 74 65 73 74 sing of the test
a8f0: 2d 73 70 65 63 0a 09 20 20 20 20 20 20 28 6c 65 -spec.. (le
a900: 74 20 28 28 69 6e 76 61 6c 69 64 2d 74 65 73 74 t ((invalid-test
a910: 73 2d 73 70 65 63 20 28 66 69 6c 74 65 72 20 28 s-spec (filter (
a920: 6c 61 6d 62 64 61 20 28 78 29 28 6e 6f 74 20 28 lambda (x)(not (
a930: 6d 65 6d 62 65 72 20 78 20 64 62 3a 74 65 73 74 member x db:test
a940: 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 29 29 -record-fields))
a950: 29 20 74 65 73 74 73 2d 73 70 65 63 29 29 29 0a ) tests-spec))).
a960: 09 09 28 69 66 20 28 6e 75 6c 6c 3f 20 69 6e 76 ..(if (null? inv
a970: 61 6c 69 64 2d 74 65 73 74 73 2d 73 70 65 63 29 alid-tests-spec)
a980: 0a 09 09 20 20 20 20 3b 3b 20 67 65 6e 65 72 61 ... ;; genera
a990: 74 65 20 74 68 65 20 6c 6f 6f 6b 75 70 20 6d 61 te the lookup ma
a9a0: 70 20 74 65 73 74 2d 66 69 65 6c 64 2d 6e 61 6d p test-field-nam
a9b0: 65 20 3d 3e 20 69 6e 64 65 78 2d 6e 75 6d 62 65 e => index-numbe
a9c0: 72 0a 09 09 20 20 20 20 28 6c 65 74 20 6c 6f 6f r... (let loo
a9d0: 70 20 28 28 68 65 64 20 28 63 61 72 20 61 64 6a p ((hed (car adj
a9e0: 2d 74 65 73 74 73 2d 73 70 65 63 29 29 0a 09 09 -tests-spec))...
a9f0: 09 20 20 20 20 20 20 20 28 74 61 6c 20 28 63 64 . (tal (cd
aa00: 72 20 61 64 6a 2d 74 65 73 74 73 2d 73 70 65 63 r adj-tests-spec
aa10: 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 64 )).... (id
aa20: 78 20 30 29 29 0a 09 09 20 20 20 20 20 20 28 68 x 0))... (h
aa30: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 ash-table-set! t
aa40: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
aa50: 68 65 64 20 69 64 78 29 0a 09 09 20 20 20 20 20 hed idx)...
aa60: 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (if (not (null?
aa70: 20 74 61 6c 29 29 28 6c 6f 6f 70 20 28 63 61 72 tal))(loop (car
aa80: 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 28 2b tal)(cdr tal)(+
aa90: 20 69 64 78 20 31 29 29 29 29 0a 09 09 20 20 20 idx 1))))...
aaa0: 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 (begin...
aab0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
aac0: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
aad0: 67 2d 70 6f 72 74 2a 20 22 49 6e 76 61 6c 69 64 g-port* "Invalid
aae0: 20 74 65 73 74 20 66 69 65 6c 64 73 20 73 70 65 test fields spe
aaf0: 63 69 66 69 65 64 3a 20 22 20 28 73 74 72 69 6e cified: " (strin
ab00: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 69 6e g-intersperse in
ab10: 76 61 6c 69 64 2d 74 65 73 74 73 2d 73 70 65 63 valid-tests-spec
ab20: 20 22 2c 20 22 29 29 0a 09 09 20 20 20 20 20 20 ", "))...
ab30: 28 65 78 69 74 29 29 29 29 29 0a 0a 09 20 20 3b (exit)))))... ;
ab40: 3b 20 45 61 63 68 20 72 75 6e 0a 09 20 20 28 66 ; Each run.. (f
ab50: 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 28 6c 61 or-each .. (la
ab60: 6d 62 64 61 20 28 72 75 6e 29 0a 09 20 20 20 20 mbda (run)..
ab70: 20 28 6c 65 74 20 28 28 74 61 72 67 65 74 73 74 (let ((targetst
ab80: 72 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 r (string-inters
ab90: 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 perse (map (lamb
aba0: 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 20 28 da (x)........ (
abb0: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
abc0: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
abd0: 72 20 78 29 29 0a 09 09 09 09 09 09 20 20 20 20 r x)).......
abe0: 20 20 20 6b 65 79 73 29 20 22 2f 22 29 29 29 0a keys) "/"))).
abf0: 09 20 20 20 20 20 20 20 28 69 66 20 64 62 2d 74 . (if db-t
ac00: 61 72 67 65 74 73 0a 09 09 20 20 20 28 69 66 20 argets... (if
ac10: 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 (not (hash-table
ac20: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 73 65 65 -ref/default see
ac30: 6e 20 74 61 72 67 65 74 73 74 72 20 23 66 29 29 n targetstr #f))
ac40: 0a 09 09 20 20 20 20 20 20 20 28 62 65 67 69 6e ... (begin
ac50: 0a 09 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 .... (hash-table
ac60: 2d 73 65 74 21 20 73 65 65 6e 20 74 61 72 67 65 -set! seen targe
ac70: 74 73 74 72 20 23 74 29 0a 09 09 09 20 3b 3b 20 tstr #t).... ;;
ac80: 28 70 72 69 6e 74 20 22 5b 22 20 74 61 72 67 65 (print "[" targe
ac90: 74 73 74 72 20 22 5d 22 29 29 29 29 0a 09 09 09 tstr "]"))))....
aca0: 20 28 69 66 20 28 6e 6f 74 20 64 6d 6f 64 65 29 (if (not dmode)
acb0: 0a 09 09 09 20 20 20 20 20 28 70 72 69 6e 74 20 .... (print
acc0: 74 61 72 67 65 74 73 74 72 29 0a 09 09 09 20 20 targetstr)....
acd0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
ace0: 65 74 21 20 64 61 74 61 20 22 74 61 72 67 65 74 et! data "target
acf0: 73 22 20 28 63 6f 6e 73 20 74 61 72 67 65 74 73 s" (cons targets
ad00: 74 72 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 tr (hash-table-r
ad10: 65 66 2f 64 65 66 61 75 6c 74 20 64 61 74 61 20 ef/default data
ad20: 22 74 61 72 67 65 74 73 22 20 27 28 29 29 29 29 "targets" '())))
ad30: 0a 09 09 09 20 20 20 20 20 29 29 29 0a 09 09 20 .... )))...
ad40: 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 2d 69 64 (let* ((run-id
ad50: 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d (db:get-value-
ad60: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
ad70: 61 64 65 72 20 22 69 64 22 29 29 0a 09 09 09 20 ader "id"))....
ad80: 20 28 72 75 6e 6e 61 6d 65 20 28 64 62 3a 67 65 (runname (db:ge
ad90: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
ada0: 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 72 75 r run header "ru
adb0: 6e 6e 61 6d 65 22 29 29 20 0a 09 09 09 20 20 28 nname")) .... (
adc0: 73 74 61 74 65 73 20 20 28 73 74 72 69 6e 67 2d states (string-
add0: 73 70 6c 69 74 20 28 6f 72 20 28 61 72 67 73 3a split (or (args:
ade0: 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 65 22 get-arg "-state"
adf0: 29 20 22 22 29 20 22 2c 22 29 29 0a 09 09 09 20 ) "") ","))....
ae00: 20 28 73 74 61 74 75 73 65 73 20 28 73 74 72 69 (statuses (stri
ae10: 6e 67 2d 73 70 6c 69 74 20 28 6f 72 20 28 61 72 ng-split (or (ar
ae20: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 gs:get-arg "-sta
ae30: 74 75 73 22 29 20 22 22 29 20 22 2c 22 29 29 0a tus") "") ",")).
ae40: 09 09 09 20 20 28 74 65 73 74 73 20 20 20 28 69 ... (tests (i
ae50: 66 20 74 65 73 74 73 2d 73 70 65 63 0a 09 09 09 f tests-spec....
ae60: 09 20 20 20 20 20 20 20 28 64 62 3a 64 69 73 70 . (db:disp
ae70: 61 74 63 68 2d 71 75 65 72 79 20 61 63 63 65 73 atch-query acces
ae80: 73 2d 6d 6f 64 65 20 72 6d 74 3a 67 65 74 2d 74 s-mode rmt:get-t
ae90: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 3a ests-for-run db:
aea0: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
aeb0: 6e 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 74 n run-id testpat
aec0: 74 20 73 74 61 74 65 73 20 73 74 61 74 75 73 65 t states statuse
aed0: 73 20 23 66 20 23 66 20 23 66 20 27 74 65 73 74 s #f #f #f 'test
aee0: 6e 61 6d 65 20 27 61 73 63 20 3b 3b 20 28 64 62 name 'asc ;; (db
aef0: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
af00: 75 6e 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d un dbstruct run-
af10: 69 64 20 74 65 73 74 70 61 74 74 20 27 28 29 20 id testpatt '()
af20: 27 28 29 20 23 66 20 23 66 20 23 66 20 27 74 65 '() #f #f #f 'te
af30: 73 74 6e 61 6d 65 20 27 61 73 63 20 0a 09 09 09 stname 'asc ....
af40: 09 09 09 09 20 20 20 20 20 3b 3b 20 75 73 65 20 .... ;; use
af50: 71 72 79 76 61 6c 73 20 69 66 20 74 65 73 74 2d qryvals if test-
af60: 73 70 65 63 20 70 72 6f 76 69 64 65 64 0a 09 09 spec provided...
af70: 09 09 09 09 09 20 20 20 20 20 28 69 66 20 74 65 ..... (if te
af80: 73 74 73 2d 73 70 65 63 0a 09 09 09 09 09 09 09 sts-spec........
af90: 09 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 . (string-inters
afa0: 70 65 72 73 65 20 61 64 6a 2d 74 65 73 74 73 2d perse adj-tests-
afb0: 73 70 65 63 20 22 2c 22 29 0a 09 09 09 09 09 09 spec ",").......
afc0: 09 09 20 3b 3b 20 64 62 3a 74 65 73 74 2d 72 65 .. ;; db:test-re
afd0: 63 6f 72 64 2d 66 69 65 6c 64 73 0a 09 09 09 09 cord-fields.....
afe0: 09 09 09 09 20 23 66 29 0a 09 09 09 09 09 09 09 .... #f)........
aff0: 20 20 20 20 20 23 66 0a 09 09 09 09 09 09 09 20 #f........
b000: 20 20 20 20 27 6e 6f 72 6d 61 6c 29 0a 09 09 09 'normal)....
b010: 09 20 20 20 20 20 20 20 27 28 29 29 29 29 0a 09 . '())))..
b020: 09 20 20 20 20 20 28 63 61 73 65 20 64 6d 6f 64 . (case dmod
b030: 65 0a 09 09 20 20 20 20 20 20 20 28 28 6a 73 6f e... ((jso
b040: 6e 20 6f 64 73 29 0a 09 09 09 28 69 66 20 72 75 n ods)....(if ru
b050: 6e 73 2d 73 70 65 63 0a 09 09 09 20 20 20 20 28 ns-spec.... (
b060: 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 20 20 for-each ....
b070: 20 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 (lambda (field
b080: 2d 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 20 -name)....
b090: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
b0a0: 68 2d 73 65 74 21 20 64 61 74 61 20 28 63 6f 6e h-set! data (con
b0b0: 63 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d c (db:get-value-
b0c0: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
b0d0: 61 64 65 72 20 66 69 65 6c 64 2d 6e 61 6d 65 29 ader field-name)
b0e0: 29 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e ) targetstr runn
b0f0: 61 6d 65 20 22 6d 65 74 61 22 20 66 69 65 6c 64 ame "meta" field
b100: 2d 6e 61 6d 65 29 29 0a 09 09 09 20 20 20 20 20 -name))....
b110: 72 75 6e 73 2d 73 70 65 63 29 29 29 0a 09 09 09 runs-spec)))....
b120: 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ;; (mutils:hierh
b130: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 64 ash-set! data (d
b140: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
b150: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
b160: 20 22 73 74 61 74 75 73 22 29 20 20 20 20 20 74 "status") t
b170: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
b180: 20 22 6d 65 74 61 22 20 22 73 74 61 74 75 73 22 "meta" "status"
b190: 20 20 20 20 20 29 0a 09 09 09 3b 3b 20 28 6d 75 )....;; (mu
b1a0: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
b1b0: 74 21 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d t! data (db:get-
b1c0: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
b1d0: 72 75 6e 20 68 65 61 64 65 72 20 22 73 74 61 74 run header "stat
b1e0: 65 22 29 20 20 20 20 20 20 74 61 72 67 65 74 73 e") targets
b1f0: 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 tr runname "meta
b200: 22 20 22 73 74 61 74 65 22 20 20 20 20 20 20 29 " "state" )
b210: 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 ....;; (mutils:h
b220: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
b230: 61 20 28 63 6f 6e 63 20 28 64 62 3a 67 65 74 2d a (conc (db:get-
b240: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
b250: 72 75 6e 20 68 65 61 64 65 72 20 22 69 64 22 29 run header "id")
b260: 29 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e ) targetstr run
b270: 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 69 64 22 name "meta" "id"
b280: 20 20 20 20 20 20 20 20 20 29 0a 09 09 09 3b 3b )....;;
b290: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
b2a0: 68 2d 73 65 74 21 20 64 61 74 61 20 28 64 62 3a h-set! data (db:
b2b0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
b2c0: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 der run header "
b2d0: 65 76 65 6e 74 5f 74 69 6d 65 22 29 20 74 61 72 event_time") tar
b2e0: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
b2f0: 6d 65 74 61 22 20 22 65 76 65 6e 74 5f 74 69 6d meta" "event_tim
b300: 65 22 20 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 e" )....;; (muti
b310: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
b320: 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 data (db:get-va
b330: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
b340: 6e 20 68 65 61 64 65 72 20 22 63 6f 6d 6d 65 6e n header "commen
b350: 74 22 29 20 20 20 20 74 61 72 67 65 74 73 74 72 t") targetstr
b360: 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 runname "meta"
b370: 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 29 0a 09 "comment" )..
b380: 09 09 3b 3b 20 3b 3b 20 61 64 64 20 6c 61 73 74 ..;; ;; add last
b390: 20 65 6e 74 72 79 20 74 77 69 63 65 20 2d 20 73 entry twice - s
b3a0: 65 65 6d 73 20 74 6f 20 62 65 20 61 20 62 75 67 eems to be a bug
b3b0: 20 69 6e 20 68 69 65 72 68 61 73 68 3f 0a 09 09 in hierhash?...
b3c0: 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 .;; (mutils:hier
b3d0: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 hash-set! data (
b3e0: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
b3f0: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
b400: 72 20 22 63 6f 6d 6d 65 6e 74 22 29 20 20 20 20 r "comment")
b410: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
b420: 65 20 22 6d 65 74 61 22 20 22 63 6f 6d 6d 65 6e e "meta" "commen
b430: 74 22 20 20 20 20 29 0a 09 09 20 20 20 20 20 20 t" )...
b440: 20 28 65 6c 73 65 0a 09 09 09 28 69 66 20 28 6e (else....(if (n
b450: 75 6c 6c 3f 20 72 75 6e 73 2d 73 70 65 63 29 0a ull? runs-spec).
b460: 09 09 09 20 20 20 20 28 70 72 69 6e 74 20 22 52 ... (print "R
b470: 75 6e 3a 20 22 20 74 61 72 67 65 74 73 74 72 20 un: " targetstr
b480: 22 2f 22 20 72 75 6e 6e 61 6d 65 20 0a 09 09 09 "/" runname ....
b490: 09 20 20 20 22 20 73 74 61 74 75 73 3a 20 22 20 . " status: "
b4a0: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
b4b0: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
b4c0: 65 72 20 22 73 74 61 74 65 22 29 0a 09 09 09 09 er "state").....
b4d0: 20 20 20 22 20 72 75 6e 2d 69 64 3a 20 22 20 72 " run-id: " r
b4e0: 75 6e 2d 69 64 20 22 2c 20 6e 75 6d 62 65 72 20 un-id ", number
b4f0: 74 65 73 74 73 3a 20 22 20 28 6c 65 6e 67 74 68 tests: " (length
b500: 20 74 65 73 74 73 29 0a 09 09 09 09 20 20 20 22 tests)..... "
b510: 20 65 76 65 6e 74 5f 74 69 6d 65 3a 20 22 20 28 event_time: " (
b520: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
b530: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
b540: 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 29 r "event_time"))
b550: 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 .... (begin..
b560: 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not
b570: 20 28 6d 65 6d 62 65 72 20 22 74 61 72 67 65 74 (member "target
b580: 22 20 72 75 6e 73 2d 73 70 65 63 29 29 0a 09 09 " runs-spec))...
b590: 09 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 64 . ;; (d
b5a0: 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 22 54 61 isplay (conc "Ta
b5b0: 72 67 65 74 3a 20 22 20 74 61 72 67 65 74 73 74 rget: " targetst
b5c0: 72 29 29 0a 09 09 09 20 20 20 20 20 20 20 20 20 r))....
b5d0: 20 28 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 (display (conc
b5e0: 22 52 75 6e 3a 20 22 20 74 61 72 67 65 74 73 74 "Run: " targetst
b5f0: 72 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 20 r "/" runname "
b600: 22 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 66 "))).... (f
b610: 6f 72 2d 65 61 63 68 0a 09 09 09 20 20 20 20 20 or-each....
b620: 20 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 (lambda (field
b630: 2d 6e 61 6d 65 29 0a 09 09 09 09 20 28 69 66 20 -name)..... (if
b640: 28 65 71 75 61 6c 3f 20 66 69 65 6c 64 2d 6e 61 (equal? field-na
b650: 6d 65 20 22 74 61 72 67 65 74 22 29 0a 09 09 09 me "target")....
b660: 09 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 28 . (display (
b670: 63 6f 6e 63 20 22 74 61 72 67 65 74 3a 20 22 20 conc "target: "
b680: 74 61 72 67 65 74 73 74 72 20 22 20 22 29 29 0a targetstr " ")).
b690: 09 09 09 09 20 20 20 20 20 28 64 69 73 70 6c 61 .... (displa
b6a0: 79 20 28 63 6f 6e 63 20 66 69 65 6c 64 2d 6e 61 y (conc field-na
b6b0: 6d 65 20 22 3a 20 22 20 28 64 62 3a 67 65 74 2d me ": " (db:get-
b6c0: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
b6d0: 72 75 6e 20 68 65 61 64 65 72 20 28 63 6f 6e 63 run header (conc
b6e0: 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 20 22 20 field-name)) "
b6f0: 22 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 "))))....
b700: 72 75 6e 73 2d 73 70 65 63 29 0a 09 09 09 20 20 runs-spec)....
b710: 20 20 20 20 28 6e 65 77 6c 69 6e 65 29 29 29 29 (newline))))
b720: 29 0a 09 09 20 20 20 20 20 20 20 0a 09 09 20 20 )... ...
b730: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 (for-each ...
b740: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 (lambda (t
b750: 65 73 74 29 0a 09 09 20 20 20 20 20 20 09 28 68 est)... .(h
b760: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
b770: 0a 09 09 09 20 65 78 6e 0a 09 09 09 20 28 62 65 .... exn.... (be
b780: 67 69 6e 0a 09 09 09 20 20 20 28 64 65 62 75 67 gin.... (debug
b790: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
b7a0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
b7b0: 2a 20 22 42 61 64 20 64 61 74 61 20 69 6e 20 74 * "Bad data in t
b7c0: 65 73 74 20 72 65 63 6f 72 64 3f 20 22 20 74 65 est record? " te
b7d0: 73 74 29 0a 09 09 09 20 20 20 28 70 72 69 6e 74 st).... (print
b7e0: 20 22 65 78 6e 3d 22 20 28 63 6f 6e 64 69 74 69 "exn=" (conditi
b7f0: 6f 6e 2d 3e 6c 69 73 74 20 65 78 6e 29 29 0a 09 on->list exn))..
b800: 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e .. (debug:prin
b810: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
b820: 2d 70 6f 72 74 2a 20 22 20 6d 65 73 73 61 67 65 -port* " message
b830: 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d : " ((condition-
b840: 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f property-accesso
b850: 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 r 'exn 'message)
b860: 20 65 78 6e 29 29 0a 09 09 09 20 20 20 28 70 72 exn)).... (pr
b870: 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 20 28 int-call-chain (
b880: 63 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f current-error-po
b890: 72 74 29 29 29 0a 09 09 09 20 28 6c 65 74 2a 20 rt))).... (let*
b8a0: 28 28 74 65 73 74 2d 69 64 20 20 20 20 20 20 28 ((test-id (
b8b0: 69 66 20 28 6d 65 6d 62 65 72 20 22 69 64 22 20 if (member "id"
b8c0: 20 20 20 20 20 20 20 20 20 20 74 65 73 74 73 2d tests-
b8d0: 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d spec)(get-value-
b8e0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
b8f0: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
b900: 65 78 20 22 69 64 22 20 20 20 20 20 20 20 20 20 ex "id"
b910: 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 ) #f)) ;; (db:t
b920: 65 73 74 2d 67 65 74 2d 69 64 20 20 20 20 20 20 est-get-id
b930: 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 74 test)).....(t
b940: 65 73 74 6e 61 6d 65 20 20 20 20 20 28 69 66 20 estname (if
b950: 28 6d 65 6d 62 65 72 20 22 74 65 73 74 6e 61 6d (member "testnam
b960: 65 22 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 e" tests-spe
b970: 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d c)(get-value-by-
b980: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
b990: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
b9a0: 22 74 65 73 74 6e 61 6d 65 22 20 20 20 20 29 20 "testname" )
b9b0: 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 #f)) ;; (db:test
b9c0: 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 20 -get-testname
b9d0: 74 65 73 74 29 29 0a 09 09 09 09 28 69 74 65 6d test)).....(item
b9e0: 70 61 74 68 20 20 20 20 20 28 69 66 20 28 6d 65 path (if (me
b9f0: 6d 62 65 72 20 22 69 74 65 6d 5f 70 61 74 68 22 mber "item_path"
ba00: 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 tests-spec)(
ba10: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
ba20: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
ba30: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 69 74 -field-index "it
ba40: 65 6d 5f 70 61 74 68 22 20 20 20 29 20 23 66 29 em_path" ) #f)
ba50: 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 ) ;; (db:test-ge
ba60: 74 2d 69 74 65 6d 2d 70 61 74 68 20 20 74 65 73 t-item-path tes
ba70: 74 29 29 0a 09 09 09 09 28 63 6f 6d 6d 65 6e 74 t)).....(comment
ba80: 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 (if (membe
ba90: 72 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 20 r "comment"
baa0: 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 tests-spec)(get
bab0: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
bac0: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
bad0: 65 6c 64 2d 69 6e 64 65 78 20 22 63 6f 6d 6d 65 eld-index "comme
bae0: 6e 74 22 20 20 20 20 20 29 20 23 66 29 29 20 3b nt" ) #f)) ;
baf0: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 ; (db:test-get-c
bb00: 6f 6d 6d 65 6e 74 20 20 20 20 74 65 73 74 29 29 omment test))
bb10: 0a 09 09 09 09 28 74 73 74 61 74 65 20 20 20 20 .....(tstate
bb20: 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 (if (member "
bb30: 73 74 61 74 65 22 20 20 20 20 20 20 20 20 74 65 state" te
bb40: 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 sts-spec)(get-va
bb50: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
bb60: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
bb70: 2d 69 6e 64 65 78 20 22 73 74 61 74 65 22 20 20 -index "state"
bb80: 20 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 ) #f)) ;; (
bb90: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
bba0: 65 20 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 e test))...
bbb0: 09 09 28 74 73 74 61 74 75 73 20 20 20 20 20 20 ..(tstatus
bbc0: 28 69 66 20 28 6d 65 6d 62 65 72 20 22 73 74 61 (if (member "sta
bbd0: 74 75 73 22 20 20 20 20 20 20 20 74 65 73 74 73 tus" tests
bbe0: 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 -spec)(get-value
bbf0: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
bc00: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
bc10: 64 65 78 20 22 73 74 61 74 75 73 22 20 20 20 20 dex "status"
bc20: 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a ) #f)) ;; (db:
bc30: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 test-get-status
bc40: 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 test)).....(
bc50: 65 76 65 6e 74 2d 74 69 6d 65 20 20 20 28 69 66 event-time (if
bc60: 20 28 6d 65 6d 62 65 72 20 22 65 76 65 6e 74 5f (member "event_
bc70: 74 69 6d 65 22 20 20 20 74 65 73 74 73 2d 73 70 time" tests-sp
bc80: 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 ec)(get-value-by
bc90: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
bca0: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
bcb0: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 20 29 "event_time" )
bcc0: 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 #f)) ;; (db:tes
bcd0: 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 t-get-event_time
bce0: 20 74 65 73 74 29 29 0a 09 09 09 09 28 72 75 6e test)).....(run
bcf0: 64 69 72 20 20 20 20 20 20 20 28 69 66 20 28 6d dir (if (m
bd00: 65 6d 62 65 72 20 22 72 75 6e 64 69 72 22 20 20 ember "rundir"
bd10: 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 tests-spec)
bd20: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
bd30: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
bd40: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 t-field-index "r
bd50: 75 6e 64 69 72 22 20 20 20 20 20 20 29 20 23 66 undir" ) #f
bd60: 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 )) ;; (db:test-g
bd70: 65 74 2d 72 75 6e 64 69 72 20 20 20 20 20 74 65 et-rundir te
bd80: 73 74 29 29 0a 09 09 09 09 28 66 69 6e 61 6c 5f st)).....(final_
bd90: 6c 6f 67 66 20 20 20 28 69 66 20 28 6d 65 6d 62 logf (if (memb
bda0: 65 72 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 er "final_logf"
bdb0: 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 tests-spec)(ge
bdc0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
bdd0: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
bde0: 69 65 6c 64 2d 69 6e 64 65 78 20 22 66 69 6e 61 ield-index "fina
bdf0: 6c 5f 6c 6f 67 66 22 20 20 29 20 23 66 29 29 20 l_logf" ) #f))
be00: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
be10: 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 74 29 final_logf test)
be20: 29 0a 09 09 09 09 28 72 75 6e 5f 64 75 72 61 74 ).....(run_durat
be30: 69 6f 6e 20 28 69 66 20 28 6d 65 6d 62 65 72 20 ion (if (member
be40: 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 20 74 "run_duration" t
be50: 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 ests-spec)(get-v
be60: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
be70: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
be80: 64 2d 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 d-index "run_dur
be90: 61 74 69 6f 6e 22 29 20 23 66 29 29 20 3b 3b 20 ation") #f)) ;;
bea0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e (db:test-get-run
beb0: 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 29 29 _duration test))
bec0: 0a 09 09 09 09 28 66 75 6c 6c 6e 61 6d 65 20 20 .....(fullname
bed0: 20 20 20 28 63 6f 6e 63 20 74 65 73 74 6e 61 6d (conc testnam
bee0: 65 0a 09 09 09 09 09 09 20 20 20 20 28 69 66 20 e....... (if
bef0: 28 65 71 75 61 6c 3f 20 69 74 65 6d 70 61 74 68 (equal? itempath
bf00: 20 22 22 29 0a 09 09 09 09 09 09 09 22 22 20 0a "")........"" .
bf10: 09 09 09 09 09 09 09 28 63 6f 6e 63 20 22 28 22 .......(conc "("
bf20: 20 69 74 65 6d 70 61 74 68 20 22 29 22 29 29 29 itempath ")")))
bf30: 29 29 0a 09 09 09 20 20 20 28 63 61 73 65 20 64 )).... (case d
bf40: 6d 6f 64 65 0a 09 09 09 20 20 20 20 20 28 28 6a mode.... ((j
bf50: 73 6f 6e 20 6f 64 73 29 0a 09 09 09 20 20 20 20 son ods)....
bf60: 20 20 28 69 66 20 74 65 73 74 73 2d 73 70 65 63 (if tests-spec
bf70: 0a 09 09 09 09 20 20 28 66 6f 72 2d 65 61 63 68 ..... (for-each
bf80: 0a 09 09 09 09 20 20 20 28 6c 61 6d 62 64 61 20 ..... (lambda
bf90: 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 (field-name)....
bfa0: 09 20 20 20 20 20 28 6d 75 74 69 6c 73 3a 68 69 . (mutils:hi
bfb0: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
bfc0: 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d (get-value-by-
bfd0: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
bfe0: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
bff0: 66 69 65 6c 64 2d 6e 61 6d 65 29 20 74 61 72 67 field-name) targ
c000: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 etstr runname "d
c010: 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d ata" (conc test-
c020: 69 64 29 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 id) field-name))
c030: 0a 09 09 09 09 20 20 20 74 65 73 74 73 2d 73 70 ..... tests-sp
c040: 65 63 29 29 29 0a 09 09 09 20 20 20 20 20 3b 3b ec))).... ;;
c050: 20 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 ;; (mutils:hier
c060: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 hash-set! data
c070: 66 75 6c 6c 6e 61 6d 65 20 20 20 74 61 72 67 65 fullname targe
c080: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 tstr runname "da
c090: 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 ta" (conc test-i
c0a0: 64 29 20 22 74 6e 61 6d 65 22 20 20 20 20 20 29 d) "tname" )
c0b0: 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 .... ;; (mu
c0c0: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
c0d0: 74 21 20 64 61 74 61 20 20 74 65 73 74 6e 61 6d t! data testnam
c0e0: 65 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 e targetstr ru
c0f0: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
c100: 6e 63 20 74 65 73 74 2d 69 64 29 20 22 74 65 73 nc test-id) "tes
c110: 74 6e 61 6d 65 22 20 20 29 0a 09 09 09 20 20 20 tname" )....
c120: 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 ;; (mutils:hi
c130: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
c140: 20 20 69 74 65 6d 70 61 74 68 20 20 20 74 61 72 itempath tar
c150: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
c160: 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 data" (conc test
c170: 2d 69 64 29 20 22 69 74 65 6d 70 61 74 68 22 20 -id) "itempath"
c180: 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 ).... ;; (
c190: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
c1a0: 73 65 74 21 20 64 61 74 61 20 20 63 6f 6d 6d 65 set! data comme
c1b0: 6e 74 20 20 20 20 74 61 72 67 65 74 73 74 72 20 nt targetstr
c1c0: 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 runname "data" (
c1d0: 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 63 conc test-id) "c
c1e0: 6f 6d 6d 65 6e 74 22 20 20 20 29 0a 09 09 09 20 omment" )....
c1f0: 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a ;; (mutils:
c200: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
c210: 74 61 20 20 74 73 74 61 74 65 20 20 20 20 20 74 ta tstate t
c220: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
c230: 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 "data" (conc te
c240: 73 74 2d 69 64 29 20 22 73 74 61 74 65 22 20 20 st-id) "state"
c250: 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 ).... ;;
c260: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
c270: 68 2d 73 65 74 21 20 64 61 74 61 20 20 74 73 74 h-set! data tst
c280: 61 74 75 73 20 20 20 20 74 61 72 67 65 74 73 74 atus targetst
c290: 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 r runname "data"
c2a0: 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 (conc test-id)
c2b0: 22 73 74 61 74 75 73 22 20 20 20 20 29 0a 09 09 "status" )...
c2c0: 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c . ;; (mutil
c2d0: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
c2e0: 64 61 74 61 20 20 72 75 6e 64 69 72 20 20 20 20 data rundir
c2f0: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
c300: 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 me "data" (conc
c310: 74 65 73 74 2d 69 64 29 20 22 72 75 6e 64 69 72 test-id) "rundir
c320: 22 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b " ).... ;
c330: 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ; (mutils:hierh
c340: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 66 ash-set! data f
c350: 69 6e 61 6c 5f 6c 6f 67 66 20 74 61 72 67 65 74 inal_logf target
c360: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 str runname "dat
c370: 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 a" (conc test-id
c380: 29 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 29 0a ) "final_logf").
c390: 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 ... ;; (mut
c3a0: 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 ils:hierhash-set
c3b0: 21 20 64 61 74 61 20 20 72 75 6e 5f 64 75 72 61 ! data run_dura
c3c0: 74 69 6f 6e 20 74 61 72 67 65 74 73 74 72 20 72 tion targetstr r
c3d0: 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 unname "data" (c
c3e0: 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 72 75 onc test-id) "ru
c3f0: 6e 5f 64 75 72 61 74 69 6f 6e 22 29 0a 09 09 09 n_duration")....
c400: 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 ;; (mutils
c410: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
c420: 61 74 61 20 20 65 76 65 6e 74 2d 74 69 6d 65 20 ata event-time
c430: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
c440: 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 e "data" (conc t
c450: 65 73 74 2d 69 64 29 20 22 65 76 65 6e 74 5f 74 est-id) "event_t
c460: 69 6d 65 22 29 0a 09 09 09 20 20 20 20 20 3b 3b ime").... ;;
c470: 20 20 3b 3b 20 61 64 64 20 6c 61 73 74 20 65 6e ;; add last en
c480: 74 72 79 20 74 77 69 63 65 20 2d 20 73 65 65 6d try twice - seem
c490: 73 20 74 6f 20 62 65 20 61 20 62 75 67 20 69 6e s to be a bug in
c4a0: 20 68 69 65 72 68 61 73 68 3f 0a 09 09 09 20 20 hierhash?....
c4b0: 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 ;; (mutils:h
c4c0: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
c4d0: 61 20 20 65 76 65 6e 74 2d 74 69 6d 65 20 74 61 a event-time ta
c4e0: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
c4f0: 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 "data" (conc tes
c500: 74 2d 69 64 29 20 22 65 76 65 6e 74 5f 74 69 6d t-id) "event_tim
c510: 65 22 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 e").... ;;
c520: 29 0a 09 09 09 20 20 20 20 20 28 65 6c 73 65 0a ).... (else.
c530: 09 09 09 20 20 20 20 20 20 28 69 66 20 28 61 6e ... (if (an
c540: 64 20 74 73 74 61 74 65 20 74 73 74 61 74 75 73 d tstate tstatus
c550: 20 65 76 65 6e 74 2d 74 69 6d 65 29 0a 09 09 09 event-time)....
c560: 09 20 20 28 66 6f 72 6d 61 74 20 23 74 0a 09 09 . (format #t...
c570: 09 09 09 20 20 22 20 20 54 65 73 74 3a 20 7e 32 ... " Test: ~2
c580: 35 61 20 53 74 61 74 65 3a 20 7e 31 35 61 20 53 5a State: ~15a S
c590: 74 61 74 75 73 3a 20 7e 31 35 61 20 52 75 6e 74 tatus: ~15a Runt
c5a0: 69 6d 65 3a 20 7e 35 40 61 73 20 54 69 6d 65 3a ime: ~5@as Time:
c5b0: 20 7e 32 32 61 20 48 6f 73 74 3a 20 7e 31 30 61 ~22a Host: ~10a
c5c0: 5c 6e 22 0a 09 09 09 09 09 20 20 28 69 66 20 66 \n"...... (if f
c5d0: 75 6c 6c 6e 61 6d 65 20 66 75 6c 6c 6e 61 6d 65 ullname fullname
c5e0: 20 22 22 29 0a 09 09 09 09 09 20 20 28 69 66 20 "")...... (if
c5f0: 74 73 74 61 74 65 20 20 20 74 73 74 61 74 65 20 tstate tstate
c600: 20 20 22 22 29 0a 09 09 09 09 09 20 20 28 69 66 "")...... (if
c610: 20 74 73 74 61 74 75 73 20 20 74 73 74 61 74 75 tstatus tstatu
c620: 73 20 20 22 22 29 0a 09 09 09 09 09 20 20 28 67 s "")...... (g
c630: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
c640: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
c650: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e field-index "run
c660: 5f 64 75 72 61 74 69 6f 6e 22 29 3b 3b 28 69 66 _duration");;(if
c670: 20 74 65 73 74 20 20 20 20 20 28 64 62 3a 74 65 test (db:te
c680: 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 st-get-run_durat
c690: 69 6f 6e 20 74 65 73 74 29 20 22 22 29 0a 09 09 ion test) "")...
c6a0: 09 09 09 20 20 28 69 66 20 65 76 65 6e 74 2d 74 ... (if event-t
c6b0: 69 6d 65 20 65 76 65 6e 74 2d 74 69 6d 65 20 22 ime event-time "
c6c0: 22 29 0a 09 09 09 09 09 20 20 28 67 65 74 2d 76 ")...... (get-v
c6d0: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
c6e0: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
c6f0: 64 2d 69 6e 64 65 78 20 22 68 6f 73 74 22 29 29 d-index "host"))
c700: 20 3b 3b 28 69 66 20 74 65 73 74 20 28 64 62 3a ;;(if test (db:
c710: 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 20 74 65 test-get-host te
c720: 73 74 29 29 20 22 22 29 0a 09 09 09 09 20 20 28 st)) "")..... (
c730: 70 72 69 6e 74 20 22 20 20 54 65 73 74 3a 20 22 print " Test: "
c740: 20 66 75 6c 6c 6e 61 6d 65 0a 09 09 09 09 09 20 fullname......
c750: 28 69 66 20 74 73 74 61 74 65 20 20 28 63 6f 6e (if tstate (con
c760: 63 20 22 20 53 74 61 74 65 3a 20 22 20 20 74 73 c " State: " ts
c770: 74 61 74 65 29 20 20 22 22 29 0a 09 09 09 09 09 tate) "")......
c780: 20 28 69 66 20 74 73 74 61 74 75 73 20 28 63 6f (if tstatus (co
c790: 6e 63 20 22 20 53 74 61 74 75 73 3a 20 22 20 74 nc " Status: " t
c7a0: 73 74 61 74 75 73 29 20 22 22 29 0a 09 09 09 09 status) "").....
c7b0: 09 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 . (if (get-value
c7c0: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
c7d0: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
c7e0: 64 65 78 20 22 72 75 6e 5f 64 75 72 61 74 69 6f dex "run_duratio
c7f0: 6e 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 63 n")...... (c
c800: 6f 6e 63 20 22 20 52 75 6e 74 69 6d 65 3a 20 22 onc " Runtime: "
c810: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
c820: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
c830: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
c840: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 29 0a run_duration")).
c850: 09 09 09 09 09 20 20 20 20 20 22 22 29 0a 09 09 ..... "")...
c860: 09 09 09 20 28 69 66 20 65 76 65 6e 74 2d 74 69 ... (if event-ti
c870: 6d 65 20 28 63 6f 6e 63 20 22 20 54 69 6d 65 3a me (conc " Time:
c880: 20 22 20 65 76 65 6e 74 2d 74 69 6d 65 29 20 22 " event-time) "
c890: 22 29 0a 09 09 09 09 09 20 28 69 66 20 28 67 65 ")...... (if (ge
c8a0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
c8b0: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
c8c0: 69 65 6c 64 2d 69 6e 64 65 78 20 22 68 6f 73 74 ield-index "host
c8d0: 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 63 6f ")...... (co
c8e0: 6e 63 20 22 20 48 6f 73 74 3a 20 22 20 28 67 65 nc " Host: " (ge
c8f0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
c900: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
c910: 69 65 6c 64 2d 69 6e 64 65 78 20 22 68 6f 73 74 ield-index "host
c920: 22 29 29 0a 09 09 09 09 09 20 20 20 20 20 22 22 "))...... ""
c930: 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 ))).... (if
c940: 20 28 6e 6f 74 20 28 6f 72 20 28 65 71 75 61 6c (not (or (equal
c950: 3f 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d ? (get-value-by-
c960: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
c970: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
c980: 22 73 74 61 74 75 73 22 29 20 22 50 41 53 53 22 "status") "PASS"
c990: 29 0a 09 09 09 09 09 20 20 20 28 65 71 75 61 6c )...... (equal
c9a0: 3f 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d ? (get-value-by-
c9b0: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
c9c0: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
c9d0: 22 73 74 61 74 75 73 22 29 20 22 57 41 52 4e 22 "status") "WARN"
c9e0: 29 0a 09 09 09 09 09 20 20 20 28 65 71 75 61 6c )...... (equal
c9f0: 3f 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d ? (get-value-by-
ca00: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
ca10: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
ca20: 22 73 74 61 74 65 22 29 20 20 22 4e 4f 54 5f 53 "state") "NOT_S
ca30: 54 41 52 54 45 44 22 29 29 29 0a 09 09 09 09 20 TARTED"))).....
ca40: 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 20 20 (begin.....
ca50: 28 70 72 69 6e 74 20 20 20 28 69 66 20 28 67 65 (print (if (ge
ca60: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
ca70: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
ca80: 69 65 6c 64 2d 69 6e 64 65 78 20 22 63 70 75 6c ield-index "cpul
ca90: 6f 61 64 22 29 0a 09 09 09 09 09 09 20 28 63 6f oad")....... (co
caa0: 6e 63 20 22 20 20 20 20 20 20 20 20 20 63 70 75 nc " cpu
cab0: 6c 6f 61 64 3a 20 20 22 20 20 20 28 67 65 74 2d load: " (get-
cac0: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
cad0: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
cae0: 6c 64 2d 69 6e 64 65 78 20 22 63 70 75 6c 6f 61 ld-index "cpuloa
caf0: 64 22 29 29 0a 09 09 09 09 09 09 20 22 22 29 20 d"))....... "")
cb00: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
cb10: 63 70 75 6c 6f 61 64 20 74 65 73 74 29 0a 09 09 cpuload test)...
cb20: 09 09 09 20 20 20 20 20 28 69 66 20 28 67 65 74 ... (if (get
cb30: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
cb40: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
cb50: 65 6c 64 2d 69 6e 64 65 78 20 22 64 69 73 6b 66 eld-index "diskf
cb60: 72 65 65 22 29 0a 09 09 09 09 09 09 20 28 63 6f ree")....... (co
cb70: 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 20 20 64 nc "\n d
cb80: 69 73 6b 66 72 65 65 3a 20 22 20 28 67 65 74 2d iskfree: " (get-
cb90: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
cba0: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
cbb0: 6c 64 2d 69 6e 64 65 78 20 22 64 69 73 6b 66 72 ld-index "diskfr
cbc0: 65 65 22 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 ee")) ;; (db:tes
cbd0: 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 65 20 74 t-get-diskfree t
cbe0: 65 73 74 29 0a 09 09 09 09 09 09 20 22 22 29 0a est)....... "").
cbf0: 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 67 ..... (if (g
cc00: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
cc10: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
cc20: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 75 6e 61 field-index "una
cc30: 6d 65 22 29 0a 09 09 09 09 09 09 20 28 63 6f 6e me")....... (con
cc40: 63 20 22 5c 6e 20 20 20 20 20 20 20 20 20 75 6e c "\n un
cc50: 61 6d 65 3a 20 20 20 20 22 20 28 67 65 74 2d 76 ame: " (get-v
cc60: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
cc70: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
cc80: 64 2d 69 6e 64 65 78 20 22 75 6e 61 6d 65 22 29 d-index "uname")
cc90: 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 ) ;; (db:test-ge
cca0: 74 2d 75 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 t-uname test)...
ccb0: 09 09 09 09 20 22 22 29 0a 09 09 09 09 09 20 20 .... "")......
ccc0: 20 20 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 (if (get-valu
ccd0: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
cce0: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
ccf0: 6e 64 65 78 20 22 72 75 6e 64 69 72 22 29 0a 09 ndex "rundir")..
cd00: 09 09 09 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 ..... (conc "\n
cd10: 20 20 20 20 20 20 20 20 72 75 6e 64 69 72 3a 20 rundir:
cd20: 20 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 " (get-value-b
cd30: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
cd40: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
cd50: 78 20 22 72 75 6e 64 69 72 22 29 29 20 3b 3b 20 x "rundir")) ;;
cd60: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e (db:test-get-run
cd70: 64 69 72 20 74 65 73 74 29 0a 09 09 09 09 09 09 dir test).......
cd80: 20 22 22 29 0a 3b 3b 09 09 09 09 09 20 20 20 20 "").;;.....
cd90: 20 22 5c 6e 20 20 20 20 20 20 20 20 20 72 75 6e "\n run
cda0: 64 69 72 3a 20 20 20 22 20 28 67 65 74 2d 76 61 dir: " (get-va
cdb0: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
cdc0: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
cdd0: 2d 69 6e 64 65 78 20 22 22 29 20 3b 3b 20 28 73 -index "") ;; (s
cde0: 64 62 3a 71 72 79 20 27 67 65 74 73 74 72 20 3b db:qry 'getstr ;
cdf0: 3b 20 28 66 69 6c 65 64 62 3a 67 65 74 2d 70 61 ; (filedb:get-pa
ce00: 74 68 20 2a 66 64 62 2a 20 0a 3b 3b 20 09 09 09 th *fdb* .;; ...
ce10: 09 09 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d .. (db:test-
ce20: 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 get-rundir test)
ce30: 20 3b 3b 20 29 0a 09 09 09 09 09 20 20 20 20 20 ;; )......
ce40: 29 0a 09 09 09 09 20 20 20 20 3b 3b 20 45 61 63 )..... ;; Eac
ce50: 68 20 74 65 73 74 0a 09 09 09 09 20 20 20 20 3b h test..... ;
ce60: 3b 20 44 4f 20 4e 4f 54 20 72 65 6d 6f 74 65 20 ; DO NOT remote
ce70: 72 75 6e 0a 09 09 09 09 20 20 20 20 28 6c 65 74 run..... (let
ce80: 20 28 28 73 74 65 70 73 20 28 64 62 3a 64 69 73 ((steps (db:dis
ce90: 70 61 74 63 68 2d 71 75 65 72 79 20 61 63 63 65 patch-query acce
cea0: 73 73 2d 6d 6f 64 65 20 72 6d 74 3a 67 65 74 2d ss-mode rmt:get-
ceb0: 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 steps-for-test d
cec0: 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d b:get-steps-for-
ced0: 74 65 73 74 20 72 75 6e 2d 69 64 20 28 64 62 3a test run-id (db:
cee0: 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 test-get-id test
cef0: 29 29 29 29 20 3b 3b 20 28 64 62 3a 67 65 74 2d )))) ;; (db:get-
cf00: 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 steps-for-test d
cf10: 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 28 bstruct run-id (
cf20: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 db:test-get-id t
cf30: 65 73 74 29 29 29 29 0a 09 09 09 09 20 20 20 20 est)))).....
cf40: 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 (for-each ....
cf50: 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 . (lambda
cf60: 28 73 74 65 70 29 0a 09 09 09 09 09 20 28 66 6f (step)...... (fo
cf70: 72 6d 61 74 20 23 74 20 0a 09 09 09 09 09 09 20 rmat #t .......
cf80: 22 20 20 20 20 53 74 65 70 3a 20 7e 32 30 61 20 " Step: ~20a
cf90: 53 74 61 74 65 3a 20 7e 31 30 61 20 53 74 61 74 State: ~10a Stat
cfa0: 75 73 3a 20 7e 31 30 61 20 54 69 6d 65 20 7e 32 us: ~10a Time ~2
cfb0: 32 61 5c 6e 22 0a 09 09 09 09 09 09 20 28 74 64 2a\n"....... (td
cfc0: 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 70 6e b:step-get-stepn
cfd0: 61 6d 65 20 73 74 65 70 29 0a 09 09 09 09 09 09 ame step).......
cfe0: 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 (tdb:step-get-s
cff0: 74 61 74 65 20 73 74 65 70 29 0a 09 09 09 09 09 tate step)......
d000: 09 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d . (tdb:step-get-
d010: 73 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 status step)....
d020: 09 09 09 20 28 74 64 62 3a 73 74 65 70 2d 67 65 ... (tdb:step-ge
d030: 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 t-event_time ste
d040: 70 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 p))).....
d050: 73 74 65 70 73 29 29 29 29 29 29 29 29 29 0a 09 steps)))))))))..
d060: 09 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 . (if (args
d070: 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f 72 74 22 :get-arg "-sort"
d080: 29 0a 09 09 09 20 20 28 73 6f 72 74 20 74 65 73 ).... (sort tes
d090: 74 73 0a 09 09 09 09 28 6c 61 6d 62 64 61 20 28 ts.....(lambda (
d0a0: 61 2d 74 65 73 74 20 62 2d 74 65 73 74 29 0a 09 a-test b-test)..
d0b0: 09 09 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 ... (let* ((key
d0c0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
d0d0: 67 20 22 2d 73 6f 72 74 22 29 29 0a 09 09 09 09 g "-sort")).....
d0e0: 09 20 28 66 69 72 73 74 20 20 28 67 65 74 2d 76 . (first (get-v
d0f0: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
d100: 65 20 61 2d 74 65 73 74 20 74 65 73 74 2d 66 69 e a-test test-fi
d110: 65 6c 64 2d 69 6e 64 65 78 20 6b 65 79 29 29 0a eld-index key)).
d120: 09 09 09 09 09 20 28 73 65 63 6f 6e 64 20 28 67 ..... (second (g
d130: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
d140: 64 6e 61 6d 65 20 62 2d 74 65 73 74 20 74 65 73 dname b-test tes
d150: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 6b 65 t-field-index ke
d160: 79 29 29 29 0a 09 09 09 09 20 20 20 20 28 28 63 y)))..... ((c
d170: 6f 6e 64 20 0a 09 09 09 09 20 20 20 20 20 20 28 ond ..... (
d180: 28 61 6e 64 20 28 6e 75 6d 62 65 72 3f 20 66 69 (and (number? fi
d190: 72 73 74 29 28 6e 75 6d 62 65 72 3f 20 73 65 63 rst)(number? sec
d1a0: 6f 6e 64 29 29 20 3c 29 0a 09 09 09 09 20 20 20 ond)) <).....
d1b0: 20 20 20 28 28 61 6e 64 20 28 73 74 72 69 6e 67 ((and (string
d1c0: 3f 20 66 69 72 73 74 29 28 73 74 72 69 6e 67 3f ? first)(string?
d1d0: 20 73 65 63 6f 6e 64 29 29 20 73 74 72 69 6e 67 second)) string
d1e0: 3c 3d 3f 29 0a 09 09 09 09 20 20 20 20 20 20 28 <=?)..... (
d1f0: 65 6c 73 65 20 65 71 75 61 6c 3f 29 29 0a 09 09 else equal?))...
d200: 09 09 20 20 20 20 20 66 69 72 73 74 20 73 65 63 .. first sec
d210: 6f 6e 64 29 29 29 29 0a 09 09 09 20 20 74 65 73 ond)))).... tes
d220: 74 73 29 29 29 29 29 29 0a 09 20 20 20 72 75 6e ts)))))).. run
d230: 73 29 0a 09 20 20 28 69 66 20 28 65 71 3f 20 64 s).. (if (eq? d
d240: 6d 6f 64 65 20 27 6a 73 6f 6e 29 28 6a 73 6f 6e mode 'json)(json
d250: 2d 77 72 69 74 65 20 64 61 74 61 29 29 0a 09 20 -write data))..
d260: 20 28 6c 65 74 2a 20 28 28 6d 65 74 61 64 61 74 (let* ((metadat
d270: 2d 66 69 65 6c 64 73 20 28 64 65 6c 65 74 65 2d -fields (delete-
d280: 64 75 70 6c 69 63 61 74 65 73 0a 09 09 09 09 20 duplicates.....
d290: 20 28 61 70 70 65 6e 64 20 6b 65 79 73 20 27 28 (append keys '(
d2a0: 20 22 72 75 6e 6e 61 6d 65 22 20 22 74 69 6d 65 "runname" "time
d2b0: 22 20 22 6f 77 6e 65 72 22 20 22 70 61 73 73 5f " "owner" "pass_
d2c0: 63 6f 75 6e 74 22 20 22 66 61 69 6c 5f 63 6f 75 count" "fail_cou
d2d0: 6e 74 22 20 22 73 74 61 74 65 22 20 22 73 74 61 nt" "state" "sta
d2e0: 74 75 73 22 20 22 63 6f 6d 6d 65 6e 74 22 20 22 tus" "comment" "
d2f0: 69 64 22 29 29 29 29 0a 09 09 20 28 72 75 6e 2d id"))))... (run-
d300: 66 69 65 6c 64 73 20 20 20 20 27 28 0a 09 09 09 fields '(....
d310: 09 20 20 22 74 65 73 74 6e 61 6d 65 22 0a 09 09 . "testname"...
d320: 09 09 20 20 22 69 74 65 6d 5f 70 61 74 68 22 0a .. "item_path".
d330: 09 09 09 09 20 20 22 73 74 61 74 65 22 0a 09 09 .... "state"...
d340: 09 09 20 20 22 73 74 61 74 75 73 22 0a 09 09 09 .. "status"....
d350: 09 20 20 22 63 6f 6d 6d 65 6e 74 22 0a 09 09 09 . "comment"....
d360: 09 20 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 0a . "event_time".
d370: 09 09 09 09 20 20 22 68 6f 73 74 22 0a 09 09 09 .... "host"....
d380: 09 20 20 22 72 75 6e 5f 69 64 22 0a 09 09 09 09 . "run_id".....
d390: 20 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 "run_duration"
d3a0: 0a 09 09 09 09 20 20 22 61 74 74 65 6d 70 74 6e ..... "attemptn
d3b0: 75 6d 22 0a 09 09 09 09 20 20 22 69 64 22 0a 09 um"..... "id"..
d3c0: 09 09 09 20 20 22 61 72 63 68 69 76 65 64 22 0a ... "archived".
d3d0: 09 09 09 09 20 20 22 64 69 73 6b 66 72 65 65 22 .... "diskfree"
d3e0: 0a 09 09 09 09 20 20 22 63 70 75 6c 6f 61 64 22 ..... "cpuload"
d3f0: 0a 09 09 09 09 20 20 22 66 69 6e 61 6c 5f 6c 6f ..... "final_lo
d400: 67 66 22 0a 09 09 09 09 20 20 22 73 68 6f 72 74 gf"..... "short
d410: 64 69 72 22 0a 09 09 09 09 20 20 22 72 75 6e 64 dir"..... "rund
d420: 69 72 22 0a 09 09 09 09 20 20 22 75 6e 61 6d 65 ir"..... "uname
d430: 22 0a 09 09 09 09 20 20 29 0a 09 09 09 09 29 0a "..... ).....).
d440: 09 09 20 28 6e 65 77 64 61 74 20 20 20 20 20 20 .. (newdat
d450: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 74 6f 2d 61 (common:to-a
d460: 6c 69 73 74 20 64 61 74 61 29 29 0a 09 09 20 28 list data))... (
d470: 61 6c 6c 72 75 6e 64 61 74 20 20 20 20 20 20 20 allrundat
d480: 28 69 66 20 28 6e 75 6c 6c 3f 20 6e 65 77 64 61 (if (null? newda
d490: 74 29 0a 09 09 09 09 20 20 20 20 20 20 27 28 29 t)..... '()
d4a0: 0a 09 09 09 09 20 20 20 20 20 20 28 63 61 72 20 ..... (car
d4b0: 28 6d 61 70 20 63 64 72 20 6e 65 77 64 61 74 29 (map cdr newdat)
d4c0: 29 29 29 20 3b 3b 20 28 63 61 72 20 28 6d 61 70 ))) ;; (car (map
d4d0: 20 63 64 72 20 28 63 61 72 20 28 6d 61 70 20 63 cdr (car (map c
d4e0: 64 72 20 6e 65 77 64 61 74 29 29 29 29 29 0a 09 dr newdat)))))..
d4f0: 09 20 28 72 75 6e 73 20 20 20 20 20 20 20 20 20 . (runs
d500: 20 20 20 28 61 70 70 65 6e 64 0a 09 09 09 09 20 (append.....
d510: 20 20 28 6c 69 73 74 20 22 72 75 6e 73 22 20 3b (list "runs" ;
d520: 3b 20 73 68 65 65 74 6e 61 6d 65 0a 09 09 09 09 ; sheetname.....
d530: 09 20 6d 65 74 61 64 61 74 2d 66 69 65 6c 64 73 . metadat-fields
d540: 29 0a 09 09 09 09 20 20 20 28 6d 61 70 20 28 6c )..... (map (l
d550: 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 09 09 09 ambda (run).....
d560: 09 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 72 75 . ;; (print "ru
d570: 6e 3a 20 22 20 72 75 6e 29 0a 09 09 09 09 09 20 n: " run)......
d580: 20 28 6c 65 74 2a 20 28 28 72 75 6e 6e 61 6d 65 (let* ((runname
d590: 20 28 63 61 72 20 72 75 6e 29 29 0a 09 09 09 09 (car run)).....
d5a0: 09 09 20 28 72 75 6e 64 61 74 20 20 28 63 64 72 .. (rundat (cdr
d5b0: 20 72 75 6e 29 29 0a 09 09 09 09 09 09 20 28 6d run))....... (m
d5c0: 65 74 61 64 61 74 20 28 6c 65 74 20 28 28 74 6d etadat (let ((tm
d5d0: 70 20 28 61 73 73 6f 63 20 22 6d 65 74 61 22 20 p (assoc "meta"
d5e0: 72 75 6e 64 61 74 29 29 29 0a 09 09 09 09 09 09 rundat))).......
d5f0: 09 20 20 20 20 28 69 66 20 74 6d 70 20 28 63 64 . (if tmp (cd
d600: 72 20 74 6d 70 29 20 23 66 29 29 29 29 0a 09 09 r tmp) #f))))...
d610: 09 09 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 ... ;; (print
d620: 20 22 72 75 6e 6e 61 6d 65 3a 20 22 20 72 75 6e "runname: " run
d630: 6e 61 6d 65 20 22 5c 6e 5c 6e 72 75 6e 64 61 74 name "\n\nrundat
d640: 3a 20 22 20 29 28 70 70 20 72 75 6e 64 61 74 29 : " )(pp rundat)
d650: 28 70 72 69 6e 74 20 22 5c 6e 5c 6e 6d 65 74 61 (print "\n\nmeta
d660: 64 61 74 3a 20 22 29 28 70 70 20 6d 65 74 61 64 dat: ")(pp metad
d670: 61 74 29 0a 09 09 09 09 09 20 20 20 20 28 69 66 at)...... (if
d680: 20 6d 65 74 61 64 61 74 0a 09 09 09 09 09 09 28 metadat.......(
d690: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 66 69 65 map (lambda (fie
d6a0: 6c 64 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 ld).......
d6b0: 20 28 6c 65 74 20 28 28 74 6d 70 20 28 61 73 73 (let ((tmp (ass
d6c0: 6f 63 20 66 69 65 6c 64 20 6d 65 74 61 64 61 74 oc field metadat
d6d0: 29 29 29 0a 09 09 09 09 09 09 09 20 28 69 66 20 )))........ (if
d6e0: 74 6d 70 20 28 63 64 72 20 74 6d 70 29 20 22 22 tmp (cdr tmp) ""
d6f0: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 6d )))....... m
d700: 65 74 61 64 61 74 2d 66 69 65 6c 64 73 29 0a 09 etadat-fields)..
d710: 09 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 09 .....(begin.....
d720: 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
d730: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
d740: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
d750: 6d 65 74 61 20 64 61 74 61 20 66 6f 72 20 72 75 meta data for ru
d760: 6e 20 22 20 72 75 6e 6e 61 6d 65 20 22 20 6e 6f n " runname " no
d770: 74 20 66 6f 75 6e 64 22 29 0a 09 09 09 09 09 09 t found").......
d780: 20 20 27 28 29 29 29 29 29 0a 09 09 09 09 09 61 '()))))......a
d790: 6c 6c 72 75 6e 64 61 74 29 29 29 0a 09 09 20 3b llrundat)))... ;
d7a0: 3b 20 27 28 20 28 20 22 74 61 72 67 65 74 22 20 ; '( ( "target"
d7b0: 28 20 22 72 75 6e 6e 61 6d 65 22 20 28 20 22 64 ( "runname" ( "d
d7c0: 61 74 61 22 20 28 20 22 72 75 6e 69 64 22 20 28 ata" ( "runid" (
d7d0: 20 22 69 64 20 2e 20 22 33 37 22 20 29 20 28 20 "id . "37" ) (
d7e0: 2e 2e 2e 20 29 29 29 29 0a 09 09 20 28 72 75 6e ... ))))... (run
d7f0: 2d 70 61 67 65 73 20 20 20 20 20 20 28 6d 61 70 -pages (map
d800: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 64 61 (lambda (targda
d810: 74 29 0a 09 09 09 09 09 28 6c 65 74 2a 20 28 28 t)......(let* ((
d820: 74 61 72 67 65 74 20 20 28 63 61 72 20 74 61 72 target (car tar
d830: 67 64 61 74 29 29 0a 09 09 09 09 09 20 20 20 20 gdat))......
d840: 20 20 20 28 72 75 6e 73 64 61 74 20 28 63 64 72 (runsdat (cdr
d850: 20 74 61 72 67 64 61 74 29 29 29 0a 09 09 09 09 targdat))).....
d860: 09 20 20 28 69 66 20 72 75 6e 73 64 61 74 0a 09 . (if runsdat..
d870: 09 09 09 09 20 20 20 20 20 20 28 6d 61 70 20 28 .... (map (
d880: 6c 61 6d 62 64 61 20 28 72 75 6e 64 61 74 29 0a lambda (rundat).
d890: 09 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a ...... (let*
d8a0: 20 28 28 72 75 6e 6e 61 6d 65 20 20 28 63 61 72 ((runname (car
d8b0: 20 72 75 6e 64 61 74 29 29 0a 09 09 09 09 09 09 rundat)).......
d8c0: 09 20 20 20 20 28 72 75 6e 64 61 74 20 20 20 28 . (rundat (
d8d0: 63 64 72 20 72 75 6e 64 61 74 29 29 0a 09 09 09 cdr rundat))....
d8e0: 09 09 09 09 20 20 20 20 28 74 65 73 74 73 64 61 .... (testsda
d8f0: 74 20 28 6c 65 74 20 28 28 74 6d 70 20 28 61 73 t (let ((tmp (as
d900: 73 6f 63 20 22 64 61 74 61 22 20 72 75 6e 64 61 soc "data" runda
d910: 74 29 29 29 0a 09 09 09 09 09 09 09 09 09 28 69 t)))..........(i
d920: 66 20 74 6d 70 20 28 63 64 72 20 74 6d 70 29 20 f tmp (cdr tmp)
d930: 23 66 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 #f)))).......
d940: 20 20 20 20 28 69 66 20 74 65 73 74 73 64 61 74 (if testsdat
d950: 0a 09 09 09 09 09 09 09 20 20 20 28 6c 65 74 20 ........ (let
d960: 28 28 74 65 73 74 73 20 28 6d 61 70 20 28 6c 61 ((tests (map (la
d970: 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 09 09 mbda (test).....
d980: 09 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 ..... (let
d990: 2a 20 28 28 74 65 73 74 2d 69 64 20 20 28 63 61 * ((test-id (ca
d9a0: 72 20 74 65 73 74 29 29 0a 09 09 09 09 09 09 09 r test))........
d9b0: 09 09 09 20 20 20 20 20 20 28 74 65 73 74 2d 64 ... (test-d
d9c0: 61 74 20 28 63 64 72 20 74 65 73 74 29 29 29 0a at (cdr test))).
d9d0: 09 09 09 09 09 09 09 09 09 09 20 28 6d 61 70 20 .......... (map
d9e0: 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 29 0a (lambda (field).
d9f0: 09 09 09 09 09 09 09 09 09 09 09 28 6c 65 74 20 ...........(let
da00: 28 28 74 6d 70 20 28 61 73 73 6f 63 20 66 69 65 ((tmp (assoc fie
da10: 6c 64 20 74 65 73 74 2d 64 61 74 29 29 29 0a 09 ld test-dat)))..
da20: 09 09 09 09 09 09 09 09 09 09 20 20 28 69 66 20 .......... (if
da30: 74 6d 70 20 28 63 64 72 20 74 6d 70 29 20 22 22 tmp (cdr tmp) ""
da40: 29 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 )))...........
da50: 20 20 20 20 72 75 6e 2d 66 69 65 6c 64 73 29 29 run-fields))
da60: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
da70: 74 65 73 74 73 64 61 74 29 29 29 0a 09 09 09 09 testsdat))).....
da80: 09 09 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e ... ;; (prin
da90: 74 20 22 54 61 72 67 65 74 3a 20 22 20 74 61 72 t "Target: " tar
daa0: 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 get "/" runname
dab0: 22 20 74 65 73 74 73 3a 22 29 0a 09 09 09 09 09 " tests:")......
dac0: 09 09 20 20 20 20 20 3b 3b 20 28 70 70 20 74 65 .. ;; (pp te
dad0: 73 74 73 29 0a 09 09 09 09 09 09 09 20 20 20 20 sts)........
dae0: 20 28 63 6f 6e 73 20 28 63 6f 6e 63 20 74 61 72 (cons (conc tar
daf0: 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 get "/" runname)
db00: 0a 09 09 09 09 09 09 09 09 20 20 20 28 63 6f 6e ......... (con
db10: 73 20 28 6c 69 73 74 20 28 63 6f 6e 63 20 74 61 s (list (conc ta
db20: 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 rget "/" runname
db30: 29 29 0a 09 09 09 09 09 09 09 09 09 20 28 63 6f )).......... (co
db40: 6e 73 20 27 28 29 0a 09 09 09 09 09 09 09 09 09 ns '()..........
db50: 20 20 20 20 20 20 20 28 63 6f 6e 73 20 72 75 6e (cons run
db60: 2d 66 69 65 6c 64 73 20 74 65 73 74 73 29 29 29 -fields tests)))
db70: 29 29 0a 09 09 09 09 09 09 09 20 20 20 28 62 65 ))........ (be
db80: 67 69 6e 0a 09 09 09 09 09 09 09 20 20 20 20 20 gin........
db90: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
dba0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
dbb0: 2a 20 22 57 41 52 4e 49 4e 47 3a 20 72 75 6e 20 * "WARNING: run
dbc0: 22 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e " target "/" run
dbd0: 6e 61 6d 65 20 22 20 61 70 70 65 61 72 73 20 74 name " appears t
dbe0: 6f 20 68 61 76 65 20 6e 6f 20 64 61 74 61 22 29 o have no data")
dbf0: 0a 09 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 ........ ;;
dc00: 28 70 70 20 72 75 6e 64 61 74 29 0a 09 09 09 09 (pp rundat).....
dc10: 09 09 09 20 20 20 20 20 27 28 29 29 29 29 29 0a ... '())))).
dc20: 09 09 09 09 09 09 20 20 20 72 75 6e 73 64 61 74 ...... runsdat
dc30: 29 0a 09 09 09 09 09 20 20 20 20 20 20 27 28 29 )...... '()
dc40: 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 6e 65 )))..... ne
dc50: 77 64 61 74 29 29 20 3b 3b 20 77 65 20 75 73 65 wdat)) ;; we use
dc60: 20 6e 65 77 64 61 74 20 74 6f 20 67 65 74 20 74 newdat to get t
dc70: 61 72 67 65 74 0a 09 09 20 28 73 68 65 65 74 73 arget... (sheets
dc80: 20 20 20 20 20 20 20 20 20 28 66 69 6c 74 65 72 (filter
dc90: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x)....
dca0: 09 09 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f .. (not (null?
dcb0: 20 78 29 29 29 0a 09 09 09 09 09 20 28 63 6f 6e x)))...... (con
dcc0: 73 20 72 75 6e 73 20 28 6d 61 70 20 63 61 72 20 s runs (map car
dcd0: 72 75 6e 2d 70 61 67 65 73 29 29 29 29 29 0a 09 run-pages)))))..
dce0: 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 61 ;; (print "a
dcf0: 6c 6c 72 75 6e 64 61 74 3a 22 29 0a 09 20 20 20 llrundat:")..
dd00: 20 3b 3b 20 28 70 70 20 61 6c 6c 72 75 6e 64 61 ;; (pp allrunda
dd10: 74 29 0a 09 20 20 20 20 3b 3b 20 28 70 72 69 6e t).. ;; (prin
dd20: 74 20 22 72 75 6e 73 3a 22 29 0a 09 20 20 20 20 t "runs:")..
dd30: 3b 3b 20 28 70 70 20 72 75 6e 73 29 0a 09 20 20 ;; (pp runs)..
dd40: 20 20 3b 28 70 72 69 6e 74 20 22 73 68 65 65 74 ;(print "sheet
dd50: 73 3a 20 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 s: ").. ;; (p
dd60: 70 20 73 68 65 65 74 73 29 0a 09 20 20 20 20 28 p sheets).. (
dd70: 69 66 20 28 65 71 3f 20 64 6d 6f 64 65 20 27 6f if (eq? dmode 'o
dd80: 64 73 29 0a 09 09 28 6c 65 74 2a 20 28 28 74 65 ds)...(let* ((te
dd90: 6d 70 64 69 72 20 20 20 20 28 63 6f 6e 63 20 22 mpdir (conc "
dda0: 2f 74 6d 70 2f 22 20 28 63 75 72 72 65 6e 74 2d /tmp/" (current-
ddb0: 75 73 65 72 2d 6e 61 6d 65 29 20 22 2f 22 20 28 user-name) "/" (
ddc0: 72 61 6e 64 6f 6d 20 31 30 30 30 30 29 20 22 5f random 10000) "_
ddd0: 22 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 " (current-proce
dde0: 73 73 2d 69 64 29 29 29 0a 09 09 20 20 20 20 20 ss-id)))...
ddf0: 20 20 28 6f 75 74 70 75 74 66 69 6c 65 20 28 6f (outputfile (o
de00: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
de10: 22 2d 6f 22 29 20 22 6f 75 74 2e 6f 64 73 22 29 "-o") "out.ods")
de20: 29 0a 09 09 20 20 20 20 20 20 20 28 6f 75 66 20 )... (ouf
de30: 20 20 20 20 20 20 20 28 69 66 20 28 73 74 72 69 (if (stri
de40: 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 ng-match (regexp
de50: 20 22 5e 5b 2f 7e 5d 2b 2e 2a 22 29 20 6f 75 74 "^[/~]+.*") out
de60: 70 75 74 66 69 6c 65 29 20 3b 3b 20 66 75 6c 6c putfile) ;; full
de70: 20 70 61 74 68 3f 0a 09 09 09 09 20 20 20 20 20 path?.....
de80: 20 20 6f 75 74 70 75 74 66 69 6c 65 0a 09 09 09 outputfile....
de90: 09 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 . (begin..
dea0: 09 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e .... (debug:prin
deb0: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
dec0: 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a -port* "WARNING:
ded0: 20 70 61 74 68 20 67 69 76 65 6e 2c 20 22 20 6f path given, " o
dee0: 75 74 70 75 74 66 69 6c 65 20 22 20 69 73 20 72 utputfile " is r
def0: 65 6c 61 74 69 76 65 2c 20 70 72 65 66 69 78 69 elative, prefixi
df00: 6e 67 20 77 69 74 68 20 63 75 72 72 65 6e 74 20 ng with current
df10: 64 69 72 65 63 74 6f 72 79 22 29 0a 09 09 09 09 directory").....
df20: 09 20 28 63 6f 6e 63 20 28 63 75 72 72 65 6e 74 . (conc (current
df30: 2d 64 69 72 65 63 74 6f 72 79 29 20 22 2f 22 20 -directory) "/"
df40: 6f 75 74 70 75 74 66 69 6c 65 29 29 29 29 29 0a outputfile))))).
df50: 09 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 .. (create-dire
df60: 63 74 6f 72 79 20 74 65 6d 70 64 69 72 20 23 74 ctory tempdir #t
df70: 29 0a 09 09 20 20 28 6f 64 73 3a 6c 69 73 74 2d )... (ods:list-
df80: 3e 6f 64 73 20 74 65 6d 70 64 69 72 20 6f 75 66 >ods tempdir ouf
df90: 20 73 68 65 65 74 73 29 29 29 29 0a 09 20 20 3b sheets)))).. ;
dfa0: 3b 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 ; (system (conc
dfb0: 22 72 6d 20 2d 72 66 20 22 20 74 65 6d 70 64 69 "rm -rf " tempdi
dfc0: 72 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 r)).. (set! *di
dfd0: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
dfe0: 29 29 0a 0a 3b 3b 20 44 6f 6e 27 74 20 74 68 69 ))..;; Don't thi
dff0: 6e 6b 20 49 20 6e 65 65 64 20 74 68 69 73 2e 20 nk I need this.
e000: 49 6e 63 6f 72 70 6f 72 61 74 65 64 20 69 6e 74 Incorporated int
e010: 6f 20 2d 6c 69 73 74 2d 72 75 6e 73 20 69 6e 73 o -list-runs ins
e020: 74 65 61 64 0a 3b 3b 0a 3b 3b 20 28 69 66 20 28 tead.;;.;; (if (
e030: 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 and (args:get-ar
e040: 67 20 22 2d 73 69 6e 63 65 22 29 0a 3b 3b 20 09 g "-since").;; .
e050: 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
e060: 0a 3b 3b 20 20 20 20 20 28 6c 65 74 2a 20 28 28 .;; (let* ((
e070: 73 69 6e 63 65 2d 74 69 6d 65 20 28 73 74 72 69 since-time (stri
e080: 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 ng->number (args
e090: 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 :get-arg "-since
e0a0: 22 29 29 29 0a 3b 3b 20 09 20 20 20 28 72 75 6e "))).;; . (run
e0b0: 2d 69 64 73 20 20 20 20 28 64 62 3a 67 65 74 2d -ids (db:get-
e0c0: 63 68 61 6e 67 65 64 2d 72 75 6e 2d 69 64 73 20 changed-run-ids
e0d0: 73 69 6e 63 65 2d 74 69 6d 65 29 29 29 0a 3b 3b since-time))).;;
e0e0: 20 20 20 20 20 20 20 3b 3b 20 28 72 6d 74 3a 67 ;; (rmt:g
e0f0: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
e100: 73 2d 6d 69 6e 64 61 74 61 20 72 75 6e 2d 69 64 s-mindata run-id
e110: 73 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 s testpatt state
e120: 73 20 73 74 61 74 75 73 20 6e 6f 74 2d 69 6e 29 s status not-in)
e130: 0a 3b 3b 20 20 20 20 20 20 20 28 70 72 69 6e 74 .;; (print
e140: 20 28 73 6f 72 74 20 72 75 6e 2d 69 64 73 20 3c (sort run-ids <
e150: 29 29 0a 3b 3b 20 20 20 20 20 20 20 28 73 65 74 )).;; (set
e160: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
e170: 20 23 74 29 29 29 0a 20 20 20 20 20 20 0a 20 20 #t))). .
e180: 20 20 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=========
e190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e1a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e1b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e1c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
e1d0: 20 66 75 6c 6c 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d full run.;;====
e1e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e1f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e220: 3d 3d 0a 0a 3b 3b 20 67 65 74 20 6c 6f 63 6b 20 ==..;; get lock
e230: 69 6e 20 64 62 20 66 6f 72 20 66 75 6c 6c 20 72 in db for full r
e240: 75 6e 20 66 6f 72 20 74 68 69 73 20 64 69 72 65 un for this dire
e250: 63 74 6f 72 79 0a 3b 3b 20 66 6f 72 20 61 6c 6c ctory.;; for all
e260: 20 74 65 73 74 73 20 77 69 74 68 20 64 65 70 73 tests with deps
e270: 0a 3b 3b 20 20 20 77 61 6c 6b 20 74 72 65 65 20 .;; walk tree
e280: 6f 66 20 74 65 73 74 73 20 74 6f 20 66 69 6e 64 of tests to find
e290: 20 68 65 61 64 20 74 61 73 6b 73 0a 3b 3b 20 20 head tasks.;;
e2a0: 20 61 64 64 20 68 65 61 64 20 74 61 73 6b 73 20 add head tasks
e2b0: 74 6f 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b to task queue.;;
e2c0: 20 20 20 61 64 64 20 64 65 70 65 6e 64 61 6e 74 add dependant
e2d0: 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 tasks to task q
e2e0: 75 65 75 65 20 0a 3b 3b 20 20 20 61 64 64 20 72 ueue .;; add r
e2f0: 65 6d 61 69 6e 69 6e 67 20 74 61 73 6b 73 20 74 emaining tasks t
e300: 6f 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 o task queue.;;
e310: 66 6f 72 20 65 61 63 68 20 74 61 73 6b 20 69 6e for each task in
e320: 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 20 task queue.;;
e330: 20 69 66 20 68 61 76 65 20 61 64 65 71 75 61 74 if have adequat
e340: 65 20 72 65 73 6f 75 72 63 65 73 0a 3b 3b 20 20 e resources.;;
e350: 20 20 20 6c 61 75 6e 63 68 20 74 61 73 6b 0a 3b launch task.;
e360: 3b 20 20 20 65 6c 73 65 0a 3b 3b 20 20 20 20 20 ; else.;;
e370: 70 75 74 20 74 61 73 6b 20 69 6e 20 64 65 66 65 put task in defe
e380: 72 72 65 64 20 71 75 65 75 65 0a 3b 3b 20 69 66 rred queue.;; if
e390: 20 73 74 69 6c 6c 20 6f 6b 20 74 6f 20 72 75 6e still ok to run
e3a0: 20 74 61 73 6b 73 0a 3b 3b 20 20 20 70 72 6f 63 tasks.;; proc
e3b0: 65 73 73 20 64 65 66 65 72 72 65 64 20 74 61 73 ess deferred tas
e3c0: 6b 73 20 70 65 72 20 61 62 6f 76 65 20 73 74 65 ks per above ste
e3d0: 70 73 0a 0a 3b 3b 20 72 75 6e 20 61 6c 6c 20 74 ps..;; run all t
e3e0: 65 73 74 73 20 61 72 65 20 61 72 65 20 4e 6f 74 ests are are Not
e3f0: 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 50 COMPLETED and P
e400: 41 53 53 20 6f 72 20 43 48 45 43 4b 0a 28 69 66 ASS or CHECK.(if
e410: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
e420: 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 0a 09 28 rg "-runall")..(
e430: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
e440: 75 6e 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d un")..(args:get-
e450: 61 72 67 20 22 2d 72 65 72 75 6e 2d 63 6c 65 61 arg "-rerun-clea
e460: 6e 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 n")..(args:get-a
e470: 72 67 20 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 29 rg "-rerun-all")
e480: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
e490: 22 2d 72 75 6e 74 65 73 74 73 22 29 29 0a 20 20 "-runtests")).
e4a0: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
e4b0: 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 75 6e 61 all . "-runa
e4c0: 6c 6c 22 0a 20 20 20 20 20 22 72 75 6e 20 61 6c ll". "run al
e4d0: 6c 20 74 65 73 74 73 22 0a 20 20 20 20 20 28 6c l tests". (l
e4e0: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
e4f0: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 nname keys keyva
e500: 6c 73 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 ls). (if (
e510: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
e520: 65 72 75 6e 2d 63 6c 65 61 6e 22 29 20 3b 3b 20 erun-clean") ;;
e530: 66 69 72 73 74 20 73 65 74 20 73 74 61 74 65 73 first set states
e540: 2f 73 74 61 74 75 73 65 73 20 63 6f 72 72 65 63 /statuses correc
e550: 74 0a 09 20 20 20 28 6c 65 74 20 28 28 73 74 61 t.. (let ((sta
e560: 74 65 73 20 20 20 28 6f 72 20 28 63 6f 6e 66 69 tes (or (confi
e570: 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 gf:lookup *confi
e580: 67 64 61 74 2a 20 22 76 61 6c 69 64 76 61 6c 75 gdat* "validvalu
e590: 65 73 22 20 22 63 6c 65 61 6e 72 65 72 75 6e 2d es" "cleanrerun-
e5a0: 73 74 61 74 65 73 22 29 0a 09 09 09 20 20 20 20 states")....
e5b0: 20 20 20 22 4b 49 4c 4c 52 45 51 2c 4b 49 4c 4c "KILLREQ,KILL
e5c0: 45 44 2c 55 4e 4b 4e 4f 57 4e 2c 49 4e 43 4f 4d ED,UNKNOWN,INCOM
e5d0: 50 4c 45 54 45 2c 53 54 55 43 4b 2c 4e 4f 54 5f PLETE,STUCK,NOT_
e5e0: 53 54 41 52 54 45 44 22 29 29 0a 09 09 20 28 73 STARTED"))... (s
e5f0: 74 61 74 75 73 65 73 20 28 6f 72 20 28 63 6f 6e tatuses (or (con
e600: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e figf:lookup *con
e610: 66 69 67 64 61 74 2a 20 22 76 61 6c 69 64 76 61 figdat* "validva
e620: 6c 75 65 73 22 20 22 63 6c 65 61 6e 72 65 72 75 lues" "cleanreru
e630: 6e 2d 73 74 61 74 75 73 65 73 22 29 0a 09 09 09 n-statuses")....
e640: 20 20 20 20 20 20 20 22 46 41 49 4c 2c 49 4e 43 "FAIL,INC
e650: 4f 4d 50 4c 45 54 45 2c 41 42 4f 52 54 2c 43 48 OMPLETE,ABORT,CH
e660: 45 43 4b 22 29 29 29 0a 09 20 20 20 20 20 28 68 ECK"))).. (h
e670: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 ash-table-set! a
e680: 72 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 70 rgs:arg-hash "-p
e690: 72 65 63 6c 65 61 6e 22 20 23 74 29 0a 09 20 20 reclean" #t)..
e6a0: 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 (runs:operate
e6b0: 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 -on 'set-state-s
e6c0: 74 61 74 75 73 0a 09 09 09 20 20 20 20 20 20 74 tatus.... t
e6d0: 61 72 67 65 74 0a 09 09 09 20 20 20 20 20 20 28 arget.... (
e6e0: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
e6f0: 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 runname) ;; (or
e700: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
e710: 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a -runname")(args:
e720: 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d get-arg ":runnam
e730: 65 22 29 29 0a 09 09 09 20 20 20 20 20 20 22 25 e")).... "%
e740: 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 " ;; (common:arg
e750: 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 s-get-testpatt #
e760: 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d f) ;; (args:get-
e770: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
e780: 0a 09 09 09 20 20 20 20 20 20 73 74 61 74 65 3a .... state:
e790: 20 20 73 74 61 74 65 73 0a 09 09 09 20 20 20 20 states....
e7a0: 20 20 3b 3b 20 73 74 61 74 75 73 3a 20 73 74 61 ;; status: sta
e7b0: 74 75 73 65 73 0a 09 09 09 20 20 20 20 20 20 6e tuses.... n
e7c0: 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a ew-state-status:
e7d0: 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f "NOT_STARTED,n/
e7e0: 61 22 29 0a 09 20 20 20 20 20 28 72 75 6e 73 3a a").. (runs:
e7f0: 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d operate-on 'set-
e800: 73 74 61 74 65 2d 73 74 61 74 75 73 0a 09 09 09 state-status....
e810: 20 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 target....
e820: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 (common:ar
e830: 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 gs-get-runname)
e840: 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 ;; (or (args:ge
e850: 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
e860: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
e870: 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 :runname"))....
e880: 20 20 20 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d "%" ;; (com
e890: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 mon:args-get-tes
e8a0: 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 tpatt #f) ;; (ar
e8b0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
e8c0: 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 tpatt")....
e8d0: 20 3b 3b 20 73 74 61 74 65 3a 20 20 73 74 61 74 ;; state: stat
e8e0: 65 73 0a 09 09 09 20 20 20 20 20 20 73 74 61 74 es.... stat
e8f0: 75 73 3a 20 73 74 61 74 75 73 65 73 0a 09 09 09 us: statuses....
e900: 20 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d new-state-
e910: 73 74 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 status: "NOT_STA
e920: 52 54 45 44 2c 6e 2f 61 22 29 29 29 0a 20 20 20 RTED,n/a"))).
e930: 20 20 20 20 3b 3b 20 52 45 52 55 4e 20 41 4c 4c ;; RERUN ALL
e940: 0a 20 20 20 20 20 20 20 28 69 66 20 28 61 72 67 . (if (arg
e950: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 72 75 s:get-arg "-reru
e960: 6e 2d 61 6c 6c 22 29 20 3b 3b 20 66 69 72 73 74 n-all") ;; first
e970: 20 73 65 74 20 73 74 61 74 65 73 2f 73 74 61 74 set states/stat
e980: 75 73 65 73 20 63 6f 72 72 65 63 74 0a 09 20 20 uses correct..
e990: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 68 (begin.. (h
e9a0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 ash-table-set! a
e9b0: 72 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 70 rgs:arg-hash "-p
e9c0: 72 65 63 6c 65 61 6e 22 20 23 74 29 0a 09 20 20 reclean" #t)..
e9d0: 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 (runs:operate
e9e0: 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 -on 'set-state-s
e9f0: 74 61 74 75 73 0a 09 09 09 20 20 20 20 20 20 74 tatus.... t
ea00: 61 72 67 65 74 0a 09 09 09 20 20 20 20 20 20 28 arget.... (
ea10: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
ea20: 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 runname) ;; (or
ea30: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
ea40: 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a -runname")(args:
ea50: 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d get-arg ":runnam
ea60: 65 22 29 29 0a 09 09 09 20 20 20 20 20 20 22 25 e")).... "%
ea70: 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 " ;; (common:arg
ea80: 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 s-get-testpatt #
ea90: 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d f) ;; (args:get-
eaa0: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
eab0: 0a 09 09 09 20 20 20 20 20 20 73 74 61 74 65 3a .... state:
eac0: 20 20 23 66 0a 09 09 09 20 20 20 20 20 20 3b 3b #f.... ;;
ead0: 20 73 74 61 74 75 73 3a 20 73 74 61 74 75 73 65 status: statuse
eae0: 73 0a 09 09 09 20 20 20 20 20 20 6e 65 77 2d 73 s.... new-s
eaf0: 74 61 74 65 2d 73 74 61 74 75 73 3a 20 22 4e 4f tate-status: "NO
eb00: 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 22 29 0a T_STARTED,n/a").
eb10: 09 20 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 . (runs:oper
eb20: 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 ate-on 'set-stat
eb30: 65 2d 73 74 61 74 75 73 0a 09 09 09 20 20 20 20 e-status....
eb40: 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 target....
eb50: 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 (common:args-g
eb60: 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 et-runname) ;;
eb70: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
eb80: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 g "-runname")(ar
eb90: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
eba0: 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 name"))....
ebb0: 20 22 25 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a "%" ;; (common:
ebc0: 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 args-get-testpat
ebd0: 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 t #f) ;; (args:g
ebe0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
ebf0: 74 22 29 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 t").... ;;
ec00: 73 74 61 74 65 3a 20 20 73 74 61 74 65 73 0a 09 state: states..
ec10: 09 09 20 20 20 20 20 20 73 74 61 74 75 73 3a 20 .. status:
ec20: 23 66 0a 09 09 09 20 20 20 20 20 20 6e 65 77 2d #f.... new-
ec30: 73 74 61 74 65 2d 73 74 61 74 75 73 3a 20 22 4e state-status: "N
ec40: 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 22 29 OT_STARTED,n/a")
ec50: 29 29 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a )). (runs:
ec60: 72 75 6e 2d 74 65 73 74 73 20 74 61 72 67 65 74 run-tests target
ec70: 0a 09 09 20 20 20 20 20 20 20 72 75 6e 6e 61 6d ... runnam
ec80: 65 0a 09 09 20 20 20 20 20 20 20 23 66 20 3b 3b e... #f ;;
ec90: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
eca0: 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 0a 09 t-testpatt #f)..
ecb0: 09 20 20 20 20 20 20 20 3b 3b 20 28 6f 72 20 28 . ;; (or (
ecc0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
ecd0: 65 73 74 70 61 74 74 22 29 0a 09 09 20 20 20 20 estpatt")...
ece0: 20 20 20 3b 3b 20 20 20 20 20 22 25 22 29 0a 09 ;; "%")..
ecf0: 09 20 20 20 20 20 20 20 75 73 65 72 0a 09 09 20 . user...
ed00: 20 20 20 20 20 20 61 72 67 73 3a 61 72 67 2d 68 args:arg-h
ed10: 61 73 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d ash))))..;;=====
ed20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ed30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ed40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ed50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ed60: 3d 0a 3b 3b 20 72 75 6e 20 6f 6e 65 20 74 65 73 =.;; run one tes
ed70: 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d t.;;============
ed80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ed90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eda0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
edb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 ==========..;; 1
edc0: 2e 20 66 69 6e 64 20 74 68 65 20 63 6f 6e 66 69 . find the confi
edd0: 67 20 66 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 61 g file.;; 2. cha
ede0: 6e 67 65 20 74 6f 20 74 68 65 20 74 65 73 74 20 nge to the test
edf0: 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 33 2e 20 directory.;; 3.
ee00: 75 70 64 61 74 65 20 74 68 65 20 64 62 20 77 69 update the db wi
ee10: 74 68 20 22 74 65 73 74 20 73 74 61 72 74 65 64 th "test started
ee20: 22 20 73 74 61 74 75 73 2c 20 73 65 74 20 72 75 " status, set ru
ee30: 6e 6e 69 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 2e nning host.;; 4.
ee40: 20 70 72 6f 63 65 73 73 20 6c 61 75 6e 63 68 20 process launch
ee50: 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d the test.;; -
ee60: 20 6d 6f 6e 69 74 6f 72 20 74 68 65 20 70 72 6f monitor the pro
ee70: 63 65 73 73 2c 20 75 70 64 61 74 65 20 73 74 61 cess, update sta
ee80: 74 73 20 69 6e 20 74 68 65 20 64 62 20 65 76 65 ts in the db eve
ee90: 72 79 20 32 5e 6e 20 6d 69 6e 75 74 65 73 0a 3b ry 2^n minutes.;
eea0: 3b 20 35 2e 20 61 73 20 74 68 65 20 74 65 73 74 ; 5. as the test
eeb0: 20 70 72 6f 63 65 65 64 73 20 69 6e 74 65 72 6e proceeds intern
eec0: 61 6c 6c 79 20 69 74 20 63 61 6c 6c 73 20 6d 65 ally it calls me
eed0: 67 61 74 65 73 74 20 61 73 20 65 61 63 68 20 73 gatest as each s
eee0: 74 65 70 20 69 73 0a 3b 3b 20 20 20 20 73 74 61 tep is.;; sta
eef0: 72 74 65 64 20 61 6e 64 20 63 6f 6d 70 6c 65 74 rted and complet
ef00: 65 64 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 ed.;; - step
ef10: 73 74 61 72 74 65 64 2c 20 74 69 6d 65 73 74 61 started, timesta
ef20: 6d 70 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 mp.;; - step
ef30: 63 6f 6d 70 6c 65 74 65 64 2c 20 65 78 69 74 20 completed, exit
ef40: 73 74 61 74 75 73 2c 20 74 69 6d 65 73 74 61 6d status, timestam
ef50: 70 0a 3b 3b 20 36 2e 20 74 65 73 74 20 70 68 6f p.;; 6. test pho
ef60: 6e 65 20 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d 20 ne home.;; -
ef70: 69 66 20 74 65 73 74 20 72 75 6e 20 74 69 6d 65 if test run time
ef80: 20 3e 20 61 6c 6c 6f 77 65 64 20 72 75 6e 20 74 > allowed run t
ef90: 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f ime then kill jo
efa0: 62 0a 3b 3b 20 20 20 20 2d 20 69 66 20 63 61 6e b.;; - if can
efb0: 6e 6f 74 20 61 63 63 65 73 73 20 64 62 20 3e 20 not access db >
efc0: 61 6c 6c 6f 77 65 64 20 64 69 73 63 6f 6e 6e 65 allowed disconne
efd0: 63 74 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c ct time then kil
efe0: 6c 20 6a 6f 62 0a 0a 3b 3b 20 3d 3d 20 64 75 70 l job..;; == dup
eff0: 6c 69 63 61 74 65 64 20 3d 3d 20 28 69 66 20 28 licated == (if (
f000: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
f010: 20 22 2d 72 75 6e 22 29 28 61 72 67 73 3a 67 65 "-run")(args:ge
f020: 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 t-arg "-runtests
f030: 22 29 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 ")).;; == duplic
f040: 61 74 65 64 20 3d 3d 20 20 20 28 67 65 6e 65 72 ated == (gener
f050: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 3b 3b 20 al-run-call .;;
f060: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f070: 20 20 20 20 22 2d 72 75 6e 74 65 73 74 73 22 20 "-runtests"
f080: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
f090: 64 20 3d 3d 20 20 20 20 22 72 75 6e 20 61 20 74 d == "run a t
f0a0: 65 73 74 22 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c est" .;; == dupl
f0b0: 69 63 61 74 65 64 20 3d 3d 20 20 20 20 28 6c 61 icated == (la
f0c0: 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
f0d0: 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c name keys keyval
f0e0: 73 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 s).;; == duplica
f0f0: 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 0a 3b ted == ;;.;
f100: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
f110: 3d 3d 20 20 20 20 20 20 3b 3b 20 4d 61 79 20 6f == ;; May o
f120: 72 20 6d 61 79 20 6e 6f 74 20 69 6d 70 6c 65 6d r may not implem
f130: 65 6e 74 20 69 74 20 74 68 69 73 20 77 61 79 20 ent it this way
f140: 2e 2e 2e 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 ....;; == duplic
f150: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 0a ated == ;;.
f160: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f170: 20 3d 3d 20 20 20 20 20 20 3b 3b 20 49 6e 73 65 == ;; Inse
f180: 72 74 20 74 68 69 73 20 72 75 6e 20 69 6e 74 6f rt this run into
f190: 20 74 68 65 20 74 61 73 6b 73 20 71 75 65 75 65 the tasks queue
f1a0: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
f1b0: 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 28 6f 70 d == ;; (op
f1c0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 en-run-close tas
f1d0: 6b 73 3a 61 64 64 20 74 61 73 6b 73 3a 6f 70 65 ks:add tasks:ope
f1e0: 6e 2d 64 62 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c n-db .;; == dupl
f1f0: 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b icated == ;
f200: 3b 20 20 20 20 09 20 20 20 20 20 22 72 75 6e 74 ; . "runt
f210: 65 73 74 73 22 20 0a 3b 3b 20 3d 3d 20 64 75 70 ests" .;; == dup
f220: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 licated ==
f230: 3b 3b 20 20 20 20 09 20 20 20 20 20 75 73 65 72 ;; . user
f240: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
f250: 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 d == ;;
f260: 09 20 20 20 20 20 74 61 72 67 65 74 0a 3b 3b 20 . target.;;
f270: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f280: 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 ;; .
f290: 20 20 72 75 6e 6e 61 6d 65 0a 3b 3b 20 3d 3d 20 runname.;; ==
f2a0: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
f2b0: 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 28 ;; . (
f2c0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
f2d0: 75 6e 74 65 73 74 73 22 29 0a 3b 3b 20 3d 3d 20 untests").;; ==
f2e0: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
f2f0: 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 23 ;; . #
f300: 66 29 29 29 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c f)))).;; == dupl
f310: 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 28 icated == (
f320: 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 runs:run-tests t
f330: 61 72 67 65 74 0a 3b 3b 20 3d 3d 20 64 75 70 6c arget.;; == dupl
f340: 69 63 61 74 65 64 20 3d 3d 20 09 09 20 20 20 20 icated == ..
f350: 20 72 75 6e 6e 61 6d 65 0a 3b 3b 20 3d 3d 20 64 runname.;; == d
f360: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 20 uplicated == ..
f370: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 (common:args
f380: 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 -get-testpatt #f
f390: 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 ) ;; (args:get-a
f3a0: 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a rg "-runtests").
f3b0: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f3c0: 20 3d 3d 20 09 09 20 20 20 20 20 75 73 65 72 0a == .. user.
f3d0: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f3e0: 20 3d 3d 20 09 09 20 20 20 20 20 61 72 67 73 3a == .. args:
f3f0: 61 72 67 2d 68 61 73 68 29 29 29 29 0a 0a 3b 3b arg-hash))))..;;
f400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f440: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 6f 6c 6c 75 70 ======.;; Rollup
f450: 20 69 6e 74 6f 20 61 20 72 75 6e 0a 3b 3b 3d 3d into a run.;;==
f460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f4a0: 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
f4b0: 67 65 74 2d 61 72 67 20 22 2d 72 6f 6c 6c 75 70 get-arg "-rollup
f4c0: 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d "). (general-
f4d0: 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 run-call . "
f4e0: 2d 72 6f 6c 6c 75 70 22 20 0a 20 20 20 20 20 22 -rollup" . "
f4f0: 72 6f 6c 6c 75 70 20 74 65 73 74 73 22 20 0a 20 rollup tests" .
f500: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
f510: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
f520: 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 keyvals).
f530: 20 28 72 75 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 (runs:rollup-ru
f540: 6e 20 6b 65 79 73 0a 09 09 09 6b 65 79 76 61 6c n keys....keyval
f550: 73 0a 09 09 09 28 6f 72 20 28 61 72 67 73 3a 67 s....(or (args:g
f560: 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 et-arg "-runname
f570: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
f580: 22 3a 72 75 6e 6e 61 6d 65 22 29 20 29 0a 09 09 ":runname") )...
f590: 09 75 73 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d .user))))..;;===
f5a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f5b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f5c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f5d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f5e0: 3d 3d 3d 0a 3b 3b 20 4c 6f 63 6b 20 6f 72 20 75 ===.;; Lock or u
f5f0: 6e 6c 6f 63 6b 20 61 20 72 75 6e 0a 3b 3b 3d 3d nlock a run.;;==
f600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f640: 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 ====..(if (or (a
f650: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
f660: 63 6b 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 ck")(args:get-ar
f670: 67 20 22 2d 75 6e 6c 6f 63 6b 22 29 29 0a 20 20 g "-unlock")).
f680: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
f690: 61 6c 6c 20 0a 20 20 20 20 20 28 69 66 20 28 61 all . (if (a
f6a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
f6b0: 63 6b 22 29 20 22 2d 6c 6f 63 6b 22 20 22 2d 75 ck") "-lock" "-u
f6c0: 6e 6c 6f 63 6b 22 29 0a 20 20 20 20 20 22 6c 6f nlock"). "lo
f6d0: 63 6b 2f 75 6e 6c 6f 63 6b 20 74 65 73 74 73 22 ck/unlock tests"
f6e0: 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
f6f0: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
f700: 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 eys keyvals).
f710: 20 20 20 20 28 72 75 6e 73 3a 68 61 6e 64 6c 65 (runs:handle
f720: 2d 6c 6f 63 6b 69 6e 67 20 0a 09 09 20 20 74 61 -locking ... ta
f730: 72 67 65 74 0a 09 09 20 20 6b 65 79 73 0a 09 09 rget... keys...
f740: 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d (or (args:get-
f750: 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 arg "-runname")(
f760: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 args:get-arg ":r
f770: 75 6e 6e 61 6d 65 22 29 20 29 0a 09 09 20 20 28 unname") )... (
f780: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
f790: 6f 63 6b 22 29 0a 09 09 20 20 28 61 72 67 73 3a ock")... (args:
f7a0: 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b get-arg "-unlock
f7b0: 22 29 0a 09 09 20 20 75 73 65 72 29 29 29 29 0a ")... user)))).
f7c0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
f7d0: 3d 3d 3d 3d 3d 3d 3d 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 0a 3b 3b 20 47 65 74 =========.;; Get
f810: 20 70 61 74 68 73 20 74 6f 20 74 65 73 74 73 0a paths to tests.
f820: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
f830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f860: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 65 74 20 ========.;; Get
f870: 74 65 73 74 20 70 61 74 68 73 20 6d 61 74 63 68 test paths match
f880: 69 6e 67 20 74 61 72 67 65 74 2c 20 72 75 6e 6e ing target, runn
f890: 61 6d 65 2c 20 61 6e 64 20 74 65 73 74 70 61 74 ame, and testpat
f8a0: 74 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a t.(if (or (args:
f8b0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 get-arg "-test-f
f8c0: 69 6c 65 73 22 29 28 61 72 67 73 3a 67 65 74 2d iles")(args:get-
f8d0: 61 72 67 20 22 2d 74 65 73 74 2d 70 61 74 68 73 arg "-test-paths
f8e0: 22 29 29 0a 20 20 20 20 3b 3b 20 69 66 20 77 65 ")). ;; if we
f8f0: 20 61 72 65 20 69 6e 20 61 20 74 65 73 74 20 75 are in a test u
f900: 73 65 20 74 68 65 20 4d 54 5f 43 4d 44 49 4e 46 se the MT_CMDINF
f910: 4f 20 64 61 74 61 0a 20 20 20 20 28 69 66 20 28 O data. (if (
f920: 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e getenv "MT_CMDIN
f930: 46 4f 22 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 FO")..(let* ((st
f940: 61 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 65 artingdir (curre
f950: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 nt-directory))..
f960: 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 (cmdinfo
f970: 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 (common:read-e
f980: 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 67 ncoded-string (g
f990: 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
f9a0: 4f 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 O"))).. (t
f9b0: 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f ransport (assoc/
f9c0: 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f default 'transpo
f9d0: 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 rt cmdinfo))..
f9e0: 20 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 (testpath
f9f0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
fa00: 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 testpath cmdinf
fa10: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 o)).. (tes
fa20: 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 t-name (assoc/de
fa30: 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 fault 'test-name
fa40: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
fa50: 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 (runscript (a
fa60: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
fa70: 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 nscript cmdinfo)
fa80: 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f ).. (db-ho
fa90: 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 st (assoc/defa
faa0: 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 ult 'db-host c
fab0: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
fac0: 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 (run-id (ass
fad0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d oc/default 'run-
fae0: 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a id cmdinfo)).
faf0: 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 . (itemdat
fb00: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
fb10: 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 t 'itemdat cmd
fb20: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
fb30: 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 3a state (args:
fb40: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 get-arg ":state"
fb50: 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 )).. (stat
fb60: 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d us (args:get-
fb70: 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a arg ":status")).
fb80: 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 20 . (target
fb90: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
fba0: 20 22 2d 74 61 72 67 65 74 22 29 29 0a 09 20 20 "-target"))..
fbb0: 20 20 20 20 20 28 74 6f 70 70 61 74 68 20 20 20 (toppath
fbc0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
fbd0: 74 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 66 toppath cmdinf
fbe0: 6f 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d o))).. (change-
fbf0: 64 69 72 65 63 74 6f 72 79 20 74 6f 70 70 61 74 directory toppat
fc00: 68 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 74 h).. (if (not t
fc10: 61 72 67 65 74 29 0a 09 20 20 20 20 20 20 28 62 arget).. (b
fc20: 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 egin...(debug:pr
fc30: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
fc40: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
fc50: 2d 74 61 72 67 65 74 20 69 73 20 72 65 71 75 69 -target is requi
fc60: 72 65 64 2e 22 29 0a 09 09 28 65 78 69 74 20 31 red.")...(exit 1
fc70: 29 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 ))).. (if (not
fc80: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
fc90: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
fca0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
fcb0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
fcc0: 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
fcd0: 75 70 2c 20 67 69 76 69 6e 67 20 75 70 20 6f 6e up, giving up on
fce0: 20 2d 74 65 73 74 2d 70 61 74 68 73 20 6f 72 20 -test-paths or
fcf0: 2d 74 65 73 74 2d 66 69 6c 65 73 2c 20 65 78 69 -test-files, exi
fd00: 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 ting")...(exit 1
fd10: 29 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b ))).. (let* ((k
fd20: 65 79 73 20 20 20 20 20 28 72 6d 74 3a 67 65 74 eys (rmt:get
fd30: 2d 6b 65 79 73 29 29 0a 09 09 20 3b 3b 20 64 62 -keys))... ;; db
fd40: 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 20 :test-get-paths
fd50: 6d 75 73 74 20 6e 6f 74 20 62 65 20 72 75 6e 20 must not be run
fd60: 72 65 6d 6f 74 65 0a 09 09 20 28 70 61 74 68 73 remote... (paths
fd70: 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d (tests:test-
fd80: 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 get-paths-matchi
fd90: 6e 67 20 6b 65 79 73 20 74 61 72 67 65 74 20 28 ng keys target (
fda0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
fdb0: 65 73 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 est-files"))))..
fdc0: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
fdd0: 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 mething* #t)..
fde0: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
fdf0: 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 28 69 bda (path)....(i
fe00: 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 f (file-exists?
fe10: 70 61 74 68 29 0a 09 09 09 28 70 72 69 6e 74 20 path)....(print
fe20: 70 61 74 68 29 29 29 09 0a 09 09 20 20 20 20 20 path)))....
fe30: 20 70 61 74 68 73 29 29 29 0a 09 3b 3b 20 65 6c paths)))..;; el
fe40: 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 6c 2d se do a general-
fe50: 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 72 run-call..(gener
fe60: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 22 al-run-call .. "
fe70: 2d 74 65 73 74 2d 66 69 6c 65 73 22 0a 09 20 22 -test-files".. "
fe80: 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 Get paths to tes
fe90: 74 22 0a 09 20 28 6c 61 6d 62 64 61 20 28 74 61 t".. (lambda (ta
fea0: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
feb0: 73 20 6b 65 79 76 61 6c 73 29 0a 09 20 20 20 28 s keyvals).. (
fec0: 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 let* ((db
fed0: 23 66 29 0a 09 09 20 20 3b 3b 20 44 4f 20 4e 4f #f)... ;; DO NO
fee0: 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 T run remote...
fef0: 20 28 70 61 74 68 73 20 20 20 20 28 74 65 73 74 (paths (test
ff00: 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 s:test-get-paths
ff10: 2d 6d 61 74 63 68 69 6e 67 20 6b 65 79 73 20 74 -matching keys t
ff20: 61 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d arget (args:get-
ff30: 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 arg "-test-files
ff40: 22 29 29 29 29 0a 09 20 20 20 20 20 28 66 6f 72 ")))).. (for
ff50: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 -each (lambda (p
ff60: 61 74 68 29 0a 09 09 09 20 28 70 72 69 6e 74 20 ath).... (print
ff70: 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 20 path))...
ff80: 70 61 74 68 73 29 29 29 29 29 29 0a 0a 3b 3b 3d paths))))))..;;=
ff90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ffa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ffb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ffc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ffd0: 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 =====.;; Archive
ffe0: 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d tests.;;=======
fff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10000 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10010 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10020 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
10030 3b 3b 20 41 72 63 68 69 76 65 20 74 65 73 74 73 ;; Archive tests
10040 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 74 matching target
10050 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 , runname, and t
10060 65 73 74 70 61 74 74 0a 28 69 66 20 28 61 72 67 estpatt.(if (arg
10070 73 3a 67 65 74 2d 61 72 67 20 22 2d 61 72 63 68 s:get-arg "-arch
10080 69 76 65 22 29 0a 20 20 20 20 3b 3b 20 65 6c 73 ive"). ;; els
10090 65 20 64 6f 20 61 20 67 65 6e 65 72 61 6c 2d 72 e do a general-r
100a0 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 28 67 65 6e un-call. (gen
100b0 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 eral-run-call .
100c0 20 20 20 20 22 2d 61 72 63 68 69 76 65 22 0a 20 "-archive".
100d0 20 20 20 20 22 41 72 63 68 69 76 65 22 0a 20 20 "Archive".
100e0 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
100f0 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
10100 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 keyvals).
10110 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 61 72 63 (operate-on 'arc
10120 68 69 76 65 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d hive))))..;;====
10130 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10140 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10150 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10160 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10170 3d 3d 0a 3b 3b 20 45 78 74 72 61 63 74 20 61 20 ==.;; Extract a
10180 73 70 72 65 61 64 73 68 65 65 74 20 66 72 6f 6d spreadsheet from
10190 20 74 68 65 20 72 75 6e 73 20 64 61 74 61 62 61 the runs databa
101a0 73 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d se.;;===========
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 0a 0a 28 69 66 ===========..(if
101f0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
10200 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 0a 20 -extract-ods").
10210 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
10220 63 61 6c 6c 0a 20 20 20 20 20 22 2d 65 78 74 72 call. "-extr
10230 61 63 74 2d 6f 64 73 22 0a 20 20 20 20 20 22 4d act-ods". "M
10240 61 6b 65 20 6f 64 73 20 73 70 72 65 61 64 73 68 ake ods spreadsh
10250 65 65 74 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 eet". (lambd
10260 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
10270 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a e keys keyvals).
10280 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 62 (let ((db
10290 73 74 72 75 63 74 20 20 20 28 6d 61 6b 65 2d 64 struct (make-d
102a0 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 68 br:dbstruct path
102b0 3a 20 2a 74 6f 70 70 61 74 68 2a 20 6c 6f 63 61 : *toppath* loca
102c0 6c 3a 20 23 74 29 29 0a 09 20 20 20 20 20 28 6f l: #t)).. (o
102d0 75 74 70 75 74 66 69 6c 65 20 28 61 72 67 73 3a utputfile (args:
102e0 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 61 63 get-arg "-extrac
102f0 74 2d 6f 64 73 22 29 29 0a 09 20 20 20 20 20 28 t-ods")).. (
10300 72 75 6e 73 70 61 74 74 20 20 20 28 6f 72 20 28 runspatt (or (
10310 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
10320 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 unname")(args:ge
10330 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 t-arg ":runname"
10340 29 29 29 0a 09 20 20 20 20 20 28 70 61 74 68 6d ))).. (pathm
10350 6f 64 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d od (args:get-
10360 61 72 67 20 22 2d 70 61 74 68 6d 6f 64 22 29 29 arg "-pathmod"))
10370 29 0a 09 20 20 20 20 20 3b 3b 20 28 6b 65 79 76 ).. ;; (keyv
10380 61 6c 61 6c 69 73 74 20 28 6b 65 79 73 2d 3e 61 alalist (keys->a
10390 6c 69 73 74 20 6b 65 79 73 20 22 25 22 29 29 29 list keys "%")))
103a0 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 .. (debug:print
103b0 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 2 *default-log-p
103c0 6f 72 74 2a 20 22 45 78 74 72 61 63 74 20 6f 64 ort* "Extract od
103d0 73 2c 20 6f 75 74 70 75 74 66 69 6c 65 3a 20 22 s, outputfile: "
103e0 20 6f 75 74 70 75 74 66 69 6c 65 20 22 20 72 75 outputfile " ru
103f0 6e 73 70 61 74 74 3a 20 22 20 72 75 6e 73 70 61 nspatt: " runspa
10400 74 74 20 22 20 6b 65 79 76 61 6c 73 3a 20 22 20 tt " keyvals: "
10410 6b 65 79 76 61 6c 73 29 0a 09 20 28 64 62 3a 65 keyvals).. (db:e
10420 78 74 72 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 xtract-ods-file
10430 64 62 73 74 72 75 63 74 20 6f 75 74 70 75 74 66 dbstruct outputf
10440 69 6c 65 20 6b 65 79 76 61 6c 73 20 28 69 66 20 ile keyvals (if
10450 72 75 6e 73 70 61 74 74 20 72 75 6e 73 70 61 74 runspatt runspat
10460 74 20 22 25 22 29 20 70 61 74 68 6d 6f 64 29 0a t "%") pathmod).
10470 09 20 28 64 62 3a 63 6c 6f 73 65 2d 61 6c 6c 20 . (db:close-all
10480 64 62 73 74 72 75 63 74 29 0a 09 20 28 73 65 74 dbstruct).. (set
10490 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
104a0 20 23 74 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d #t)))))..;;====
104b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104f0 3d 3d 0a 3b 3b 20 65 78 65 63 75 74 65 20 74 68 ==.;; execute th
10500 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 67 e test.;; - g
10510 65 74 73 20 63 61 6c 6c 65 64 20 6f 6e 20 72 65 ets called on re
10520 6d 6f 74 65 20 68 6f 73 74 0a 3b 3b 20 20 20 20 mote host.;;
10530 2d 20 72 65 63 65 69 76 65 73 20 69 6e 66 6f 20 - receives info
10540 66 72 6f 6d 20 74 68 65 20 2d 65 78 65 63 75 74 from the -execut
10550 65 20 70 61 72 61 6d 0a 3b 3b 20 20 20 20 2d 20 e param.;; -
10560 70 61 73 73 65 73 20 69 6e 66 6f 20 74 6f 20 73 passes info to s
10570 74 65 70 73 20 76 69 61 20 4d 54 5f 43 4d 44 49 teps via MT_CMDI
10580 4e 46 4f 20 65 6e 76 20 76 61 72 20 28 66 75 74 NFO env var (fut
10590 75 72 65 20 69 73 20 74 6f 20 75 73 65 20 61 20 ure is to use a
105a0 64 6f 74 20 66 69 6c 65 29 0a 3b 3b 20 20 20 20 dot file).;;
105b0 2d 20 67 61 74 68 65 72 73 20 68 6f 73 74 20 69 - gathers host i
105c0 6e 66 6f 20 61 6e 64 20 0a 3b 3b 3d 3d 3d 3d 3d nfo and .;;=====
105d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
105e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
105f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10600 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10610 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 =..(if (args:get
10620 2d 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 -arg "-execute")
10630 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
10640 20 20 28 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 (launch:execut
10650 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 e (args:get-arg
10660 22 2d 65 78 65 63 75 74 65 22 29 29 0a 20 20 20 "-execute")).
10670 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
10680 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b ething* #t)))..;
10690 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
106a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
106b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
106c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
106d0 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 65 63 6f 76 =======.;; recov
106e0 65 72 20 66 72 6f 6d 20 61 20 74 65 73 74 20 77 er from a test w
106f0 68 65 72 65 20 74 68 65 20 6d 61 6e 61 67 69 6e here the managin
10700 67 20 6d 74 65 73 74 20 77 61 73 20 6b 69 6c 6c g mtest was kill
10710 65 64 20 62 75 74 20 74 68 65 20 75 6e 64 65 72 ed but the under
10720 6c 79 69 6e 67 0a 3b 3b 20 70 72 6f 63 65 73 73 lying.;; process
10730 20 6d 69 67 68 74 20 73 74 69 6c 6c 20 62 65 20 might still be
10740 73 61 6c 76 61 67 65 61 62 6c 65 0a 3b 3b 3d 3d salvageable.;;==
10750 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10760 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10770 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10780 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10790 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
107a0 67 65 74 2d 61 72 67 20 22 2d 72 65 63 6f 76 65 get-arg "-recove
107b0 72 2d 74 65 73 74 22 29 0a 20 20 20 20 28 6c 65 r-test"). (le
107c0 74 2a 20 28 28 70 61 72 61 6d 73 20 28 73 74 72 t* ((params (str
107d0 69 6e 67 2d 73 70 6c 69 74 20 28 61 72 67 73 3a ing-split (args:
107e0 67 65 74 2d 61 72 67 20 22 2d 72 65 63 6f 76 65 get-arg "-recove
107f0 72 2d 74 65 73 74 22 29 20 22 2c 22 29 29 29 0a r-test") ","))).
10800 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 (if (> (le
10810 6e 67 74 68 20 70 61 72 61 6d 73 29 20 31 29 20 ngth params) 1)
10820 3b 3b 20 72 75 6e 2d 69 64 20 61 6e 64 20 74 65 ;; run-id and te
10830 73 74 2d 69 64 0a 09 20 20 28 6c 65 74 20 28 28 st-id.. (let ((
10840 72 75 6e 2d 69 64 20 28 73 74 72 69 6e 67 2d 3e run-id (string->
10850 6e 75 6d 62 65 72 20 28 63 61 72 20 70 61 72 61 number (car para
10860 6d 73 29 29 29 0a 09 09 28 74 65 73 74 2d 69 64 ms)))...(test-id
10870 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
10880 20 28 63 61 64 72 20 70 61 72 61 6d 73 29 29 29 (cadr params)))
10890 29 0a 09 20 20 20 20 28 69 66 20 28 61 6e 64 20 ).. (if (and
108a0 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a run-id test-id).
108b0 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 6c 61 ..(begin... (la
108c0 75 6e 63 68 3a 72 65 63 6f 76 65 72 2d 74 65 73 unch:recover-tes
108d0 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 t run-id test-id
108e0 29 0a 09 09 20 20 28 73 65 74 21 20 2a 64 69 64 )... (set! *did
108f0 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 0a something* #t)).
10900 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 64 65 ..(begin... (de
10910 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
10920 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
10930 6f 72 74 2a 20 22 62 61 64 20 72 75 6e 2d 69 64 ort* "bad run-id
10940 20 6f 72 20 74 65 73 74 2d 69 64 2c 20 6d 75 73 or test-id, mus
10950 74 20 62 65 20 69 6e 74 65 67 65 72 73 22 29 0a t be integers").
10960 09 09 20 20 28 65 78 69 74 20 31 29 29 29 29 29 .. (exit 1)))))
10970 29 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
109c0 54 65 73 74 20 63 6f 6d 6d 61 6e 64 73 20 28 69 Test commands (i
109d0 2e 65 2e 20 66 6f 72 20 75 73 65 20 69 6e 73 69 .e. for use insi
109e0 64 65 20 74 65 73 74 73 29 0a 3b 3b 3d 3d 3d 3d de tests).;;====
109f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a30 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 6d 65 67 ==..(define (meg
10a40 61 74 65 73 74 3a 73 74 65 70 20 73 74 65 70 20 atest:step step
10a50 73 74 61 74 65 20 73 74 61 74 75 73 20 6c 6f 67 state status log
10a60 66 69 6c 65 20 6d 73 67 29 0a 20 20 28 69 66 20 file msg). (if
10a70 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 4d 54 (not (getenv "MT
10a80 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 20 20 20 20 _CMDINFO")).
10a90 20 20 28 62 65 67 69 6e 0a 09 28 64 65 62 75 67 (begin..(debug
10aa0 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
10ab0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
10ac0 2a 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e * "MT_CMDINFO en
10ad0 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 2d v var not set, -
10ae0 73 74 65 70 20 6d 75 73 74 20 62 65 20 63 61 6c step must be cal
10af0 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d led *inside* a m
10b00 65 67 61 74 65 73 74 20 69 6e 76 6f 6b 65 64 20 egatest invoked
10b10 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 environment!")..
10b20 28 65 78 69 74 20 35 29 29 0a 20 20 20 20 20 20 (exit 5)).
10b30 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e 66 6f 20 (let* ((cmdinfo
10b40 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 (common:read-e
10b50 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 67 ncoded-string (g
10b60 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
10b70 4f 22 29 29 29 0a 09 20 20 20 20 20 28 74 72 61 O"))).. (tra
10b80 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f 64 65 nsport (assoc/de
10b90 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f 72 74 fault 'transport
10ba0 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
10bb0 20 28 74 65 73 74 70 61 74 68 20 20 28 61 73 73 (testpath (ass
10bc0 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
10bd0 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a path cmdinfo)).
10be0 09 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 . (test-name
10bf0 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
10c00 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
10c10 66 6f 29 29 0a 09 20 20 20 20 20 28 72 75 6e 73 fo)).. (runs
10c20 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 cript (assoc/def
10c30 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 ault 'runscript
10c40 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
10c50 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f (db-host (asso
10c60 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f c/default 'db-ho
10c70 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 st cmdinfo))..
10c80 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 (run-id
10c90 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
10ca0 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 run-id cmdinf
10cb0 6f 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 2d o)).. (test-
10cc0 69 64 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 id (assoc/defa
10cd0 75 6c 74 20 27 74 65 73 74 2d 69 64 20 20 20 63 ult 'test-id c
10ce0 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 mdinfo)).. (
10cf0 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 itemdat (assoc
10d00 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 /default 'itemda
10d10 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
10d20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 28 (work-area (
10d30 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 77 assoc/default 'w
10d40 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 66 6f ork-area cmdinfo
10d50 29 29 0a 09 20 20 20 20 20 28 64 62 20 20 20 20 )).. (db
10d60 20 20 20 20 23 66 29 29 0a 09 28 63 68 61 6e 67 #f))..(chang
10d70 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test
10d80 70 61 74 68 29 0a 09 28 69 66 20 28 6e 6f 74 20 path)..(if (not
10d90 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
10da0 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 . (begin..
10db0 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
10dc0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
10dd0 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 ort* "Failed to
10de0 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 setup, exiting")
10df0 0a 09 20 20 20 20 20 20 28 65 78 69 74 20 31 29 .. (exit 1)
10e00 29 29 0a 09 28 69 66 20 28 61 6e 64 20 73 74 61 ))..(if (and sta
10e10 74 65 20 73 74 61 74 75 73 29 0a 09 20 20 20 20 te status)..
10e20 28 6c 65 74 20 28 28 63 6f 6d 6d 65 6e 74 20 28 (let ((comment (
10e30 6c 61 75 6e 63 68 3a 6c 6f 61 64 2d 6c 6f 67 70 launch:load-logp
10e40 72 6f 2d 64 61 74 20 72 75 6e 2d 69 64 20 74 65 ro-dat run-id te
10e50 73 74 2d 69 64 20 73 74 65 70 29 29 29 0a 09 20 st-id step)))..
10e60 20 20 20 20 20 3b 3b 20 28 72 6d 74 3a 74 65 73 ;; (rmt:tes
10e70 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 t-set-log! run-i
10e80 64 20 74 65 73 74 2d 69 64 20 28 63 6f 6e 63 20 d test-id (conc
10e90 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 stepname ".html"
10ea0 29 29 29 29 0a 09 20 20 20 20 20 20 28 72 6d 74 )))).. (rmt
10eb0 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 :teststep-set-st
10ec0 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 atus! run-id tes
10ed0 74 2d 69 64 20 73 74 65 70 20 73 74 61 74 65 20 t-id step state
10ee0 73 74 61 74 75 73 20 28 6f 72 20 63 6f 6d 6d 65 status (or comme
10ef0 6e 74 20 6d 73 67 29 20 6c 6f 67 66 69 6c 65 29 nt msg) logfile)
10f00 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 ).. (begin..
10f10 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
10f20 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
10f30 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 59 6f lt-log-port* "Yo
10f40 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 3a u must specify :
10f50 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 state and :statu
10f60 73 20 77 69 74 68 20 65 76 65 72 79 20 63 61 6c s with every cal
10f70 6c 20 74 6f 20 2d 73 74 65 70 22 29 0a 09 20 20 l to -step")..
10f80 20 20 20 20 28 65 78 69 74 20 36 29 29 29 29 29 (exit 6)))))
10f90 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
10fa0 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a 20 20 -arg "-step").
10fb0 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
10fc0 6d 65 67 61 74 65 73 74 3a 73 74 65 70 20 0a 20 megatest:step .
10fd0 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
10fe0 61 72 67 20 22 2d 73 74 65 70 22 29 0a 20 20 20 arg "-step").
10ff0 20 20 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (or (args:ge
11000 74 2d 61 72 67 20 22 2d 73 74 61 74 65 22 29 28 t-arg "-state")(
11010 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 args:get-arg ":s
11020 74 61 74 65 22 29 29 0a 20 20 20 20 20 20 20 28 tate")). (
11030 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
11040 20 22 2d 73 74 61 74 75 73 22 29 28 61 72 67 73 "-status")(args
11050 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 :get-arg ":statu
11060 73 22 29 29 0a 20 20 20 20 20 20 20 28 61 72 67 s")). (arg
11070 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c s:get-arg "-setl
11080 6f 67 22 29 0a 20 20 20 20 20 20 20 28 61 72 67 og"). (arg
11090 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 s:get-arg "-m"))
110a0 0a 20 20 20 20 20 20 3b 3b 20 28 69 66 20 64 62 . ;; (if db
110b0 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
110c0 7a 65 21 20 64 62 29 29 0a 20 20 20 20 20 20 28 ze! db)). (
110d0 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
110e0 6e 67 2a 20 23 74 29 29 29 0a 20 20 20 20 0a 28 ng* #t))). .(
110f0 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
11100 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 20 -arg "-setlog")
11110 20 20 20 20 20 20 3b 3b 20 73 69 6e 63 65 20 73 ;; since s
11120 65 74 74 69 6e 67 20 75 70 20 69 73 20 73 6f 20 etting up is so
11130 63 6f 73 74 6c 79 20 6c 65 74 73 20 70 69 67 67 costly lets pigg
11140 79 62 61 63 6b 20 6f 6e 20 2d 74 65 73 74 2d 73 yback on -test-s
11150 74 61 74 75 73 0a 09 3b 3b 20 20 20 20 20 28 6e tatus..;; (n
11160 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
11170 20 22 2d 73 74 65 70 22 29 29 29 20 20 3b 3b 20 "-step"))) ;;
11180 2d 73 65 74 6c 6f 67 20 6d 61 79 20 68 61 76 65 -setlog may have
11190 20 62 65 65 6e 20 70 72 6f 63 65 73 73 65 64 20 been processed
111a0 61 6c 72 65 61 64 79 20 69 6e 20 74 68 65 20 22 already in the "
111b0 2d 73 74 65 70 22 20 70 72 65 76 69 6f 75 73 0a -step" previous.
111c0 09 3b 3b 20 20 20 20 20 4e 45 57 20 50 4f 4c 49 .;; NEW POLI
111d0 43 59 20 2d 20 2d 73 65 74 6c 6f 67 20 73 65 74 CY - -setlog set
111e0 73 20 74 65 73 74 20 6f 76 65 72 61 6c 6c 20 6c s test overall l
111f0 6f 67 20 6f 6e 20 65 76 65 72 79 20 63 61 6c 6c og on every call
11200 2e 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ...(args:get-arg
11210 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a "-set-toplog").
11220 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
11230 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a 09 -test-status")..
11240 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11250 73 65 74 2d 76 61 6c 75 65 73 22 29 0a 09 28 61 set-values")..(a
11260 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
11270 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a 09 ad-test-data")..
11280 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11290 72 75 6e 73 74 65 70 22 29 0a 09 28 61 72 67 73 runstep")..(args
112a0 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d 6d 61 :get-arg "-summa
112b0 72 69 7a 65 2d 69 74 65 6d 73 22 29 29 0a 20 20 rize-items")).
112c0 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 65 (if (not (gete
112d0 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
112e0 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 )..(begin.. (de
112f0 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
11300 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
11310 6f 72 74 2a 20 22 4d 54 5f 43 4d 44 49 4e 46 4f ort* "MT_CMDINFO
11320 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 env var not set
11330 2c 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 65 73 74 , commands -test
11340 2d 73 74 61 74 75 73 2c 20 2d 72 75 6e 73 74 65 -status, -runste
11350 70 20 61 6e 64 20 2d 73 65 74 6c 6f 67 20 6d 75 p and -setlog mu
11360 73 74 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e st be called *in
11370 73 69 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 side* a megatest
11380 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a environment!").
11390 09 20 20 28 65 78 69 74 20 35 29 29 0a 09 28 6c . (exit 5))..(l
113a0 65 74 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69 et* ((startingdi
113b0 72 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 r (current-direc
113c0 74 6f 72 79 29 29 0a 09 20 20 20 20 20 20 20 28 tory)).. (
113d0 63 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f cmdinfo (commo
113e0 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 n:read-encoded-s
113f0 74 72 69 6e 67 20 28 67 65 74 65 6e 76 20 22 4d tring (getenv "M
11400 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 20 T_CMDINFO")))..
11410 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 (transport
11420 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
11430 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 'transport cmdin
11440 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 fo)).. (te
11450 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 stpath (assoc/d
11460 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 efault 'testpath
11470 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
11480 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 (test-name (
11490 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
114a0 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f est-name cmdinfo
114b0 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 )).. (runs
114c0 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 cript (assoc/def
114d0 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 ault 'runscript
114e0 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
114f0 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 (db-host (as
11500 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d soc/default 'db-
11510 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 host cmdinfo))
11520 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 .. (run-id
11530 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 (assoc/defau
11540 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d lt 'run-id cm
11550 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
11560 28 74 65 73 74 2d 69 64 20 20 20 28 61 73 73 6f (test-id (asso
11570 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d c/default 'test-
11580 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 id cmdinfo))..
11590 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 (itemdat
115a0 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
115b0 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 'itemdat cmdi
115c0 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 77 nfo)).. (w
115d0 6f 72 6b 2d 61 72 65 61 20 28 61 73 73 6f 63 2f ork-area (assoc/
115e0 64 65 66 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 default 'work-ar
115f0 65 61 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 ea cmdinfo))..
11600 20 20 20 20 20 28 64 62 20 20 20 20 20 20 20 20 (db
11610 23 66 29 20 3b 3b 20 28 6f 70 65 6e 2d 64 62 29 #f) ;; (open-db)
11620 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 65 ).. (state
11630 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
11640 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 rg ":state"))..
11650 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 (status
11660 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
11670 3a 73 74 61 74 75 73 22 29 29 0a 09 20 20 20 20 :status"))..
11680 20 20 20 28 73 74 65 70 6e 61 6d 65 20 20 28 61 (stepname (a
11690 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
116a0 65 70 22 29 29 29 0a 09 20 20 28 69 66 20 28 6e ep"))).. (if (n
116b0 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 ot (launch:setup
116c0 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e )).. (begin
116d0 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
116e0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
116f0 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 ort* "Failed to
11700 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 setup, exiting")
11710 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 0a 09 ...(exit 1)))...
11720 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
11730 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 28 arg "-runstep")(
11740 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
11750 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 1 *default-log-
11760 70 6f 72 74 2a 20 22 52 75 6e 6e 69 6e 67 20 2d port* "Running -
11770 72 75 6e 73 74 65 70 2c 20 66 69 72 73 74 20 63 runstep, first c
11780 68 61 6e 67 65 20 74 6f 20 64 69 72 65 63 74 6f hange to directo
11790 72 79 20 22 20 77 6f 72 6b 2d 61 72 65 61 29 29 ry " work-area))
117a0 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 .. (change-dire
117b0 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 ctory work-area)
117c0 0a 09 20 20 3b 3b 20 63 61 6e 20 73 65 74 75 70 .. ;; can setup
117d0 20 61 73 20 63 6c 69 65 6e 74 20 66 6f 72 20 73 as client for s
117e0 65 72 76 65 72 20 6d 6f 64 65 20 6e 6f 77 0a 09 erver mode now..
117f0 20 20 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 65 74 ;; (client:set
11800 75 70 29 0a 0a 09 20 20 28 69 66 20 28 61 72 67 up)... (if (arg
11810 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 s:get-arg "-load
11820 2d 74 65 73 74 2d 64 61 74 61 22 29 0a 09 20 20 -test-data")..
11830 20 20 20 20 3b 3b 20 68 61 73 20 73 75 62 20 63 ;; has sub c
11840 6f 6d 6d 61 6e 64 73 20 74 68 61 74 20 61 72 65 ommands that are
11850 20 72 64 62 3a 0a 09 20 20 20 20 20 20 3b 3b 20 rdb:.. ;;
11860 44 4f 20 4e 4f 54 20 70 75 74 20 74 68 69 73 20 DO NOT put this
11870 6f 6e 65 20 69 6e 74 6f 20 65 69 74 68 65 72 20 one into either
11880 72 6d 74 3a 20 6f 72 20 6f 70 65 6e 2d 72 75 6e rmt: or open-run
11890 2d 63 6c 6f 73 65 0a 09 20 20 20 20 20 20 28 74 -close.. (t
118a0 64 62 3a 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 db:load-test-dat
118b0 61 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 a run-id test-id
118c0 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a )).. (if (args:
118d0 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 get-arg "-setlog
118e0 22 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 ").. (let (
118f0 28 6c 6f 67 66 6e 61 6d 65 20 28 61 72 67 73 3a (logfname (args:
11900 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 get-arg "-setlog
11910 22 29 29 29 0a 09 09 28 72 6d 74 3a 74 65 73 74 ")))...(rmt:test
11920 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 -set-log! run-id
11930 20 74 65 73 74 2d 69 64 20 6c 6f 67 66 6e 61 6d test-id logfnam
11940 65 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 e))).. (if (arg
11950 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
11960 74 6f 70 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 toplog")..
11970 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 ;; DO NOT run re
11980 6d 6f 74 65 0a 09 20 20 20 20 20 20 28 74 65 73 mote.. (tes
11990 74 73 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c ts:test-set-topl
119a0 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d og! run-id test-
119b0 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 name (args:get-a
119c0 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 rg "-set-toplog"
119d0 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 ))).. (if (args
119e0 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d 6d 61 :get-arg "-summa
119f0 72 69 7a 65 2d 69 74 65 6d 73 22 29 0a 09 20 20 rize-items")..
11a00 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 ;; DO NOT ru
11a10 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 n remote..
11a20 28 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 (tests:summarize
11a30 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 -items run-id te
11a40 73 74 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 st-id test-name
11a50 23 74 29 29 20 3b 3b 20 64 6f 20 66 6f 72 63 65 #t)) ;; do force
11a60 20 68 65 72 65 0a 09 20 20 28 69 66 20 28 61 72 here.. (if (ar
11a70 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
11a80 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 28 69 step").. (i
11a90 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 f (null? remargs
11aa0 29 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 )... (begin...
11ab0 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
11ac0 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
11ad0 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6e 6f 74 68 -log-port* "noth
11ae0 69 6e 67 20 73 70 65 63 69 66 69 65 64 20 74 6f ing specified to
11af0 20 72 75 6e 21 22 29 0a 09 09 20 20 20 20 28 69 run!")... (i
11b00 66 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 f db (sqlite3:fi
11b10 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 09 20 nalize! db))...
11b20 20 20 20 28 65 78 69 74 20 36 29 29 0a 09 09 20 (exit 6))...
11b30 20 28 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 6d (let* ((stepnam
11b40 65 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 e (args:get-ar
11b50 67 20 22 2d 72 75 6e 73 74 65 70 22 29 29 0a 09 g "-runstep"))..
11b60 09 09 20 28 6c 6f 67 70 72 6f 66 69 6c 65 20 28 .. (logprofile (
11b70 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
11b80 6f 67 70 72 6f 22 29 29 0a 09 09 09 20 28 6c 6f ogpro")).... (lo
11b90 67 66 69 6c 65 20 20 20 20 28 63 6f 6e 63 20 73 gfile (conc s
11ba0 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 29 tepname ".log"))
11bb0 0a 09 09 09 20 28 63 6d 64 20 20 20 20 20 20 20 .... (cmd
11bc0 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 (if (null? rema
11bd0 72 67 73 29 20 23 66 20 28 63 61 72 20 72 65 6d rgs) #f (car rem
11be0 61 72 67 73 29 29 29 0a 09 09 09 20 28 70 61 72 args))).... (par
11bf0 61 6d 73 20 20 20 20 20 28 69 66 20 63 6d 64 20 ams (if cmd
11c00 28 63 64 72 20 72 65 6d 61 72 67 73 29 20 27 28 (cdr remargs) '(
11c10 29 29 29 0a 09 09 09 20 28 65 78 69 74 73 74 61 ))).... (exitsta
11c20 74 20 20 20 23 66 29 0a 09 09 09 20 28 73 68 65 t #f).... (she
11c30 6c 6c 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 ll (let ((s
11c40 68 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 h (get-environme
11c50 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 53 48 45 nt-variable "SHE
11c60 4c 4c 22 29 20 29 29 0a 09 09 09 09 20 20 20 20 LL") )).....
11c70 20 20 20 28 69 66 20 73 68 20 0a 09 09 09 09 09 (if sh ......
11c80 20 20 20 28 6c 61 73 74 20 28 73 74 72 69 6e 67 (last (string
11c90 2d 73 70 6c 69 74 20 73 68 20 22 2f 22 29 29 0a -split sh "/")).
11ca0 09 09 09 09 09 20 20 20 22 62 61 73 68 22 29 29 ..... "bash"))
11cb0 29 0a 09 09 09 20 28 72 65 64 69 72 20 20 20 20 ).... (redir
11cc0 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d (case (string-
11cd0 3e 73 79 6d 62 6f 6c 20 73 68 65 6c 6c 29 0a 09 >symbol shell)..
11ce0 09 09 09 20 20 20 20 20 20 20 28 28 74 63 73 68 ... ((tcsh
11cf0 20 63 73 68 20 6b 73 68 29 20 20 20 20 22 3e 26 csh ksh) ">&
11d00 22 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 ")..... ((
11d10 7a 73 68 20 62 61 73 68 20 73 68 20 61 73 68 29 zsh bash sh ash)
11d20 20 22 32 3e 26 31 20 3e 22 29 0a 09 09 09 09 20 "2>&1 >").....
11d30 20 20 20 20 20 20 28 65 6c 73 65 20 22 3e 26 22 (else ">&"
11d40 29 29 29 0a 09 09 09 20 28 66 75 6c 6c 63 6d 64 ))).... (fullcmd
11d50 20 20 20 20 28 63 6f 6e 63 20 22 28 22 20 28 73 (conc "(" (s
11d60 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
11d70 65 20 0a 09 09 09 09 09 09 28 63 6f 6e 73 20 63 e .......(cons c
11d80 6d 64 20 70 61 72 61 6d 73 29 20 22 20 22 29 0a md params) " ").
11d90 09 09 09 09 09 20 20 20 22 29 20 22 20 72 65 64 ..... ") " red
11da0 69 72 20 22 20 22 20 6c 6f 67 66 69 6c 65 29 29 ir " " logfile))
11db0 29 0a 09 09 20 20 20 20 3b 3b 20 6d 61 72 6b 20 )... ;; mark
11dc0 74 68 65 20 73 74 61 72 74 20 6f 66 20 74 68 65 the start of the
11dd0 20 74 65 73 74 0a 09 09 20 20 20 20 28 72 6d 74 test... (rmt
11de0 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 :teststep-set-st
11df0 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 atus! run-id tes
11e00 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 73 t-id stepname "s
11e10 74 61 72 74 22 20 22 6e 2f 61 22 20 28 61 72 67 tart" "n/a" (arg
11e20 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 s:get-arg "-m")
11e30 6c 6f 67 66 69 6c 65 29 0a 09 09 20 20 20 20 3b logfile)... ;
11e40 3b 20 72 75 6e 20 74 68 65 20 74 65 73 74 20 73 ; run the test s
11e50 74 65 70 0a 09 09 20 20 20 20 28 64 65 62 75 67 tep... (debug
11e60 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 2a 64 :print-info 2 *d
11e70 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
11e80 20 22 52 75 6e 6e 69 6e 67 20 5c 22 22 20 66 75 "Running \"" fu
11e90 6c 6c 63 6d 64 20 22 5c 22 20 69 6e 20 64 69 72 llcmd "\" in dir
11ea0 65 63 74 6f 72 79 20 5c 22 22 20 73 74 61 72 74 ectory \"" start
11eb0 69 6e 67 64 69 72 29 0a 09 09 20 20 20 20 28 63 ingdir)... (c
11ec0 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
11ed0 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 09 20 startingdir)...
11ee0 20 20 20 28 73 65 74 21 20 65 78 69 74 73 74 61 (set! exitsta
11ef0 74 20 28 73 79 73 74 65 6d 20 66 75 6c 6c 63 6d t (system fullcm
11f00 64 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 d))... (set!
11f10 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 *globalexitstatu
11f20 73 2a 20 65 78 69 74 73 74 61 74 29 0a 09 09 20 s* exitstat)...
11f30 20 20 20 3b 3b 20 28 63 68 61 6e 67 65 2d 64 69 ;; (change-di
11f40 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 rectory testpath
11f50 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 6c )... ;; run l
11f60 6f 67 70 72 6f 20 69 66 20 61 70 70 6c 69 63 61 ogpro if applica
11f70 62 6c 65 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d ble ;; (process-
11f80 72 75 6e 20 22 6c 73 22 20 28 6c 69 73 74 20 22 run "ls" (list "
11f90 2f 66 6f 6f 22 20 22 32 3e 26 31 22 20 22 62 6c /foo" "2>&1" "bl
11fa0 61 68 2e 6c 6f 67 22 29 29 0a 09 09 20 20 20 20 ah.log"))...
11fb0 28 69 66 20 6c 6f 67 70 72 6f 66 69 6c 65 0a 09 (if logprofile..
11fc0 09 09 28 6c 65 74 2a 20 28 28 68 74 6d 6c 6c 6f ..(let* ((htmllo
11fd0 67 66 69 6c 65 20 28 63 6f 6e 63 20 73 74 65 70 gfile (conc step
11fe0 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 name ".html"))..
11ff0 09 09 20 20 20 20 20 20 20 28 6f 6c 64 65 78 69 .. (oldexi
12000 74 73 74 61 74 20 65 78 69 74 73 74 61 74 29 0a tstat exitstat).
12010 09 09 09 20 20 20 20 20 20 20 28 63 6d 64 20 20 ... (cmd
12020 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 (string-i
12030 6e 74 65 72 73 70 65 72 73 65 20 28 6c 69 73 74 ntersperse (list
12040 20 22 6c 6f 67 70 72 6f 22 20 6c 6f 67 70 72 6f "logpro" logpro
12050 66 69 6c 65 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 file htmllogfile
12060 20 22 3c 22 20 6c 6f 67 66 69 6c 65 20 22 3e 22 "<" logfile ">"
12070 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
12080 22 5f 6c 6f 67 70 72 6f 2e 6c 6f 67 22 29 29 20 "_logpro.log"))
12090 22 20 22 29 29 29 0a 09 09 09 20 20 28 64 65 62 " "))).... (deb
120a0 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 ug:print-info 2
120b0 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
120c0 74 2a 20 22 72 75 6e 6e 69 6e 67 20 5c 22 22 20 t* "running \""
120d0 63 6d 64 20 22 5c 22 22 29 0a 09 09 09 20 20 28 cmd "\"").... (
120e0 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
120f0 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 09 startingdir)...
12100 09 20 20 28 73 65 74 21 20 65 78 69 74 73 74 61 . (set! exitsta
12110 74 20 28 73 79 73 74 65 6d 20 63 6d 64 29 29 0a t (system cmd)).
12120 09 09 09 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 ... (set! *glob
12130 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 65 78 alexitstatus* ex
12140 69 74 73 74 61 74 29 20 3b 3b 20 6e 6f 20 6e 65 itstat) ;; no ne
12150 63 65 73 73 61 72 79 0a 09 09 09 20 20 28 63 68 cessary.... (ch
12160 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
12170 65 73 74 70 61 74 68 29 0a 09 09 09 20 20 28 72 estpath).... (r
12180 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 mt:test-set-log!
12190 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
121a0 68 74 6d 6c 6c 6f 67 66 69 6c 65 29 29 29 0a 09 htmllogfile)))..
121b0 09 20 20 20 20 28 6c 65 74 20 28 28 6d 73 67 20 . (let ((msg
121c0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
121d0 6d 22 29 29 29 0a 09 09 20 20 20 20 20 20 28 72 m")))... (r
121e0 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d mt:teststep-set-
121f0 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
12200 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 est-id stepname
12210 22 65 6e 64 22 20 65 78 69 74 73 74 61 74 20 6d "end" exitstat m
12220 73 67 20 6c 6f 67 66 69 6c 65 29 29 0a 09 09 20 sg logfile))...
12230 20 20 20 29 29 29 0a 09 20 20 28 69 66 20 28 6f ))).. (if (o
12240 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
12250 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a "-test-status").
12260 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 .. (args:get-ar
12270 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 g "-set-values")
12280 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 ).. (let ((
12290 6e 65 77 73 74 61 74 75 73 20 28 63 6f 6e 64 0a newstatus (cond.
122a0 09 09 09 09 28 28 6e 75 6d 62 65 72 3f 20 73 74 ....((number? st
122b0 61 74 75 73 29 20 20 20 20 20 20 20 28 69 66 20 atus) (if
122c0 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 20 30 (equal? status 0
122d0 29 20 22 50 41 53 53 22 20 22 46 41 49 4c 22 29 ) "PASS" "FAIL")
122e0 29 0a 09 09 09 09 28 28 61 6e 64 20 28 73 74 72 ).....((and (str
122f0 69 6e 67 3f 20 73 74 61 74 75 73 29 0a 09 09 09 ing? status)....
12300 09 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e . (string->
12310 6e 75 6d 62 65 72 20 73 74 61 74 75 73 29 29 28 number status))(
12320 69 66 20 28 65 71 75 61 6c 3f 20 28 73 74 72 69 if (equal? (stri
12330 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 ng->number statu
12340 73 29 20 30 29 20 22 50 41 53 53 22 20 22 46 41 s) 0) "PASS" "FA
12350 49 4c 22 29 29 0a 09 09 09 09 28 65 6c 73 65 20 IL")).....(else
12360 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 20 20 status)))...
12370 3b 3b 20 74 72 61 6e 73 66 65 72 20 72 65 6c 65 ;; transfer rele
12380 76 61 6e 74 20 6b 65 79 73 20 69 6e 74 6f 20 61 vant keys into a
12390 20 68 61 73 68 20 74 6f 20 62 65 20 70 61 73 73 hash to be pass
123a0 65 64 20 74 6f 20 74 65 73 74 2d 73 65 74 2d 73 ed to test-set-s
123b0 74 61 74 75 73 21 0a 09 09 20 20 20 20 3b 3b 20 tatus!... ;;
123c0 63 6f 75 6c 64 20 75 73 65 20 61 6e 20 61 73 73 could use an ass
123d0 6f 63 20 6c 69 73 74 20 49 20 67 75 65 73 73 2e oc list I guess.
123e0 20 0a 09 09 20 20 20 20 28 6f 74 68 65 72 64 61 ... (otherda
123f0 74 61 20 28 6c 65 74 20 28 28 72 65 73 20 28 6d ta (let ((res (m
12400 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
12410 29 0a 09 09 09 09 20 28 66 6f 72 2d 65 61 63 68 )..... (for-each
12420 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 (lambda (key)..
12430 09 09 09 09 20 20 20 20 20 28 69 66 20 28 61 72 .... (if (ar
12440 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 79 29 0a gs:get-arg key).
12450 09 09 09 09 09 09 20 28 68 61 73 68 2d 74 61 62 ...... (hash-tab
12460 6c 65 2d 73 65 74 21 20 72 65 73 20 6b 65 79 20 le-set! res key
12470 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 (args:get-arg ke
12480 79 29 29 29 29 0a 09 09 09 09 09 20 20 20 28 6c y))))...... (l
12490 69 73 74 20 22 3a 76 61 6c 75 65 22 20 22 3a 74 ist ":value" ":t
124a0 6f 6c 22 20 22 3a 65 78 70 65 63 74 65 64 22 20 ol" ":expected"
124b0 22 3a 66 69 72 73 74 5f 65 72 72 22 20 22 3a 66 ":first_err" ":f
124c0 69 72 73 74 5f 77 61 72 6e 22 20 22 3a 75 6e 69 irst_warn" ":uni
124d0 74 73 22 20 22 3a 63 61 74 65 67 6f 72 79 22 20 ts" ":category"
124e0 22 3a 76 61 72 69 61 62 6c 65 22 29 29 0a 09 09 ":variable"))...
124f0 09 09 20 72 65 73 29 29 29 0a 09 09 28 69 66 20 .. res)))...(if
12500 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 (and (args:get-a
12510 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 rg "-test-status
12520 22 29 0a 09 09 09 20 28 6f 72 20 28 6e 6f 74 20 ").... (or (not
12530 73 74 61 74 65 29 0a 09 09 09 20 20 20 20 20 28 state).... (
12540 6e 6f 74 20 73 74 61 74 75 73 29 29 29 0a 09 09 not status)))...
12550 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 (begin...
12560 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
12570 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
12580 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 59 6f 75 20 -log-port* "You
12590 6d 75 73 74 20 73 70 65 63 69 66 79 20 3a 73 74 must specify :st
125a0 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 20 ate and :status
125b0 77 69 74 68 20 65 76 65 72 79 20 63 61 6c 6c 20 with every call
125c0 74 6f 20 2d 74 65 73 74 2d 73 74 61 74 75 73 5c to -test-status\
125d0 6e 22 20 68 65 6c 70 29 0a 09 09 20 20 20 20 20 n" help)...
125e0 20 28 69 66 20 28 73 71 6c 69 74 65 33 3a 64 61 (if (sqlite3:da
125f0 74 61 62 61 73 65 3f 20 64 62 29 28 73 71 6c 69 tabase? db)(sqli
12600 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
12610 29 29 0a 09 09 20 20 20 20 20 20 28 65 78 69 74 ))... (exit
12620 20 36 29 29 29 0a 09 09 28 6c 65 74 2a 20 28 28 6)))...(let* ((
12630 6d 73 67 20 20 20 20 28 61 72 67 73 3a 67 65 74 msg (args:get
12640 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 20 20 -arg "-m"))...
12650 20 20 20 20 20 28 6e 75 6d 6f 74 68 20 28 6c 65 (numoth (le
12660 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 6c 65 ngth (hash-table
12670 2d 6b 65 79 73 20 6f 74 68 65 72 64 61 74 61 29 -keys otherdata)
12680 29 29 29 0a 09 09 20 20 3b 3b 20 43 6f 6e 76 65 )))... ;; Conve
12690 72 74 20 74 6f 20 72 70 63 20 69 6e 73 69 64 65 rt to rpc inside
126a0 20 74 68 65 20 74 65 73 74 73 3a 74 65 73 74 2d the tests:test-
126b0 73 65 74 2d 73 74 61 74 75 73 21 20 63 61 6c 6c set-status! call
126c0 2c 20 6e 6f 74 20 68 65 72 65 0a 09 09 20 20 28 , not here... (
126d0 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 tests:test-set-s
126e0 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 tatus! run-id te
126f0 73 74 2d 69 64 20 73 74 61 74 65 20 6e 65 77 73 st-id state news
12700 74 61 74 75 73 20 6d 73 67 20 6f 74 68 65 72 64 tatus msg otherd
12710 61 74 61 20 77 6f 72 6b 2d 61 72 65 61 3a 20 77 ata work-area: w
12720 6f 72 6b 2d 61 72 65 61 29 29 29 29 0a 09 20 20 ork-area))))..
12730 28 69 66 20 28 73 71 6c 69 74 65 33 3a 64 61 74 (if (sqlite3:dat
12740 61 62 61 73 65 3f 20 64 62 29 28 73 71 6c 69 74 abase? db)(sqlit
12750 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
12760 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 ).. (set! *dids
12770 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 omething* #t))))
12780 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
12790 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
127a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
127b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
127c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 56 61 ==========.;; Va
127d0 72 69 6f 75 73 20 68 65 6c 70 65 72 20 63 6f 6d rious helper com
127e0 6d 61 6e 64 73 20 63 61 6e 20 67 6f 20 62 65 6c mands can go bel
127f0 6f 77 20 68 65 72 65 0a 3b 3b 3d 3d 3d 3d 3d 3d ow here.;;======
12800 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12810 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12820 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12830 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12840 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a ..(if (or (args:
12850 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 6b 65 get-arg "-showke
12860 79 73 22 29 0a 20 20 20 20 20 20 20 20 28 61 72 ys"). (ar
12870 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f gs:get-arg "-sho
12880 77 2d 6b 65 79 73 22 29 29 0a 20 20 20 20 28 6c w-keys")). (l
12890 65 74 20 28 28 64 62 20 23 66 29 0a 09 20 20 28 et ((db #f).. (
128a0 6b 65 79 73 20 23 66 29 29 0a 20 20 20 20 20 20 keys #f)).
128b0 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 (if (not (launch
128c0 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 65 67 :setup)).. (beg
128d0 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 in.. (debug:p
128e0 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
128f0 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 log-port* "Faile
12900 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit
12910 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 69 74 ing").. (exit
12920 20 31 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 1))). (set
12930 21 20 6b 65 79 73 20 28 72 6d 74 3a 67 65 74 2d ! keys (rmt:get-
12940 6b 65 79 73 29 29 20 3b 3b 20 20 64 62 29 29 0a keys)) ;; db)).
12950 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
12960 6e 74 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 1 *default-lo
12970 67 2d 70 6f 72 74 2a 20 22 4b 65 79 73 3a 20 22 g-port* "Keys: "
12980 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
12990 65 72 73 65 20 6b 65 79 73 20 22 2c 20 22 29 29 erse keys ", "))
129a0 0a 20 20 20 20 20 20 28 69 66 20 28 73 71 6c 69 . (if (sqli
129b0 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 64 62 te3:database? db
129c0 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 )(sqlite3:finali
129d0 7a 65 21 20 64 62 29 29 0a 20 20 20 20 20 20 28 ze! db)). (
129e0 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
129f0 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 ng* #t)))..(if (
12a00 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 args:get-arg "-g
12a10 75 69 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ui"). (begin.
12a20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
12a30 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
12a40 67 2d 70 6f 72 74 2a 20 22 4c 6f 6f 6b 20 61 74 g-port* "Look at
12a50 20 74 68 65 20 64 61 73 68 62 6f 61 72 64 20 66 the dashboard f
12a60 6f 72 20 6e 6f 77 22 29 0a 20 20 20 20 20 20 3b or now"). ;
12a70 3b 20 28 6d 65 67 61 74 65 73 74 2d 67 75 69 29 ; (megatest-gui)
12a80 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
12a90 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
12aa0 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
12ab0 2d 61 72 67 20 22 2d 63 72 65 61 74 65 2d 6d 65 -arg "-create-me
12ac0 67 61 74 65 73 74 2d 61 72 65 61 22 29 0a 20 20 gatest-area").
12ad0 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
12ae0 67 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 genexample:mk-me
12af0 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 29 0a 20 gatest.config).
12b00 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
12b10 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
12b20 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
12b30 72 67 20 22 2d 63 72 65 61 74 65 2d 74 65 73 74 rg "-create-test
12b40 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 65 "). (let ((te
12b50 73 74 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 stname (args:get
12b60 2d 61 72 67 20 22 2d 63 72 65 61 74 65 2d 74 65 -arg "-create-te
12b70 73 74 22 29 29 29 0a 20 20 20 20 20 20 28 67 65 st"))). (ge
12b80 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 nexample:mk-mega
12b90 74 65 73 74 2d 74 65 73 74 20 74 65 73 74 6e 61 test-test testna
12ba0 6d 65 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 me). (set!
12bb0 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
12bc0 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
12bd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12be0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12bf0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12c00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
12c10 3b 20 55 70 64 61 74 65 20 74 68 65 20 64 61 74 ; Update the dat
12c20 61 62 61 73 65 20 73 63 68 65 6d 61 2c 20 63 6c abase schema, cl
12c30 65 61 6e 20 75 70 20 74 68 65 20 64 62 0a 3b 3b ean up the db.;;
12c40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12c50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12c60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12c70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12c80 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 ======..(if (arg
12c90 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 62 75 s:get-arg "-rebu
12ca0 69 6c 64 2d 64 62 22 29 0a 20 20 20 20 28 62 65 ild-db"). (be
12cb0 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e gin. (if (n
12cc0 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 ot (launch:setup
12cd0 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 )).. (begin..
12ce0 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
12cf0 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
12d00 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 rt* "Failed to s
12d10 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 etup, exiting")
12d20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 .. (exit 1)))
12d30 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 . ;; keep t
12d40 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 his one local.
12d50 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c (open-run-cl
12d60 6f 73 65 20 70 61 74 63 68 2d 64 62 20 23 66 29 ose patch-db #f)
12d70 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
12d80 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
12d90 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
12da0 2d 61 72 67 20 22 2d 63 6c 65 61 6e 75 70 2d 64 -arg "-cleanup-d
12db0 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 b"). (begin.
12dc0 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c (if (not (l
12dd0 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 aunch:setup))..
12de0 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 (begin.. (de
12df0 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
12e00 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
12e10 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
12e20 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 exiting") ..
12e30 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 (exit 1))).
12e40 20 20 28 6c 65 74 20 28 28 64 62 73 74 72 75 63 (let ((dbstruc
12e50 74 20 28 64 62 3a 73 65 74 75 70 20 2a 74 6f 70 t (db:setup *top
12e60 70 61 74 68 2a 29 29 29 0a 20 20 20 20 20 20 20 path*))).
12e70 20 28 63 6f 6d 6d 6f 6e 3a 63 6c 65 61 6e 75 70 (common:cleanup
12e80 2d 64 62 20 64 62 73 74 72 75 63 74 29 29 0a 20 -db dbstruct)).
12e90 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
12ea0 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
12eb0 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
12ec0 72 67 20 22 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 rg "-mark-incomp
12ed0 6c 65 74 65 73 22 29 0a 20 20 20 20 28 62 65 67 letes"). (beg
12ee0 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f in. (if (no
12ef0 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 t (launch:setup)
12f00 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 ).. (begin..
12f10 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
12f20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
12f30 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 t* "Failed to se
12f40 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 tup, exiting")..
12f50 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
12f60 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
12f70 6c 6f 73 65 20 64 62 3a 66 69 6e 64 2d 61 6e 64 lose db:find-and
12f80 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 -mark-incomplete
12f90 20 23 66 29 0a 20 20 20 20 20 20 28 73 65 74 21 #f). (set!
12fa0 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
12fb0 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d #t)))..;;=======
12fc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12fd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12fe0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ff0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
13000 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 74 65 ;; Update the te
13010 73 74 73 20 6d 65 74 61 20 64 61 74 61 20 66 72 sts meta data fr
13020 6f 6d 20 74 68 65 20 74 65 73 74 63 6f 6e 66 69 om the testconfi
13030 67 20 66 69 6c 65 73 0a 3b 3b 3d 3d 3d 3d 3d 3d g files.;;======
13040 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13050 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13060 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13070 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13080 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
13090 61 72 67 20 22 2d 75 70 64 61 74 65 2d 6d 65 74 arg "-update-met
130a0 61 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 a"). (begin.
130b0 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c (if (not (l
130c0 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 aunch:setup))..
130d0 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 (begin.. (de
130e0 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
130f0 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
13100 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
13110 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 exiting") ..
13120 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 (exit 1))).
13130 20 20 28 72 75 6e 73 3a 75 70 64 61 74 65 2d 61 (runs:update-a
13140 6c 6c 2d 74 65 73 74 5f 6d 65 74 61 20 23 66 29 ll-test_meta #f)
13150 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
13160 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
13170 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
13180 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13190 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 53 ===========.;; S
131c0 74 61 72 74 20 61 20 72 65 70 6c 0a 3b 3b 3d 3d tart a repl.;;==
131d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
131f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13200 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13210 3d 3d 3d 3d 0a 0a 3b 3b 20 66 61 6b 65 6f 75 74 ====..;; fakeout
13220 20 72 65 61 64 6c 69 6e 65 0a 28 69 6e 63 6c 75 readline.(inclu
13230 64 65 20 22 72 65 61 64 6c 69 6e 65 2d 66 69 78 de "readline-fix
13240 2e 73 63 6d 22 29 0a 0a 28 69 66 20 28 6f 72 20 .scm")..(if (or
13250 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 53 (getenv "MT_RUNS
13260 43 52 49 50 54 22 29 0a 09 28 61 72 67 73 3a 67 CRIPT")..(args:g
13270 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 29 0a et-arg "-repl").
13280 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
13290 2d 6c 6f 61 64 22 29 29 0a 20 20 20 20 28 6c 65 -load")). (le
132a0 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 6c 61 t* ((toppath (la
132b0 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 unch:setup))..
132c0 20 28 64 62 73 74 72 75 63 74 20 28 69 66 20 28 (dbstruct (if (
132d0 61 6e 64 20 74 6f 70 70 61 74 68 0a 20 20 20 20 and toppath.
132e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
132f0 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f (commo
13300 6e 3a 6f 6e 2d 68 6f 6d 65 68 6f 73 74 3f 29 29 n:on-homehost?))
13310 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
13320 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 73 65 (db:se
13330 74 75 70 29 0a 20 20 20 20 20 20 20 20 20 20 20 tup).
13340 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 #f
13350 29 29 29 20 3b 3b 20 6d 61 6b 65 2d 64 62 72 3a ))) ;; make-dbr:
13360 64 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 74 dbstruct path: t
13370 6f 70 70 61 74 68 20 6c 6f 63 61 6c 3a 20 28 61 oppath local: (a
13380 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
13390 63 61 6c 22 29 29 20 23 66 29 29 29 0a 20 20 20 cal")) #f))).
133a0 20 20 20 28 69 66 20 2a 74 6f 70 70 61 74 68 2a (if *toppath*
133b0 0a 09 20 20 28 63 6f 6e 64 0a 09 20 20 20 28 28 .. (cond.. ((
133c0 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 53 43 getenv "MT_RUNSC
133d0 52 49 50 54 22 29 0a 09 20 20 20 20 3b 3b 20 48 RIPT").. ;; H
133e0 6f 77 20 74 6f 20 72 75 6e 20 6d 65 67 61 74 65 ow to run megate
133f0 73 74 20 73 63 72 69 70 74 73 0a 09 20 20 20 20 st scripts..
13400 3b 3b 0a 09 20 20 20 20 3b 3b 20 23 21 2f 62 69 ;;.. ;; #!/bi
13410 6e 2f 62 61 73 68 0a 09 20 20 20 20 3b 3b 0a 09 n/bash.. ;;..
13420 20 20 20 20 3b 3b 20 65 78 70 6f 72 74 20 4d 54 ;; export MT
13430 5f 52 55 4e 53 43 52 49 50 54 3d 79 65 73 0a 09 _RUNSCRIPT=yes..
13440 20 20 20 20 3b 3b 20 6d 65 67 61 74 65 73 74 20 ;; megatest
13450 3c 3c 20 45 4f 46 0a 09 20 20 20 20 3b 3b 20 28 << EOF.. ;; (
13460 70 72 69 6e 74 20 22 48 65 6c 6c 6f 20 77 6f 72 print "Hello wor
13470 6c 64 22 29 0a 09 20 20 20 20 3b 3b 20 28 65 78 ld").. ;; (ex
13480 69 74 29 0a 09 20 20 20 20 3b 3b 20 45 4f 46 0a it).. ;; EOF.
13490 0a 09 20 20 20 20 28 72 65 70 6c 29 29 0a 09 20 .. (repl))..
134a0 20 20 28 65 6c 73 65 0a 09 20 20 20 20 28 62 65 (else.. (be
134b0 67 69 6e 0a 09 20 20 20 20 20 20 28 73 65 74 21 gin.. (set!
134c0 20 2a 64 62 2a 20 64 62 73 74 72 75 63 74 29 0a *db* dbstruct).
134d0 09 20 20 20 20 20 20 28 69 6d 70 6f 72 74 20 65 . (import e
134e0 78 74 72 61 73 29 20 3b 3b 20 6d 69 67 68 74 20 xtras) ;; might
134f0 6e 6f 74 20 62 65 20 6e 65 65 64 65 64 0a 09 20 not be needed..
13500 20 20 20 20 20 3b 3b 20 28 69 6d 70 6f 72 74 20 ;; (import
13510 63 73 69 29 0a 09 20 20 20 20 20 20 28 69 6d 70 csi).. (imp
13520 6f 72 74 20 72 65 61 64 6c 69 6e 65 29 0a 09 20 ort readline)..
13530 20 20 20 20 20 28 69 6d 70 6f 72 74 20 61 70 72 (import apr
13540 6f 70 6f 73 29 0a 09 20 20 20 20 20 20 3b 3b 20 opos).. ;;
13550 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 (import (prefix
13560 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a sqlite3 sqlite3:
13570 29 29 20 3b 3b 20 64 6f 65 73 6e 27 74 20 77 6f )) ;; doesn't wo
13580 72 6b 20 2e 2e 2e 0a 0a 09 20 20 20 20 20 20 28 rk ...... (
13590 69 66 20 2a 75 73 65 2d 6e 65 77 2d 72 65 61 64 if *use-new-read
135a0 6c 69 6e 65 2a 0a 09 09 20 20 28 62 65 67 69 6e line*... (begin
135b0 0a 09 09 20 20 20 20 28 69 6e 73 74 61 6c 6c 2d ... (install-
135c0 68 69 73 74 6f 72 79 2d 66 69 6c 65 20 28 67 65 history-file (ge
135d0 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
135e0 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 riable "HOME") "
135f0 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 74 6f 72 .megatest_histor
13600 79 22 29 20 3b 3b 20 20 5b 68 6f 6d 65 64 69 72 y") ;; [homedir
13610 5d 20 5b 66 69 6c 65 6e 61 6d 65 5d 20 5b 6e 6c ] [filename] [nl
13620 69 6e 65 73 5d 29 0a 09 09 20 20 20 20 28 63 75 ines])... (cu
13630 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 rrent-input-port
13640 20 28 6d 61 6b 65 2d 72 65 61 64 6c 69 6e 65 2d (make-readline-
13650 70 6f 72 74 20 22 6d 65 67 61 74 65 73 74 3e 20 port "megatest>
13660 22 29 29 29 0a 09 09 20 20 28 62 65 67 69 6e 0a ")))... (begin.
13670 09 09 20 20 20 20 28 67 6e 75 2d 68 69 73 74 6f .. (gnu-histo
13680 72 79 2d 69 6e 73 74 61 6c 6c 2d 66 69 6c 65 2d ry-install-file-
13690 6d 61 6e 61 67 65 72 0a 09 09 20 20 20 20 20 28 manager... (
136a0 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 0a 09 09 string-append...
136b0 20 20 20 20 20 20 28 6f 72 20 28 67 65 74 2d 65 (or (get-e
136c0 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
136d0 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2e 22 29 ble "HOME") ".")
136e0 20 22 2f 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 "/.megatest_his
136f0 74 6f 72 79 22 29 29 0a 09 09 20 20 20 20 28 63 tory"))... (c
13700 75 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 urrent-input-por
13710 74 20 28 6d 61 6b 65 2d 67 6e 75 2d 72 65 61 64 t (make-gnu-read
13720 6c 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 line-port "megat
13730 65 73 74 3e 20 22 29 29 29 29 0a 09 20 20 20 20 est> "))))..
13740 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
13750 61 72 67 20 22 2d 72 65 70 6c 22 29 0a 09 09 20 arg "-repl")...
13760 20 28 72 65 70 6c 29 0a 09 09 20 20 28 6c 6f 61 (repl)... (loa
13770 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
13780 22 2d 6c 6f 61 64 22 29 29 29 0a 09 20 20 20 20 "-load")))..
13790 20 20 3b 3b 20 28 64 62 3a 63 6c 6f 73 65 2d 61 ;; (db:close-a
137a0 6c 6c 20 64 62 73 74 72 75 63 74 29 20 3c 3d 20 ll dbstruct) <=
137b0 74 61 6b 65 6e 20 63 61 72 65 20 6f 66 20 62 79 taken care of by
137c0 20 6f 6e 2d 65 78 69 74 20 63 61 6c 6c 0a 09 20 on-exit call..
137d0 20 20 20 20 20 29 0a 09 20 20 20 20 28 65 78 69 ).. (exi
137e0 74 29 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 t))).. (set! *d
137f0 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
13800 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
13810 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13820 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13830 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13840 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
13850 20 57 61 69 74 20 6f 6e 20 61 20 72 75 6e 20 74 Wait on a run t
13860 6f 20 63 6f 6d 70 6c 65 74 65 0a 3b 3b 3d 3d 3d o complete.;;===
13870 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13880 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13890 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
138a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
138b0 3d 3d 3d 0a 0a 28 69 66 20 28 61 6e 64 20 28 61 ===..(if (and (a
138c0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
138d0 6e 2d 77 61 69 74 22 29 0a 09 20 28 6e 6f 74 20 n-wait").. (not
138e0 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
138f0 67 20 22 2d 72 75 6e 22 29 0a 09 09 20 20 28 61 g "-run")... (a
13900 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
13910 6e 74 65 73 74 73 22 29 29 29 29 20 3b 3b 20 72 ntests")))) ;; r
13920 75 6e 2d 77 61 69 74 20 69 73 20 62 75 69 6c 74 un-wait is built
13930 20 69 6e 74 6f 20 72 75 6e 74 65 73 74 73 20 6e into runtests n
13940 6f 77 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 ow. (begin.
13950 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 (if (not (la
13960 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 unch:setup))..
13970 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 (begin.. (deb
13980 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
13990 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 ult-log-port* "F
139a0 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 ailed to setup,
139b0 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 exiting") ..
139c0 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 (exit 1))).
139d0 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 72 75 (operate-on 'ru
139e0 6e 2d 77 61 69 74 29 0a 20 20 20 20 20 20 28 73 n-wait). (s
139f0 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
13a00 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 3b 3b 20 g* #t)))..;; ;;
13a10 3b 3b 20 72 65 64 6f 20 6d 65 20 3b 3b 20 4e 6f ;; redo me ;; No
13a20 74 20 63 6f 6e 76 65 72 74 65 64 20 74 6f 20 75 t converted to u
13a30 73 65 20 64 62 73 74 72 75 63 74 20 79 65 74 0a se dbstruct yet.
13a40 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
13a50 20 3b 3b 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ;;.;; ;; ;; red
13a60 6f 20 6d 65 20 28 69 66 20 28 61 72 67 73 3a 67 o me (if (args:g
13a70 65 74 2d 61 72 67 20 22 2d 63 6f 6e 76 65 72 74 et-arg "-convert
13a80 2d 74 6f 2d 6e 6f 72 6d 22 29 0a 3b 3b 20 3b 3b -to-norm").;; ;;
13a90 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 ;; redo me
13aa0 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 (let* ((toppath
13ab0 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
13ac0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13ad0 65 20 09 20 20 20 28 64 62 73 74 72 75 63 74 20 e . (dbstruct
13ae0 28 69 66 20 74 6f 70 70 61 74 68 20 28 6d 61 6b (if toppath (mak
13af0 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 e-dbr:dbstruct p
13b00 61 74 68 3a 20 74 6f 70 70 61 74 68 20 6c 6f 63 ath: toppath loc
13b10 61 6c 3a 20 23 74 29 29 29 29 0a 3b 3b 20 3b 3b al: #t)))).;; ;;
13b20 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 ;; redo me
13b30 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 3b 3b 20 (for-each .;;
13b40 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
13b50 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 69 (lambda (fi
13b60 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 eld).;; ;; ;; re
13b70 64 6f 20 6d 65 20 09 20 28 6c 65 74 20 28 28 64 do me . (let ((d
13b80 61 74 20 27 28 29 29 29 0a 3b 3b 20 3b 3b 20 3b at '())).;; ;; ;
13b90 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 64 ; redo me . (d
13ba0 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
13bb0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
13bc0 6f 72 74 2a 20 22 47 65 74 74 69 6e 67 20 64 61 ort* "Getting da
13bd0 74 61 20 66 6f 72 20 66 69 65 6c 64 20 22 20 66 ta for field " f
13be0 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 ield).;; ;; ;; r
13bf0 65 64 6f 20 6d 65 20 09 20 20 20 28 73 71 6c 69 edo me . (sqli
13c00 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
13c10 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13c20 65 20 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 e . (lambda (
13c30 69 64 20 76 61 6c 29 0a 3b 3b 20 3b 3b 20 3b 3b id val).;; ;; ;;
13c40 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 20 redo me .
13c50 28 73 65 74 21 20 64 61 74 20 28 63 6f 6e 73 20 (set! dat (cons
13c60 28 6c 69 73 74 20 69 64 20 76 61 6c 29 20 64 61 (list id val) da
13c70 74 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 t))).;; ;; ;; re
13c80 64 6f 20 6d 65 20 09 20 20 20 20 28 64 62 3a 67 do me . (db:g
13c90 65 74 2d 64 62 20 64 62 20 72 75 6e 2d 69 64 29 et-db db run-id)
13ca0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13cb0 65 20 09 20 20 20 20 28 63 6f 6e 63 20 22 53 45 e . (conc "SE
13cc0 4c 45 43 54 20 69 64 2c 22 20 66 69 65 6c 64 20 LECT id," field
13cd0 22 20 46 52 4f 4d 20 74 65 73 74 73 3b 22 29 29 " FROM tests;"))
13ce0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13cf0 65 20 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 e . (debug:pri
13d00 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
13d10 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 6f lt-log-port* "fo
13d20 75 6e 64 20 22 20 28 6c 65 6e 67 74 68 20 64 61 und " (length da
13d30 74 29 20 22 20 69 74 65 6d 73 20 66 6f 72 20 66 t) " items for f
13d40 69 65 6c 64 20 22 20 66 69 65 6c 64 29 0a 3b 3b ield " field).;;
13d50 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
13d60 20 20 20 28 6c 65 74 20 28 28 71 72 79 20 28 73 (let ((qry (s
13d70 71 6c 69 74 65 33 3a 70 72 65 70 61 72 65 20 64 qlite3:prepare d
13d80 62 20 28 63 6f 6e 63 20 22 55 50 44 41 54 45 20 b (conc "UPDATE
13d90 74 65 73 74 73 20 53 45 54 20 22 20 66 69 65 6c tests SET " fiel
13da0 64 20 22 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f d "=? WHERE id=?
13db0 3b 22 29 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 ;")))).;; ;; ;;
13dc0 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 28 66 redo me . (f
13dd0 6f 72 2d 65 61 63 68 0a 3b 3b 20 3b 3b 20 3b 3b or-each.;; ;; ;;
13de0 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 20 redo me .
13df0 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 3b (lambda (item).;
13e00 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
13e10 09 09 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 ..(let ((newval
13e20 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 67 65 74 ;; (sdb:qry 'get
13e30 69 64 20 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 id .;; ;; ;; red
13e40 6f 20 6d 65 20 09 09 20 20 20 20 20 20 20 28 63 o me .. (c
13e50 61 64 72 20 69 74 65 6d 29 29 29 20 3b 3b 20 29 adr item))) ;; )
13e60 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13e70 65 20 09 09 20 20 28 69 66 20 28 6e 6f 74 20 28 e .. (if (not (
13e80 65 71 75 61 6c 3f 20 6e 65 77 76 61 6c 20 28 63 equal? newval (c
13e90 61 64 72 20 69 74 65 6d 29 29 29 0a 3b 3b 20 3b adr item))).;; ;
13ea0 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 20 ; ;; redo me ..
13eb0 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
13ec0 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
13ed0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 6f 6e t-log-port* "Con
13ee0 76 65 72 74 69 6e 67 20 22 20 28 63 61 64 72 20 verting " (cadr
13ef0 69 74 65 6d 29 20 22 20 74 6f 20 22 20 6e 65 77 item) " to " new
13f00 76 61 6c 20 22 20 66 6f 72 20 74 65 73 74 20 23 val " for test #
13f10 22 20 28 63 61 72 20 69 74 65 6d 29 29 29 0a 3b " (car item))).;
13f20 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
13f30 09 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 .. (sqlite3:exe
13f40 63 75 74 65 20 71 72 79 20 6e 65 77 76 61 6c 20 cute qry newval
13f50 28 63 61 72 20 69 74 65 6d 29 29 29 29 0a 3b 3b (car item)))).;;
13f60 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
13f70 20 20 20 20 20 20 64 61 74 29 0a 3b 3b 20 3b 3b dat).;; ;;
13f80 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
13f90 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
13fa0 69 7a 65 21 20 71 72 79 29 29 29 29 0a 3b 3b 20 ize! qry)))).;;
13fb0 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
13fc0 20 20 20 20 20 28 64 62 3a 63 6c 6f 73 65 2d 61 (db:close-a
13fd0 6c 6c 20 64 62 73 74 72 75 63 74 29 0a 3b 3b 20 ll dbstruct).;;
13fe0 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
13ff0 20 20 20 20 20 28 6c 69 73 74 20 22 75 6e 61 6d (list "unam
14000 65 22 20 22 72 75 6e 64 69 72 22 20 22 66 69 6e e" "rundir" "fin
14010 61 6c 5f 6c 6f 67 66 22 20 22 63 6f 6d 6d 65 6e al_logf" "commen
14020 74 22 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 t")).;; ;; ;; re
14030 64 6f 20 6d 65 20 20 20 20 20 20 20 28 73 65 74 do me (set
14040 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
14050 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
14060 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 6d 70 6f s:get-arg "-impo
14070 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 29 rt-megatest.db")
14080 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
14090 20 20 28 64 62 3a 6d 75 6c 74 69 2d 64 62 2d 73 (db:multi-db-s
140a0 79 6e 63 20 0a 20 20 20 20 20 20 20 28 64 62 3a ync . (db:
140b0 73 65 74 75 70 29 0a 20 20 20 20 20 20 20 27 6b setup). 'k
140c0 69 6c 6c 73 65 72 76 65 72 73 0a 20 20 20 20 20 illservers.
140d0 20 20 27 64 65 6a 75 6e 6b 0a 20 20 20 20 20 20 'dejunk.
140e0 20 27 61 64 6a 2d 74 65 73 74 69 64 73 0a 20 20 'adj-testids.
140f0 20 20 20 20 20 27 6f 6c 64 32 6e 65 77 0a 20 20 'old2new.
14100 20 20 20 20 20 3b 3b 20 27 6e 65 77 32 6f 6c 64 ;; 'new2old
14110 0a 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 20 . ).
14120 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
14130 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
14140 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
14150 73 79 6e 63 2d 74 6f 2d 6d 65 67 61 74 65 73 74 sync-to-megatest
14160 2e 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e .db"). (begin
14170 0a 20 20 20 20 20 20 28 64 62 3a 6d 75 6c 74 69 . (db:multi
14180 2d 64 62 2d 73 79 6e 63 20 0a 20 20 20 20 20 20 -db-sync .
14190 20 28 64 62 3a 73 65 74 75 70 29 0a 20 20 20 20 (db:setup).
141a0 20 20 20 27 6e 65 77 32 6f 6c 64 0a 20 20 20 20 'new2old.
141b0 20 20 20 29 0a 20 20 20 20 20 20 28 73 65 74 21 ). (set!
141c0 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
141d0 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 #t)))..(if (args
141e0 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 6e 65 72 :get-arg "-gener
141f0 61 74 65 2d 68 74 6d 6c 22 29 0a 20 20 20 20 28 ate-html"). (
14200 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 let* ((toppath (
14210 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 0a launch:setup))).
14220 20 20 20 20 20 20 28 69 66 20 28 74 65 73 74 73 (if (tests
14230 3a 63 72 65 61 74 65 2d 68 74 6d 6c 2d 74 72 65 :create-html-tre
14240 65 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 20 e #f).
14250 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
14260 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 0 *default-log
14270 2d 70 6f 72 74 2a 20 22 48 54 4d 4c 20 6f 75 74 -port* "HTML out
14280 70 75 74 20 63 72 65 61 74 65 64 20 69 6e 20 22 put created in "
14290 20 74 6f 70 70 61 74 68 20 22 2f 6c 74 2f 72 75 toppath "/lt/ru
142a0 6e 73 2d 69 6e 64 65 78 2e 68 74 6d 6c 22 29 0a ns-index.html").
142b0 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
142c0 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
142d0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
142e0 6c 65 64 20 74 6f 20 63 72 65 61 74 65 20 48 54 led to create HT
142f0 4d 4c 20 6f 75 74 70 75 74 20 69 6e 20 22 20 74 ML output in " t
14300 6f 70 70 61 74 68 20 22 2f 6c 74 2f 72 75 6e 73 oppath "/lt/runs
14310 2d 69 6e 64 65 78 2e 68 74 6d 6c 22 29 29 0a 20 -index.html")).
14320 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
14330 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
14340 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
14350 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14360 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14370 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14380 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 69 =========.;; Exi
14390 74 20 61 6e 64 20 63 6c 65 61 6e 20 75 70 0a 3b t and clean up.;
143a0 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
143b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
143c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
143d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
143e0 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6e 6f =======..(if (no
143f0 74 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a t *didsomething*
14400 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
14410 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
14420 67 2d 70 6f 72 74 2a 20 68 65 6c 70 29 29 0a 0a g-port* help))..
14430 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 2a 77 (thread-join! *w
14440 61 74 63 68 64 6f 67 2a 29 0a 28 73 65 74 21 20 atchdog*).(set!
14450 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a 20 23 *time-to-exit* #
14460 74 29 0a 0a 28 69 66 20 28 6e 6f 74 20 28 65 71 t)..(if (not (eq
14470 3f 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 ? *globalexitsta
14480 74 75 73 2a 20 30 29 29 0a 20 20 20 20 28 69 66 tus* 0)). (if
14490 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
144a0 72 67 20 22 2d 72 75 6e 22 29 28 61 72 67 73 3a rg "-run")(args:
144b0 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 get-arg "-runtes
144c0 74 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 ts")(args:get-ar
144d0 67 20 22 2d 72 75 6e 61 6c 6c 22 29 29 0a 20 20 g "-runall")).
144e0 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 (begin.
144f0 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 (debug:p
14500 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
14510 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 4f 54 45 3a log-port* "NOTE:
14520 20 53 75 62 70 72 6f 63 65 73 73 65 73 20 77 69 Subprocesses wi
14530 74 68 20 6e 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 th non-zero exit
14540 20 63 6f 64 65 20 64 65 74 65 63 74 65 64 3a 20 code detected:
14550 22 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 " *globalexitsta
14560 74 75 73 2a 29 0a 20 20 20 20 20 20 20 20 20 20 tus*).
14570 20 28 65 78 69 74 20 30 29 29 0a 20 20 20 20 20 (exit 0)).
14580 20 20 20 28 63 61 73 65 20 2a 67 6c 6f 62 61 6c (case *global
14590 65 78 69 74 73 74 61 74 75 73 2a 0a 20 20 20 20 exitstatus*.
145a0 20 20 20 20 20 28 28 30 29 28 65 78 69 74 20 30 ((0)(exit 0
145b0 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 31 29 )). ((1)
145c0 28 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 20 (exit 1)).
145d0 20 20 20 28 28 32 29 28 65 78 69 74 20 32 29 29 ((2)(exit 2))
145e0 0a 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 . (else
145f0 28 65 78 69 74 20 33 29 29 29 29 29 0a (exit 3))))).