0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 20 6-2012, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 made available
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 .;; greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 ng file COPYING
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 for details..;;
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 .;; This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c ven the.;; impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 ied warranty of
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 PARTICULAR.;;
0140: 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 20 28 69 6e PURPOSE...;; (in
0150: 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 2e 73 63 clude "common.sc
0160: 6d 22 29 0a 3b 3b 20 28 69 6e 63 6c 75 64 65 20 m").;; (include
0170: 22 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f "megatest-versio
0180: 6e 2e 73 63 6d 22 29 0a 0a 3b 3b 20 66 61 6b 65 n.scm")..;; fake
0190: 20 6f 75 74 20 72 65 61 64 6c 69 6e 65 20 75 73 out readline us
01a0: 61 67 65 20 6f 66 20 74 6f 70 6c 65 76 65 6c 2d age of toplevel-
01b0: 63 6f 6d 6d 61 6e 64 0a 28 64 65 66 69 6e 65 20 command.(define
01c0: 28 74 6f 70 6c 65 76 65 6c 2d 63 6f 6d 6d 61 6e (toplevel-comman
01d0: 64 20 2e 20 61 29 20 23 66 29 0a 0a 28 75 73 65 d . a) #f)..(use
01e0: 20 73 71 6c 69 74 65 33 20 73 72 66 69 2d 31 20 sqlite3 srfi-1
01f0: 70 6f 73 69 78 20 72 65 67 65 78 20 72 65 67 65 posix regex rege
0200: 78 2d 63 61 73 65 20 73 72 66 69 2d 36 39 20 62 x-case srfi-69 b
0210: 61 73 65 36 34 20 72 65 61 64 6c 69 6e 65 20 61 ase64 readline a
0220: 70 72 6f 70 6f 73 20 6a 73 6f 6e 20 68 74 74 70 propos json http
0230: 2d 63 6c 69 65 6e 74 20 64 69 72 65 63 74 6f 72 -client director
0240: 79 2d 75 74 69 6c 73 20 72 70 63 20 74 79 70 65 y-utils rpc type
0250: 64 2d 72 65 63 6f 72 64 73 3b 3b 20 28 73 72 66 d-records;; (srf
0260: 69 20 31 38 29 20 65 78 74 72 61 73 29 0a 20 20 i 18) extras).
0270: 20 20 20 68 74 74 70 2d 63 6c 69 65 6e 74 20 73 http-client s
0280: 72 66 69 2d 31 38 20 65 78 74 72 61 73 20 66 6f rfi-18 extras fo
0290: 72 6d 61 74 29 20 3b 3b 20 20 7a 6d 71 20 65 78 rmat) ;; zmq ex
02a0: 74 72 61 73 29 0a 0a 3b 3b 20 41 64 64 65 64 20 tras)..;; Added
02b0: 66 6f 72 20 63 73 76 20 73 74 75 66 66 20 2d 20 for csv stuff -
02c0: 77 69 6c 6c 20 62 65 20 72 65 6d 6f 76 65 64 0a will be removed.
02d0: 3b 3b 0a 28 75 73 65 20 73 70 61 72 73 65 2d 76 ;;.(use sparse-v
02e0: 65 63 74 6f 72 73 29 0a 0a 28 69 6d 70 6f 72 74 ectors)..(import
02f0: 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 (prefix sqlite3
0300: 20 73 71 6c 69 74 65 33 3a 29 29 0a 28 69 6d 70 sqlite3:)).(imp
0310: 6f 72 74 20 28 70 72 65 66 69 78 20 62 61 73 65 ort (prefix base
0320: 36 34 20 62 61 73 65 36 34 3a 29 29 0a 28 69 6d 64 base64:)).(im
0330: 70 6f 72 74 20 28 70 72 65 66 69 78 20 72 70 63 port (prefix rpc
0340: 20 72 70 63 3a 29 29 0a 28 72 65 71 75 69 72 65 rpc:)).(require
0350: 2d 6c 69 62 72 61 72 79 20 6d 75 74 69 6c 73 29 -library mutils)
0360: 0a 0a 3b 3b 20 28 75 73 65 20 7a 6d 71 29 0a 0a ..;; (use zmq)..
0370: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 (declare (uses c
0380: 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 ommon)).(declare
0390: 20 28 75 73 65 73 20 6d 65 67 61 74 65 73 74 2d (uses megatest-
03a0: 76 65 72 73 69 6f 6e 29 29 0a 28 64 65 63 6c 61 version)).(decla
03b0: 72 65 20 28 75 73 65 73 20 6d 61 72 67 73 29 29 re (uses margs))
03c0: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
03d0: 72 75 6e 73 29 29 0a 28 64 65 63 6c 61 72 65 20 runs)).(declare
03e0: 28 75 73 65 73 20 6c 61 75 6e 63 68 29 29 0a 28 (uses launch)).(
03f0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 73 65 declare (uses se
0400: 72 76 65 72 29 29 0a 28 64 65 63 6c 61 72 65 20 rver)).(declare
0410: 28 75 73 65 73 20 63 6c 69 65 6e 74 29 29 0a 28 (uses client)).(
0420: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 74 65 declare (uses te
0430: 73 74 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 sts)).(declare (
0440: 75 73 65 73 20 67 65 6e 65 78 61 6d 70 6c 65 29 uses genexample)
0450: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0460: 20 64 61 65 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 daemon)).(decla
0470: 72 65 20 28 75 73 65 73 20 64 62 29 29 0a 3b 3b re (uses db)).;;
0480: 20 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 (declare (uses
0490: 64 63 6f 6d 6d 6f 6e 29 29 0a 0a 28 64 65 63 6c dcommon))..(decl
04a0: 61 72 65 20 28 75 73 65 73 20 74 64 62 29 29 0a are (uses tdb)).
04b0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
04c0: 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 t)).(declare (us
04d0: 65 73 20 61 70 69 29 29 0a 28 64 65 63 6c 61 72 es api)).(declar
04e0: 65 20 28 75 73 65 73 20 74 61 73 6b 73 29 29 20 e (uses tasks))
04f0: 3b 3b 20 6f 6e 6c 79 20 75 73 65 64 20 66 6f 72 ;; only used for
0500: 20 64 65 62 75 67 67 69 6e 67 2e 0a 28 64 65 63 debugging..(dec
0510: 6c 61 72 65 20 28 75 73 65 73 20 65 6e 76 29 29 lare (uses env))
0520: 0a 0a 28 64 65 66 69 6e 65 20 2a 64 62 2a 20 23 ..(define *db* #
0530: 66 29 20 3b 3b 20 74 68 69 73 20 69 73 20 6f 6e f) ;; this is on
0540: 6c 79 20 66 6f 72 20 74 68 65 20 72 65 70 6c 2c ly for the repl,
0550: 20 64 6f 20 6e 6f 74 20 75 73 65 20 69 6e 20 67 do not use in g
0560: 65 6e 65 72 61 6c 21 21 21 21 0a 0a 28 69 6e 63 eneral!!!!..(inc
0570: 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 lude "common_rec
0580: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl
0590: 75 64 65 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 ude "key_records
05a0: 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 .scm").(include
05b0: 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 "db_records.scm"
05c0: 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 75 6e 5f ).(include "run_
05d0: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 records.scm").(i
05e0: 6e 63 6c 75 64 65 20 22 6d 65 67 61 74 65 73 74 nclude "megatest
05f0: 2d 66 6f 73 73 69 6c 2d 68 61 73 68 2e 73 63 6d -fossil-hash.scm
0600: 22 29 0a 0a 28 6c 65 74 20 28 28 64 65 62 75 67 ")..(let ((debug
0610: 63 6f 6e 74 72 6f 6c 66 20 28 63 6f 6e 63 20 28 controlf (conc (
0620: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
0630: 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 variable "HOME")
0640: 20 22 2f 2e 6d 65 67 61 74 65 73 74 72 63 22 29 "/.megatestrc")
0650: 29 29 0a 20 20 28 69 66 20 28 66 69 6c 65 2d 65 )). (if (file-e
0660: 78 69 73 74 73 3f 20 64 65 62 75 67 63 6f 6e 74 xists? debugcont
0670: 72 6f 6c 66 29 0a 20 20 20 20 20 20 28 6c 6f 61 rolf). (loa
0680: 64 20 64 65 62 75 67 63 6f 6e 74 72 6f 6c 66 29 d debugcontrolf)
0690: 29 29 0a 0a 3b 3b 20 44 69 73 61 62 6c 65 64 20 ))..;; Disabled
06a0: 68 65 6c 70 20 69 74 65 6d 73 0a 3b 3b 20 20 2d help items.;; -
06b0: 72 6f 6c 6c 75 70 20 20 20 20 20 20 20 20 20 20 rollup
06c0: 20 20 20 20 20 20 20 3a 20 28 63 75 72 72 65 6e : (curren
06d0: 74 6c 79 20 64 69 73 61 62 6c 65 64 29 20 66 69 tly disabled) fi
06e0: 6c 6c 20 72 75 6e 20 28 73 65 74 20 62 79 20 3a ll run (set by :
06f0: 72 75 6e 6e 61 6d 65 29 20 20 77 69 74 68 20 6c runname) with l
0700: 61 74 65 73 74 20 74 65 73 74 28 73 29 0a 3b 3b atest test(s).;;
0710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0720: 20 20 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d from
0730: 20 70 72 69 6f 72 20 72 75 6e 73 20 77 69 74 68 prior runs with
0740: 20 73 61 6d 65 20 6b 65 79 73 0a 0a 28 64 65 66 same keys..(def
0750: 69 6e 65 20 68 65 6c 70 20 28 63 6f 6e 63 20 22 ine help (conc "
0760: 0a 4d 65 67 61 74 65 73 74 2c 20 64 6f 63 75 6d .Megatest, docum
0770: 65 6e 74 61 74 69 6f 6e 20 61 74 20 68 74 74 70 entation at http
0780: 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f ://www.kiatoa.co
0790: 6d 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 m/fossils/megate
07a0: 73 74 0a 20 20 76 65 72 73 69 6f 6e 20 22 20 6d st. version " m
07b0: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 egatest-version
07c0: 22 0a 20 20 6c 69 63 65 6e 73 65 20 47 50 4c 2c ". license GPL,
07d0: 20 43 6f 70 79 72 69 67 68 74 20 4d 61 74 74 20 Copyright Matt
07e0: 57 65 6c 6c 61 6e 64 20 32 30 30 36 2d 32 30 31 Welland 2006-201
07f0: 35 0a 0a 55 73 61 67 65 3a 20 6d 65 67 61 74 65 5..Usage: megate
0800: 73 74 20 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 2d st [options]. -
0810: 68 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 h
0820: 20 20 20 20 20 20 20 3a 20 74 68 69 73 20 68 65 : this he
0830: 6c 70 0a 20 20 2d 76 65 72 73 69 6f 6e 20 20 20 lp. -version
0840: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 70 : p
0850: 72 69 6e 74 20 6d 65 67 61 74 65 73 74 20 76 65 rint megatest ve
0860: 72 73 69 6f 6e 20 28 63 75 72 72 65 6e 74 6c 79 rsion (currently
0870: 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 " megatest-vers
0880: 69 6f 6e 20 22 29 0a 0a 4c 61 75 6e 63 68 69 6e ion ")..Launchin
0890: 67 20 61 6e 64 20 6d 61 6e 61 67 69 6e 67 20 72 g and managing r
08a0: 75 6e 73 0a 20 20 2d 72 75 6e 61 6c 6c 20 20 20 uns. -runall
08b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
08c0: 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 6f 72 run all tests or
08d0: 20 61 73 20 73 70 65 63 69 66 69 65 64 20 62 79 as specified by
08e0: 20 2d 74 65 73 74 70 61 74 74 0a 20 20 2d 72 65 -testpatt. -re
08f0: 6d 6f 76 65 2d 72 75 6e 73 20 20 20 20 20 20 20 move-runs
0900: 20 20 20 20 20 3a 20 72 65 6d 6f 76 65 20 74 68 : remove th
0910: 65 20 64 61 74 61 20 66 6f 72 20 61 20 72 75 6e e data for a run
0920: 2c 20 72 65 71 75 69 72 65 73 20 2d 72 75 6e 6e , requires -runn
0930: 61 6d 65 20 61 6e 64 20 2d 74 65 73 74 70 61 74 ame and -testpat
0940: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
0950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 4f 70 Op
0960: 74 69 6f 6e 61 6c 6c 79 20 75 73 65 20 3a 73 74 tionally use :st
0970: 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 0a ate and :status.
0980: 20 20 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 -set-state-sta
0990: 74 75 73 20 58 2c 59 20 20 20 3a 20 73 65 74 20 tus X,Y : set
09a0: 73 74 61 74 65 20 74 6f 20 58 20 61 6e 64 20 73 state to X and s
09b0: 74 61 74 75 73 20 74 6f 20 59 2c 20 72 65 71 75 tatus to Y, requ
09c0: 69 72 65 73 20 63 6f 6e 74 72 6f 6c 73 20 70 65 ires controls pe
09d0: 72 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 0a 20 r -remove-runs.
09e0: 20 2d 72 65 72 75 6e 20 46 41 49 4c 2c 57 41 52 -rerun FAIL,WAR
09f0: 4e 2e 2e 2e 20 20 20 20 20 3a 20 66 6f 72 63 65 N... : force
0a00: 20 72 65 2d 72 75 6e 20 66 6f 72 20 74 65 73 74 re-run for test
0a10: 73 20 77 69 74 68 20 73 70 65 63 69 66 69 63 65 s with specifice
0a20: 64 20 73 74 61 74 75 73 28 73 29 0a 20 20 2d 72 d status(s). -r
0a30: 65 72 75 6e 2d 63 6c 65 61 6e 20 20 20 20 20 20 erun-clean
0a40: 20 20 20 20 20 20 3a 20 73 65 74 20 61 6c 6c 20 : set all
0a50: 74 65 73 74 73 20 6e 6f 74 20 43 4f 4d 50 4c 45 tests not COMPLE
0a60: 54 45 44 2b 50 41 53 53 2c 57 41 52 4e 2c 57 41 TED+PASS,WARN,WA
0a70: 49 56 45 44 20 74 6f 20 4e 4f 54 5f 53 54 41 52 IVED to NOT_STAR
0a80: 54 45 44 2c 6e 2f 61 0a 20 20 20 20 20 20 20 20 TED,n/a.
0a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0aa0: 20 20 20 20 61 6e 64 20 74 68 65 6e 20 72 75 6e and then run
0ab0: 20 74 68 65 20 73 70 65 63 69 66 69 65 64 20 74 the specified t
0ac0: 65 73 74 70 61 74 74 20 77 69 74 68 20 2d 70 72 estpatt with -pr
0ad0: 65 63 6c 65 61 6e 0a 20 20 2d 72 65 72 75 6e 2d eclean. -rerun-
0ae0: 61 6c 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 all
0af0: 20 3a 20 73 65 74 20 61 6c 6c 20 74 65 73 74 73 : set all tests
0b00: 20 74 6f 20 4e 4f 54 5f 53 54 41 52 54 45 44 2c to NOT_STARTED,
0b10: 6e 2f 61 20 61 6e 64 20 72 75 6e 20 77 69 74 68 n/a and run with
0b20: 20 2d 70 72 65 63 6c 65 61 6e 0a 20 20 2d 6c 6f -preclean. -lo
0b30: 63 6b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ck
0b40: 20 20 20 20 20 3a 20 6c 6f 63 6b 20 72 75 6e 20 : lock run
0b50: 73 70 65 63 69 66 69 65 64 20 62 79 20 74 61 72 specified by tar
0b60: 67 65 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a get and runname.
0b70: 20 20 2d 75 6e 6c 6f 63 6b 20 20 20 20 20 20 20 -unlock
0b80: 20 20 20 20 20 20 20 20 20 20 3a 20 75 6e 6c 6f : unlo
0b90: 63 6b 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 ck run specified
0ba0: 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 by target and r
0bb0: 75 6e 6e 61 6d 65 0a 20 20 2d 73 65 74 2d 72 75 unname. -set-ru
0bc0: 6e 2d 73 74 61 74 75 73 20 73 74 61 74 75 73 20 n-status status
0bd0: 20 3a 20 73 65 74 73 20 73 74 61 74 75 73 20 66 : sets status f
0be0: 6f 72 20 72 75 6e 20 74 6f 20 73 74 61 74 75 73 or run to status
0bf0: 2c 20 72 65 71 75 69 72 65 73 20 2d 74 61 72 67 , requires -targ
0c00: 65 74 20 61 6e 64 20 2d 72 75 6e 6e 61 6d 65 0a et and -runname.
0c10: 20 20 2d 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 -get-run-statu
0c20: 73 20 20 20 20 20 20 20 20 20 3a 20 67 65 74 73 s : gets
0c30: 20 73 74 61 74 75 73 20 66 6f 72 20 72 75 6e 20 status for run
0c40: 73 70 65 63 69 66 69 65 64 20 62 79 20 74 61 72 specified by tar
0c50: 67 65 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a get and runname.
0c60: 20 20 2d 72 75 6e 2d 77 61 69 74 20 20 20 20 20 -run-wait
0c70: 20 20 20 20 20 20 20 20 20 20 3a 20 77 61 69 74 : wait
0c80: 20 6f 6e 20 72 75 6e 20 73 70 65 63 69 66 69 65 on run specifie
0c90: 64 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 d by target and
0ca0: 72 75 6e 6e 61 6d 65 0a 20 20 2d 70 72 65 63 6c runname. -precl
0cb0: 65 61 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 ean
0cc0: 20 20 3a 20 72 65 6d 6f 76 65 20 74 68 65 20 65 : remove the e
0cd0: 78 69 73 74 69 6e 67 20 74 65 73 74 20 64 69 72 xisting test dir
0ce0: 65 63 74 6f 72 79 20 62 65 66 6f 72 65 20 72 75 ectory before ru
0cf0: 6e 6e 69 6e 67 20 74 68 65 20 74 65 73 74 0a 20 nning the test.
0d00: 20 2d 63 6c 65 61 6e 2d 63 61 63 68 65 20 20 20 -clean-cache
0d10: 20 20 20 20 20 20 20 20 20 3a 20 72 65 6d 6f 76 : remov
0d20: 65 20 74 68 65 20 63 61 63 68 65 64 20 6d 65 67 e the cached meg
0d30: 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 61 6e 64 atest.config and
0d40: 20 72 75 6e 63 6f 6e 66 69 67 2e 63 6f 6e 66 69 runconfig.confi
0d50: 67 20 66 69 6c 65 73 0a 0a 53 65 6c 65 63 74 6f g files..Selecto
0d60: 72 73 20 28 65 2e 67 2e 20 75 73 65 20 66 6f 72 rs (e.g. use for
0d70: 20 2d 72 75 6e 74 65 73 74 73 2c 20 2d 72 65 6d -runtests, -rem
0d80: 6f 76 65 2d 72 75 6e 73 2c 20 2d 73 65 74 2d 73 ove-runs, -set-s
0d90: 74 61 74 65 2d 73 74 61 74 75 73 2c 20 2d 6c 69 tate-status, -li
0da0: 73 74 2d 72 75 6e 73 20 65 74 63 2e 29 0a 20 20 st-runs etc.).
0db0: 2d 74 61 72 67 65 74 20 6b 65 79 31 2f 6b 65 79 -target key1/key
0dc0: 32 2f 2e 2e 2e 20 20 20 3a 20 72 75 6e 20 66 6f 2/... : run fo
0dd0: 72 20 6b 65 79 31 2c 20 6b 65 79 32 2c 20 65 74 r key1, key2, et
0de0: 63 2e 0a 20 20 2d 72 65 71 74 61 72 67 20 6b 65 c.. -reqtarg ke
0df0: 79 31 2f 6b 65 79 32 2f 2e 2e 2e 20 20 3a 20 72 y1/key2/... : r
0e00: 75 6e 20 66 6f 72 20 6b 65 79 31 2c 20 6b 65 79 un for key1, key
0e10: 32 2c 20 65 74 63 2e 20 62 75 74 20 6b 65 79 31 2, etc. but key1
0e20: 2f 6b 65 79 32 20 6d 75 73 74 20 62 65 20 69 6e /key2 must be in
0e30: 20 72 75 6e 63 6f 6e 66 69 67 0a 20 20 2d 74 65 runconfig. -te
0e40: 73 74 70 61 74 74 20 70 61 74 74 31 2f 70 61 74 stpatt patt1/pat
0e50: 74 32 2c 70 61 74 74 33 2f 2e 2e 2e 20 20 3a 20 t2,patt3/... :
0e60: 25 20 69 73 20 77 69 6c 64 63 61 72 64 0a 20 20 % is wildcard.
0e70: 2d 72 75 6e 6e 61 6d 65 20 20 20 20 20 20 20 20 -runname
0e80: 20 20 20 20 20 20 20 20 3a 20 72 65 71 75 69 72 : requir
0e90: 65 64 2c 20 6e 61 6d 65 20 66 6f 72 20 74 68 69 ed, name for thi
0ea0: 73 20 70 61 72 74 69 63 75 6c 61 72 20 74 65 73 s particular tes
0eb0: 74 20 72 75 6e 0a 20 20 2d 73 74 61 74 65 20 20 t run. -state
0ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ed0: 3a 20 41 70 70 6c 69 65 73 20 74 6f 20 72 75 6e : Applies to run
0ee0: 73 2c 20 74 65 73 74 73 20 6f 72 20 73 74 65 70 s, tests or step
0ef0: 73 20 64 65 70 65 6e 64 69 6e 67 20 6f 6e 20 63 s depending on c
0f00: 6f 6e 74 65 78 74 0a 20 20 2d 73 74 61 74 75 73 ontext. -status
0f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f20: 20 3a 20 41 70 70 6c 69 65 73 20 74 6f 20 72 75 : Applies to ru
0f30: 6e 73 2c 20 74 65 73 74 73 20 6f 72 20 73 74 65 ns, tests or ste
0f40: 70 73 20 64 65 70 65 6e 64 69 6e 67 20 6f 6e 20 ps depending on
0f50: 63 6f 6e 74 65 78 74 0a 0a 54 65 73 74 20 68 65 context..Test he
0f60: 6c 70 65 72 73 20 28 66 6f 72 20 75 73 65 20 69 lpers (for use i
0f70: 6e 73 69 64 65 20 74 65 73 74 73 29 0a 20 20 2d nside tests). -
0f80: 73 74 65 70 20 73 74 65 70 6e 61 6d 65 0a 20 20 step stepname.
0f90: 2d 74 65 73 74 2d 73 74 61 74 75 73 20 20 20 20 -test-status
0fa0: 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 : set th
0fb0: 65 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 e state and stat
0fc0: 75 73 20 6f 66 20 61 20 74 65 73 74 20 28 75 73 us of a test (us
0fd0: 65 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 e :state and :st
0fe0: 61 74 75 73 29 0a 20 20 2d 73 65 74 6c 6f 67 20 atus). -setlog
0ff0: 6c 6f 67 66 6e 61 6d 65 20 20 20 20 20 20 20 20 logfname
1000: 3a 20 73 65 74 20 74 68 65 20 70 61 74 68 2f 66 : set the path/f
1010: 69 6c 65 6e 61 6d 65 20 74 6f 20 74 68 65 20 66 ilename to the f
1020: 69 6e 61 6c 20 6c 6f 67 20 72 65 6c 61 74 69 76 inal log relativ
1030: 65 20 74 6f 20 74 68 65 20 74 65 73 74 0a 20 20 e to the test.
1040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1050: 20 20 20 20 20 20 20 20 20 20 64 69 72 65 63 74 direct
1060: 6f 72 79 2e 20 6d 61 79 20 62 65 20 75 73 65 64 ory. may be used
1070: 20 77 69 74 68 20 2d 74 65 73 74 2d 73 74 61 74 with -test-stat
1080: 75 73 0a 20 20 2d 73 65 74 2d 74 6f 70 6c 6f 67 us. -set-toplog
1090: 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 3a 20 73 logfname : s
10a0: 65 74 20 74 68 65 20 6f 76 65 72 61 6c 6c 20 6c et the overall l
10b0: 6f 67 20 66 6f 72 20 61 20 73 75 69 74 65 20 6f og for a suite o
10c0: 66 20 73 75 62 2d 74 65 73 74 73 0a 20 20 2d 73 f sub-tests. -s
10d0: 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 20 ummarize-items
10e0: 20 20 20 20 20 20 3a 20 66 6f 72 20 61 6e 20 69 : for an i
10f0: 74 65 6d 69 7a 65 64 20 74 65 73 74 20 63 72 65 temized test cre
1100: 61 74 65 20 61 20 73 75 6d 6d 61 72 79 20 68 74 ate a summary ht
1110: 6d 6c 20 0a 20 20 2d 6d 20 63 6f 6d 6d 65 6e 74 ml . -m comment
1120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
1130: 69 6e 73 65 72 74 20 61 20 63 6f 6d 6d 65 6e 74 insert a comment
1140: 20 66 6f 72 20 74 68 69 73 20 74 65 73 74 0a 0a for this test..
1150: 54 65 73 74 20 64 61 74 61 20 63 61 70 74 75 72 Test data captur
1160: 65 0a 20 20 2d 73 65 74 2d 76 61 6c 75 65 73 20 e. -set-values
1170: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 75 70 : up
1180: 64 61 74 65 20 6f 72 20 73 65 74 20 76 61 6c 75 date or set valu
1190: 65 73 20 69 6e 20 74 68 65 20 74 65 73 74 64 61 es in the testda
11a0: 74 61 20 74 61 62 6c 65 0a 20 20 3a 63 61 74 65 ta table. :cate
11b0: 67 6f 72 79 20 20 20 20 20 20 20 20 20 20 20 20 gory
11c0: 20 20 20 3a 20 73 65 74 20 74 68 65 20 63 61 74 : set the cat
11d0: 65 67 6f 72 79 20 66 69 65 6c 64 20 28 6f 70 74 egory field (opt
11e0: 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 72 69 61 62 ional). :variab
11f0: 6c 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 le
1200: 20 3a 20 73 65 74 20 74 68 65 20 76 61 72 69 61 : set the varia
1210: 62 6c 65 20 6e 61 6d 65 20 28 6f 70 74 69 6f 6e ble name (option
1220: 61 6c 29 0a 20 20 3a 76 61 6c 75 65 20 20 20 20 al). :value
1230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
1240: 76 61 6c 75 65 20 6d 65 61 73 75 72 65 64 20 28 value measured (
1250: 72 65 71 75 69 72 65 64 29 0a 20 20 3a 65 78 70 required). :exp
1260: 65 63 74 65 64 20 20 20 20 20 20 20 20 20 20 20 ected
1270: 20 20 20 20 3a 20 76 61 6c 75 65 20 65 78 70 65 : value expe
1280: 63 74 65 64 20 28 72 65 71 75 69 72 65 64 29 0a cted (required).
1290: 20 20 3a 74 6f 6c 20 20 20 20 20 20 20 20 20 20 :tol
12a0: 20 20 20 20 20 20 20 20 20 20 3a 20 7c 76 61 6c : |val
12b0: 75 65 2d 65 78 70 65 63 74 7c 20 3c 3d 20 74 6f ue-expect| <= to
12c0: 6c 20 28 72 65 71 75 69 72 65 64 2c 20 63 61 6e l (required, can
12d0: 20 62 65 20 3c 2c 20 3e 2c 20 3e 3d 2c 20 3c 3d be <, >, >=, <=
12e0: 20 6f 72 20 6e 75 6d 62 65 72 29 0a 20 20 3a 75 or number). :u
12f0: 6e 69 74 73 20 20 20 20 20 20 20 20 20 20 20 20 nits
1300: 20 20 20 20 20 20 3a 20 6e 61 6d 65 20 6f 66 20 : name of
1310: 74 68 65 20 75 6e 69 74 73 20 66 6f 72 20 76 61 the units for va
1320: 6c 75 65 2c 20 65 78 70 65 63 74 65 64 5f 76 61 lue, expected_va
1330: 6c 75 65 20 65 74 63 2e 20 28 6f 70 74 69 6f 6e lue etc. (option
1340: 61 6c 29 0a 20 20 2d 6c 6f 61 64 2d 74 65 73 74 al). -load-test
1350: 2d 64 61 74 61 20 20 20 20 20 20 20 20 20 3a 20 -data :
1360: 72 65 61 64 20 74 65 73 74 20 73 70 65 63 69 66 read test specif
1370: 69 63 20 64 61 74 61 20 66 6f 72 20 73 74 6f 72 ic data for stor
1380: 61 67 65 20 69 6e 20 74 68 65 20 74 65 73 74 5f age in the test_
1390: 64 61 74 61 20 74 61 62 6c 65 0a 20 20 20 20 20 data table.
13a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13b0: 20 20 20 20 20 20 20 66 72 6f 6d 20 73 74 61 6e from stan
13c0: 64 61 72 64 20 69 6e 2e 20 45 61 63 68 20 6c 69 dard in. Each li
13d0: 6e 65 20 69 73 20 63 6f 6d 6d 61 20 64 65 6c 69 ne is comma deli
13e0: 6d 69 74 65 64 20 77 69 74 68 20 66 6f 75 72 0a mited with four.
13f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1400: 20 20 20 20 20 20 20 20 20 20 20 20 66 69 65 6c fiel
1410: 64 73 20 63 61 74 65 67 6f 72 79 2c 76 61 72 69 ds category,vari
1420: 61 62 6c 65 2c 76 61 6c 75 65 2c 63 6f 6d 6d 65 able,value,comme
1430: 6e 74 0a 0a 51 75 65 72 69 65 73 0a 20 20 2d 6c nt..Queries. -l
1440: 69 73 74 2d 72 75 6e 73 20 70 61 74 74 20 20 20 ist-runs patt
1450: 20 20 20 20 20 20 3a 20 6c 69 73 74 20 72 75 6e : list run
1460: 73 20 6d 61 74 63 68 69 6e 67 20 70 61 74 74 65 s matching patte
1470: 72 6e 20 5c 22 70 61 74 74 5c 22 2c 20 25 20 69 rn \"patt\", % i
1480: 73 20 74 68 65 20 77 69 6c 64 63 61 72 64 0a 20 s the wildcard.
1490: 20 2d 73 68 6f 77 2d 6b 65 79 73 20 20 20 20 20 -show-keys
14a0: 20 20 20 20 20 20 20 20 20 3a 20 73 68 6f 77 20 : show
14b0: 74 68 65 20 6b 65 79 73 20 75 73 65 64 20 69 6e the keys used in
14c0: 20 74 68 69 73 20 6d 65 67 61 74 65 73 74 20 73 this megatest s
14d0: 65 74 75 70 0a 20 20 2d 74 65 73 74 2d 66 69 6c etup. -test-fil
14e0: 65 73 20 74 61 72 67 70 61 74 74 20 20 20 20 3a es targpatt :
14f0: 20 67 65 74 20 74 68 65 20 6d 6f 73 74 20 72 65 get the most re
1500: 63 65 6e 74 20 74 65 73 74 20 70 61 74 68 2f 66 cent test path/f
1510: 69 6c 65 20 6d 61 74 63 68 69 6e 67 20 74 61 72 ile matching tar
1520: 67 70 61 74 74 20 65 2e 67 2e 20 25 2f 25 2e 2e gpatt e.g. %/%..
1530: 2e 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 . .
1540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
1550: 65 74 75 72 6e 73 20 6c 69 73 74 20 73 6f 72 74 eturns list sort
1560: 65 64 20 62 79 20 61 67 65 20 61 73 63 65 6e 64 ed by age ascend
1570: 69 6e 67 2c 20 73 65 65 20 65 78 61 6d 70 6c 65 ing, see example
1580: 73 20 62 65 6c 6f 77 0a 20 20 2d 74 65 73 74 2d s below. -test-
1590: 70 61 74 68 73 20 20 20 20 20 20 20 20 20 20 20 paths
15a0: 20 20 3a 20 67 65 74 20 74 68 65 20 74 65 73 74 : get the test
15b0: 20 70 61 74 68 73 20 6d 61 74 63 68 69 6e 67 20 paths matching
15c0: 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c target, runname,
15d0: 20 69 74 65 6d 20 61 6e 64 20 74 65 73 74 0a 20 item and test.
15e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15f0: 20 20 20 20 20 20 20 20 20 20 20 70 61 74 74 65 patte
1600: 72 6e 73 2e 0a 20 20 2d 6c 69 73 74 2d 64 69 73 rns.. -list-dis
1610: 6b 73 20 20 20 20 20 20 20 20 20 20 20 20 20 3a ks :
1620: 20 6c 69 73 74 20 74 68 65 20 64 69 73 6b 73 20 list the disks
1630: 61 76 61 69 6c 61 62 6c 65 20 66 6f 72 20 73 74 available for st
1640: 6f 72 69 6e 67 20 72 75 6e 73 0a 20 20 2d 6c 69 oring runs. -li
1650: 73 74 2d 74 61 72 67 65 74 73 20 20 20 20 20 20 st-targets
1660: 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 65 20 : list the
1670: 74 61 72 67 65 74 73 20 69 6e 20 72 75 6e 63 6f targets in runco
1680: 6e 66 69 67 73 2e 63 6f 6e 66 69 67 0a 20 20 2d nfigs.config. -
1690: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 20 list-db-targets
16a0: 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 : list th
16b0: 65 20 74 61 72 67 65 74 20 63 6f 6d 62 69 6e 61 e target combina
16c0: 74 69 6f 6e 73 20 75 73 65 64 20 69 6e 20 74 68 tions used in th
16d0: 65 20 64 62 0a 20 20 2d 73 68 6f 77 2d 63 6f 6e e db. -show-con
16e0: 66 69 67 20 20 20 20 20 20 20 20 20 20 20 20 3a fig :
16f0: 20 64 75 6d 70 20 74 68 65 20 69 6e 74 65 72 6e dump the intern
1700: 61 6c 20 72 65 70 72 65 73 65 6e 74 61 74 69 6f al representatio
1710: 6e 20 6f 66 20 74 68 65 20 6d 65 67 61 74 65 73 n of the megates
1720: 74 2e 63 6f 6e 66 69 67 20 66 69 6c 65 0a 20 20 t.config file.
1730: 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 20 -show-runconfig
1740: 20 20 20 20 20 20 20 20 3a 20 64 75 6d 70 20 74 : dump t
1750: 68 65 20 69 6e 74 65 72 6e 61 6c 20 72 65 70 72 he internal repr
1760: 65 73 65 6e 74 61 74 69 6f 6e 20 6f 66 20 74 68 esentation of th
1770: 65 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e e runconfigs.con
1780: 66 69 67 20 66 69 6c 65 0a 20 20 2d 64 75 6d 70 fig file. -dump
1790: 6d 6f 64 65 20 4d 4f 44 45 20 20 20 20 20 20 20 mode MODE
17a0: 20 20 20 3a 20 64 75 6d 70 20 69 6e 20 4d 4f 44 : dump in MOD
17b0: 45 20 66 6f 72 6d 61 74 20 69 6e 73 74 65 61 64 E format instead
17c0: 20 6f 66 20 73 65 78 70 72 2c 20 4d 4f 44 45 3d of sexpr, MODE=
17d0: 6a 73 6f 6e 2c 69 6e 69 2c 73 65 78 70 20 65 74 json,ini,sexp et
17e0: 63 2e 0a 20 20 2d 73 68 6f 77 2d 63 6d 64 69 6e c.. -show-cmdin
17f0: 66 6f 20 20 20 20 20 20 20 20 20 20 20 3a 20 64 fo : d
1800: 75 6d 70 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 ump the command
1810: 69 6e 66 6f 20 66 6f 72 20 61 20 74 65 73 74 20 info for a test
1820: 28 72 75 6e 20 69 6e 20 74 65 73 74 20 65 6e 76 (run in test env
1830: 69 72 6f 6e 6d 65 6e 74 29 0a 20 20 2d 73 65 63 ironment). -sec
1840: 74 69 6f 6e 20 73 65 63 74 69 6f 6e 4e 61 6d 65 tion sectionName
1850: 0a 20 20 2d 76 61 72 20 76 61 72 4e 61 6d 65 20 . -var varName
1860: 20 20 20 20 20 20 20 20 20 20 20 3a 20 66 6f 72 : for
1870: 20 63 6f 6e 66 69 67 20 61 6e 64 20 72 75 6e 63 config and runc
1880: 6f 6e 66 69 67 20 6c 6f 6f 6b 75 70 20 76 61 6c onfig lookup val
1890: 75 65 20 66 6f 72 20 73 65 63 74 69 6f 6e 4e 61 ue for sectionNa
18a0: 6d 65 20 76 61 72 4e 61 6d 65 0a 20 20 2d 73 69 me varName. -si
18b0: 6e 63 65 20 4e 20 20 20 20 20 20 20 20 20 20 20 nce N
18c0: 20 20 20 20 20 3a 20 67 65 74 20 6c 69 73 74 20 : get list
18d0: 6f 66 20 72 75 6e 73 20 63 68 61 6e 67 65 64 20 of runs changed
18e0: 73 69 6e 63 65 20 74 69 6d 65 20 4e 20 28 55 6e since time N (Un
18f0: 69 78 20 73 65 63 6f 6e 64 73 29 0a 20 20 2d 66 ix seconds). -f
1900: 69 65 6c 64 73 20 66 69 65 6c 64 73 70 65 63 20 ields fieldspec
1910: 20 20 20 20 20 20 3a 20 66 69 65 6c 64 73 20 74 : fields t
1920: 6f 20 69 6e 63 6c 75 64 65 20 69 6e 20 6a 73 6f o include in jso
1930: 6e 20 64 75 6d 70 3b 20 72 75 6e 73 3a 69 64 2c n dump; runs:id,
1940: 72 75 6e 61 6d 65 2b 74 65 73 74 73 3a 74 65 73 runame+tests:tes
1950: 74 6e 61 6d 65 2b 73 74 65 70 73 0a 20 20 2d 73 tname+steps. -s
1960: 6f 72 74 20 66 69 65 6c 64 6e 61 6d 65 20 20 20 ort fieldname
1970: 20 20 20 20 20 20 3a 20 69 6e 20 2d 6c 69 73 74 : in -list
1980: 2d 72 75 6e 73 20 73 6f 72 74 20 74 65 73 74 73 -runs sort tests
1990: 20 62 79 20 74 68 69 73 20 66 69 65 6c 64 0a 0a by this field..
19a0: 4d 69 73 63 20 0a 20 20 2d 73 74 61 72 74 2d 64 Misc . -start-d
19b0: 69 72 20 70 61 74 68 20 20 20 20 20 20 20 20 20 ir path
19c0: 3a 20 73 77 69 74 63 68 20 74 6f 20 74 68 69 73 : switch to this
19d0: 20 64 69 72 65 63 74 6f 72 79 20 62 65 66 6f 72 directory befor
19e0: 65 20 72 75 6e 6e 69 6e 67 20 6d 65 67 61 74 65 e running megate
19f0: 73 74 0a 20 20 2d 72 65 62 75 69 6c 64 2d 64 62 st. -rebuild-db
1a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 62 : b
1a10: 72 69 6e 67 20 74 68 65 20 64 61 74 61 62 61 73 ring the databas
1a20: 65 20 73 63 68 65 6d 61 20 75 70 20 74 6f 20 64 e schema up to d
1a30: 61 74 65 0a 20 20 2d 63 6c 65 61 6e 75 70 2d 64 ate. -cleanup-d
1a40: 62 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 b :
1a50: 72 65 6d 6f 76 65 20 61 6e 79 20 6f 72 70 68 61 remove any orpha
1a60: 6e 20 72 65 63 6f 72 64 73 2c 20 76 61 63 75 75 n records, vacuu
1a70: 6d 20 74 68 65 20 64 62 0a 20 20 2d 69 6d 70 6f m the db. -impo
1a80: 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 20 20 rt-megatest.db
1a90: 20 20 20 3a 20 6d 69 67 72 61 74 65 20 61 20 64 : migrate a d
1aa0: 61 74 61 62 61 73 65 20 66 72 6f 6d 20 76 31 2e atabase from v1.
1ab0: 35 35 20 73 65 72 69 65 73 20 74 6f 20 76 31 2e 55 series to v1.
1ac0: 36 30 20 73 65 72 69 65 73 0a 20 20 2d 73 79 6e 60 series. -syn
1ad0: 63 2d 74 6f 2d 6d 65 67 61 74 65 73 74 2e 64 62 c-to-megatest.db
1ae0: 20 20 20 20 3a 20 6d 69 67 72 61 74 65 20 64 61 : migrate da
1af0: 74 61 20 62 61 63 6b 20 74 6f 20 6d 65 67 61 74 ta back to megat
1b00: 65 73 74 2e 64 62 0a 20 20 2d 75 73 65 2d 64 62 est.db. -use-db
1b10: 2d 63 61 63 68 65 20 20 20 20 20 20 20 20 20 20 -cache
1b20: 20 3a 20 75 73 65 20 63 61 63 68 65 64 20 61 63 : use cached ac
1b30: 63 65 73 73 20 74 6f 20 64 62 20 74 6f 20 72 65 cess to db to re
1b40: 64 75 63 65 20 6c 6f 61 64 0a 20 20 2d 75 70 64 duce load. -upd
1b50: 61 74 65 2d 6d 65 74 61 20 20 20 20 20 20 20 20 ate-meta
1b60: 20 20 20 20 3a 20 75 70 64 61 74 65 20 74 68 65 : update the
1b70: 20 74 65 73 74 73 20 6d 65 74 61 64 61 74 61 20 tests metadata
1b80: 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 0a 20 20 for all tests.
1b90: 2d 73 65 74 76 61 72 73 20 56 41 52 31 3d 76 61 -setvars VAR1=va
1ba0: 6c 31 2c 56 41 52 32 3d 76 61 6c 32 20 3a 20 41 l1,VAR2=val2 : A
1bb0: 64 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 dd environment v
1bc0: 61 72 69 61 62 6c 65 73 20 74 6f 20 61 20 72 75 ariables to a ru
1bd0: 6e 20 4e 42 2f 2f 20 74 68 65 73 65 20 61 72 65 n NB// these are
1be0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c00: 20 20 6f 76 65 72 77 72 69 74 74 65 6e 20 62 79 overwritten by
1c10: 20 76 61 6c 75 65 73 20 73 65 74 20 69 6e 20 63 values set in c
1c20: 6f 6e 66 69 67 20 66 69 6c 65 73 2e 0a 20 20 2d onfig files.. -
1c30: 73 65 72 76 65 72 20 2d 7c 68 6f 73 74 6e 61 6d server -|hostnam
1c40: 65 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 74 e : start t
1c50: 68 65 20 73 65 72 76 65 72 20 28 72 65 64 75 63 he server (reduc
1c60: 65 73 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 6f 6e es contention on
1c70: 20 6d 65 67 61 74 65 73 74 2e 64 62 29 2c 20 75 megatest.db), u
1c80: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
1c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d -
1ca0: 20 74 6f 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c to automaticall
1cb0: 79 20 66 69 67 75 72 65 20 6f 75 74 20 68 6f 73 y figure out hos
1cc0: 74 6e 61 6d 65 0a 20 20 2d 74 72 61 6e 73 70 6f tname. -transpo
1cd0: 72 74 20 68 74 74 70 7c 72 70 63 20 20 20 20 20 rt http|rpc
1ce0: 3a 20 75 73 65 20 68 74 74 70 20 6f 72 20 72 70 : use http or rp
1cf0: 63 20 66 6f 72 20 74 72 61 6e 73 70 6f 72 74 20 c for transport
1d00: 28 64 65 66 61 75 6c 74 20 69 73 20 68 74 74 70 (default is http
1d10: 29 20 0a 20 20 2d 64 61 65 6d 6f 6e 69 7a 65 20 ) . -daemonize
1d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 66 : f
1d30: 6f 72 6b 20 69 6e 74 6f 20 62 61 63 6b 67 72 6f ork into backgro
1d40: 75 6e 64 20 61 6e 64 20 64 69 73 63 6f 6e 6e 65 und and disconne
1d50: 63 74 20 66 72 6f 6d 20 73 74 64 69 6e 2f 6f 75 ct from stdin/ou
1d60: 74 0a 20 20 2d 6c 6f 67 20 6c 6f 67 66 69 6c 65 t. -log logfile
1d70: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 : se
1d80: 6e 64 20 73 74 64 6f 75 74 20 61 6e 64 20 73 74 nd stdout and st
1d90: 64 65 72 72 20 74 6f 20 6c 6f 67 66 69 6c 65 0a derr to logfile.
1da0: 20 20 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 20 -list-servers
1db0: 20 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 : list
1dc0: 20 74 68 65 20 73 65 72 76 65 72 73 20 0a 20 20 the servers .
1dd0: 2d 73 74 6f 70 2d 73 65 72 76 65 72 20 69 64 20 -stop-server id
1de0: 20 20 20 20 20 20 20 20 3a 20 73 74 6f 70 20 73 : stop s
1df0: 65 72 76 65 72 20 73 70 65 63 69 66 69 65 64 20 erver specified
1e00: 62 79 20 69 64 20 28 73 65 65 20 6f 75 74 70 75 by id (see outpu
1e10: 74 20 6f 66 20 2d 6c 69 73 74 2d 73 65 72 76 65 t of -list-serve
1e20: 72 73 29 2c 20 75 73 65 0a 20 20 20 20 20 20 20 rs), use.
1e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e40: 20 20 20 20 20 30 20 74 6f 20 6b 69 6c 6c 20 61 0 to kill a
1e50: 6c 6c 0a 20 20 2d 72 65 70 6c 20 20 20 20 20 20 ll. -repl
1e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 : s
1e70: 74 61 72 74 20 61 20 72 65 70 6c 20 28 75 73 65 tart a repl (use
1e80: 66 75 6c 20 66 6f 72 20 65 78 74 65 6e 64 69 6e ful for extendin
1e90: 67 20 6d 65 67 61 74 65 73 74 29 0a 20 20 2d 6c g megatest). -l
1ea0: 6f 61 64 20 66 69 6c 65 2e 73 63 6d 20 20 20 20 oad file.scm
1eb0: 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 61 6e 64 : load and
1ec0: 20 72 75 6e 20 66 69 6c 65 2e 73 63 6d 0a 20 20 run file.scm.
1ed0: 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 -mark-incomplete
1ee0: 73 20 20 20 20 20 20 20 3a 20 66 69 6e 64 20 61 s : find a
1ef0: 6e 64 20 6d 61 72 6b 20 69 6e 63 6f 6d 70 6c 65 nd mark incomple
1f00: 74 65 20 74 65 73 74 73 0a 20 20 2d 70 69 6e 67 te tests. -ping
1f10: 20 72 75 6e 2d 69 64 7c 68 6f 73 74 3a 70 6f 72 run-id|host:por
1f20: 74 20 20 3a 20 70 69 6e 67 20 73 65 72 76 65 72 t : ping server
1f30: 2c 20 65 78 69 74 20 77 69 74 68 20 30 20 69 66 , exit with 0 if
1f40: 20 66 6f 75 6e 64 0a 20 20 2d 64 65 62 75 67 20 found. -debug
1f50: 4e 7c 4e 2c 4d 2c 4f 2e 2e 2e 20 20 20 20 20 20 N|N,M,O...
1f60: 20 3a 20 65 6e 61 62 6c 65 20 64 65 62 75 67 20 : enable debug
1f70: 30 2d 4e 20 6f 72 20 4e 20 61 6e 64 20 4d 20 61 0-N or N and M a
1f80: 6e 64 20 4f 20 2e 2e 2e 0a 0a 55 74 69 6c 69 74 nd O .....Utilit
1f90: 69 65 73 0a 20 20 2d 65 6e 76 32 66 69 6c 65 20 ies. -env2file
1fa0: 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 3a 20 fname :
1fb0: 77 72 69 74 65 20 74 68 65 20 65 6e 76 69 72 6f write the enviro
1fc0: 6e 6d 65 6e 74 20 74 6f 20 66 6e 61 6d 65 2e 63 nment to fname.c
1fd0: 73 68 20 61 6e 64 20 66 6e 61 6d 65 2e 73 68 0a sh and fname.sh.
1fe0: 20 20 2d 65 6e 76 63 61 70 20 66 6e 61 6d 65 3d -envcap fname=
1ff0: 63 6f 6e 74 65 78 74 20 20 20 3a 20 73 61 76 65 context : save
2000: 20 63 75 72 72 65 6e 74 20 76 61 72 69 61 62 6c current variabl
2010: 65 73 20 6c 61 62 65 6c 65 64 20 61 73 20 63 6f es labeled as co
2020: 6e 74 65 78 74 20 69 6e 20 66 69 6c 65 20 66 6e ntext in file fn
2030: 61 6d 65 0a 20 20 2d 72 65 66 64 62 32 64 61 74 ame. -refdb2dat
2040: 20 72 65 66 64 62 20 20 20 20 20 20 20 20 3a 20 refdb :
2050: 63 6f 6e 76 65 72 74 20 72 65 66 64 62 20 74 6f convert refdb to
2060: 20 73 65 78 70 20 6f 72 20 74 6f 20 66 6f 72 6d sexp or to form
2070: 61 74 20 73 70 65 63 69 66 69 65 64 20 62 79 20 at specified by
2080: 2d 64 75 6d 70 6d 6f 64 65 0a 20 20 20 20 20 20 -dumpmode.
2090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20a0: 20 20 20 20 20 20 66 6f 72 6d 61 74 73 3a 20 70 formats: p
20b0: 65 72 6c 2c 20 72 75 62 79 2c 20 73 71 6c 69 74 erl, ruby, sqlit
20c0: 65 33 2c 20 63 73 76 20 28 66 6f 72 20 63 73 76 e3, csv (for csv
20d0: 20 74 68 65 20 2d 6f 20 70 61 72 61 6d 0a 20 20 the -o param.
20e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20f0: 20 20 20 20 20 20 20 20 20 20 77 69 6c 6c 20 73 will s
2100: 75 62 73 74 69 74 75 74 65 20 25 73 20 66 6f 72 ubstitute %s for
2110: 20 74 68 65 20 73 68 65 65 74 20 6e 61 6d 65 20 the sheet name
2120: 69 6e 20 67 65 6e 65 72 61 74 69 6e 67 20 0a 20 in generating .
2130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2140: 20 20 20 20 20 20 20 20 20 20 20 6d 75 6c 74 69 multi
2150: 70 6c 65 20 73 68 65 65 74 73 29 0a 20 20 2d 6f ple sheets). -o
2160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2170: 20 20 20 20 20 20 3a 20 6f 75 74 70 75 74 20 66 : output f
2180: 69 6c 65 20 66 6f 72 20 72 65 66 64 62 32 64 61 ile for refdb2da
2190: 74 20 28 64 65 66 61 75 6c 74 73 20 74 6f 20 73 t (defaults to s
21a0: 74 64 6f 75 74 29 0a 20 20 2d 61 72 63 68 69 76 tdout). -archiv
21b0: 65 20 63 6d 64 20 20 20 20 20 20 20 20 20 20 20 e cmd
21c0: 20 3a 20 61 72 63 68 69 76 65 20 72 75 6e 73 20 : archive runs
21d0: 73 70 65 63 69 66 69 65 64 20 62 79 20 73 65 6c specified by sel
21e0: 65 63 74 6f 72 73 20 74 6f 20 6f 6e 65 20 6f 66 ectors to one of
21f0: 20 64 69 73 6b 73 20 73 70 65 63 69 66 69 65 64 disks specified
2200: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2210: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 6e 20 in
2220: 74 68 65 20 5b 61 72 63 68 69 76 65 2d 64 69 73 the [archive-dis
2230: 6b 73 5d 20 73 65 63 74 69 6f 6e 2e 0a 20 20 20 ks] section..
2240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2250: 20 20 20 20 20 20 20 20 20 63 6d 64 3a 20 6b 65 cmd: ke
2260: 65 70 2d 68 74 6d 6c 2c 20 72 65 73 74 6f 72 65 ep-html, restore
2270: 2c 20 73 61 76 65 2c 20 73 61 76 65 2d 72 65 6d , save, save-rem
2280: 6f 76 65 0a 20 20 2d 67 65 6e 65 72 61 74 65 2d ove. -generate-
2290: 68 74 6d 6c 20 20 20 20 20 20 20 20 20 20 3a 20 html :
22a0: 63 72 65 61 74 65 20 61 20 73 69 6d 70 6c 65 20 create a simple
22b0: 68 74 6d 6c 20 74 72 65 65 20 66 6f 72 20 62 72 html tree for br
22c0: 6f 77 73 69 6e 67 20 79 6f 75 72 20 72 75 6e 73 owsing your runs
22d0: 0a 0a 53 70 72 65 61 64 73 68 65 65 74 20 67 65 ..Spreadsheet ge
22e0: 6e 65 72 61 74 69 6f 6e 0a 20 20 2d 65 78 74 72 neration. -extr
22f0: 61 63 74 2d 6f 64 73 20 66 6e 61 6d 65 2e 6f 64 act-ods fname.od
2300: 73 20 20 3a 20 65 78 74 72 61 63 74 20 61 6e 20 s : extract an
2310: 6f 70 65 6e 20 64 6f 63 75 6d 65 6e 74 20 73 70 open document sp
2320: 72 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 74 readsheet from t
2330: 68 65 20 64 61 74 61 62 61 73 65 0a 20 20 2d 70 he database. -p
2340: 61 74 68 6d 6f 64 20 70 61 74 68 20 20 20 20 20 athmod path
2350: 20 20 20 20 20 20 3a 20 69 6e 73 65 72 74 20 70 : insert p
2360: 61 74 68 2c 20 69 2e 65 2e 20 70 61 74 68 2f 72 ath, i.e. path/r
2370: 75 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c uname/itempath/l
2380: 6f 67 66 69 6c 65 2e 68 74 6d 6c 0a 20 20 20 20 ogfile.html.
2390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23a0: 20 20 20 20 20 20 20 20 77 69 6c 6c 20 63 6c 65 will cle
23b0: 61 72 20 74 68 65 20 66 69 65 6c 64 20 69 66 20 ar the field if
23c0: 6e 6f 20 72 75 6e 64 69 72 2f 74 65 73 74 6e 61 no rundir/testna
23d0: 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 me/itempath/logf
23e0: 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ile.
23f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2400: 69 66 20 69 74 20 63 6f 6e 74 61 69 6e 73 20 66 if it contains f
2410: 6f 72 77 61 72 64 20 73 6c 61 73 68 65 73 20 74 orward slashes t
2420: 68 65 20 70 61 74 68 20 77 69 6c 6c 20 62 65 20 he path will be
2430: 63 6f 6e 76 65 72 74 65 64 0a 20 20 20 20 20 20 converted.
2440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2450: 20 20 20 20 20 20 74 6f 20 77 69 6e 64 6f 77 73 to windows
2460: 20 73 74 79 6c 65 0a 47 65 74 74 69 6e 67 20 73 style.Getting s
2470: 74 61 72 74 65 64 0a 20 20 2d 63 72 65 61 74 65 tarted. -create
2480: 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 20 20 -megatest-area
2490: 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 61 20 : create a
24a0: 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 skeleton megates
24b0: 74 20 61 72 65 61 2e 20 59 6f 75 20 77 69 6c 6c t area. You will
24c0: 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 be prompted for
24d0: 20 70 61 74 68 73 0a 20 20 2d 63 72 65 61 74 65 paths. -create
24e0: 2d 74 65 73 74 20 74 65 73 74 6e 61 6d 65 20 20 -test testname
24f0: 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 61 20 : create a
2500: 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 skeleton megates
2510: 74 20 74 65 73 74 2e 20 59 6f 75 20 77 69 6c 6c t test. You will
2520: 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 be prompted for
2530: 20 69 6e 66 6f 0a 0a 45 78 61 6d 70 6c 65 73 0a info..Examples.
2540: 0a 23 20 47 65 74 20 74 65 73 74 20 70 61 74 68 .# Get test path
2550: 2c 20 75 73 65 20 27 2e 27 20 74 6f 20 67 65 74 , use '.' to get
2560: 20 61 20 73 69 6e 67 6c 65 20 70 61 74 68 20 6f a single path o
2570: 72 20 61 20 73 70 65 63 69 66 69 63 20 70 61 74 r a specific pat
2580: 68 2f 66 69 6c 65 20 70 61 74 74 65 72 6e 0a 6d h/file pattern.m
2590: 65 67 61 74 65 73 74 20 2d 74 65 73 74 2d 66 69 egatest -test-fi
25a0: 6c 65 73 20 27 6c 6f 67 73 2f 2a 2e 6c 6f 67 27 les 'logs/*.log'
25b0: 20 2d 74 61 72 67 65 74 20 75 62 75 6e 74 75 2f -target ubuntu/
25c0: 6e 25 2f 6e 6f 25 20 2d 72 75 6e 6e 61 6d 65 20 n%/no% -runname
25d0: 77 34 39 25 20 2d 74 65 73 74 70 61 74 74 20 74 w49% -testpatt t
25e0: 65 73 74 5f 6d 74 25 0a 0a 43 61 6c 6c 65 64 20 est_mt%..Called
25f0: 61 73 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 as " (string-int
2600: 65 72 73 70 65 72 73 65 20 28 61 72 67 76 29 20 ersperse (argv)
2610: 22 20 22 29 20 22 0a 56 65 72 73 69 6f 6e 20 22 " ") ".Version "
2620: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f megatest-versio
2630: 6e 20 22 2c 20 62 75 69 6c 74 20 66 72 6f 6d 20 n ", built from
2640: 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 " megatest-fossi
2650: 6c 2d 68 61 73 68 20 29 29 0a 0a 3b 3b 20 20 2d l-hash ))..;; -
2660: 67 75 69 20 20 20 20 20 20 20 20 20 20 20 20 20 gui
2670: 20 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 61 : start a
2680: 20 67 75 69 20 69 6e 74 65 72 66 61 63 65 0a 3b gui interface.;
2690: 3b 20 20 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 ; -config fname
26a0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 6f 76 65 : ove
26b0: 72 72 69 64 65 20 74 68 65 20 72 75 6e 63 6f 6e rride the runcon
26c0: 66 69 67 20 66 69 6c 65 20 77 69 74 68 20 66 6e fig file with fn
26d0: 61 6d 65 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 20 ame..;; process
26e0: 61 72 67 73 0a 28 64 65 66 69 6e 65 20 72 65 6d args.(define rem
26f0: 61 72 67 73 20 28 61 72 67 73 3a 67 65 74 2d 61 args (args:get-a
2700: 72 67 73 20 0a 09 09 20 28 61 72 67 76 29 0a 09 rgs ... (argv)..
2710: 09 20 28 6c 69 73 74 20 20 22 2d 72 75 6e 74 65 . (list "-runte
2720: 73 74 73 22 20 20 3b 3b 20 72 75 6e 20 61 20 73 sts" ;; run a s
2730: 70 65 63 69 66 69 63 20 74 65 73 74 0a 09 09 09 pecific test....
2740: 22 2d 63 6f 6e 66 69 67 22 20 20 20 20 3b 3b 20 "-config" ;;
2750: 6f 76 65 72 72 69 64 65 20 74 68 65 20 63 6f 6e override the con
2760: 66 69 67 20 66 69 6c 65 20 6e 61 6d 65 0a 09 09 fig file name...
2770: 09 22 2d 65 78 65 63 75 74 65 22 20 20 20 3b 3b ."-execute" ;;
2780: 20 72 75 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 run the command
2790: 20 65 6e 63 6f 64 65 64 20 69 6e 20 74 68 65 20 encoded in the
27a0: 62 61 73 65 36 34 20 70 61 72 61 6d 65 74 65 72 base64 parameter
27b0: 0a 09 09 09 22 2d 73 74 65 70 22 0a 09 09 09 22 ...."-step"...."
27c0: 2d 74 61 72 67 65 74 22 0a 09 09 09 22 2d 72 65 -target"...."-re
27d0: 71 74 61 72 67 22 0a 09 09 09 22 3a 72 75 6e 6e qtarg"....":runn
27e0: 61 6d 65 22 0a 09 09 09 22 2d 72 75 6e 6e 61 6d ame"...."-runnam
27f0: 65 22 0a 09 09 09 22 3a 73 74 61 74 65 22 20 20 e"....":state"
2800: 0a 09 09 09 22 2d 73 74 61 74 65 22 0a 09 09 09 ...."-state"....
2810: 22 3a 73 74 61 74 75 73 22 0a 09 09 09 22 2d 73 ":status"...."-s
2820: 74 61 74 75 73 22 0a 09 09 09 22 2d 6c 69 73 74 tatus"...."-list
2830: 2d 72 75 6e 73 22 0a 09 09 09 22 2d 74 65 73 74 -runs"...."-test
2840: 70 61 74 74 22 20 0a 09 09 09 22 2d 69 74 65 6d patt" ...."-item
2850: 70 61 74 74 22 0a 09 09 09 22 2d 73 65 74 6c 6f patt"...."-setlo
2860: 67 22 0a 09 09 09 22 2d 73 65 74 2d 74 6f 70 6c g"...."-set-topl
2870: 6f 67 22 0a 09 09 09 22 2d 72 75 6e 73 74 65 70 og"...."-runstep
2880: 22 0a 09 09 09 22 2d 6c 6f 67 70 72 6f 22 0a 09 "...."-logpro"..
2890: 09 09 22 2d 6d 22 0a 09 09 09 22 2d 72 65 72 75 .."-m"...."-reru
28a0: 6e 22 0a 09 09 09 22 2d 64 61 79 73 22 0a 09 09 n"...."-days"...
28b0: 09 22 2d 72 65 6e 61 6d 65 2d 72 75 6e 22 0a 09 ."-rename-run"..
28c0: 09 09 22 2d 74 6f 22 0a 09 09 09 3b 3b 20 76 61 .."-to"....;; va
28d0: 6c 75 65 73 20 61 6e 64 20 6d 65 73 73 61 67 65 lues and message
28e0: 73 0a 09 09 09 22 3a 63 61 74 65 67 6f 72 79 22 s....":category"
28f0: 0a 09 09 09 22 3a 76 61 72 69 61 62 6c 65 22 0a ....":variable".
2900: 09 09 09 22 3a 76 61 6c 75 65 22 0a 09 09 09 22 ...":value"...."
2910: 3a 65 78 70 65 63 74 65 64 22 0a 09 09 09 22 3a :expected"....":
2920: 74 6f 6c 22 0a 09 09 09 22 3a 75 6e 69 74 73 22 tol"....":units"
2930: 0a 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 09 22 ....;; misc...."
2940: 2d 73 74 61 72 74 2d 64 69 72 22 0a 09 09 09 22 -start-dir"...."
2950: 2d 73 65 72 76 65 72 22 0a 09 09 09 22 2d 73 74 -server"...."-st
2960: 6f 70 2d 73 65 72 76 65 72 22 0a 09 09 09 22 2d op-server"...."-
2970: 74 72 61 6e 73 70 6f 72 74 22 0a 09 09 09 22 2d transport"...."-
2980: 6b 69 6c 6c 2d 73 65 72 76 65 72 22 0a 09 09 09 kill-server"....
2990: 22 2d 70 6f 72 74 22 0a 09 09 09 22 2d 65 78 74 "-port"...."-ext
29a0: 72 61 63 74 2d 6f 64 73 22 0a 09 09 09 22 2d 70 ract-ods"...."-p
29b0: 61 74 68 6d 6f 64 22 0a 09 09 09 22 2d 65 6e 76 athmod"...."-env
29c0: 32 66 69 6c 65 22 0a 09 09 09 22 2d 65 6e 76 63 2file"...."-envc
29d0: 61 70 22 0a 09 09 09 22 2d 65 6e 76 64 65 6c 74 ap"...."-envdelt
29e0: 61 22 0a 09 09 09 22 2d 73 65 74 76 61 72 73 22 a"...."-setvars"
29f0: 0a 09 09 09 22 2d 73 65 74 2d 73 74 61 74 65 2d ...."-set-state-
2a00: 73 74 61 74 75 73 22 0a 09 09 09 22 2d 73 65 74 status"...."-set
2a10: 2d 72 75 6e 2d 73 74 61 74 75 73 22 0a 09 09 09 -run-status"....
2a20: 22 2d 64 65 62 75 67 22 20 3b 3b 20 66 6f 72 20 "-debug" ;; for
2a30: 2a 76 65 72 62 6f 73 69 74 79 2a 20 3e 20 32 0a *verbosity* > 2.
2a40: 09 09 09 22 2d 63 72 65 61 74 65 2d 74 65 73 74 ..."-create-test
2a50: 22 0a 09 09 09 22 2d 6f 76 65 72 72 69 64 65 2d "...."-override-
2a60: 74 69 6d 65 6f 75 74 22 0a 09 09 09 22 2d 74 65 timeout"...."-te
2a70: 73 74 2d 66 69 6c 65 73 22 20 20 3b 3b 20 2d 74 st-files" ;; -t
2a80: 65 73 74 2d 70 61 74 68 73 20 69 73 20 66 6f 72 est-paths is for
2a90: 20 6c 69 73 74 69 6e 67 20 61 6c 6c 0a 09 09 09 listing all....
2aa0: 22 2d 6c 6f 61 64 22 20 20 20 20 20 20 20 20 3b "-load" ;
2ab0: 3b 20 6c 6f 61 64 20 61 6e 64 20 65 78 65 63 74 ; load and exect
2ac0: 75 74 65 20 61 20 73 63 68 65 6d 65 20 66 69 6c ute a scheme fil
2ad0: 65 0a 09 09 09 22 2d 73 65 63 74 69 6f 6e 22 0a e...."-section".
2ae0: 09 09 09 22 2d 76 61 72 22 0a 09 09 09 22 2d 64 ..."-var"...."-d
2af0: 75 6d 70 6d 6f 64 65 22 0a 09 09 09 22 2d 72 75 umpmode"...."-ru
2b00: 6e 2d 69 64 22 0a 09 09 09 22 2d 70 69 6e 67 22 n-id"...."-ping"
2b10: 0a 09 09 09 22 2d 72 65 66 64 62 32 64 61 74 22 ...."-refdb2dat"
2b20: 0a 09 09 09 22 2d 6f 22 0a 09 09 09 22 2d 6c 6f ...."-o"...."-lo
2b30: 67 22 0a 09 09 09 22 2d 61 72 63 68 69 76 65 22 g"...."-archive"
2b40: 0a 09 09 09 22 2d 73 69 6e 63 65 22 0a 09 09 09 ...."-since"....
2b50: 22 2d 66 69 65 6c 64 73 22 0a 09 09 09 22 2d 72 "-fields"...."-r
2b60: 65 63 6f 76 65 72 2d 74 65 73 74 22 20 3b 3b 20 ecover-test" ;;
2b70: 72 75 6e 2d 69 64 2c 74 65 73 74 2d 69 64 20 2d run-id,test-id -
2b80: 20 75 73 65 64 20 69 6e 74 65 72 6e 61 6c 6c 79 used internally
2b90: 20 74 6f 20 72 65 63 6f 76 65 72 20 61 20 74 65 to recover a te
2ba0: 73 74 20 73 74 75 63 6b 20 69 6e 20 52 55 4e 4e st stuck in RUNN
2bb0: 49 4e 47 20 73 74 61 74 65 0a 09 09 09 22 2d 73 ING state...."-s
2bc0: 6f 72 74 22 0a 09 09 09 22 2d 74 61 72 67 65 74 ort"...."-target
2bd0: 2d 64 62 22 0a 09 09 09 22 2d 73 6f 75 72 63 65 -db"...."-source
2be0: 2d 64 62 22 0a 09 09 09 29 0a 20 09 09 20 28 6c -db"....). .. (l
2bf0: 69 73 74 20 20 22 2d 68 22 20 22 2d 68 65 6c 70 ist "-h" "-help
2c00: 22 20 22 2d 2d 68 65 6c 70 22 0a 09 09 09 22 2d " "--help"...."-
2c10: 6d 61 6e 75 61 6c 22 0a 09 09 09 22 2d 76 65 72 manual"...."-ver
2c20: 73 69 6f 6e 22 0a 09 09 20 20 20 20 20 20 20 20 sion"...
2c30: 22 2d 66 6f 72 63 65 22 0a 09 09 20 20 20 20 20 "-force"...
2c40: 20 20 20 22 2d 78 74 65 72 6d 22 0a 09 09 20 20 "-xterm"...
2c50: 20 20 20 20 20 20 22 2d 73 68 6f 77 6b 65 79 73 "-showkeys
2c60: 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d 73 68 "... "-sh
2c70: 6f 77 2d 6b 65 79 73 22 0a 09 09 20 20 20 20 20 ow-keys"...
2c80: 20 20 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 "-test-status
2c90: 22 0a 09 09 09 22 2d 73 65 74 2d 76 61 6c 75 65 "...."-set-value
2ca0: 73 22 0a 09 09 09 22 2d 6c 6f 61 64 2d 74 65 73 s"...."-load-tes
2cb0: 74 2d 64 61 74 61 22 0a 09 09 09 22 2d 73 75 6d t-data"...."-sum
2cc0: 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 0a 09 09 marize-items"...
2cd0: 20 20 20 20 20 20 20 20 22 2d 67 75 69 22 0a 09 "-gui"..
2ce0: 09 09 22 2d 64 61 65 6d 6f 6e 69 7a 65 22 0a 09 .."-daemonize"..
2cf0: 09 09 22 2d 70 72 65 63 6c 65 61 6e 22 0a 09 09 .."-preclean"...
2d00: 09 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 22 0a ."-rerun-clean".
2d10: 09 09 09 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 0a ..."-rerun-all".
2d20: 09 09 09 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 ..."-clean-cache
2d30: 22 0a 09 09 09 22 2d 63 61 63 68 65 2d 64 62 22 "...."-cache-db"
2d40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2d50: 20 20 20 20 20 20 20 20 20 22 2d 75 73 65 2d 64 "-use-d
2d60: 62 2d 63 61 63 68 65 22 0a 09 09 09 3b 3b 20 6d b-cache"....;; m
2d70: 69 73 63 0a 09 09 09 22 2d 72 65 70 6c 22 0a 09 isc...."-repl"..
2d80: 09 09 22 2d 6c 6f 63 6b 22 0a 09 09 09 22 2d 75 .."-lock"...."-u
2d90: 6e 6c 6f 63 6b 22 0a 09 09 09 22 2d 6c 69 73 74 nlock"...."-list
2da0: 2d 73 65 72 76 65 72 73 22 0a 20 20 20 20 20 20 -servers".
2db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2dc0: 20 20 22 2d 72 75 6e 2d 77 61 69 74 22 20 20 20 "-run-wait"
2dd0: 20 20 20 3b 3b 20 77 61 69 74 20 6f 6e 20 61 20 ;; wait on a
2de0: 72 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 run to complete
2df0: 28 69 2e 65 2e 20 6e 6f 20 52 55 4e 4e 49 4e 47 (i.e. no RUNNING
2e00: 29 0a 09 09 09 22 2d 6c 6f 63 61 6c 22 20 20 20 )...."-local"
2e10: 20 20 20 20 20 20 3b 3b 20 72 75 6e 20 73 6f 6d ;; run som
2e20: 65 20 63 6f 6d 6d 61 6e 64 73 20 75 73 69 6e 67 e commands using
2e30: 20 6c 6f 63 61 6c 20 64 62 20 61 63 63 65 73 73 local db access
2e40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2e50: 20 20 20 20 20 20 20 20 20 22 2d 67 65 6e 65 72 "-gener
2e60: 61 74 65 2d 68 74 6d 6c 22 0a 0a 09 09 09 3b 3b ate-html".....;;
2e70: 20 6d 69 73 63 20 71 75 65 72 69 65 73 0a 09 09 misc queries...
2e80: 09 22 2d 6c 69 73 74 2d 64 69 73 6b 73 22 0a 09 ."-list-disks"..
2e90: 09 09 22 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 .."-list-targets
2ea0: 22 0a 09 09 09 22 2d 6c 69 73 74 2d 64 62 2d 74 "...."-list-db-t
2eb0: 61 72 67 65 74 73 22 0a 09 09 09 22 2d 73 68 6f argets"...."-sho
2ec0: 77 2d 72 75 6e 63 6f 6e 66 69 67 22 0a 09 09 09 w-runconfig"....
2ed0: 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 22 0a 09 "-show-config"..
2ee0: 09 09 22 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 6f .."-show-cmdinfo
2ef0: 22 0a 09 09 09 22 2d 67 65 74 2d 72 75 6e 2d 73 "...."-get-run-s
2f00: 74 61 74 75 73 22 0a 0a 09 09 09 3b 3b 20 71 75 tatus".....;; qu
2f10: 65 72 69 65 73 0a 09 09 09 22 2d 74 65 73 74 2d eries...."-test-
2f20: 70 61 74 68 73 22 20 3b 3b 20 67 65 74 20 70 61 paths" ;; get pa
2f30: 74 68 28 73 29 20 74 6f 20 61 20 74 65 73 74 2c th(s) to a test,
2f40: 20 6f 72 64 65 72 65 64 20 62 79 20 79 6f 75 6e ordered by youn
2f50: 67 65 73 74 20 66 69 72 73 74 0a 0a 09 09 09 22 gest first....."
2f60: 2d 72 75 6e 61 6c 6c 22 20 20 20 20 3b 3b 20 72 -runall" ;; r
2f70: 75 6e 20 61 6c 6c 20 74 65 73 74 73 2c 20 72 65 un all tests, re
2f80: 73 70 65 63 74 73 20 2d 74 65 73 74 70 61 74 74 spects -testpatt
2f90: 2c 20 64 65 66 61 75 6c 74 73 20 74 6f 20 25 0a , defaults to %.
2fa0: 09 09 09 22 2d 72 75 6e 22 20 20 20 20 20 20 20 ..."-run"
2fb0: 3b 3b 20 61 6c 69 61 73 20 66 6f 72 20 2d 72 75 ;; alias for -ru
2fc0: 6e 61 6c 6c 0a 09 09 09 22 2d 72 65 6d 6f 76 65 nall...."-remove
2fd0: 2d 72 75 6e 73 22 0a 09 09 09 22 2d 72 65 62 75 -runs"...."-rebu
2fe0: 69 6c 64 2d 64 62 22 0a 09 09 09 22 2d 63 6c 65 ild-db"...."-cle
2ff0: 61 6e 75 70 2d 64 62 22 0a 09 09 09 22 2d 72 6f anup-db"...."-ro
3000: 6c 6c 75 70 22 0a 09 09 09 22 2d 75 70 64 61 74 llup"...."-updat
3010: 65 2d 6d 65 74 61 22 0a 09 09 09 22 2d 63 72 65 e-meta"...."-cre
3020: 61 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 ate-megatest-are
3030: 61 22 0a 09 09 09 22 2d 6d 61 72 6b 2d 69 6e 63 a"...."-mark-inc
3040: 6f 6d 70 6c 65 74 65 73 22 0a 0a 09 09 09 22 2d ompletes"....."-
3050: 63 6f 6e 76 65 72 74 2d 74 6f 2d 6e 6f 72 6d 22 convert-to-norm"
3060: 0a 09 09 09 22 2d 63 6f 6e 76 65 72 74 2d 74 6f ...."-convert-to
3070: 2d 6f 6c 64 22 0a 09 09 09 22 2d 69 6d 70 6f 72 -old"...."-impor
3080: 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 0a 09 t-megatest.db"..
3090: 09 09 22 2d 73 79 6e 63 2d 74 6f 2d 6d 65 67 61 .."-sync-to-mega
30a0: 74 65 73 74 2e 64 62 22 0a 0a 09 09 09 22 2d 6c test.db"....."-l
30b0: 6f 67 67 69 6e 67 22 0a 09 09 09 22 2d 76 22 20 ogging"...."-v"
30c0: 3b 3b 20 76 65 72 62 6f 73 65 20 32 2c 20 6d 6f ;; verbose 2, mo
30d0: 72 65 20 74 68 61 6e 20 6e 6f 72 6d 61 6c 20 28 re than normal (
30e0: 6e 6f 72 6d 61 6c 20 69 73 20 31 29 0a 09 09 09 normal is 1)....
30f0: 22 2d 71 22 20 3b 3b 20 71 75 69 65 74 20 30 2c "-q" ;; quiet 0,
3100: 20 65 72 72 6f 72 73 2f 77 61 72 6e 69 6e 67 73 errors/warnings
3110: 20 6f 6e 6c 79 0a 09 09 20 20 20 20 20 20 20 29 only... )
3120: 0a 09 09 20 61 72 67 73 3a 61 72 67 2d 68 61 73 ... args:arg-has
3130: 68 0a 09 09 20 30 29 29 0a 0a 3b 3b 20 41 64 64 h... 0))..;; Add
3140: 20 61 72 67 73 20 74 68 61 74 20 75 73 65 20 72 args that use r
3150: 65 6d 61 72 67 73 20 68 65 72 65 0a 3b 3b 0a 28 emargs here.;;.(
3160: 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 6e 75 if (and (not (nu
3170: 6c 6c 3f 20 72 65 6d 61 72 67 73 29 29 0a 09 20 ll? remargs))..
3180: 28 6e 6f 74 20 28 6f 72 0a 09 20 20 20 20 20 20 (not (or..
3190: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
31a0: 2d 72 75 6e 73 74 65 70 22 29 0a 09 20 20 20 20 -runstep")..
31b0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
31c0: 20 22 2d 65 6e 76 63 61 70 22 29 0a 09 20 20 20 "-envcap")..
31d0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
31e0: 67 20 22 2d 65 6e 76 64 65 6c 74 61 22 29 0a 09 g "-envdelta")..
31f0: 20 20 20 20 20 20 20 29 0a 09 20 20 20 20 20 20 )..
3200: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
3210: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
3220: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
3230: 55 6e 72 65 63 6f 67 6e 69 73 65 64 20 61 72 67 Unrecognised arg
3240: 75 6d 65 6e 74 73 3a 20 22 20 28 73 74 72 69 6e uments: " (strin
3250: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 69 g-intersperse (i
3260: 66 20 28 6c 69 73 74 3f 20 72 65 6d 61 72 67 73 f (list? remargs
3270: 29 20 72 65 6d 61 72 67 73 20 28 61 72 67 76 29 ) remargs (argv)
3280: 29 20 20 22 20 22 29 29 29 0a 0a 3b 3b 20 69 6d ) " ")))..;; im
3290: 6d 65 64 69 61 74 65 6c 79 20 73 65 74 20 4d 54 mediately set MT
32a0: 5f 54 41 52 47 45 54 20 69 66 20 2d 72 65 71 74 _TARGET if -reqt
32b0: 61 72 67 20 6f 72 20 2d 74 61 72 67 65 74 20 61 arg or -target a
32c0: 72 65 20 61 76 61 69 6c 61 62 6c 65 0a 3b 3b 0a re available.;;.
32d0: 28 6c 65 74 20 28 28 74 61 72 67 20 28 6f 72 20 (let ((targ (or
32e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
32f0: 72 65 71 74 61 72 67 22 29 28 61 72 67 73 3a 67 reqtarg")(args:g
3300: 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 et-arg "-target"
3310: 29 29 29 29 0a 20 20 28 69 66 20 74 61 72 67 20 )))). (if targ
3320: 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 (setenv "MT_TARG
3330: 45 54 22 20 74 61 72 67 29 29 29 0a 0a 3b 3b 20 ET" targ)))..;;
3340: 54 68 65 20 77 61 74 63 68 64 6f 67 20 69 73 20 The watchdog is
3350: 74 6f 20 6b 65 65 70 20 61 6e 20 65 79 65 20 6f to keep an eye o
3360: 6e 20 74 68 69 6e 67 73 20 6c 69 6b 65 20 64 62 n things like db
3370: 20 73 79 6e 63 20 65 74 63 2e 0a 3b 3b 0a 28 64 sync etc..;;.(d
3380: 65 66 69 6e 65 20 2a 77 61 74 63 68 64 6f 67 2a efine *watchdog*
3390: 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 63 6f (make-thread co
33a0: 6d 6d 6f 6e 3a 77 61 74 63 68 64 6f 67 20 22 57 mmon:watchdog "W
33b0: 61 74 63 68 64 6f 67 20 74 68 72 65 61 64 22 29 atchdog thread")
33c0: 29 0a 0a 28 74 68 72 65 61 64 2d 73 74 61 72 74 )..(thread-start
33d0: 21 20 2a 77 61 74 63 68 64 6f 67 2a 29 0a 0a 28 ! *watchdog*)..(
33e0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
33f0: 20 22 2d 6c 6f 67 22 29 0a 20 20 20 20 28 6c 65 "-log"). (le
3400: 74 20 28 28 6f 75 70 20 28 6f 70 65 6e 2d 6f 75 t ((oup (open-ou
3410: 74 70 75 74 2d 66 69 6c 65 20 28 61 72 67 73 3a tput-file (args:
3420: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 29 get-arg "-log"))
3430: 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a )). (debug:
3440: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
3450: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3460: 22 53 65 6e 64 69 6e 67 20 6c 6f 67 20 6f 75 74 "Sending log out
3470: 70 75 74 20 74 6f 20 22 20 28 61 72 67 73 3a 67 put to " (args:g
3480: 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 29 0a et-arg "-log")).
3490: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 65 66 (set! *def
34a0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 6f ault-log-port* o
34b0: 75 70 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 up)))..(if (or (
34c0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 args:get-arg "-h
34d0: 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
34e0: 67 20 22 2d 68 65 6c 70 22 29 0a 09 28 61 72 67 g "-help")..(arg
34f0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 2d 68 65 6c s:get-arg "--hel
3500: 70 22 29 29 0a 20 20 20 20 28 62 65 67 69 6e 0a p")). (begin.
3510: 20 20 20 20 20 20 28 70 72 69 6e 74 20 68 65 6c (print hel
3520: 70 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 p). (exit))
3530: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
3540: 2d 61 72 67 20 22 2d 6d 61 6e 75 61 6c 22 29 0a -arg "-manual").
3550: 20 20 20 20 28 6c 65 74 2a 20 28 28 68 74 6d 6c (let* ((html
3560: 76 69 65 77 65 72 63 6d 64 20 28 6f 72 20 28 63 viewercmd (or (c
3570: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 onfigf:lookup *c
3580: 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 onfigdat* "setup
3590: 22 20 22 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 " "htmlviewercmd
35a0: 22 29 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d ").... (com
35b0: 6d 6f 6e 3a 77 68 69 63 68 20 27 28 22 66 69 72 mon:which '("fir
35c0: 65 66 6f 78 22 20 22 61 72 6f 72 61 22 29 29 29 efox" "arora")))
35d0: 29 0a 09 20 20 20 28 69 6e 73 74 61 6c 6c 2d 68 ).. (install-h
35e0: 6f 6d 65 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 ome (common:get
35f0: 2d 69 6e 73 74 61 6c 6c 2d 61 72 65 61 29 29 0a -install-area)).
3600: 09 20 20 20 28 6d 61 6e 75 61 6c 2d 68 74 6d 6c . (manual-html
3610: 20 20 20 28 63 6f 6e 63 20 69 6e 73 74 61 6c 6c (conc install
3620: 2d 68 6f 6d 65 20 22 2f 73 68 61 72 65 2f 64 6f -home "/share/do
3630: 63 73 2f 6d 65 67 61 74 65 73 74 5f 6d 61 6e 75 cs/megatest_manu
3640: 61 6c 2e 68 74 6d 6c 22 29 29 29 0a 20 20 20 20 al.html"))).
3650: 20 20 28 69 66 20 28 61 6e 64 20 69 6e 73 74 61 (if (and insta
3660: 6c 6c 2d 68 6f 6d 65 0a 09 20 20 20 20 20 20 20 ll-home..
3670: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6d 61 (file-exists? ma
3680: 6e 75 61 6c 2d 68 74 6d 6c 29 29 0a 09 20 20 28 nual-html)).. (
3690: 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 28 22 system (conc "("
36a0: 20 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 22 htmlviewercmd "
36b0: 20 22 20 6d 61 6e 75 61 6c 2d 68 74 6d 6c 20 22 " manual-html "
36c0: 20 29 20 26 22 29 29 0a 09 20 20 28 73 79 73 74 ) &")).. (syst
36d0: 65 6d 20 28 63 6f 6e 63 20 22 28 22 20 68 74 6d em (conc "(" htm
36e0: 6c 76 69 65 77 65 72 63 6d 64 20 22 20 68 74 74 lviewercmd " htt
36f0: 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 p://www.kiatoa.c
3700: 6f 6d 2f 63 67 69 2d 62 69 6e 2f 66 6f 73 73 69 om/cgi-bin/fossi
3710: 6c 73 2f 6d 65 67 61 74 65 73 74 2f 64 6f 63 2f ls/megatest/doc/
3720: 74 69 70 2f 64 6f 63 73 2f 6d 61 6e 75 61 6c 2f tip/docs/manual/
3730: 6d 65 67 61 74 65 73 74 5f 6d 61 6e 75 61 6c 2e megatest_manual.
3740: 68 74 6d 6c 20 29 20 26 22 29 29 29 0a 20 20 20 html ) &"))).
3750: 20 20 20 28 65 78 69 74 29 29 29 0a 0a 28 69 66 (exit)))..(if
3760: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3770: 2d 73 74 61 72 74 2d 64 69 72 22 29 0a 20 20 20 -start-dir").
3780: 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 (if (file-exist
3790: 73 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 s? (args:get-arg
37a0: 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 0a "-start-dir")).
37b0: 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f .(change-directo
37c0: 72 79 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ry (args:get-arg
37d0: 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 0a "-start-dir")).
37e0: 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 .(begin.. (debu
37f0: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
3800: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
3810: 74 2a 20 22 6e 6f 6e 2d 65 78 69 73 74 61 6e 74 t* "non-existant
3820: 20 73 74 61 72 74 20 64 69 72 20 22 20 28 61 72 start dir " (ar
3830: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 gs:get-arg "-sta
3840: 72 74 2d 64 69 72 22 29 20 22 20 73 70 65 63 69 rt-dir") " speci
3850: 66 69 65 64 2c 20 65 78 69 74 69 6e 67 2e 22 29 fied, exiting.")
3860: 0a 09 20 20 28 65 78 69 74 20 31 29 29 29 29 0a .. (exit 1)))).
3870: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
3880: 72 67 20 22 2d 76 65 72 73 69 6f 6e 22 29 0a 20 rg "-version").
3890: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
38a0: 28 70 72 69 6e 74 20 28 63 6f 6d 6d 6f 6e 3a 76 (print (common:v
38b0: 65 72 73 69 6f 6e 2d 73 69 67 6e 61 74 75 72 65 ersion-signature
38c0: 29 29 20 3b 3b 20 28 70 72 69 6e 74 20 6d 65 67 )) ;; (print meg
38d0: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 atest-version).
38e0: 20 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a 28 (exit)))..(
38f0: 64 65 66 69 6e 65 20 2a 64 69 64 73 6f 6d 65 74 define *didsomet
3900: 68 69 6e 67 2a 20 23 66 29 0a 0a 3b 3b 20 4f 76 hing* #f)..;; Ov
3910: 65 72 61 6c 6c 20 65 78 69 74 20 68 61 6e 64 6c erall exit handl
3920: 69 6e 67 20 73 65 74 75 70 20 69 6d 6d 65 64 69 ing setup immedi
3930: 61 74 65 6c 79 0a 3b 3b 0a 28 69 66 20 28 6f 72 ately.;;.(if (or
3940: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3950: 2d 70 72 6f 63 65 73 73 2d 72 65 61 70 22 29 29 -process-reap"))
3960: 0a 20 20 20 20 20 20 20 20 3b 3b 20 28 61 72 67 . ;; (arg
3970: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 s:get-arg "-runt
3980: 65 73 74 73 22 29 0a 09 3b 3b 20 28 61 72 67 73 ests")..;; (args
3990: 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 :get-arg "-execu
39a0: 74 65 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a 67 te")..;; (args:g
39b0: 65 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d et-arg "-remove-
39c0: 72 75 6e 73 22 29 0a 09 3b 3b 20 28 61 72 67 73 runs")..;; (args
39d0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 :get-arg "-runst
39e0: 65 70 22 29 29 0a 20 20 20 20 28 6c 65 74 20 28 ep")). (let (
39f0: 28 6f 72 69 67 69 6e 61 6c 2d 65 78 69 74 20 28 (original-exit (
3a00: 65 78 69 74 2d 68 61 6e 64 6c 65 72 29 29 29 0a exit-handler))).
3a10: 20 20 20 20 20 20 28 65 78 69 74 2d 68 61 6e 64 (exit-hand
3a20: 6c 65 72 20 28 6c 61 6d 62 64 61 20 28 23 21 6f ler (lambda (#!o
3a30: 70 74 69 6f 6e 61 6c 20 28 65 78 69 74 2d 63 6f ptional (exit-co
3a40: 64 65 20 30 29 29 0a 09 09 20 20 20 20 20 20 28 de 0))... (
3a50: 70 72 69 6e 74 66 20 22 50 72 65 70 61 72 69 6e printf "Preparin
3a60: 67 20 74 6f 20 65 78 69 74 20 77 69 74 68 20 65 g to exit with e
3a70: 78 69 74 20 63 6f 64 65 20 7e 41 20 2e 2e 2e 5c xit code ~A ...\
3a80: 6e 22 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 n" exit-code)...
3a90: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
3aa0: 0a 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 ... (lambd
3ab0: 61 20 28 70 69 64 29 0a 09 09 09 20 28 68 61 6e a (pid).... (han
3ac0: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
3ad0: 09 09 20 20 65 78 6e 0a 09 09 09 20 20 23 74 0a .. exn.... #t.
3ae0: 09 09 09 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 ... (let-values
3af0: 20 28 28 28 70 69 64 2d 76 61 6c 20 65 78 69 74 (((pid-val exit
3b00: 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 -status exit-cod
3b10: 65 29 20 28 70 72 6f 63 65 73 73 2d 77 61 69 74 e) (process-wait
3b20: 20 70 69 64 20 23 74 29 29 29 0a 09 09 09 09 20 pid #t))).....
3b30: 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 65 71 (if (or (eq
3b40: 3f 20 70 69 64 2d 76 61 6c 20 70 69 64 29 0a 09 ? pid-val pid)..
3b50: 09 09 09 09 20 20 20 20 20 20 28 65 71 3f 20 70 .... (eq? p
3b60: 69 64 2d 76 61 6c 20 30 29 29 0a 09 09 09 09 09 id-val 0))......
3b70: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 (begin......
3b80: 20 20 28 70 72 69 6e 74 66 20 22 53 65 6e 64 69 (printf "Sendi
3b90: 6e 67 20 73 69 67 6e 61 6c 2f 74 65 72 6d 20 74 ng signal/term t
3ba0: 6f 20 7e 41 5c 6e 22 20 70 69 64 29 0a 09 09 09 o ~A\n" pid)....
3bb0: 09 09 20 20 20 20 28 70 72 6f 63 65 73 73 2d 73 .. (process-s
3bc0: 69 67 6e 61 6c 20 70 69 64 20 73 69 67 6e 61 6c ignal pid signal
3bd0: 2f 74 65 72 6d 29 29 29 29 29 29 0a 09 09 20 20 /term))))))...
3be0: 20 20 20 20 20 28 70 72 6f 63 65 73 73 3a 63 68 (process:ch
3bf0: 69 6c 64 72 65 6e 20 23 66 29 29 0a 09 09 20 20 ildren #f))...
3c00: 20 20 20 20 28 6f 72 69 67 69 6e 61 6c 2d 65 78 (original-ex
3c10: 69 74 20 65 78 69 74 2d 63 6f 64 65 29 29 29 29 it exit-code))))
3c20: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
3c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d ===========.;; M
3c70: 69 73 63 20 73 65 74 75 70 20 73 74 75 66 66 0a isc setup stuff.
3c80: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
3c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3cc0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 62 75 67 ========..(debug
3cd0: 3a 73 65 74 75 70 29 0a 0a 28 69 66 20 28 61 72 :setup)..(if (ar
3ce0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 gs:get-arg "-log
3cf0: 67 69 6e 67 22 29 28 73 65 74 21 20 2a 6c 6f 67 ging")(set! *log
3d00: 67 69 6e 67 2a 20 23 74 29 29 0a 0a 28 69 66 20 ging* #t))..(if
3d10: 28 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 (debug:debug-mod
3d20: 65 20 33 29 20 3b 3b 20 77 65 20 61 72 65 20 6f e 3) ;; we are o
3d30: 62 76 69 6f 75 73 6c 79 20 64 65 62 75 67 67 69 bviously debuggi
3d40: 6e 67 0a 20 20 20 20 28 73 65 74 21 20 6f 70 65 ng. (set! ope
3d50: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 6f 70 65 6e n-run-close open
3d60: 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 -run-close-no-ex
3d70: 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 ception-handling
3d80: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
3d90: 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 t-arg "-itempatt
3da0: 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 6e 65 "). (let ((ne
3db0: 77 76 61 6c 20 28 63 6f 6e 63 20 28 61 72 67 73 wval (conc (args
3dc0: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 :get-arg "-testp
3dd0: 61 74 74 22 29 20 22 2f 22 20 28 61 72 67 73 3a att") "/" (args:
3de0: 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 get-arg "-itempa
3df0: 74 74 22 29 29 29 29 0a 20 20 20 20 20 20 28 64 tt")))). (d
3e00: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
3e10: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3e20: 22 57 41 52 4e 49 4e 47 3a 20 2d 69 74 65 6d 70 "WARNING: -itemp
3e30: 61 74 74 20 68 61 73 20 62 65 65 6e 20 64 65 70 att has been dep
3e40: 72 65 63 61 74 65 64 2c 20 70 6c 65 61 73 65 20 recated, please
3e50: 75 73 65 20 2d 74 65 73 74 70 61 74 74 20 74 65 use -testpatt te
3e60: 73 74 70 61 74 74 2f 69 74 65 6d 70 61 74 74 20 stpatt/itempatt
3e70: 6d 65 74 68 6f 64 2c 20 6e 65 77 20 74 65 73 74 method, new test
3e80: 70 61 74 74 20 69 73 20 22 6e 65 77 76 61 6c 29 patt is "newval)
3e90: 0a 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 . (hash-tab
3ea0: 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 le-set! args:arg
3eb0: 2d 68 61 73 68 20 22 2d 74 65 73 74 70 61 74 74 -hash "-testpatt
3ec0: 22 20 6e 65 77 76 61 6c 29 0a 20 20 20 20 20 20 " newval).
3ed0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 (hash-table-dele
3ee0: 74 65 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 te! args:arg-has
3ef0: 68 20 22 2d 69 74 65 6d 70 61 74 74 22 29 29 29 h "-itempatt")))
3f00: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
3f10: 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
3f20: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
3f30: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
3f40: 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a -port* "WARNING:
3f50: 20 5c 22 2d 72 75 6e 74 65 73 74 73 5c 22 20 69 \"-runtests\" i
3f60: 73 20 64 65 70 72 65 63 61 74 65 64 2e 20 55 73 s deprecated. Us
3f70: 65 20 5c 22 2d 72 75 6e 5c 22 20 77 69 74 68 20 e \"-run\" with
3f80: 5c 22 2d 74 65 73 74 70 61 74 74 5c 22 20 69 6e \"-testpatt\" in
3f90: 73 74 65 61 64 22 29 29 0a 0a 28 6f 6e 2d 65 78 stead"))..(on-ex
3fa0: 69 74 20 73 74 64 2d 65 78 69 74 2d 70 72 6f 63 it std-exit-proc
3fb0: 65 64 75 72 65 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d edure)..;;======
3fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4000: 0a 3b 3b 20 4d 69 73 63 20 67 65 6e 65 72 61 6c .;; Misc general
4010: 20 63 61 6c 6c 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d calls.;;=======
4020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
4060: 0a 28 69 66 20 28 61 6e 64 20 28 61 72 67 73 3a .(if (and (args:
4070: 67 65 74 2d 61 72 67 20 22 2d 63 61 63 68 65 2d get-arg "-cache-
4080: 64 62 22 29 0a 20 20 20 20 20 20 20 20 20 28 61 db"). (a
4090: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f rgs:get-arg "-so
40a0: 75 72 63 65 2d 64 62 22 29 29 0a 20 20 20 20 28 urce-db")). (
40b0: 6c 65 74 2a 20 28 28 74 65 6d 70 2d 64 69 72 20 let* ((temp-dir
40c0: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
40d0: 67 20 22 2d 74 61 72 67 65 74 2d 64 62 22 29 20 g "-target-db")
40e0: 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
40f0: 79 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 y (conc "/tmp/"
4100: 28 67 65 74 65 6e 76 20 22 55 53 45 52 22 29 20 (getenv "USER")
4110: 22 2f 22 20 28 73 74 72 69 6e 67 2d 74 72 61 6e "/" (string-tran
4120: 73 6c 61 74 65 20 28 63 75 72 72 65 6e 74 2d 64 slate (current-d
4130: 69 72 65 63 74 6f 72 79 29 20 22 2f 22 20 22 5f irectory) "/" "_
4140: 22 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 "))))).
4150: 20 20 28 74 61 72 67 65 74 2d 64 62 20 28 63 6f (target-db (co
4160: 6e 63 20 74 65 6d 70 2d 64 69 72 20 22 2f 63 61 nc temp-dir "/ca
4170: 63 68 65 64 2e 64 62 22 29 29 0a 20 20 20 20 20 ched.db")).
4180: 20 20 20 20 20 20 28 73 6f 75 72 63 65 2d 64 62 (source-db
4190: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
41a0: 2d 73 6f 75 72 63 65 2d 64 62 22 29 29 29 20 20 -source-db")))
41b0: 20 20 20 20 20 20 0a 20 20 20 20 20 20 28 64 62 . (db
41c0: 3a 63 61 63 68 65 2d 66 6f 72 2d 72 65 61 64 2d :cache-for-read-
41d0: 6f 6e 6c 79 20 73 6f 75 72 63 65 2d 64 62 20 74 only source-db t
41e0: 61 72 67 65 74 2d 64 62 29 0a 20 20 20 20 20 20 arget-db).
41f0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
4200: 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 68 ing* #t)))..;; h
4210: 61 6e 64 6c 65 20 61 20 63 6c 65 61 6e 2d 63 61 andle a clean-ca
4220: 63 68 65 20 72 65 71 75 65 73 74 20 61 73 20 65 che request as e
4230: 61 72 6c 79 20 61 73 20 70 6f 73 73 69 62 6c 65 arly as possible
4240: 0a 3b 3b 0a 28 69 66 20 28 61 72 67 73 3a 67 65 .;;.(if (args:ge
4250: 74 2d 61 72 67 20 22 2d 63 6c 65 61 6e 2d 63 61 t-arg "-clean-ca
4260: 63 68 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e che"). (begin
4270: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
4280: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 20 dsomething* #t)
4290: 3b 3b 20 73 75 70 70 72 65 73 73 20 74 68 65 20 ;; suppress the
42a0: 68 65 6c 70 20 6f 75 74 70 75 74 2e 0a 20 20 20 help output..
42b0: 20 20 20 28 69 66 20 28 67 65 74 65 6e 76 20 22 (if (getenv "
42c0: 4d 54 5f 54 41 52 47 45 54 22 29 20 3b 3b 20 6e MT_TARGET") ;; n
42d0: 6f 20 70 6f 69 6e 74 20 69 6e 20 74 72 79 69 6e o point in tryin
42e0: 67 20 69 66 20 6e 6f 20 74 61 72 67 65 74 0a 09 g if no target..
42f0: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
4300: 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 0a arg "-runname").
4310: 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 . (let* ((t
4320: 6f 70 70 61 74 68 20 20 28 6c 61 75 6e 63 68 3a oppath (launch:
4330: 73 65 74 75 70 29 29 0a 09 09 20 20 20 20 20 28 setup))... (
4340: 6c 69 6e 6b 74 72 65 65 20 28 69 66 20 74 6f 70 linktree (if top
4350: 70 61 74 68 20 28 63 6f 6e 66 69 67 66 3a 6c 6f path (configf:lo
4360: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
4370: 20 22 73 65 74 75 70 22 20 22 6c 69 6e 6b 74 72 "setup" "linktr
4380: 65 65 22 29 29 29 0a 09 09 20 20 20 20 20 28 72 ee")))... (r
4390: 75 6e 74 6f 70 20 20 20 28 63 6f 6e 63 20 6c 69 untop (conc li
43a0: 6e 6b 74 72 65 65 20 22 2f 22 20 28 67 65 74 65 nktree "/" (gete
43b0: 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 20 nv "MT_TARGET")
43c0: 22 2f 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 "/" (args:get-ar
43d0: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 29 29 0a g "-runname"))).
43e0: 09 09 20 20 20 20 20 28 66 69 6c 65 73 20 20 20 .. (files
43f0: 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 (if (file-exist
4400: 73 3f 20 72 75 6e 74 6f 70 29 0a 09 09 09 09 20 s? runtop).....
4410: 20 20 28 61 70 70 65 6e 64 20 28 67 6c 6f 62 20 (append (glob
4420: 28 63 6f 6e 63 20 72 75 6e 74 6f 70 20 22 2f 2e (conc runtop "/.
4430: 6d 65 67 61 74 65 73 74 2a 22 29 29 0a 09 09 09 megatest*"))....
4440: 09 09 20 20 20 28 67 6c 6f 62 20 28 63 6f 6e 63 .. (glob (conc
4450: 20 72 75 6e 74 6f 70 20 22 2f 2e 72 75 6e 63 6f runtop "/.runco
4460: 6e 66 69 67 2a 22 29 29 29 0a 09 09 09 09 20 20 nfig*"))).....
4470: 20 27 28 29 29 29 29 0a 09 09 28 69 66 20 28 6e '())))...(if (n
4480: 75 6c 6c 3f 20 66 69 6c 65 73 29 0a 09 09 20 20 ull? files)...
4490: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
44a0: 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
44b0: 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f 20 63 61 63 og-port* "No cac
44c0: 68 65 64 20 6d 65 67 61 74 65 73 74 20 6f 72 20 hed megatest or
44d0: 72 75 6e 63 6f 6e 66 69 67 73 20 66 69 6c 65 73 runconfigs files
44e0: 20 66 6f 75 6e 64 2e 20 4e 6f 6e 65 20 72 65 6d found. None rem
44f0: 6f 76 65 64 2e 22 29 0a 09 09 20 20 20 20 28 62 oved.")... (b
4500: 65 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 egin... (de
4510: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
4520: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
4530: 72 74 2a 20 22 52 65 6d 6f 76 69 6e 67 20 63 61 rt* "Removing ca
4540: 63 68 65 64 20 66 69 6c 65 73 3a 5c 6e 20 20 20 ched files:\n
4550: 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 " (string-inter
4560: 73 70 65 72 73 65 20 66 69 6c 65 73 20 22 5c 6e sperse files "\n
4570: 20 20 20 20 22 29 29 0a 09 09 20 20 20 20 20 20 "))...
4580: 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 20 20 20 (for-each ...
4590: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 29 0a (lambda (f).
45a0: 09 09 09 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 ... (handle-exce
45b0: 70 74 69 6f 6e 73 0a 09 09 09 20 20 20 20 20 65 ptions.... e
45c0: 78 6e 0a 09 09 09 20 20 20 20 20 28 64 65 62 75 xn.... (debu
45d0: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
45e0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 lt-log-port* "WA
45f0: 52 4e 49 4e 47 3a 20 46 61 69 6c 65 64 20 74 6f RNING: Failed to
4600: 20 72 65 6d 6f 76 65 20 66 69 6c 65 20 22 20 66 remove file " f
4610: 29 0a 09 09 09 20 20 20 28 64 65 6c 65 74 65 2d ).... (delete-
4620: 66 69 6c 65 20 66 29 29 29 0a 09 09 20 20 20 20 file f)))...
4630: 20 20 20 66 69 6c 65 73 29 29 29 29 0a 09 20 20 files))))..
4640: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
4650: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
4660: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 63 6c t-log-port* "-cl
4670: 65 61 6e 2d 63 61 63 68 65 20 72 65 71 75 69 72 ean-cache requir
4680: 65 73 20 2d 72 75 6e 6e 61 6d 65 2e 22 29 29 0a es -runname.")).
4690: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
46a0: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
46b0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 63 6c 65 -log-port* "-cle
46c0: 61 6e 2d 63 61 63 68 65 20 72 65 71 75 69 72 65 an-cache require
46d0: 73 20 2d 74 61 72 67 65 74 20 6f 72 20 2d 72 65 s -target or -re
46e0: 71 74 61 72 67 22 29 29 29 29 0a 09 20 20 20 20 qtarg"))))..
46f0: 0a 09 20 20 0a 28 69 66 20 28 61 72 67 73 3a 67 .. .(if (args:g
4700: 65 74 2d 61 72 67 20 22 2d 65 6e 76 32 66 69 6c et-arg "-env2fil
4710: 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 e"). (begin.
4720: 20 20 20 20 20 28 73 61 76 65 2d 65 6e 76 69 72 (save-envir
4730: 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 onment-as-files
4740: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4750: 65 6e 76 32 66 69 6c 65 22 29 29 0a 20 20 20 20 env2file")).
4760: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
4770: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
4780: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
4790: 22 2d 6c 69 73 74 2d 64 69 73 6b 73 22 29 0a 20 "-list-disks").
47a0: 20 20 20 28 6c 65 74 20 28 28 74 6f 70 70 61 74 (let ((toppat
47b0: 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 h (launch:setup)
47c0: 29 29 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 )). (print
47d0: 0a 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d . (string-
47e0: 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 28 6d intersperse ..(m
47f0: 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 ap (lambda (x)..
4800: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 (string-i
4810: 6e 74 65 72 73 70 65 72 73 65 20 0a 09 09 78 0a ntersperse ...x.
4820: 09 09 22 20 3d 3e 20 22 29 29 0a 09 20 20 20 20 .." => "))..
4830: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 64 69 73 (common:get-dis
4840: 6b 73 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 29 ks *configdat*))
4850: 0a 09 22 5c 6e 22 29 29 0a 20 20 20 20 20 20 28 .."\n")). (
4860: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
4870: 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 63 73 ng* #t)))..;; cs
4880: 76 20 70 72 6f 63 65 73 73 69 6e 67 20 72 65 63 v processing rec
4890: 6f 72 64 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b ord.(define (mak
48a0: 65 2d 72 65 66 64 62 3a 63 73 76 29 0a 20 20 28 e-refdb:csv). (
48b0: 76 65 63 74 6f 72 20 0a 20 20 20 28 6d 61 6b 65 vector . (make
48c0: 2d 73 70 61 72 73 65 2d 61 72 72 61 79 29 0a 20 -sparse-array).
48d0: 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 (make-hash-tab
48e0: 6c 65 29 0a 20 20 20 28 6d 61 6b 65 2d 68 61 73 le). (make-has
48f0: 68 2d 74 61 62 6c 65 29 0a 20 20 20 30 0a 20 20 h-table). 0.
4900: 20 30 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 0)).(define-inl
4910: 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 67 ine (refdb:csv-g
4920: 65 74 2d 73 76 65 63 20 20 20 20 20 76 65 63 29 et-svec vec)
4930: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
4940: 20 76 65 63 20 30 29 29 0a 28 64 65 66 69 6e 65 vec 0)).(define
4950: 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 -inline (refdb:c
4960: 73 76 2d 67 65 74 2d 72 6f 77 73 20 20 20 20 20 sv-get-rows
4970: 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d vec) (vector-
4980: 72 65 66 20 20 76 65 63 20 31 29 29 0a 28 64 65 ref vec 1)).(de
4990: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 fine-inline (ref
49a0: 64 62 3a 63 73 76 2d 67 65 74 2d 63 6f 6c 73 20 db:csv-get-cols
49b0: 20 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 vec) (vec
49c0: 74 6f 72 2d 72 65 66 20 20 76 65 63 20 32 29 29 tor-ref vec 2))
49d0: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
49e0: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d (refdb:csv-get-m
49f0: 61 78 72 6f 77 20 20 20 76 65 63 29 20 20 20 20 axrow vec)
4a00: 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 (vector-ref vec
4a10: 20 33 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 3)).(define-inl
4a20: 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 67 ine (refdb:csv-g
4a30: 65 74 2d 6d 61 78 63 6f 6c 20 20 20 76 65 63 29 et-maxcol vec)
4a40: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
4a50: 20 76 65 63 20 34 29 29 0a 28 64 65 66 69 6e 65 vec 4)).(define
4a60: 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 -inline (refdb:c
4a70: 73 76 2d 73 65 74 2d 73 76 65 63 21 20 20 20 20 sv-set-svec!
4a80: 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d vec val)(vector-
4a90: 73 65 74 21 20 76 65 63 20 30 20 76 61 6c 29 29 set! vec 0 val))
4aa0: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
4ab0: 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 72 (refdb:csv-set-r
4ac0: 6f 77 73 21 20 20 20 20 76 65 63 20 76 61 6c 29 ows! vec val)
4ad0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
4ae0: 20 31 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 1 val)).(define
4af0: 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 -inline (refdb:c
4b00: 73 76 2d 73 65 74 2d 63 6f 6c 73 21 20 20 20 20 sv-set-cols!
4b10: 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d vec val)(vector-
4b20: 73 65 74 21 20 76 65 63 20 32 20 76 61 6c 29 29 set! vec 2 val))
4b30: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
4b40: 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d (refdb:csv-set-m
4b50: 61 78 72 6f 77 21 20 20 76 65 63 20 76 61 6c 29 axrow! vec val)
4b60: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
4b70: 20 33 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 3 val)).(define
4b80: 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 -inline (refdb:c
4b90: 73 76 2d 73 65 74 2d 6d 61 78 63 6f 6c 21 20 20 sv-set-maxcol!
4ba0: 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d vec val)(vector-
4bb0: 73 65 74 21 20 76 65 63 20 34 20 76 61 6c 29 29 set! vec 4 val))
4bc0: 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d 64 ..(define (get-d
4bd0: 61 74 20 72 65 73 75 6c 74 73 20 73 68 65 65 74 at results sheet
4be0: 6e 61 6d 65 29 0a 20 20 28 6f 72 20 28 68 61 73 name). (or (has
4bf0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
4c00: 75 6c 74 20 72 65 73 75 6c 74 73 20 73 68 65 65 ult results shee
4c10: 74 6e 61 6d 65 20 23 66 29 0a 20 20 20 20 20 20 tname #f).
4c20: 28 6c 65 74 20 28 28 74 6d 70 2d 76 65 63 20 20 (let ((tmp-vec
4c30: 28 6d 61 6b 65 2d 72 65 66 64 62 3a 63 73 76 29 (make-refdb:csv)
4c40: 29 29 0a 09 28 68 61 73 68 2d 74 61 62 6c 65 2d ))..(hash-table-
4c50: 73 65 74 21 20 72 65 73 75 6c 74 73 20 73 68 65 set! results she
4c60: 65 74 6e 61 6d 65 20 74 6d 70 2d 76 65 63 29 0a etname tmp-vec).
4c70: 09 74 6d 70 2d 76 65 63 29 29 29 0a 0a 28 69 66 .tmp-vec)))..(if
4c80: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4c90: 2d 72 65 66 64 62 32 64 61 74 22 29 0a 20 20 20 -refdb2dat").
4ca0: 20 28 6c 65 74 2a 20 28 28 69 6e 70 75 74 2d 64 (let* ((input-d
4cb0: 62 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 b (args:get-arg
4cc0: 22 2d 72 65 66 64 62 32 64 61 74 22 29 29 0a 09 "-refdb2dat"))..
4cd0: 20 20 20 28 6f 75 74 2d 66 69 6c 65 20 28 61 72 (out-file (ar
4ce0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 gs:get-arg "-o")
4cf0: 29 0a 09 20 20 20 28 6f 75 74 2d 66 6d 74 20 20 ).. (out-fmt
4d00: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
4d10: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
4d20: 73 63 68 65 6d 65 22 29 29 0a 09 20 20 20 28 6f scheme")).. (o
4d30: 75 74 2d 70 6f 72 74 20 28 69 66 20 28 61 6e 64 ut-port (if (and
4d40: 20 6f 75 74 2d 66 69 6c 65 20 0a 09 09 09 20 20 out-file ....
4d50: 20 20 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 (not (member
4d60: 20 6f 75 74 2d 66 6d 74 20 27 28 22 73 71 6c 69 out-fmt '("sqli
4d70: 74 65 33 22 20 22 63 73 76 22 29 29 29 29 0a 09 te3" "csv"))))..
4d80: 09 09 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d .. (open-output-
4d90: 66 69 6c 65 20 6f 75 74 2d 66 69 6c 65 29 0a 09 file out-file)..
4da0: 09 09 20 28 63 75 72 72 65 6e 74 2d 6f 75 74 70 .. (current-outp
4db0: 75 74 2d 70 6f 72 74 29 29 29 0a 09 20 20 20 28 ut-port))).. (
4dc0: 72 65 73 2d 64 61 74 61 20 28 63 6f 6e 66 69 67 res-data (config
4dd0: 66 3a 72 65 61 64 2d 72 65 66 64 62 20 69 6e 70 f:read-refdb inp
4de0: 75 74 2d 64 62 29 29 0a 09 20 20 20 28 64 61 74 ut-db)).. (dat
4df0: 61 20 20 20 20 20 28 63 61 72 20 72 65 73 2d 64 a (car res-d
4e00: 61 74 61 29 29 0a 09 20 20 20 28 6d 73 67 20 20 ata)).. (msg
4e10: 20 20 20 20 28 63 61 64 72 20 72 65 73 2d 64 61 (cadr res-da
4e20: 74 61 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 ta))). (if
4e30: 28 6e 6f 74 20 64 61 74 61 29 0a 09 20 20 28 64 (not data).. (d
4e40: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
4e50: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
4e60: 22 42 61 64 20 69 6e 70 75 74 3f 20 64 61 74 61 "Bad input? data
4e70: 3d 22 20 64 61 74 61 29 20 3b 3b 20 73 6f 6d 65 =" data) ;; some
4e80: 20 65 72 72 6f 72 20 6f 63 63 75 72 72 65 64 0a error occurred.
4e90: 09 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d . (with-output-
4ea0: 74 6f 2d 70 6f 72 74 20 6f 75 74 2d 70 6f 72 74 to-port out-port
4eb0: 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 .. (lambda ()
4ec0: 0a 09 20 20 20 20 20 20 28 63 61 73 65 20 28 73 .. (case (s
4ed0: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 6f 75 tring->symbol ou
4ee0: 74 2d 66 6d 74 29 0a 09 09 28 28 73 63 68 65 6d t-fmt)...((schem
4ef0: 65 29 28 70 70 20 64 61 74 61 29 29 0a 09 09 28 e)(pp data))...(
4f00: 28 70 65 72 6c 29 0a 09 09 20 3b 3b 20 28 70 72 (perl)... ;; (pr
4f10: 69 6e 74 20 22 25 68 61 73 68 20 3d 20 28 22 29 int "%hash = (")
4f20: 0a 09 09 20 3b 3b 20 20 20 20 20 20 20 20 6b 65 ... ;; ke
4f30: 79 31 20 3d 3e 20 27 76 61 6c 75 65 31 27 2c 0a y1 => 'value1',.
4f40: 09 09 20 3b 3b 20 20 20 20 20 20 20 20 6b 65 79 .. ;; key
4f50: 32 20 3d 3e 20 27 76 61 6c 75 65 32 27 2c 0a 09 2 => 'value2',..
4f60: 09 20 3b 3b 20 20 20 20 20 20 20 20 6b 65 79 33 . ;; key3
4f70: 20 3d 3e 20 27 76 61 6c 75 65 33 27 2c 0a 09 09 => 'value3',...
4f80: 20 3b 3b 20 29 3b 0a 09 09 20 28 63 6f 6e 66 69 ;; );... (confi
4f90: 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d gf:map-all-hier-
4fa0: 61 6c 69 73 74 20 0a 09 09 20 20 64 61 74 61 20 alist ... data
4fb0: 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 28 73 68 ... (lambda (sh
4fc0: 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e eetname sectionn
4fd0: 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 ame varname val)
4fe0: 0a 09 09 20 20 20 20 28 70 72 69 6e 74 20 22 24 ... (print "$
4ff0: 64 61 74 61 7b 5c 22 22 20 73 68 65 65 74 6e 61 data{\"" sheetna
5000: 6d 65 20 22 5c 22 7d 7b 5c 22 22 20 73 65 63 74 me "\"}{\"" sect
5010: 69 6f 6e 6e 61 6d 65 20 22 5c 22 7d 7b 5c 22 22 ionname "\"}{\""
5020: 20 76 61 72 6e 61 6d 65 20 22 5c 22 7d 20 3d 20 varname "\"} =
5030: 5c 22 22 20 76 61 6c 20 22 5c 22 3b 22 29 29 29 \"" val "\";")))
5040: 29 0a 09 09 28 28 70 79 74 68 6f 6e 20 72 75 62 )...((python rub
5050: 79 29 0a 09 09 20 28 70 72 69 6e 74 20 22 64 61 y)... (print "da
5060: 74 61 3d 7b 7d 22 29 0a 09 09 20 28 63 6f 6e 66 ta={}")... (conf
5070: 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 igf:map-all-hier
5080: 2d 61 6c 69 73 74 0a 09 09 20 20 64 61 74 61 0a -alist... data.
5090: 09 09 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 .. (lambda (she
50a0: 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 etname sectionna
50b0: 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 0a me varname val).
50c0: 09 09 20 20 20 20 28 70 72 69 6e 74 20 22 64 61 .. (print "da
50d0: 74 61 5b 5c 22 22 20 73 68 65 65 74 6e 61 6d 65 ta[\"" sheetname
50e0: 20 22 5c 22 5d 5b 5c 22 22 20 73 65 63 74 69 6f "\"][\"" sectio
50f0: 6e 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 22 20 76 nname "\"][\"" v
5100: 61 72 6e 61 6d 65 20 22 5c 22 5d 20 3d 20 5c 22 arname "\"] = \"
5110: 22 20 76 61 6c 20 22 5c 22 22 29 29 0a 09 09 20 " val "\""))...
5120: 20 69 6e 69 74 70 72 6f 63 31 3a 0a 09 09 20 20 initproc1:...
5130: 28 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 (lambda (sheetna
5140: 6d 65 29 0a 09 09 20 20 20 20 28 70 72 69 6e 74 me)... (print
5150: 20 22 64 61 74 61 5b 5c 22 22 20 73 68 65 65 74 "data[\"" sheet
5160: 6e 61 6d 65 20 22 5c 22 5d 20 3d 20 7b 7d 22 29 name "\"] = {}")
5170: 29 0a 09 09 20 20 69 6e 69 74 70 72 6f 63 32 3a )... initproc2:
5180: 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 28 73 68 ... (lambda (sh
5190: 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e eetname sectionn
51a0: 61 6d 65 29 0a 09 09 20 20 20 20 28 70 72 69 6e ame)... (prin
51b0: 74 20 22 64 61 74 61 5b 5c 22 22 20 73 68 65 65 t "data[\"" shee
51c0: 74 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 22 20 73 tname "\"][\"" s
51d0: 65 63 74 69 6f 6e 6e 61 6d 65 20 22 5c 22 5d 20 ectionname "\"]
51e0: 3d 20 7b 7d 22 29 29 29 29 0a 09 09 28 28 63 73 = {}"))))...((cs
51f0: 76 29 0a 09 09 20 28 6c 65 74 2a 20 28 28 72 65 v)... (let* ((re
5200: 73 75 6c 74 73 20 20 28 6d 61 6b 65 2d 68 61 73 sults (make-has
5210: 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 28 6d 61 h-table)) ;; (ma
5220: 6b 65 2d 73 70 61 72 73 65 2d 61 72 72 61 79 29 ke-sparse-array)
5230: 29 29 0a 09 09 09 28 72 6f 77 2d 63 6f 6c 73 20 ))....(row-cols
5240: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
5250: 29 29 29 20 3b 3b 20 68 61 73 68 20 6f 66 20 68 ))) ;; hash of h
5260: 61 73 68 65 73 20 77 68 65 72 65 20 73 65 63 74 ashes where sect
5270: 69 6f 6e 20 3d 3e 20 68 74 20 7b 20 72 6f 77 2d ion => ht { row-
5280: 3c 6e 61 6d 65 3e 20 3d 3e 20 6e 75 6d 20 6f 72 <name> => num or
5290: 20 63 6f 6c 2d 3c 6e 61 6d 65 3e 20 3d 3e 20 6e col-<name> => n
52a0: 75 6d 0a 09 09 20 20 20 3b 3b 20 28 70 72 69 6e um... ;; (prin
52b0: 74 20 22 64 61 74 61 3d 22 29 0a 09 09 20 20 20 t "data=")...
52c0: 3b 3b 20 28 70 70 20 64 61 74 61 29 0a 09 09 20 ;; (pp data)...
52d0: 20 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 (configf:map-a
52e0: 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 0a 09 09 ll-hier-alist...
52f0: 20 20 20 20 64 61 74 61 0a 09 09 20 20 20 20 28 data... (
5300: 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d lambda (sheetnam
5310: 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 e sectionname va
5320: 72 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 rname val)...
5330: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 68 ;; (print "sh
5340: 65 65 74 6e 61 6d 65 3a 20 22 20 73 68 65 65 74 eetname: " sheet
5350: 6e 61 6d 65 20 22 2c 20 73 65 63 74 69 6f 6e 6e name ", sectionn
5360: 61 6d 65 3a 20 22 20 73 65 63 74 69 6f 6e 6e 61 ame: " sectionna
5370: 6d 65 20 22 2c 20 76 61 72 6e 61 6d 65 3a 20 22 me ", varname: "
5380: 20 76 61 72 6e 61 6d 65 20 22 2c 20 76 61 6c 3a varname ", val:
5390: 20 22 20 76 61 6c 29 0a 09 09 20 20 20 20 20 20 " val)...
53a0: 28 6c 65 74 2a 20 28 28 64 61 74 20 20 20 20 20 (let* ((dat
53b0: 20 28 67 65 74 2d 64 61 74 20 72 65 73 75 6c 74 (get-dat result
53c0: 73 20 73 68 65 65 74 6e 61 6d 65 29 29 0a 09 09 s sheetname))...
53d0: 09 20 20 20 20 20 28 76 65 63 20 20 20 20 20 20 . (vec
53e0: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 73 (refdb:csv-get-s
53f0: 76 65 63 20 64 61 74 29 29 0a 09 09 09 20 20 20 vec dat))....
5400: 20 20 28 72 6f 77 6e 61 6d 65 73 20 28 72 65 66 (rownames (ref
5410: 64 62 3a 63 73 76 2d 67 65 74 2d 72 6f 77 73 20 db:csv-get-rows
5420: 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 63 dat)).... (c
5430: 6f 6c 6e 61 6d 65 73 20 28 72 65 66 64 62 3a 63 olnames (refdb:c
5440: 73 76 2d 67 65 74 2d 63 6f 6c 73 20 64 61 74 29 sv-get-cols dat)
5450: 29 0a 09 09 09 20 20 20 20 20 28 63 75 72 72 72 ).... (currr
5460: 6f 77 6e 20 28 68 61 73 68 2d 74 61 62 6c 65 2d own (hash-table-
5470: 72 65 66 2f 64 65 66 61 75 6c 74 20 72 6f 77 6e ref/default rown
5480: 61 6d 65 73 20 76 61 72 6e 61 6d 65 20 23 66 29 ames varname #f)
5490: 29 0a 09 09 09 20 20 20 20 20 28 63 75 72 72 63 ).... (currc
54a0: 6f 6c 6e 20 28 68 61 73 68 2d 74 61 62 6c 65 2d oln (hash-table-
54b0: 72 65 66 2f 64 65 66 61 75 6c 74 20 63 6f 6c 6e ref/default coln
54c0: 61 6d 65 73 20 73 65 63 74 69 6f 6e 6e 61 6d 65 ames sectionname
54d0: 20 23 66 29 29 0a 09 09 09 20 20 20 20 20 28 72 #f)).... (r
54e0: 6f 77 6e 20 20 20 20 20 28 6f 72 20 63 75 72 72 own (or curr
54f0: 72 6f 77 6e 20 0a 09 09 09 09 09 20 20 20 28 6c rown ...... (l
5500: 65 74 2a 20 28 28 6c 61 73 74 6e 20 20 20 28 72 et* ((lastn (r
5510: 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 efdb:csv-get-max
5520: 72 6f 77 20 64 61 74 29 29 0a 09 09 09 09 09 09 row dat)).......
5530: 20 20 28 6e 65 77 72 6f 77 6e 20 28 2b 20 6c 61 (newrown (+ la
5540: 73 74 6e 20 31 29 29 29 0a 09 09 09 09 09 20 20 stn 1)))......
5550: 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 (refdb:csv-se
5560: 74 2d 6d 61 78 72 6f 77 21 20 64 61 74 20 6e 65 t-maxrow! dat ne
5570: 77 72 6f 77 6e 29 0a 09 09 09 09 09 20 20 20 20 wrown)......
5580: 20 6e 65 77 72 6f 77 6e 29 29 29 0a 09 09 09 20 newrown)))....
5590: 20 20 20 20 28 63 6f 6c 6e 20 20 20 20 20 28 6f (coln (o
55a0: 72 20 63 75 72 72 63 6f 6c 6e 20 0a 09 09 09 09 r currcoln .....
55b0: 09 20 20 20 28 6c 65 74 2a 20 28 28 6c 61 73 74 . (let* ((last
55c0: 6e 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 n (refdb:csv-g
55d0: 65 74 2d 6d 61 78 63 6f 6c 20 64 61 74 29 29 0a et-maxcol dat)).
55e0: 09 09 09 09 09 09 20 20 28 6e 65 77 63 6f 6c 6e ...... (newcoln
55f0: 20 28 2b 20 6c 61 73 74 6e 20 31 29 29 29 0a 09 (+ lastn 1)))..
5600: 09 09 09 09 20 20 20 20 20 28 72 65 66 64 62 3a .... (refdb:
5610: 63 73 76 2d 73 65 74 2d 6d 61 78 63 6f 6c 21 20 csv-set-maxcol!
5620: 64 61 74 20 6e 65 77 63 6f 6c 6e 29 0a 09 09 09 dat newcoln)....
5630: 09 09 20 20 20 20 20 6e 65 77 63 6f 6c 6e 29 29 .. newcoln))
5640: 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 28 ))....(if (not (
5650: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 sparse-array-ref
5660: 20 76 65 63 20 30 20 63 6f 6c 6e 29 29 20 3b 3b vec 0 coln)) ;;
5670: 20 28 65 71 3f 20 72 6f 77 6e 20 30 29 0a 09 09 (eq? rown 0)...
5680: 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 20 . (begin....
5690: 20 20 20 20 20 28 73 70 61 72 73 65 2d 61 72 72 (sparse-arr
56a0: 61 79 2d 73 65 74 21 20 76 65 63 20 30 20 63 6f ay-set! vec 0 co
56b0: 6c 6e 20 73 65 63 74 69 6f 6e 6e 61 6d 65 29 0a ln sectionname).
56c0: 09 09 09 20 20 20 20 20 20 3b 3b 20 28 70 72 69 ... ;; (pri
56d0: 6e 74 20 22 73 70 61 72 73 65 2d 61 72 72 61 79 nt "sparse-array
56e0: 2d 72 65 66 20 22 20 30 20 22 2c 22 20 63 6f 6c -ref " 0 "," col
56f0: 6e 20 22 3d 22 20 28 73 70 61 72 73 65 2d 61 72 n "=" (sparse-ar
5700: 72 61 79 2d 72 65 66 20 76 65 63 20 30 20 63 6f ray-ref vec 0 co
5710: 6c 6e 29 29 0a 09 09 09 20 20 20 20 20 20 29 29 ln)).... ))
5720: 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 28 73 70 ....(if (not (sp
5730: 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 76 arse-array-ref v
5740: 65 63 20 72 6f 77 6e 20 30 29 29 20 3b 3b 20 28 ec rown 0)) ;; (
5750: 65 71 3f 20 63 6f 6c 6e 20 30 29 0a 09 09 09 20 eq? coln 0)....
5760: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 (begin....
5770: 20 20 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 (sparse-array
5780: 2d 73 65 74 21 20 76 65 63 20 72 6f 77 6e 20 30 -set! vec rown 0
5790: 20 76 61 72 6e 61 6d 65 29 0a 09 09 09 20 20 20 varname)....
57a0: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 70 ;; (print "sp
57b0: 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 22 arse-array-ref "
57c0: 20 72 6f 77 6e 20 22 2c 22 20 30 20 22 3d 22 20 rown "," 0 "="
57d0: 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 (sparse-array-re
57e0: 66 20 76 65 63 20 72 6f 77 6e 20 30 29 29 0a 09 f vec rown 0))..
57f0: 09 09 20 20 20 20 20 20 29 29 0a 09 09 09 28 69 .. ))....(i
5800: 66 20 28 6e 6f 74 20 63 75 72 72 72 6f 77 6e 29 f (not currrown)
5810: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
5820: 20 72 6f 77 6e 61 6d 65 73 20 76 61 72 6e 61 6d rownames varnam
5830: 65 20 72 6f 77 6e 29 29 0a 09 09 09 28 69 66 20 e rown))....(if
5840: 28 6e 6f 74 20 63 75 72 72 63 6f 6c 6e 29 28 68 (not currcoln)(h
5850: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 63 ash-table-set! c
5860: 6f 6c 6e 61 6d 65 73 20 73 65 63 74 69 6f 6e 6e olnames sectionn
5870: 61 6d 65 20 63 6f 6c 6e 29 29 0a 09 09 09 3b 3b ame coln))....;;
5880: 20 28 70 72 69 6e 74 20 22 64 61 74 3d 22 20 64 (print "dat=" d
5890: 61 74 20 22 2c 20 72 6f 77 6e 3d 22 20 72 6f 77 at ", rown=" row
58a0: 6e 20 22 2c 20 63 6f 6c 6e 3d 22 20 63 6f 6c 6e n ", coln=" coln
58b0: 29 0a 09 09 09 28 73 70 61 72 73 65 2d 61 72 72 )....(sparse-arr
58c0: 61 79 2d 73 65 74 21 20 76 65 63 20 72 6f 77 6e ay-set! vec rown
58d0: 20 63 6f 6c 6e 20 76 61 6c 29 0a 09 09 09 3b 3b coln val)....;;
58e0: 20 28 70 72 69 6e 74 20 22 73 70 61 72 73 65 2d (print "sparse-
58f0: 61 72 72 61 79 2d 72 65 66 20 22 20 72 6f 77 6e array-ref " rown
5900: 20 22 2c 22 20 63 6f 6c 6e 20 22 3d 22 20 28 73 "," coln "=" (s
5910: 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 parse-array-ref
5920: 76 65 63 20 72 6f 77 6e 20 63 6f 6c 6e 29 29 0a vec rown coln)).
5930: 09 09 09 29 29 29 0a 09 09 20 20 20 28 66 6f 72 ...)))... (for
5940: 2d 65 61 63 68 0a 09 09 20 20 20 20 28 6c 61 6d -each... (lam
5950: 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 29 0a bda (sheetname).
5960: 09 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 .. (let* ((
5970: 73 68 65 65 74 64 61 74 20 28 67 65 74 2d 64 61 sheetdat (get-da
5980: 74 20 72 65 73 75 6c 74 73 20 73 68 65 65 74 6e t results sheetn
5990: 61 6d 65 29 29 0a 09 09 09 20 20 20 20 20 28 73 ame)).... (s
59a0: 76 65 63 20 20 20 20 20 28 72 65 66 64 62 3a 63 vec (refdb:c
59b0: 73 76 2d 67 65 74 2d 73 76 65 63 20 73 68 65 65 sv-get-svec shee
59c0: 74 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 tdat)).... (
59d0: 6d 61 78 72 6f 77 20 20 20 28 72 65 66 64 62 3a maxrow (refdb:
59e0: 63 73 76 2d 67 65 74 2d 6d 61 78 72 6f 77 20 73 csv-get-maxrow s
59f0: 68 65 65 74 64 61 74 29 29 0a 09 09 09 20 20 20 heetdat))....
5a00: 20 20 28 6d 61 78 63 6f 6c 20 20 20 28 72 65 66 (maxcol (ref
5a10: 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 63 6f db:csv-get-maxco
5a20: 6c 20 73 68 65 65 74 64 61 74 29 29 0a 09 09 09 l sheetdat))....
5a30: 20 20 20 20 20 28 66 6e 61 6d 65 20 20 20 20 28 (fname (
5a40: 69 66 20 6f 75 74 2d 66 69 6c 65 20 0a 09 09 09 if out-file ....
5a50: 09 09 20 20 20 28 73 74 72 69 6e 67 2d 73 75 62 .. (string-sub
5a60: 73 74 69 74 75 74 65 20 22 25 73 22 20 73 68 65 stitute "%s" she
5a70: 65 74 6e 61 6d 65 20 6f 75 74 2d 66 69 6c 65 29 etname out-file)
5a80: 20 3b 3b 20 22 2f 66 6f 6f 2f 62 61 72 2f 25 73 ;; "/foo/bar/%s
5a90: 2e 63 73 76 22 29 0a 09 09 09 09 09 20 20 20 28 .csv")...... (
5aa0: 63 6f 6e 63 20 73 68 65 65 74 6e 61 6d 65 20 22 conc sheetname "
5ab0: 2e 63 73 76 22 29 29 29 29 0a 09 09 09 28 77 69 .csv"))))....(wi
5ac0: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
5ad0: 65 20 66 6e 61 6d 65 0a 09 09 09 20 20 28 6c 61 e fname.... (la
5ae0: 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 20 3b mbda ().... ;
5af0: 3b 20 28 70 72 69 6e 74 20 22 53 68 65 65 74 6e ; (print "Sheetn
5b00: 61 6d 65 3a 20 22 20 73 68 65 65 74 6e 61 6d 65 ame: " sheetname
5b10: 29 0a 09 09 09 20 20 20 20 28 6c 65 74 20 6c 6f ).... (let lo
5b20: 6f 70 20 28 28 72 6f 77 20 20 20 20 20 20 20 30 op ((row 0
5b30: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 63 6f )..... (co
5b40: 6c 20 20 20 20 20 20 20 30 29 0a 09 09 09 09 20 l 0).....
5b50: 20 20 20 20 20 20 28 63 75 72 72 2d 72 6f 77 20 (curr-row
5b60: 27 28 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 '()).....
5b70: 28 72 65 73 75 6c 74 20 20 20 27 28 29 29 29 0a (result '())).
5b80: 09 09 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 ... (let* (
5b90: 28 76 61 6c 20 28 73 70 61 72 73 65 2d 61 72 72 (val (sparse-arr
5ba0: 61 79 2d 72 65 66 20 73 76 65 63 20 72 6f 77 20 ay-ref svec row
5bb0: 63 6f 6c 29 29 0a 09 09 09 09 20 20 20 20 20 28 col))..... (
5bc0: 64 69 73 70 2d 76 61 6c 20 28 69 66 20 76 61 6c disp-val (if val
5bd0: 0a 09 09 09 09 09 09 20 20 20 28 63 6f 6e 63 20 ....... (conc
5be0: 22 5c 22 22 20 76 61 6c 20 22 5c 22 22 29 0a 09 "\"" val "\"")..
5bf0: 09 09 09 09 09 20 20 20 22 22 29 29 29 0a 09 09 ..... "")))...
5c00: 09 09 28 69 66 20 28 3e 20 63 6f 6c 20 30 29 28 ..(if (> col 0)(
5c10: 64 69 73 70 6c 61 79 20 22 2c 22 29 29 0a 09 09 display ","))...
5c20: 09 09 28 64 69 73 70 6c 61 79 20 64 69 73 70 2d ..(display disp-
5c30: 76 61 6c 29 0a 09 09 09 09 28 63 6f 6e 64 0a 09 val).....(cond..
5c40: 09 09 09 20 28 28 3e 20 72 6f 77 20 6d 61 78 72 ... ((> row maxr
5c50: 6f 77 29 28 64 69 73 70 6c 61 79 20 22 5c 6e 22 ow)(display "\n"
5c60: 29 20 72 65 73 75 6c 74 29 0a 09 09 09 09 20 28 ) result)..... (
5c70: 28 3e 3d 20 63 6f 6c 20 6d 61 78 63 6f 6c 29 0a (>= col maxcol).
5c80: 09 09 09 09 20 20 28 64 69 73 70 6c 61 79 20 22 .... (display "
5c90: 5c 6e 22 29 0a 09 09 09 09 20 20 28 6c 6f 6f 70 \n")..... (loop
5ca0: 20 28 2b 20 72 6f 77 20 31 29 20 30 20 27 28 29 (+ row 1) 0 '()
5cb0: 20 28 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 (append result
5cc0: 28 6c 69 73 74 20 63 75 72 72 2d 72 6f 77 29 29 (list curr-row))
5cd0: 29 29 0a 09 09 09 09 20 28 65 6c 73 65 0a 09 09 ))..... (else...
5ce0: 09 09 20 20 28 6c 6f 6f 70 20 72 6f 77 20 28 2b .. (loop row (+
5cf0: 20 63 6f 6c 20 31 29 20 28 61 70 70 65 6e 64 20 col 1) (append
5d00: 63 75 72 72 2d 72 6f 77 20 28 6c 69 73 74 20 76 curr-row (list v
5d10: 61 6c 29 29 20 72 65 73 75 6c 74 29 29 29 29 29 al)) result)))))
5d20: 29 29 29 29 0a 09 09 20 20 20 20 28 68 61 73 68 ))))... (hash
5d30: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 65 73 75 -table-keys resu
5d40: 6c 74 73 29 29 29 29 0a 09 09 28 28 73 71 6c 69 lts))))...((sqli
5d50: 74 65 33 29 0a 09 09 20 28 6c 65 74 2a 20 28 28 te3)... (let* ((
5d60: 64 62 2d 66 69 6c 65 20 20 20 28 6f 72 20 6f 75 db-file (or ou
5d70: 74 2d 66 69 6c 65 20 28 70 61 74 68 6e 61 6d 65 t-file (pathname
5d80: 2d 66 69 6c 65 20 69 6e 70 75 74 2d 64 62 29 29 -file input-db))
5d90: 29 0a 09 09 09 28 64 62 2d 65 78 69 73 74 73 20 )....(db-exists
5da0: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 62 (file-exists? db
5db0: 2d 66 69 6c 65 29 29 0a 09 09 09 28 64 62 20 20 -file))....(db
5dc0: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 6f (sqlite3:o
5dd0: 70 65 6e 2d 64 61 74 61 62 61 73 65 20 64 62 2d pen-database db-
5de0: 66 69 6c 65 29 29 29 0a 09 09 20 20 20 28 69 66 file)))... (if
5df0: 20 28 6e 6f 74 20 64 62 2d 65 78 69 73 74 73 29 (not db-exists)
5e00: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
5e10: 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42 4c db "CREATE TABL
5e20: 45 20 64 61 74 61 20 28 73 68 65 65 74 2c 73 65 E data (sheet,se
5e30: 63 74 69 6f 6e 2c 76 61 72 2c 76 61 6c 29 3b 22 ction,var,val);"
5e40: 29 29 0a 09 09 20 20 20 28 63 6f 6e 66 69 67 66 ))... (configf
5e50: 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c :map-all-hier-al
5e60: 69 73 74 0a 09 09 20 20 20 20 64 61 74 61 0a 09 ist... data..
5e70: 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 68 . (lambda (sh
5e80: 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e eetname sectionn
5e90: 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 ame varname val)
5ea0: 0a 09 09 20 20 20 20 20 20 28 73 71 6c 69 74 65 ... (sqlite
5eb0: 33 3a 65 78 65 63 75 74 65 20 64 62 0a 09 09 09 3:execute db....
5ec0: 09 20 20 20 20 20 20 20 22 49 4e 53 45 52 54 20 . "INSERT
5ed0: 4f 52 20 52 45 50 4c 41 43 45 20 49 4e 54 4f 20 OR REPLACE INTO
5ee0: 64 61 74 61 20 28 73 68 65 65 74 2c 73 65 63 74 data (sheet,sect
5ef0: 69 6f 6e 2c 76 61 72 2c 76 61 6c 29 20 56 41 4c ion,var,val) VAL
5f00: 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 29 3b 22 0a UES (?,?,?,?);".
5f10: 09 09 09 09 20 20 20 20 20 20 20 73 68 65 65 74 .... sheet
5f20: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 name sectionname
5f30: 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 29 29 0a varname val))).
5f40: 09 09 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 .. (sqlite3:fi
5f50: 6e 61 6c 69 7a 65 21 20 64 62 29 29 29 0a 09 09 nalize! db)))...
5f60: 28 65 6c 73 65 0a 09 09 20 28 70 70 20 64 61 74 (else... (pp dat
5f70: 61 29 29 29 29 29 29 0a 20 20 20 20 20 20 28 69 a)))))). (i
5f80: 66 20 6f 75 74 2d 66 69 6c 65 20 28 63 6c 6f 73 f out-file (clos
5f90: 65 2d 6f 75 74 70 75 74 2d 70 6f 72 74 20 6f 75 e-output-port ou
5fa0: 74 2d 70 6f 72 74 29 29 0a 20 20 20 20 20 20 28 t-port)). (
5fb0: 65 78 69 74 29 20 3b 3b 20 79 65 73 2c 20 62 65 exit) ;; yes, be
5fc0: 6e 64 69 6e 67 20 74 68 65 20 72 75 6c 65 73 20 nding the rules
5fd0: 68 65 72 65 20 2d 20 6e 65 65 64 20 74 6f 20 65 here - need to e
5fe0: 78 69 74 20 73 69 6e 63 65 20 74 68 69 73 20 69 xit since this i
5ff0: 73 20 61 20 75 74 69 6c 69 74 79 0a 20 20 20 20 s a utility.
6000: 20 20 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a ))..(if (args:
6010: 67 65 74 2d 61 72 67 20 22 2d 70 69 6e 67 22 29 get-arg "-ping")
6020: 0a 20 20 20 20 28 6c 65 74 2a 20 28 3b 3b 20 28 . (let* (;; (
6030: 72 75 6e 2d 69 64 20 20 20 20 20 20 20 20 28 73 run-id (s
6040: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 tring->number (a
6050: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
6060: 6e 2d 69 64 22 29 29 29 0a 09 20 20 20 28 68 6f n-id"))).. (ho
6070: 73 74 3a 70 6f 72 74 20 20 20 20 20 28 61 72 67 st:port (arg
6080: 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 69 6e 67 s:get-arg "-ping
6090: 22 29 29 29 0a 20 20 20 20 20 20 28 73 65 72 76 "))). (serv
60a0: 65 72 3a 70 69 6e 67 20 68 6f 73 74 3a 70 6f 72 er:ping host:por
60b0: 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
60c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
60d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
60e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
60f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
6100: 3b 20 43 61 70 74 75 72 65 2c 20 73 61 76 65 20 ; Capture, save
6110: 61 6e 64 20 6d 61 6e 69 70 75 6c 61 74 65 20 65 and manipulate e
6120: 6e 76 69 72 6f 6e 6d 65 6e 74 73 0a 3b 3b 3d 3d nvironments.;;==
6130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6170: 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 4b ====..;; NOTE: K
6180: 65 65 70 20 74 68 65 73 65 20 61 62 6f 76 65 20 eep these above
6190: 74 68 65 20 73 65 63 74 69 6f 6e 20 77 68 65 72 the section wher
61a0: 65 20 74 68 65 20 73 65 72 76 65 72 20 6f 72 20 e the server or
61b0: 63 6c 69 65 6e 74 20 63 6f 64 65 20 69 73 20 73 client code is s
61c0: 65 74 75 70 0a 0a 28 6c 65 74 20 28 28 65 6e 76 etup..(let ((env
61d0: 63 61 70 20 28 61 72 67 73 3a 67 65 74 2d 61 72 cap (args:get-ar
61e0: 67 20 22 2d 65 6e 76 63 61 70 22 29 29 29 0a 20 g "-envcap"))).
61f0: 20 28 69 66 20 65 6e 76 63 61 70 0a 20 20 20 20 (if envcap.
6200: 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 20 (let* ((db
6210: 20 20 28 65 6e 76 3a 6f 70 65 6e 2d 64 62 20 28 (env:open-db (
6220: 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 if (null? remarg
6230: 73 29 20 22 65 6e 76 64 61 74 2e 64 62 22 20 28 s) "envdat.db" (
6240: 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 29 29 car remargs)))))
6250: 0a 09 28 65 6e 76 3a 73 61 76 65 2d 65 6e 76 2d ..(env:save-env-
6260: 76 61 72 73 20 64 62 20 65 6e 76 63 61 70 29 0a vars db envcap).
6270: 09 28 65 6e 76 3a 63 6c 6f 73 65 2d 64 61 74 61 .(env:close-data
6280: 62 61 73 65 20 64 62 29 0a 09 28 73 65 74 21 20 base db)..(set!
6290: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
62a0: 74 29 29 29 29 0a 0a 3b 3b 20 64 65 6c 74 61 20 t))))..;; delta
62b0: 22 6c 61 6e 67 75 61 67 65 22 20 77 69 6c 6c 20 "language" will
62c0: 65 76 65 6e 74 75 61 6c 6c 79 20 62 65 20 72 65 eventually be re
62d0: 73 3d 61 2b 62 2d 63 20 62 75 74 20 66 6f 72 20 s=a+b-c but for
62e0: 6e 6f 77 20 69 74 20 69 73 20 6a 75 73 74 20 72 now it is just r
62f0: 65 73 3d 61 2d 62 20 0a 3b 3b 0a 28 6c 65 74 20 es=a-b .;;.(let
6300: 28 28 65 6e 76 64 65 6c 74 61 20 28 61 72 67 73 ((envdelta (args
6310: 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 64 65 :get-arg "-envde
6320: 6c 74 61 22 29 29 29 0a 20 20 28 69 66 20 65 6e lta"))). (if en
6330: 76 64 65 6c 74 61 0a 20 20 20 20 20 20 28 6c 65 vdelta. (le
6340: 74 20 28 28 6d 61 74 63 68 20 28 73 74 72 69 6e t ((match (strin
6350: 67 2d 73 70 6c 69 74 20 65 6e 76 64 65 6c 74 61 g-split envdelta
6360: 20 22 2d 22 29 29 29 3b 3b 20 28 73 74 72 69 6e "-")));; (strin
6370: 67 2d 6d 61 74 63 68 20 22 28 5b 61 2d 7a 30 2d g-match "([a-z0-
6380: 39 5f 5d 2b 29 3d 28 5b 61 2d 7a 30 2d 39 5f 5c 9_]+)=([a-z0-9_\
6390: 5c 2d 2c 5d 2b 29 22 20 65 6e 76 64 65 6c 74 61 \-,]+)" envdelta
63a0: 29 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 6e )))..(if (not (n
63b0: 75 6c 6c 3f 20 6d 61 74 63 68 29 29 0a 09 20 20 ull? match))..
63c0: 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 20 (let* ((db
63d0: 20 20 20 20 28 65 6e 76 3a 6f 70 65 6e 2d 64 62 (env:open-db
63e0: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 (if (null? rema
63f0: 72 67 73 29 20 22 65 6e 76 64 61 74 2e 64 62 22 rgs) "envdat.db"
6400: 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 (car remargs)))
6410: 29 0a 09 09 20 20 20 3b 3b 20 28 72 65 73 63 74 )... ;; (resct
6420: 78 20 20 20 20 28 63 61 64 72 20 6d 61 74 63 68 x (cadr match
6430: 29 29 0a 09 09 20 20 20 3b 3b 20 28 65 71 75 6e ))... ;; (equn
6440: 20 20 20 20 20 20 28 63 61 64 64 72 20 6d 61 74 (caddr mat
6450: 63 68 29 29 0a 09 09 20 20 20 28 70 61 72 74 73 ch))... (parts
6460: 20 20 20 20 20 6d 61 74 63 68 29 20 3b 3b 20 28 match) ;; (
6470: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 65 71 75 string-split equ
6480: 6e 20 22 2d 22 29 29 0a 09 09 20 20 20 28 6d 69 n "-"))... (mi
6490: 6e 75 65 6e 64 20 20 20 28 63 61 72 20 70 61 72 nuend (car par
64a0: 74 73 29 29 0a 09 09 20 20 20 28 73 75 62 74 72 ts))... (subtr
64b0: 61 65 6e 64 20 28 63 61 64 72 20 70 61 72 74 73 aend (cadr parts
64c0: 29 29 0a 09 09 20 20 20 28 61 64 64 65 64 20 20 ))... (added
64d0: 20 20 20 28 65 6e 76 3a 67 65 74 2d 61 64 64 65 (env:get-adde
64e0: 64 20 20 20 64 62 20 6d 69 6e 75 65 6e 64 20 73 d db minuend s
64f0: 75 62 74 72 61 65 6e 64 29 29 0a 09 09 20 20 20 ubtraend))...
6500: 28 72 65 6d 6f 76 65 64 20 20 20 28 65 6e 76 3a (removed (env:
6510: 67 65 74 2d 72 65 6d 6f 76 65 64 20 64 62 20 6d get-removed db m
6520: 69 6e 75 65 6e 64 20 73 75 62 74 72 61 65 6e 64 inuend subtraend
6530: 29 29 0a 09 09 20 20 20 28 63 68 61 6e 67 65 64 ))... (changed
6540: 20 20 20 28 65 6e 76 3a 67 65 74 2d 63 68 61 6e (env:get-chan
6550: 67 65 64 20 64 62 20 6d 69 6e 75 65 6e 64 20 73 ged db minuend s
6560: 75 62 74 72 61 65 6e 64 29 29 29 0a 09 20 20 20 ubtraend)))..
6570: 20 20 20 3b 3b 20 28 70 70 20 28 68 61 73 68 2d ;; (pp (hash-
6580: 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 61 64 64 table->alist add
6590: 65 64 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 ed)).. ;; (
65a0: 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e pp (hash-table->
65b0: 61 6c 69 73 74 20 72 65 6d 6f 76 65 64 29 29 0a alist removed)).
65c0: 09 20 20 20 20 20 20 3b 3b 20 28 70 70 20 28 68 . ;; (pp (h
65d0: 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 ash-table->alist
65e0: 20 63 68 61 6e 67 65 64 29 29 0a 09 20 20 20 20 changed))..
65f0: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
6600: 61 72 67 20 22 2d 6f 22 29 0a 09 09 20 20 28 77 arg "-o")... (w
6610: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 ith-output-to-fi
6620: 6c 65 0a 09 09 20 20 20 20 20 20 28 61 72 67 73 le... (args
6630: 3a 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 0a 09 :get-arg "-o")..
6640: 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a . (lambda ().
6650: 09 09 20 20 20 20 20 20 28 65 6e 76 3a 70 72 69 .. (env:pri
6660: 6e 74 20 61 64 64 65 64 20 72 65 6d 6f 76 65 64 nt added removed
6670: 20 63 68 61 6e 67 65 64 29 29 29 0a 09 09 20 20 changed)))...
6680: 28 65 6e 76 3a 70 72 69 6e 74 20 61 64 64 65 64 (env:print added
6690: 20 72 65 6d 6f 76 65 64 20 63 68 61 6e 67 65 64 removed changed
66a0: 29 29 0a 09 20 20 20 20 20 20 28 65 6e 76 3a 63 )).. (env:c
66b0: 6c 6f 73 65 2d 64 61 74 61 62 61 73 65 20 64 62 lose-database db
66c0: 29 0a 09 20 20 20 20 20 20 28 73 65 74 21 20 2a ).. (set! *
66d0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
66e0: 29 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 )).. (debug:p
66f0: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
6700: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
6710: 22 50 61 72 61 6d 65 74 65 72 20 74 6f 20 2d 65 "Parameter to -e
6720: 6e 76 64 65 6c 74 61 20 73 68 6f 75 6c 64 20 62 nvdelta should b
6730: 65 20 6e 65 77 3d 73 74 61 72 2d 65 6e 64 22 29 e new=star-end")
6740: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
6750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
6790: 3b 20 53 74 61 72 74 20 74 68 65 20 73 65 72 76 ; Start the serv
67a0: 65 72 20 2d 20 63 61 6e 20 62 65 20 64 6f 6e 65 er - can be done
67b0: 20 69 6e 20 63 6f 6e 6a 75 6e 63 74 69 6f 6e 20 in conjunction
67c0: 77 69 74 68 20 2d 72 75 6e 61 6c 6c 20 6f 72 20 with -runall or
67d0: 2d 72 75 6e 74 65 73 74 73 20 28 6f 6e 65 20 64 -runtests (one d
67e0: 61 79 2e 2e 2e 29 0a 3b 3b 20 20 20 77 65 20 73 ay...).;; we s
67f0: 74 61 72 74 20 74 68 65 20 73 65 72 76 65 72 20 tart the server
6800: 69 66 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 65 if not running e
6810: 6c 73 65 20 73 74 61 72 74 20 74 68 65 20 63 6c lse start the cl
6820: 69 65 6e 74 20 74 68 72 65 61 64 0a 3b 3b 3d 3d ient thread.;;==
6830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6870: 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
6880: 67 65 74 2d 61 72 67 20 22 2d 73 65 72 76 65 72 get-arg "-server
6890: 22 29 0a 0a 20 20 20 20 3b 3b 20 53 65 72 76 65 ").. ;; Serve
68a0: 72 3f 20 53 74 61 72 74 20 75 70 20 68 65 72 65 r? Start up here
68b0: 2e 0a 20 20 20 20 3b 3b 0a 20 20 20 20 28 6c 65 .. ;;. (le
68c0: 74 20 28 28 74 6c 20 20 20 20 20 20 20 20 28 6c t ((tl (l
68d0: 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 aunch:setup))..
68e0: 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 6e 64 (run-id (and
68f0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6900: 2d 72 75 6e 2d 69 64 22 29 0a 09 09 09 20 20 28 -run-id").... (
6910: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
6920: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
6930: 75 6e 2d 69 64 22 29 29 29 29 0a 20 20 20 20 20 un-id")))).
6940: 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 2d (transport-
6950: 74 79 70 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 type (string->sy
6960: 6d 62 6f 6c 20 28 6f 72 20 28 61 72 67 73 3a 67 mbol (or (args:g
6970: 65 74 2d 61 72 67 20 22 2d 74 72 61 6e 73 70 6f et-arg "-transpo
6980: 72 74 22 29 20 22 68 74 74 70 22 29 29 29 29 0a rt") "http")))).
6990: 20 20 20 20 20 20 28 69 66 20 72 75 6e 2d 69 64 (if run-id
69a0: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
69b0: 28 73 65 72 76 65 72 3a 6c 61 75 6e 63 68 20 72 (server:launch r
69c0: 75 6e 2d 69 64 20 74 72 61 6e 73 70 6f 72 74 2d un-id transport-
69d0: 74 79 70 65 29 0a 09 20 20 20 20 28 73 65 74 21 type).. (set!
69e0: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
69f0: 23 74 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 #t)).. (debug:p
6a00: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
6a10: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
6a20: 22 73 65 72 76 65 72 20 72 65 71 75 69 72 65 73 "server requires
6a30: 20 72 75 6e 2d 69 64 20 62 65 20 73 70 65 63 69 run-id be speci
6a40: 66 69 65 64 20 77 69 74 68 20 2d 72 75 6e 2d 69 fied with -run-i
6a50: 64 22 29 29 29 0a 0a 20 20 20 20 3b 3b 20 4e 6f d"))).. ;; No
6a60: 74 20 61 20 73 65 72 76 65 72 3f 20 54 68 69 73 t a server? This
6a70: 20 73 65 63 74 69 6f 6e 20 77 69 6c 6c 20 64 65 section will de
6a80: 63 69 64 65 20 68 6f 77 20 74 6f 20 63 6f 6d 6d cide how to comm
6a90: 75 6e 69 63 61 74 65 0a 20 20 20 20 3b 3b 0a 20 unicate. ;;.
6aa0: 20 20 20 3b 3b 20 20 53 65 74 75 70 20 63 6c 69 ;; Setup cli
6ab0: 65 6e 74 20 66 6f 72 20 61 6c 6c 20 65 78 70 65 ent for all expe
6ac0: 63 74 20 6c 69 73 74 65 64 20 68 65 72 65 0a 20 ct listed here.
6ad0: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 28 6c (if (null? (l
6ae0: 73 65 74 2d 69 6e 74 65 72 73 65 63 74 69 6f 6e set-intersection
6af0: 20 0a 09 09 65 71 75 61 6c 3f 0a 09 09 28 68 61 ...equal?...(ha
6b00: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 61 72 sh-table-keys ar
6b10: 67 73 3a 61 72 67 2d 68 61 73 68 29 0a 09 09 27 gs:arg-hash)...'
6b20: 28 22 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 ("-list-servers"
6b30: 0a 09 09 20 20 22 2d 73 74 6f 70 2d 73 65 72 76 ... "-stop-serv
6b40: 65 72 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 er".
6b50: 20 20 20 20 20 20 22 2d 6b 69 6c 6c 2d 73 65 72 "-kill-ser
6b60: 76 65 72 22 0a 09 09 20 20 22 2d 73 68 6f 77 2d ver"... "-show-
6b70: 63 6d 64 69 6e 66 6f 22 0a 09 09 20 20 22 2d 6c cmdinfo"... "-l
6b80: 69 73 74 2d 72 75 6e 73 22 0a 09 09 20 20 22 2d ist-runs"... "-
6b90: 70 69 6e 67 22 29 29 29 0a 09 28 69 66 20 28 6c ping")))..(if (l
6ba0: 61 75 6e 63 68 3a 73 65 74 75 70 29 0a 09 20 20 aunch:setup)..
6bb0: 20 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 (let ((run-id
6bc0: 20 20 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 (and (args:ge
6bd0: 74 2d 61 72 67 20 22 2d 72 75 6e 2d 69 64 22 29 t-arg "-run-id")
6be0: 0a 09 09 09 09 20 20 28 73 74 72 69 6e 67 2d 3e ..... (string->
6bf0: 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 number (args:get
6c00: 2d 61 72 67 20 22 2d 72 75 6e 2d 69 64 22 29 29 -arg "-run-id"))
6c10: 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 73 ))).. ;; (s
6c20: 65 74 21 20 2a 66 64 62 2a 20 20 20 28 66 69 6c et! *fdb* (fil
6c30: 65 64 62 3a 6f 70 65 6e 2d 64 62 20 28 63 6f 6e edb:open-db (con
6c40: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 64 62 c *toppath* "/db
6c50: 2f 70 61 74 68 73 2e 64 62 22 29 29 29 0a 09 20 /paths.db")))..
6c60: 20 20 20 20 20 3b 3b 20 69 66 20 6e 6f 74 20 6c ;; if not l
6c70: 69 73 74 20 6f 72 20 6b 69 6c 6c 20 74 68 65 6e ist or kill then
6c80: 20 73 74 61 72 74 20 61 20 63 6c 69 65 6e 74 20 start a client
6c90: 28 69 66 20 61 70 70 72 6f 70 72 69 61 74 65 29 (if appropriate)
6ca0: 0a 09 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 .. (if (or
6cb0: 28 61 72 67 73 2d 64 65 66 69 6e 65 64 3f 20 22 (args-defined? "
6cc0: 2d 68 22 20 22 2d 76 65 72 73 69 6f 6e 22 20 22 -h" "-version" "
6cd0: 2d 63 72 65 61 74 65 2d 6d 65 67 61 74 65 73 74 -create-megatest
6ce0: 2d 61 72 65 61 22 20 22 2d 63 72 65 61 74 65 2d -area" "-create-
6cf0: 74 65 73 74 22 29 0a 09 09 20 20 20 20 20 20 28 test")... (
6d00: 65 71 3f 20 28 6c 65 6e 67 74 68 20 28 68 61 73 eq? (length (has
6d10: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 61 72 67 h-table-keys arg
6d20: 73 3a 61 72 67 2d 68 61 73 68 29 29 20 30 29 29 s:arg-hash)) 0))
6d30: 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
6d40: 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c t-info 1 *defaul
6d50: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 65 72 t-log-port* "Ser
6d60: 76 65 72 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 6e ver connection n
6d70: 6f 74 20 6e 65 65 64 65 64 22 29 0a 09 09 20 20 ot needed")...
6d80: 28 62 65 67 69 6e 0a 09 09 20 20 20 20 3b 3b 20 (begin... ;;
6d90: 28 69 66 20 72 75 6e 2d 69 64 20 0a 09 09 20 20 (if run-id ...
6da0: 20 20 3b 3b 20 20 20 20 20 28 63 6c 69 65 6e 74 ;; (client
6db0: 3a 6c 61 75 6e 63 68 20 72 75 6e 2d 69 64 29 20 :launch run-id)
6dc0: 0a 09 09 20 20 20 20 3b 3b 20 20 20 20 20 28 63 ... ;; (c
6dd0: 6c 69 65 6e 74 3a 6c 61 75 6e 63 68 20 30 29 20 lient:launch 0)
6de0: 20 20 20 20 20 3b 3b 20 77 69 74 68 6f 75 74 20 ;; without
6df0: 72 75 6e 2d 69 64 20 77 65 27 6c 6c 20 73 74 61 run-id we'll sta
6e00: 72 74 20 61 20 73 65 72 76 65 72 20 66 6f 72 20 rt a server for
6e10: 22 30 22 0a 09 09 20 20 20 20 23 74 0a 09 09 20 "0"... #t...
6e20: 20 20 20 29 29 29 29 29 29 0a 0a 28 69 66 20 28 ))))))..(if (
6e30: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
6e40: 20 22 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 "-list-servers"
6e50: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
6e60: 20 22 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 29 "-stop-server")
6e70: 0a 20 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 . (args:g
6e80: 65 74 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 et-arg "-kill-se
6e90: 72 76 65 72 22 29 29 0a 20 20 20 20 28 6c 65 74 rver")). (let
6ea0: 20 28 28 74 6c 20 28 6c 61 75 6e 63 68 3a 73 65 ((tl (launch:se
6eb0: 74 75 70 29 29 29 0a 20 20 20 20 20 20 28 69 66 tup))). (if
6ec0: 20 74 6c 20 0a 09 20 20 28 6c 65 74 2a 20 28 28 tl .. (let* ((
6ed0: 74 64 62 64 61 74 20 20 28 74 61 73 6b 73 3a 6f tdbdat (tasks:o
6ee0: 70 65 6e 2d 64 62 29 29 0a 09 09 20 28 73 65 72 pen-db))... (ser
6ef0: 76 65 72 73 20 28 74 61 73 6b 73 3a 67 65 74 2d vers (tasks:get-
6f00: 61 6c 6c 2d 73 65 72 76 65 72 73 20 28 64 62 3a all-servers (db:
6f10: 64 65 6c 61 79 2d 69 66 2d 62 75 73 79 20 74 64 delay-if-busy td
6f20: 62 64 61 74 29 29 29 0a 09 09 20 28 66 6d 74 73 bdat)))... (fmts
6f30: 74 72 20 20 22 7e 35 61 7e 31 32 61 7e 38 61 7e tr "~5a~12a~8a~
6f40: 32 30 61 7e 32 34 61 7e 31 30 61 7e 31 30 61 7e 20a~24a~10a~10a~
6f50: 31 30 61 7e 31 30 61 5c 6e 22 29 0a 09 09 20 28 10a~10a\n")... (
6f60: 73 65 72 76 65 72 73 2d 74 6f 2d 6b 69 6c 6c 20 servers-to-kill
6f70: 27 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 '()).
6f80: 20 20 20 20 20 20 28 6b 69 6c 6c 2d 73 77 69 74 (kill-swit
6f90: 63 68 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 ch (if (args:ge
6fa0: 74 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 72 t-arg "-kill-ser
6fb0: 76 65 72 22 29 20 22 2d 39 22 20 22 22 29 29 0a ver") "-9" "")).
6fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fd0: 20 28 6b 69 6c 6c 69 6e 66 6f 20 20 20 28 6f 72 (killinfo (or
6fe0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6ff0: 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 29 20 28 -stop-server") (
7000: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6b args:get-arg "-k
7010: 69 6c 6c 2d 73 65 72 76 65 72 22 29 20 29 29 0a ill-server") )).
7020: 09 09 20 28 6b 68 6f 73 74 2d 70 6f 72 74 20 28 .. (khost-port (
7030: 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 69 66 20 if killinfo (if
7040: 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 (substring-index
7050: 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f 29 28 73 ":" killinfo)(s
7060: 74 72 69 6e 67 2d 73 70 6c 69 74 20 22 3a 22 29 tring-split ":")
7070: 20 23 66 29 20 23 66 29 29 0a 09 09 20 28 73 69 #f) #f))... (si
7080: 64 20 20 20 20 20 20 20 20 28 69 66 20 6b 69 6c d (if kil
7090: 6c 69 6e 66 6f 20 28 69 66 20 28 73 75 62 73 74 linfo (if (subst
70a0: 72 69 6e 67 2d 69 6e 64 65 78 20 22 3a 22 20 6b ring-index ":" k
70b0: 69 6c 6c 69 6e 66 6f 29 20 23 66 20 28 73 74 72 illinfo) #f (str
70c0: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 6b 69 6c 6c ing->number kill
70d0: 69 6e 66 6f 29 29 20 23 66 29 29 29 0a 09 20 20 info)) #f)))..
70e0: 20 20 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 (format #t fmt
70f0: 73 74 72 20 22 49 64 22 20 22 4d 54 76 65 72 22 str "Id" "MTver"
7100: 20 22 50 69 64 22 20 22 48 6f 73 74 22 20 22 49 "Pid" "Host" "I
7110: 6e 74 65 72 66 61 63 65 3a 4f 75 74 50 6f 72 74 nterface:OutPort
7120: 22 20 22 49 6e 50 6f 72 74 22 20 22 4c 61 73 74 " "InPort" "Last
7130: 42 65 61 74 22 20 22 53 74 61 74 65 22 20 22 54 Beat" "State" "T
7140: 72 61 6e 73 70 6f 72 74 22 29 0a 09 20 20 20 20 ransport")..
7150: 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 74 (format #t fmtst
7160: 72 20 22 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 r "==" "=====" "
7170: 3d 3d 3d 22 20 22 3d 3d 3d 3d 22 20 22 3d 3d 3d ===" "====" "===
7180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 20 =============="
7190: 22 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d "======" "======
71a0: 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d ==" "=====" "===
71b0: 3d 3d 3d 3d 3d 3d 22 29 0a 09 20 20 20 20 28 66 ======").. (f
71c0: 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 28 or-each .. (
71d0: 6c 61 6d 62 64 61 20 28 73 65 72 76 65 72 29 0a lambda (server).
71e0: 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 . (let* ((
71f0: 69 64 20 20 20 20 20 20 20 20 20 28 76 65 63 74 id (vect
7200: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 30 29 or-ref server 0)
7210: 29 0a 09 09 20 20 20 20 20 20 28 70 69 64 20 20 )... (pid
7220: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re
7230: 66 20 73 65 72 76 65 72 20 31 29 29 0a 09 09 20 f server 1))...
7240: 20 20 20 20 20 28 68 6f 73 74 6e 61 6d 65 20 20 (hostname
7250: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
7260: 76 65 72 20 32 29 29 0a 09 09 20 20 20 20 20 20 ver 2))...
7270: 28 69 6e 74 65 72 66 61 63 65 20 20 28 76 65 63 (interface (vec
7280: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 33 tor-ref server 3
7290: 29 29 20 0a 09 09 20 20 20 20 20 20 28 70 75 6c )) ... (pul
72a0: 6c 70 6f 72 74 20 20 20 28 76 65 63 74 6f 72 2d lport (vector-
72b0: 72 65 66 20 73 65 72 76 65 72 20 34 29 29 0a 09 ref server 4))..
72c0: 09 20 20 20 20 20 20 28 70 75 62 70 6f 72 74 20 . (pubport
72d0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
72e0: 65 72 76 65 72 20 35 29 29 0a 09 09 20 20 20 20 erver 5))...
72f0: 20 20 28 73 74 61 72 74 2d 74 69 6d 65 20 28 76 (start-time (v
7300: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
7310: 20 36 29 29 0a 09 09 20 20 20 20 20 20 28 70 72 6))... (pr
7320: 69 6f 72 69 74 79 20 20 20 28 76 65 63 74 6f 72 iority (vector
7330: 2d 72 65 66 20 73 65 72 76 65 72 20 37 29 29 0a -ref server 7)).
7340: 09 09 20 20 20 20 20 20 28 73 74 61 74 65 20 20 .. (state
7350: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
7360: 73 65 72 76 65 72 20 38 29 29 0a 09 09 20 20 20 server 8))...
7370: 20 20 20 28 6d 74 2d 76 65 72 20 20 20 20 20 28 (mt-ver (
7380: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
7390: 72 20 39 29 29 0a 09 09 20 20 20 20 20 20 28 6c r 9))... (l
73a0: 61 73 74 2d 75 70 64 61 74 65 20 28 76 65 63 74 ast-update (vect
73b0: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 30 or-ref server 10
73c0: 29 29 20 0a 09 09 20 20 20 20 20 20 28 74 72 61 )) ... (tra
73d0: 6e 73 70 6f 72 74 20 20 28 76 65 63 74 6f 72 2d nsport (vector-
73e0: 72 65 66 20 73 65 72 76 65 72 20 31 31 29 29 0a ref server 11)).
73f0: 09 09 20 20 20 20 20 20 28 6b 69 6c 6c 65 64 20 .. (killed
7400: 20 20 20 20 23 66 29 0a 09 09 20 20 20 20 20 20 #f)...
7410: 28 73 74 61 74 75 73 20 20 20 20 20 28 3c 20 6c (status (< l
7420: 61 73 74 2d 75 70 64 61 74 65 20 32 30 29 29 29 ast-update 20)))
7430: 0a 09 09 20 3b 3b 20 20 20 28 7a 6d 71 2d 73 6f ... ;; (zmq-so
7440: 63 6b 65 74 73 20 28 69 66 20 73 74 61 74 75 73 ckets (if status
7450: 20 28 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d (server:client-
7460: 63 6f 6e 6e 65 63 74 20 68 6f 73 74 6e 61 6d 65 connect hostname
7470: 20 70 6f 72 74 29 20 23 66 29 29 29 0a 09 09 20 port) #f)))...
7480: 3b 3b 20 6e 6f 20 6e 65 65 64 20 74 6f 20 6c 6f ;; no need to lo
7490: 67 69 6e 20 61 73 20 73 74 61 74 75 73 20 6f 66 gin as status of
74a0: 20 23 74 20 69 6e 64 69 63 61 74 65 73 20 77 65 #t indicates we
74b0: 20 61 72 65 20 63 6f 6e 6e 65 63 74 69 6e 67 20 are connecting
74c0: 74 6f 20 63 6f 72 72 65 63 74 20 0a 09 09 20 3b to correct ... ;
74d0: 3b 20 73 65 72 76 65 72 0a 09 09 20 28 69 66 20 ; server... (if
74e0: 28 65 71 75 61 6c 3f 20 73 74 61 74 65 20 22 64 (equal? state "d
74f0: 65 61 64 22 29 0a 09 09 20 20 20 20 20 28 69 66 ead")... (if
7500: 20 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 (> last-update
7510: 28 2a 20 32 35 20 36 30 20 36 30 29 29 20 3b 3b (* 25 60 60)) ;;
7520: 20 6b 65 65 70 20 72 65 63 6f 72 64 73 20 61 72 keep records ar
7530: 6f 75 6e 64 20 66 6f 72 20 73 6c 69 67 68 6c 79 ound for slighly
7540: 20 6f 76 65 72 20 61 20 64 61 79 2e 0a 09 09 09 over a day.....
7550: 20 28 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 (tasks:server-d
7560: 65 72 65 67 69 73 74 65 72 20 28 64 62 3a 64 65 eregister (db:de
7570: 6c 61 79 2d 69 66 2d 62 75 73 79 20 74 64 62 64 lay-if-busy tdbd
7580: 61 74 29 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c at) hostname pul
7590: 6c 70 6f 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 lport: pullport
75a0: 70 69 64 3a 20 70 69 64 20 61 63 74 69 6f 6e 3a pid: pid action:
75b0: 20 27 64 65 6c 65 74 65 29 29 0a 09 09 20 20 20 'delete))...
75c0: 20 20 28 69 66 20 28 3e 20 6c 61 73 74 2d 75 70 (if (> last-up
75d0: 64 61 74 65 20 32 30 29 20 20 20 20 20 20 20 20 date 20)
75e0: 3b 3b 20 4d 61 72 6b 20 61 73 20 64 65 61 64 20 ;; Mark as dead
75f0: 69 66 20 6e 6f 74 20 75 70 64 61 74 65 64 20 69 if not updated i
7600: 6e 20 6c 61 73 74 20 32 30 20 73 65 63 6f 6e 64 n last 20 second
7610: 73 0a 09 09 09 20 28 74 61 73 6b 73 3a 73 65 72 s.... (tasks:ser
7620: 76 65 72 2d 64 65 72 65 67 69 73 74 65 72 20 28 ver-deregister (
7630: 64 62 3a 64 65 6c 61 79 2d 69 66 2d 62 75 73 79 db:delay-if-busy
7640: 20 74 64 62 64 61 74 29 20 68 6f 73 74 6e 61 6d tdbdat) hostnam
7650: 65 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 6c 6c e pullport: pull
7660: 70 6f 72 74 20 70 69 64 3a 20 70 69 64 29 29 29 port pid: pid)))
7670: 0a 09 09 20 28 66 6f 72 6d 61 74 20 23 74 20 66 ... (format #t f
7680: 6d 74 73 74 72 20 69 64 20 6d 74 2d 76 65 72 20 mtstr id mt-ver
7690: 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 28 63 6f pid hostname (co
76a0: 6e 63 20 69 6e 74 65 72 66 61 63 65 20 22 3a 22 nc interface ":"
76b0: 20 70 75 6c 6c 70 6f 72 74 29 20 70 75 62 70 6f pullport) pubpo
76c0: 72 74 20 6c 61 73 74 2d 75 70 64 61 74 65 0a 09 rt last-update..
76d0: 09 09 20 28 69 66 20 73 74 61 74 75 73 20 22 61 .. (if status "a
76e0: 6c 69 76 65 22 20 22 64 65 61 64 22 29 20 74 72 live" "dead") tr
76f0: 61 6e 73 70 6f 72 74 29 0a 09 09 20 28 69 66 20 ansport)... (if
7700: 28 6f 72 20 28 65 71 75 61 6c 3f 20 69 64 20 73 (or (equal? id s
7710: 69 64 29 0a 09 09 09 20 28 65 71 75 61 6c 3f 20 id).... (equal?
7720: 73 69 64 20 30 29 29 20 3b 3b 20 6b 69 6c 6c 20 sid 0)) ;; kill
7730: 61 6c 6c 2f 61 6e 79 0a 09 09 20 20 20 20 20 28 all/any... (
7740: 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 20 28 begin... (
7750: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
7760: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
7770: 70 6f 72 74 2a 20 22 41 74 74 65 6d 70 74 69 6e port* "Attemptin
7780: 67 20 74 6f 20 6b 69 6c 6c 20 22 6b 69 6c 6c 2d g to kill "kill-
7790: 73 77 69 74 63 68 22 20 73 65 72 76 65 72 20 77 switch" server w
77a0: 69 74 68 20 70 69 64 20 22 20 70 69 64 29 0a 09 ith pid " pid)..
77b0: 09 20 20 20 20 20 20 20 28 74 61 73 6b 73 3a 6b . (tasks:k
77c0: 69 6c 6c 2d 73 65 72 76 65 72 20 68 6f 73 74 6e ill-server hostn
77d0: 61 6d 65 20 70 69 64 20 6b 69 6c 6c 2d 73 77 69 ame pid kill-swi
77e0: 74 63 68 3a 20 6b 69 6c 6c 2d 73 77 69 74 63 68 tch: kill-switch
77f0: 29 29 29 29 29 0a 09 20 20 20 20 20 73 65 72 76 ))))).. serv
7800: 65 72 73 29 0a 09 20 20 20 20 28 64 65 62 75 67 ers).. (debug
7810: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 :print-info 1 *d
7820: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
7830: 20 22 44 6f 6e 65 20 77 69 74 68 20 6c 69 73 74 "Done with list
7840: 73 65 72 76 65 72 73 22 29 0a 09 20 20 20 20 28 servers").. (
7850: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
7860: 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 28 65 78 ng* #t).. (ex
7870: 69 74 29 29 20 3b 3b 20 6d 75 73 74 20 64 6f 2c it)) ;; must do,
7880: 20 77 6f 75 6c 64 20 68 61 76 65 20 74 6f 20 61 would have to a
7890: 64 64 20 63 68 65 63 6b 73 20 74 6f 20 6d 61 6e dd checks to man
78a0: 79 2f 61 6c 6c 20 63 61 6c 6c 73 20 62 65 6c 6f y/all calls belo
78b0: 77 0a 09 20 20 28 65 78 69 74 29 29 29 29 0a 0a w.. (exit))))..
78c0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
78d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7900: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 57 65 69 72 ========.;; Weir
7910: 64 20 73 70 65 63 69 61 6c 20 63 61 6c 6c 73 20 d special calls
7920: 74 68 61 74 20 6e 65 65 64 20 74 6f 20 72 75 6e that need to run
7930: 20 2a 61 66 74 65 72 2a 20 74 68 65 20 73 65 72 *after* the ser
7940: 76 65 72 20 68 61 73 20 73 74 61 72 74 65 64 3f ver has started?
7950: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
7960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
79a0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
79b0: 69 73 74 2d 74 61 72 67 65 74 73 22 29 0a 20 20 ist-targets").
79c0: 20 20 28 6c 65 74 20 28 28 74 61 72 67 65 74 73 (let ((targets
79d0: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 72 75 6e (common:get-run
79e0: 63 6f 6e 66 69 67 2d 74 61 72 67 65 74 73 29 29 config-targets))
79f0: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
7a00: 72 69 6e 74 20 31 20 2a 64 65 66 61 75 6c 74 2d rint 1 *default-
7a10: 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 6f 75 6e 64 log-port* "Found
7a20: 20 22 28 6c 65 6e 67 74 68 20 74 61 72 67 65 74 "(length target
7a30: 73 29 20 22 20 74 61 72 67 65 74 73 22 29 0a 20 s) " targets").
7a40: 20 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 (case (stri
7a50: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 20 28 ng->symbol (or (
7a60: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
7a70: 75 6d 70 6d 6f 64 65 22 29 20 22 61 6c 69 73 74 umpmode") "alist
7a80: 22 29 29 0a 09 28 28 61 6c 69 73 74 29 0a 09 20 "))..((alist)..
7a90: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
7aa0: 61 20 28 78 29 0a 09 09 20 20 20 20 20 3b 3b 20 a (x)... ;;
7ab0: 28 70 72 69 6e 74 20 22 5b 22 20 78 20 22 5d 22 (print "[" x "]"
7ac0: 29 29 0a 09 09 20 20 20 20 20 28 70 72 69 6e 74 ))... (print
7ad0: 20 78 29 29 0a 09 09 20 20 20 74 61 72 67 65 74 x))... target
7ae0: 73 29 29 0a 09 28 28 6a 73 6f 6e 29 0a 09 20 28 s))..((json).. (
7af0: 6a 73 6f 6e 2d 77 72 69 74 65 20 74 61 72 67 65 json-write targe
7b00: 74 73 29 29 0a 09 28 65 6c 73 65 0a 09 20 28 64 ts))..(else.. (d
7b10: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
7b20: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
7b30: 70 6f 72 74 2a 20 22 64 75 6d 70 20 6f 75 74 70 port* "dump outp
7b40: 75 74 20 66 6f 72 6d 61 74 20 22 20 28 61 72 67 ut format " (arg
7b50: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
7b60: 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 73 75 70 mode") " not sup
7b70: 70 6f 72 74 65 64 20 66 6f 72 20 2d 6c 69 73 74 ported for -list
7b80: 2d 74 61 72 67 65 74 73 22 29 29 29 0a 20 20 20 -targets"))).
7b90: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
7ba0: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b ething* #t)))..;
7bb0: 3b 20 63 61 63 68 65 20 74 68 65 20 72 75 6e 63 ; cache the runc
7bc0: 6f 6e 66 69 67 73 20 69 6e 20 24 4d 54 5f 4c 49 onfigs in $MT_LI
7bd0: 4e 4b 54 52 45 45 2f 24 4d 54 5f 54 41 52 47 45 NKTREE/$MT_TARGE
7be0: 54 2f 24 4d 54 5f 52 55 4e 4e 41 4d 45 2f 2e 72 T/$MT_RUNNAME/.r
7bf0: 75 6e 63 6f 6e 66 69 67 0a 3b 3b 0a 28 64 65 66 unconfig.;;.(def
7c00: 69 6e 65 20 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e ine (full-runcon
7c10: 66 69 67 73 2d 72 65 61 64 29 0a 3b 3b 20 69 6e figs-read).;; in
7c20: 20 74 68 65 20 65 6e 76 70 72 6f 63 65 73 73 69 the envprocessi
7c30: 6e 67 20 62 72 61 6e 63 68 20 74 68 65 20 62 65 ng branch the be
7c40: 6c 6f 77 20 63 6f 64 65 20 72 65 70 6c 61 63 65 low code replace
7c50: 73 20 74 68 65 20 66 75 72 74 68 65 72 20 62 65 s the further be
7c60: 6c 6f 77 20 63 6f 64 65 0a 3b 3b 20 20 28 69 66 low code.;; (if
7c70: 20 28 65 71 3f 20 2a 63 6f 6e 66 69 67 73 74 61 (eq? *configsta
7c80: 74 75 73 2a 20 27 66 75 6c 6c 64 61 74 61 29 0a tus* 'fulldata).
7c90: 3b 3b 20 20 20 20 20 20 2a 72 75 6e 63 6f 6e 66 ;; *runconf
7ca0: 69 67 64 61 74 2a 0a 3b 3b 20 20 20 20 20 20 28 igdat*.;; (
7cb0: 62 65 67 69 6e 0a 3b 3b 09 28 6c 61 75 6e 63 68 begin.;;.(launch
7cc0: 3a 73 65 74 75 70 29 0a 3b 3b 09 2a 72 75 6e 63 :setup).;;.*runc
7cd0: 6f 6e 66 69 67 64 61 74 2a 29 29 29 0a 0a 20 20 onfigdat*)))..
7ce0: 28 6c 65 74 2a 20 28 28 72 75 6e 64 69 72 20 28 (let* ((rundir (
7cf0: 69 66 20 28 61 6e 64 20 28 67 65 74 65 6e 76 20 if (and (getenv
7d00: 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 29 28 67 "MT_LINKTREE")(g
7d10: 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 etenv "MT_TARGET
7d20: 22 29 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 ")(getenv "MT_RU
7d30: 4e 4e 41 4d 45 22 29 29 0a 09 09 20 20 20 20 20 NNAME"))...
7d40: 28 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 22 4d (conc (getenv "M
7d50: 54 5f 4c 49 4e 4b 54 52 45 45 22 29 20 22 2f 22 T_LINKTREE") "/"
7d60: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 (getenv "MT_TAR
7d70: 47 45 54 22 29 20 22 2f 22 20 28 67 65 74 65 6e GET") "/" (geten
7d80: 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 29 29 v "MT_RUNNAME"))
7d90: 0a 09 09 20 20 20 20 20 23 66 29 29 0a 09 20 28 ... #f)).. (
7da0: 63 66 67 66 20 20 20 28 69 66 20 72 75 6e 64 69 cfgf (if rundi
7db0: 72 20 28 63 6f 6e 63 20 72 75 6e 64 69 72 20 22 r (conc rundir "
7dc0: 2f 2e 72 75 6e 63 6f 6e 66 69 67 2e 22 20 6d 65 /.runconfig." me
7dd0: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 gatest-version "
7de0: 2d 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 -" megatest-foss
7df0: 69 6c 2d 68 61 73 68 29 20 23 66 29 29 29 0a 20 il-hash) #f))).
7e00: 20 20 20 28 69 66 20 28 61 6e 64 20 63 66 67 66 (if (and cfgf
7e10: 0a 09 20 20 20 20 20 28 66 69 6c 65 2d 65 78 69 .. (file-exi
7e20: 73 74 73 3f 20 63 66 67 66 29 0a 09 20 20 20 20 sts? cfgf)..
7e30: 20 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 (file-write-acc
7e40: 65 73 73 3f 20 63 66 67 66 29 29 0a 09 28 63 6f ess? cfgf))..(co
7e50: 6e 66 69 67 66 3a 72 65 61 64 2d 61 6c 69 73 74 nfigf:read-alist
7e60: 20 63 66 67 66 29 0a 09 28 6c 65 74 2a 20 28 28 cfgf)..(let* ((
7e70: 6b 65 79 73 20 20 20 28 72 6d 74 3a 67 65 74 2d keys (rmt:get-
7e80: 6b 65 79 73 29 29 0a 09 20 20 20 20 20 20 20 28 keys)).. (
7e90: 74 61 72 67 65 74 20 28 63 6f 6d 6d 6f 6e 3a 61 target (common:a
7ea0: 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 29 rgs-get-target))
7eb0: 0a 09 20 20 20 20 20 20 20 28 6b 65 79 2d 76 61 .. (key-va
7ec0: 6c 73 20 28 69 66 20 74 61 72 67 65 74 20 28 6b ls (if target (k
7ed0: 65 79 73 3a 74 61 72 67 65 74 2d 3e 6b 65 79 76 eys:target->keyv
7ee0: 61 6c 20 6b 65 79 73 20 74 61 72 67 65 74 29 20 al keys target)
7ef0: 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 73 65 #f)).. (se
7f00: 63 74 69 6f 6e 73 20 28 69 66 20 74 61 72 67 65 ctions (if targe
7f10: 74 20 28 6c 69 73 74 20 22 64 65 66 61 75 6c 74 t (list "default
7f20: 22 20 74 61 72 67 65 74 29 20 23 66 29 29 0a 09 " target) #f))..
7f30: 20 20 20 20 20 20 20 28 64 61 74 61 20 20 20 20 (data
7f40: 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 28 73 (begin.... (s
7f50: 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 etenv "MT_RUN_AR
7f60: 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 EA_HOME" *toppat
7f70: 68 2a 29 0a 09 09 09 20 20 20 28 69 66 20 6b 65 h*).... (if ke
7f80: 79 2d 76 61 6c 73 0a 09 09 09 20 20 20 20 20 20 y-vals....
7f90: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
7fa0: 64 61 20 28 6b 74 29 0a 09 09 09 09 09 20 20 20 da (kt)......
7fb0: 28 73 65 74 65 6e 76 20 28 63 61 72 20 6b 74 29 (setenv (car kt)
7fc0: 20 28 63 61 64 72 20 6b 74 29 29 29 0a 09 09 09 (cadr kt)))....
7fd0: 09 09 20 6b 65 79 2d 76 61 6c 73 29 29 0a 09 09 .. key-vals))...
7fe0: 09 20 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 . (read-config
7ff0: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
8000: 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f "/runconfigs.co
8010: 6e 66 69 67 22 29 20 23 66 20 23 74 20 73 65 63 nfig") #f #t sec
8020: 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f 6e 73 29 tions: sections)
8030: 29 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 ))).. (if (and
8040: 72 75 6e 64 69 72 20 3b 3b 20 68 61 76 65 20 61 rundir ;; have a
8050: 6c 6c 20 6e 65 65 64 65 64 20 76 61 72 69 61 62 ll needed variab
8060: 6c 65 73 73 0a 09 09 20 20 20 28 64 69 72 65 63 less... (direc
8070: 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 72 75 6e tory-exists? run
8080: 64 69 72 29 0a 09 09 20 20 20 28 66 69 6c 65 2d dir)... (file-
8090: 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 72 75 write-access? ru
80a0: 6e 64 69 72 29 29 0a 09 20 20 20 20 20 20 28 62 ndir)).. (b
80b0: 65 67 69 6e 0a 09 09 28 63 6f 6e 66 69 67 66 3a egin...(configf:
80c0: 77 72 69 74 65 2d 61 6c 69 73 74 20 64 61 74 61 write-alist data
80d0: 20 63 66 67 66 29 0a 09 09 3b 3b 20 66 6f 72 63 cfgf)...;; forc
80e0: 65 20 72 65 2d 72 65 61 64 20 6f 66 20 6d 65 67 e re-read of meg
80f0: 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 2d 20 74 atest.config - t
8100: 68 69 73 20 72 65 73 6f 6c 76 65 73 20 63 69 72 his resolves cir
8110: 63 75 6c 61 72 20 72 65 66 65 72 65 6e 63 65 73 cular references
8120: 20 62 65 74 77 65 65 6e 20 6d 65 67 61 74 65 73 between megates
8130: 74 2e 63 6f 6e 66 69 67 0a 09 09 28 6c 61 75 6e t.config...(laun
8140: 63 68 3a 73 65 74 75 70 20 66 6f 72 63 65 3a 20 ch:setup force:
8150: 23 74 29 0a 09 09 28 6c 61 75 6e 63 68 3a 63 61 #t)...(launch:ca
8160: 63 68 65 2d 63 6f 6e 66 69 67 29 29 29 20 3b 3b che-config))) ;;
8170: 20 77 65 20 63 61 6e 20 73 61 66 65 6c 79 20 63 we can safely c
8180: 61 63 68 65 20 6d 65 67 61 74 65 73 74 2e 63 6f ache megatest.co
8190: 6e 66 69 67 20 73 69 6e 63 65 20 77 65 20 68 61 nfig since we ha
81a0: 76 65 20 61 20 76 61 6c 69 64 20 72 75 6e 63 6f ve a valid runco
81b0: 6e 66 69 67 0a 09 20 20 64 61 74 61 29 29 29 29 nfig.. data))))
81c0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
81d0: 61 72 67 20 22 2d 73 68 6f 77 2d 72 75 6e 63 6f arg "-show-runco
81e0: 6e 66 69 67 22 29 0a 20 20 20 20 28 6c 65 74 20 nfig"). (let
81f0: 28 28 74 6c 20 28 6c 61 75 6e 63 68 3a 73 65 74 ((tl (launch:set
8200: 75 70 29 29 29 0a 20 20 20 20 20 20 28 70 75 73 up))). (pus
8210: 68 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 h-directory *top
8220: 70 61 74 68 2a 29 0a 20 20 20 20 20 20 28 6c 65 path*). (le
8230: 74 20 28 28 64 61 74 61 20 28 66 75 6c 6c 2d 72 t ((data (full-r
8240: 75 6e 63 6f 6e 66 69 67 73 2d 72 65 61 64 29 29 unconfigs-read))
8250: 29 0a 09 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 )..;; keep this
8260: 6f 6e 65 20 6c 6f 63 61 6c 0a 09 28 63 6f 6e 64 one local..(cond
8270: 0a 09 20 28 28 61 6e 64 20 28 61 72 67 73 3a 67 .. ((and (args:g
8280: 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e et-arg "-section
8290: 22 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 ").. (args
82a0: 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 :get-arg "-var")
82b0: 29 0a 09 20 20 28 6c 65 74 20 28 28 76 61 6c 20 ).. (let ((val
82c0: 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (or (configf:loo
82d0: 6b 75 70 20 64 61 74 61 20 28 61 72 67 73 3a 67 kup data (args:g
82e0: 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e et-arg "-section
82f0: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
8300: 22 2d 76 61 72 22 29 29 0a 09 09 09 20 28 63 6f "-var")).... (co
8310: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 nfigf:lookup dat
8320: 61 20 22 64 65 66 61 75 6c 74 22 20 28 61 72 67 a "default" (arg
8330: 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 s:get-arg "-var"
8340: 29 29 29 29 29 0a 09 20 20 20 20 28 69 66 20 76 ))))).. (if v
8350: 61 6c 20 28 70 72 69 6e 74 20 76 61 6c 29 29 29 al (print val)))
8360: 29 0a 09 20 28 28 6e 6f 74 20 28 61 72 67 73 3a ).. ((not (args:
8370: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
8380: 64 65 22 29 29 0a 09 20 20 28 70 70 20 28 68 61 de")).. (pp (ha
8390: 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 sh-table->alist
83a0: 64 61 74 61 29 29 29 0a 09 20 28 28 73 74 72 69 data))).. ((stri
83b0: 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 ng=? (args:get-a
83c0: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 rg "-dumpmode")
83d0: 22 6a 73 6f 6e 22 29 0a 09 20 20 28 6a 73 6f 6e "json").. (json
83e0: 2d 77 72 69 74 65 20 64 61 74 61 29 29 0a 09 20 -write data))..
83f0: 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 ((string=? (args
8400: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
8410: 6f 64 65 22 29 20 22 69 6e 69 22 29 0a 09 20 20 ode") "ini")..
8420: 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 69 67 2d (configf:config-
8430: 3e 69 6e 69 20 64 61 74 61 29 29 0a 09 20 28 65 >ini data)).. (e
8440: 6c 73 65 0a 09 20 20 28 64 65 62 75 67 3a 70 72 lse.. (debug:pr
8450: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
8460: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
8470: 2d 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 -dumpmode of " (
8480: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
8490: 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 umpmode") " not
84a0: 72 65 63 6f 67 6e 69 73 65 64 22 29 29 29 0a 09 recognised")))..
84b0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
84c0: 69 6e 67 2a 20 23 74 29 29 0a 20 20 20 20 20 20 ing* #t)).
84d0: 28 70 6f 70 2d 64 69 72 65 63 74 6f 72 79 29 29 (pop-directory))
84e0: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
84f0: 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 6f 6e 66 -arg "-show-conf
8500: 69 67 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 ig"). (let ((
8510: 74 6c 20 20 20 28 6c 61 75 6e 63 68 3a 73 65 74 tl (launch:set
8520: 75 70 29 29 0a 09 20 20 28 64 61 74 61 20 2a 63 up)).. (data *c
8530: 6f 6e 66 69 67 64 61 74 2a 29 29 20 3b 3b 20 28 onfigdat*)) ;; (
8540: 72 65 61 64 2d 63 6f 6e 66 69 67 20 22 6d 65 67 read-config "meg
8550: 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 20 23 66 atest.config" #f
8560: 20 23 74 29 29 29 0a 20 20 20 20 20 20 28 70 75 #t))). (pu
8570: 73 68 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f sh-directory *to
8580: 70 70 61 74 68 2a 29 0a 20 20 20 20 20 20 3b 3b ppath*). ;;
8590: 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c keep this one l
85a0: 6f 63 61 6c 0a 20 20 20 20 20 20 28 63 6f 6e 64 ocal. (cond
85b0: 20 0a 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 . ((and (
85c0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
85d0: 65 63 74 69 6f 6e 22 29 0a 09 20 20 20 20 20 28 ection").. (
85e0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 args:get-arg "-v
85f0: 61 72 22 29 29 0a 09 28 6c 65 74 20 28 28 76 61 ar"))..(let ((va
8600: 6c 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 l (configf:looku
8610: 70 20 64 61 74 61 20 28 61 72 67 73 3a 67 65 74 p data (args:get
8620: 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 -arg "-section")
8630: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8640: 76 61 72 22 29 29 29 29 0a 09 20 20 28 69 66 20 var")))).. (if
8650: 76 61 6c 20 28 70 72 69 6e 74 20 76 61 6c 29 29 val (print val))
8660: 29 29 0a 0a 20 20 20 20 20 20 20 3b 3b 20 70 72 )).. ;; pr
8670: 69 6e 74 20 6a 75 73 74 20 61 20 73 65 63 74 69 int just a secti
8680: 6f 6e 20 69 66 20 6f 6e 6c 79 20 2d 73 65 63 74 on if only -sect
8690: 69 6f 6e 0a 0a 20 20 20 20 20 20 20 28 28 6e 6f ion.. ((no
86a0: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
86b0: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 29 0a 09 28 "-dumpmode"))..(
86c0: 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e pp (hash-table->
86d0: 61 6c 69 73 74 20 64 61 74 61 29 29 29 0a 20 20 alist data))).
86e0: 20 20 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 ((string=?
86f0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8700: 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e dumpmode") "json
8710: 22 29 0a 09 28 6a 73 6f 6e 2d 77 72 69 74 65 20 ")..(json-write
8720: 64 61 74 61 29 29 0a 20 20 20 20 20 20 20 28 28 data)). ((
8730: 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 string=? (args:g
8740: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
8750: 65 22 29 20 22 69 6e 69 22 29 0a 09 28 63 6f 6e e") "ini")..(con
8760: 66 69 67 66 3a 63 6f 6e 66 69 67 2d 3e 69 6e 69 figf:config->ini
8770: 20 64 61 74 61 29 29 0a 20 20 20 20 20 20 20 28 data)). (
8780: 65 6c 73 65 0a 09 28 64 65 62 75 67 3a 70 72 69 else..(debug:pri
8790: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
87a0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d ult-log-port* "-
87b0: 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 61 dumpmode of " (a
87c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
87d0: 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 72 mpmode") " not r
87e0: 65 63 6f 67 6e 69 73 65 64 22 29 29 29 0a 20 20 ecognised"))).
87f0: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
8800: 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 20 20 20 mething* #t).
8810: 20 20 20 28 70 6f 70 2d 64 69 72 65 63 74 6f 72 (pop-director
8820: 79 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a y)))..(if (args:
8830: 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 get-arg "-show-c
8840: 6d 64 69 6e 66 6f 22 29 0a 20 20 20 20 28 69 66 mdinfo"). (if
8850: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
8860: 72 67 20 22 3a 76 61 6c 75 65 22 29 28 67 65 74 rg ":value")(get
8870: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
8880: 29 29 0a 09 28 6c 65 74 20 28 28 64 61 74 61 20 ))..(let ((data
8890: 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 (common:read-enc
88a0: 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 6f 72 20 oded-string (or
88b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
88c0: 76 61 6c 75 65 22 29 28 67 65 74 65 6e 76 20 22 value")(getenv "
88d0: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 MT_CMDINFO")))))
88e0: 0a 09 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 .. (if (equal?
88f0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8900: 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e dumpmode") "json
8910: 22 29 0a 09 20 20 20 20 20 20 28 6a 73 6f 6e 2d ").. (json-
8920: 77 72 69 74 65 20 64 61 74 61 29 0a 09 20 20 20 write data)..
8930: 20 20 20 28 70 70 20 64 61 74 61 29 29 0a 09 20 (pp data))..
8940: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
8950: 68 69 6e 67 2a 20 23 74 29 29 0a 09 28 64 65 62 hing* #t))..(deb
8960: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
8970: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
8980: 74 2a 20 22 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 t* "environment
8990: 76 61 72 69 61 62 6c 65 20 4d 54 5f 43 4d 44 49 variable MT_CMDI
89a0: 4e 46 4f 20 69 73 20 6e 6f 74 20 73 65 74 22 29 NFO is not set")
89b0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
89c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
89d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
89e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
89f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
8a00: 52 65 6d 6f 76 65 20 6f 6c 64 20 72 75 6e 28 73 Remove old run(s
8a10: 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ).;;============
8a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 ==========..;; s
8a60: 69 6e 63 65 20 73 65 76 65 72 61 6c 20 61 63 74 ince several act
8a70: 69 6f 6e 73 20 63 61 6e 20 62 65 20 73 70 65 63 ions can be spec
8a80: 69 66 69 65 64 20 6f 6e 20 74 68 65 20 63 6f 6d ified on the com
8a90: 6d 61 6e 64 20 6c 69 6e 65 20 74 68 65 20 72 65 mand line the re
8aa0: 6d 6f 76 61 6c 0a 3b 3b 20 69 73 20 64 6f 6e 65 moval.;; is done
8ab0: 20 66 69 72 73 74 0a 28 64 65 66 69 6e 65 20 28 first.(define (
8ac0: 6f 70 65 72 61 74 65 2d 6f 6e 20 61 63 74 69 6f operate-on actio
8ad0: 6e 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e n). (let* ((run
8ae0: 72 65 63 20 28 72 75 6e 73 3a 72 75 6e 72 65 63 rec (runs:runrec
8af0: 2d 6d 61 6b 65 2d 72 65 63 6f 72 64 29 29 0a 09 -make-record))..
8b00: 20 28 74 61 72 67 65 74 20 28 63 6f 6d 6d 6f 6e (target (common
8b10: 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 :args-get-target
8b20: 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 ))). (cond.
8b30: 20 20 20 28 28 6e 6f 74 20 74 61 72 67 65 74 29 ((not target)
8b40: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
8b50: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
8b60: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
8b70: 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 Missing required
8b80: 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 parameter for "
8b90: 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d action ", you m
8ba0: 75 73 74 20 73 70 65 63 69 66 79 20 2d 74 61 72 ust specify -tar
8bb0: 67 65 74 20 6f 72 20 2d 72 65 71 74 61 72 67 22 get or -reqtarg"
8bc0: 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 31 29 ). (exit 1)
8bd0: 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 6f 72 ). ((not (or
8be0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8bf0: 3a 72 75 6e 6e 61 6d 65 22 29 0a 09 20 20 20 20 :runname")..
8c00: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
8c10: 20 22 2d 72 75 6e 6e 61 6d 65 22 29 29 29 0a 20 "-runname"))).
8c20: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
8c30: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
8c40: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 lt-log-port* "Mi
8c50: 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 ssing required p
8c60: 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 61 arameter for " a
8c70: 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 ction ", you mus
8c80: 74 20 73 70 65 63 69 66 79 20 74 68 65 20 72 75 t specify the ru
8c90: 6e 20 6e 61 6d 65 20 70 61 74 74 65 72 6e 20 77 n name pattern w
8ca0: 69 74 68 20 2d 72 75 6e 6e 61 6d 65 20 70 61 74 ith -runname pat
8cb0: 74 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 t"). (exit
8cc0: 32 29 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 2)). ((not (
8cd0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
8ce0: 65 73 74 70 61 74 74 22 29 29 0a 20 20 20 20 20 estpatt")).
8cf0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
8d00: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
8d10: 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 69 6e og-port* "Missin
8d20: 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d g required param
8d30: 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f eter for " actio
8d40: 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 n ", you must sp
8d50: 65 63 69 66 79 20 74 68 65 20 74 65 73 74 20 70 ecify the test p
8d60: 61 74 74 65 72 6e 20 77 69 74 68 20 2d 74 65 73 attern with -tes
8d70: 74 70 61 74 74 22 29 0a 20 20 20 20 20 20 28 65 tpatt"). (e
8d80: 78 69 74 20 33 29 29 0a 20 20 20 20 20 28 65 6c xit 3)). (el
8d90: 73 65 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f se. (if (no
8da0: 74 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e t (car *configin
8db0: 66 6f 2a 29 29 0a 09 20 20 28 62 65 67 69 6e 0a fo*)).. (begin.
8dc0: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
8dd0: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
8de0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 41 74 lt-log-port* "At
8df0: 74 65 6d 70 74 65 64 20 22 20 61 63 74 69 6f 6e tempted " action
8e00: 20 22 6f 6e 20 74 65 73 74 28 73 29 20 62 75 74 "on test(s) but
8e10: 20 72 75 6e 20 61 72 65 61 20 63 6f 6e 66 69 67 run area config
8e20: 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 22 file not found"
8e30: 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 ).. (exit 1))
8e40: 0a 09 20 20 3b 3b 20 70 75 74 20 74 65 73 74 20 .. ;; put test
8e50: 70 61 72 61 6d 65 74 65 72 73 20 69 6e 74 6f 20 parameters into
8e60: 63 6f 6e 76 65 6e 69 65 6e 74 20 76 61 72 69 61 convenient varia
8e70: 62 6c 65 73 0a 09 20 20 28 62 65 67 69 6e 0a 09 bles.. (begin..
8e80: 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 66 6f 72 ;; check for
8e90: 20 63 6f 72 72 65 63 74 20 76 65 72 73 69 6f 6e correct version
8ea0: 2c 20 65 78 69 74 20 77 69 74 68 20 6d 65 73 73 , exit with mess
8eb0: 61 67 65 20 69 66 20 6e 6f 74 20 63 6f 72 72 65 age if not corre
8ec0: 63 74 0a 09 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a ct.. (common:
8ed0: 65 78 69 74 2d 6f 6e 2d 76 65 72 73 69 6f 6e 2d exit-on-version-
8ee0: 63 68 61 6e 67 65 64 29 0a 09 20 20 20 20 28 72 changed).. (r
8ef0: 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 20 uns:operate-on
8f00: 61 63 74 69 6f 6e 0a 09 09 09 20 20 20 20 20 20 action....
8f10: 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 20 20 target....
8f20: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
8f30: 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f -runname) ;; (o
8f40: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
8f50: 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 "-runname")(args
8f60: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
8f70: 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 20 28 me")).... (
8f80: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
8f90: 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 testpatt #f) ;;
8fa0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8fb0: 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 testpatt")....
8fc0: 20 20 20 20 73 74 61 74 65 3a 20 28 63 6f 6d 6d state: (comm
8fd0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 73 74 61 74 on:args-get-stat
8fe0: 65 29 0a 09 09 09 20 20 20 20 20 20 73 74 61 74 e).... stat
8ff0: 75 73 3a 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 us: (common:args
9000: 2d 67 65 74 2d 73 74 61 74 75 73 29 0a 09 09 09 -get-status)....
9010: 20 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d new-state-
9020: 73 74 61 74 75 73 3a 20 28 61 72 67 73 3a 67 65 status: (args:ge
9030: 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 74 61 74 t-arg "-set-stat
9040: 65 2d 73 74 61 74 75 73 22 29 29 29 29 0a 20 20 e-status")))).
9050: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
9060: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 29 mething* #t)))))
9070: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
9080: 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e arg "-remove-run
9090: 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c s"). (general
90a0: 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 -run-call .
90b0: 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 0a 20 "-remove-runs".
90c0: 20 20 20 20 22 72 65 6d 6f 76 65 20 72 75 6e 73 "remove runs
90d0: 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ". (lambda (
90e0: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
90f0: 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 eys keyvals).
9100: 20 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 (operate-on
9110: 27 72 65 6d 6f 76 65 2d 72 75 6e 73 29 29 29 29 'remove-runs))))
9120: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
9130: 61 72 67 20 22 2d 73 65 74 2d 73 74 61 74 65 2d arg "-set-state-
9140: 73 74 61 74 75 73 22 29 0a 20 20 20 20 28 67 65 status"). (ge
9150: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
9160: 20 20 20 20 20 22 2d 73 65 74 2d 73 74 61 74 65 "-set-state
9170: 2d 73 74 61 74 75 73 22 0a 20 20 20 20 20 22 73 -status". "s
9180: 65 74 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 et state and sta
9190: 74 75 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 tus". (lambd
91a0: 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
91b0: 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a e keys keyvals).
91c0: 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d (operate-
91d0: 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 on 'set-state-st
91e0: 61 74 75 73 29 29 29 29 0a 0a 28 69 66 20 28 6f atus))))..(if (o
91f0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
9200: 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 "-set-run-status
9210: 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
9220: 67 20 22 2d 67 65 74 2d 72 75 6e 2d 73 74 61 74 g "-get-run-stat
9230: 75 73 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 us")). (gener
9240: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 al-run-call.
9250: 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 "-set-run-statu
9260: 73 22 0a 20 20 20 20 20 22 73 65 74 20 72 75 6e s". "set run
9270: 20 73 74 61 74 75 73 22 0a 20 20 20 20 20 28 6c status". (l
9280: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
9290: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 nname keys keyva
92a0: 6c 73 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a ls). (let*
92b0: 20 28 28 72 75 6e 73 64 61 74 20 20 28 72 6d 74 ((runsdat (rmt
92c0: 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 :get-runs-by-pat
92d0: 74 20 6b 65 79 73 20 72 75 6e 6e 61 6d 65 20 0a t keys runname .
92e0: 09 09 09 09 09 28 63 6f 6d 6d 6f 6e 3a 61 72 67 .....(common:arg
92f0: 73 2d 67 65 74 2d 74 61 72 67 65 74 29 0a 09 09 s-get-target)...
9300: 09 09 09 23 66 20 23 66 20 23 66 20 23 66 29 29 ...#f #f #f #f))
9310: 0a 09 20 20 20 20 20 20 28 68 65 61 64 65 72 20 .. (header
9320: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 (vector-ref ru
9330: 6e 73 64 61 74 20 30 29 29 0a 09 20 20 20 20 20 nsdat 0))..
9340: 20 28 72 6f 77 73 20 20 20 20 20 28 76 65 63 74 (rows (vect
9350: 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 31 or-ref runsdat 1
9360: 29 29 29 0a 09 20 28 69 66 20 28 6e 75 6c 6c 3f ))).. (if (null?
9370: 20 72 6f 77 73 29 0a 09 20 20 20 20 20 28 62 65 rows).. (be
9380: 67 69 6e 0a 09 20 20 20 20 20 20 20 28 64 65 62 gin.. (deb
9390: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
93a0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
93b0: 74 2a 20 22 4e 6f 20 6d 61 74 63 68 69 6e 67 20 t* "No matching
93c0: 72 75 6e 20 66 6f 75 6e 64 2e 22 29 0a 09 20 20 run found.")..
93d0: 20 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 09 (exit 1))..
93e0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 6f 77 (let* ((row
93f0: 20 20 20 20 20 20 28 63 61 72 20 28 76 65 63 74 (car (vect
9400: 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 31 or-ref runsdat 1
9410: 29 29 29 0a 09 09 20 20 20 20 28 72 75 6e 2d 69 )))... (run-i
9420: 64 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 d (db:get-valu
9430: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 6f 77 20 e-by-header row
9440: 68 65 61 64 65 72 20 22 69 64 22 29 29 29 0a 09 header "id")))..
9450: 20 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 (if (args
9460: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 72 :get-arg "-set-r
9470: 75 6e 2d 73 74 61 74 75 73 22 29 0a 09 09 20 20 un-status")...
9480: 20 28 72 6d 74 3a 73 65 74 2d 72 75 6e 2d 73 74 (rmt:set-run-st
9490: 61 74 75 73 20 72 75 6e 2d 69 64 20 28 61 72 67 atus run-id (arg
94a0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
94b0: 72 75 6e 2d 73 74 61 74 75 73 22 29 20 6d 73 67 run-status") msg
94c0: 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 : (args:get-arg
94d0: 22 2d 6d 22 29 29 0a 09 09 20 20 20 28 70 72 69 "-m"))... (pri
94e0: 6e 74 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d nt (rmt:get-run-
94f0: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 29 29 0a status run-id)).
9500: 09 09 20 20 20 29 29 29 29 29 29 29 0a 0a 3b 3b .. )))))))..;;
9510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9550: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 75 65 72 79 20 ======.;; Query
9560: 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d runs.;;=========
9570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
95a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
95b0: 3b 20 2d 66 69 65 6c 64 73 20 72 75 6e 73 3a 69 ; -fields runs:i
95c0: 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 d,target,runname
95d0: 2c 63 6f 6d 6d 65 6e 74 2b 74 65 73 74 73 3a 69 ,comment+tests:i
95e0: 64 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f d,testname,item_
95f0: 70 61 74 68 2b 73 74 65 70 73 0a 3b 3b 0a 3b 3b path+steps.;;.;;
9600: 20 63 73 69 3e 20 28 65 78 74 72 61 63 74 2d 66 csi> (extract-f
9610: 69 65 6c 64 73 2d 63 6f 6e 73 74 72 61 69 6e 74 ields-constraint
9620: 73 20 22 72 75 6e 73 3a 69 64 2c 74 61 72 67 65 s "runs:id,targe
9630: 74 2c 72 75 6e 6e 61 6d 65 2c 63 6f 6d 6d 65 6e t,runname,commen
9640: 74 2b 74 65 73 74 73 3a 69 64 2c 74 65 73 74 6e t+tests:id,testn
9650: 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2b 73 74 ame,item_path+st
9660: 65 70 73 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 eps").;;
9670: 20 3d 3e 20 28 28 22 72 75 6e 73 22 20 22 69 64 => (("runs" "id
9680: 22 20 22 74 61 72 67 65 74 22 20 22 72 75 6e 6e " "target" "runn
9690: 61 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 20 ame" "comment")
96a0: 28 22 74 65 73 74 73 22 20 22 69 64 22 20 22 74 ("tests" "id" "t
96b0: 65 73 74 6e 61 6d 65 22 20 22 69 74 65 6d 5f 70 estname" "item_p
96c0: 61 74 68 22 29 20 28 22 73 74 65 70 73 22 29 29 ath") ("steps"))
96d0: 0a 3b 3b 0a 3b 3b 20 20 20 4e 4f 54 45 3a 20 72 .;;.;; NOTE: r
96e0: 65 6d 65 6d 62 65 72 20 74 68 61 74 20 74 68 65 emember that the
96f0: 20 63 64 72 20 77 69 6c 6c 20 62 65 20 74 68 65 cdr will be the
9700: 20 6c 69 73 74 20 79 6f 75 20 65 78 70 65 63 74 list you expect
9710: 20 28 63 64 72 20 28 22 72 75 6e 73 22 20 22 69 (cdr ("runs" "i
9720: 64 22 20 22 74 61 72 67 65 74 22 20 22 72 75 6e d" "target" "run
9730: 6e 61 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 name" "comment")
9740: 29 20 3d 3e 20 28 22 69 64 22 20 22 74 61 72 67 ) => ("id" "targ
9750: 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 63 et" "runname" "c
9760: 6f 6d 6d 65 6e 74 22 29 0a 3b 3b 20 20 20 20 20 omment").;;
9770: 20 20 20 20 61 6e 64 20 73 6f 20 61 6c 69 73 74 and so alist
9780: 2d 72 65 66 20 77 69 6c 6c 20 79 69 65 6c 64 20 -ref will yield
9790: 77 68 61 74 20 79 6f 75 20 65 78 70 65 63 74 0a what you expect.
97a0: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 65 78 74 72 ;;.(define (extr
97b0: 61 63 74 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 74 act-fields-const
97c0: 72 61 69 6e 74 73 20 66 69 65 6c 64 73 2d 73 70 raints fields-sp
97d0: 65 63 29 0a 20 20 28 6d 61 70 20 28 6c 61 6d 62 ec). (map (lamb
97e0: 64 61 20 28 74 61 62 6c 65 2d 73 70 65 63 29 20 da (table-spec)
97f0: 3b 3b 20 72 75 6e 73 3a 69 64 2c 74 61 72 67 65 ;; runs:id,targe
9800: 74 2c 72 75 6e 6e 61 6d 65 0a 09 20 28 6c 65 74 t,runname.. (let
9810: 20 28 28 64 61 74 20 28 73 74 72 69 6e 67 2d 73 ((dat (string-s
9820: 70 6c 69 74 20 74 61 62 6c 65 2d 73 70 65 63 20 plit table-spec
9830: 22 3a 22 29 29 29 20 3b 3b 20 28 22 72 75 6e 73 ":"))) ;; ("runs
9840: 22 20 22 69 64 2c 74 61 72 67 65 74 2c 72 75 6e " "id,target,run
9850: 6e 61 6d 65 22 29 0a 09 20 20 20 28 69 66 20 28 name").. (if (
9860: 3e 20 28 6c 65 6e 67 74 68 20 64 61 74 29 20 31 > (length dat) 1
9870: 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 ).. (cons
9880: 28 63 61 72 20 64 61 74 29 28 73 74 72 69 6e 67 (car dat)(string
9890: 2d 73 70 6c 69 74 20 28 63 61 64 72 20 64 61 74 -split (cadr dat
98a0: 29 20 22 2c 22 29 29 20 3b 3b 20 22 69 64 2c 74 ) ",")) ;; "id,t
98b0: 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 22 0a 09 arget,runname"..
98c0: 20 20 20 20 20 20 20 64 61 74 29 29 29 0a 20 20 dat))).
98d0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c (string-spl
98e0: 69 74 20 66 69 65 6c 64 73 2d 73 70 65 63 20 22 it fields-spec "
98f0: 2b 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 +")))..(define (
9900: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
9910: 6c 64 6e 61 6d 65 20 64 61 74 61 76 65 63 20 74 ldname datavec t
9920: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
9930: 66 69 65 6c 64 6e 61 6d 65 29 0a 20 20 28 6c 65 fieldname). (le
9940: 74 20 28 28 69 6e 64 78 20 28 68 61 73 68 2d 74 t ((indx (hash-t
9950: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
9960: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
9970: 78 20 66 69 65 6c 64 6e 61 6d 65 20 23 66 29 29 x fieldname #f))
9980: 29 0a 20 20 20 20 28 69 66 20 69 6e 64 78 0a 09 ). (if indx..
9990: 28 69 66 20 28 3e 3d 20 69 6e 64 78 20 28 76 65 (if (>= indx (ve
99a0: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 64 61 74 61 ctor-length data
99b0: 76 65 63 29 29 0a 09 20 20 20 20 23 66 20 3b 3b vec)).. #f ;;
99c0: 20 69 6e 64 65 78 20 74 6f 6f 20 68 69 67 68 2c index too high,
99d0: 20 73 68 6f 75 6c 64 20 72 61 69 73 65 20 61 6e should raise an
99e0: 20 65 72 72 6f 72 20 49 20 73 75 70 70 6f 73 65 error I suppose
99f0: 0a 09 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 .. (vector-re
9a00: 66 20 64 61 74 61 76 65 63 20 69 6e 64 78 29 29 f datavec indx))
9a10: 0a 09 23 66 29 29 29 0a 0a 3b 3b 20 4e 4f 54 45 ..#f)))..;; NOTE
9a20: 3a 20 6c 69 73 74 2d 72 75 6e 73 20 61 6e 64 20 : list-runs and
9a30: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 20 list-db-targets
9a40: 6f 70 65 72 61 74 65 20 6f 6e 20 6c 6f 63 61 6c operate on local
9a50: 20 64 62 21 21 21 0a 3b 3b 0a 3b 3b 20 49 44 45 db!!!.;;.;; IDE
9a60: 41 3a 20 6d 65 67 61 74 65 73 74 20 6c 69 73 74 A: megatest list
9a70: 20 2d 72 75 6e 6e 61 6d 65 20 62 6c 61 68 25 20 -runname blah%
9a80: 2e 2e 2e 0a 3b 3b 0a 28 69 66 20 28 6f 72 20 28 ....;;.(if (or (
9a90: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
9aa0: 69 73 74 2d 72 75 6e 73 22 29 0a 09 28 61 72 67 ist-runs")..(arg
9ab0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
9ac0: 2d 64 62 2d 74 61 72 67 65 74 73 22 29 29 0a 20 -db-targets")).
9ad0: 20 20 20 28 69 66 20 28 6c 61 75 6e 63 68 3a 73 (if (launch:s
9ae0: 65 74 75 70 29 0a 09 28 6c 65 74 2a 20 28 3b 3b etup)..(let* (;;
9af0: 20 28 64 62 73 74 72 75 63 74 20 20 20 20 28 6d (dbstruct (m
9b00: 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 ake-dbr:dbstruct
9b10: 20 70 61 74 68 3a 20 2a 74 6f 70 70 61 74 68 2a path: *toppath*
9b20: 20 6c 6f 63 61 6c 3a 20 28 61 72 67 73 3a 67 65 local: (args:ge
9b30: 74 2d 61 72 67 20 22 2d 6c 6f 63 61 6c 22 29 29 t-arg "-local"))
9b40: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 70 61 ).. (runpa
9b50: 74 74 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 tt (args:get
9b60: 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 -arg "-list-runs
9b70: 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ")).
9b80: 20 20 20 28 61 63 63 65 73 73 2d 6d 6f 64 65 20 (access-mode
9b90: 28 64 62 3a 67 65 74 2d 61 63 63 65 73 73 2d 6d (db:get-access-m
9ba0: 6f 64 65 29 29 0a 09 20 20 20 20 20 20 20 28 74 ode)).. (t
9bb0: 65 73 74 70 61 74 74 20 20 20 20 28 63 6f 6d 6d estpatt (comm
9bc0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
9bd0: 70 61 74 74 20 23 66 29 29 0a 09 20 20 20 20 20 patt #f))..
9be0: 20 20 3b 3b 20 28 69 66 20 28 61 72 67 73 3a 67 ;; (if (args:g
9bf0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
9c00: 74 22 29 20 0a 09 20 20 20 20 20 20 20 3b 3b 20 t") .. ;;
9c10: 20 09 20 20 20 20 20 20 20 20 28 61 72 67 73 3a . (args:
9c20: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
9c30: 74 74 22 29 20 0a 09 20 20 20 20 20 20 20 3b 3b tt") .. ;;
9c40: 20 20 09 20 20 20 20 20 20 20 20 22 25 22 29 29 . "%"))
9c50: 0a 09 20 20 20 20 20 20 20 28 6b 65 79 73 20 20 .. (keys
9c60: 20 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b (rmt:get-k
9c70: 65 79 73 29 29 20 3b 3b 20 28 64 62 3a 67 65 74 eys)) ;; (db:get
9c80: 2d 6b 65 79 73 20 64 62 73 74 72 75 63 74 29 29 -keys dbstruct))
9c90: 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 72 75 6e .. ;; (run
9ca0: 73 64 61 74 20 20 28 64 62 3a 67 65 74 2d 72 75 sdat (db:get-ru
9cb0: 6e 73 20 64 62 73 74 72 75 63 74 20 72 75 6e 70 ns dbstruct runp
9cc0: 61 74 74 20 23 66 20 23 66 20 27 28 29 29 29 0a att #f #f '())).
9cd0: 09 3b 3b 20 28 72 75 6e 73 64 61 74 20 20 20 20 .;; (runsdat
9ce0: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 (rmt:get-runs-b
9cf0: 79 2d 70 61 74 74 20 6b 65 79 73 20 28 6f 72 20 y-patt keys (or
9d00: 72 75 6e 70 61 74 74 20 22 25 22 29 20 28 63 6f runpatt "%") (co
9d10: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 mmon:args-get-ta
9d20: 72 67 65 74 29 20 3b 3b 20 28 64 62 3a 67 65 74 rget) ;; (db:get
9d30: 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 64 62 -runs-by-patt db
9d40: 73 74 72 75 63 74 20 6b 65 79 73 20 28 6f 72 20 struct keys (or
9d50: 72 75 6e 70 61 74 74 20 22 25 22 29 20 28 63 6f runpatt "%") (co
9d60: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 mmon:args-get-ta
9d70: 72 67 65 74 29 0a 09 3b 3b 20 09 09 20 20 20 20 rget)..;; ..
9d80: 20 20 20 20 20 20 20 09 20 23 66 20 23 66 20 27 . #f #f '
9d90: 28 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 ("id" "runname"
9da0: 22 73 74 61 74 65 22 20 22 73 74 61 74 75 73 22 "state" "status"
9db0: 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f "owner" "event_
9dc0: 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 time" "comment")
9dd0: 20 30 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 0)).. (ru
9de0: 6e 73 64 61 74 20 20 20 20 20 28 64 62 3a 64 69 nsdat (db:di
9df0: 73 70 61 74 63 68 2d 71 75 65 72 79 20 61 63 63 spatch-query acc
9e00: 65 73 73 2d 6d 6f 64 65 20 72 6d 74 3a 67 65 74 ess-mode rmt:get
9e10: 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 64 62 -runs-by-patt db
9e20: 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 :get-runs-by-pat
9e30: 74 20 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 61 t keys (or runpa
9e40: 74 74 20 22 25 22 29 20 0a 20 20 20 20 20 20 20 tt "%") .
9e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9e70: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 (common:arg
9e80: 73 2d 67 65 74 2d 74 61 72 67 65 74 29 20 23 66 s-get-target) #f
9e90: 20 23 66 20 27 28 22 69 64 22 20 22 72 75 6e 6e #f '("id" "runn
9ea0: 61 6d 65 22 20 22 73 74 61 74 65 22 20 22 73 74 ame" "state" "st
9eb0: 61 74 75 73 22 20 22 6f 77 6e 65 72 22 20 22 65 atus" "owner" "e
9ec0: 76 65 6e 74 5f 74 69 6d 65 22 20 22 63 6f 6d 6d vent_time" "comm
9ed0: 65 6e 74 22 29 20 30 29 29 0a 09 20 20 20 20 20 ent") 0))..
9ee0: 20 20 28 72 75 6e 73 74 6d 70 20 20 20 20 20 28 (runstmp (
9ef0: 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e 73 db:get-rows runs
9f00: 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 28 68 dat)).. (h
9f10: 65 61 64 65 72 20 20 20 20 20 20 28 64 62 3a 67 eader (db:g
9f20: 65 74 2d 68 65 61 64 65 72 20 72 75 6e 73 64 61 et-header runsda
9f30: 74 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 74 t)).. ;; t
9f40: 68 69 73 20 69 73 20 22 2d 73 69 6e 63 65 22 20 his is "-since"
9f50: 73 75 70 70 6f 72 74 2e 20 54 68 69 73 20 6c 6f support. This lo
9f60: 6f 6b 73 20 61 74 20 6c 61 73 74 20 6d 6f 64 20 oks at last mod
9f70: 74 69 6d 65 73 20 6f 66 20 3c 72 75 6e 2d 69 64 times of <run-id
9f80: 3e 2e 64 62 20 66 69 6c 65 73 0a 09 20 20 20 20 >.db files..
9f90: 20 20 20 3b 3b 20 61 6e 64 20 63 6f 6c 6c 65 63 ;; and collec
9fa0: 74 73 20 74 68 6f 73 65 20 6d 6f 64 69 66 69 65 ts those modifie
9fb0: 64 20 73 69 6e 63 65 20 74 68 65 20 2d 73 69 6e d since the -sin
9fc0: 63 65 20 74 69 6d 65 2e 0a 09 20 20 20 20 20 20 ce time...
9fd0: 20 28 72 75 6e 73 20 20 20 20 20 20 20 20 28 69 (runs (i
9fe0: 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 6e 75 6c f (and (not (nul
9ff0: 6c 3f 20 72 75 6e 73 74 6d 70 29 29 0a 09 09 09 l? runstmp))....
a000: 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d . (args:get-
a010: 61 72 67 20 22 2d 73 69 6e 63 65 22 29 29 0a 09 arg "-since"))..
a020: 09 09 09 28 6c 65 74 20 28 28 63 68 61 6e 67 65 ...(let ((change
a030: 64 2d 69 64 73 20 28 64 62 3a 67 65 74 2d 63 68 d-ids (db:get-ch
a040: 61 6e 67 65 64 2d 72 75 6e 2d 69 64 73 20 28 73 anged-run-ids (s
a050: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 tring->number (a
a060: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 rgs:get-arg "-si
a070: 6e 63 65 22 29 29 29 29 29 0a 09 09 09 09 20 20 nce"))))).....
a080: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 (let loop ((hed
a090: 28 63 61 72 20 72 75 6e 73 74 6d 70 29 29 0a 09 (car runstmp))..
a0a0: 09 09 09 09 20 20 20 20 20 28 74 61 6c 20 28 63 .... (tal (c
a0b0: 64 72 20 72 75 6e 73 74 6d 70 29 29 0a 09 09 09 dr runstmp))....
a0c0: 09 09 20 20 20 20 20 28 72 65 73 20 27 28 29 29 .. (res '())
a0d0: 29 0a 09 09 09 09 20 20 20 20 28 6c 65 74 20 28 )..... (let (
a0e0: 28 6e 65 77 2d 72 65 73 20 28 69 66 20 28 6d 65 (new-res (if (me
a0f0: 6d 62 65 72 20 28 64 62 3a 67 65 74 2d 76 61 6c mber (db:get-val
a100: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 68 65 64 ue-by-header hed
a110: 20 68 65 61 64 65 72 20 22 69 64 22 29 20 63 68 header "id") ch
a120: 61 6e 67 65 64 2d 69 64 73 29 0a 09 09 09 09 09 anged-ids)......
a130: 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 68 65 . (cons he
a140: 64 20 72 65 73 29 0a 09 09 09 09 09 09 20 20 20 d res).......
a150: 20 20 20 20 72 65 73 29 29 29 0a 09 09 09 09 20 res))).....
a160: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
a170: 74 61 6c 29 0a 09 09 09 09 09 20 20 28 72 65 76 tal)...... (rev
a180: 65 72 73 65 20 6e 65 77 2d 72 65 73 29 0a 09 09 erse new-res)...
a190: 09 09 09 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 ... (loop (car
a1a0: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 tal)(cdr tal) ne
a1b0: 77 2d 72 65 73 29 29 29 29 29 0a 09 09 09 09 72 w-res))))).....r
a1c0: 75 6e 73 74 6d 70 29 29 0a 09 20 20 20 20 20 20 unstmp))..
a1d0: 20 28 64 62 2d 74 61 72 67 65 74 73 20 20 28 61 (db-targets (a
a1e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
a1f0: 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 29 29 st-db-targets"))
a200: 0a 09 20 20 20 20 20 20 20 28 73 65 65 6e 20 20 .. (seen
a210: 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 (make-hash
a220: 2d 74 61 62 6c 65 29 29 0a 09 20 20 20 20 20 20 -table))..
a230: 20 28 64 6d 6f 64 65 20 20 20 20 20 20 20 28 6c (dmode (l
a240: 65 74 20 28 28 64 20 28 61 72 67 73 3a 67 65 74 et ((d (args:get
a250: 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 -arg "-dumpmode"
a260: 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 ))).... (if
a270: 20 64 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 d (string->symb
a280: 6f 6c 20 64 29 20 23 66 29 29 29 0a 09 20 20 20 ol d) #f)))..
a290: 20 20 20 20 28 64 61 74 61 20 20 20 20 20 20 20 (data
a2a0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
a2b0: 65 29 29 0a 09 20 20 20 20 20 20 20 28 66 69 65 e)).. (fie
a2c0: 6c 64 73 2d 73 70 65 63 20 28 69 66 20 28 61 72 lds-spec (if (ar
a2d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 66 69 65 gs:get-arg "-fie
a2e0: 6c 64 73 22 29 0a 09 09 09 09 28 65 78 74 72 61 lds").....(extra
a2f0: 63 74 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 74 72 ct-fields-constr
a300: 61 69 6e 74 73 20 28 61 72 67 73 3a 67 65 74 2d aints (args:get-
a310: 61 72 67 20 22 2d 66 69 65 6c 64 73 22 29 29 0a arg "-fields")).
a320: 09 09 09 09 28 6c 69 73 74 20 28 63 6f 6e 73 20 ....(list (cons
a330: 22 72 75 6e 73 22 20 28 61 70 70 65 6e 64 20 6b "runs" (append k
a340: 65 79 73 20 28 6c 69 73 74 20 22 69 64 22 20 22 eys (list "id" "
a350: 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 runname" "state"
a360: 20 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 "status" "owner
a370: 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 22 " "event_time" "
a380: 63 6f 6d 6d 65 6e 74 22 20 22 66 61 69 6c 5f 63 comment" "fail_c
a390: 6f 75 6e 74 22 20 22 70 61 73 73 5f 63 6f 75 6e ount" "pass_coun
a3a0: 74 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 t"))).....
a3b0: 28 63 6f 6e 73 20 22 74 65 73 74 73 22 20 20 64 (cons "tests" d
a3c0: 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 b:test-record-fi
a3d0: 65 6c 64 73 29 20 3b 3b 20 22 69 64 22 20 22 74 elds) ;; "id" "t
a3e0: 65 73 74 6e 61 6d 65 22 20 22 74 65 73 74 5f 70 estname" "test_p
a3f0: 61 74 68 22 29 0a 09 09 09 09 20 20 20 20 20 20 ath").....
a400: 28 6c 69 73 74 20 22 73 74 65 70 73 22 20 22 69 (list "steps" "i
a410: 64 22 20 22 73 74 65 70 6e 61 6d 65 22 29 29 29 d" "stepname")))
a420: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 2d ).. (runs-
a430: 73 70 65 63 20 20 20 28 6c 65 74 20 28 28 72 20 spec (let ((r
a440: 28 61 6c 69 73 74 2d 72 65 66 20 22 72 75 6e 73 (alist-ref "runs
a450: 22 20 20 66 69 65 6c 64 73 2d 73 70 65 63 20 65 " fields-spec e
a460: 71 75 61 6c 3f 29 29 29 20 3b 3b 20 74 68 65 20 qual?))) ;; the
a470: 63 68 65 63 6b 20 69 73 20 6e 6f 77 20 75 6e 6e check is now unn
a480: 65 63 65 73 73 61 72 79 0a 09 09 09 20 20 20 20 ecessary....
a490: 20 20 28 69 66 20 28 61 6e 64 20 72 20 28 6e 6f (if (and r (no
a4a0: 74 20 28 6e 75 6c 6c 3f 20 72 29 29 29 20 72 20 t (null? r))) r
a4b0: 28 6c 69 73 74 20 22 69 64 22 20 29 29 29 29 0a (list "id" )))).
a4c0: 09 20 20 20 20 20 20 20 28 74 65 73 74 73 2d 73 . (tests-s
a4d0: 70 65 63 20 20 28 6c 65 74 20 28 28 74 20 28 61 pec (let ((t (a
a4e0: 6c 69 73 74 2d 72 65 66 20 22 74 65 73 74 73 22 list-ref "tests"
a4f0: 20 66 69 65 6c 64 73 2d 73 70 65 63 20 65 71 75 fields-spec equ
a500: 61 6c 3f 29 29 29 0a 09 09 09 20 20 20 20 20 20 al?)))....
a510: 28 69 66 20 28 61 6e 64 20 74 20 28 6e 75 6c 6c (if (and t (null
a520: 3f 20 74 29 29 20 3b 3b 20 61 6c 6c 20 66 69 65 ? t)) ;; all fie
a530: 6c 64 73 0a 09 09 09 09 20 20 64 62 3a 74 65 73 lds..... db:tes
a540: 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 0a t-record-fields.
a550: 09 09 09 09 20 20 74 29 29 29 0a 09 20 20 20 20 .... t)))..
a560: 20 20 20 28 61 64 6a 2d 74 65 73 74 73 2d 73 70 (adj-tests-sp
a570: 65 63 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 ec (delete-dupli
a580: 63 61 74 65 73 20 28 69 66 20 74 65 73 74 73 2d cates (if tests-
a590: 73 70 65 63 20 28 63 6f 6e 73 20 22 69 64 22 20 spec (cons "id"
a5a0: 74 65 73 74 73 2d 73 70 65 63 29 20 64 62 3a 74 tests-spec) db:t
a5b0: 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 est-record-field
a5c0: 73 29 29 29 20 3b 3b 20 27 28 22 69 64 22 29 29 s))) ;; '("id"))
a5d0: 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 65 70 )).. (step
a5e0: 73 2d 73 70 65 63 20 20 28 61 6c 69 73 74 2d 72 s-spec (alist-r
a5f0: 65 66 20 22 73 74 65 70 73 22 20 66 69 65 6c 64 ef "steps" field
a600: 73 2d 73 70 65 63 20 65 71 75 61 6c 3f 29 29 0a s-spec equal?)).
a610: 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 66 69 . (test-fi
a620: 65 6c 64 2d 69 6e 64 65 78 20 28 6d 61 6b 65 2d eld-index (make-
a630: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 20 hash-table)))..
a640: 20 28 69 66 20 28 61 6e 64 20 74 65 73 74 73 2d (if (and tests-
a650: 73 70 65 63 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f spec (not (null?
a660: 20 74 65 73 74 73 2d 73 70 65 63 29 29 29 20 3b tests-spec))) ;
a670: 3b 20 64 6f 20 73 6f 6d 65 20 76 61 6c 69 64 61 ; do some valida
a680: 74 69 6f 6e 20 61 6e 64 20 70 72 6f 63 65 73 73 tion and process
a690: 69 6e 67 20 6f 66 20 74 68 65 20 74 65 73 74 2d ing of the test-
a6a0: 73 70 65 63 0a 09 20 20 20 20 20 20 28 6c 65 74 spec.. (let
a6b0: 20 28 28 69 6e 76 61 6c 69 64 2d 74 65 73 74 73 ((invalid-tests
a6c0: 2d 73 70 65 63 20 28 66 69 6c 74 65 72 20 28 6c -spec (filter (l
a6d0: 61 6d 62 64 61 20 28 78 29 28 6e 6f 74 20 28 6d ambda (x)(not (m
a6e0: 65 6d 62 65 72 20 78 20 64 62 3a 74 65 73 74 2d ember x db:test-
a6f0: 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 29 29 29 record-fields)))
a700: 20 74 65 73 74 73 2d 73 70 65 63 29 29 29 0a 09 tests-spec)))..
a710: 09 28 69 66 20 28 6e 75 6c 6c 3f 20 69 6e 76 61 .(if (null? inva
a720: 6c 69 64 2d 74 65 73 74 73 2d 73 70 65 63 29 0a lid-tests-spec).
a730: 09 09 20 20 20 20 3b 3b 20 67 65 6e 65 72 61 74 .. ;; generat
a740: 65 20 74 68 65 20 6c 6f 6f 6b 75 70 20 6d 61 70 e the lookup map
a750: 20 74 65 73 74 2d 66 69 65 6c 64 2d 6e 61 6d 65 test-field-name
a760: 20 3d 3e 20 69 6e 64 65 78 2d 6e 75 6d 62 65 72 => index-number
a770: 0a 09 09 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 ... (let loop
a780: 20 28 28 68 65 64 20 28 63 61 72 20 61 64 6a 2d ((hed (car adj-
a790: 74 65 73 74 73 2d 73 70 65 63 29 29 0a 09 09 09 tests-spec))....
a7a0: 20 20 20 20 20 20 20 28 74 61 6c 20 28 63 64 72 (tal (cdr
a7b0: 20 61 64 6a 2d 74 65 73 74 73 2d 73 70 65 63 29 adj-tests-spec)
a7c0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 64 78 ).... (idx
a7d0: 20 30 29 29 0a 09 09 20 20 20 20 20 20 28 68 61 0))... (ha
a7e0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 sh-table-set! te
a7f0: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 68 st-field-index h
a800: 65 64 20 69 64 78 29 0a 09 09 20 20 20 20 20 20 ed idx)...
a810: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
a820: 74 61 6c 29 29 28 6c 6f 6f 70 20 28 63 61 72 20 tal))(loop (car
a830: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 28 2b 20 tal)(cdr tal)(+
a840: 69 64 78 20 31 29 29 29 29 0a 09 09 20 20 20 20 idx 1))))...
a850: 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 28 (begin... (
a860: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
a870: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
a880: 2d 70 6f 72 74 2a 20 22 49 6e 76 61 6c 69 64 20 -port* "Invalid
a890: 74 65 73 74 20 66 69 65 6c 64 73 20 73 70 65 63 test fields spec
a8a0: 69 66 69 65 64 3a 20 22 20 28 73 74 72 69 6e 67 ified: " (string
a8b0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 69 6e 76 -intersperse inv
a8c0: 61 6c 69 64 2d 74 65 73 74 73 2d 73 70 65 63 20 alid-tests-spec
a8d0: 22 2c 20 22 29 29 0a 09 09 20 20 20 20 20 20 28 ", "))... (
a8e0: 65 78 69 74 29 29 29 29 29 0a 0a 09 20 20 3b 3b exit)))))... ;;
a8f0: 20 45 61 63 68 20 72 75 6e 0a 09 20 20 28 66 6f Each run.. (fo
a900: 72 2d 65 61 63 68 20 0a 09 20 20 20 28 6c 61 6d r-each .. (lam
a910: 62 64 61 20 28 72 75 6e 29 0a 09 20 20 20 20 20 bda (run)..
a920: 28 6c 65 74 20 28 28 74 61 72 67 65 74 73 74 72 (let ((targetstr
a930: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
a940: 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 erse (map (lambd
a950: 61 20 28 78 29 0a 09 09 09 09 09 09 09 20 28 64 a (x)........ (d
a960: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
a970: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
a980: 20 78 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 x)).......
a990: 20 20 6b 65 79 73 29 20 22 2f 22 29 29 29 0a 09 keys) "/")))..
a9a0: 20 20 20 20 20 20 20 28 69 66 20 64 62 2d 74 61 (if db-ta
a9b0: 72 67 65 74 73 0a 09 09 20 20 20 28 69 66 20 28 rgets... (if (
a9c0: 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d not (hash-table-
a9d0: 72 65 66 2f 64 65 66 61 75 6c 74 20 73 65 65 6e ref/default seen
a9e0: 20 74 61 72 67 65 74 73 74 72 20 23 66 29 29 0a targetstr #f)).
a9f0: 09 09 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a .. (begin.
aa00: 09 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ... (hash-table-
aa10: 73 65 74 21 20 73 65 65 6e 20 74 61 72 67 65 74 set! seen target
aa20: 73 74 72 20 23 74 29 0a 09 09 09 20 3b 3b 20 28 str #t).... ;; (
aa30: 70 72 69 6e 74 20 22 5b 22 20 74 61 72 67 65 74 print "[" target
aa40: 73 74 72 20 22 5d 22 29 29 29 29 0a 09 09 09 20 str "]"))))....
aa50: 28 69 66 20 28 6e 6f 74 20 64 6d 6f 64 65 29 0a (if (not dmode).
aa60: 09 09 09 20 20 20 20 20 28 70 72 69 6e 74 20 74 ... (print t
aa70: 61 72 67 65 74 73 74 72 29 0a 09 09 09 20 20 20 argetstr)....
aa80: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
aa90: 74 21 20 64 61 74 61 20 22 74 61 72 67 65 74 73 t! data "targets
aaa0: 22 20 28 63 6f 6e 73 20 74 61 72 67 65 74 73 74 " (cons targetst
aab0: 72 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 r (hash-table-re
aac0: 66 2f 64 65 66 61 75 6c 74 20 64 61 74 61 20 22 f/default data "
aad0: 74 61 72 67 65 74 73 22 20 27 28 29 29 29 29 0a targets" '()))).
aae0: 09 09 09 20 20 20 20 20 29 29 29 0a 09 09 20 20 ... )))...
aaf0: 20 28 6c 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 (let* ((run-id
ab00: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
ab10: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
ab20: 64 65 72 20 22 69 64 22 29 29 0a 09 09 09 20 20 der "id"))....
ab30: 28 72 75 6e 6e 61 6d 65 20 28 64 62 3a 67 65 74 (runname (db:get
ab40: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
ab50: 20 72 75 6e 20 68 65 61 64 65 72 20 22 72 75 6e run header "run
ab60: 6e 61 6d 65 22 29 29 20 0a 09 09 09 20 20 28 73 name")) .... (s
ab70: 74 61 74 65 73 20 20 28 73 74 72 69 6e 67 2d 73 tates (string-s
ab80: 70 6c 69 74 20 28 6f 72 20 28 61 72 67 73 3a 67 plit (or (args:g
ab90: 65 74 2d 61 72 67 20 22 2d 73 74 61 74 65 22 29 et-arg "-state")
aba0: 20 22 22 29 20 22 2c 22 29 29 0a 09 09 09 20 20 "") ","))....
abb0: 28 73 74 61 74 75 73 65 73 20 28 73 74 72 69 6e (statuses (strin
abc0: 67 2d 73 70 6c 69 74 20 28 6f 72 20 28 61 72 67 g-split (or (arg
abd0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 s:get-arg "-stat
abe0: 75 73 22 29 20 22 22 29 20 22 2c 22 29 29 0a 09 us") "") ","))..
abf0: 09 09 20 20 28 74 65 73 74 73 20 20 20 28 69 66 .. (tests (if
ac00: 20 74 65 73 74 73 2d 73 70 65 63 0a 09 09 09 09 tests-spec.....
ac10: 20 20 20 20 20 20 20 28 64 62 3a 64 69 73 70 61 (db:dispa
ac20: 74 63 68 2d 71 75 65 72 79 20 61 63 63 65 73 73 tch-query access
ac30: 2d 6d 6f 64 65 20 72 6d 74 3a 67 65 74 2d 74 65 -mode rmt:get-te
ac40: 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 3a 67 sts-for-run db:g
ac50: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
ac60: 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 74 74 run-id testpatt
ac70: 20 73 74 61 74 65 73 20 73 74 61 74 75 73 65 73 states statuses
ac80: 20 23 66 20 23 66 20 23 66 20 27 74 65 73 74 6e #f #f #f 'testn
ac90: 61 6d 65 20 27 61 73 63 20 3b 3b 20 28 64 62 3a ame 'asc ;; (db:
aca0: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
acb0: 6e 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 n dbstruct run-i
acc0: 64 20 74 65 73 74 70 61 74 74 20 27 28 29 20 27 d testpatt '() '
acd0: 28 29 20 23 66 20 23 66 20 23 66 20 27 74 65 73 () #f #f #f 'tes
ace0: 74 6e 61 6d 65 20 27 61 73 63 20 0a 09 09 09 09 tname 'asc .....
acf0: 09 09 09 20 20 20 20 20 3b 3b 20 75 73 65 20 71 ... ;; use q
ad00: 72 79 76 61 6c 73 20 69 66 20 74 65 73 74 2d 73 ryvals if test-s
ad10: 70 65 63 20 70 72 6f 76 69 64 65 64 0a 09 09 09 pec provided....
ad20: 09 09 09 09 20 20 20 20 20 28 69 66 20 74 65 73 .... (if tes
ad30: 74 73 2d 73 70 65 63 0a 09 09 09 09 09 09 09 09 ts-spec.........
ad40: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
ad50: 65 72 73 65 20 61 64 6a 2d 74 65 73 74 73 2d 73 erse adj-tests-s
ad60: 70 65 63 20 22 2c 22 29 0a 09 09 09 09 09 09 09 pec ",")........
ad70: 09 20 3b 3b 20 64 62 3a 74 65 73 74 2d 72 65 63 . ;; db:test-rec
ad80: 6f 72 64 2d 66 69 65 6c 64 73 0a 09 09 09 09 09 ord-fields......
ad90: 09 09 09 20 23 66 29 0a 09 09 09 09 09 09 09 20 ... #f)........
ada0: 20 20 20 20 23 66 0a 09 09 09 09 09 09 09 20 20 #f........
adb0: 20 20 20 27 6e 6f 72 6d 61 6c 29 0a 09 09 09 09 'normal).....
adc0: 20 20 20 20 20 20 20 27 28 29 29 29 29 0a 09 09 '())))...
add0: 20 20 20 20 20 28 63 61 73 65 20 64 6d 6f 64 65 (case dmode
ade0: 0a 09 09 20 20 20 20 20 20 20 28 28 6a 73 6f 6e ... ((json
adf0: 20 6f 64 73 29 0a 09 09 09 28 69 66 20 72 75 6e ods)....(if run
ae00: 73 2d 73 70 65 63 0a 09 09 09 20 20 20 20 28 66 s-spec.... (f
ae10: 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 20 20 20 or-each ....
ae20: 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 2d (lambda (field-
ae30: 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 20 20 name)....
ae40: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
ae50: 2d 73 65 74 21 20 64 61 74 61 20 28 63 6f 6e 63 -set! data (conc
ae60: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
ae70: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
ae80: 64 65 72 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 der field-name))
ae90: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
aea0: 6d 65 20 22 6d 65 74 61 22 20 66 69 65 6c 64 2d me "meta" field-
aeb0: 6e 61 6d 65 29 29 0a 09 09 09 20 20 20 20 20 72 name)).... r
aec0: 75 6e 73 2d 73 70 65 63 29 29 29 0a 09 09 09 3b uns-spec)))....;
aed0: 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 ; (mutils:hierha
aee0: 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 64 62 sh-set! data (db
aef0: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
af00: 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 ader run header
af10: 22 73 74 61 74 75 73 22 29 20 20 20 20 20 74 61 "status") ta
af20: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
af30: 22 6d 65 74 61 22 20 22 73 74 61 74 75 73 22 20 "meta" "status"
af40: 20 20 20 20 29 0a 09 09 09 3b 3b 20 28 6d 75 74 )....;; (mut
af50: 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 ils:hierhash-set
af60: 21 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 ! data (db:get-v
af70: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
af80: 75 6e 20 68 65 61 64 65 72 20 22 73 74 61 74 65 un header "state
af90: 22 29 20 20 20 20 20 20 74 61 72 67 65 74 73 74 ") targetst
afa0: 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 r runname "meta"
afb0: 20 22 73 74 61 74 65 22 20 20 20 20 20 20 29 0a "state" ).
afc0: 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 ...;; (mutils:hi
afd0: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
afe0: 20 28 63 6f 6e 63 20 28 64 62 3a 67 65 74 2d 76 (conc (db:get-v
aff0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
b000: 75 6e 20 68 65 61 64 65 72 20 22 69 64 22 29 29 un header "id"))
b010: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
b020: 61 6d 65 20 22 6d 65 74 61 22 20 22 69 64 22 20 ame "meta" "id"
b030: 20 20 20 20 20 20 20 20 29 0a 09 09 09 3b 3b 20 )....;;
b040: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
b050: 2d 73 65 74 21 20 64 61 74 61 20 28 64 62 3a 67 -set! data (db:g
b060: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
b070: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 65 er run header "e
b080: 76 65 6e 74 5f 74 69 6d 65 22 29 20 74 61 72 67 vent_time") targ
b090: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d etstr runname "m
b0a0: 65 74 61 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 eta" "event_time
b0b0: 22 20 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c " )....;; (mutil
b0c0: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
b0d0: 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 6c data (db:get-val
b0e0: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
b0f0: 20 68 65 61 64 65 72 20 22 63 6f 6d 6d 65 6e 74 header "comment
b100: 22 29 20 20 20 20 74 61 72 67 65 74 73 74 72 20 ") targetstr
b110: 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 runname "meta" "
b120: 63 6f 6d 6d 65 6e 74 22 20 20 20 20 29 0a 09 09 comment" )...
b130: 09 3b 3b 20 3b 3b 20 61 64 64 20 6c 61 73 74 20 .;; ;; add last
b140: 65 6e 74 72 79 20 74 77 69 63 65 20 2d 20 73 65 entry twice - se
b150: 65 6d 73 20 74 6f 20 62 65 20 61 20 62 75 67 20 ems to be a bug
b160: 69 6e 20 68 69 65 72 68 61 73 68 3f 0a 09 09 09 in hierhash?....
b170: 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ;; (mutils:hierh
b180: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 64 ash-set! data (d
b190: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
b1a0: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
b1b0: 20 22 63 6f 6d 6d 65 6e 74 22 29 20 20 20 20 74 "comment") t
b1c0: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
b1d0: 20 22 6d 65 74 61 22 20 22 63 6f 6d 6d 65 6e 74 "meta" "comment
b1e0: 22 20 20 20 20 29 0a 09 09 20 20 20 20 20 20 20 " )...
b1f0: 28 65 6c 73 65 0a 09 09 09 28 69 66 20 28 6e 75 (else....(if (nu
b200: 6c 6c 3f 20 72 75 6e 73 2d 73 70 65 63 29 0a 09 ll? runs-spec)..
b210: 09 09 20 20 20 20 28 70 72 69 6e 74 20 22 52 75 .. (print "Ru
b220: 6e 3a 20 22 20 74 61 72 67 65 74 73 74 72 20 22 n: " targetstr "
b230: 2f 22 20 72 75 6e 6e 61 6d 65 20 0a 09 09 09 09 /" runname .....
b240: 20 20 20 22 20 73 74 61 74 75 73 3a 20 22 20 28 " status: " (
b250: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
b260: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
b270: 72 20 22 73 74 61 74 65 22 29 0a 09 09 09 09 20 r "state").....
b280: 20 20 22 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 " run-id: " ru
b290: 6e 2d 69 64 20 22 2c 20 6e 75 6d 62 65 72 20 74 n-id ", number t
b2a0: 65 73 74 73 3a 20 22 20 28 6c 65 6e 67 74 68 20 ests: " (length
b2b0: 74 65 73 74 73 29 0a 09 09 09 09 20 20 20 22 20 tests)..... "
b2c0: 65 76 65 6e 74 5f 74 69 6d 65 3a 20 22 20 28 64 event_time: " (d
b2d0: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
b2e0: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
b2f0: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 29 0a "event_time")).
b300: 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ... (begin...
b310: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
b320: 28 6d 65 6d 62 65 72 20 22 74 61 72 67 65 74 22 (member "target"
b330: 20 72 75 6e 73 2d 73 70 65 63 29 29 0a 09 09 09 runs-spec))....
b340: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 64 69 ;; (di
b350: 73 70 6c 61 79 20 28 63 6f 6e 63 20 22 54 61 72 splay (conc "Tar
b360: 67 65 74 3a 20 22 20 74 61 72 67 65 74 73 74 72 get: " targetstr
b370: 29 29 0a 09 09 09 20 20 20 20 20 20 20 20 20 20 ))....
b380: 28 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 22 (display (conc "
b390: 52 75 6e 3a 20 22 20 74 61 72 67 65 74 73 74 72 Run: " targetstr
b3a0: 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 20 22 "/" runname " "
b3b0: 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 66 6f ))).... (fo
b3c0: 72 2d 65 61 63 68 0a 09 09 09 20 20 20 20 20 20 r-each....
b3d0: 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 2d (lambda (field-
b3e0: 6e 61 6d 65 29 0a 09 09 09 09 20 28 69 66 20 28 name)..... (if (
b3f0: 65 71 75 61 6c 3f 20 66 69 65 6c 64 2d 6e 61 6d equal? field-nam
b400: 65 20 22 74 61 72 67 65 74 22 29 0a 09 09 09 09 e "target").....
b410: 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 28 63 (display (c
b420: 6f 6e 63 20 22 74 61 72 67 65 74 3a 20 22 20 74 onc "target: " t
b430: 61 72 67 65 74 73 74 72 20 22 20 22 29 29 0a 09 argetstr " "))..
b440: 09 09 09 20 20 20 20 20 28 64 69 73 70 6c 61 79 ... (display
b450: 20 28 63 6f 6e 63 20 66 69 65 6c 64 2d 6e 61 6d (conc field-nam
b460: 65 20 22 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 e ": " (db:get-v
b470: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
b480: 75 6e 20 68 65 61 64 65 72 20 28 63 6f 6e 63 20 un header (conc
b490: 66 69 65 6c 64 2d 6e 61 6d 65 29 29 20 22 20 22 field-name)) " "
b4a0: 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 72 )))).... r
b4b0: 75 6e 73 2d 73 70 65 63 29 0a 09 09 09 20 20 20 uns-spec)....
b4c0: 20 20 20 28 6e 65 77 6c 69 6e 65 29 29 29 29 29 (newline)))))
b4d0: 0a 09 09 20 20 20 20 20 20 20 0a 09 09 20 20 20 ... ...
b4e0: 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 20 (for-each ...
b4f0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 (lambda (te
b500: 73 74 29 0a 09 09 20 20 20 20 20 20 09 28 68 61 st)... .(ha
b510: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
b520: 09 09 09 20 65 78 6e 0a 09 09 09 20 28 62 65 67 ... exn.... (beg
b530: 69 6e 0a 09 09 09 20 20 20 28 64 65 62 75 67 3a in.... (debug:
b540: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
b550: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
b560: 20 22 42 61 64 20 64 61 74 61 20 69 6e 20 74 65 "Bad data in te
b570: 73 74 20 72 65 63 6f 72 64 3f 20 22 20 74 65 73 st record? " tes
b580: 74 29 0a 09 09 09 20 20 20 28 70 72 69 6e 74 20 t).... (print
b590: 22 65 78 6e 3d 22 20 28 63 6f 6e 64 69 74 69 6f "exn=" (conditio
b5a0: 6e 2d 3e 6c 69 73 74 20 65 78 6e 29 29 0a 09 09 n->list exn))...
b5b0: 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
b5c0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
b5d0: 70 6f 72 74 2a 20 22 20 6d 65 73 73 61 67 65 3a port* " message:
b5e0: 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 " ((condition-p
b5f0: 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 roperty-accessor
b600: 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 'exn 'message)
b610: 65 78 6e 29 29 0a 09 09 09 20 20 20 28 70 72 69 exn)).... (pri
b620: 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 20 28 63 nt-call-chain (c
b630: 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 urrent-error-por
b640: 74 29 29 29 0a 09 09 09 20 28 6c 65 74 2a 20 28 t))).... (let* (
b650: 28 74 65 73 74 2d 69 64 20 20 20 20 20 20 28 69 (test-id (i
b660: 66 20 28 6d 65 6d 62 65 72 20 22 69 64 22 20 20 f (member "id"
b670: 20 20 20 20 20 20 20 20 20 74 65 73 74 73 2d 73 tests-s
b680: 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 pec)(get-value-b
b690: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
b6a0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
b6b0: 78 20 22 69 64 22 20 20 20 20 20 20 20 20 20 20 x "id"
b6c0: 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 ) #f)) ;; (db:te
b6d0: 73 74 2d 67 65 74 2d 69 64 20 20 20 20 20 20 20 st-get-id
b6e0: 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 74 65 test)).....(te
b6f0: 73 74 6e 61 6d 65 20 20 20 20 20 28 69 66 20 28 stname (if (
b700: 6d 65 6d 62 65 72 20 22 74 65 73 74 6e 61 6d 65 member "testname
b710: 22 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 " tests-spec
b720: 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 )(get-value-by-f
b730: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
b740: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
b750: 74 65 73 74 6e 61 6d 65 22 20 20 20 20 29 20 23 testname" ) #
b760: 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d f)) ;; (db:test-
b770: 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 20 74 get-testname t
b780: 65 73 74 29 29 0a 09 09 09 09 28 69 74 65 6d 70 est)).....(itemp
b790: 61 74 68 20 20 20 20 20 28 69 66 20 28 6d 65 6d ath (if (mem
b7a0: 62 65 72 20 22 69 74 65 6d 5f 70 61 74 68 22 20 ber "item_path"
b7b0: 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 tests-spec)(g
b7c0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
b7d0: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
b7e0: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 69 74 65 field-index "ite
b7f0: 6d 5f 70 61 74 68 22 20 20 20 29 20 23 66 29 29 m_path" ) #f))
b800: 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ;; (db:test-get
b810: 2d 69 74 65 6d 2d 70 61 74 68 20 20 74 65 73 74 -item-path test
b820: 29 29 0a 09 09 09 09 28 63 6f 6d 6d 65 6e 74 20 )).....(comment
b830: 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 (if (member
b840: 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 20 20 "comment"
b850: 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d tests-spec)(get-
b860: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
b870: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
b880: 6c 64 2d 69 6e 64 65 78 20 22 63 6f 6d 6d 65 6e ld-index "commen
b890: 74 22 20 20 20 20 20 29 20 23 66 29 29 20 3b 3b t" ) #f)) ;;
b8a0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 6f (db:test-get-co
b8b0: 6d 6d 65 6e 74 20 20 20 20 74 65 73 74 29 29 0a mment test)).
b8c0: 09 09 09 09 28 74 73 74 61 74 65 20 20 20 20 20 ....(tstate
b8d0: 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 73 (if (member "s
b8e0: 74 61 74 65 22 20 20 20 20 20 20 20 20 74 65 73 tate" tes
b8f0: 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c ts-spec)(get-val
b900: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
b910: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
b920: 69 6e 64 65 78 20 22 73 74 61 74 65 22 20 20 20 index "state"
b930: 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 ) #f)) ;; (d
b940: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
b950: 20 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 test))....
b960: 09 28 74 73 74 61 74 75 73 20 20 20 20 20 20 28 .(tstatus (
b970: 69 66 20 28 6d 65 6d 62 65 72 20 22 73 74 61 74 if (member "stat
b980: 75 73 22 20 20 20 20 20 20 20 74 65 73 74 73 2d us" tests-
b990: 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d spec)(get-value-
b9a0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
b9b0: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
b9c0: 65 78 20 22 73 74 61 74 75 73 22 20 20 20 20 20 ex "status"
b9d0: 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 ) #f)) ;; (db:t
b9e0: 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 20 est-get-status
b9f0: 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 65 test)).....(e
ba00: 76 65 6e 74 2d 74 69 6d 65 20 20 20 28 69 66 20 vent-time (if
ba10: 28 6d 65 6d 62 65 72 20 22 65 76 65 6e 74 5f 74 (member "event_t
ba20: 69 6d 65 22 20 20 20 74 65 73 74 73 2d 73 70 65 ime" tests-spe
ba30: 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d c)(get-value-by-
ba40: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
ba50: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
ba60: 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 20 29 20 "event_time" )
ba70: 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 #f)) ;; (db:test
ba80: 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -get-event_time
ba90: 74 65 73 74 29 29 0a 09 09 09 09 28 72 75 6e 64 test)).....(rund
baa0: 69 72 20 20 20 20 20 20 20 28 69 66 20 28 6d 65 ir (if (me
bab0: 6d 62 65 72 20 22 72 75 6e 64 69 72 22 20 20 20 mber "rundir"
bac0: 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 tests-spec)(
bad0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
bae0: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
baf0: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 -field-index "ru
bb00: 6e 64 69 72 22 20 20 20 20 20 20 29 20 23 66 29 ndir" ) #f)
bb10: 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 ) ;; (db:test-ge
bb20: 74 2d 72 75 6e 64 69 72 20 20 20 20 20 74 65 73 t-rundir tes
bb30: 74 29 29 0a 09 09 09 09 28 66 69 6e 61 6c 5f 6c t)).....(final_l
bb40: 6f 67 66 20 20 20 28 69 66 20 28 6d 65 6d 62 65 ogf (if (membe
bb50: 72 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 20 r "final_logf"
bb60: 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 tests-spec)(get
bb70: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
bb80: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
bb90: 65 6c 64 2d 69 6e 64 65 78 20 22 66 69 6e 61 6c eld-index "final
bba0: 5f 6c 6f 67 66 22 20 20 29 20 23 66 29 29 20 3b _logf" ) #f)) ;
bbb0: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 ; (db:test-get-f
bbc0: 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 74 29 29 inal_logf test))
bbd0: 0a 09 09 09 09 28 72 75 6e 5f 64 75 72 61 74 69 .....(run_durati
bbe0: 6f 6e 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 on (if (member "
bbf0: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 20 74 65 run_duration" te
bc00: 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 sts-spec)(get-va
bc10: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
bc20: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
bc30: 2d 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 61 -index "run_dura
bc40: 74 69 6f 6e 22 29 20 23 66 29 29 20 3b 3b 20 28 tion") #f)) ;; (
bc50: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f db:test-get-run_
bc60: 64 75 72 61 74 69 6f 6e 20 74 65 73 74 29 29 0a duration test)).
bc70: 09 09 09 09 28 66 75 6c 6c 6e 61 6d 65 20 20 20 ....(fullname
bc80: 20 20 28 63 6f 6e 63 20 74 65 73 74 6e 61 6d 65 (conc testname
bc90: 0a 09 09 09 09 09 09 20 20 20 20 28 69 66 20 28 ....... (if (
bca0: 65 71 75 61 6c 3f 20 69 74 65 6d 70 61 74 68 20 equal? itempath
bcb0: 22 22 29 0a 09 09 09 09 09 09 09 22 22 20 0a 09 "")........"" ..
bcc0: 09 09 09 09 09 09 28 63 6f 6e 63 20 22 28 22 20 ......(conc "("
bcd0: 69 74 65 6d 70 61 74 68 20 22 29 22 29 29 29 29 itempath ")"))))
bce0: 29 0a 09 09 09 20 20 20 28 63 61 73 65 20 64 6d ).... (case dm
bcf0: 6f 64 65 0a 09 09 09 20 20 20 20 20 28 28 6a 73 ode.... ((js
bd00: 6f 6e 20 6f 64 73 29 0a 09 09 09 20 20 20 20 20 on ods)....
bd10: 20 28 69 66 20 74 65 73 74 73 2d 73 70 65 63 0a (if tests-spec.
bd20: 09 09 09 09 20 20 28 66 6f 72 2d 65 61 63 68 0a .... (for-each.
bd30: 09 09 09 09 20 20 20 28 6c 61 6d 62 64 61 20 28 .... (lambda (
bd40: 66 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 09 field-name).....
bd50: 20 20 20 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 (mutils:hie
bd60: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
bd70: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
bd80: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
bd90: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 66 st-field-index f
bda0: 69 65 6c 64 2d 6e 61 6d 65 29 20 74 61 72 67 65 ield-name) targe
bdb0: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 tstr runname "da
bdc0: 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 ta" (conc test-i
bdd0: 64 29 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 0a d) field-name)).
bde0: 09 09 09 09 20 20 20 74 65 73 74 73 2d 73 70 65 .... tests-spe
bdf0: 63 29 29 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 c))).... ;;
be00: 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ;; (mutils:hierh
be10: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 66 ash-set! data f
be20: 75 6c 6c 6e 61 6d 65 20 20 20 74 61 72 67 65 74 ullname target
be30: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 str runname "dat
be40: 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 a" (conc test-id
be50: 29 20 22 74 6e 61 6d 65 22 20 20 20 20 20 29 0a ) "tname" ).
be60: 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 ... ;; (mut
be70: 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 ils:hierhash-set
be80: 21 20 64 61 74 61 20 20 74 65 73 74 6e 61 6d 65 ! data testname
be90: 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e targetstr run
bea0: 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e name "data" (con
beb0: 63 20 74 65 73 74 2d 69 64 29 20 22 74 65 73 74 c test-id) "test
bec0: 6e 61 6d 65 22 20 20 29 0a 09 09 09 20 20 20 20 name" )....
bed0: 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 ;; (mutils:hie
bee0: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
bef0: 20 69 74 65 6d 70 61 74 68 20 20 20 74 61 72 67 itempath targ
bf00: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 etstr runname "d
bf10: 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d ata" (conc test-
bf20: 69 64 29 20 22 69 74 65 6d 70 61 74 68 22 20 20 id) "itempath"
bf30: 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d ).... ;; (m
bf40: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
bf50: 65 74 21 20 64 61 74 61 20 20 63 6f 6d 6d 65 6e et! data commen
bf60: 74 20 20 20 20 74 61 72 67 65 74 73 74 72 20 72 t targetstr r
bf70: 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 unname "data" (c
bf80: 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 63 6f onc test-id) "co
bf90: 6d 6d 65 6e 74 22 20 20 20 29 0a 09 09 09 20 20 mment" )....
bfa0: 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 ;; (mutils:h
bfb0: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
bfc0: 61 20 20 74 73 74 61 74 65 20 20 20 20 20 74 61 a tstate ta
bfd0: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
bfe0: 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 "data" (conc tes
bff0: 74 2d 69 64 29 20 22 73 74 61 74 65 22 20 20 20 t-id) "state"
c000: 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 ).... ;;
c010: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
c020: 2d 73 65 74 21 20 64 61 74 61 20 20 74 73 74 61 -set! data tsta
c030: 74 75 73 20 20 20 20 74 61 72 67 65 74 73 74 72 tus targetstr
c040: 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 runname "data"
c050: 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 (conc test-id) "
c060: 73 74 61 74 75 73 22 20 20 20 20 29 0a 09 09 09 status" )....
c070: 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 ;; (mutils
c080: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
c090: 61 74 61 20 20 72 75 6e 64 69 72 20 20 20 20 20 ata rundir
c0a0: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
c0b0: 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 e "data" (conc t
c0c0: 65 73 74 2d 69 64 29 20 22 72 75 6e 64 69 72 22 est-id) "rundir"
c0d0: 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b ).... ;;
c0e0: 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 (mutils:hierha
c0f0: 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 66 69 sh-set! data fi
c100: 6e 61 6c 5f 6c 6f 67 66 20 74 61 72 67 65 74 73 nal_logf targets
c110: 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 tr runname "data
c120: 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 " (conc test-id)
c130: 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 29 0a 09 "final_logf")..
c140: 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 .. ;; (muti
c150: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
c160: 20 64 61 74 61 20 20 72 75 6e 5f 64 75 72 61 74 data run_durat
c170: 69 6f 6e 20 74 61 72 67 65 74 73 74 72 20 72 75 ion targetstr ru
c180: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
c190: 6e 63 20 74 65 73 74 2d 69 64 29 20 22 72 75 6e nc test-id) "run
c1a0: 5f 64 75 72 61 74 69 6f 6e 22 29 0a 09 09 09 20 _duration")....
c1b0: 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a ;; (mutils:
c1c0: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
c1d0: 74 61 20 20 65 76 65 6e 74 2d 74 69 6d 65 20 74 ta event-time t
c1e0: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
c1f0: 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 "data" (conc te
c200: 73 74 2d 69 64 29 20 22 65 76 65 6e 74 5f 74 69 st-id) "event_ti
c210: 6d 65 22 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 me").... ;;
c220: 20 3b 3b 20 61 64 64 20 6c 61 73 74 20 65 6e 74 ;; add last ent
c230: 72 79 20 74 77 69 63 65 20 2d 20 73 65 65 6d 73 ry twice - seems
c240: 20 74 6f 20 62 65 20 61 20 62 75 67 20 69 6e 20 to be a bug in
c250: 68 69 65 72 68 61 73 68 3f 0a 09 09 09 20 20 20 hierhash?....
c260: 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 ;; (mutils:hi
c270: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
c280: 20 20 65 76 65 6e 74 2d 74 69 6d 65 20 74 61 72 event-time tar
c290: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
c2a0: 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 data" (conc test
c2b0: 2d 69 64 29 20 22 65 76 65 6e 74 5f 74 69 6d 65 -id) "event_time
c2c0: 22 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 29 ").... ;; )
c2d0: 0a 09 09 09 20 20 20 20 20 28 65 6c 73 65 0a 09 .... (else..
c2e0: 09 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 .. (if (and
c2f0: 20 74 73 74 61 74 65 20 74 73 74 61 74 75 73 20 tstate tstatus
c300: 65 76 65 6e 74 2d 74 69 6d 65 29 0a 09 09 09 09 event-time).....
c310: 20 20 28 66 6f 72 6d 61 74 20 23 74 0a 09 09 09 (format #t....
c320: 09 09 20 20 22 20 20 54 65 73 74 3a 20 7e 32 35 .. " Test: ~25
c330: 61 20 53 74 61 74 65 3a 20 7e 31 35 61 20 53 74 a State: ~15a St
c340: 61 74 75 73 3a 20 7e 31 35 61 20 52 75 6e 74 69 atus: ~15a Runti
c350: 6d 65 3a 20 7e 35 40 61 73 20 54 69 6d 65 3a 20 me: ~5@as Time:
c360: 7e 32 32 61 20 48 6f 73 74 3a 20 7e 31 30 61 5c ~22a Host: ~10a\
c370: 6e 22 0a 09 09 09 09 09 20 20 28 69 66 20 66 75 n"...... (if fu
c380: 6c 6c 6e 61 6d 65 20 66 75 6c 6c 6e 61 6d 65 20 llname fullname
c390: 22 22 29 0a 09 09 09 09 09 20 20 28 69 66 20 74 "")...... (if t
c3a0: 73 74 61 74 65 20 20 20 74 73 74 61 74 65 20 20 state tstate
c3b0: 20 22 22 29 0a 09 09 09 09 09 20 20 28 69 66 20 "")...... (if
c3c0: 74 73 74 61 74 75 73 20 20 74 73 74 61 74 75 73 tstatus tstatus
c3d0: 20 20 22 22 29 0a 09 09 09 09 09 20 20 28 67 65 "")...... (ge
c3e0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
c3f0: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
c400: 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 5f ield-index "run_
c410: 64 75 72 61 74 69 6f 6e 22 29 3b 3b 28 69 66 20 duration");;(if
c420: 74 65 73 74 20 20 20 20 20 28 64 62 3a 74 65 73 test (db:tes
c430: 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 t-get-run_durati
c440: 6f 6e 20 74 65 73 74 29 20 22 22 29 0a 09 09 09 on test) "")....
c450: 09 09 20 20 28 69 66 20 65 76 65 6e 74 2d 74 69 .. (if event-ti
c460: 6d 65 20 65 76 65 6e 74 2d 74 69 6d 65 20 22 22 me event-time ""
c470: 29 0a 09 09 09 09 09 20 20 28 67 65 74 2d 76 61 )...... (get-va
c480: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
c490: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
c4a0: 2d 69 6e 64 65 78 20 22 68 6f 73 74 22 29 29 20 -index "host"))
c4b0: 3b 3b 28 69 66 20 74 65 73 74 20 28 64 62 3a 74 ;;(if test (db:t
c4c0: 65 73 74 2d 67 65 74 2d 68 6f 73 74 20 74 65 73 est-get-host tes
c4d0: 74 29 29 20 22 22 29 0a 09 09 09 09 20 20 28 70 t)) "")..... (p
c4e0: 72 69 6e 74 20 22 20 20 54 65 73 74 3a 20 22 20 rint " Test: "
c4f0: 66 75 6c 6c 6e 61 6d 65 0a 09 09 09 09 09 20 28 fullname...... (
c500: 69 66 20 74 73 74 61 74 65 20 20 28 63 6f 6e 63 if tstate (conc
c510: 20 22 20 53 74 61 74 65 3a 20 22 20 20 74 73 74 " State: " tst
c520: 61 74 65 29 20 20 22 22 29 0a 09 09 09 09 09 20 ate) "")......
c530: 28 69 66 20 74 73 74 61 74 75 73 20 28 63 6f 6e (if tstatus (con
c540: 63 20 22 20 53 74 61 74 75 73 3a 20 22 20 74 73 c " Status: " ts
c550: 74 61 74 75 73 29 20 22 22 29 0a 09 09 09 09 09 tatus) "")......
c560: 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d (if (get-value-
c570: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
c580: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
c590: 65 78 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e ex "run_duration
c5a0: 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 63 6f ")...... (co
c5b0: 6e 63 20 22 20 52 75 6e 74 69 6d 65 3a 20 22 20 nc " Runtime: "
c5c0: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
c5d0: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
c5e0: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 t-field-index "r
c5f0: 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 29 0a 09 un_duration"))..
c600: 09 09 09 09 20 20 20 20 20 22 22 29 0a 09 09 09 .... "")....
c610: 09 09 20 28 69 66 20 65 76 65 6e 74 2d 74 69 6d .. (if event-tim
c620: 65 20 28 63 6f 6e 63 20 22 20 54 69 6d 65 3a 20 e (conc " Time:
c630: 22 20 65 76 65 6e 74 2d 74 69 6d 65 29 20 22 22 " event-time) ""
c640: 29 0a 09 09 09 09 09 20 28 69 66 20 28 67 65 74 )...... (if (get
c650: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
c660: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
c670: 65 6c 64 2d 69 6e 64 65 78 20 22 68 6f 73 74 22 eld-index "host"
c680: 29 0a 09 09 09 09 09 20 20 20 20 20 28 63 6f 6e )...... (con
c690: 63 20 22 20 48 6f 73 74 3a 20 22 20 28 67 65 74 c " Host: " (get
c6a0: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
c6b0: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
c6c0: 65 6c 64 2d 69 6e 64 65 78 20 22 68 6f 73 74 22 eld-index "host"
c6d0: 29 29 0a 09 09 09 09 09 20 20 20 20 20 22 22 29 ))...... "")
c6e0: 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 )).... (if
c6f0: 28 6e 6f 74 20 28 6f 72 20 28 65 71 75 61 6c 3f (not (or (equal?
c700: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
c710: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
c720: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
c730: 73 74 61 74 75 73 22 29 20 22 50 41 53 53 22 29 status") "PASS")
c740: 0a 09 09 09 09 09 20 20 20 28 65 71 75 61 6c 3f ...... (equal?
c750: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
c760: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
c770: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
c780: 73 74 61 74 75 73 22 29 20 22 57 41 52 4e 22 29 status") "WARN")
c790: 0a 09 09 09 09 09 20 20 20 28 65 71 75 61 6c 3f ...... (equal?
c7a0: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
c7b0: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
c7c0: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
c7d0: 73 74 61 74 65 22 29 20 20 22 4e 4f 54 5f 53 54 state") "NOT_ST
c7e0: 41 52 54 45 44 22 29 29 29 0a 09 09 09 09 20 20 ARTED"))).....
c7f0: 28 62 65 67 69 6e 0a 09 09 09 09 20 20 20 20 28 (begin..... (
c800: 70 72 69 6e 74 20 20 20 28 69 66 20 28 67 65 74 print (if (get
c810: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
c820: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
c830: 65 6c 64 2d 69 6e 64 65 78 20 22 63 70 75 6c 6f eld-index "cpulo
c840: 61 64 22 29 0a 09 09 09 09 09 09 20 28 63 6f 6e ad")....... (con
c850: 63 20 22 20 20 20 20 20 20 20 20 20 63 70 75 6c c " cpul
c860: 6f 61 64 3a 20 20 22 20 20 20 28 67 65 74 2d 76 oad: " (get-v
c870: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
c880: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
c890: 64 2d 69 6e 64 65 78 20 22 63 70 75 6c 6f 61 64 d-index "cpuload
c8a0: 22 29 29 0a 09 09 09 09 09 09 20 22 22 29 20 3b "))....... "") ;
c8b0: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 ; (db:test-get-c
c8c0: 70 75 6c 6f 61 64 20 74 65 73 74 29 0a 09 09 09 puload test)....
c8d0: 09 09 20 20 20 20 20 28 69 66 20 28 67 65 74 2d .. (if (get-
c8e0: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
c8f0: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
c900: 6c 64 2d 69 6e 64 65 78 20 22 64 69 73 6b 66 72 ld-index "diskfr
c910: 65 65 22 29 0a 09 09 09 09 09 09 20 28 63 6f 6e ee")....... (con
c920: 63 20 22 5c 6e 20 20 20 20 20 20 20 20 20 64 69 c "\n di
c930: 73 6b 66 72 65 65 3a 20 22 20 28 67 65 74 2d 76 skfree: " (get-v
c940: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
c950: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
c960: 64 2d 69 6e 64 65 78 20 22 64 69 73 6b 66 72 65 d-index "diskfre
c970: 65 22 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 e")) ;; (db:test
c980: 2d 67 65 74 2d 64 69 73 6b 66 72 65 65 20 74 65 -get-diskfree te
c990: 73 74 29 0a 09 09 09 09 09 09 20 22 22 29 0a 09 st)....... "")..
c9a0: 09 09 09 09 20 20 20 20 20 28 69 66 20 28 67 65 .... (if (ge
c9b0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
c9c0: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
c9d0: 69 65 6c 64 2d 69 6e 64 65 78 20 22 75 6e 61 6d ield-index "unam
c9e0: 65 22 29 0a 09 09 09 09 09 09 20 28 63 6f 6e 63 e")....... (conc
c9f0: 20 22 5c 6e 20 20 20 20 20 20 20 20 20 75 6e 61 "\n una
ca00: 6d 65 3a 20 20 20 20 22 20 28 67 65 74 2d 76 61 me: " (get-va
ca10: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
ca20: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
ca30: 2d 69 6e 64 65 78 20 22 75 6e 61 6d 65 22 29 29 -index "uname"))
ca40: 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ;; (db:test-get
ca50: 2d 75 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 09 -uname test)....
ca60: 09 09 09 20 22 22 29 0a 09 09 09 09 09 20 20 20 ... "")......
ca70: 20 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 (if (get-value
ca80: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
ca90: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
caa0: 64 65 78 20 22 72 75 6e 64 69 72 22 29 0a 09 09 dex "rundir")...
cab0: 09 09 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 20 .... (conc "\n
cac0: 20 20 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 rundir:
cad0: 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 " (get-value-by
cae0: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
caf0: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
cb00: 20 22 72 75 6e 64 69 72 22 29 29 20 3b 3b 20 28 "rundir")) ;; (
cb10: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 db:test-get-rund
cb20: 69 72 20 74 65 73 74 29 0a 09 09 09 09 09 09 20 ir test).......
cb30: 22 22 29 0a 3b 3b 09 09 09 09 09 20 20 20 20 20 "").;;.....
cb40: 22 5c 6e 20 20 20 20 20 20 20 20 20 72 75 6e 64 "\n rund
cb50: 69 72 3a 20 20 20 22 20 28 67 65 74 2d 76 61 6c ir: " (get-val
cb60: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
cb70: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
cb80: 69 6e 64 65 78 20 22 22 29 20 3b 3b 20 28 73 64 index "") ;; (sd
cb90: 62 3a 71 72 79 20 27 67 65 74 73 74 72 20 3b 3b b:qry 'getstr ;;
cba0: 20 28 66 69 6c 65 64 62 3a 67 65 74 2d 70 61 74 (filedb:get-pat
cbb0: 68 20 2a 66 64 62 2a 20 0a 3b 3b 20 09 09 09 09 h *fdb* .;; ....
cbc0: 09 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 . (db:test-g
cbd0: 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 20 et-rundir test)
cbe0: 3b 3b 20 29 0a 09 09 09 09 09 20 20 20 20 20 29 ;; )...... )
cbf0: 0a 09 09 09 09 20 20 20 20 3b 3b 20 45 61 63 68 ..... ;; Each
cc00: 20 74 65 73 74 0a 09 09 09 09 20 20 20 20 3b 3b test..... ;;
cc10: 20 44 4f 20 4e 4f 54 20 72 65 6d 6f 74 65 20 72 DO NOT remote r
cc20: 75 6e 0a 09 09 09 09 20 20 20 20 28 6c 65 74 20 un..... (let
cc30: 28 28 73 74 65 70 73 20 28 64 62 3a 64 69 73 70 ((steps (db:disp
cc40: 61 74 63 68 2d 71 75 65 72 79 20 61 63 63 65 73 atch-query acces
cc50: 73 2d 6d 6f 64 65 20 72 6d 74 3a 67 65 74 2d 73 s-mode rmt:get-s
cc60: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 teps-for-test db
cc70: 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 :get-steps-for-t
cc80: 65 73 74 20 72 75 6e 2d 69 64 20 28 64 62 3a 74 est run-id (db:t
cc90: 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 29 est-get-id test)
cca0: 29 29 29 20 3b 3b 20 28 64 62 3a 67 65 74 2d 73 ))) ;; (db:get-s
ccb0: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 teps-for-test db
ccc0: 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 28 64 struct run-id (d
ccd0: 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 b:test-get-id te
cce0: 73 74 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 st)))).....
ccf0: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 (for-each .....
cd00: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
cd10: 73 74 65 70 29 0a 09 09 09 09 09 20 28 66 6f 72 step)...... (for
cd20: 6d 61 74 20 23 74 20 0a 09 09 09 09 09 09 20 22 mat #t ....... "
cd30: 20 20 20 20 53 74 65 70 3a 20 7e 32 30 61 20 53 Step: ~20a S
cd40: 74 61 74 65 3a 20 7e 31 30 61 20 53 74 61 74 75 tate: ~10a Statu
cd50: 73 3a 20 7e 31 30 61 20 54 69 6d 65 20 7e 32 32 s: ~10a Time ~22
cd60: 61 5c 6e 22 0a 09 09 09 09 09 09 20 28 74 64 62 a\n"....... (tdb
cd70: 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 :step-get-stepna
cd80: 6d 65 20 73 74 65 70 29 0a 09 09 09 09 09 09 20 me step).......
cd90: 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 (tdb:step-get-st
cda0: 61 74 65 20 73 74 65 70 29 0a 09 09 09 09 09 09 ate step).......
cdb0: 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 (tdb:step-get-s
cdc0: 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 09 tatus step).....
cdd0: 09 09 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 .. (tdb:step-get
cde0: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 -event_time step
cdf0: 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 73 )))..... s
ce00: 74 65 70 73 29 29 29 29 29 29 29 29 29 0a 09 09 teps)))))))))...
ce10: 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a (if (args:
ce20: 67 65 74 2d 61 72 67 20 22 2d 73 6f 72 74 22 29 get-arg "-sort")
ce30: 0a 09 09 09 20 20 28 73 6f 72 74 20 74 65 73 74 .... (sort test
ce40: 73 0a 09 09 09 09 28 6c 61 6d 62 64 61 20 28 61 s.....(lambda (a
ce50: 2d 74 65 73 74 20 62 2d 74 65 73 74 29 0a 09 09 -test b-test)...
ce60: 09 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 20 .. (let* ((key
ce70: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
ce80: 20 22 2d 73 6f 72 74 22 29 29 0a 09 09 09 09 09 "-sort"))......
ce90: 20 28 66 69 72 73 74 20 20 28 67 65 74 2d 76 61 (first (get-va
cea0: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
ceb0: 20 61 2d 74 65 73 74 20 74 65 73 74 2d 66 69 65 a-test test-fie
cec0: 6c 64 2d 69 6e 64 65 78 20 6b 65 79 29 29 0a 09 ld-index key))..
ced0: 09 09 09 09 20 28 73 65 63 6f 6e 64 20 28 67 65 .... (second (ge
cee0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
cef0: 6e 61 6d 65 20 62 2d 74 65 73 74 20 74 65 73 74 name b-test test
cf00: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 6b 65 79 -field-index key
cf10: 29 29 29 0a 09 09 09 09 20 20 20 20 28 28 63 6f )))..... ((co
cf20: 6e 64 20 0a 09 09 09 09 20 20 20 20 20 20 28 28 nd ..... ((
cf30: 61 6e 64 20 28 6e 75 6d 62 65 72 3f 20 66 69 72 and (number? fir
cf40: 73 74 29 28 6e 75 6d 62 65 72 3f 20 73 65 63 6f st)(number? seco
cf50: 6e 64 29 29 20 3c 29 0a 09 09 09 09 20 20 20 20 nd)) <).....
cf60: 20 20 28 28 61 6e 64 20 28 73 74 72 69 6e 67 3f ((and (string?
cf70: 20 66 69 72 73 74 29 28 73 74 72 69 6e 67 3f 20 first)(string?
cf80: 73 65 63 6f 6e 64 29 29 20 73 74 72 69 6e 67 3c second)) string<
cf90: 3d 3f 29 0a 09 09 09 09 20 20 20 20 20 20 28 65 =?)..... (e
cfa0: 6c 73 65 20 65 71 75 61 6c 3f 29 29 0a 09 09 09 lse equal?))....
cfb0: 09 20 20 20 20 20 66 69 72 73 74 20 73 65 63 6f . first seco
cfc0: 6e 64 29 29 29 29 0a 09 09 09 20 20 74 65 73 74 nd)))).... test
cfd0: 73 29 29 29 29 29 29 0a 09 20 20 20 72 75 6e 73 s)))))).. runs
cfe0: 29 0a 09 20 20 28 69 66 20 28 65 71 3f 20 64 6d ).. (if (eq? dm
cff0: 6f 64 65 20 27 6a 73 6f 6e 29 28 6a 73 6f 6e 2d ode 'json)(json-
d000: 77 72 69 74 65 20 64 61 74 61 29 29 0a 09 20 20 write data))..
d010: 28 6c 65 74 2a 20 28 28 6d 65 74 61 64 61 74 2d (let* ((metadat-
d020: 66 69 65 6c 64 73 20 28 64 65 6c 65 74 65 2d 64 fields (delete-d
d030: 75 70 6c 69 63 61 74 65 73 0a 09 09 09 09 20 20 uplicates.....
d040: 28 61 70 70 65 6e 64 20 6b 65 79 73 20 27 28 20 (append keys '(
d050: 22 72 75 6e 6e 61 6d 65 22 20 22 74 69 6d 65 22 "runname" "time"
d060: 20 22 6f 77 6e 65 72 22 20 22 70 61 73 73 5f 63 "owner" "pass_c
d070: 6f 75 6e 74 22 20 22 66 61 69 6c 5f 63 6f 75 6e ount" "fail_coun
d080: 74 22 20 22 73 74 61 74 65 22 20 22 73 74 61 74 t" "state" "stat
d090: 75 73 22 20 22 63 6f 6d 6d 65 6e 74 22 20 22 69 us" "comment" "i
d0a0: 64 22 29 29 29 29 0a 09 09 20 28 72 75 6e 2d 66 d"))))... (run-f
d0b0: 69 65 6c 64 73 20 20 20 20 27 28 0a 09 09 09 09 ields '(.....
d0c0: 20 20 22 74 65 73 74 6e 61 6d 65 22 0a 09 09 09 "testname"....
d0d0: 09 20 20 22 69 74 65 6d 5f 70 61 74 68 22 0a 09 . "item_path"..
d0e0: 09 09 09 20 20 22 73 74 61 74 65 22 0a 09 09 09 ... "state"....
d0f0: 09 20 20 22 73 74 61 74 75 73 22 0a 09 09 09 09 . "status".....
d100: 20 20 22 63 6f 6d 6d 65 6e 74 22 0a 09 09 09 09 "comment".....
d110: 20 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 0a 09 "event_time"..
d120: 09 09 09 20 20 22 68 6f 73 74 22 0a 09 09 09 09 ... "host".....
d130: 20 20 22 72 75 6e 5f 69 64 22 0a 09 09 09 09 20 "run_id".....
d140: 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 0a "run_duration".
d150: 09 09 09 09 20 20 22 61 74 74 65 6d 70 74 6e 75 .... "attemptnu
d160: 6d 22 0a 09 09 09 09 20 20 22 69 64 22 0a 09 09 m"..... "id"...
d170: 09 09 20 20 22 61 72 63 68 69 76 65 64 22 0a 09 .. "archived"..
d180: 09 09 09 20 20 22 64 69 73 6b 66 72 65 65 22 0a ... "diskfree".
d190: 09 09 09 09 20 20 22 63 70 75 6c 6f 61 64 22 0a .... "cpuload".
d1a0: 09 09 09 09 20 20 22 66 69 6e 61 6c 5f 6c 6f 67 .... "final_log
d1b0: 66 22 0a 09 09 09 09 20 20 22 73 68 6f 72 74 64 f"..... "shortd
d1c0: 69 72 22 0a 09 09 09 09 20 20 22 72 75 6e 64 69 ir"..... "rundi
d1d0: 72 22 0a 09 09 09 09 20 20 22 75 6e 61 6d 65 22 r"..... "uname"
d1e0: 0a 09 09 09 09 20 20 29 0a 09 09 09 09 29 0a 09 ..... ).....)..
d1f0: 09 20 28 6e 65 77 64 61 74 20 20 20 20 20 20 20 . (newdat
d200: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 74 6f 2d 61 6c (common:to-al
d210: 69 73 74 20 64 61 74 61 29 29 0a 09 09 20 28 61 ist data))... (a
d220: 6c 6c 72 75 6e 64 61 74 20 20 20 20 20 20 20 28 llrundat (
d230: 69 66 20 28 6e 75 6c 6c 3f 20 6e 65 77 64 61 74 if (null? newdat
d240: 29 0a 09 09 09 09 20 20 20 20 20 20 27 28 29 0a )..... '().
d250: 09 09 09 09 20 20 20 20 20 20 28 63 61 72 20 28 .... (car (
d260: 6d 61 70 20 63 64 72 20 6e 65 77 64 61 74 29 29 map cdr newdat))
d270: 29 29 20 3b 3b 20 28 63 61 72 20 28 6d 61 70 20 )) ;; (car (map
d280: 63 64 72 20 28 63 61 72 20 28 6d 61 70 20 63 64 cdr (car (map cd
d290: 72 20 6e 65 77 64 61 74 29 29 29 29 29 0a 09 09 r newdat)))))...
d2a0: 20 28 72 75 6e 73 20 20 20 20 20 20 20 20 20 20 (runs
d2b0: 20 20 28 61 70 70 65 6e 64 0a 09 09 09 09 20 20 (append.....
d2c0: 20 28 6c 69 73 74 20 22 72 75 6e 73 22 20 3b 3b (list "runs" ;;
d2d0: 20 73 68 65 65 74 6e 61 6d 65 0a 09 09 09 09 09 sheetname......
d2e0: 20 6d 65 74 61 64 61 74 2d 66 69 65 6c 64 73 29 metadat-fields)
d2f0: 0a 09 09 09 09 20 20 20 28 6d 61 70 20 28 6c 61 ..... (map (la
d300: 6d 62 64 61 20 28 72 75 6e 29 0a 09 09 09 09 09 mbda (run)......
d310: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 72 75 6e ;; (print "run
d320: 3a 20 22 20 72 75 6e 29 0a 09 09 09 09 09 20 20 : " run)......
d330: 28 6c 65 74 2a 20 28 28 72 75 6e 6e 61 6d 65 20 (let* ((runname
d340: 28 63 61 72 20 72 75 6e 29 29 0a 09 09 09 09 09 (car run))......
d350: 09 20 28 72 75 6e 64 61 74 20 20 28 63 64 72 20 . (rundat (cdr
d360: 72 75 6e 29 29 0a 09 09 09 09 09 09 20 28 6d 65 run))....... (me
d370: 74 61 64 61 74 20 28 6c 65 74 20 28 28 74 6d 70 tadat (let ((tmp
d380: 20 28 61 73 73 6f 63 20 22 6d 65 74 61 22 20 72 (assoc "meta" r
d390: 75 6e 64 61 74 29 29 29 0a 09 09 09 09 09 09 09 undat)))........
d3a0: 20 20 20 20 28 69 66 20 74 6d 70 20 28 63 64 72 (if tmp (cdr
d3b0: 20 74 6d 70 29 20 23 66 29 29 29 29 0a 09 09 09 tmp) #f))))....
d3c0: 09 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 .. ;; (print
d3d0: 22 72 75 6e 6e 61 6d 65 3a 20 22 20 72 75 6e 6e "runname: " runn
d3e0: 61 6d 65 20 22 5c 6e 5c 6e 72 75 6e 64 61 74 3a ame "\n\nrundat:
d3f0: 20 22 20 29 28 70 70 20 72 75 6e 64 61 74 29 28 " )(pp rundat)(
d400: 70 72 69 6e 74 20 22 5c 6e 5c 6e 6d 65 74 61 64 print "\n\nmetad
d410: 61 74 3a 20 22 29 28 70 70 20 6d 65 74 61 64 61 at: ")(pp metada
d420: 74 29 0a 09 09 09 09 09 20 20 20 20 28 69 66 20 t)...... (if
d430: 6d 65 74 61 64 61 74 0a 09 09 09 09 09 09 28 6d metadat.......(m
d440: 61 70 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c ap (lambda (fiel
d450: 64 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 d).......
d460: 28 6c 65 74 20 28 28 74 6d 70 20 28 61 73 73 6f (let ((tmp (asso
d470: 63 20 66 69 65 6c 64 20 6d 65 74 61 64 61 74 29 c field metadat)
d480: 29 29 0a 09 09 09 09 09 09 09 20 28 69 66 20 74 ))........ (if t
d490: 6d 70 20 28 63 64 72 20 74 6d 70 29 20 22 22 29 mp (cdr tmp) "")
d4a0: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 6d 65 ))....... me
d4b0: 74 61 64 61 74 2d 66 69 65 6c 64 73 29 0a 09 09 tadat-fields)...
d4c0: 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 09 09 ....(begin......
d4d0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
d4e0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
d4f0: 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 6d ort* "WARNING: m
d500: 65 74 61 20 64 61 74 61 20 66 6f 72 20 72 75 6e eta data for run
d510: 20 22 20 72 75 6e 6e 61 6d 65 20 22 20 6e 6f 74 " runname " not
d520: 20 66 6f 75 6e 64 22 29 0a 09 09 09 09 09 09 20 found").......
d530: 20 27 28 29 29 29 29 29 0a 09 09 09 09 09 61 6c '()))))......al
d540: 6c 72 75 6e 64 61 74 29 29 29 0a 09 09 20 3b 3b lrundat)))... ;;
d550: 20 27 28 20 28 20 22 74 61 72 67 65 74 22 20 28 '( ( "target" (
d560: 20 22 72 75 6e 6e 61 6d 65 22 20 28 20 22 64 61 "runname" ( "da
d570: 74 61 22 20 28 20 22 72 75 6e 69 64 22 20 28 20 ta" ( "runid" (
d580: 22 69 64 20 2e 20 22 33 37 22 20 29 20 28 20 2e "id . "37" ) ( .
d590: 2e 2e 20 29 29 29 29 0a 09 09 20 28 72 75 6e 2d .. ))))... (run-
d5a0: 70 61 67 65 73 20 20 20 20 20 20 28 6d 61 70 20 pages (map
d5b0: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 64 61 74 (lambda (targdat
d5c0: 29 0a 09 09 09 09 09 28 6c 65 74 2a 20 28 28 74 )......(let* ((t
d5d0: 61 72 67 65 74 20 20 28 63 61 72 20 74 61 72 67 arget (car targ
d5e0: 64 61 74 29 29 0a 09 09 09 09 09 20 20 20 20 20 dat))......
d5f0: 20 20 28 72 75 6e 73 64 61 74 20 28 63 64 72 20 (runsdat (cdr
d600: 74 61 72 67 64 61 74 29 29 29 0a 09 09 09 09 09 targdat)))......
d610: 20 20 28 69 66 20 72 75 6e 73 64 61 74 0a 09 09 (if runsdat...
d620: 09 09 09 20 20 20 20 20 20 28 6d 61 70 20 28 6c ... (map (l
d630: 61 6d 62 64 61 20 28 72 75 6e 64 61 74 29 0a 09 ambda (rundat)..
d640: 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 ..... (let*
d650: 28 28 72 75 6e 6e 61 6d 65 20 20 28 63 61 72 20 ((runname (car
d660: 72 75 6e 64 61 74 29 29 0a 09 09 09 09 09 09 09 rundat))........
d670: 20 20 20 20 28 72 75 6e 64 61 74 20 20 20 28 63 (rundat (c
d680: 64 72 20 72 75 6e 64 61 74 29 29 0a 09 09 09 09 dr rundat)).....
d690: 09 09 09 20 20 20 20 28 74 65 73 74 73 64 61 74 ... (testsdat
d6a0: 20 28 6c 65 74 20 28 28 74 6d 70 20 28 61 73 73 (let ((tmp (ass
d6b0: 6f 63 20 22 64 61 74 61 22 20 72 75 6e 64 61 74 oc "data" rundat
d6c0: 29 29 29 0a 09 09 09 09 09 09 09 09 09 28 69 66 )))..........(if
d6d0: 20 74 6d 70 20 28 63 64 72 20 74 6d 70 29 20 23 tmp (cdr tmp) #
d6e0: 66 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 f)))).......
d6f0: 20 20 20 28 69 66 20 74 65 73 74 73 64 61 74 0a (if testsdat.
d700: 09 09 09 09 09 09 09 20 20 20 28 6c 65 74 20 28 ....... (let (
d710: 28 74 65 73 74 73 20 28 6d 61 70 20 28 6c 61 6d (tests (map (lam
d720: 62 64 61 20 28 74 65 73 74 29 0a 09 09 09 09 09 bda (test)......
d730: 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 2a .... (let*
d740: 20 28 28 74 65 73 74 2d 69 64 20 20 28 63 61 72 ((test-id (car
d750: 20 74 65 73 74 29 29 0a 09 09 09 09 09 09 09 09 test)).........
d760: 09 09 20 20 20 20 20 20 28 74 65 73 74 2d 64 61 .. (test-da
d770: 74 20 28 63 64 72 20 74 65 73 74 29 29 29 0a 09 t (cdr test)))..
d780: 09 09 09 09 09 09 09 09 09 20 28 6d 61 70 20 28 ......... (map (
d790: 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 29 0a 09 lambda (field)..
d7a0: 09 09 09 09 09 09 09 09 09 09 28 6c 65 74 20 28 ..........(let (
d7b0: 28 74 6d 70 20 28 61 73 73 6f 63 20 66 69 65 6c (tmp (assoc fiel
d7c0: 64 20 74 65 73 74 2d 64 61 74 29 29 29 0a 09 09 d test-dat)))...
d7d0: 09 09 09 09 09 09 09 09 09 20 20 28 69 66 20 74 ......... (if t
d7e0: 6d 70 20 28 63 64 72 20 74 6d 70 29 20 22 22 29 mp (cdr tmp) "")
d7f0: 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 ))...........
d800: 20 20 20 72 75 6e 2d 66 69 65 6c 64 73 29 29 29 run-fields)))
d810: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 74 .......... t
d820: 65 73 74 73 64 61 74 29 29 29 0a 09 09 09 09 09 estsdat)))......
d830: 09 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 .. ;; (print
d840: 20 22 54 61 72 67 65 74 3a 20 22 20 74 61 72 67 "Target: " targ
d850: 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 et "/" runname "
d860: 20 74 65 73 74 73 3a 22 29 0a 09 09 09 09 09 09 tests:").......
d870: 09 20 20 20 20 20 3b 3b 20 28 70 70 20 74 65 73 . ;; (pp tes
d880: 74 73 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 ts)........
d890: 28 63 6f 6e 73 20 28 63 6f 6e 63 20 74 61 72 67 (cons (conc targ
d8a0: 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 0a et "/" runname).
d8b0: 09 09 09 09 09 09 09 09 20 20 20 28 63 6f 6e 73 ........ (cons
d8c0: 20 28 6c 69 73 74 20 28 63 6f 6e 63 20 74 61 72 (list (conc tar
d8d0: 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 get "/" runname)
d8e0: 29 0a 09 09 09 09 09 09 09 09 09 20 28 63 6f 6e ).......... (con
d8f0: 73 20 27 28 29 0a 09 09 09 09 09 09 09 09 09 20 s '()..........
d900: 20 20 20 20 20 20 28 63 6f 6e 73 20 72 75 6e 2d (cons run-
d910: 66 69 65 6c 64 73 20 74 65 73 74 73 29 29 29 29 fields tests))))
d920: 29 0a 09 09 09 09 09 09 09 20 20 20 28 62 65 67 )........ (beg
d930: 69 6e 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 in........ (
d940: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
d950: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
d960: 20 22 57 41 52 4e 49 4e 47 3a 20 72 75 6e 20 22 "WARNING: run "
d970: 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e target "/" runn
d980: 61 6d 65 20 22 20 61 70 70 65 61 72 73 20 74 6f ame " appears to
d990: 20 68 61 76 65 20 6e 6f 20 64 61 74 61 22 29 0a have no data").
d9a0: 09 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 28 ....... ;; (
d9b0: 70 70 20 72 75 6e 64 61 74 29 0a 09 09 09 09 09 pp rundat)......
d9c0: 09 09 20 20 20 20 20 27 28 29 29 29 29 29 0a 09 .. '()))))..
d9d0: 09 09 09 09 09 20 20 20 72 75 6e 73 64 61 74 29 ..... runsdat)
d9e0: 0a 09 09 09 09 09 20 20 20 20 20 20 27 28 29 29 ...... '())
d9f0: 29 29 0a 09 09 09 09 20 20 20 20 20 20 6e 65 77 ))..... new
da00: 64 61 74 29 29 20 3b 3b 20 77 65 20 75 73 65 20 dat)) ;; we use
da10: 6e 65 77 64 61 74 20 74 6f 20 67 65 74 20 74 61 newdat to get ta
da20: 72 67 65 74 0a 09 09 20 28 73 68 65 65 74 73 20 rget... (sheets
da30: 20 20 20 20 20 20 20 20 28 66 69 6c 74 65 72 20 (filter
da40: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 (lambda (x).....
da50: 09 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 . (not (null?
da60: 78 29 29 29 0a 09 09 09 09 09 20 28 63 6f 6e 73 x)))...... (cons
da70: 20 72 75 6e 73 20 28 6d 61 70 20 63 61 72 20 72 runs (map car r
da80: 75 6e 2d 70 61 67 65 73 29 29 29 29 29 0a 09 20 un-pages)))))..
da90: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 61 6c ;; (print "al
daa0: 6c 72 75 6e 64 61 74 3a 22 29 0a 09 20 20 20 20 lrundat:")..
dab0: 3b 3b 20 28 70 70 20 61 6c 6c 72 75 6e 64 61 74 ;; (pp allrundat
dac0: 29 0a 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 ).. ;; (print
dad0: 20 22 72 75 6e 73 3a 22 29 0a 09 20 20 20 20 3b "runs:").. ;
dae0: 3b 20 28 70 70 20 72 75 6e 73 29 0a 09 20 20 20 ; (pp runs)..
daf0: 20 3b 28 70 72 69 6e 74 20 22 73 68 65 65 74 73 ;(print "sheets
db00: 3a 20 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 70 : ").. ;; (pp
db10: 20 73 68 65 65 74 73 29 0a 09 20 20 20 20 28 69 sheets).. (i
db20: 66 20 28 65 71 3f 20 64 6d 6f 64 65 20 27 6f 64 f (eq? dmode 'od
db30: 73 29 0a 09 09 28 6c 65 74 2a 20 28 28 74 65 6d s)...(let* ((tem
db40: 70 64 69 72 20 20 20 20 28 63 6f 6e 63 20 22 2f pdir (conc "/
db50: 74 6d 70 2f 22 20 28 63 75 72 72 65 6e 74 2d 75 tmp/" (current-u
db60: 73 65 72 2d 6e 61 6d 65 29 20 22 2f 22 20 28 72 ser-name) "/" (r
db70: 61 6e 64 6f 6d 20 31 30 30 30 30 29 20 22 5f 22 andom 10000) "_"
db80: 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 (current-proces
db90: 73 2d 69 64 29 29 29 0a 09 09 20 20 20 20 20 20 s-id)))...
dba0: 20 28 6f 75 74 70 75 74 66 69 6c 65 20 28 6f 72 (outputfile (or
dbb0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
dbc0: 2d 6f 22 29 20 22 6f 75 74 2e 6f 64 73 22 29 29 -o") "out.ods"))
dbd0: 0a 09 09 20 20 20 20 20 20 20 28 6f 75 66 20 20 ... (ouf
dbe0: 20 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e (if (strin
dbf0: 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 g-match (regexp
dc00: 22 5e 5b 2f 7e 5d 2b 2e 2a 22 29 20 6f 75 74 70 "^[/~]+.*") outp
dc10: 75 74 66 69 6c 65 29 20 3b 3b 20 66 75 6c 6c 20 utfile) ;; full
dc20: 70 61 74 68 3f 0a 09 09 09 09 20 20 20 20 20 20 path?.....
dc30: 20 6f 75 74 70 75 74 66 69 6c 65 0a 09 09 09 09 outputfile.....
dc40: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 (begin...
dc50: 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ... (debug:print
dc60: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
dc70: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
dc80: 70 61 74 68 20 67 69 76 65 6e 2c 20 22 20 6f 75 path given, " ou
dc90: 74 70 75 74 66 69 6c 65 20 22 20 69 73 20 72 65 tputfile " is re
dca0: 6c 61 74 69 76 65 2c 20 70 72 65 66 69 78 69 6e lative, prefixin
dcb0: 67 20 77 69 74 68 20 63 75 72 72 65 6e 74 20 64 g with current d
dcc0: 69 72 65 63 74 6f 72 79 22 29 0a 09 09 09 09 09 irectory")......
dcd0: 20 28 63 6f 6e 63 20 28 63 75 72 72 65 6e 74 2d (conc (current-
dce0: 64 69 72 65 63 74 6f 72 79 29 20 22 2f 22 20 6f directory) "/" o
dcf0: 75 74 70 75 74 66 69 6c 65 29 29 29 29 29 0a 09 utputfile)))))..
dd00: 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 . (create-direc
dd10: 74 6f 72 79 20 74 65 6d 70 64 69 72 20 23 74 29 tory tempdir #t)
dd20: 0a 09 09 20 20 28 6f 64 73 3a 6c 69 73 74 2d 3e ... (ods:list->
dd30: 6f 64 73 20 74 65 6d 70 64 69 72 20 6f 75 66 20 ods tempdir ouf
dd40: 73 68 65 65 74 73 29 29 29 29 0a 09 20 20 3b 3b sheets)))).. ;;
dd50: 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
dd60: 72 6d 20 2d 72 66 20 22 20 74 65 6d 70 64 69 72 rm -rf " tempdir
dd70: 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 )).. (set! *did
dd80: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
dd90: 29 0a 0a 3b 3b 20 44 6f 6e 27 74 20 74 68 69 6e )..;; Don't thin
dda0: 6b 20 49 20 6e 65 65 64 20 74 68 69 73 2e 20 49 k I need this. I
ddb0: 6e 63 6f 72 70 6f 72 61 74 65 64 20 69 6e 74 6f ncorporated into
ddc0: 20 2d 6c 69 73 74 2d 72 75 6e 73 20 69 6e 73 74 -list-runs inst
ddd0: 65 61 64 0a 3b 3b 0a 3b 3b 20 28 69 66 20 28 61 ead.;;.;; (if (a
dde0: 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 nd (args:get-arg
ddf0: 20 22 2d 73 69 6e 63 65 22 29 0a 3b 3b 20 09 20 "-since").;; .
de00: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
de10: 3b 3b 20 20 20 20 20 28 6c 65 74 2a 20 28 28 73 ;; (let* ((s
de20: 69 6e 63 65 2d 74 69 6d 65 20 28 73 74 72 69 6e ince-time (strin
de30: 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a g->number (args:
de40: 67 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 22 get-arg "-since"
de50: 29 29 29 0a 3b 3b 20 09 20 20 20 28 72 75 6e 2d ))).;; . (run-
de60: 69 64 73 20 20 20 20 28 64 62 3a 67 65 74 2d 63 ids (db:get-c
de70: 68 61 6e 67 65 64 2d 72 75 6e 2d 69 64 73 20 73 hanged-run-ids s
de80: 69 6e 63 65 2d 74 69 6d 65 29 29 29 0a 3b 3b 20 ince-time))).;;
de90: 20 20 20 20 20 20 3b 3b 20 28 72 6d 74 3a 67 65 ;; (rmt:ge
dea0: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 73 t-tests-for-runs
deb0: 2d 6d 69 6e 64 61 74 61 20 72 75 6e 2d 69 64 73 -mindata run-ids
dec0: 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 testpatt states
ded0: 20 73 74 61 74 75 73 20 6e 6f 74 2d 69 6e 29 0a status not-in).
dee0: 3b 3b 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 ;; (print
def0: 28 73 6f 72 74 20 72 75 6e 2d 69 64 73 20 3c 29 (sort run-ids <)
df00: 29 0a 3b 3b 20 20 20 20 20 20 20 28 73 65 74 21 ).;; (set!
df10: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
df20: 23 74 29 29 29 0a 20 20 20 20 20 20 0a 20 20 20 #t))). .
df30: 20 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;==========
df40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
df80: 66 75 6c 6c 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d full run.;;=====
df90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dfa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dfb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dfc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dfd0: 3d 0a 0a 3b 3b 20 67 65 74 20 6c 6f 63 6b 20 69 =..;; get lock i
dfe0: 6e 20 64 62 20 66 6f 72 20 66 75 6c 6c 20 72 75 n db for full ru
dff0: 6e 20 66 6f 72 20 74 68 69 73 20 64 69 72 65 63 n for this direc
e000: 74 6f 72 79 0a 3b 3b 20 66 6f 72 20 61 6c 6c 20 tory.;; for all
e010: 74 65 73 74 73 20 77 69 74 68 20 64 65 70 73 0a tests with deps.
e020: 3b 3b 20 20 20 77 61 6c 6b 20 74 72 65 65 20 6f ;; walk tree o
e030: 66 20 74 65 73 74 73 20 74 6f 20 66 69 6e 64 20 f tests to find
e040: 68 65 61 64 20 74 61 73 6b 73 0a 3b 3b 20 20 20 head tasks.;;
e050: 61 64 64 20 68 65 61 64 20 74 61 73 6b 73 20 74 add head tasks t
e060: 6f 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 o task queue.;;
e070: 20 20 61 64 64 20 64 65 70 65 6e 64 61 6e 74 20 add dependant
e080: 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 tasks to task qu
e090: 65 75 65 20 0a 3b 3b 20 20 20 61 64 64 20 72 65 eue .;; add re
e0a0: 6d 61 69 6e 69 6e 67 20 74 61 73 6b 73 20 74 6f maining tasks to
e0b0: 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 66 task queue.;; f
e0c0: 6f 72 20 65 61 63 68 20 74 61 73 6b 20 69 6e 20 or each task in
e0d0: 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 20 20 task queue.;;
e0e0: 69 66 20 68 61 76 65 20 61 64 65 71 75 61 74 65 if have adequate
e0f0: 20 72 65 73 6f 75 72 63 65 73 0a 3b 3b 20 20 20 resources.;;
e100: 20 20 6c 61 75 6e 63 68 20 74 61 73 6b 0a 3b 3b launch task.;;
e110: 20 20 20 65 6c 73 65 0a 3b 3b 20 20 20 20 20 70 else.;; p
e120: 75 74 20 74 61 73 6b 20 69 6e 20 64 65 66 65 72 ut task in defer
e130: 72 65 64 20 71 75 65 75 65 0a 3b 3b 20 69 66 20 red queue.;; if
e140: 73 74 69 6c 6c 20 6f 6b 20 74 6f 20 72 75 6e 20 still ok to run
e150: 74 61 73 6b 73 0a 3b 3b 20 20 20 70 72 6f 63 65 tasks.;; proce
e160: 73 73 20 64 65 66 65 72 72 65 64 20 74 61 73 6b ss deferred task
e170: 73 20 70 65 72 20 61 62 6f 76 65 20 73 74 65 70 s per above step
e180: 73 0a 0a 3b 3b 20 72 75 6e 20 61 6c 6c 20 74 65 s..;; run all te
e190: 73 74 73 20 61 72 65 20 61 72 65 20 4e 6f 74 20 sts are are Not
e1a0: 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 50 41 COMPLETED and PA
e1b0: 53 53 20 6f 72 20 43 48 45 43 4b 0a 28 69 66 20 SS or CHECK.(if
e1c0: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
e1d0: 67 20 22 2d 72 75 6e 61 6c 6c 22 29 0a 09 28 61 g "-runall")..(a
e1e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
e1f0: 6e 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 n")..(args:get-a
e200: 72 67 20 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e rg "-rerun-clean
e210: 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
e220: 67 20 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 29 0a g "-rerun-all").
e230: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
e240: 2d 72 75 6e 74 65 73 74 73 22 29 29 0a 20 20 20 -runtests")).
e250: 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 (general-run-ca
e260: 6c 6c 20 0a 20 20 20 20 20 22 2d 72 75 6e 61 6c ll . "-runal
e270: 6c 22 0a 20 20 20 20 20 22 72 75 6e 20 61 6c 6c l". "run all
e280: 20 74 65 73 74 73 22 0a 20 20 20 20 20 28 6c 61 tests". (la
e290: 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
e2a0: 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c name keys keyval
e2b0: 73 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 61 s). (if (a
e2c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
e2d0: 72 75 6e 2d 63 6c 65 61 6e 22 29 20 3b 3b 20 66 run-clean") ;; f
e2e0: 69 72 73 74 20 73 65 74 20 73 74 61 74 65 73 2f irst set states/
e2f0: 73 74 61 74 75 73 65 73 20 63 6f 72 72 65 63 74 statuses correct
e300: 0a 09 20 20 20 28 6c 65 74 20 28 28 73 74 61 74 .. (let ((stat
e310: 65 73 20 20 20 28 6f 72 20 28 63 6f 6e 66 69 67 es (or (config
e320: 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
e330: 64 61 74 2a 20 22 76 61 6c 69 64 76 61 6c 75 65 dat* "validvalue
e340: 73 22 20 22 63 6c 65 61 6e 72 65 72 75 6e 2d 73 s" "cleanrerun-s
e350: 74 61 74 65 73 22 29 0a 09 09 09 20 20 20 20 20 tates")....
e360: 20 20 22 4b 49 4c 4c 52 45 51 2c 4b 49 4c 4c 45 "KILLREQ,KILLE
e370: 44 2c 55 4e 4b 4e 4f 57 4e 2c 49 4e 43 4f 4d 50 D,UNKNOWN,INCOMP
e380: 4c 45 54 45 2c 53 54 55 43 4b 2c 4e 4f 54 5f 53 LETE,STUCK,NOT_S
e390: 54 41 52 54 45 44 22 29 29 0a 09 09 20 28 73 74 TARTED"))... (st
e3a0: 61 74 75 73 65 73 20 28 6f 72 20 28 63 6f 6e 66 atuses (or (conf
e3b0: 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 igf:lookup *conf
e3c0: 69 67 64 61 74 2a 20 22 76 61 6c 69 64 76 61 6c igdat* "validval
e3d0: 75 65 73 22 20 22 63 6c 65 61 6e 72 65 72 75 6e ues" "cleanrerun
e3e0: 2d 73 74 61 74 75 73 65 73 22 29 0a 09 09 09 20 -statuses")....
e3f0: 20 20 20 20 20 20 22 46 41 49 4c 2c 49 4e 43 4f "FAIL,INCO
e400: 4d 50 4c 45 54 45 2c 41 42 4f 52 54 2c 43 48 45 MPLETE,ABORT,CHE
e410: 43 4b 22 29 29 29 0a 09 20 20 20 20 20 28 68 61 CK"))).. (ha
e420: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 72 sh-table-set! ar
e430: 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 70 72 gs:arg-hash "-pr
e440: 65 63 6c 65 61 6e 22 20 23 74 29 0a 09 20 20 20 eclean" #t)..
e450: 20 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d (runs:operate-
e460: 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 on 'set-state-st
e470: 61 74 75 73 0a 09 09 09 20 20 20 20 20 20 74 61 atus.... ta
e480: 72 67 65 74 0a 09 09 09 20 20 20 20 20 20 28 63 rget.... (c
e490: 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 ommon:args-get-r
e4a0: 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 unname) ;; (or
e4b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
e4c0: 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 runname")(args:g
e4d0: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
e4e0: 22 29 29 0a 09 09 09 20 20 20 20 20 20 22 25 22 ")).... "%"
e4f0: 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 ;; (common:args
e500: 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 -get-testpatt #f
e510: 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 ) ;; (args:get-a
e520: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a rg "-testpatt").
e530: 09 09 09 20 20 20 20 20 20 73 74 61 74 65 3a 20 ... state:
e540: 20 73 74 61 74 65 73 0a 09 09 09 20 20 20 20 20 states....
e550: 20 3b 3b 20 73 74 61 74 75 73 3a 20 73 74 61 74 ;; status: stat
e560: 75 73 65 73 0a 09 09 09 20 20 20 20 20 20 6e 65 uses.... ne
e570: 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a 20 w-state-status:
e580: 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 "NOT_STARTED,n/a
e590: 22 29 0a 09 20 20 20 20 20 28 72 75 6e 73 3a 6f ").. (runs:o
e5a0: 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 perate-on 'set-s
e5b0: 74 61 74 65 2d 73 74 61 74 75 73 0a 09 09 09 20 tate-status....
e5c0: 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 20 target....
e5d0: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 (common:arg
e5e0: 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 s-get-runname)
e5f0: 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 ;; (or (args:get
e600: 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 -arg "-runname")
e610: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
e620: 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 runname"))....
e630: 20 20 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d 6d "%" ;; (comm
e640: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
e650: 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 patt #f) ;; (arg
e660: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
e670: 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 20 patt")....
e680: 3b 3b 20 73 74 61 74 65 3a 20 20 73 74 61 74 65 ;; state: state
e690: 73 0a 09 09 09 20 20 20 20 20 20 73 74 61 74 75 s.... statu
e6a0: 73 3a 20 73 74 61 74 75 73 65 73 0a 09 09 09 20 s: statuses....
e6b0: 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 new-state-s
e6c0: 74 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 tatus: "NOT_STAR
e6d0: 54 45 44 2c 6e 2f 61 22 29 29 29 0a 20 20 20 20 TED,n/a"))).
e6e0: 20 20 20 3b 3b 20 52 45 52 55 4e 20 41 4c 4c 0a ;; RERUN ALL.
e6f0: 20 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 (if (args
e700: 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 72 75 6e :get-arg "-rerun
e710: 2d 61 6c 6c 22 29 20 3b 3b 20 66 69 72 73 74 20 -all") ;; first
e720: 73 65 74 20 73 74 61 74 65 73 2f 73 74 61 74 75 set states/statu
e730: 73 65 73 20 63 6f 72 72 65 63 74 0a 09 20 20 20 ses correct..
e740: 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 68 61 (begin.. (ha
e750: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 72 sh-table-set! ar
e760: 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 70 72 gs:arg-hash "-pr
e770: 65 63 6c 65 61 6e 22 20 23 74 29 0a 09 20 20 20 eclean" #t)..
e780: 20 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d (runs:operate-
e790: 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 on 'set-state-st
e7a0: 61 74 75 73 0a 09 09 09 20 20 20 20 20 20 74 61 atus.... ta
e7b0: 72 67 65 74 0a 09 09 09 20 20 20 20 20 20 28 63 rget.... (c
e7c0: 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 ommon:args-get-r
e7d0: 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 unname) ;; (or
e7e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
e7f0: 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 runname")(args:g
e800: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
e810: 22 29 29 0a 09 09 09 20 20 20 20 20 20 22 25 22 ")).... "%"
e820: 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 ;; (common:args
e830: 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 -get-testpatt #f
e840: 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 ) ;; (args:get-a
e850: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a rg "-testpatt").
e860: 09 09 09 20 20 20 20 20 20 73 74 61 74 65 3a 20 ... state:
e870: 20 23 66 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 #f.... ;;
e880: 73 74 61 74 75 73 3a 20 73 74 61 74 75 73 65 73 status: statuses
e890: 0a 09 09 09 20 20 20 20 20 20 6e 65 77 2d 73 74 .... new-st
e8a0: 61 74 65 2d 73 74 61 74 75 73 3a 20 22 4e 4f 54 ate-status: "NOT
e8b0: 5f 53 54 41 52 54 45 44 2c 6e 2f 61 22 29 0a 09 _STARTED,n/a")..
e8c0: 20 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 61 (runs:opera
e8d0: 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 te-on 'set-state
e8e0: 2d 73 74 61 74 75 73 0a 09 09 09 20 20 20 20 20 -status....
e8f0: 20 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 20 target....
e900: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
e910: 74 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 t-runname) ;; (
e920: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
e930: 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 "-runname")(arg
e940: 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e s:get-arg ":runn
e950: 61 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 20 ame"))....
e960: 22 25 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 "%" ;; (common:a
e970: 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 rgs-get-testpatt
e980: 20 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 #f) ;; (args:ge
e990: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
e9a0: 22 29 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 73 ").... ;; s
e9b0: 74 61 74 65 3a 20 20 73 74 61 74 65 73 0a 09 09 tate: states...
e9c0: 09 20 20 20 20 20 20 73 74 61 74 75 73 3a 20 23 . status: #
e9d0: 66 0a 09 09 09 20 20 20 20 20 20 6e 65 77 2d 73 f.... new-s
e9e0: 74 61 74 65 2d 73 74 61 74 75 73 3a 20 22 4e 4f tate-status: "NO
e9f0: 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 22 29 29 T_STARTED,n/a"))
ea00: 29 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a 72 ). (runs:r
ea10: 75 6e 2d 74 65 73 74 73 20 74 61 72 67 65 74 0a un-tests target.
ea20: 09 09 20 20 20 20 20 20 20 72 75 6e 6e 61 6d 65 .. runname
ea30: 0a 09 09 20 20 20 20 20 20 20 23 66 20 3b 3b 20 ... #f ;;
ea40: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
ea50: 2d 74 65 73 74 70 61 74 74 20 23 66 29 0a 09 09 -testpatt #f)...
ea60: 20 20 20 20 20 20 20 3b 3b 20 28 6f 72 20 28 61 ;; (or (a
ea70: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
ea80: 73 74 70 61 74 74 22 29 0a 09 09 20 20 20 20 20 stpatt")...
ea90: 20 20 3b 3b 20 20 20 20 20 22 25 22 29 0a 09 09 ;; "%")...
eaa0: 20 20 20 20 20 20 20 75 73 65 72 0a 09 09 20 20 user...
eab0: 20 20 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 args:arg-ha
eac0: 73 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d sh))))..;;======
ead0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eaf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb10: 0a 3b 3b 20 72 75 6e 20 6f 6e 65 20 74 65 73 74 .;; run one test
eb20: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
eb30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e =========..;; 1.
eb70: 20 66 69 6e 64 20 74 68 65 20 63 6f 6e 66 69 67 find the config
eb80: 20 66 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 61 6e file.;; 2. chan
eb90: 67 65 20 74 6f 20 74 68 65 20 74 65 73 74 20 64 ge to the test d
eba0: 69 72 65 63 74 6f 72 79 0a 3b 3b 20 33 2e 20 75 irectory.;; 3. u
ebb0: 70 64 61 74 65 20 74 68 65 20 64 62 20 77 69 74 pdate the db wit
ebc0: 68 20 22 74 65 73 74 20 73 74 61 72 74 65 64 22 h "test started"
ebd0: 20 73 74 61 74 75 73 2c 20 73 65 74 20 72 75 6e status, set run
ebe0: 6e 69 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 2e 20 ning host.;; 4.
ebf0: 70 72 6f 63 65 73 73 20 6c 61 75 6e 63 68 20 74 process launch t
ec00: 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 he test.;; -
ec10: 6d 6f 6e 69 74 6f 72 20 74 68 65 20 70 72 6f 63 monitor the proc
ec20: 65 73 73 2c 20 75 70 64 61 74 65 20 73 74 61 74 ess, update stat
ec30: 73 20 69 6e 20 74 68 65 20 64 62 20 65 76 65 72 s in the db ever
ec40: 79 20 32 5e 6e 20 6d 69 6e 75 74 65 73 0a 3b 3b y 2^n minutes.;;
ec50: 20 35 2e 20 61 73 20 74 68 65 20 74 65 73 74 20 5. as the test
ec60: 70 72 6f 63 65 65 64 73 20 69 6e 74 65 72 6e 61 proceeds interna
ec70: 6c 6c 79 20 69 74 20 63 61 6c 6c 73 20 6d 65 67 lly it calls meg
ec80: 61 74 65 73 74 20 61 73 20 65 61 63 68 20 73 74 atest as each st
ec90: 65 70 20 69 73 0a 3b 3b 20 20 20 20 73 74 61 72 ep is.;; star
eca0: 74 65 64 20 61 6e 64 20 63 6f 6d 70 6c 65 74 65 ted and complete
ecb0: 64 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 73 d.;; - step s
ecc0: 74 61 72 74 65 64 2c 20 74 69 6d 65 73 74 61 6d tarted, timestam
ecd0: 70 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 63 p.;; - step c
ece0: 6f 6d 70 6c 65 74 65 64 2c 20 65 78 69 74 20 73 ompleted, exit s
ecf0: 74 61 74 75 73 2c 20 74 69 6d 65 73 74 61 6d 70 tatus, timestamp
ed00: 0a 3b 3b 20 36 2e 20 74 65 73 74 20 70 68 6f 6e .;; 6. test phon
ed10: 65 20 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d 20 69 e home.;; - i
ed20: 66 20 74 65 73 74 20 72 75 6e 20 74 69 6d 65 20 f test run time
ed30: 3e 20 61 6c 6c 6f 77 65 64 20 72 75 6e 20 74 69 > allowed run ti
ed40: 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 me then kill job
ed50: 0a 3b 3b 20 20 20 20 2d 20 69 66 20 63 61 6e 6e .;; - if cann
ed60: 6f 74 20 61 63 63 65 73 73 20 64 62 20 3e 20 61 ot access db > a
ed70: 6c 6c 6f 77 65 64 20 64 69 73 63 6f 6e 6e 65 63 llowed disconnec
ed80: 74 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c t time then kill
ed90: 20 6a 6f 62 0a 0a 3b 3b 20 3d 3d 20 64 75 70 6c job..;; == dupl
eda0: 69 63 61 74 65 64 20 3d 3d 20 28 69 66 20 28 6f icated == (if (o
edb0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
edc0: 22 2d 72 75 6e 22 29 28 61 72 67 73 3a 67 65 74 "-run")(args:get
edd0: 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 -arg "-runtests"
ede0: 29 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 )).;; == duplica
edf0: 74 65 64 20 3d 3d 20 20 20 28 67 65 6e 65 72 61 ted == (genera
ee00: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 3b 3b 20 3d l-run-call .;; =
ee10: 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
ee20: 20 20 20 22 2d 72 75 6e 74 65 73 74 73 22 20 0a "-runtests" .
ee30: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
ee40: 20 3d 3d 20 20 20 20 22 72 75 6e 20 61 20 74 65 == "run a te
ee50: 73 74 22 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 st" .;; == dupli
ee60: 63 61 74 65 64 20 3d 3d 20 20 20 20 28 6c 61 6d cated == (lam
ee70: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
ee80: 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 ame keys keyvals
ee90: 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 ).;; == duplicat
eea0: 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 0a 3b 3b ed == ;;.;;
eeb0: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
eec0: 3d 20 20 20 20 20 20 3b 3b 20 4d 61 79 20 6f 72 = ;; May or
eed0: 20 6d 61 79 20 6e 6f 74 20 69 6d 70 6c 65 6d 65 may not impleme
eee0: 6e 74 20 69 74 20 74 68 69 73 20 77 61 79 20 2e nt it this way .
eef0: 2e 2e 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 ...;; == duplica
ef00: 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 0a 3b ted == ;;.;
ef10: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
ef20: 3d 3d 20 20 20 20 20 20 3b 3b 20 49 6e 73 65 72 == ;; Inser
ef30: 74 20 74 68 69 73 20 72 75 6e 20 69 6e 74 6f 20 t this run into
ef40: 74 68 65 20 74 61 73 6b 73 20 71 75 65 75 65 0a the tasks queue.
ef50: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
ef60: 20 3d 3d 20 20 20 20 20 20 3b 3b 20 28 6f 70 65 == ;; (ope
ef70: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b n-run-close task
ef80: 73 3a 61 64 64 20 74 61 73 6b 73 3a 6f 70 65 6e s:add tasks:open
ef90: 2d 64 62 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 -db .;; == dupli
efa0: 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b cated == ;;
efb0: 20 20 20 20 09 20 20 20 20 20 22 72 75 6e 74 65 . "runte
efc0: 73 74 73 22 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c sts" .;; == dupl
efd0: 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b icated == ;
efe0: 3b 20 20 20 20 09 20 20 20 20 20 75 73 65 72 0a ; . user.
eff0: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f000: 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 == ;; .
f010: 20 20 20 20 20 74 61 72 67 65 74 0a 3b 3b 20 3d target.;; =
f020: 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
f030: 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 ;; .
f040: 20 72 75 6e 6e 61 6d 65 0a 3b 3b 20 3d 3d 20 64 runname.;; == d
f050: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
f060: 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 28 61 ;; . (a
f070: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
f080: 6e 74 65 73 74 73 22 29 0a 3b 3b 20 3d 3d 20 64 ntests").;; == d
f090: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
f0a0: 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 23 66 ;; . #f
f0b0: 29 29 29 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 )))).;; == dupli
f0c0: 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 28 72 cated == (r
f0d0: 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 uns:run-tests ta
f0e0: 72 67 65 74 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 rget.;; == dupli
f0f0: 63 61 74 65 64 20 3d 3d 20 09 09 20 20 20 20 20 cated == ..
f100: 72 75 6e 6e 61 6d 65 0a 3b 3b 20 3d 3d 20 64 75 runname.;; == du
f110: 70 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 20 20 plicated == ..
f120: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d (common:args-
f130: 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 get-testpatt #f)
f140: 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ;; (args:get-ar
f150: 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 3b g "-runtests").;
f160: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
f170: 3d 3d 20 09 09 20 20 20 20 20 75 73 65 72 0a 3b == .. user.;
f180: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
f190: 3d 3d 20 09 09 20 20 20 20 20 61 72 67 73 3a 61 == .. args:a
f1a0: 72 67 2d 68 61 73 68 29 29 29 29 0a 0a 3b 3b 3d rg-hash))))..;;=
f1b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f1c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f1d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f1e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f1f0: 3d 3d 3d 3d 3d 0a 3b 3b 20 52 6f 6c 6c 75 70 20 =====.;; Rollup
f200: 69 6e 74 6f 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d into a run.;;===
f210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f250: 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
f260: 65 74 2d 61 72 67 20 22 2d 72 6f 6c 6c 75 70 22 et-arg "-rollup"
f270: 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 ). (general-r
f280: 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d un-call . "-
f290: 72 6f 6c 6c 75 70 22 20 0a 20 20 20 20 20 22 72 rollup" . "r
f2a0: 6f 6c 6c 75 70 20 74 65 73 74 73 22 20 0a 20 20 ollup tests" .
f2b0: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
f2c0: 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
f2d0: 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 keyvals).
f2e0: 28 72 75 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e (runs:rollup-run
f2f0: 20 6b 65 79 73 0a 09 09 09 6b 65 79 76 61 6c 73 keys....keyvals
f300: 0a 09 09 09 28 6f 72 20 28 61 72 67 73 3a 67 65 ....(or (args:ge
f310: 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
f320: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
f330: 3a 72 75 6e 6e 61 6d 65 22 29 20 29 0a 09 09 09 :runname") )....
f340: 75 73 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d user))))..;;====
f350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f390: 3d 3d 0a 3b 3b 20 4c 6f 63 6b 20 6f 72 20 75 6e ==.;; Lock or un
f3a0: 6c 6f 63 6b 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d lock a run.;;===
f3b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f3c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f3d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f3e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f3f0: 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 ===..(if (or (ar
f400: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 gs:get-arg "-loc
f410: 6b 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 k")(args:get-arg
f420: 20 22 2d 75 6e 6c 6f 63 6b 22 29 29 0a 20 20 20 "-unlock")).
f430: 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 (general-run-ca
f440: 6c 6c 20 0a 20 20 20 20 20 28 69 66 20 28 61 72 ll . (if (ar
f450: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 gs:get-arg "-loc
f460: 6b 22 29 20 22 2d 6c 6f 63 6b 22 20 22 2d 75 6e k") "-lock" "-un
f470: 6c 6f 63 6b 22 29 0a 20 20 20 20 20 22 6c 6f 63 lock"). "loc
f480: 6b 2f 75 6e 6c 6f 63 6b 20 74 65 73 74 73 22 20 k/unlock tests"
f490: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 . (lambda (t
f4a0: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
f4b0: 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 ys keyvals).
f4c0: 20 20 20 28 72 75 6e 73 3a 68 61 6e 64 6c 65 2d (runs:handle-
f4d0: 6c 6f 63 6b 69 6e 67 20 0a 09 09 20 20 74 61 72 locking ... tar
f4e0: 67 65 74 0a 09 09 20 20 6b 65 79 73 0a 09 09 20 get... keys...
f4f0: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
f500: 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 rg "-runname")(a
f510: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 rgs:get-arg ":ru
f520: 6e 6e 61 6d 65 22 29 20 29 0a 09 09 20 20 28 61 nname") )... (a
f530: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
f540: 63 6b 22 29 0a 09 09 20 20 28 61 72 67 73 3a 67 ck")... (args:g
f550: 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b 22 et-arg "-unlock"
f560: 29 0a 09 09 20 20 75 73 65 72 29 29 29 29 0a 0a )... user))))..
f570: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
f580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 47 65 74 20 ========.;; Get
f5c0: 70 61 74 68 73 20 74 6f 20 74 65 73 74 73 0a 3b paths to tests.;
f5d0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
f5e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f5f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f610: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 65 74 20 74 =======.;; Get t
f620: 65 73 74 20 70 61 74 68 73 20 6d 61 74 63 68 69 est paths matchi
f630: 6e 67 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 ng target, runna
f640: 6d 65 2c 20 61 6e 64 20 74 65 73 74 70 61 74 74 me, and testpatt
f650: 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 .(if (or (args:g
f660: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 et-arg "-test-fi
f670: 6c 65 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 les")(args:get-a
f680: 72 67 20 22 2d 74 65 73 74 2d 70 61 74 68 73 22 rg "-test-paths"
f690: 29 29 0a 20 20 20 20 3b 3b 20 69 66 20 77 65 20 )). ;; if we
f6a0: 61 72 65 20 69 6e 20 61 20 74 65 73 74 20 75 73 are in a test us
f6b0: 65 20 74 68 65 20 4d 54 5f 43 4d 44 49 4e 46 4f e the MT_CMDINFO
f6c0: 20 64 61 74 61 0a 20 20 20 20 28 69 66 20 28 67 data. (if (g
f6d0: 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
f6e0: 4f 22 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 O")..(let* ((sta
f6f0: 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 65 6e rtingdir (curren
f700: 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 20 t-directory))..
f710: 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 (cmdinfo
f720: 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e (common:read-en
f730: 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 67 65 coded-string (ge
f740: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
f750: 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 72 "))).. (tr
f760: 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f 64 ansport (assoc/d
f770: 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f 72 efault 'transpor
f780: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
f790: 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 (testpath (
f7a0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
f7b0: 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
f7c0: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
f7d0: 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 -name (assoc/def
f7e0: 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 ault 'test-name
f7f0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
f800: 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 (runscript (as
f810: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
f820: 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 script cmdinfo))
f830: 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 .. (db-hos
f840: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
f850: 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d lt 'db-host cm
f860: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
f870: 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f (run-id (asso
f880: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 c/default 'run-i
f890: 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 d cmdinfo))..
f8a0: 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 (itemdat
f8b0: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
f8c0: 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 'itemdat cmdi
f8d0: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 73 nfo)).. (s
f8e0: 74 61 74 65 20 20 20 20 20 28 61 72 67 73 3a 67 tate (args:g
f8f0: 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 et-arg ":state")
f900: 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 75 ).. (statu
f910: 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 s (args:get-a
f920: 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a 09 rg ":status"))..
f930: 20 20 20 20 20 20 20 28 74 61 72 67 65 74 20 20 (target
f940: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
f950: 22 2d 74 61 72 67 65 74 22 29 29 0a 09 20 20 20 "-target"))..
f960: 20 20 20 20 28 74 6f 70 70 61 74 68 20 20 20 28 (toppath (
f970: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
f980: 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 66 6f oppath cmdinfo
f990: 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 ))).. (change-d
f9a0: 69 72 65 63 74 6f 72 79 20 74 6f 70 70 61 74 68 irectory toppath
f9b0: 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 74 61 ).. (if (not ta
f9c0: 72 67 65 74 29 0a 09 20 20 20 20 20 20 28 62 65 rget).. (be
f9d0: 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 gin...(debug:pri
f9e0: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
f9f0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d ult-log-port* "-
fa00: 74 61 72 67 65 74 20 69 73 20 72 65 71 75 69 72 target is requir
fa10: 65 64 2e 22 29 0a 09 09 28 65 78 69 74 20 31 29 ed.")...(exit 1)
fa20: 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 )).. (if (not (
fa30: 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 launch:setup))..
fa40: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 (begin...(
fa50: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
fa60: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
fa70: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
fa80: 70 2c 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 p, giving up on
fa90: 2d 74 65 73 74 2d 70 61 74 68 73 20 6f 72 20 2d -test-paths or -
faa0: 74 65 73 74 2d 66 69 6c 65 73 2c 20 65 78 69 74 test-files, exit
fab0: 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 ing")...(exit 1)
fac0: 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 )).. (let* ((ke
fad0: 79 73 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d ys (rmt:get-
fae0: 6b 65 79 73 29 29 0a 09 09 20 3b 3b 20 64 62 3a keys))... ;; db:
faf0: 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 20 6d test-get-paths m
fb00: 75 73 74 20 6e 6f 74 20 62 65 20 72 75 6e 20 72 ust not be run r
fb10: 65 6d 6f 74 65 0a 09 09 20 28 70 61 74 68 73 20 emote... (paths
fb20: 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 67 (tests:test-g
fb30: 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e et-paths-matchin
fb40: 67 20 6b 65 79 73 20 74 61 72 67 65 74 20 28 61 g keys target (a
fb50: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
fb60: 73 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 st-files"))))..
fb70: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
fb80: 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 ething* #t)..
fb90: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
fba0: 64 61 20 28 70 61 74 68 29 0a 09 09 09 28 70 72 da (path)....(pr
fbb0: 69 6e 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 int path))...
fbc0: 20 20 20 70 61 74 68 73 29 29 29 0a 09 3b 3b 20 paths)))..;;
fbd0: 65 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 else do a genera
fbe0: 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 6e l-run-call..(gen
fbf0: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 eral-run-call ..
fc00: 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 0a 09 "-test-files"..
fc10: 20 22 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 "Get paths to t
fc20: 65 73 74 22 0a 09 20 28 6c 61 6d 62 64 61 20 28 est".. (lambda (
fc30: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
fc40: 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 09 20 20 eys keyvals)..
fc50: 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 (let* ((db
fc60: 20 20 23 66 29 0a 09 09 20 20 3b 3b 20 44 4f 20 #f)... ;; DO
fc70: 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 NOT run remote..
fc80: 09 20 20 28 70 61 74 68 73 20 20 20 20 28 74 65 . (paths (te
fc90: 73 74 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 sts:test-get-pat
fca0: 68 73 2d 6d 61 74 63 68 69 6e 67 20 6b 65 79 73 hs-matching keys
fcb0: 20 74 61 72 67 65 74 20 28 61 72 67 73 3a 67 65 target (args:ge
fcc0: 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c t-arg "-test-fil
fcd0: 65 73 22 29 29 29 29 0a 09 20 20 20 20 20 28 66 es")))).. (f
fce0: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
fcf0: 28 70 61 74 68 29 0a 09 09 09 20 28 70 72 69 6e (path).... (prin
fd00: 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 t path))...
fd10: 20 20 70 61 74 68 73 29 29 29 29 29 29 0a 0a 3b paths))))))..;
fd20: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
fd30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fd40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fd50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fd60: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 =======.;; Archi
fd70: 76 65 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d ve tests.;;=====
fd80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fd90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fda0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fdb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fdc0: 3d 0a 3b 3b 20 41 72 63 68 69 76 65 20 74 65 73 =.;; Archive tes
fdd0: 74 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 ts matching targ
fde0: 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 et, runname, and
fdf0: 20 74 65 73 74 70 61 74 74 0a 28 69 66 20 28 61 testpatt.(if (a
fe00: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 61 72 rgs:get-arg "-ar
fe10: 63 68 69 76 65 22 29 0a 20 20 20 20 3b 3b 20 65 chive"). ;; e
fe20: 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 6c lse do a general
fe30: 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 28 67 -run-call. (g
fe40: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
fe50: 0a 20 20 20 20 20 22 2d 61 72 63 68 69 76 65 22 . "-archive"
fe60: 0a 20 20 20 20 20 22 41 72 63 68 69 76 65 22 0a . "Archive".
fe70: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 (lambda (ta
fe80: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
fe90: 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 s keyvals).
fea0: 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 61 (operate-on 'a
feb0: 72 63 68 69 76 65 29 29 29 29 0a 0a 3b 3b 3d 3d rchive))))..;;==
fec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ff00: 3d 3d 3d 3d 0a 3b 3b 20 45 78 74 72 61 63 74 20 ====.;; Extract
ff10: 61 20 73 70 72 65 61 64 73 68 65 65 74 20 66 72 a spreadsheet fr
ff20: 6f 6d 20 74 68 65 20 72 75 6e 73 20 64 61 74 61 om the runs data
ff30: 62 61 73 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d base.;;=========
ff40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ff50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ff60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ff70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
ff80: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
ff90: 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 "-extract-ods")
ffa0: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
ffb0: 6e 2d 63 61 6c 6c 0a 20 20 20 20 20 22 2d 65 78 n-call. "-ex
ffc0: 74 72 61 63 74 2d 6f 64 73 22 0a 20 20 20 20 20 tract-ods".
ffd0: 22 4d 61 6b 65 20 6f 64 73 20 73 70 72 65 61 64 "Make ods spread
ffe0: 73 68 65 65 74 22 0a 20 20 20 20 20 28 6c 61 6d sheet". (lam
fff0: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
10000 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 ame keys keyvals
10010 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 ). (let ((
10020 64 62 73 74 72 75 63 74 20 20 20 28 6d 61 6b 65 dbstruct (make
10030 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 -dbr:dbstruct pa
10040 74 68 3a 20 2a 74 6f 70 70 61 74 68 2a 20 6c 6f th: *toppath* lo
10050 63 61 6c 3a 20 23 74 29 29 0a 09 20 20 20 20 20 cal: #t))..
10060 28 6f 75 74 70 75 74 66 69 6c 65 20 28 61 72 67 (outputfile (arg
10070 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 s:get-arg "-extr
10080 61 63 74 2d 6f 64 73 22 29 29 0a 09 20 20 20 20 act-ods"))..
10090 20 28 72 75 6e 73 70 61 74 74 20 20 20 28 6f 72 (runspatt (or
100a0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
100b0 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a -runname")(args:
100c0 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d get-arg ":runnam
100d0 65 22 29 29 29 0a 09 20 20 20 20 20 28 70 61 74 e"))).. (pat
100e0 68 6d 6f 64 20 20 20 20 28 61 72 67 73 3a 67 65 hmod (args:ge
100f0 74 2d 61 72 67 20 22 2d 70 61 74 68 6d 6f 64 22 t-arg "-pathmod"
10100 29 29 29 0a 09 20 20 20 20 20 3b 3b 20 28 6b 65 ))).. ;; (ke
10110 79 76 61 6c 61 6c 69 73 74 20 28 6b 65 79 73 2d yvalalist (keys-
10120 3e 61 6c 69 73 74 20 6b 65 79 73 20 22 25 22 29 >alist keys "%")
10130 29 29 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e )).. (debug:prin
10140 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 2 *default-log
10150 2d 70 6f 72 74 2a 20 22 45 78 74 72 61 63 74 20 -port* "Extract
10160 6f 64 73 2c 20 6f 75 74 70 75 74 66 69 6c 65 3a ods, outputfile:
10170 20 22 20 6f 75 74 70 75 74 66 69 6c 65 20 22 20 " outputfile "
10180 72 75 6e 73 70 61 74 74 3a 20 22 20 72 75 6e 73 runspatt: " runs
10190 70 61 74 74 20 22 20 6b 65 79 76 61 6c 73 3a 20 patt " keyvals:
101a0 22 20 6b 65 79 76 61 6c 73 29 0a 09 20 28 64 62 " keyvals).. (db
101b0 3a 65 78 74 72 61 63 74 2d 6f 64 73 2d 66 69 6c :extract-ods-fil
101c0 65 20 64 62 73 74 72 75 63 74 20 6f 75 74 70 75 e dbstruct outpu
101d0 74 66 69 6c 65 20 6b 65 79 76 61 6c 73 20 28 69 tfile keyvals (i
101e0 66 20 72 75 6e 73 70 61 74 74 20 72 75 6e 73 70 f runspatt runsp
101f0 61 74 74 20 22 25 22 29 20 70 61 74 68 6d 6f 64 att "%") pathmod
10200 29 0a 09 20 28 64 62 3a 63 6c 6f 73 65 2d 61 6c ).. (db:close-al
10210 6c 20 64 62 73 74 72 75 63 74 29 0a 09 20 28 73 l dbstruct).. (s
10220 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
10230 67 2a 20 23 74 29 29 29 29 29 0a 0a 3b 3b 3d 3d g* #t)))))..;;==
10240 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10250 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10260 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10270 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10280 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 63 75 74 65 20 ====.;; execute
10290 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d the test.;; -
102a0 20 67 65 74 73 20 63 61 6c 6c 65 64 20 6f 6e 20 gets called on
102b0 72 65 6d 6f 74 65 20 68 6f 73 74 0a 3b 3b 20 20 remote host.;;
102c0 20 20 2d 20 72 65 63 65 69 76 65 73 20 69 6e 66 - receives inf
102d0 6f 20 66 72 6f 6d 20 74 68 65 20 2d 65 78 65 63 o from the -exec
102e0 75 74 65 20 70 61 72 61 6d 0a 3b 3b 20 20 20 20 ute param.;;
102f0 2d 20 70 61 73 73 65 73 20 69 6e 66 6f 20 74 6f - passes info to
10300 20 73 74 65 70 73 20 76 69 61 20 4d 54 5f 43 4d steps via MT_CM
10310 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 28 66 DINFO env var (f
10320 75 74 75 72 65 20 69 73 20 74 6f 20 75 73 65 20 uture is to use
10330 61 20 64 6f 74 20 66 69 6c 65 29 0a 3b 3b 20 20 a dot file).;;
10340 20 20 2d 20 67 61 74 68 65 72 73 20 68 6f 73 74 - gathers host
10350 20 69 6e 66 6f 20 61 6e 64 20 0a 3b 3b 3d 3d 3d info and .;;===
10360 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10370 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10380 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10390 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
103a0 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
103b0 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 65 et-arg "-execute
103c0 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
103d0 20 20 20 20 28 6c 61 75 6e 63 68 3a 65 78 65 63 (launch:exec
103e0 75 74 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ute (args:get-ar
103f0 67 20 22 2d 65 78 65 63 75 74 65 22 29 29 0a 20 g "-execute")).
10400 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
10410 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
10420 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
10430 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10440 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10450 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10460 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 65 63 =========.;; rec
10470 6f 76 65 72 20 66 72 6f 6d 20 61 20 74 65 73 74 over from a test
10480 20 77 68 65 72 65 20 74 68 65 20 6d 61 6e 61 67 where the manag
10490 69 6e 67 20 6d 74 65 73 74 20 77 61 73 20 6b 69 ing mtest was ki
104a0 6c 6c 65 64 20 62 75 74 20 74 68 65 20 75 6e 64 lled but the und
104b0 65 72 6c 79 69 6e 67 0a 3b 3b 20 70 72 6f 63 65 erlying.;; proce
104c0 73 73 20 6d 69 67 68 74 20 73 74 69 6c 6c 20 62 ss might still b
104d0 65 20 73 61 6c 76 61 67 65 61 62 6c 65 0a 3b 3b e salvageable.;;
104e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10500 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10510 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10520 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 ======..(if (arg
10530 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 63 6f s:get-arg "-reco
10540 76 65 72 2d 74 65 73 74 22 29 0a 20 20 20 20 28 ver-test"). (
10550 6c 65 74 2a 20 28 28 70 61 72 61 6d 73 20 28 73 let* ((params (s
10560 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 61 72 67 tring-split (arg
10570 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 63 6f s:get-arg "-reco
10580 76 65 72 2d 74 65 73 74 22 29 20 22 2c 22 29 29 ver-test") ","))
10590 29 0a 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 ). (if (> (
105a0 6c 65 6e 67 74 68 20 70 61 72 61 6d 73 29 20 31 length params) 1
105b0 29 20 3b 3b 20 72 75 6e 2d 69 64 20 61 6e 64 20 ) ;; run-id and
105c0 74 65 73 74 2d 69 64 0a 09 20 20 28 6c 65 74 20 test-id.. (let
105d0 28 28 72 75 6e 2d 69 64 20 28 73 74 72 69 6e 67 ((run-id (string
105e0 2d 3e 6e 75 6d 62 65 72 20 28 63 61 72 20 70 61 ->number (car pa
105f0 72 61 6d 73 29 29 29 0a 09 09 28 74 65 73 74 2d rams)))...(test-
10600 69 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 id (string->numb
10610 65 72 20 28 63 61 64 72 20 70 61 72 61 6d 73 29 er (cadr params)
10620 29 29 29 0a 09 20 20 20 20 28 69 66 20 28 61 6e ))).. (if (an
10630 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 d run-id test-id
10640 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 )...(begin... (
10650 6c 61 75 6e 63 68 3a 72 65 63 6f 76 65 72 2d 74 launch:recover-t
10660 65 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d est run-id test-
10670 69 64 29 0a 09 09 20 20 28 73 65 74 21 20 2a 64 id)... (set! *d
10680 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
10690 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 )...(begin... (
106a0 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
106b0 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
106c0 2d 70 6f 72 74 2a 20 22 62 61 64 20 72 75 6e 2d -port* "bad run-
106d0 69 64 20 6f 72 20 74 65 73 74 2d 69 64 2c 20 6d id or test-id, m
106e0 75 73 74 20 62 65 20 69 6e 74 65 67 65 72 73 22 ust be integers"
106f0 29 0a 09 09 20 20 28 65 78 69 74 20 31 29 29 29 )... (exit 1)))
10700 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
10710 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10720 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10730 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10740 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
10750 3b 20 54 65 73 74 20 63 6f 6d 6d 61 6e 64 73 20 ; Test commands
10760 28 69 2e 65 2e 20 66 6f 72 20 75 73 65 20 69 6e (i.e. for use in
10770 73 69 64 65 20 74 65 73 74 73 29 0a 3b 3b 3d 3d side tests).;;==
10780 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10790 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107c0 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 6d ====..(define (m
107d0 65 67 61 74 65 73 74 3a 73 74 65 70 20 73 74 65 egatest:step ste
107e0 70 20 73 74 61 74 65 20 73 74 61 74 75 73 20 6c p state status l
107f0 6f 67 66 69 6c 65 20 6d 73 67 29 0a 20 20 28 69 ogfile msg). (i
10800 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 f (not (getenv "
10810 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 20 20 MT_CMDINFO")).
10820 20 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 62 (begin..(deb
10830 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
10840 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
10850 72 74 2a 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 20 rt* "MT_CMDINFO
10860 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c env var not set,
10870 20 2d 73 74 65 70 20 6d 75 73 74 20 62 65 20 63 -step must be c
10880 61 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 alled *inside* a
10890 20 6d 65 67 61 74 65 73 74 20 69 6e 76 6f 6b 65 megatest invoke
108a0 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 d environment!")
108b0 0a 09 28 65 78 69 74 20 35 29 29 0a 20 20 20 20 ..(exit 5)).
108c0 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e 66 (let* ((cmdinf
108d0 6f 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 o (common:read
108e0 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 -encoded-string
108f0 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (getenv "MT_CMDI
10900 4e 46 4f 22 29 29 29 0a 09 20 20 20 20 20 28 74 NFO"))).. (t
10910 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f ransport (assoc/
10920 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f default 'transpo
10930 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 rt cmdinfo))..
10940 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 61 (testpath (a
10950 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
10960 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 stpath cmdinfo)
10970 29 0a 09 20 20 20 20 20 28 74 65 73 74 2d 6e 61 ).. (test-na
10980 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c me (assoc/defaul
10990 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 t 'test-name cmd
109a0 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 75 info)).. (ru
109b0 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
109c0 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
109d0 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
109e0 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 (db-host (as
109f0 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d soc/default 'db-
10a00 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 host cmdinfo))
10a10 0a 09 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 .. (run-id
10a20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
10a30 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 'run-id cmdi
10a40 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 73 nfo)).. (tes
10a50 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 65 t-id (assoc/de
10a60 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 20 fault 'test-id
10a70 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
10a80 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 (itemdat (ass
10a90 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d oc/default 'item
10aa0 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a dat cmdinfo)).
10ab0 09 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 . (work-area
10ac0 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
10ad0 27 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 'work-area cmdin
10ae0 66 6f 29 29 0a 09 20 20 20 20 20 28 64 62 20 20 fo)).. (db
10af0 20 20 20 20 20 20 23 66 29 29 0a 09 28 63 68 61 #f))..(cha
10b00 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 nge-directory te
10b10 73 74 70 61 74 68 29 0a 09 28 69 66 20 28 6e 6f stpath)..(if (no
10b20 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 t (launch:setup)
10b30 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 ).. (begin..
10b40 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
10b50 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
10b60 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 -port* "Failed t
10b70 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
10b80 22 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 20 ").. (exit
10b90 31 29 29 29 0a 09 28 69 66 20 28 61 6e 64 20 73 1)))..(if (and s
10ba0 74 61 74 65 20 73 74 61 74 75 73 29 0a 09 20 20 tate status)..
10bb0 20 20 28 6c 65 74 20 28 28 63 6f 6d 6d 65 6e 74 (let ((comment
10bc0 20 28 6c 61 75 6e 63 68 3a 6c 6f 61 64 2d 6c 6f (launch:load-lo
10bd0 67 70 72 6f 2d 64 61 74 20 72 75 6e 2d 69 64 20 gpro-dat run-id
10be0 74 65 73 74 2d 69 64 20 73 74 65 70 29 29 29 0a test-id step))).
10bf0 09 20 20 20 20 20 20 3b 3b 20 28 72 6d 74 3a 74 . ;; (rmt:t
10c00 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e est-set-log! run
10c10 2d 69 64 20 74 65 73 74 2d 69 64 20 28 63 6f 6e -id test-id (con
10c20 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 6d c stepname ".htm
10c30 6c 22 29 29 29 29 0a 09 20 20 20 20 20 20 28 72 l")))).. (r
10c40 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d mt:teststep-set-
10c50 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
10c60 65 73 74 2d 69 64 20 73 74 65 70 20 73 74 61 74 est-id step stat
10c70 65 20 73 74 61 74 75 73 20 28 6f 72 20 63 6f 6d e status (or com
10c80 6d 65 6e 74 20 6d 73 67 29 20 6c 6f 67 66 69 6c ment msg) logfil
10c90 65 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a e)).. (begin.
10ca0 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
10cb0 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
10cc0 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
10cd0 59 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 You must specify
10ce0 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 :state and :sta
10cf0 74 75 73 20 77 69 74 68 20 65 76 65 72 79 20 63 tus with every c
10d00 61 6c 6c 20 74 6f 20 2d 73 74 65 70 22 29 0a 09 all to -step")..
10d10 20 20 20 20 20 20 28 65 78 69 74 20 36 29 29 29 (exit 6)))
10d20 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
10d30 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a et-arg "-step").
10d40 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
10d50 20 28 6d 65 67 61 74 65 73 74 3a 73 74 65 70 20 (megatest:step
10d60 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 . (args:ge
10d70 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a 20 t-arg "-step").
10d80 20 20 20 20 20 20 28 6f 72 20 28 61 72 67 73 3a (or (args:
10d90 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 65 22 get-arg "-state"
10da0 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
10db0 3a 73 74 61 74 65 22 29 29 0a 20 20 20 20 20 20 :state")).
10dc0 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
10dd0 72 67 20 22 2d 73 74 61 74 75 73 22 29 28 61 72 rg "-status")(ar
10de0 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
10df0 74 75 73 22 29 29 0a 20 20 20 20 20 20 20 28 61 tus")). (a
10e00 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
10e10 74 6c 6f 67 22 29 0a 20 20 20 20 20 20 20 28 61 tlog"). (a
10e20 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
10e30 29 29 0a 20 20 20 20 20 20 3b 3b 20 28 69 66 20 )). ;; (if
10e40 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 db (sqlite3:fina
10e50 6c 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 20 lize! db)).
10e60 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
10e70 68 69 6e 67 2a 20 23 74 29 29 29 0a 20 20 20 20 hing* #t))).
10e80 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 .(if (or (args:g
10e90 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 et-arg "-setlog"
10ea0 29 20 20 20 20 20 20 20 3b 3b 20 73 69 6e 63 65 ) ;; since
10eb0 20 73 65 74 74 69 6e 67 20 75 70 20 69 73 20 73 setting up is s
10ec0 6f 20 63 6f 73 74 6c 79 20 6c 65 74 73 20 70 69 o costly lets pi
10ed0 67 67 79 62 61 63 6b 20 6f 6e 20 2d 74 65 73 74 ggyback on -test
10ee0 2d 73 74 61 74 75 73 0a 09 3b 3b 20 20 20 20 20 -status..;;
10ef0 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 (not (args:get-a
10f00 72 67 20 22 2d 73 74 65 70 22 29 29 29 20 20 3b rg "-step"))) ;
10f10 3b 20 2d 73 65 74 6c 6f 67 20 6d 61 79 20 68 61 ; -setlog may ha
10f20 76 65 20 62 65 65 6e 20 70 72 6f 63 65 73 73 65 ve been processe
10f30 64 20 61 6c 72 65 61 64 79 20 69 6e 20 74 68 65 d already in the
10f40 20 22 2d 73 74 65 70 22 20 70 72 65 76 69 6f 75 "-step" previou
10f50 73 0a 09 3b 3b 20 20 20 20 20 4e 45 57 20 50 4f s..;; NEW PO
10f60 4c 49 43 59 20 2d 20 2d 73 65 74 6c 6f 67 20 73 LICY - -setlog s
10f70 65 74 73 20 74 65 73 74 20 6f 76 65 72 61 6c 6c ets test overall
10f80 20 6c 6f 67 20 6f 6e 20 65 76 65 72 79 20 63 61 log on every ca
10f90 6c 6c 2e 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 ll...(args:get-a
10fa0 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 rg "-set-toplog"
10fb0 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
10fc0 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 "-test-status")
10fd0 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
10fe0 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 0a 09 "-set-values")..
10ff0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11000 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 load-test-data")
11010 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
11020 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 28 61 72 "-runstep")..(ar
11030 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d gs:get-arg "-sum
11040 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 29 0a marize-items")).
11050 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 (if (not (ge
11060 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
11070 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 "))..(begin.. (
11080 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
11090 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
110a0 2d 70 6f 72 74 2a 20 22 4d 54 5f 43 4d 44 49 4e -port* "MT_CMDIN
110b0 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 FO env var not s
110c0 65 74 2c 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 65 et, commands -te
110d0 73 74 2d 73 74 61 74 75 73 2c 20 2d 72 75 6e 73 st-status, -runs
110e0 74 65 70 20 61 6e 64 20 2d 73 65 74 6c 6f 67 20 tep and -setlog
110f0 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 20 2a must be called *
11100 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 74 65 inside* a megate
11110 73 74 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 st environment!"
11120 29 0a 09 20 20 28 65 78 69 74 20 35 29 29 0a 09 ).. (exit 5))..
11130 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e 67 (let* ((starting
11140 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 72 dir (current-dir
11150 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 20 ectory))..
11160 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d (cmdinfo (com
11170 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 mon:read-encoded
11180 2d 73 74 72 69 6e 67 20 28 67 65 74 65 6e 76 20 -string (getenv
11190 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a "MT_CMDINFO"))).
111a0 09 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f . (transpo
111b0 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c rt (assoc/defaul
111c0 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 t 'transport cmd
111d0 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
111e0 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
111f0 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
11200 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
11210 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
11220 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
11230 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
11240 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
11250 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
11260 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
11270 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
11280 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 (db-host (
11290 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 assoc/default 'd
112a0 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f b-host cmdinfo
112b0 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
112c0 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 id (assoc/def
112d0 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 ault 'run-id
112e0 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
112f0 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 73 (test-id (as
11300 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
11310 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 t-id cmdinfo))
11320 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 .. (itemda
11330 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
11340 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d lt 'itemdat cm
11350 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
11360 28 77 6f 72 6b 2d 61 72 65 61 20 28 61 73 73 6f (work-area (asso
11370 63 2f 64 65 66 61 75 6c 74 20 27 77 6f 72 6b 2d c/default 'work-
11380 61 72 65 61 20 63 6d 64 69 6e 66 6f 29 29 0a 09 area cmdinfo))..
11390 20 20 20 20 20 20 20 28 64 62 20 20 20 20 20 20 (db
113a0 20 20 23 66 29 20 3b 3b 20 28 6f 70 65 6e 2d 64 #f) ;; (open-d
113b0 62 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 b)).. (sta
113c0 74 65 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 te (args:get
113d0 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a -arg ":state")).
113e0 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 20 . (status
113f0 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
11400 20 22 3a 73 74 61 74 75 73 22 29 29 0a 09 20 20 ":status"))..
11410 20 20 20 20 20 28 73 74 65 70 6e 61 6d 65 20 20 (stepname
11420 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11430 73 74 65 70 22 29 29 29 0a 09 20 20 28 69 66 20 step"))).. (if
11440 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 (not (launch:set
11450 75 70 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 up)).. (beg
11460 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e in...(debug:prin
11470 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
11480 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 -port* "Failed t
11490 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
114a0 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a ")...(exit 1))).
114b0 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 .. (if (args:ge
114c0 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 t-arg "-runstep"
114d0 29 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e )(debug:print-in
114e0 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 1 *default-lo
114f0 67 2d 70 6f 72 74 2a 20 22 52 75 6e 6e 69 6e 67 g-port* "Running
11500 20 2d 72 75 6e 73 74 65 70 2c 20 66 69 72 73 74 -runstep, first
11510 20 63 68 61 6e 67 65 20 74 6f 20 64 69 72 65 63 change to direc
11520 74 6f 72 79 20 22 20 77 6f 72 6b 2d 61 72 65 61 tory " work-area
11530 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 )).. (change-di
11540 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 rectory work-are
11550 61 29 0a 09 20 20 3b 3b 20 63 61 6e 20 73 65 74 a).. ;; can set
11560 75 70 20 61 73 20 63 6c 69 65 6e 74 20 66 6f 72 up as client for
11570 20 73 65 72 76 65 72 20 6d 6f 64 65 20 6e 6f 77 server mode now
11580 0a 09 20 20 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 .. ;; (client:s
11590 65 74 75 70 29 0a 0a 09 20 20 28 69 66 20 28 61 etup)... (if (a
115a0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
115b0 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a 09 ad-test-data")..
115c0 20 20 20 20 20 20 3b 3b 20 68 61 73 20 73 75 62 ;; has sub
115d0 20 63 6f 6d 6d 61 6e 64 73 20 74 68 61 74 20 61 commands that a
115e0 72 65 20 72 64 62 3a 0a 09 20 20 20 20 20 20 3b re rdb:.. ;
115f0 3b 20 44 4f 20 4e 4f 54 20 70 75 74 20 74 68 69 ; DO NOT put thi
11600 73 20 6f 6e 65 20 69 6e 74 6f 20 65 69 74 68 65 s one into eithe
11610 72 20 72 6d 74 3a 20 6f 72 20 6f 70 65 6e 2d 72 r rmt: or open-r
11620 75 6e 2d 63 6c 6f 73 65 0a 09 20 20 20 20 20 20 un-close..
11630 28 74 64 62 3a 6c 6f 61 64 2d 74 65 73 74 2d 64 (tdb:load-test-d
11640 61 74 61 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ata run-id test-
11650 69 64 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 id)).. (if (arg
11660 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c s:get-arg "-setl
11670 6f 67 22 29 0a 09 20 20 20 20 20 20 28 6c 65 74 og").. (let
11680 20 28 28 6c 6f 67 66 6e 61 6d 65 20 28 61 72 67 ((logfname (arg
11690 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c s:get-arg "-setl
116a0 6f 67 22 29 29 29 0a 09 09 28 72 6d 74 3a 74 65 og")))...(rmt:te
116b0 73 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e 2d st-set-log! run-
116c0 69 64 20 74 65 73 74 2d 69 64 20 6c 6f 67 66 6e id test-id logfn
116d0 61 6d 65 29 29 29 0a 09 20 20 28 69 66 20 28 61 ame))).. (if (a
116e0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
116f0 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 20 20 20 20 t-toplog")..
11700 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 ;; DO NOT run
11710 72 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 28 74 remote.. (t
11720 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 74 6f ests:test-set-to
11730 70 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 73 plog! run-id tes
11740 74 2d 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 t-name (args:get
11750 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f -arg "-set-toplo
11760 67 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 g"))).. (if (ar
11770 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d gs:get-arg "-sum
11780 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 0a 09 marize-items")..
11790 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 ;; DO NOT
117a0 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 20 run remote..
117b0 20 20 28 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 (tests:summari
117c0 7a 65 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 ze-items run-id
117d0 74 65 73 74 2d 69 64 20 74 65 73 74 2d 6e 61 6d test-id test-nam
117e0 65 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 6f 72 e #t)) ;; do for
117f0 63 65 20 68 65 72 65 0a 09 20 20 28 69 66 20 28 ce here.. (if (
11800 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
11810 75 6e 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 unstep")..
11820 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 (if (null? remar
11830 67 73 29 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 gs)... (begin..
11840 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
11850 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
11860 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6e 6f lt-log-port* "no
11870 74 68 69 6e 67 20 73 70 65 63 69 66 69 65 64 20 thing specified
11880 74 6f 20 72 75 6e 21 22 29 0a 09 09 20 20 20 20 to run!")...
11890 28 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 3a (if db (sqlite3:
118a0 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 finalize! db))..
118b0 09 20 20 20 20 28 65 78 69 74 20 36 29 29 0a 09 . (exit 6))..
118c0 09 20 20 28 6c 65 74 2a 20 28 28 73 74 65 70 6e . (let* ((stepn
118d0 61 6d 65 20 20 20 28 61 72 67 73 3a 67 65 74 2d ame (args:get-
118e0 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 29 arg "-runstep"))
118f0 0a 09 09 09 20 28 6c 6f 67 70 72 6f 66 69 6c 65 .... (logprofile
11900 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
11910 2d 6c 6f 67 70 72 6f 22 29 29 0a 09 09 09 20 28 -logpro")).... (
11920 6c 6f 67 66 69 6c 65 20 20 20 20 28 63 6f 6e 63 logfile (conc
11930 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 stepname ".log"
11940 29 29 0a 09 09 09 20 28 63 6d 64 20 20 20 20 20 )).... (cmd
11950 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 (if (null? re
11960 6d 61 72 67 73 29 20 23 66 20 28 63 61 72 20 72 margs) #f (car r
11970 65 6d 61 72 67 73 29 29 29 0a 09 09 09 20 28 70 emargs))).... (p
11980 61 72 61 6d 73 20 20 20 20 20 28 69 66 20 63 6d arams (if cm
11990 64 20 28 63 64 72 20 72 65 6d 61 72 67 73 29 20 d (cdr remargs)
119a0 27 28 29 29 29 0a 09 09 09 20 28 65 78 69 74 73 '())).... (exits
119b0 74 61 74 20 20 20 23 66 29 0a 09 09 09 20 28 73 tat #f).... (s
119c0 68 65 6c 6c 20 20 20 20 20 20 28 6c 65 74 20 28 hell (let (
119d0 28 73 68 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e (sh (get-environ
119e0 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 53 ment-variable "S
119f0 48 45 4c 4c 22 29 20 29 29 0a 09 09 09 09 20 20 HELL") )).....
11a00 20 20 20 20 20 28 69 66 20 73 68 20 0a 09 09 09 (if sh ....
11a10 09 09 20 20 20 28 6c 61 73 74 20 28 73 74 72 69 .. (last (stri
11a20 6e 67 2d 73 70 6c 69 74 20 73 68 20 22 2f 22 29 ng-split sh "/")
11a30 29 0a 09 09 09 09 09 20 20 20 22 62 61 73 68 22 )...... "bash"
11a40 29 29 29 0a 09 09 09 20 28 72 65 64 69 72 20 20 ))).... (redir
11a50 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e (case (strin
11a60 67 2d 3e 73 79 6d 62 6f 6c 20 73 68 65 6c 6c 29 g->symbol shell)
11a70 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 74 63 ..... ((tc
11a80 73 68 20 63 73 68 20 6b 73 68 29 20 20 20 20 22 sh csh ksh) "
11a90 3e 26 22 29 0a 09 09 09 09 20 20 20 20 20 20 20 >&").....
11aa0 28 28 7a 73 68 20 62 61 73 68 20 73 68 20 61 73 ((zsh bash sh as
11ab0 68 29 20 22 32 3e 26 31 20 3e 22 29 0a 09 09 09 h) "2>&1 >")....
11ac0 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 22 3e . (else ">
11ad0 26 22 29 29 29 0a 09 09 09 20 28 66 75 6c 6c 63 &"))).... (fullc
11ae0 6d 64 20 20 20 20 28 63 6f 6e 63 20 22 28 22 20 md (conc "("
11af0 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
11b00 72 73 65 20 0a 09 09 09 09 09 09 28 63 6f 6e 73 rse .......(cons
11b10 20 63 6d 64 20 70 61 72 61 6d 73 29 20 22 20 22 cmd params) " "
11b20 29 0a 09 09 09 09 09 20 20 20 22 29 20 22 20 72 )...... ") " r
11b30 65 64 69 72 20 22 20 22 20 6c 6f 67 66 69 6c 65 edir " " logfile
11b40 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 6d 61 72 )))... ;; mar
11b50 6b 20 74 68 65 20 73 74 61 72 74 20 6f 66 20 74 k the start of t
11b60 68 65 20 74 65 73 74 0a 09 09 20 20 20 20 28 72 he test... (r
11b70 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d mt:teststep-set-
11b80 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
11b90 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 est-id stepname
11ba0 22 73 74 61 72 74 22 20 22 6e 2f 61 22 20 28 61 "start" "n/a" (a
11bb0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
11bc0 29 20 6c 6f 67 66 69 6c 65 29 0a 09 09 20 20 20 ) logfile)...
11bd0 20 3b 3b 20 72 75 6e 20 74 68 65 20 74 65 73 74 ;; run the test
11be0 20 73 74 65 70 0a 09 09 20 20 20 20 28 64 65 62 step... (deb
11bf0 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 ug:print-info 2
11c00 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
11c10 74 2a 20 22 52 75 6e 6e 69 6e 67 20 5c 22 22 20 t* "Running \""
11c20 66 75 6c 6c 63 6d 64 20 22 5c 22 20 69 6e 20 64 fullcmd "\" in d
11c30 69 72 65 63 74 6f 72 79 20 5c 22 22 20 73 74 61 irectory \"" sta
11c40 72 74 69 6e 67 64 69 72 29 0a 09 09 20 20 20 20 rtingdir)...
11c50 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
11c60 79 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 y startingdir)..
11c70 09 20 20 20 20 28 73 65 74 21 20 65 78 69 74 73 . (set! exits
11c80 74 61 74 20 28 73 79 73 74 65 6d 20 66 75 6c 6c tat (system full
11c90 63 6d 64 29 29 0a 09 09 20 20 20 20 28 73 65 74 cmd))... (set
11ca0 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 ! *globalexitsta
11cb0 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 0a 09 tus* exitstat)..
11cc0 09 20 20 20 20 3b 3b 20 28 63 68 61 6e 67 65 2d . ;; (change-
11cd0 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 directory testpa
11ce0 74 68 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e th)... ;; run
11cf0 20 6c 6f 67 70 72 6f 20 69 66 20 61 70 70 6c 69 logpro if appli
11d00 63 61 62 6c 65 20 3b 3b 20 28 70 72 6f 63 65 73 cable ;; (proces
11d10 73 2d 72 75 6e 20 22 6c 73 22 20 28 6c 69 73 74 s-run "ls" (list
11d20 20 22 2f 66 6f 6f 22 20 22 32 3e 26 31 22 20 22 "/foo" "2>&1" "
11d30 62 6c 61 68 2e 6c 6f 67 22 29 29 0a 09 09 20 20 blah.log"))...
11d40 20 20 28 69 66 20 6c 6f 67 70 72 6f 66 69 6c 65 (if logprofile
11d50 0a 09 09 09 28 6c 65 74 2a 20 28 28 68 74 6d 6c ....(let* ((html
11d60 6c 6f 67 66 69 6c 65 20 28 63 6f 6e 63 20 73 74 logfile (conc st
11d70 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 epname ".html"))
11d80 0a 09 09 09 20 20 20 20 20 20 20 28 6f 6c 64 65 .... (olde
11d90 78 69 74 73 74 61 74 20 65 78 69 74 73 74 61 74 xitstat exitstat
11da0 29 0a 09 09 09 20 20 20 20 20 20 20 28 63 6d 64 ).... (cmd
11db0 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 (string
11dc0 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6c 69 -intersperse (li
11dd0 73 74 20 22 6c 6f 67 70 72 6f 22 20 6c 6f 67 70 st "logpro" logp
11de0 72 6f 66 69 6c 65 20 68 74 6d 6c 6c 6f 67 66 69 rofile htmllogfi
11df0 6c 65 20 22 3c 22 20 6c 6f 67 66 69 6c 65 20 22 le "<" logfile "
11e00 3e 22 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d >" (conc stepnam
11e10 65 20 22 5f 6c 6f 67 70 72 6f 2e 6c 6f 67 22 29 e "_logpro.log")
11e20 29 20 22 20 22 29 29 29 0a 09 09 09 20 20 28 64 ) " "))).... (d
11e30 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
11e40 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 2 *default-log-p
11e50 6f 72 74 2a 20 22 72 75 6e 6e 69 6e 67 20 5c 22 ort* "running \"
11e60 22 20 63 6d 64 20 22 5c 22 22 29 0a 09 09 09 20 " cmd "\"")....
11e70 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
11e80 72 79 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a ry startingdir).
11e90 09 09 09 20 20 28 73 65 74 21 20 65 78 69 74 73 ... (set! exits
11ea0 74 61 74 20 28 73 79 73 74 65 6d 20 63 6d 64 29 tat (system cmd)
11eb0 29 0a 09 09 09 20 20 28 73 65 74 21 20 2a 67 6c ).... (set! *gl
11ec0 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 obalexitstatus*
11ed0 65 78 69 74 73 74 61 74 29 20 3b 3b 20 6e 6f 20 exitstat) ;; no
11ee0 6e 65 63 65 73 73 61 72 79 0a 09 09 09 20 20 28 necessary.... (
11ef0 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
11f00 20 74 65 73 74 70 61 74 68 29 0a 09 09 09 20 20 testpath)....
11f10 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f (rmt:test-set-lo
11f20 67 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 g! run-id test-i
11f30 64 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 29 29 29 d htmllogfile)))
11f40 0a 09 09 20 20 20 20 28 6c 65 74 20 28 28 6d 73 ... (let ((ms
11f50 67 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 g (args:get-arg
11f60 22 2d 6d 22 29 29 29 0a 09 09 20 20 20 20 20 20 "-m")))...
11f70 28 72 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 (rmt:teststep-se
11f80 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 t-status! run-id
11f90 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d test-id stepnam
11fa0 65 20 22 65 6e 64 22 20 65 78 69 74 73 74 61 74 e "end" exitstat
11fb0 20 6d 73 67 20 6c 6f 67 66 69 6c 65 29 29 0a 09 msg logfile))..
11fc0 09 20 20 20 20 29 29 29 0a 09 20 20 28 69 66 20 . ))).. (if
11fd0 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
11fe0 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 g "-test-status"
11ff0 29 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d )... (args:get-
12000 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 73 arg "-set-values
12010 22 29 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 ")).. (let
12020 28 28 6e 65 77 73 74 61 74 75 73 20 28 63 6f 6e ((newstatus (con
12030 64 0a 09 09 09 09 28 28 6e 75 6d 62 65 72 3f 20 d.....((number?
12040 73 74 61 74 75 73 29 20 20 20 20 20 20 20 28 69 status) (i
12050 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 f (equal? status
12060 20 30 29 20 22 50 41 53 53 22 20 22 46 41 49 4c 0) "PASS" "FAIL
12070 22 29 29 0a 09 09 09 09 28 28 61 6e 64 20 28 73 ")).....((and (s
12080 74 72 69 6e 67 3f 20 73 74 61 74 75 73 29 0a 09 tring? status)..
12090 09 09 09 20 20 20 20 20 20 28 73 74 72 69 6e 67 ... (string
120a0 2d 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 73 29 ->number status)
120b0 29 28 69 66 20 28 65 71 75 61 6c 3f 20 28 73 74 )(if (equal? (st
120c0 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 61 ring->number sta
120d0 74 75 73 29 20 30 29 20 22 50 41 53 53 22 20 22 tus) 0) "PASS" "
120e0 46 41 49 4c 22 29 29 0a 09 09 09 09 28 65 6c 73 FAIL")).....(els
120f0 65 20 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 e status)))...
12100 20 20 3b 3b 20 74 72 61 6e 73 66 65 72 20 72 65 ;; transfer re
12110 6c 65 76 61 6e 74 20 6b 65 79 73 20 69 6e 74 6f levant keys into
12120 20 61 20 68 61 73 68 20 74 6f 20 62 65 20 70 61 a hash to be pa
12130 73 73 65 64 20 74 6f 20 74 65 73 74 2d 73 65 74 ssed to test-set
12140 2d 73 74 61 74 75 73 21 0a 09 09 20 20 20 20 3b -status!... ;
12150 3b 20 63 6f 75 6c 64 20 75 73 65 20 61 6e 20 61 ; could use an a
12160 73 73 6f 63 20 6c 69 73 74 20 49 20 67 75 65 73 ssoc list I gues
12170 73 2e 20 0a 09 09 20 20 20 20 28 6f 74 68 65 72 s. ... (other
12180 64 61 74 61 20 28 6c 65 74 20 28 28 72 65 73 20 data (let ((res
12190 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
121a0 29 29 29 0a 09 09 09 09 20 28 66 6f 72 2d 65 61 )))..... (for-ea
121b0 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 ch (lambda (key)
121c0 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 ...... (if (
121d0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 79 args:get-arg key
121e0 29 0a 09 09 09 09 09 09 20 28 68 61 73 68 2d 74 )....... (hash-t
121f0 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 6b 65 able-set! res ke
12200 79 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 y (args:get-arg
12210 6b 65 79 29 29 29 29 0a 09 09 09 09 09 20 20 20 key))))......
12220 28 6c 69 73 74 20 22 3a 76 61 6c 75 65 22 20 22 (list ":value" "
12230 3a 74 6f 6c 22 20 22 3a 65 78 70 65 63 74 65 64 :tol" ":expected
12240 22 20 22 3a 66 69 72 73 74 5f 65 72 72 22 20 22 " ":first_err" "
12250 3a 66 69 72 73 74 5f 77 61 72 6e 22 20 22 3a 75 :first_warn" ":u
12260 6e 69 74 73 22 20 22 3a 63 61 74 65 67 6f 72 79 nits" ":category
12270 22 20 22 3a 76 61 72 69 61 62 6c 65 22 29 29 0a " ":variable")).
12280 09 09 09 09 20 72 65 73 29 29 29 0a 09 09 28 69 .... res)))...(i
12290 66 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 f (and (args:get
122a0 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 -arg "-test-stat
122b0 75 73 22 29 0a 09 09 09 20 28 6f 72 20 28 6e 6f us").... (or (no
122c0 74 20 73 74 61 74 65 29 0a 09 09 09 20 20 20 20 t state)....
122d0 20 28 6e 6f 74 20 73 74 61 74 75 73 29 29 29 0a (not status))).
122e0 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 .. (begin...
122f0 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
12300 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
12310 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 59 6f lt-log-port* "Yo
12320 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 3a u must specify :
12330 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 state and :statu
12340 73 20 77 69 74 68 20 65 76 65 72 79 20 63 61 6c s with every cal
12350 6c 20 74 6f 20 2d 74 65 73 74 2d 73 74 61 74 75 l to -test-statu
12360 73 5c 6e 22 20 68 65 6c 70 29 0a 09 09 20 20 20 s\n" help)...
12370 20 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 3a (if (sqlite3:
12380 64 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 71 database? db)(sq
12390 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
123a0 64 62 29 29 0a 09 09 20 20 20 20 20 20 28 65 78 db))... (ex
123b0 69 74 20 36 29 29 29 0a 09 09 28 6c 65 74 2a 20 it 6)))...(let*
123c0 28 28 6d 73 67 20 20 20 20 28 61 72 67 73 3a 67 ((msg (args:g
123d0 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 et-arg "-m"))...
123e0 20 20 20 20 20 20 20 28 6e 75 6d 6f 74 68 20 28 (numoth (
123f0 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 length (hash-tab
12400 6c 65 2d 6b 65 79 73 20 6f 74 68 65 72 64 61 74 le-keys otherdat
12410 61 29 29 29 29 0a 09 09 20 20 3b 3b 20 43 6f 6e a))))... ;; Con
12420 76 65 72 74 20 74 6f 20 72 70 63 20 69 6e 73 69 vert to rpc insi
12430 64 65 20 74 68 65 20 74 65 73 74 73 3a 74 65 73 de the tests:tes
12440 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 63 61 t-set-status! ca
12450 6c 6c 2c 20 6e 6f 74 20 68 65 72 65 0a 09 09 20 ll, not here...
12460 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 (tests:test-set
12470 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 -status! run-id
12480 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 6e 65 test-id state ne
12490 77 73 74 61 74 75 73 20 6d 73 67 20 6f 74 68 65 wstatus msg othe
124a0 72 64 61 74 61 20 77 6f 72 6b 2d 61 72 65 61 3a rdata work-area:
124b0 20 77 6f 72 6b 2d 61 72 65 61 29 29 29 29 0a 09 work-area))))..
124c0 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 3a 64 (if (sqlite3:d
124d0 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 71 6c atabase? db)(sql
124e0 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
124f0 62 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 b)).. (set! *di
12500 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
12510 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
12520 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12530 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12540 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12550 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
12560 56 61 72 69 6f 75 73 20 68 65 6c 70 65 72 20 63 Various helper c
12570 6f 6d 6d 61 6e 64 73 20 63 61 6e 20 67 6f 20 62 ommands can go b
12580 65 6c 6f 77 20 68 65 72 65 0a 3b 3b 3d 3d 3d 3d elow here.;;====
12590 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
125a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
125b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
125c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
125d0 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 ==..(if (or (arg
125e0 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 s:get-arg "-show
125f0 6b 65 79 73 22 29 0a 20 20 20 20 20 20 20 20 28 keys"). (
12600 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
12610 68 6f 77 2d 6b 65 79 73 22 29 29 0a 20 20 20 20 how-keys")).
12620 28 6c 65 74 20 28 28 64 62 20 23 66 29 0a 09 20 (let ((db #f)..
12630 20 28 6b 65 79 73 20 23 66 29 29 0a 20 20 20 20 (keys #f)).
12640 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e (if (not (laun
12650 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 ch:setup)).. (b
12660 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 egin.. (debug
12670 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
12680 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
12690 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
126a0 69 74 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 iting").. (ex
126b0 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 73 it 1))). (s
126c0 65 74 21 20 6b 65 79 73 20 28 72 6d 74 3a 67 65 et! keys (rmt:ge
126d0 74 2d 6b 65 79 73 29 29 20 3b 3b 20 20 64 62 29 t-keys)) ;; db)
126e0 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
126f0 72 69 6e 74 20 31 20 2a 64 65 66 61 75 6c 74 2d rint 1 *default-
12700 6c 6f 67 2d 70 6f 72 74 2a 20 22 4b 65 79 73 3a log-port* "Keys:
12710 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 " (string-inter
12720 73 70 65 72 73 65 20 6b 65 79 73 20 22 2c 20 22 sperse keys ", "
12730 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 73 71 )). (if (sq
12740 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 lite3:database?
12750 64 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 db)(sqlite3:fina
12760 6c 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 20 lize! db)).
12770 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
12780 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 hing* #t)))..(if
12790 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
127a0 2d 67 75 69 22 29 0a 20 20 20 20 28 62 65 67 69 -gui"). (begi
127b0 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 n. (debug:p
127c0 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
127d0 6c 6f 67 2d 70 6f 72 74 2a 20 22 4c 6f 6f 6b 20 log-port* "Look
127e0 61 74 20 74 68 65 20 64 61 73 68 62 6f 61 72 64 at the dashboard
127f0 20 66 6f 72 20 6e 6f 77 22 29 0a 20 20 20 20 20 for now").
12800 20 3b 3b 20 28 6d 65 67 61 74 65 73 74 2d 67 75 ;; (megatest-gu
12810 69 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a i). (set! *
12820 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
12830 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
12840 65 74 2d 61 72 67 20 22 2d 63 72 65 61 74 65 2d et-arg "-create-
12850 6d 65 67 61 74 65 73 74 2d 61 72 65 61 22 29 0a megatest-area").
12860 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
12870 20 28 67 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d (genexample:mk-
12880 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 29 megatest.config)
12890 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
128a0 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
128b0 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
128c0 2d 61 72 67 20 22 2d 63 72 65 61 74 65 2d 74 65 -arg "-create-te
128d0 73 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 st"). (let ((
128e0 74 65 73 74 6e 61 6d 65 20 28 61 72 67 73 3a 67 testname (args:g
128f0 65 74 2d 61 72 67 20 22 2d 63 72 65 61 74 65 2d et-arg "-create-
12900 74 65 73 74 22 29 29 29 0a 20 20 20 20 20 20 28 test"))). (
12910 67 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 genexample:mk-me
12920 67 61 74 65 73 74 2d 74 65 73 74 20 74 65 73 74 gatest-test test
12930 6e 61 6d 65 29 0a 20 20 20 20 20 20 28 73 65 74 name). (set
12940 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
12950 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d #t)))..;;======
12960 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12970 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12980 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12990 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
129a0 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 64 .;; Update the d
129b0 61 74 61 62 61 73 65 20 73 63 68 65 6d 61 2c 20 atabase schema,
129c0 63 6c 65 61 6e 20 75 70 20 74 68 65 20 64 62 0a clean up the db.
129d0 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
129e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
129f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a10 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
12a20 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
12a30 62 75 69 6c 64 2d 64 62 22 29 0a 20 20 20 20 28 build-db"). (
12a40 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 begin. (if
12a50 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 (not (launch:set
12a60 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 up)).. (begin..
12a70 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
12a80 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
12a90 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f port* "Failed to
12aa0 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
12ab0 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ) .. (exit 1)
12ac0 29 29 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 )). ;; keep
12ad0 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a this one local.
12ae0 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d (open-run-
12af0 63 6c 6f 73 65 20 70 61 74 63 68 2d 64 62 20 23 close patch-db #
12b00 66 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a f). (set! *
12b10 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
12b20 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
12b30 65 74 2d 61 72 67 20 22 2d 63 6c 65 61 6e 75 70 et-arg "-cleanup
12b40 2d 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e -db"). (begin
12b50 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
12b60 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
12b70 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
12b80 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
12b90 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
12ba0 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
12bb0 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 p, exiting") ..
12bc0 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))).
12bd0 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 63 6c 65 61 (common:clea
12be0 6e 75 70 2d 64 62 29 0a 20 20 20 20 20 20 28 73 nup-db). (s
12bf0 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
12c00 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
12c10 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 61 rgs:get-arg "-ma
12c20 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 22 29 rk-incompletes")
12c30 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
12c40 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e (if (not (laun
12c50 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 ch:setup)).. (b
12c60 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 egin.. (debug
12c70 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
12c80 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
12c90 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
12ca0 69 74 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 iting").. (ex
12cb0 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 6f it 1))). (o
12cc0 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 pen-run-close db
12cd0 3a 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 :find-and-mark-i
12ce0 6e 63 6f 6d 70 6c 65 74 65 20 23 66 29 0a 20 20 ncomplete #f).
12cf0 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
12d00 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
12d10 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
12d20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12d30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12d40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12d50 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 ========.;; Upda
12d60 74 65 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 te the tests met
12d70 61 20 64 61 74 61 20 66 72 6f 6d 20 74 68 65 20 a data from the
12d80 74 65 73 74 63 6f 6e 66 69 67 20 66 69 6c 65 73 testconfig files
12d90 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
12da0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12db0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12dc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12dd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
12de0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 args:get-arg "-u
12df0 70 64 61 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 pdate-meta").
12e00 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 (begin. (i
12e10 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
12e20 65 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e etup)).. (begin
12e30 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
12e40 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
12e50 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 g-port* "Failed
12e60 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
12e70 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 g") .. (exit
12e80 31 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6e 6f 1))). ;; no
12e90 77 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 64 w can find our d
12ea0 62 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 b. ;; keep
12eb0 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 this one local.
12ec0 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
12ed0 6c 6f 73 65 20 72 75 6e 73 3a 75 70 64 61 74 65 lose runs:update
12ee0 2d 61 6c 6c 2d 74 65 73 74 5f 6d 65 74 61 20 23 -all-test_meta #
12ef0 66 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a f). (set! *
12f00 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
12f10 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
12f20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
12f60 20 53 74 61 72 74 20 61 20 72 65 70 6c 0a 3b 3b Start a repl.;;
12f70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12fa0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12fb0 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 66 61 6b 65 6f ======..;; fakeo
12fc0 75 74 20 72 65 61 64 6c 69 6e 65 0a 28 69 6e 63 ut readline.(inc
12fd0 6c 75 64 65 20 22 72 65 61 64 6c 69 6e 65 2d 66 lude "readline-f
12fe0 69 78 2e 73 63 6d 22 29 0a 0a 28 69 66 20 28 6f ix.scm")..(if (o
12ff0 72 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 r (getenv "MT_RU
13000 4e 53 43 52 49 50 54 22 29 0a 09 28 61 72 67 73 NSCRIPT")..(args
13010 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 :get-arg "-repl"
13020 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
13030 20 22 2d 6c 6f 61 64 22 29 29 0a 20 20 20 20 28 "-load")). (
13040 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 let* ((toppath (
13050 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 launch:setup))..
13060 20 20 20 28 64 62 73 74 72 75 63 74 20 28 69 66 (dbstruct (if
13070 20 74 6f 70 70 61 74 68 20 28 64 62 3a 73 65 74 toppath (db:set
13080 75 70 29 29 29 29 20 3b 3b 20 6d 61 6b 65 2d 64 up)))) ;; make-d
13090 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 68 br:dbstruct path
130a0 3a 20 74 6f 70 70 61 74 68 20 6c 6f 63 61 6c 3a : toppath local:
130b0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
130c0 2d 6c 6f 63 61 6c 22 29 29 20 23 66 29 29 29 0a -local")) #f))).
130d0 20 20 20 20 20 20 28 69 66 20 64 62 73 74 72 75 (if dbstru
130e0 63 74 0a 09 20 20 28 63 6f 6e 64 0a 09 20 20 20 ct.. (cond..
130f0 28 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e ((getenv "MT_RUN
13100 53 43 52 49 50 54 22 29 0a 09 20 20 20 20 3b 3b SCRIPT").. ;;
13110 20 48 6f 77 20 74 6f 20 72 75 6e 20 6d 65 67 61 How to run mega
13120 74 65 73 74 20 73 63 72 69 70 74 73 0a 09 20 20 test scripts..
13130 20 20 3b 3b 0a 09 20 20 20 20 3b 3b 20 23 21 2f ;;.. ;; #!/
13140 62 69 6e 2f 62 61 73 68 0a 09 20 20 20 20 3b 3b bin/bash.. ;;
13150 0a 09 20 20 20 20 3b 3b 20 65 78 70 6f 72 74 20 .. ;; export
13160 4d 54 5f 52 55 4e 53 43 52 49 50 54 3d 79 65 73 MT_RUNSCRIPT=yes
13170 0a 09 20 20 20 20 3b 3b 20 6d 65 67 61 74 65 73 .. ;; megates
13180 74 20 3c 3c 20 45 4f 46 0a 09 20 20 20 20 3b 3b t << EOF.. ;;
13190 20 28 70 72 69 6e 74 20 22 48 65 6c 6c 6f 20 77 (print "Hello w
131a0 6f 72 6c 64 22 29 0a 09 20 20 20 20 3b 3b 20 28 orld").. ;; (
131b0 65 78 69 74 29 0a 09 20 20 20 20 3b 3b 20 45 4f exit).. ;; EO
131c0 46 0a 0a 09 20 20 20 20 28 72 65 70 6c 29 29 0a F... (repl)).
131d0 09 20 20 20 28 65 6c 73 65 0a 09 20 20 20 20 28 . (else.. (
131e0 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 73 65 begin.. (se
131f0 74 21 20 2a 64 62 2a 20 64 62 73 74 72 75 63 74 t! *db* dbstruct
13200 29 0a 09 20 20 20 20 20 20 28 69 6d 70 6f 72 74 ).. (import
13210 20 65 78 74 72 61 73 29 20 3b 3b 20 6d 69 67 68 extras) ;; migh
13220 74 20 6e 6f 74 20 62 65 20 6e 65 65 64 65 64 0a t not be needed.
13230 09 20 20 20 20 20 20 3b 3b 20 28 69 6d 70 6f 72 . ;; (impor
13240 74 20 63 73 69 29 0a 09 20 20 20 20 20 20 28 69 t csi).. (i
13250 6d 70 6f 72 74 20 72 65 61 64 6c 69 6e 65 29 0a mport readline).
13260 09 20 20 20 20 20 20 28 69 6d 70 6f 72 74 20 61 . (import a
13270 70 72 6f 70 6f 73 29 0a 09 20 20 20 20 20 20 3b propos).. ;
13280 3b 20 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 ; (import (prefi
13290 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 x sqlite3 sqlite
132a0 33 3a 29 29 20 3b 3b 20 64 6f 65 73 6e 27 74 20 3:)) ;; doesn't
132b0 77 6f 72 6b 20 2e 2e 2e 0a 0a 09 20 20 20 20 20 work ......
132c0 20 28 69 66 20 2a 75 73 65 2d 6e 65 77 2d 72 65 (if *use-new-re
132d0 61 64 6c 69 6e 65 2a 0a 09 09 20 20 28 62 65 67 adline*... (beg
132e0 69 6e 0a 09 09 20 20 20 20 28 69 6e 73 74 61 6c in... (instal
132f0 6c 2d 68 69 73 74 6f 72 79 2d 66 69 6c 65 20 28 l-history-file (
13300 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
13310 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 variable "HOME")
13320 20 22 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 74 ".megatest_hist
13330 6f 72 79 22 29 20 3b 3b 20 20 5b 68 6f 6d 65 64 ory") ;; [homed
13340 69 72 5d 20 5b 66 69 6c 65 6e 61 6d 65 5d 20 5b ir] [filename] [
13350 6e 6c 69 6e 65 73 5d 29 0a 09 09 20 20 20 20 28 nlines])... (
13360 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f current-input-po
13370 72 74 20 28 6d 61 6b 65 2d 72 65 61 64 6c 69 6e rt (make-readlin
13380 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 65 73 74 e-port "megatest
13390 3e 20 22 29 29 29 0a 09 09 20 20 28 62 65 67 69 > ")))... (begi
133a0 6e 0a 09 09 20 20 20 20 28 67 6e 75 2d 68 69 73 n... (gnu-his
133b0 74 6f 72 79 2d 69 6e 73 74 61 6c 6c 2d 66 69 6c tory-install-fil
133c0 65 2d 6d 61 6e 61 67 65 72 0a 09 09 20 20 20 20 e-manager...
133d0 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 0a (string-append.
133e0 09 09 20 20 20 20 20 20 28 6f 72 20 28 67 65 74 .. (or (get
133f0 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
13400 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2e iable "HOME") ".
13410 22 29 20 22 2f 2e 6d 65 67 61 74 65 73 74 5f 68 ") "/.megatest_h
13420 69 73 74 6f 72 79 22 29 29 0a 09 09 20 20 20 20 istory"))...
13430 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 (current-input-p
13440 6f 72 74 20 28 6d 61 6b 65 2d 67 6e 75 2d 72 65 ort (make-gnu-re
13450 61 64 6c 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 adline-port "meg
13460 61 74 65 73 74 3e 20 22 29 29 29 29 0a 09 20 20 atest> "))))..
13470 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 (if (args:ge
13480 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 29 0a 09 t-arg "-repl")..
13490 09 20 20 28 72 65 70 6c 29 0a 09 09 20 20 28 6c . (repl)... (l
134a0 6f 61 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 oad (args:get-ar
134b0 67 20 22 2d 6c 6f 61 64 22 29 29 29 0a 09 20 20 g "-load")))..
134c0 20 20 20 20 3b 3b 20 28 64 62 3a 63 6c 6f 73 65 ;; (db:close
134d0 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 29 20 3c -all dbstruct) <
134e0 3d 20 74 61 6b 65 6e 20 63 61 72 65 20 6f 66 20 = taken care of
134f0 62 79 20 6f 6e 2d 65 78 69 74 20 63 61 6c 6c 0a by on-exit call.
13500 09 20 20 20 20 20 20 29 0a 09 20 20 20 20 28 65 . ).. (e
13510 78 69 74 29 29 29 0a 09 20 20 28 73 65 74 21 20 xit))).. (set!
13520 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
13530 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d t))))..;;=======
13540 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13550 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13560 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13570 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
13580 3b 3b 20 57 61 69 74 20 6f 6e 20 61 20 72 75 6e ;; Wait on a run
13590 20 74 6f 20 63 6f 6d 70 6c 65 74 65 0a 3b 3b 3d to complete.;;=
135a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
135b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
135c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
135d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
135e0 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 6e 64 20 =====..(if (and
135f0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
13600 72 75 6e 2d 77 61 69 74 22 29 0a 09 20 28 6e 6f run-wait").. (no
13610 74 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d t (or (args:get-
13620 61 72 67 20 22 2d 72 75 6e 22 29 0a 09 09 20 20 arg "-run")...
13630 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
13640 72 75 6e 74 65 73 74 73 22 29 29 29 29 20 3b 3b runtests")))) ;;
13650 20 72 75 6e 2d 77 61 69 74 20 69 73 20 62 75 69 run-wait is bui
13660 6c 74 20 69 6e 74 6f 20 72 75 6e 74 65 73 74 73 lt into runtests
13670 20 6e 6f 77 0a 20 20 20 20 28 62 65 67 69 6e 0a now. (begin.
13680 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
13690 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 launch:setup))..
136a0 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 (begin.. (d
136b0 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
136c0 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
136d0 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 "Failed to setup
136e0 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 , exiting") ..
136f0 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 (exit 1))).
13700 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 (operate-on '
13710 72 75 6e 2d 77 61 69 74 29 0a 20 20 20 20 20 20 run-wait).
13720 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
13730 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 3b ing* #t)))..;; ;
13740 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 3b 3b 20 ; ;; redo me ;;
13750 4e 6f 74 20 63 6f 6e 76 65 72 74 65 64 20 74 6f Not converted to
13760 20 75 73 65 20 64 62 73 74 72 75 63 74 20 79 65 use dbstruct ye
13770 74 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 t.;; ;; ;; redo
13780 6d 65 20 3b 3b 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 me ;;.;; ;; ;; r
13790 65 64 6f 20 6d 65 20 28 69 66 20 28 61 72 67 73 edo me (if (args
137a0 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e 76 65 :get-arg "-conve
137b0 72 74 2d 74 6f 2d 6e 6f 72 6d 22 29 0a 3b 3b 20 rt-to-norm").;;
137c0 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
137d0 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 (let* ((toppat
137e0 68 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e h (setup-for-run
137f0 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f )).;; ;; ;; redo
13800 20 6d 65 20 09 20 20 20 28 64 62 73 74 72 75 63 me . (dbstruc
13810 74 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 6d t (if toppath (m
13820 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 ake-dbr:dbstruct
13830 20 70 61 74 68 3a 20 74 6f 70 70 61 74 68 20 6c path: toppath l
13840 6f 63 61 6c 3a 20 23 74 29 29 29 29 0a 3b 3b 20 ocal: #t)))).;;
13850 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
13860 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 3b (for-each .;
13870 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
13880 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
13890 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 field).;; ;; ;;
138a0 72 65 64 6f 20 6d 65 20 09 20 28 6c 65 74 20 28 redo me . (let (
138b0 28 64 61 74 20 27 28 29 29 29 0a 3b 3b 20 3b 3b (dat '())).;; ;;
138c0 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
138d0 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
138e0 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 0 *default-log
138f0 2d 70 6f 72 74 2a 20 22 47 65 74 74 69 6e 67 20 -port* "Getting
13900 64 61 74 61 20 66 6f 72 20 66 69 65 6c 64 20 22 data for field "
13910 20 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b field).;; ;; ;;
13920 20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 73 71 redo me . (sq
13930 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
13940 6f 77 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f ow.;; ;; ;; redo
13950 20 6d 65 20 09 20 20 20 20 28 6c 61 6d 62 64 61 me . (lambda
13960 20 28 69 64 20 76 61 6c 29 0a 3b 3b 20 3b 3b 20 (id val).;; ;;
13970 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 ;; redo me .
13980 20 20 28 73 65 74 21 20 64 61 74 20 28 63 6f 6e (set! dat (con
13990 73 20 28 6c 69 73 74 20 69 64 20 76 61 6c 29 20 s (list id val)
139a0 64 61 74 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 dat))).;; ;; ;;
139b0 72 65 64 6f 20 6d 65 20 09 20 20 20 20 28 64 62 redo me . (db
139c0 3a 67 65 74 2d 64 62 20 64 62 20 72 75 6e 2d 69 :get-db db run-i
139d0 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f d).;; ;; ;; redo
139e0 20 6d 65 20 09 20 20 20 20 28 63 6f 6e 63 20 22 me . (conc "
139f0 53 45 4c 45 43 54 20 69 64 2c 22 20 66 69 65 6c SELECT id," fiel
13a00 64 20 22 20 46 52 4f 4d 20 74 65 73 74 73 3b 22 d " FROM tests;"
13a10 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f )).;; ;; ;; redo
13a20 20 6d 65 20 09 20 20 20 28 64 65 62 75 67 3a 70 me . (debug:p
13a30 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
13a40 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
13a50 66 6f 75 6e 64 20 22 20 28 6c 65 6e 67 74 68 20 found " (length
13a60 64 61 74 29 20 22 20 69 74 65 6d 73 20 66 6f 72 dat) " items for
13a70 20 66 69 65 6c 64 20 22 20 66 69 65 6c 64 29 0a field " field).
13a80 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
13a90 20 09 20 20 20 28 6c 65 74 20 28 28 71 72 79 20 . (let ((qry
13aa0 28 73 71 6c 69 74 65 33 3a 70 72 65 70 61 72 65 (sqlite3:prepare
13ab0 20 64 62 20 28 63 6f 6e 63 20 22 55 50 44 41 54 db (conc "UPDAT
13ac0 45 20 74 65 73 74 73 20 53 45 54 20 22 20 66 69 E tests SET " fi
13ad0 65 6c 64 20 22 3d 3f 20 57 48 45 52 45 20 69 64 eld "=? WHERE id
13ae0 3d 3f 3b 22 29 29 29 29 0a 3b 3b 20 3b 3b 20 3b =?;")))).;; ;; ;
13af0 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 ; redo me .
13b00 28 66 6f 72 2d 65 61 63 68 0a 3b 3b 20 3b 3b 20 (for-each.;; ;;
13b10 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 ;; redo me .
13b20 20 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 (lambda (item)
13b30 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13b40 65 20 09 09 28 6c 65 74 20 28 28 6e 65 77 76 61 e ..(let ((newva
13b50 6c 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 67 l ;; (sdb:qry 'g
13b60 65 74 69 64 20 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 etid .;; ;; ;; r
13b70 65 64 6f 20 6d 65 20 09 09 20 20 20 20 20 20 20 edo me ..
13b80 28 63 61 64 72 20 69 74 65 6d 29 29 29 20 3b 3b (cadr item))) ;;
13b90 20 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f ).;; ;; ;; redo
13ba0 20 6d 65 20 09 09 20 20 28 69 66 20 28 6e 6f 74 me .. (if (not
13bb0 20 28 65 71 75 61 6c 3f 20 6e 65 77 76 61 6c 20 (equal? newval
13bc0 28 63 61 64 72 20 69 74 65 6d 29 29 29 0a 3b 3b (cadr item))).;;
13bd0 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
13be0 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
13bf0 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
13c00 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 ult-log-port* "C
13c10 6f 6e 76 65 72 74 69 6e 67 20 22 20 28 63 61 64 onverting " (cad
13c20 72 20 69 74 65 6d 29 20 22 20 74 6f 20 22 20 6e r item) " to " n
13c30 65 77 76 61 6c 20 22 20 66 6f 72 20 74 65 73 74 ewval " for test
13c40 20 23 22 20 28 63 61 72 20 69 74 65 6d 29 29 29 #" (car item)))
13c50 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13c60 65 20 09 09 20 20 28 73 71 6c 69 74 65 33 3a 65 e .. (sqlite3:e
13c70 78 65 63 75 74 65 20 71 72 79 20 6e 65 77 76 61 xecute qry newva
13c80 6c 20 28 63 61 72 20 69 74 65 6d 29 29 29 29 0a l (car item)))).
13c90 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
13ca0 20 09 20 20 20 20 20 20 64 61 74 29 0a 3b 3b 20 . dat).;;
13cb0 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 ;; ;; redo me .
13cc0 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e (sqlite3:fin
13cd0 61 6c 69 7a 65 21 20 71 72 79 29 29 29 29 0a 3b alize! qry)))).;
13ce0 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
13cf0 20 20 20 20 20 20 20 28 64 62 3a 63 6c 6f 73 65 (db:close
13d00 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 29 0a 3b -all dbstruct).;
13d10 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
13d20 20 20 20 20 20 20 20 28 6c 69 73 74 20 22 75 6e (list "un
13d30 61 6d 65 22 20 22 72 75 6e 64 69 72 22 20 22 66 ame" "rundir" "f
13d40 69 6e 61 6c 5f 6c 6f 67 66 22 20 22 63 6f 6d 6d inal_logf" "comm
13d50 65 6e 74 22 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 ent")).;; ;; ;;
13d60 72 65 64 6f 20 6d 65 20 20 20 20 20 20 20 28 73 redo me (s
13d70 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
13d80 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
13d90 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 6d rgs:get-arg "-im
13da0 70 6f 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 port-megatest.db
13db0 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
13dc0 20 20 20 20 28 64 62 3a 6d 75 6c 74 69 2d 64 62 (db:multi-db
13dd0 2d 73 79 6e 63 20 0a 20 20 20 20 20 20 20 23 66 -sync . #f
13de0 20 3b 3b 20 64 6f 20 61 6c 6c 20 72 75 6e 2d 69 ;; do all run-i
13df0 64 73 0a 20 20 20 20 20 20 20 27 6b 69 6c 6c 73 ds. 'kills
13e00 65 72 76 65 72 73 0a 20 20 20 20 20 20 20 27 64 ervers. 'd
13e10 65 6a 75 6e 6b 0a 20 20 20 20 20 20 20 27 61 64 ejunk. 'ad
13e20 6a 2d 74 65 73 74 69 64 73 0a 20 20 20 20 20 20 j-testids.
13e30 20 27 6f 6c 64 32 6e 65 77 0a 20 20 20 20 20 20 'old2new.
13e40 20 3b 3b 20 27 6e 65 77 32 6f 6c 64 0a 20 20 20 ;; 'new2old.
13e50 20 20 20 20 29 0a 20 20 20 20 20 20 28 73 65 74 ). (set
13e60 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
13e70 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
13e80 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 79 6e 63 s:get-arg "-sync
13e90 2d 74 6f 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 -to-megatest.db"
13ea0 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
13eb0 20 20 20 28 64 62 3a 6d 75 6c 74 69 2d 64 62 2d (db:multi-db-
13ec0 73 79 6e 63 20 0a 20 20 20 20 20 20 20 23 66 20 sync . #f
13ed0 3b 3b 20 64 6f 20 61 6c 6c 20 72 75 6e 2d 69 64 ;; do all run-id
13ee0 73 0a 20 20 20 20 20 20 20 27 6e 65 77 32 6f 6c s. 'new2ol
13ef0 64 0a 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 d. ).
13f00 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
13f10 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 hing* #t)))..(if
13f20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
13f30 2d 67 65 6e 65 72 61 74 65 2d 68 74 6d 6c 22 29 -generate-html")
13f40 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 . (let* ((top
13f50 70 61 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 path (launch:set
13f60 75 70 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 up))). (if
13f70 28 74 65 73 74 73 3a 63 72 65 61 74 65 2d 68 74 (tests:create-ht
13f80 6d 6c 2d 74 72 65 65 20 23 66 29 0a 20 20 20 20 ml-tree #f).
13f90 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
13fa0 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
13fb0 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 48 54 lt-log-port* "HT
13fc0 4d 4c 20 6f 75 74 70 75 74 20 63 72 65 61 74 65 ML output create
13fd0 64 20 69 6e 20 22 20 74 6f 70 70 61 74 68 20 22 d in " toppath "
13fe0 2f 6c 74 2f 72 75 6e 73 2d 69 6e 64 65 78 2e 68 /lt/runs-index.h
13ff0 74 6d 6c 22 29 0a 20 20 20 20 20 20 20 20 20 20 tml").
14000 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
14010 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
14020 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 63 72 65 * "Failed to cre
14030 61 74 65 20 48 54 4d 4c 20 6f 75 74 70 75 74 20 ate HTML output
14040 69 6e 20 22 20 74 6f 70 70 61 74 68 20 22 2f 6c in " toppath "/l
14050 74 2f 72 75 6e 73 2d 69 6e 64 65 78 2e 68 74 6d t/runs-index.htm
14060 6c 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 l")). (set!
14070 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
14080 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d #t)))..;;=======
14090 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
140a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
140b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
140c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
140d0 3b 3b 20 45 78 69 74 20 61 6e 64 20 63 6c 65 61 ;; Exit and clea
140e0 6e 20 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d n up.;;=========
140f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14100 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14110 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14120 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
14130 69 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 28 if *runremote* (
14140 63 6c 6f 73 65 2d 61 6c 6c 2d 63 6f 6e 6e 65 63 close-all-connec
14150 74 69 6f 6e 73 21 29 29 20 3b 3b 20 66 6f 72 20 tions!)) ;; for
14160 68 74 74 70 2d 63 6c 69 65 6e 74 0a 0a 28 69 66 http-client..(if
14170 20 28 6e 6f 74 20 2a 64 69 64 73 6f 6d 65 74 68 (not *didsometh
14180 69 6e 67 2a 29 0a 20 20 20 20 28 64 65 62 75 67 ing*). (debug
14190 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
141a0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 68 65 6c 70 t-log-port* help
141b0 29 29 0a 0a 28 73 65 74 21 20 2a 74 69 6d 65 2d ))..(set! *time-
141c0 74 6f 2d 65 78 69 74 2a 20 23 74 29 0a 28 74 68 to-exit* #t).(th
141d0 72 65 61 64 2d 6a 6f 69 6e 21 20 2a 77 61 74 63 read-join! *watc
141e0 68 64 6f 67 2a 29 0a 0a 28 69 66 20 28 6e 6f 74 hdog*)..(if (not
141f0 20 28 65 71 3f 20 2a 67 6c 6f 62 61 6c 65 78 69 (eq? *globalexi
14200 74 73 74 61 74 75 73 2a 20 30 29 29 0a 20 20 20 tstatus* 0)).
14210 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 (if (or (args:g
14220 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 28 61 et-arg "-run")(a
14230 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
14240 6e 74 65 73 74 73 22 29 28 61 72 67 73 3a 67 65 ntests")(args:ge
14250 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 t-arg "-runall")
14260 29 0a 20 20 20 20 20 20 20 20 28 62 65 67 69 6e ). (begin
14270 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 . (deb
14280 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
14290 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e ult-log-port* "N
142a0 4f 54 45 3a 20 53 75 62 70 72 6f 63 65 73 73 65 OTE: Subprocesse
142b0 73 20 77 69 74 68 20 6e 6f 6e 2d 7a 65 72 6f 20 s with non-zero
142c0 65 78 69 74 20 63 6f 64 65 20 64 65 74 65 63 74 exit code detect
142d0 65 64 3a 20 22 20 2a 67 6c 6f 62 61 6c 65 78 69 ed: " *globalexi
142e0 74 73 74 61 74 75 73 2a 29 0a 20 20 20 20 20 20 tstatus*).
142f0 20 20 20 20 20 28 65 78 69 74 20 30 29 29 0a 20 (exit 0)).
14300 20 20 20 20 20 20 20 28 63 61 73 65 20 2a 67 6c (case *gl
14310 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 0a obalexitstatus*.
14320 20 20 20 20 20 20 20 20 20 28 28 30 29 28 65 78 ((0)(ex
14330 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 it 0)).
14340 28 28 31 29 28 65 78 69 74 20 31 29 29 0a 20 20 ((1)(exit 1)).
14350 20 20 20 20 20 20 20 28 28 32 29 28 65 78 69 74 ((2)(exit
14360 20 32 29 29 0a 20 20 20 20 20 20 20 20 20 28 65 2)). (e
14370 6c 73 65 20 28 65 78 69 74 20 33 29 29 29 29 29 lse (exit 3)))))
14380 0a .