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 3b aunch:setup))..;
68e0: 3b 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 6e ; (run-id (an
68f0: 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
6900: 22 2d 72 75 6e 2d 69 64 22 29 0a 09 3b 3b 20 09 "-run-id")..;; .
6910: 09 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 . (string->numb
6920: 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 er (args:get-arg
6930: 20 22 2d 72 75 6e 2d 69 64 22 29 29 29 29 0a 20 "-run-id")))).
6940: 20 20 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 (transp
6950: 6f 72 74 2d 74 79 70 65 20 28 73 74 72 69 6e 67 ort-type (string
6960: 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 20 28 61 72 ->symbol (or (ar
6970: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 72 61 gs:get-arg "-tra
6980: 6e 73 70 6f 72 74 22 29 20 22 68 74 74 70 22 29 nsport") "http")
6990: 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 28 69 66 ))). ;; (if
69a0: 20 72 75 6e 2d 69 64 0a 20 20 20 20 20 20 3b 3b run-id. ;;
69b0: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
69c0: 28 73 65 72 76 65 72 3a 6c 61 75 6e 63 68 20 30 (server:launch 0
69d0: 20 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 29 transport-type)
69e0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
69f0: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
6a00: 29 0a 3b 3b 20 20 20 20 20 3b 3b 20 28 64 65 62 ).;; ;; (deb
6a10: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
6a20: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
6a30: 72 74 2a 20 22 73 65 72 76 65 72 20 72 65 71 75 rt* "server requ
6a40: 69 72 65 73 20 72 75 6e 2d 69 64 20 62 65 20 73 ires run-id be s
6a50: 70 65 63 69 66 69 65 64 20 77 69 74 68 20 2d 72 pecified with -r
6a60: 75 6e 2d 69 64 22 29 29 29 0a 3b 3b 20 0a 3b 3b un-id"))).;; .;;
6a70: 20 20 20 20 20 3b 3b 20 4e 6f 74 20 61 20 73 65 ;; Not a se
6a80: 72 76 65 72 3f 20 54 68 69 73 20 73 65 63 74 69 rver? This secti
6a90: 6f 6e 20 77 69 6c 6c 20 64 65 63 69 64 65 20 68 on will decide h
6aa0: 6f 77 20 74 6f 20 63 6f 6d 6d 75 6e 69 63 61 74 ow to communicat
6ab0: 65 0a 3b 3b 20 20 20 20 20 3b 3b 0a 3b 3b 20 20 e.;; ;;.;;
6ac0: 20 20 20 3b 3b 20 20 53 65 74 75 70 20 63 6c 69 ;; Setup cli
6ad0: 65 6e 74 20 66 6f 72 20 61 6c 6c 20 65 78 70 65 ent for all expe
6ae0: 63 74 20 6c 69 73 74 65 64 20 68 65 72 65 0a 3b ct listed here.;
6af0: 3b 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f ; (if (null?
6b00: 20 28 6c 73 65 74 2d 69 6e 74 65 72 73 65 63 74 (lset-intersect
6b10: 69 6f 6e 20 0a 3b 3b 20 09 09 65 71 75 61 6c 3f ion .;; ..equal?
6b20: 0a 3b 3b 20 09 09 28 68 61 73 68 2d 74 61 62 6c .;; ..(hash-tabl
6b30: 65 2d 6b 65 79 73 20 61 72 67 73 3a 61 72 67 2d e-keys args:arg-
6b40: 68 61 73 68 29 0a 3b 3b 20 09 09 27 28 22 2d 6c hash).;; ..'("-l
6b50: 69 73 74 2d 73 65 72 76 65 72 73 22 0a 3b 3b 20 ist-servers".;;
6b60: 09 09 20 20 22 2d 73 74 6f 70 2d 73 65 72 76 65 .. "-stop-serve
6b70: 72 22 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 r".;;
6b80: 20 20 20 20 20 20 20 20 22 2d 6b 69 6c 6c 2d 73 "-kill-s
6b90: 65 72 76 65 72 22 0a 3b 3b 20 09 09 20 20 22 2d erver".;; .. "-
6ba0: 73 68 6f 77 2d 63 6d 64 69 6e 66 6f 22 0a 3b 3b show-cmdinfo".;;
6bb0: 20 09 09 20 20 22 2d 6c 69 73 74 2d 72 75 6e 73 .. "-list-runs
6bc0: 22 0a 3b 3b 20 09 09 20 20 22 2d 70 69 6e 67 22 ".;; .. "-ping"
6bd0: 29 29 29 0a 3b 3b 20 09 28 69 66 20 28 6c 61 75 ))).;; .(if (lau
6be0: 6e 63 68 3a 73 65 74 75 70 29 0a 3b 3b 20 09 20 nch:setup).;; .
6bf0: 20 20 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 (let ((run-id
6c00: 20 20 20 20 28 61 6e 64 20 28 61 72 67 73 3a 67 (and (args:g
6c10: 65 74 2d 61 72 67 20 22 2d 72 75 6e 2d 69 64 22 et-arg "-run-id"
6c20: 29 0a 3b 3b 20 09 09 09 09 20 20 28 73 74 72 69 ).;; .... (stri
6c30: 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 ng->number (args
6c40: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 2d 69 :get-arg "-run-i
6c50: 64 22 29 29 29 29 29 0a 3b 3b 20 09 20 20 20 20 d"))))).;; .
6c60: 20 20 3b 3b 20 28 73 65 74 21 20 2a 66 64 62 2a ;; (set! *fdb*
6c70: 20 20 20 28 66 69 6c 65 64 62 3a 6f 70 65 6e 2d (filedb:open-
6c80: 64 62 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 db (conc *toppat
6c90: 68 2a 20 22 2f 64 62 2f 70 61 74 68 73 2e 64 62 h* "/db/paths.db
6ca0: 22 29 29 29 0a 3b 3b 20 09 20 20 20 20 20 20 3b "))).;; . ;
6cb0: 3b 20 69 66 20 6e 6f 74 20 6c 69 73 74 20 6f 72 ; if not list or
6cc0: 20 6b 69 6c 6c 20 74 68 65 6e 20 73 74 61 72 74 kill then start
6cd0: 20 61 20 63 6c 69 65 6e 74 20 28 69 66 20 61 70 a client (if ap
6ce0: 70 72 6f 70 72 69 61 74 65 29 0a 3b 3b 20 09 20 propriate).;; .
6cf0: 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 61 72 (if (or (ar
6d00: 67 73 2d 64 65 66 69 6e 65 64 3f 20 22 2d 68 22 gs-defined? "-h"
6d10: 20 22 2d 76 65 72 73 69 6f 6e 22 20 22 2d 63 72 "-version" "-cr
6d20: 65 61 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 72 eate-megatest-ar
6d30: 65 61 22 20 22 2d 63 72 65 61 74 65 2d 74 65 73 ea" "-create-tes
6d40: 74 22 29 0a 3b 3b 20 09 09 20 20 20 20 20 20 28 t").;; .. (
6d50: 65 71 3f 20 28 6c 65 6e 67 74 68 20 28 68 61 73 eq? (length (has
6d60: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 61 72 67 h-table-keys arg
6d70: 73 3a 61 72 67 2d 68 61 73 68 29 29 20 30 29 29 s:arg-hash)) 0))
6d80: 0a 3b 3b 20 09 09 20 20 28 64 65 62 75 67 3a 70 .;; .. (debug:p
6d90: 72 69 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 rint-info 1 *def
6da0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
6db0: 53 65 72 76 65 72 20 63 6f 6e 6e 65 63 74 69 6f Server connectio
6dc0: 6e 20 6e 6f 74 20 6e 65 65 64 65 64 22 29 0a 3b n not needed").;
6dd0: 3b 20 09 09 20 20 28 62 65 67 69 6e 0a 3b 3b 20 ; .. (begin.;;
6de0: 09 09 20 20 20 20 3b 3b 20 28 69 66 20 72 75 6e .. ;; (if run
6df0: 2d 69 64 20 0a 3b 3b 20 09 09 20 20 20 20 3b 3b -id .;; .. ;;
6e00: 20 20 20 20 20 28 63 6c 69 65 6e 74 3a 6c 61 75 (client:lau
6e10: 6e 63 68 20 72 75 6e 2d 69 64 29 20 0a 3b 3b 20 nch run-id) .;;
6e20: 09 09 20 20 20 20 3b 3b 20 20 20 20 20 28 63 6c .. ;; (cl
6e30: 69 65 6e 74 3a 6c 61 75 6e 63 68 20 30 29 20 20 ient:launch 0)
6e40: 20 20 20 20 3b 3b 20 77 69 74 68 6f 75 74 20 72 ;; without r
6e50: 75 6e 2d 69 64 20 77 65 27 6c 6c 20 73 74 61 72 un-id we'll star
6e60: 74 20 61 20 73 65 72 76 65 72 20 66 6f 72 20 22 t a server for "
6e70: 30 22 0a 3b 3b 20 09 09 20 20 20 20 23 74 0a 3b 0".;; .. #t.;
6e80: 3b 20 09 09 20 20 20 20 29 29 29 29 29 29 0a 0a ; .. ))))))..
6e90: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
6ea0: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 73 65 72 t-arg "-list-ser
6eb0: 76 65 72 73 22 29 0a 09 28 61 72 67 73 3a 67 65 vers")..(args:ge
6ec0: 74 2d 61 72 67 20 22 2d 73 74 6f 70 2d 73 65 72 t-arg "-stop-ser
6ed0: 76 65 72 22 29 0a 20 20 20 20 20 20 20 20 28 61 ver"). (a
6ee0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6b 69 rgs:get-arg "-ki
6ef0: 6c 6c 2d 73 65 72 76 65 72 22 29 29 0a 20 20 20 ll-server")).
6f00: 20 28 6c 65 74 20 28 28 74 6c 20 28 6c 61 75 6e (let ((tl (laun
6f10: 63 68 3a 73 65 74 75 70 29 29 29 0a 20 20 20 20 ch:setup))).
6f20: 20 20 28 69 66 20 74 6c 20 0a 09 20 20 28 6c 65 (if tl .. (le
6f30: 74 2a 20 28 28 74 64 62 64 61 74 20 20 28 74 61 t* ((tdbdat (ta
6f40: 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 29 0a 09 09 sks:open-db))...
6f50: 20 28 73 65 72 76 65 72 73 20 28 74 61 73 6b 73 (servers (tasks
6f60: 3a 67 65 74 2d 61 6c 6c 2d 73 65 72 76 65 72 73 :get-all-servers
6f70: 20 28 64 62 3a 64 65 6c 61 79 2d 69 66 2d 62 75 (db:delay-if-bu
6f80: 73 79 20 74 64 62 64 61 74 29 29 29 0a 09 09 20 sy tdbdat)))...
6f90: 28 66 6d 74 73 74 72 20 20 22 7e 35 61 7e 31 32 (fmtstr "~5a~12
6fa0: 61 7e 38 61 7e 32 30 61 7e 32 34 61 7e 31 30 61 a~8a~20a~24a~10a
6fb0: 7e 31 30 61 7e 31 30 61 7e 31 30 61 5c 6e 22 29 ~10a~10a~10a\n")
6fc0: 0a 09 09 20 28 73 65 72 76 65 72 73 2d 74 6f 2d ... (servers-to-
6fd0: 6b 69 6c 6c 20 27 28 29 29 0a 20 20 20 20 20 20 kill '()).
6fe0: 20 20 20 20 20 20 20 20 20 20 20 28 6b 69 6c 6c (kill
6ff0: 2d 73 77 69 74 63 68 20 20 28 69 66 20 28 61 72 -switch (if (ar
7000: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6b 69 6c gs:get-arg "-kil
7010: 6c 2d 73 65 72 76 65 72 22 29 20 22 2d 39 22 20 l-server") "-9"
7020: 22 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 "")).
7030: 20 20 20 20 20 20 28 6b 69 6c 6c 69 6e 66 6f 20 (killinfo
7040: 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d (or (args:get-
7050: 61 72 67 20 22 2d 73 74 6f 70 2d 73 65 72 76 65 arg "-stop-serve
7060: 72 22 29 20 28 61 72 67 73 3a 67 65 74 2d 61 72 r") (args:get-ar
7070: 67 20 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 g "-kill-server"
7080: 29 20 29 29 0a 09 09 20 28 6b 68 6f 73 74 2d 70 ) ))... (khost-p
7090: 6f 72 74 20 28 69 66 20 6b 69 6c 6c 69 6e 66 6f ort (if killinfo
70a0: 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d (if (substring-
70b0: 69 6e 64 65 78 20 22 3a 22 20 6b 69 6c 6c 69 6e index ":" killin
70c0: 66 6f 29 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 fo)(string-split
70d0: 20 22 3a 22 29 20 23 66 29 20 23 66 29 29 0a 09 ":") #f) #f))..
70e0: 09 20 28 73 69 64 20 20 20 20 20 20 20 20 28 69 . (sid (i
70f0: 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 69 66 20 28 f killinfo (if (
7100: 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 substring-index
7110: 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f 29 20 23 66 ":" killinfo) #f
7120: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
7130: 20 6b 69 6c 6c 69 6e 66 6f 29 29 20 23 66 29 29 killinfo)) #f))
7140: 29 0a 09 20 20 20 20 28 66 6f 72 6d 61 74 20 23 ).. (format #
7150: 74 20 66 6d 74 73 74 72 20 22 49 64 22 20 22 4d t fmtstr "Id" "M
7160: 54 76 65 72 22 20 22 50 69 64 22 20 22 48 6f 73 Tver" "Pid" "Hos
7170: 74 22 20 22 49 6e 74 65 72 66 61 63 65 3a 4f 75 t" "Interface:Ou
7180: 74 50 6f 72 74 22 20 22 49 6e 50 6f 72 74 22 20 tPort" "InPort"
7190: 22 4c 61 73 74 42 65 61 74 22 20 22 53 74 61 74 "LastBeat" "Stat
71a0: 65 22 20 22 54 72 61 6e 73 70 6f 72 74 22 29 0a e" "Transport").
71b0: 09 20 20 20 20 28 66 6f 72 6d 61 74 20 23 74 20 . (format #t
71c0: 66 6d 74 73 74 72 20 22 3d 3d 22 20 22 3d 3d 3d fmtstr "==" "===
71d0: 3d 3d 22 20 22 3d 3d 3d 22 20 22 3d 3d 3d 3d 22 ==" "===" "===="
71e0: 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d "==============
71f0: 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 22 20 22 3d ===" "======" "=
7200: 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 =======" "====="
7210: 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 29 0a 09 20 "=========")..
7220: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 (for-each ..
7230: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 72 (lambda (ser
7240: 76 65 72 29 0a 09 20 20 20 20 20 20 20 28 6c 65 ver).. (le
7250: 74 2a 20 28 28 69 64 20 20 20 20 20 20 20 20 20 t* ((id
7260: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 (vector-ref serv
7270: 65 72 20 30 29 29 0a 09 09 20 20 20 20 20 20 28 er 0))... (
7280: 70 69 64 20 20 20 20 20 20 20 20 28 76 65 63 74 pid (vect
7290: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 29 or-ref server 1)
72a0: 29 0a 09 09 20 20 20 20 20 20 28 68 6f 73 74 6e )... (hostn
72b0: 61 6d 65 20 20 20 28 76 65 63 74 6f 72 2d 72 65 ame (vector-re
72c0: 66 20 73 65 72 76 65 72 20 32 29 29 0a 09 09 20 f server 2))...
72d0: 20 20 20 20 20 28 69 6e 74 65 72 66 61 63 65 20 (interface
72e0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
72f0: 76 65 72 20 33 29 29 20 0a 09 09 20 20 20 20 20 ver 3)) ...
7300: 20 28 70 75 6c 6c 70 6f 72 74 20 20 20 28 76 65 (pullport (ve
7310: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
7320: 34 29 29 0a 09 09 20 20 20 20 20 20 28 70 75 62 4))... (pub
7330: 70 6f 72 74 20 20 20 20 28 76 65 63 74 6f 72 2d port (vector-
7340: 72 65 66 20 73 65 72 76 65 72 20 35 29 29 0a 09 ref server 5))..
7350: 09 20 20 20 20 20 20 28 73 74 61 72 74 2d 74 69 . (start-ti
7360: 6d 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 me (vector-ref s
7370: 65 72 76 65 72 20 36 29 29 0a 09 09 20 20 20 20 erver 6))...
7380: 20 20 28 70 72 69 6f 72 69 74 79 20 20 20 28 76 (priority (v
7390: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
73a0: 20 37 29 29 0a 09 09 20 20 20 20 20 20 28 73 74 7))... (st
73b0: 61 74 65 20 20 20 20 20 20 28 76 65 63 74 6f 72 ate (vector
73c0: 2d 72 65 66 20 73 65 72 76 65 72 20 38 29 29 0a -ref server 8)).
73d0: 09 09 20 20 20 20 20 20 28 6d 74 2d 76 65 72 20 .. (mt-ver
73e0: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
73f0: 73 65 72 76 65 72 20 39 29 29 0a 09 09 20 20 20 server 9))...
7400: 20 20 20 28 6c 61 73 74 2d 75 70 64 61 74 65 20 (last-update
7410: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 (vector-ref serv
7420: 65 72 20 31 30 29 29 20 0a 09 09 20 20 20 20 20 er 10)) ...
7430: 20 28 74 72 61 6e 73 70 6f 72 74 20 20 28 76 65 (transport (ve
7440: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
7450: 31 31 29 29 0a 09 09 20 20 20 20 20 20 28 6b 69 11))... (ki
7460: 6c 6c 65 64 20 20 20 20 20 23 66 29 0a 09 09 20 lled #f)...
7470: 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 (status
7480: 20 28 3c 20 6c 61 73 74 2d 75 70 64 61 74 65 20 (< last-update
7490: 32 30 29 29 29 0a 09 09 20 3b 3b 20 20 20 28 7a 20)))... ;; (z
74a0: 6d 71 2d 73 6f 63 6b 65 74 73 20 28 69 66 20 73 mq-sockets (if s
74b0: 74 61 74 75 73 20 28 73 65 72 76 65 72 3a 63 6c tatus (server:cl
74c0: 69 65 6e 74 2d 63 6f 6e 6e 65 63 74 20 68 6f 73 ient-connect hos
74d0: 74 6e 61 6d 65 20 70 6f 72 74 29 20 23 66 29 29 tname port) #f))
74e0: 29 0a 09 09 20 3b 3b 20 6e 6f 20 6e 65 65 64 20 )... ;; no need
74f0: 74 6f 20 6c 6f 67 69 6e 20 61 73 20 73 74 61 74 to login as stat
7500: 75 73 20 6f 66 20 23 74 20 69 6e 64 69 63 61 74 us of #t indicat
7510: 65 73 20 77 65 20 61 72 65 20 63 6f 6e 6e 65 63 es we are connec
7520: 74 69 6e 67 20 74 6f 20 63 6f 72 72 65 63 74 20 ting to correct
7530: 0a 09 09 20 3b 3b 20 73 65 72 76 65 72 0a 09 09 ... ;; server...
7540: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 (if (equal? sta
7550: 74 65 20 22 64 65 61 64 22 29 0a 09 09 20 20 20 te "dead")...
7560: 20 20 28 69 66 20 28 3e 20 6c 61 73 74 2d 75 70 (if (> last-up
7570: 64 61 74 65 20 28 2a 20 32 35 20 36 30 20 36 30 date (* 25 60 60
7580: 29 29 20 3b 3b 20 6b 65 65 70 20 72 65 63 6f 72 )) ;; keep recor
7590: 64 73 20 61 72 6f 75 6e 64 20 66 6f 72 20 73 6c ds around for sl
75a0: 69 67 68 6c 79 20 6f 76 65 72 20 61 20 64 61 79 ighly over a day
75b0: 2e 0a 09 09 09 20 28 74 61 73 6b 73 3a 73 65 72 ..... (tasks:ser
75c0: 76 65 72 2d 64 65 72 65 67 69 73 74 65 72 20 28 ver-deregister (
75d0: 64 62 3a 64 65 6c 61 79 2d 69 66 2d 62 75 73 79 db:delay-if-busy
75e0: 20 74 64 62 64 61 74 29 20 68 6f 73 74 6e 61 6d tdbdat) hostnam
75f0: 65 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 6c 6c e pullport: pull
7600: 70 6f 72 74 20 70 69 64 3a 20 70 69 64 20 61 63 port pid: pid ac
7610: 74 69 6f 6e 3a 20 27 64 65 6c 65 74 65 29 29 0a tion: 'delete)).
7620: 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 6c 61 .. (if (> la
7630: 73 74 2d 75 70 64 61 74 65 20 32 30 29 20 20 20 st-update 20)
7640: 20 20 20 20 20 3b 3b 20 4d 61 72 6b 20 61 73 20 ;; Mark as
7650: 64 65 61 64 20 69 66 20 6e 6f 74 20 75 70 64 61 dead if not upda
7660: 74 65 64 20 69 6e 20 6c 61 73 74 20 32 30 20 73 ted in last 20 s
7670: 65 63 6f 6e 64 73 0a 09 09 09 20 28 74 61 73 6b econds.... (task
7680: 73 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 s:server-deregis
7690: 74 65 72 20 28 64 62 3a 64 65 6c 61 79 2d 69 66 ter (db:delay-if
76a0: 2d 62 75 73 79 20 74 64 62 64 61 74 29 20 68 6f -busy tdbdat) ho
76b0: 73 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 74 3a stname pullport:
76c0: 20 70 75 6c 6c 70 6f 72 74 20 70 69 64 3a 20 70 pullport pid: p
76d0: 69 64 29 29 29 0a 09 09 20 28 66 6f 72 6d 61 74 id)))... (format
76e0: 20 23 74 20 66 6d 74 73 74 72 20 69 64 20 6d 74 #t fmtstr id mt
76f0: 2d 76 65 72 20 70 69 64 20 68 6f 73 74 6e 61 6d -ver pid hostnam
7700: 65 20 28 63 6f 6e 63 20 69 6e 74 65 72 66 61 63 e (conc interfac
7710: 65 20 22 3a 22 20 70 75 6c 6c 70 6f 72 74 29 20 e ":" pullport)
7720: 70 75 62 70 6f 72 74 20 6c 61 73 74 2d 75 70 64 pubport last-upd
7730: 61 74 65 0a 09 09 09 20 28 69 66 20 73 74 61 74 ate.... (if stat
7740: 75 73 20 22 61 6c 69 76 65 22 20 22 64 65 61 64 us "alive" "dead
7750: 22 29 20 74 72 61 6e 73 70 6f 72 74 29 0a 09 09 ") transport)...
7760: 20 28 69 66 20 28 6f 72 20 28 65 71 75 61 6c 3f (if (or (equal?
7770: 20 69 64 20 73 69 64 29 0a 09 09 09 20 28 65 71 id sid).... (eq
7780: 75 61 6c 3f 20 73 69 64 20 30 29 29 20 3b 3b 20 ual? sid 0)) ;;
7790: 6b 69 6c 6c 20 61 6c 6c 2f 61 6e 79 0a 09 09 20 kill all/any...
77a0: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 (begin...
77b0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
77c0: 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
77d0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 41 74 74 65 -log-port* "Atte
77e0: 6d 70 74 69 6e 67 20 74 6f 20 6b 69 6c 6c 20 22 mpting to kill "
77f0: 6b 69 6c 6c 2d 73 77 69 74 63 68 22 20 73 65 72 kill-switch" ser
7800: 76 65 72 20 77 69 74 68 20 70 69 64 20 22 20 70 ver with pid " p
7810: 69 64 29 0a 09 09 20 20 20 20 20 20 20 28 74 61 id)... (ta
7820: 73 6b 73 3a 6b 69 6c 6c 2d 73 65 72 76 65 72 20 sks:kill-server
7830: 68 6f 73 74 6e 61 6d 65 20 70 69 64 20 6b 69 6c hostname pid kil
7840: 6c 2d 73 77 69 74 63 68 3a 20 6b 69 6c 6c 2d 73 l-switch: kill-s
7850: 77 69 74 63 68 29 29 29 29 29 0a 09 20 20 20 20 witch)))))..
7860: 20 73 65 72 76 65 72 73 29 0a 09 20 20 20 20 28 servers).. (
7870: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
7880: 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 1 *default-log-
7890: 70 6f 72 74 2a 20 22 44 6f 6e 65 20 77 69 74 68 port* "Done with
78a0: 20 6c 69 73 74 73 65 72 76 65 72 73 22 29 0a 09 listservers")..
78b0: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
78c0: 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 mething* #t)..
78d0: 20 20 28 65 78 69 74 29 29 20 3b 3b 20 6d 75 73 (exit)) ;; mus
78e0: 74 20 64 6f 2c 20 77 6f 75 6c 64 20 68 61 76 65 t do, would have
78f0: 20 74 6f 20 61 64 64 20 63 68 65 63 6b 73 20 74 to add checks t
7900: 6f 20 6d 61 6e 79 2f 61 6c 6c 20 63 61 6c 6c 73 o many/all calls
7910: 20 62 65 6c 6f 77 0a 09 20 20 28 65 78 69 74 29 below.. (exit)
7920: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
7930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7950: 3d 3d 3d 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 0a 3b 3b =============.;;
7970: 20 57 65 69 72 64 20 73 70 65 63 69 61 6c 20 63 Weird special c
7980: 61 6c 6c 73 20 74 68 61 74 20 6e 65 65 64 20 74 alls that need t
7990: 6f 20 72 75 6e 20 2a 61 66 74 65 72 2a 20 74 68 o run *after* th
79a0: 65 20 73 65 72 76 65 72 20 68 61 73 20 73 74 61 e server has sta
79b0: 72 74 65 64 3f 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d rted?.;;========
79c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
79d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
79e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
79f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
7a00: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
7a10: 67 20 22 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 g "-list-targets
7a20: 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 61 "). (let ((ta
7a30: 72 67 65 74 73 20 28 63 6f 6d 6d 6f 6e 3a 67 65 rgets (common:ge
7a40: 74 2d 72 75 6e 63 6f 6e 66 69 67 2d 74 61 72 67 t-runconfig-targ
7a50: 65 74 73 29 29 29 0a 20 20 20 20 20 20 28 64 65 ets))). (de
7a60: 62 75 67 3a 70 72 69 6e 74 20 31 20 2a 64 65 66 bug:print 1 *def
7a70: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
7a80: 46 6f 75 6e 64 20 22 28 6c 65 6e 67 74 68 20 74 Found "(length t
7a90: 61 72 67 65 74 73 29 20 22 20 74 61 72 67 65 74 argets) " target
7aa0: 73 22 29 0a 20 20 20 20 20 20 28 63 61 73 65 20 s"). (case
7ab0: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
7ac0: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
7ad0: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
7ae0: 61 6c 69 73 74 22 29 29 0a 09 28 28 61 6c 69 73 alist"))..((alis
7af0: 74 29 0a 09 20 28 66 6f 72 2d 65 61 63 68 20 28 t).. (for-each (
7b00: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 20 20 20 lambda (x)...
7b10: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 5b 22 20 ;; (print "["
7b20: 78 20 22 5d 22 29 29 0a 09 09 20 20 20 20 20 28 x "]"))... (
7b30: 70 72 69 6e 74 20 78 29 29 0a 09 09 20 20 20 74 print x))... t
7b40: 61 72 67 65 74 73 29 29 0a 09 28 28 6a 73 6f 6e argets))..((json
7b50: 29 0a 09 20 28 6a 73 6f 6e 2d 77 72 69 74 65 20 ).. (json-write
7b60: 74 61 72 67 65 74 73 29 29 0a 09 28 65 6c 73 65 targets))..(else
7b70: 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d .. (debug:print-
7b80: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
7b90: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 64 75 6d 70 -log-port* "dump
7ba0: 20 6f 75 74 70 75 74 20 66 6f 72 6d 61 74 20 22 output format "
7bb0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7bc0: 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f -dumpmode") " no
7bd0: 74 20 73 75 70 70 6f 72 74 65 64 20 66 6f 72 20 t supported for
7be0: 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 22 29 29 -list-targets"))
7bf0: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
7c00: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
7c10: 29 29 0a 0a 3b 3b 20 63 61 63 68 65 20 74 68 65 ))..;; cache the
7c20: 20 72 75 6e 63 6f 6e 66 69 67 73 20 69 6e 20 24 runconfigs in $
7c30: 4d 54 5f 4c 49 4e 4b 54 52 45 45 2f 24 4d 54 5f MT_LINKTREE/$MT_
7c40: 54 41 52 47 45 54 2f 24 4d 54 5f 52 55 4e 4e 41 TARGET/$MT_RUNNA
7c50: 4d 45 2f 2e 72 75 6e 63 6f 6e 66 69 67 0a 3b 3b ME/.runconfig.;;
7c60: 0a 28 64 65 66 69 6e 65 20 28 66 75 6c 6c 2d 72 .(define (full-r
7c70: 75 6e 63 6f 6e 66 69 67 73 2d 72 65 61 64 29 0a unconfigs-read).
7c80: 3b 3b 20 69 6e 20 74 68 65 20 65 6e 76 70 72 6f ;; in the envpro
7c90: 63 65 73 73 69 6e 67 20 62 72 61 6e 63 68 20 74 cessing branch t
7ca0: 68 65 20 62 65 6c 6f 77 20 63 6f 64 65 20 72 65 he below code re
7cb0: 70 6c 61 63 65 73 20 74 68 65 20 66 75 72 74 68 places the furth
7cc0: 65 72 20 62 65 6c 6f 77 20 63 6f 64 65 0a 3b 3b er below code.;;
7cd0: 20 20 28 69 66 20 28 65 71 3f 20 2a 63 6f 6e 66 (if (eq? *conf
7ce0: 69 67 73 74 61 74 75 73 2a 20 27 66 75 6c 6c 64 igstatus* 'fulld
7cf0: 61 74 61 29 0a 3b 3b 20 20 20 20 20 20 2a 72 75 ata).;; *ru
7d00: 6e 63 6f 6e 66 69 67 64 61 74 2a 0a 3b 3b 20 20 nconfigdat*.;;
7d10: 20 20 20 20 28 62 65 67 69 6e 0a 3b 3b 09 28 6c (begin.;;.(l
7d20: 61 75 6e 63 68 3a 73 65 74 75 70 29 0a 3b 3b 09 aunch:setup).;;.
7d30: 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 29 29 *runconfigdat*))
7d40: 29 0a 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e ).. (let* ((run
7d50: 64 69 72 20 28 69 66 20 28 61 6e 64 20 28 67 65 dir (if (and (ge
7d60: 74 65 6e 76 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 tenv "MT_LINKTRE
7d70: 45 22 29 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 E")(getenv "MT_T
7d80: 41 52 47 45 54 22 29 28 67 65 74 65 6e 76 20 22 ARGET")(getenv "
7d90: 4d 54 5f 52 55 4e 4e 41 4d 45 22 29 29 0a 09 09 MT_RUNNAME"))...
7da0: 20 20 20 20 20 28 63 6f 6e 63 20 28 67 65 74 65 (conc (gete
7db0: 6e 76 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 nv "MT_LINKTREE"
7dc0: 29 20 22 2f 22 20 28 67 65 74 65 6e 76 20 22 4d ) "/" (getenv "M
7dd0: 54 5f 54 41 52 47 45 54 22 29 20 22 2f 22 20 28 T_TARGET") "/" (
7de0: 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 getenv "MT_RUNNA
7df0: 4d 45 22 29 29 0a 09 09 20 20 20 20 20 23 66 29 ME"))... #f)
7e00: 29 0a 09 20 28 63 66 67 66 20 20 20 28 69 66 20 ).. (cfgf (if
7e10: 72 75 6e 64 69 72 20 28 63 6f 6e 63 20 72 75 6e rundir (conc run
7e20: 64 69 72 20 22 2f 2e 72 75 6e 63 6f 6e 66 69 67 dir "/.runconfig
7e30: 2e 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 ." megatest-vers
7e40: 69 6f 6e 20 22 2d 22 20 6d 65 67 61 74 65 73 74 ion "-" megatest
7e50: 2d 66 6f 73 73 69 6c 2d 68 61 73 68 29 20 23 66 -fossil-hash) #f
7e60: 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 6e 64 ))). (if (and
7e70: 20 63 66 67 66 0a 09 20 20 20 20 20 28 66 69 6c cfgf.. (fil
7e80: 65 2d 65 78 69 73 74 73 3f 20 63 66 67 66 29 0a e-exists? cfgf).
7e90: 09 20 20 20 20 20 28 66 69 6c 65 2d 77 72 69 74 . (file-writ
7ea0: 65 2d 61 63 63 65 73 73 3f 20 63 66 67 66 29 29 e-access? cfgf))
7eb0: 0a 09 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d ..(configf:read-
7ec0: 61 6c 69 73 74 20 63 66 67 66 29 0a 09 28 6c 65 alist cfgf)..(le
7ed0: 74 2a 20 28 28 6b 65 79 73 20 20 20 28 72 6d 74 t* ((keys (rmt
7ee0: 3a 67 65 74 2d 6b 65 79 73 29 29 0a 09 20 20 20 :get-keys))..
7ef0: 20 20 20 20 28 74 61 72 67 65 74 20 28 63 6f 6d (target (com
7f00: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 mon:args-get-tar
7f10: 67 65 74 29 29 0a 09 20 20 20 20 20 20 20 28 6b get)).. (k
7f20: 65 79 2d 76 61 6c 73 20 28 69 66 20 74 61 72 67 ey-vals (if targ
7f30: 65 74 20 28 6b 65 79 73 3a 74 61 72 67 65 74 2d et (keys:target-
7f40: 3e 6b 65 79 76 61 6c 20 6b 65 79 73 20 74 61 72 >keyval keys tar
7f50: 67 65 74 29 20 23 66 29 29 0a 09 20 20 20 20 20 get) #f))..
7f60: 20 20 28 73 65 63 74 69 6f 6e 73 20 28 69 66 20 (sections (if
7f70: 74 61 72 67 65 74 20 28 6c 69 73 74 20 22 64 65 target (list "de
7f80: 66 61 75 6c 74 22 20 74 61 72 67 65 74 29 20 23 fault" target) #
7f90: 66 29 29 0a 09 20 20 20 20 20 20 20 28 64 61 74 f)).. (dat
7fa0: 61 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 a (begin....
7fb0: 20 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 52 (setenv "MT_R
7fc0: 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 UN_AREA_HOME" *t
7fd0: 6f 70 70 61 74 68 2a 29 0a 09 09 09 20 20 20 28 oppath*).... (
7fe0: 69 66 20 6b 65 79 2d 76 61 6c 73 0a 09 09 09 20 if key-vals....
7ff0: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
8000: 28 6c 61 6d 62 64 61 20 28 6b 74 29 0a 09 09 09 (lambda (kt)....
8010: 09 09 20 20 20 28 73 65 74 65 6e 76 20 28 63 61 .. (setenv (ca
8020: 72 20 6b 74 29 20 28 63 61 64 72 20 6b 74 29 29 r kt) (cadr kt))
8030: 29 0a 09 09 09 09 09 20 6b 65 79 2d 76 61 6c 73 )...... key-vals
8040: 29 29 0a 09 09 09 20 20 20 28 72 65 61 64 2d 63 )).... (read-c
8050: 6f 6e 66 69 67 20 28 63 6f 6e 63 20 2a 74 6f 70 onfig (conc *top
8060: 70 61 74 68 2a 20 22 2f 72 75 6e 63 6f 6e 66 69 path* "/runconfi
8070: 67 73 2e 63 6f 6e 66 69 67 22 29 20 23 66 20 23 gs.config") #f #
8080: 74 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 t sections: sect
8090: 69 6f 6e 73 29 29 29 29 0a 09 20 20 28 69 66 20 ions)))).. (if
80a0: 28 61 6e 64 20 72 75 6e 64 69 72 20 3b 3b 20 68 (and rundir ;; h
80b0: 61 76 65 20 61 6c 6c 20 6e 65 65 64 65 64 20 76 ave all needed v
80c0: 61 72 69 61 62 6c 65 73 73 0a 09 09 20 20 20 28 ariabless... (
80d0: 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 directory-exists
80e0: 3f 20 72 75 6e 64 69 72 29 0a 09 09 20 20 20 28 ? rundir)... (
80f0: 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 file-write-acces
8100: 73 3f 20 72 75 6e 64 69 72 29 29 0a 09 20 20 20 s? rundir))..
8110: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 63 6f 6e (begin...(con
8120: 66 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 73 74 figf:write-alist
8130: 20 64 61 74 61 20 63 66 67 66 29 0a 09 09 3b 3b data cfgf)...;;
8140: 20 66 6f 72 63 65 20 72 65 2d 72 65 61 64 20 6f force re-read o
8150: 66 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 f megatest.confi
8160: 67 20 2d 20 74 68 69 73 20 72 65 73 6f 6c 76 65 g - this resolve
8170: 73 20 63 69 72 63 75 6c 61 72 20 72 65 66 65 72 s circular refer
8180: 65 6e 63 65 73 20 62 65 74 77 65 65 6e 20 6d 65 ences between me
8190: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 0a 09 09 gatest.config...
81a0: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 20 66 6f (launch:setup fo
81b0: 72 63 65 3a 20 23 74 29 0a 09 09 28 6c 61 75 6e rce: #t)...(laun
81c0: 63 68 3a 63 61 63 68 65 2d 63 6f 6e 66 69 67 29 ch:cache-config)
81d0: 29 29 20 3b 3b 20 77 65 20 63 61 6e 20 73 61 66 )) ;; we can saf
81e0: 65 6c 79 20 63 61 63 68 65 20 6d 65 67 61 74 65 ely cache megate
81f0: 73 74 2e 63 6f 6e 66 69 67 20 73 69 6e 63 65 20 st.config since
8200: 77 65 20 68 61 76 65 20 61 20 76 61 6c 69 64 20 we have a valid
8210: 72 75 6e 63 6f 6e 66 69 67 0a 09 20 20 64 61 74 runconfig.. dat
8220: 61 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 a))))..(if (args
8230: 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d :get-arg "-show-
8240: 72 75 6e 63 6f 6e 66 69 67 22 29 0a 20 20 20 20 runconfig").
8250: 28 6c 65 74 20 28 28 74 6c 20 28 6c 61 75 6e 63 (let ((tl (launc
8260: 68 3a 73 65 74 75 70 29 29 29 0a 20 20 20 20 20 h:setup))).
8270: 20 28 70 75 73 68 2d 64 69 72 65 63 74 6f 72 79 (push-directory
8280: 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 20 *toppath*).
8290: 20 20 28 6c 65 74 20 28 28 64 61 74 61 20 28 66 (let ((data (f
82a0: 75 6c 6c 2d 72 75 6e 63 6f 6e 66 69 67 73 2d 72 ull-runconfigs-r
82b0: 65 61 64 29 29 29 0a 09 3b 3b 20 6b 65 65 70 20 ead)))..;; keep
82c0: 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 09 this one local..
82d0: 28 63 6f 6e 64 0a 09 20 28 28 61 6e 64 20 28 61 (cond.. ((and (a
82e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
82f0: 63 74 69 6f 6e 22 29 0a 09 20 20 20 20 20 20 20 ction")..
8300: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8310: 76 61 72 22 29 29 0a 09 20 20 28 6c 65 74 20 28 var")).. (let (
8320: 28 76 61 6c 20 28 6f 72 20 28 63 6f 6e 66 69 67 (val (or (config
8330: 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 61 20 28 61 f:lookup data (a
8340: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
8350: 63 74 69 6f 6e 22 29 28 61 72 67 73 3a 67 65 74 ction")(args:get
8360: 2d 61 72 67 20 22 2d 76 61 72 22 29 29 0a 09 09 -arg "-var"))...
8370: 09 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 . (configf:looku
8380: 70 20 64 61 74 61 20 22 64 65 66 61 75 6c 74 22 p data "default"
8390: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
83a0: 2d 76 61 72 22 29 29 29 29 29 0a 09 20 20 20 20 -var")))))..
83b0: 28 69 66 20 76 61 6c 20 28 70 72 69 6e 74 20 76 (if val (print v
83c0: 61 6c 29 29 29 29 0a 09 20 28 28 6e 6f 74 20 28 al)))).. ((not (
83d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
83e0: 75 6d 70 6d 6f 64 65 22 29 29 0a 09 20 20 28 70 umpmode")).. (p
83f0: 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 p (hash-table->a
8400: 6c 69 73 74 20 64 61 74 61 29 29 29 0a 09 20 28 list data))).. (
8410: 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a (string=? (args:
8420: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
8430: 64 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 20 20 de") "json")..
8440: 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 (json-write data
8450: 29 29 0a 09 20 28 28 73 74 72 69 6e 67 3d 3f 20 )).. ((string=?
8460: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8470: 64 75 6d 70 6d 6f 64 65 22 29 20 22 69 6e 69 22 dumpmode") "ini"
8480: 29 0a 09 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f ).. (configf:co
8490: 6e 66 69 67 2d 3e 69 6e 69 20 64 61 74 61 29 29 nfig->ini data))
84a0: 0a 09 20 28 65 6c 73 65 0a 09 20 20 28 64 65 62 .. (else.. (deb
84b0: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
84c0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
84d0: 72 74 2a 20 22 2d 64 75 6d 70 6d 6f 64 65 20 6f rt* "-dumpmode o
84e0: 66 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 f " (args:get-ar
84f0: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
8500: 20 6e 6f 74 20 72 65 63 6f 67 6e 69 73 65 64 22 not recognised"
8510: 29 29 29 0a 09 28 73 65 74 21 20 2a 64 69 64 73 )))..(set! *dids
8520: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 0a 20 omething* #t)).
8530: 20 20 20 20 20 28 70 6f 70 2d 64 69 72 65 63 74 (pop-direct
8540: 6f 72 79 29 29 29 0a 0a 28 69 66 20 28 61 72 67 ory)))..(if (arg
8550: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 s:get-arg "-show
8560: 2d 63 6f 6e 66 69 67 22 29 0a 20 20 20 20 28 6c -config"). (l
8570: 65 74 20 28 28 74 6c 20 20 20 28 6c 61 75 6e 63 et ((tl (launc
8580: 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 64 61 h:setup)).. (da
8590: 74 61 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 29 ta *configdat*))
85a0: 20 3b 3b 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 ;; (read-config
85b0: 20 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 "megatest.confi
85c0: 67 22 20 23 66 20 23 74 29 29 29 0a 20 20 20 20 g" #f #t))).
85d0: 20 20 28 70 75 73 68 2d 64 69 72 65 63 74 6f 72 (push-director
85e0: 79 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 y *toppath*).
85f0: 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 ;; keep this
8600: 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 20 one local.
8610: 28 63 6f 6e 64 20 0a 20 20 20 20 20 20 20 28 28 (cond . ((
8620: 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 and (args:get-ar
8630: 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 0a 09 20 g "-section")..
8640: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
8650: 67 20 22 2d 76 61 72 22 29 29 0a 09 28 6c 65 74 g "-var"))..(let
8660: 20 28 28 76 61 6c 20 28 63 6f 6e 66 69 67 66 3a ((val (configf:
8670: 6c 6f 6f 6b 75 70 20 64 61 74 61 20 28 61 72 67 lookup data (arg
8680: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 63 74 s:get-arg "-sect
8690: 69 6f 6e 22 29 28 61 72 67 73 3a 67 65 74 2d 61 ion")(args:get-a
86a0: 72 67 20 22 2d 76 61 72 22 29 29 29 29 0a 09 20 rg "-var"))))..
86b0: 20 28 69 66 20 76 61 6c 20 28 70 72 69 6e 74 20 (if val (print
86c0: 76 61 6c 29 29 29 29 0a 0a 20 20 20 20 20 20 20 val))))..
86d0: 3b 3b 20 70 72 69 6e 74 20 6a 75 73 74 20 61 20 ;; print just a
86e0: 73 65 63 74 69 6f 6e 20 69 66 20 6f 6e 6c 79 20 section if only
86f0: 2d 73 65 63 74 69 6f 6e 0a 0a 20 20 20 20 20 20 -section..
8700: 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 ((not (args:get
8710: 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 -arg "-dumpmode"
8720: 29 29 0a 09 28 70 70 20 28 68 61 73 68 2d 74 61 ))..(pp (hash-ta
8730: 62 6c 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 29 ble->alist data)
8740: 29 29 0a 20 20 20 20 20 20 20 28 28 73 74 72 69 )). ((stri
8750: 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 ng=? (args:get-a
8760: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 rg "-dumpmode")
8770: 22 6a 73 6f 6e 22 29 0a 09 28 6a 73 6f 6e 2d 77 "json")..(json-w
8780: 72 69 74 65 20 64 61 74 61 29 29 0a 20 20 20 20 rite data)).
8790: 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 ((string=? (a
87a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
87b0: 6d 70 6d 6f 64 65 22 29 20 22 69 6e 69 22 29 0a mpmode") "ini").
87c0: 09 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 69 67 .(configf:config
87d0: 2d 3e 69 6e 69 20 64 61 74 61 29 29 0a 20 20 20 ->ini data)).
87e0: 20 20 20 20 28 65 6c 73 65 0a 09 28 64 65 62 75 (else..(debu
87f0: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
8800: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
8810: 74 2a 20 22 2d 64 75 6d 70 6d 6f 64 65 20 6f 66 t* "-dumpmode of
8820: 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 " (args:get-arg
8830: 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 "-dumpmode") "
8840: 6e 6f 74 20 72 65 63 6f 67 6e 69 73 65 64 22 29 not recognised")
8850: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
8860: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
8870: 29 0a 20 20 20 20 20 20 28 70 6f 70 2d 64 69 72 ). (pop-dir
8880: 65 63 74 6f 72 79 29 29 29 0a 0a 28 69 66 20 28 ectory)))..(if (
8890: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
88a0: 68 6f 77 2d 63 6d 64 69 6e 66 6f 22 29 0a 20 20 how-cmdinfo").
88b0: 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a (if (or (args:
88c0: 67 65 74 2d 61 72 67 20 22 3a 76 61 6c 75 65 22 get-arg ":value"
88d0: 29 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 )(getenv "MT_CMD
88e0: 49 4e 46 4f 22 29 29 0a 09 28 6c 65 74 20 28 28 INFO"))..(let ((
88f0: 64 61 74 61 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 data (common:rea
8900: 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 d-encoded-string
8910: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
8920: 72 67 20 22 3a 76 61 6c 75 65 22 29 28 67 65 74 rg ":value")(get
8930: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
8940: 29 29 29 29 29 0a 09 20 20 28 69 66 20 28 65 71 ))))).. (if (eq
8950: 75 61 6c 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 ual? (args:get-a
8960: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 rg "-dumpmode")
8970: 22 6a 73 6f 6e 22 29 0a 09 20 20 20 20 20 20 28 "json").. (
8980: 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 29 json-write data)
8990: 0a 09 20 20 20 20 20 20 28 70 70 20 64 61 74 61 .. (pp data
89a0: 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 )).. (set! *did
89b0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 0a something* #t)).
89c0: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e .(debug:print-in
89d0: 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 0 *default-lo
89e0: 67 2d 70 6f 72 74 2a 20 22 65 6e 76 69 72 6f 6e g-port* "environ
89f0: 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 20 4d 54 ment variable MT
8a00: 5f 43 4d 44 49 4e 46 4f 20 69 73 20 6e 6f 74 20 _CMDINFO is not
8a10: 73 65 74 22 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d set")))..;;=====
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 3d 3d 3d 3d 3d 3d ================
8a60: 3d 0a 3b 3b 20 52 65 6d 6f 76 65 20 6f 6c 64 20 =.;; Remove old
8a70: 72 75 6e 28 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d run(s).;;=======
8a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
8ac0: 0a 3b 3b 20 73 69 6e 63 65 20 73 65 76 65 72 61 .;; since severa
8ad0: 6c 20 61 63 74 69 6f 6e 73 20 63 61 6e 20 62 65 l actions can be
8ae0: 20 73 70 65 63 69 66 69 65 64 20 6f 6e 20 74 68 specified on th
8af0: 65 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 74 e command line t
8b00: 68 65 20 72 65 6d 6f 76 61 6c 0a 3b 3b 20 69 73 he removal.;; is
8b10: 20 64 6f 6e 65 20 66 69 72 73 74 0a 28 64 65 66 done first.(def
8b20: 69 6e 65 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 ine (operate-on
8b30: 61 63 74 69 6f 6e 29 0a 20 20 28 6c 65 74 2a 20 action). (let*
8b40: 28 28 72 75 6e 72 65 63 20 28 72 75 6e 73 3a 72 ((runrec (runs:r
8b50: 75 6e 72 65 63 2d 6d 61 6b 65 2d 72 65 63 6f 72 unrec-make-recor
8b60: 64 29 29 0a 09 20 28 74 61 72 67 65 74 20 28 63 d)).. (target (c
8b70: 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 ommon:args-get-t
8b80: 61 72 67 65 74 29 29 29 0a 20 20 20 20 28 63 6f arget))). (co
8b90: 6e 64 0a 20 20 20 20 20 28 28 6e 6f 74 20 74 61 nd. ((not ta
8ba0: 72 67 65 74 29 0a 20 20 20 20 20 20 28 64 65 62 rget). (deb
8bb0: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
8bc0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
8bd0: 72 74 2a 20 22 4d 69 73 73 69 6e 67 20 72 65 71 rt* "Missing req
8be0: 75 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 uired parameter
8bf0: 66 6f 72 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 for " action ",
8c00: 79 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 you must specify
8c10: 20 2d 74 61 72 67 65 74 20 6f 72 20 2d 72 65 71 -target or -req
8c20: 74 61 72 67 22 29 0a 20 20 20 20 20 20 28 65 78 targ"). (ex
8c30: 69 74 20 31 29 29 0a 20 20 20 20 20 28 28 6e 6f it 1)). ((no
8c40: 74 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d t (or (args:get-
8c50: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 0a arg ":runname").
8c60: 09 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 . (args:ge
8c70: 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
8c80: 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 ))). (debug
8c90: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
8ca0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
8cb0: 2a 20 22 4d 69 73 73 69 6e 67 20 72 65 71 75 69 * "Missing requi
8cc0: 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 6f red parameter fo
8cd0: 72 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f r " action ", yo
8ce0: 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 74 u must specify t
8cf0: 68 65 20 72 75 6e 20 6e 61 6d 65 20 70 61 74 74 he run name patt
8d00: 65 72 6e 20 77 69 74 68 20 2d 72 75 6e 6e 61 6d ern with -runnam
8d10: 65 20 70 61 74 74 22 29 0a 20 20 20 20 20 20 28 e patt"). (
8d20: 65 78 69 74 20 32 29 29 0a 20 20 20 20 20 28 28 exit 2)). ((
8d30: 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 not (args:get-ar
8d40: 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 29 0a g "-testpatt")).
8d50: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
8d60: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
8d70: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d ult-log-port* "M
8d80: 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 issing required
8d90: 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 parameter for "
8da0: 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 action ", you mu
8db0: 73 74 20 73 70 65 63 69 66 79 20 74 68 65 20 74 st specify the t
8dc0: 65 73 74 20 70 61 74 74 65 72 6e 20 77 69 74 68 est pattern with
8dd0: 20 2d 74 65 73 74 70 61 74 74 22 29 0a 20 20 20 -testpatt").
8de0: 20 20 20 28 65 78 69 74 20 33 29 29 0a 20 20 20 (exit 3)).
8df0: 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 28 69 (else. (i
8e00: 66 20 28 6e 6f 74 20 28 63 61 72 20 2a 63 6f 6e f (not (car *con
8e10: 66 69 67 69 6e 66 6f 2a 29 29 0a 09 20 20 28 62 figinfo*)).. (b
8e20: 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 egin.. (debug
8e30: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
8e40: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
8e50: 2a 20 22 41 74 74 65 6d 70 74 65 64 20 22 20 61 * "Attempted " a
8e60: 63 74 69 6f 6e 20 22 6f 6e 20 74 65 73 74 28 73 ction "on test(s
8e70: 29 20 62 75 74 20 72 75 6e 20 61 72 65 61 20 63 ) but run area c
8e80: 6f 6e 66 69 67 20 66 69 6c 65 20 6e 6f 74 20 66 onfig file not f
8e90: 6f 75 6e 64 22 29 0a 09 20 20 20 20 28 65 78 69 ound").. (exi
8ea0: 74 20 31 29 29 0a 09 20 20 3b 3b 20 70 75 74 20 t 1)).. ;; put
8eb0: 74 65 73 74 20 70 61 72 61 6d 65 74 65 72 73 20 test parameters
8ec0: 69 6e 74 6f 20 63 6f 6e 76 65 6e 69 65 6e 74 20 into convenient
8ed0: 76 61 72 69 61 62 6c 65 73 0a 09 20 20 28 62 65 variables.. (be
8ee0: 67 69 6e 0a 09 20 20 20 20 3b 3b 20 63 68 65 63 gin.. ;; chec
8ef0: 6b 20 66 6f 72 20 63 6f 72 72 65 63 74 20 76 65 k for correct ve
8f00: 72 73 69 6f 6e 2c 20 65 78 69 74 20 77 69 74 68 rsion, exit with
8f10: 20 6d 65 73 73 61 67 65 20 69 66 20 6e 6f 74 20 message if not
8f20: 63 6f 72 72 65 63 74 0a 09 20 20 20 20 28 63 6f correct.. (co
8f30: 6d 6d 6f 6e 3a 65 78 69 74 2d 6f 6e 2d 76 65 72 mmon:exit-on-ver
8f40: 73 69 6f 6e 2d 63 68 61 6e 67 65 64 29 0a 09 20 sion-changed)..
8f50: 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 (runs:operate
8f60: 2d 6f 6e 20 20 61 63 74 69 6f 6e 0a 09 09 09 20 -on action....
8f70: 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 20 target....
8f80: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 (common:arg
8f90: 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 s-get-runname)
8fa0: 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 ;; (or (args:get
8fb0: 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 -arg "-runname")
8fc0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
8fd0: 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 runname"))....
8fe0: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 (common:args
8ff0: 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 -get-testpatt #f
9000: 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 ) ;; (args:get-a
9010: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a rg "-testpatt").
9020: 09 09 09 20 20 20 20 20 20 73 74 61 74 65 3a 20 ... state:
9030: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
9040: 2d 73 74 61 74 65 29 0a 09 09 09 20 20 20 20 20 -state)....
9050: 20 73 74 61 74 75 73 3a 20 28 63 6f 6d 6d 6f 6e status: (common
9060: 3a 61 72 67 73 2d 67 65 74 2d 73 74 61 74 75 73 :args-get-status
9070: 29 0a 09 09 09 20 20 20 20 20 20 6e 65 77 2d 73 ).... new-s
9080: 74 61 74 65 2d 73 74 61 74 75 73 3a 20 28 61 72 tate-status: (ar
9090: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
90a0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 29 29 -state-status"))
90b0: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
90c0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
90d0: 29 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 )))))..(if (args
90e0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 :get-arg "-remov
90f0: 65 2d 72 75 6e 73 22 29 0a 20 20 20 20 28 67 65 e-runs"). (ge
9100: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
9110: 20 20 20 20 20 22 2d 72 65 6d 6f 76 65 2d 72 75 "-remove-ru
9120: 6e 73 22 0a 20 20 20 20 20 22 72 65 6d 6f 76 65 ns". "remove
9130: 20 72 75 6e 73 22 0a 20 20 20 20 20 28 6c 61 6d runs". (lam
9140: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
9150: 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 ame keys keyvals
9160: 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 ). (operat
9170: 65 2d 6f 6e 20 27 72 65 6d 6f 76 65 2d 72 75 6e e-on 'remove-run
9180: 73 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 s))))..(if (args
9190: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 :get-arg "-set-s
91a0: 74 61 74 65 2d 73 74 61 74 75 73 22 29 0a 20 20 tate-status").
91b0: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
91c0: 61 6c 6c 20 0a 20 20 20 20 20 22 2d 73 65 74 2d all . "-set-
91d0: 73 74 61 74 65 2d 73 74 61 74 75 73 22 0a 20 20 state-status".
91e0: 20 20 20 22 73 65 74 20 73 74 61 74 65 20 61 6e "set state an
91f0: 64 20 73 74 61 74 75 73 22 0a 20 20 20 20 20 28 d status". (
9200: 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 lambda (target r
9210: 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 unname keys keyv
9220: 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6f 70 65 als). (ope
9230: 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 rate-on 'set-sta
9240: 74 65 2d 73 74 61 74 75 73 29 29 29 29 0a 0a 28 te-status))))..(
9250: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
9260: 2d 61 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 -arg "-set-run-s
9270: 74 61 74 75 73 22 29 0a 09 28 61 72 67 73 3a 67 tatus")..(args:g
9280: 65 74 2d 61 72 67 20 22 2d 67 65 74 2d 72 75 6e et-arg "-get-run
9290: 2d 73 74 61 74 75 73 22 29 29 0a 20 20 20 20 28 -status")). (
92a0: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
92b0: 0a 20 20 20 20 20 22 2d 73 65 74 2d 72 75 6e 2d . "-set-run-
92c0: 73 74 61 74 75 73 22 0a 20 20 20 20 20 22 73 65 status". "se
92d0: 74 20 72 75 6e 20 73 74 61 74 75 73 22 0a 20 20 t run status".
92e0: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
92f0: 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
9300: 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 keyvals).
9310: 28 6c 65 74 2a 20 28 28 72 75 6e 73 64 61 74 20 (let* ((runsdat
9320: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 (rmt:get-runs-b
9330: 79 2d 70 61 74 74 20 6b 65 79 73 20 72 75 6e 6e y-patt keys runn
9340: 61 6d 65 20 0a 09 09 09 09 09 28 63 6f 6d 6d 6f ame ......(commo
9350: 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 n:args-get-targe
9360: 74 29 0a 09 09 09 09 09 23 66 20 23 66 20 23 66 t)......#f #f #f
9370: 20 23 66 29 29 0a 09 20 20 20 20 20 20 28 68 65 #f)).. (he
9380: 61 64 65 72 20 20 20 28 76 65 63 74 6f 72 2d 72 ader (vector-r
9390: 65 66 20 72 75 6e 73 64 61 74 20 30 29 29 0a 09 ef runsdat 0))..
93a0: 20 20 20 20 20 20 28 72 6f 77 73 20 20 20 20 20 (rows
93b0: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 (vector-ref runs
93c0: 64 61 74 20 31 29 29 29 0a 09 20 28 69 66 20 28 dat 1))).. (if (
93d0: 6e 75 6c 6c 3f 20 72 6f 77 73 29 0a 09 20 20 20 null? rows)..
93e0: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
93f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
9400: 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 0 *default-lo
9410: 67 2d 70 6f 72 74 2a 20 22 4e 6f 20 6d 61 74 63 g-port* "No matc
9420: 68 69 6e 67 20 72 75 6e 20 66 6f 75 6e 64 2e 22 hing run found."
9430: 29 0a 09 20 20 20 20 20 20 20 28 65 78 69 74 20 ).. (exit
9440: 31 29 29 0a 09 20 20 20 20 20 28 6c 65 74 2a 20 1)).. (let*
9450: 28 28 72 6f 77 20 20 20 20 20 20 28 63 61 72 20 ((row (car
9460: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 (vector-ref runs
9470: 64 61 74 20 31 29 29 29 0a 09 09 20 20 20 20 28 dat 1)))... (
9480: 72 75 6e 2d 69 64 20 20 20 28 64 62 3a 67 65 74 run-id (db:get
9490: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
94a0: 20 72 6f 77 20 68 65 61 64 65 72 20 22 69 64 22 row header "id"
94b0: 29 29 29 0a 09 20 20 20 20 20 20 20 28 69 66 20 ))).. (if
94c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
94d0: 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 29 set-run-status")
94e0: 0a 09 09 20 20 20 28 72 6d 74 3a 73 65 74 2d 72 ... (rmt:set-r
94f0: 75 6e 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 un-status run-id
9500: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9510: 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 -set-run-status"
9520: 29 20 6d 73 67 3a 20 28 61 72 67 73 3a 67 65 74 ) msg: (args:get
9530: 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 20 20 -arg "-m"))...
9540: 20 28 70 72 69 6e 74 20 28 72 6d 74 3a 67 65 74 (print (rmt:get
9550: 2d 72 75 6e 2d 73 74 61 74 75 73 20 72 75 6e 2d -run-status run-
9560: 69 64 29 29 0a 09 09 20 20 20 29 29 29 29 29 29 id))... ))))))
9570: 29 0a 0a 3b 3b 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 3d 3d 3d ================
95b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 ===========.;; Q
95c0: 75 65 72 79 20 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d uery runs.;;====
95d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
95e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
95f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9610: 3d 3d 0a 0a 3b 3b 20 2d 66 69 65 6c 64 73 20 72 ==..;; -fields r
9620: 75 6e 73 3a 69 64 2c 74 61 72 67 65 74 2c 72 75 uns:id,target,ru
9630: 6e 6e 61 6d 65 2c 63 6f 6d 6d 65 6e 74 2b 74 65 nname,comment+te
9640: 73 74 73 3a 69 64 2c 74 65 73 74 6e 61 6d 65 2c sts:id,testname,
9650: 69 74 65 6d 5f 70 61 74 68 2b 73 74 65 70 73 0a item_path+steps.
9660: 3b 3b 0a 3b 3b 20 63 73 69 3e 20 28 65 78 74 72 ;;.;; csi> (extr
9670: 61 63 74 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 74 act-fields-const
9680: 72 61 69 6e 74 73 20 22 72 75 6e 73 3a 69 64 2c raints "runs:id,
9690: 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 2c 63 target,runname,c
96a0: 6f 6d 6d 65 6e 74 2b 74 65 73 74 73 3a 69 64 2c omment+tests:id,
96b0: 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 61 testname,item_pa
96c0: 74 68 2b 73 74 65 70 73 22 29 0a 3b 3b 20 20 20 th+steps").;;
96d0: 20 20 20 20 20 20 3d 3e 20 28 28 22 72 75 6e 73 => (("runs
96e0: 22 20 22 69 64 22 20 22 74 61 72 67 65 74 22 20 " "id" "target"
96f0: 22 72 75 6e 6e 61 6d 65 22 20 22 63 6f 6d 6d 65 "runname" "comme
9700: 6e 74 22 29 20 28 22 74 65 73 74 73 22 20 22 69 nt") ("tests" "i
9710: 64 22 20 22 74 65 73 74 6e 61 6d 65 22 20 22 69 d" "testname" "i
9720: 74 65 6d 5f 70 61 74 68 22 29 20 28 22 73 74 65 tem_path") ("ste
9730: 70 73 22 29 29 0a 3b 3b 0a 3b 3b 20 20 20 4e 4f ps")).;;.;; NO
9740: 54 45 3a 20 72 65 6d 65 6d 62 65 72 20 74 68 61 TE: remember tha
9750: 74 20 74 68 65 20 63 64 72 20 77 69 6c 6c 20 62 t the cdr will b
9760: 65 20 74 68 65 20 6c 69 73 74 20 79 6f 75 20 65 e the list you e
9770: 78 70 65 63 74 20 28 63 64 72 20 28 22 72 75 6e xpect (cdr ("run
9780: 73 22 20 22 69 64 22 20 22 74 61 72 67 65 74 22 s" "id" "target"
9790: 20 22 72 75 6e 6e 61 6d 65 22 20 22 63 6f 6d 6d "runname" "comm
97a0: 65 6e 74 22 29 29 20 3d 3e 20 28 22 69 64 22 20 ent")) => ("id"
97b0: 22 74 61 72 67 65 74 22 20 22 72 75 6e 6e 61 6d "target" "runnam
97c0: 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 0a 3b 3b e" "comment").;;
97d0: 20 20 20 20 20 20 20 20 20 61 6e 64 20 73 6f 20 and so
97e0: 61 6c 69 73 74 2d 72 65 66 20 77 69 6c 6c 20 79 alist-ref will y
97f0: 69 65 6c 64 20 77 68 61 74 20 79 6f 75 20 65 78 ield what you ex
9800: 70 65 63 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 pect.;;.(define
9810: 28 65 78 74 72 61 63 74 2d 66 69 65 6c 64 73 2d (extract-fields-
9820: 63 6f 6e 73 74 72 61 69 6e 74 73 20 66 69 65 6c constraints fiel
9830: 64 73 2d 73 70 65 63 29 0a 20 20 28 6d 61 70 20 ds-spec). (map
9840: 28 6c 61 6d 62 64 61 20 28 74 61 62 6c 65 2d 73 (lambda (table-s
9850: 70 65 63 29 20 3b 3b 20 72 75 6e 73 3a 69 64 2c pec) ;; runs:id,
9860: 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 0a 09 target,runname..
9870: 20 28 6c 65 74 20 28 28 64 61 74 20 28 73 74 72 (let ((dat (str
9880: 69 6e 67 2d 73 70 6c 69 74 20 74 61 62 6c 65 2d ing-split table-
9890: 73 70 65 63 20 22 3a 22 29 29 29 20 3b 3b 20 28 spec ":"))) ;; (
98a0: 22 72 75 6e 73 22 20 22 69 64 2c 74 61 72 67 65 "runs" "id,targe
98b0: 74 2c 72 75 6e 6e 61 6d 65 22 29 0a 09 20 20 20 t,runname")..
98c0: 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 64 (if (> (length d
98d0: 61 74 29 20 31 29 0a 09 20 20 20 20 20 20 20 28 at) 1).. (
98e0: 63 6f 6e 73 20 28 63 61 72 20 64 61 74 29 28 73 cons (car dat)(s
98f0: 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 63 61 64 tring-split (cad
9900: 72 20 64 61 74 29 20 22 2c 22 29 29 20 3b 3b 20 r dat) ",")) ;;
9910: 22 69 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 "id,target,runna
9920: 6d 65 22 0a 09 20 20 20 20 20 20 20 64 61 74 29 me".. dat)
9930: 29 29 0a 20 20 20 20 20 20 20 28 73 74 72 69 6e )). (strin
9940: 67 2d 73 70 6c 69 74 20 66 69 65 6c 64 73 2d 73 g-split fields-s
9950: 70 65 63 20 22 2b 22 29 29 29 0a 0a 28 64 65 66 pec "+")))..(def
9960: 69 6e 65 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 ine (get-value-b
9970: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 64 61 74 61 y-fieldname data
9980: 76 65 63 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 vec test-field-i
9990: 6e 64 65 78 20 66 69 65 6c 64 6e 61 6d 65 29 0a ndex fieldname).
99a0: 20 20 28 6c 65 74 20 28 28 69 6e 64 78 20 28 68 (let ((indx (h
99b0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
99c0: 66 61 75 6c 74 20 74 65 73 74 2d 66 69 65 6c 64 fault test-field
99d0: 2d 69 6e 64 65 78 20 66 69 65 6c 64 6e 61 6d 65 -index fieldname
99e0: 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 69 #f))). (if i
99f0: 6e 64 78 0a 09 28 69 66 20 28 3e 3d 20 69 6e 64 ndx..(if (>= ind
9a00: 78 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 x (vector-length
9a10: 20 64 61 74 61 76 65 63 29 29 0a 09 20 20 20 20 datavec))..
9a20: 23 66 20 3b 3b 20 69 6e 64 65 78 20 74 6f 6f 20 #f ;; index too
9a30: 68 69 67 68 2c 20 73 68 6f 75 6c 64 20 72 61 69 high, should rai
9a40: 73 65 20 61 6e 20 65 72 72 6f 72 20 49 20 73 75 se an error I su
9a50: 70 70 6f 73 65 0a 09 20 20 20 20 28 76 65 63 74 ppose.. (vect
9a60: 6f 72 2d 72 65 66 20 64 61 74 61 76 65 63 20 69 or-ref datavec i
9a70: 6e 64 78 29 29 0a 09 23 66 29 29 29 0a 0a 3b 3b ndx))..#f)))..;;
9a80: 20 4e 4f 54 45 3a 20 6c 69 73 74 2d 72 75 6e 73 NOTE: list-runs
9a90: 20 61 6e 64 20 6c 69 73 74 2d 64 62 2d 74 61 72 and list-db-tar
9aa0: 67 65 74 73 20 6f 70 65 72 61 74 65 20 6f 6e 20 gets operate on
9ab0: 6c 6f 63 61 6c 20 64 62 21 21 21 0a 3b 3b 0a 3b local db!!!.;;.;
9ac0: 3b 20 49 44 45 41 3a 20 6d 65 67 61 74 65 73 74 ; IDEA: megatest
9ad0: 20 6c 69 73 74 20 2d 72 75 6e 6e 61 6d 65 20 62 list -runname b
9ae0: 6c 61 68 25 20 2e 2e 2e 0a 3b 3b 0a 28 69 66 20 lah% ....;;.(if
9af0: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
9b00: 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 0a g "-list-runs").
9b10: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
9b20: 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 -list-db-targets
9b30: 22 29 29 0a 20 20 20 20 28 69 66 20 28 6c 61 75 ")). (if (lau
9b40: 6e 63 68 3a 73 65 74 75 70 29 0a 09 28 6c 65 74 nch:setup)..(let
9b50: 2a 20 28 3b 3b 20 28 64 62 73 74 72 75 63 74 20 * (;; (dbstruct
9b60: 20 20 20 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 (make-dbr:dbs
9b70: 74 72 75 63 74 20 70 61 74 68 3a 20 2a 74 6f 70 truct path: *top
9b80: 70 61 74 68 2a 20 6c 6f 63 61 6c 3a 20 28 61 72 path* local: (ar
9b90: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 gs:get-arg "-loc
9ba0: 61 6c 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 al"))).. (
9bb0: 72 75 6e 70 61 74 74 20 20 20 20 20 28 61 72 67 runpatt (arg
9bc0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
9bd0: 2d 72 75 6e 73 22 29 29 0a 20 20 20 20 20 20 20 -runs")).
9be0: 20 20 20 20 20 20 20 20 28 61 63 63 65 73 73 2d (access-
9bf0: 6d 6f 64 65 20 28 64 62 3a 67 65 74 2d 61 63 63 mode (db:get-acc
9c00: 65 73 73 2d 6d 6f 64 65 29 29 0a 09 20 20 20 20 ess-mode))..
9c10: 20 20 20 28 74 65 73 74 70 61 74 74 20 20 20 20 (testpatt
9c20: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
9c30: 2d 74 65 73 74 70 61 74 74 20 23 66 29 29 0a 09 -testpatt #f))..
9c40: 20 20 20 20 20 20 20 3b 3b 20 28 69 66 20 28 61 ;; (if (a
9c50: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
9c60: 73 74 70 61 74 74 22 29 20 0a 09 20 20 20 20 20 stpatt") ..
9c70: 20 20 3b 3b 20 20 09 20 20 20 20 20 20 20 20 28 ;; . (
9c80: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
9c90: 65 73 74 70 61 74 74 22 29 20 0a 09 20 20 20 20 estpatt") ..
9ca0: 20 20 20 3b 3b 20 20 09 20 20 20 20 20 20 20 20 ;; .
9cb0: 22 25 22 29 29 0a 09 20 20 20 20 20 20 20 28 6b "%")).. (k
9cc0: 65 79 73 20 20 20 20 20 20 20 20 28 72 6d 74 3a eys (rmt:
9cd0: 67 65 74 2d 6b 65 79 73 29 29 20 3b 3b 20 28 64 get-keys)) ;; (d
9ce0: 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 73 74 72 b:get-keys dbstr
9cf0: 75 63 74 29 29 0a 09 20 20 20 20 20 20 20 3b 3b uct)).. ;;
9d00: 20 28 72 75 6e 73 64 61 74 20 20 28 64 62 3a 67 (runsdat (db:g
9d10: 65 74 2d 72 75 6e 73 20 64 62 73 74 72 75 63 74 et-runs dbstruct
9d20: 20 72 75 6e 70 61 74 74 20 23 66 20 23 66 20 27 runpatt #f #f '
9d30: 28 29 29 29 0a 09 3b 3b 20 28 72 75 6e 73 64 61 ()))..;; (runsda
9d40: 74 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 72 t (rmt:get-r
9d50: 75 6e 73 2d 62 79 2d 70 61 74 74 20 6b 65 79 73 uns-by-patt keys
9d60: 20 28 6f 72 20 72 75 6e 70 61 74 74 20 22 25 22 (or runpatt "%"
9d70: 29 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 ) (common:args-g
9d80: 65 74 2d 74 61 72 67 65 74 29 20 3b 3b 20 28 64 et-target) ;; (d
9d90: 62 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 b:get-runs-by-pa
9da0: 74 74 20 64 62 73 74 72 75 63 74 20 6b 65 79 73 tt dbstruct keys
9db0: 20 28 6f 72 20 72 75 6e 70 61 74 74 20 22 25 22 (or runpatt "%"
9dc0: 29 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 ) (common:args-g
9dd0: 65 74 2d 74 61 72 67 65 74 29 0a 09 3b 3b 20 09 et-target)..;; .
9de0: 09 20 20 20 20 20 20 20 20 20 20 20 09 20 23 66 . . #f
9df0: 20 23 66 20 27 28 22 69 64 22 20 22 72 75 6e 6e #f '("id" "runn
9e00: 61 6d 65 22 20 22 73 74 61 74 65 22 20 22 73 74 ame" "state" "st
9e10: 61 74 75 73 22 20 22 6f 77 6e 65 72 22 20 22 65 atus" "owner" "e
9e20: 76 65 6e 74 5f 74 69 6d 65 22 20 22 63 6f 6d 6d vent_time" "comm
9e30: 65 6e 74 22 29 20 30 29 29 0a 09 20 20 20 20 20 ent") 0))..
9e40: 20 20 28 72 75 6e 73 64 61 74 20 20 20 20 20 28 (runsdat (
9e50: 64 62 3a 64 69 73 70 61 74 63 68 2d 71 75 65 72 db:dispatch-quer
9e60: 79 20 61 63 63 65 73 73 2d 6d 6f 64 65 20 72 6d y access-mode rm
9e70: 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 t:get-runs-by-pa
9e80: 74 74 20 64 62 3a 67 65 74 2d 72 75 6e 73 2d 62 tt db:get-runs-b
9e90: 79 2d 70 61 74 74 20 6b 65 79 73 20 28 6f 72 20 y-patt keys (or
9ea0: 72 75 6e 70 61 74 74 20 22 25 22 29 20 0a 20 20 runpatt "%") .
9eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9ed0: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f (commo
9ee0: 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 n:args-get-targe
9ef0: 74 29 20 23 66 20 23 66 20 27 28 22 69 64 22 20 t) #f #f '("id"
9f00: 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 "runname" "state
9f10: 22 20 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 " "status" "owne
9f20: 72 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 r" "event_time"
9f30: 22 63 6f 6d 6d 65 6e 74 22 29 20 30 29 29 0a 09 "comment") 0))..
9f40: 20 20 20 20 20 20 20 28 72 75 6e 73 74 6d 70 20 (runstmp
9f50: 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 (db:get-rows
9f60: 20 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 20 runsdat))..
9f70: 20 20 20 28 68 65 61 64 65 72 20 20 20 20 20 20 (header
9f80: 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 (db:get-header r
9f90: 75 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 20 unsdat))..
9fa0: 20 3b 3b 20 74 68 69 73 20 69 73 20 22 2d 73 69 ;; this is "-si
9fb0: 6e 63 65 22 20 73 75 70 70 6f 72 74 2e 20 54 68 nce" support. Th
9fc0: 69 73 20 6c 6f 6f 6b 73 20 61 74 20 6c 61 73 74 is looks at last
9fd0: 20 6d 6f 64 20 74 69 6d 65 73 20 6f 66 20 3c 72 mod times of <r
9fe0: 75 6e 2d 69 64 3e 2e 64 62 20 66 69 6c 65 73 0a un-id>.db files.
9ff0: 09 20 20 20 20 20 20 20 3b 3b 20 61 6e 64 20 63 . ;; and c
a000: 6f 6c 6c 65 63 74 73 20 74 68 6f 73 65 20 6d 6f ollects those mo
a010: 64 69 66 69 65 64 20 73 69 6e 63 65 20 74 68 65 dified since the
a020: 20 2d 73 69 6e 63 65 20 74 69 6d 65 2e 0a 09 20 -since time...
a030: 20 20 20 20 20 20 28 72 75 6e 73 20 20 20 20 20 (runs
a040: 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 (if (and (not
a050: 20 28 6e 75 6c 6c 3f 20 72 75 6e 73 74 6d 70 29 (null? runstmp)
a060: 29 0a 09 09 09 09 20 20 20 20 20 28 61 72 67 73 )..... (args
a070: 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 :get-arg "-since
a080: 22 29 29 0a 09 09 09 09 28 6c 65 74 20 28 28 63 ")).....(let ((c
a090: 68 61 6e 67 65 64 2d 69 64 73 20 28 64 62 3a 67 hanged-ids (db:g
a0a0: 65 74 2d 63 68 61 6e 67 65 64 2d 72 75 6e 2d 69 et-changed-run-i
a0b0: 64 73 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 ds (string->numb
a0c0: 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 er (args:get-arg
a0d0: 20 22 2d 73 69 6e 63 65 22 29 29 29 29 29 0a 09 "-since")))))..
a0e0: 09 09 09 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 ... (let loop (
a0f0: 28 68 65 64 20 28 63 61 72 20 72 75 6e 73 74 6d (hed (car runstm
a100: 70 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 74 p))...... (t
a110: 61 6c 20 28 63 64 72 20 72 75 6e 73 74 6d 70 29 al (cdr runstmp)
a120: 29 0a 09 09 09 09 09 20 20 20 20 20 28 72 65 73 )...... (res
a130: 20 27 28 29 29 29 0a 09 09 09 09 20 20 20 20 28 '()))..... (
a140: 6c 65 74 20 28 28 6e 65 77 2d 72 65 73 20 28 69 let ((new-res (i
a150: 66 20 28 6d 65 6d 62 65 72 20 28 64 62 3a 67 65 f (member (db:ge
a160: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
a170: 72 20 68 65 64 20 68 65 61 64 65 72 20 22 69 64 r hed header "id
a180: 22 29 20 63 68 61 6e 67 65 64 2d 69 64 73 29 0a ") changed-ids).
a190: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 6f ...... (co
a1a0: 6e 73 20 68 65 64 20 72 65 73 29 0a 09 09 09 09 ns hed res).....
a1b0: 09 09 20 20 20 20 20 20 20 72 65 73 29 29 29 0a .. res))).
a1c0: 09 09 09 09 20 20 20 20 20 20 28 69 66 20 28 6e .... (if (n
a1d0: 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 09 09 09 20 ull? tal)......
a1e0: 20 28 72 65 76 65 72 73 65 20 6e 65 77 2d 72 65 (reverse new-re
a1f0: 73 29 0a 09 09 09 09 09 20 20 28 6c 6f 6f 70 20 s)...... (loop
a200: 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 (car tal)(cdr ta
a210: 6c 29 20 6e 65 77 2d 72 65 73 29 29 29 29 29 0a l) new-res))))).
a220: 09 09 09 09 72 75 6e 73 74 6d 70 29 29 0a 09 20 ....runstmp))..
a230: 20 20 20 20 20 20 28 64 62 2d 74 61 72 67 65 74 (db-target
a240: 73 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 s (args:get-arg
a250: 20 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 "-list-db-targe
a260: 74 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 ts")).. (s
a270: 65 65 6e 20 20 20 20 20 20 20 20 28 6d 61 6b 65 een (make
a280: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 -hash-table))..
a290: 20 20 20 20 20 20 28 64 6d 6f 64 65 20 20 20 20 (dmode
a2a0: 20 20 20 28 6c 65 74 20 28 28 64 20 28 61 72 67 (let ((d (arg
a2b0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
a2c0: 6d 6f 64 65 22 29 29 29 0a 09 09 09 20 20 20 20 mode")))....
a2d0: 20 20 28 69 66 20 64 20 28 73 74 72 69 6e 67 2d (if d (string-
a2e0: 3e 73 79 6d 62 6f 6c 20 64 29 20 23 66 29 29 29 >symbol d) #f)))
a2f0: 0a 09 20 20 20 20 20 20 20 28 64 61 74 61 20 20 .. (data
a300: 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 (make-hash
a310: 2d 74 61 62 6c 65 29 29 0a 09 20 20 20 20 20 20 -table))..
a320: 20 28 66 69 65 6c 64 73 2d 73 70 65 63 20 28 69 (fields-spec (i
a330: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
a340: 22 2d 66 69 65 6c 64 73 22 29 0a 09 09 09 09 28 "-fields").....(
a350: 65 78 74 72 61 63 74 2d 66 69 65 6c 64 73 2d 63 extract-fields-c
a360: 6f 6e 73 74 72 61 69 6e 74 73 20 28 61 72 67 73 onstraints (args
a370: 3a 67 65 74 2d 61 72 67 20 22 2d 66 69 65 6c 64 :get-arg "-field
a380: 73 22 29 29 0a 09 09 09 09 28 6c 69 73 74 20 28 s")).....(list (
a390: 63 6f 6e 73 20 22 72 75 6e 73 22 20 28 61 70 70 cons "runs" (app
a3a0: 65 6e 64 20 6b 65 79 73 20 28 6c 69 73 74 20 22 end keys (list "
a3b0: 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 id" "runname" "s
a3c0: 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 22 tate" "status" "
a3d0: 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 69 owner" "event_ti
a3e0: 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 20 22 66 me" "comment" "f
a3f0: 61 69 6c 5f 63 6f 75 6e 74 22 20 22 70 61 73 73 ail_count" "pass
a400: 5f 63 6f 75 6e 74 22 29 29 29 0a 09 09 09 09 20 _count"))).....
a410: 20 20 20 20 20 28 63 6f 6e 73 20 22 74 65 73 74 (cons "test
a420: 73 22 20 20 64 62 3a 74 65 73 74 2d 72 65 63 6f s" db:test-reco
a430: 72 64 2d 66 69 65 6c 64 73 29 20 3b 3b 20 22 69 rd-fields) ;; "i
a440: 64 22 20 22 74 65 73 74 6e 61 6d 65 22 20 22 74 d" "testname" "t
a450: 65 73 74 5f 70 61 74 68 22 29 0a 09 09 09 09 20 est_path").....
a460: 20 20 20 20 20 28 6c 69 73 74 20 22 73 74 65 70 (list "step
a470: 73 22 20 22 69 64 22 20 22 73 74 65 70 6e 61 6d s" "id" "stepnam
a480: 65 22 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 e")))).. (
a490: 72 75 6e 73 2d 73 70 65 63 20 20 20 28 6c 65 74 runs-spec (let
a4a0: 20 28 28 72 20 28 61 6c 69 73 74 2d 72 65 66 20 ((r (alist-ref
a4b0: 22 72 75 6e 73 22 20 20 66 69 65 6c 64 73 2d 73 "runs" fields-s
a4c0: 70 65 63 20 65 71 75 61 6c 3f 29 29 29 20 3b 3b pec equal?))) ;;
a4d0: 20 74 68 65 20 63 68 65 63 6b 20 69 73 20 6e 6f the check is no
a4e0: 77 20 75 6e 6e 65 63 65 73 73 61 72 79 0a 09 09 w unnecessary...
a4f0: 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 . (if (and
a500: 72 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 29 r (not (null? r)
a510: 29 29 20 72 20 28 6c 69 73 74 20 22 69 64 22 20 )) r (list "id"
a520: 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 )))).. (te
a530: 73 74 73 2d 73 70 65 63 20 20 28 6c 65 74 20 28 sts-spec (let (
a540: 28 74 20 28 61 6c 69 73 74 2d 72 65 66 20 22 74 (t (alist-ref "t
a550: 65 73 74 73 22 20 66 69 65 6c 64 73 2d 73 70 65 ests" fields-spe
a560: 63 20 65 71 75 61 6c 3f 29 29 29 0a 09 09 09 20 c equal?)))....
a570: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 20 (if (and t
a580: 28 6e 75 6c 6c 3f 20 74 29 29 20 3b 3b 20 61 6c (null? t)) ;; al
a590: 6c 20 66 69 65 6c 64 73 0a 09 09 09 09 20 20 64 l fields..... d
a5a0: 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 b:test-record-fi
a5b0: 65 6c 64 73 0a 09 09 09 09 20 20 74 29 29 29 0a elds..... t))).
a5c0: 09 20 20 20 20 20 20 20 28 61 64 6a 2d 74 65 73 . (adj-tes
a5d0: 74 73 2d 73 70 65 63 20 28 64 65 6c 65 74 65 2d ts-spec (delete-
a5e0: 64 75 70 6c 69 63 61 74 65 73 20 28 69 66 20 74 duplicates (if t
a5f0: 65 73 74 73 2d 73 70 65 63 20 28 63 6f 6e 73 20 ests-spec (cons
a600: 22 69 64 22 20 74 65 73 74 73 2d 73 70 65 63 29 "id" tests-spec)
a610: 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d db:test-record-
a620: 66 69 65 6c 64 73 29 29 29 20 3b 3b 20 27 28 22 fields))) ;; '("
a630: 69 64 22 29 29 29 29 0a 09 20 20 20 20 20 20 20 id"))))..
a640: 28 73 74 65 70 73 2d 73 70 65 63 20 20 28 61 6c (steps-spec (al
a650: 69 73 74 2d 72 65 66 20 22 73 74 65 70 73 22 20 ist-ref "steps"
a660: 66 69 65 6c 64 73 2d 73 70 65 63 20 65 71 75 61 fields-spec equa
a670: 6c 3f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 l?)).. (te
a680: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 28 st-field-index (
a690: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
a6a0: 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 74 )).. (if (and t
a6b0: 65 73 74 73 2d 73 70 65 63 20 28 6e 6f 74 20 28 ests-spec (not (
a6c0: 6e 75 6c 6c 3f 20 74 65 73 74 73 2d 73 70 65 63 null? tests-spec
a6d0: 29 29 29 20 3b 3b 20 64 6f 20 73 6f 6d 65 20 76 ))) ;; do some v
a6e0: 61 6c 69 64 61 74 69 6f 6e 20 61 6e 64 20 70 72 alidation and pr
a6f0: 6f 63 65 73 73 69 6e 67 20 6f 66 20 74 68 65 20 ocessing of the
a700: 74 65 73 74 2d 73 70 65 63 0a 09 20 20 20 20 20 test-spec..
a710: 20 28 6c 65 74 20 28 28 69 6e 76 61 6c 69 64 2d (let ((invalid-
a720: 74 65 73 74 73 2d 73 70 65 63 20 28 66 69 6c 74 tests-spec (filt
a730: 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e er (lambda (x)(n
a740: 6f 74 20 28 6d 65 6d 62 65 72 20 78 20 64 62 3a ot (member x db:
a750: 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c test-record-fiel
a760: 64 73 29 29 29 20 74 65 73 74 73 2d 73 70 65 63 ds))) tests-spec
a770: 29 29 29 0a 09 09 28 69 66 20 28 6e 75 6c 6c 3f )))...(if (null?
a780: 20 69 6e 76 61 6c 69 64 2d 74 65 73 74 73 2d 73 invalid-tests-s
a790: 70 65 63 29 0a 09 09 20 20 20 20 3b 3b 20 67 65 pec)... ;; ge
a7a0: 6e 65 72 61 74 65 20 74 68 65 20 6c 6f 6f 6b 75 nerate the looku
a7b0: 70 20 6d 61 70 20 74 65 73 74 2d 66 69 65 6c 64 p map test-field
a7c0: 2d 6e 61 6d 65 20 3d 3e 20 69 6e 64 65 78 2d 6e -name => index-n
a7d0: 75 6d 62 65 72 0a 09 09 20 20 20 20 28 6c 65 74 umber... (let
a7e0: 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 loop ((hed (car
a7f0: 20 61 64 6a 2d 74 65 73 74 73 2d 73 70 65 63 29 adj-tests-spec)
a800: 29 0a 09 09 09 20 20 20 20 20 20 20 28 74 61 6c ).... (tal
a810: 20 28 63 64 72 20 61 64 6a 2d 74 65 73 74 73 2d (cdr adj-tests-
a820: 73 70 65 63 29 29 0a 09 09 09 20 20 20 20 20 20 spec))....
a830: 20 28 69 64 78 20 30 29 29 0a 09 09 20 20 20 20 (idx 0))...
a840: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
a850: 74 21 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e t! test-field-in
a860: 64 65 78 20 68 65 64 20 69 64 78 29 0a 09 09 20 dex hed idx)...
a870: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e (if (not (n
a880: 75 6c 6c 3f 20 74 61 6c 29 29 28 6c 6f 6f 70 20 ull? tal))(loop
a890: 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 (car tal)(cdr ta
a8a0: 6c 29 28 2b 20 69 64 78 20 31 29 29 29 29 0a 09 l)(+ idx 1))))..
a8b0: 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 . (begin...
a8c0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
a8d0: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
a8e0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 6e 76 t-log-port* "Inv
a8f0: 61 6c 69 64 20 74 65 73 74 20 66 69 65 6c 64 73 alid test fields
a900: 20 73 70 65 63 69 66 69 65 64 3a 20 22 20 28 73 specified: " (s
a910: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
a920: 65 20 69 6e 76 61 6c 69 64 2d 74 65 73 74 73 2d e invalid-tests-
a930: 73 70 65 63 20 22 2c 20 22 29 29 0a 09 09 20 20 spec ", "))...
a940: 20 20 20 20 28 65 78 69 74 29 29 29 29 29 0a 0a (exit)))))..
a950: 09 20 20 3b 3b 20 45 61 63 68 20 72 75 6e 0a 09 . ;; Each run..
a960: 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 (for-each ..
a970: 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 (lambda (run)..
a980: 20 20 20 20 20 28 6c 65 74 20 28 28 74 61 72 67 (let ((targ
a990: 65 74 73 74 72 20 28 73 74 72 69 6e 67 2d 69 6e etstr (string-in
a9a0: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 tersperse (map (
a9b0: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 lambda (x)......
a9c0: 09 09 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 .. (db:get-value
a9d0: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
a9e0: 65 61 64 65 72 20 78 29 29 0a 09 09 09 09 09 09 eader x)).......
a9f0: 20 20 20 20 20 20 20 6b 65 79 73 29 20 22 2f 22 keys) "/"
aa00: 29 29 29 0a 09 20 20 20 20 20 20 20 28 69 66 20 ))).. (if
aa10: 64 62 2d 74 61 72 67 65 74 73 0a 09 09 20 20 20 db-targets...
aa20: 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 (if (not (hash-t
aa30: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
aa40: 20 73 65 65 6e 20 74 61 72 67 65 74 73 74 72 20 seen targetstr
aa50: 23 66 29 29 0a 09 09 20 20 20 20 20 20 20 28 62 #f))... (b
aa60: 65 67 69 6e 0a 09 09 09 20 28 68 61 73 68 2d 74 egin.... (hash-t
aa70: 61 62 6c 65 2d 73 65 74 21 20 73 65 65 6e 20 74 able-set! seen t
aa80: 61 72 67 65 74 73 74 72 20 23 74 29 0a 09 09 09 argetstr #t)....
aa90: 20 3b 3b 20 28 70 72 69 6e 74 20 22 5b 22 20 74 ;; (print "[" t
aaa0: 61 72 67 65 74 73 74 72 20 22 5d 22 29 29 29 29 argetstr "]"))))
aab0: 0a 09 09 09 20 28 69 66 20 28 6e 6f 74 20 64 6d .... (if (not dm
aac0: 6f 64 65 29 0a 09 09 09 20 20 20 20 20 28 70 72 ode).... (pr
aad0: 69 6e 74 20 74 61 72 67 65 74 73 74 72 29 0a 09 int targetstr)..
aae0: 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 .. (hash-tab
aaf0: 6c 65 2d 73 65 74 21 20 64 61 74 61 20 22 74 61 le-set! data "ta
ab00: 72 67 65 74 73 22 20 28 63 6f 6e 73 20 74 61 72 rgets" (cons tar
ab10: 67 65 74 73 74 72 20 28 68 61 73 68 2d 74 61 62 getstr (hash-tab
ab20: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 64 le-ref/default d
ab30: 61 74 61 20 22 74 61 72 67 65 74 73 22 20 27 28 ata "targets" '(
ab40: 29 29 29 29 0a 09 09 09 20 20 20 20 20 29 29 29 )))).... )))
ab50: 0a 09 09 20 20 20 28 6c 65 74 2a 20 28 28 72 75 ... (let* ((ru
ab60: 6e 2d 69 64 20 20 28 64 62 3a 67 65 74 2d 76 61 n-id (db:get-va
ab70: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
ab80: 6e 20 68 65 61 64 65 72 20 22 69 64 22 29 29 0a n header "id")).
ab90: 09 09 09 20 20 28 72 75 6e 6e 61 6d 65 20 28 64 ... (runname (d
aba0: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
abb0: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
abc0: 20 22 72 75 6e 6e 61 6d 65 22 29 29 20 0a 09 09 "runname")) ...
abd0: 09 20 20 28 73 74 61 74 65 73 20 20 28 73 74 72 . (states (str
abe0: 69 6e 67 2d 73 70 6c 69 74 20 28 6f 72 20 28 61 ing-split (or (a
abf0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
ac00: 61 74 65 22 29 20 22 22 29 20 22 2c 22 29 29 0a ate") "") ",")).
ac10: 09 09 09 20 20 28 73 74 61 74 75 73 65 73 20 28 ... (statuses (
ac20: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 6f 72 string-split (or
ac30: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
ac40: 2d 73 74 61 74 75 73 22 29 20 22 22 29 20 22 2c -status") "") ",
ac50: 22 29 29 0a 09 09 09 20 20 28 74 65 73 74 73 20 ")).... (tests
ac60: 20 20 28 69 66 20 74 65 73 74 73 2d 73 70 65 63 (if tests-spec
ac70: 0a 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a ..... (db:
ac80: 64 69 73 70 61 74 63 68 2d 71 75 65 72 79 20 61 dispatch-query a
ac90: 63 63 65 73 73 2d 6d 6f 64 65 20 72 6d 74 3a 67 ccess-mode rmt:g
aca0: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
acb0: 20 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f db:get-tests-fo
acc0: 72 2d 72 75 6e 20 72 75 6e 2d 69 64 20 74 65 73 r-run run-id tes
acd0: 74 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 tpatt states sta
ace0: 74 75 73 65 73 20 23 66 20 23 66 20 23 66 20 27 tuses #f #f #f '
acf0: 74 65 73 74 6e 61 6d 65 20 27 61 73 63 20 3b 3b testname 'asc ;;
ad00: 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 (db:get-tests-f
ad10: 6f 72 2d 72 75 6e 20 64 62 73 74 72 75 63 74 20 or-run dbstruct
ad20: 72 75 6e 2d 69 64 20 74 65 73 74 70 61 74 74 20 run-id testpatt
ad30: 27 28 29 20 27 28 29 20 23 66 20 23 66 20 23 66 '() '() #f #f #f
ad40: 20 27 74 65 73 74 6e 61 6d 65 20 27 61 73 63 20 'testname 'asc
ad50: 0a 09 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 ........ ;;
ad60: 75 73 65 20 71 72 79 76 61 6c 73 20 69 66 20 74 use qryvals if t
ad70: 65 73 74 2d 73 70 65 63 20 70 72 6f 76 69 64 65 est-spec provide
ad80: 64 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 69 d........ (i
ad90: 66 20 74 65 73 74 73 2d 73 70 65 63 0a 09 09 09 f tests-spec....
ada0: 09 09 09 09 09 20 28 73 74 72 69 6e 67 2d 69 6e ..... (string-in
adb0: 74 65 72 73 70 65 72 73 65 20 61 64 6a 2d 74 65 tersperse adj-te
adc0: 73 74 73 2d 73 70 65 63 20 22 2c 22 29 0a 09 09 sts-spec ",")...
add0: 09 09 09 09 09 09 20 3b 3b 20 64 62 3a 74 65 73 ...... ;; db:tes
ade0: 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 0a t-record-fields.
adf0: 09 09 09 09 09 09 09 09 20 23 66 29 0a 09 09 09 ........ #f)....
ae00: 09 09 09 09 20 20 20 20 20 23 66 0a 09 09 09 09 .... #f.....
ae10: 09 09 09 20 20 20 20 20 27 6e 6f 72 6d 61 6c 29 ... 'normal)
ae20: 0a 09 09 09 09 20 20 20 20 20 20 20 27 28 29 29 ..... '())
ae30: 29 29 0a 09 09 20 20 20 20 20 28 63 61 73 65 20 ))... (case
ae40: 64 6d 6f 64 65 0a 09 09 20 20 20 20 20 20 20 28 dmode... (
ae50: 28 6a 73 6f 6e 20 6f 64 73 29 0a 09 09 09 28 69 (json ods)....(i
ae60: 66 20 72 75 6e 73 2d 73 70 65 63 0a 09 09 09 20 f runs-spec....
ae70: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 (for-each ...
ae80: 09 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 . (lambda (f
ae90: 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 20 20 ield-name)....
aea0: 20 20 20 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 (mutils:hie
aeb0: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
aec0: 28 63 6f 6e 63 20 28 64 62 3a 67 65 74 2d 76 61 (conc (db:get-va
aed0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
aee0: 6e 20 68 65 61 64 65 72 20 66 69 65 6c 64 2d 6e n header field-n
aef0: 61 6d 65 29 29 20 74 61 72 67 65 74 73 74 72 20 ame)) targetstr
af00: 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 66 runname "meta" f
af10: 69 65 6c 64 2d 6e 61 6d 65 29 29 0a 09 09 09 20 ield-name))....
af20: 20 20 20 20 72 75 6e 73 2d 73 70 65 63 29 29 29 runs-spec)))
af30: 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 ....;; (mutils:h
af40: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
af50: 61 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d a (db:get-value-
af60: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
af70: 61 64 65 72 20 22 73 74 61 74 75 73 22 29 20 20 ader "status")
af80: 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e targetstr run
af90: 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 73 74 61 name "meta" "sta
afa0: 74 75 73 22 20 20 20 20 20 29 0a 09 09 09 3b 3b tus" )....;;
afb0: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
afc0: 68 2d 73 65 74 21 20 64 61 74 61 20 28 64 62 3a h-set! data (db:
afd0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
afe0: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 der run header "
aff0: 73 74 61 74 65 22 29 20 20 20 20 20 20 74 61 72 state") tar
b000: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
b010: 6d 65 74 61 22 20 22 73 74 61 74 65 22 20 20 20 meta" "state"
b020: 20 20 20 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 )....;; (muti
b030: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
b040: 20 64 61 74 61 20 28 63 6f 6e 63 20 28 64 62 3a data (conc (db:
b050: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
b060: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 der run header "
b070: 69 64 22 29 29 20 20 74 61 72 67 65 74 73 74 72 id")) targetstr
b080: 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 runname "meta"
b090: 22 69 64 22 20 20 20 20 20 20 20 20 20 29 0a 09 "id" )..
b0a0: 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 ..;; (mutils:hie
b0b0: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
b0c0: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
b0d0: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
b0e0: 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 er "event_time")
b0f0: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
b100: 6d 65 20 22 6d 65 74 61 22 20 22 65 76 65 6e 74 me "meta" "event
b110: 5f 74 69 6d 65 22 20 29 0a 09 09 09 3b 3b 20 28 _time" )....;; (
b120: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
b130: 73 65 74 21 20 64 61 74 61 20 28 64 62 3a 67 65 set! data (db:ge
b140: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
b150: 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 63 6f r run header "co
b160: 6d 6d 65 6e 74 22 29 20 20 20 20 74 61 72 67 65 mment") targe
b170: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 tstr runname "me
b180: 74 61 22 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 ta" "comment"
b190: 20 29 0a 09 09 09 3b 3b 20 3b 3b 20 61 64 64 20 )....;; ;; add
b1a0: 6c 61 73 74 20 65 6e 74 72 79 20 74 77 69 63 65 last entry twice
b1b0: 20 2d 20 73 65 65 6d 73 20 74 6f 20 62 65 20 61 - seems to be a
b1c0: 20 62 75 67 20 69 6e 20 68 69 65 72 68 61 73 68 bug in hierhash
b1d0: 3f 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a ?....;; (mutils:
b1e0: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
b1f0: 74 61 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 ta (db:get-value
b200: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
b210: 65 61 64 65 72 20 22 63 6f 6d 6d 65 6e 74 22 29 eader "comment")
b220: 20 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 targetstr ru
b230: 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 63 6f nname "meta" "co
b240: 6d 6d 65 6e 74 22 20 20 20 20 29 0a 09 09 20 20 mment" )...
b250: 20 20 20 20 20 28 65 6c 73 65 0a 09 09 09 28 69 (else....(i
b260: 66 20 28 6e 75 6c 6c 3f 20 72 75 6e 73 2d 73 70 f (null? runs-sp
b270: 65 63 29 0a 09 09 09 20 20 20 20 28 70 72 69 6e ec).... (prin
b280: 74 20 22 52 75 6e 3a 20 22 20 74 61 72 67 65 74 t "Run: " target
b290: 73 74 72 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 str "/" runname
b2a0: 0a 09 09 09 09 20 20 20 22 20 73 74 61 74 75 73 ..... " status
b2b0: 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 : " (db:get-valu
b2c0: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
b2d0: 68 65 61 64 65 72 20 22 73 74 61 74 65 22 29 0a header "state").
b2e0: 09 09 09 09 20 20 20 22 20 72 75 6e 2d 69 64 3a .... " run-id:
b2f0: 20 22 20 72 75 6e 2d 69 64 20 22 2c 20 6e 75 6d " run-id ", num
b300: 62 65 72 20 74 65 73 74 73 3a 20 22 20 28 6c 65 ber tests: " (le
b310: 6e 67 74 68 20 74 65 73 74 73 29 0a 09 09 09 09 ngth tests).....
b320: 20 20 20 22 20 65 76 65 6e 74 5f 74 69 6d 65 3a " event_time:
b330: 20 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 " (db:get-value
b340: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
b350: 65 61 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d eader "event_tim
b360: 65 22 29 29 0a 09 09 09 20 20 20 20 28 62 65 67 e")).... (beg
b370: 69 6e 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 in.... (if
b380: 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 22 74 61 (not (member "ta
b390: 72 67 65 74 22 20 72 75 6e 73 2d 73 70 65 63 29 rget" runs-spec)
b3a0: 29 0a 09 09 09 20 20 20 20 20 20 20 20 20 20 3b ).... ;
b3b0: 3b 20 28 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 ; (display (conc
b3c0: 20 22 54 61 72 67 65 74 3a 20 22 20 74 61 72 67 "Target: " targ
b3d0: 65 74 73 74 72 29 29 0a 09 09 09 20 20 20 20 20 etstr))....
b3e0: 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 28 63 (display (c
b3f0: 6f 6e 63 20 22 52 75 6e 3a 20 22 20 74 61 72 67 onc "Run: " targ
b400: 65 74 73 74 72 20 22 2f 22 20 72 75 6e 6e 61 6d etstr "/" runnam
b410: 65 20 22 20 22 29 29 29 0a 09 09 09 20 20 20 20 e " ")))....
b420: 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 20 (for-each....
b430: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 (lambda (f
b440: 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 09 20 ield-name).....
b450: 28 69 66 20 28 65 71 75 61 6c 3f 20 66 69 65 6c (if (equal? fiel
b460: 64 2d 6e 61 6d 65 20 22 74 61 72 67 65 74 22 29 d-name "target")
b470: 0a 09 09 09 09 20 20 20 20 20 28 64 69 73 70 6c ..... (displ
b480: 61 79 20 28 63 6f 6e 63 20 22 74 61 72 67 65 74 ay (conc "target
b490: 3a 20 22 20 74 61 72 67 65 74 73 74 72 20 22 20 : " targetstr "
b4a0: 22 29 29 0a 09 09 09 09 20 20 20 20 20 28 64 69 "))..... (di
b4b0: 73 70 6c 61 79 20 28 63 6f 6e 63 20 66 69 65 6c splay (conc fiel
b4c0: 64 2d 6e 61 6d 65 20 22 3a 20 22 20 28 64 62 3a d-name ": " (db:
b4d0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
b4e0: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 28 der run header (
b4f0: 63 6f 6e 63 20 66 69 65 6c 64 2d 6e 61 6d 65 29 conc field-name)
b500: 29 20 22 20 22 29 29 29 29 0a 09 09 09 20 20 20 ) " "))))....
b510: 20 20 20 20 72 75 6e 73 2d 73 70 65 63 29 0a 09 runs-spec)..
b520: 09 09 20 20 20 20 20 20 28 6e 65 77 6c 69 6e 65 .. (newline
b530: 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 0a )))))... .
b540: 09 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 .. (for-each
b550: 20 0a 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 ... (lambd
b560: 61 20 28 74 65 73 74 29 0a 09 09 20 20 20 20 20 a (test)...
b570: 20 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 .(handle-except
b580: 69 6f 6e 73 0a 09 09 09 20 65 78 6e 0a 09 09 09 ions.... exn....
b590: 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 28 64 (begin.... (d
b5a0: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
b5b0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
b5c0: 70 6f 72 74 2a 20 22 42 61 64 20 64 61 74 61 20 port* "Bad data
b5d0: 69 6e 20 74 65 73 74 20 72 65 63 6f 72 64 3f 20 in test record?
b5e0: 22 20 74 65 73 74 29 0a 09 09 09 20 20 20 28 70 " test).... (p
b5f0: 72 69 6e 74 20 22 65 78 6e 3d 22 20 28 63 6f 6e rint "exn=" (con
b600: 64 69 74 69 6f 6e 2d 3e 6c 69 73 74 20 65 78 6e dition->list exn
b610: 29 29 0a 09 09 09 20 20 20 28 64 65 62 75 67 3a )).... (debug:
b620: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
b630: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 -log-port* " mes
b640: 73 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 sage: " ((condit
b650: 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
b660: 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
b670: 61 67 65 29 20 65 78 6e 29 29 0a 09 09 09 20 20 age) exn))....
b680: 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 (print-call-cha
b690: 69 6e 20 28 63 75 72 72 65 6e 74 2d 65 72 72 6f in (current-erro
b6a0: 72 2d 70 6f 72 74 29 29 29 0a 09 09 09 20 28 6c r-port))).... (l
b6b0: 65 74 2a 20 28 28 74 65 73 74 2d 69 64 20 20 20 et* ((test-id
b6c0: 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 (if (member "
b6d0: 69 64 22 20 20 20 20 20 20 20 20 20 20 20 74 65 id" te
b6e0: 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 sts-spec)(get-va
b6f0: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
b700: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
b710: 2d 69 6e 64 65 78 20 22 69 64 22 20 20 20 20 20 -index "id"
b720: 20 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 ) #f)) ;; (
b730: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 20 db:test-get-id
b740: 20 20 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 test))...
b750: 09 09 28 74 65 73 74 6e 61 6d 65 20 20 20 20 20 ..(testname
b760: 28 69 66 20 28 6d 65 6d 62 65 72 20 22 74 65 73 (if (member "tes
b770: 74 6e 61 6d 65 22 20 20 20 20 20 74 65 73 74 73 tname" tests
b780: 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 -spec)(get-value
b790: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
b7a0: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
b7b0: 64 65 78 20 22 74 65 73 74 6e 61 6d 65 22 20 20 dex "testname"
b7c0: 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a ) #f)) ;; (db:
b7d0: 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d test-get-testnam
b7e0: 65 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 e test)).....(
b7f0: 69 74 65 6d 70 61 74 68 20 20 20 20 20 28 69 66 itempath (if
b800: 20 28 6d 65 6d 62 65 72 20 22 69 74 65 6d 5f 70 (member "item_p
b810: 61 74 68 22 20 20 20 20 74 65 73 74 73 2d 73 70 ath" tests-sp
b820: 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 ec)(get-value-by
b830: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
b840: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
b850: 20 22 69 74 65 6d 5f 70 61 74 68 22 20 20 20 29 "item_path" )
b860: 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 #f)) ;; (db:tes
b870: 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 t-get-item-path
b880: 20 74 65 73 74 29 29 0a 09 09 09 09 28 63 6f 6d test)).....(com
b890: 6d 65 6e 74 20 20 20 20 20 20 28 69 66 20 28 6d ment (if (m
b8a0: 65 6d 62 65 72 20 22 63 6f 6d 6d 65 6e 74 22 20 ember "comment"
b8b0: 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 tests-spec)
b8c0: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
b8d0: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
b8e0: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 63 t-field-index "c
b8f0: 6f 6d 6d 65 6e 74 22 20 20 20 20 20 29 20 23 66 omment" ) #f
b900: 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 )) ;; (db:test-g
b910: 65 74 2d 63 6f 6d 6d 65 6e 74 20 20 20 20 74 65 et-comment te
b920: 73 74 29 29 0a 09 09 09 09 28 74 73 74 61 74 65 st)).....(tstate
b930: 20 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 (if (memb
b940: 65 72 20 22 73 74 61 74 65 22 20 20 20 20 20 20 er "state"
b950: 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 tests-spec)(ge
b960: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
b970: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
b980: 69 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 ield-index "stat
b990: 65 22 20 20 20 20 20 20 20 29 20 23 66 29 29 20 e" ) #f))
b9a0: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
b9b0: 73 74 61 74 65 20 20 20 20 20 20 74 65 73 74 29 state test)
b9c0: 29 0a 09 09 09 09 28 74 73 74 61 74 75 73 20 20 ).....(tstatus
b9d0: 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 (if (member
b9e0: 22 73 74 61 74 75 73 22 20 20 20 20 20 20 20 74 "status" t
b9f0: 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 ests-spec)(get-v
ba00: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
ba10: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
ba20: 64 2d 69 6e 64 65 78 20 22 73 74 61 74 75 73 22 d-index "status"
ba30: 20 20 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 ) #f)) ;;
ba40: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
ba50: 74 75 73 20 20 20 20 20 74 65 73 74 29 29 0a 09 tus test))..
ba60: 09 09 09 28 65 76 65 6e 74 2d 74 69 6d 65 20 20 ...(event-time
ba70: 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 65 76 (if (member "ev
ba80: 65 6e 74 5f 74 69 6d 65 22 20 20 20 74 65 73 74 ent_time" test
ba90: 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 s-spec)(get-valu
baa0: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
bab0: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
bac0: 6e 64 65 78 20 22 65 76 65 6e 74 5f 74 69 6d 65 ndex "event_time
bad0: 22 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 " ) #f)) ;; (db
bae0: 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f :test-get-event_
baf0: 74 69 6d 65 20 74 65 73 74 29 29 0a 09 09 09 09 time test)).....
bb00: 28 72 75 6e 64 69 72 20 20 20 20 20 20 20 28 69 (rundir (i
bb10: 66 20 28 6d 65 6d 62 65 72 20 22 72 75 6e 64 69 f (member "rundi
bb20: 72 22 20 20 20 20 20 20 20 74 65 73 74 73 2d 73 r" tests-s
bb30: 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 pec)(get-value-b
bb40: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
bb50: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
bb60: 78 20 22 72 75 6e 64 69 72 22 20 20 20 20 20 20 x "rundir"
bb70: 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 ) #f)) ;; (db:te
bb80: 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 20 20 st-get-rundir
bb90: 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 66 69 test)).....(fi
bba0: 6e 61 6c 5f 6c 6f 67 66 20 20 20 28 69 66 20 28 nal_logf (if (
bbb0: 6d 65 6d 62 65 72 20 22 66 69 6e 61 6c 5f 6c 6f member "final_lo
bbc0: 67 66 22 20 20 20 74 65 73 74 73 2d 73 70 65 63 gf" tests-spec
bbd0: 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 )(get-value-by-f
bbe0: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
bbf0: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
bc00: 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 20 29 20 23 final_logf" ) #
bc10: 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d f)) ;; (db:test-
bc20: 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 get-final_logf t
bc30: 65 73 74 29 29 0a 09 09 09 09 28 72 75 6e 5f 64 est)).....(run_d
bc40: 75 72 61 74 69 6f 6e 20 28 69 66 20 28 6d 65 6d uration (if (mem
bc50: 62 65 72 20 22 72 75 6e 5f 64 75 72 61 74 69 6f ber "run_duratio
bc60: 6e 22 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 n" tests-spec)(g
bc70: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
bc80: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
bc90: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e field-index "run
bca0: 5f 64 75 72 61 74 69 6f 6e 22 29 20 23 66 29 29 _duration") #f))
bcb0: 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ;; (db:test-get
bcc0: 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 -run_duration te
bcd0: 73 74 29 29 0a 09 09 09 09 28 66 75 6c 6c 6e 61 st)).....(fullna
bce0: 6d 65 20 20 20 20 20 28 63 6f 6e 63 20 74 65 73 me (conc tes
bcf0: 74 6e 61 6d 65 0a 09 09 09 09 09 09 20 20 20 20 tname.......
bd00: 28 69 66 20 28 65 71 75 61 6c 3f 20 69 74 65 6d (if (equal? item
bd10: 70 61 74 68 20 22 22 29 0a 09 09 09 09 09 09 09 path "")........
bd20: 22 22 20 0a 09 09 09 09 09 09 09 28 63 6f 6e 63 "" ........(conc
bd30: 20 22 28 22 20 69 74 65 6d 70 61 74 68 20 22 29 "(" itempath ")
bd40: 22 29 29 29 29 29 0a 09 09 09 20 20 20 28 63 61 "))))).... (ca
bd50: 73 65 20 64 6d 6f 64 65 0a 09 09 09 20 20 20 20 se dmode....
bd60: 20 28 28 6a 73 6f 6e 20 6f 64 73 29 0a 09 09 09 ((json ods)....
bd70: 20 20 20 20 20 20 28 69 66 20 74 65 73 74 73 2d (if tests-
bd80: 73 70 65 63 0a 09 09 09 09 20 20 28 66 6f 72 2d spec..... (for-
bd90: 65 61 63 68 0a 09 09 09 09 20 20 20 28 6c 61 6d each..... (lam
bda0: 62 64 61 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 bda (field-name)
bdb0: 0a 09 09 09 09 20 20 20 20 20 28 6d 75 74 69 6c ..... (mutil
bdc0: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
bdd0: 64 61 74 61 20 20 28 67 65 74 2d 76 61 6c 75 65 data (get-value
bde0: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
bdf0: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
be00: 64 65 78 20 66 69 65 6c 64 2d 6e 61 6d 65 29 20 dex field-name)
be10: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
be20: 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 e "data" (conc t
be30: 65 73 74 2d 69 64 29 20 66 69 65 6c 64 2d 6e 61 est-id) field-na
be40: 6d 65 29 29 0a 09 09 09 09 20 20 20 74 65 73 74 me))..... test
be50: 73 2d 73 70 65 63 29 29 29 0a 09 09 09 20 20 20 s-spec)))....
be60: 20 20 3b 3b 20 3b 3b 20 28 6d 75 74 69 6c 73 3a ;; ;; (mutils:
be70: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
be80: 74 61 20 20 66 75 6c 6c 6e 61 6d 65 20 20 20 74 ta fullname t
be90: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
bea0: 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 "data" (conc te
beb0: 73 74 2d 69 64 29 20 22 74 6e 61 6d 65 22 20 20 st-id) "tname"
bec0: 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 ).... ;;
bed0: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
bee0: 68 2d 73 65 74 21 20 64 61 74 61 20 20 74 65 73 h-set! data tes
bef0: 74 6e 61 6d 65 20 20 20 74 61 72 67 65 74 73 74 tname targetst
bf00: 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 r runname "data"
bf10: 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 (conc test-id)
bf20: 22 74 65 73 74 6e 61 6d 65 22 20 20 29 0a 09 09 "testname" )...
bf30: 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c . ;; (mutil
bf40: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
bf50: 64 61 74 61 20 20 69 74 65 6d 70 61 74 68 20 20 data itempath
bf60: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
bf70: 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 me "data" (conc
bf80: 74 65 73 74 2d 69 64 29 20 22 69 74 65 6d 70 61 test-id) "itempa
bf90: 74 68 22 20 20 29 0a 09 09 09 20 20 20 20 20 3b th" ).... ;
bfa0: 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ; (mutils:hierh
bfb0: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 63 ash-set! data c
bfc0: 6f 6d 6d 65 6e 74 20 20 20 20 74 61 72 67 65 74 omment target
bfd0: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 str runname "dat
bfe0: 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 a" (conc test-id
bff0: 29 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 29 0a ) "comment" ).
c000: 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 ... ;; (mut
c010: 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 ils:hierhash-set
c020: 21 20 64 61 74 61 20 20 74 73 74 61 74 65 20 20 ! data tstate
c030: 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e targetstr run
c040: 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e name "data" (con
c050: 63 20 74 65 73 74 2d 69 64 29 20 22 73 74 61 74 c test-id) "stat
c060: 65 22 20 20 20 20 20 29 0a 09 09 09 20 20 20 20 e" )....
c070: 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 ;; (mutils:hie
c080: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
c090: 20 74 73 74 61 74 75 73 20 20 20 20 74 61 72 67 tstatus targ
c0a0: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 etstr runname "d
c0b0: 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d ata" (conc test-
c0c0: 69 64 29 20 22 73 74 61 74 75 73 22 20 20 20 20 id) "status"
c0d0: 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d ).... ;; (m
c0e0: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
c0f0: 65 74 21 20 64 61 74 61 20 20 72 75 6e 64 69 72 et! data rundir
c100: 20 20 20 20 20 74 61 72 67 65 74 73 74 72 20 72 targetstr r
c110: 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 unname "data" (c
c120: 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 72 75 onc test-id) "ru
c130: 6e 64 69 72 22 20 20 20 20 29 0a 09 09 09 20 20 ndir" )....
c140: 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 ;; (mutils:h
c150: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
c160: 61 20 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 61 a final_logf ta
c170: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
c180: 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 "data" (conc tes
c190: 74 2d 69 64 29 20 22 66 69 6e 61 6c 5f 6c 6f 67 t-id) "final_log
c1a0: 66 22 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 f").... ;;
c1b0: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
c1c0: 2d 73 65 74 21 20 64 61 74 61 20 20 72 75 6e 5f -set! data run_
c1d0: 64 75 72 61 74 69 6f 6e 20 74 61 72 67 65 74 73 duration targets
c1e0: 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 tr runname "data
c1f0: 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 " (conc test-id)
c200: 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 "run_duration")
c210: 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 .... ;; (mu
c220: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
c230: 74 21 20 64 61 74 61 20 20 65 76 65 6e 74 2d 74 t! data event-t
c240: 69 6d 65 20 74 61 72 67 65 74 73 74 72 20 72 75 ime targetstr ru
c250: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
c260: 6e 63 20 74 65 73 74 2d 69 64 29 20 22 65 76 65 nc test-id) "eve
c270: 6e 74 5f 74 69 6d 65 22 29 0a 09 09 09 20 20 20 nt_time")....
c280: 20 20 3b 3b 20 20 3b 3b 20 61 64 64 20 6c 61 73 ;; ;; add las
c290: 74 20 65 6e 74 72 79 20 74 77 69 63 65 20 2d 20 t entry twice -
c2a0: 73 65 65 6d 73 20 74 6f 20 62 65 20 61 20 62 75 seems to be a bu
c2b0: 67 20 69 6e 20 68 69 65 72 68 61 73 68 3f 0a 09 g in hierhash?..
c2c0: 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 .. ;; (muti
c2d0: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
c2e0: 20 64 61 74 61 20 20 65 76 65 6e 74 2d 74 69 6d data event-tim
c2f0: 65 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e e targetstr runn
c300: 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 ame "data" (conc
c310: 20 74 65 73 74 2d 69 64 29 20 22 65 76 65 6e 74 test-id) "event
c320: 5f 74 69 6d 65 22 29 0a 09 09 09 20 20 20 20 20 _time")....
c330: 3b 3b 20 20 29 0a 09 09 09 20 20 20 20 20 28 65 ;; ).... (e
c340: 6c 73 65 0a 09 09 09 20 20 20 20 20 20 28 69 66 lse.... (if
c350: 20 28 61 6e 64 20 74 73 74 61 74 65 20 74 73 74 (and tstate tst
c360: 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 29 atus event-time)
c370: 0a 09 09 09 09 20 20 28 66 6f 72 6d 61 74 20 23 ..... (format #
c380: 74 0a 09 09 09 09 09 20 20 22 20 20 54 65 73 74 t...... " Test
c390: 3a 20 7e 32 35 61 20 53 74 61 74 65 3a 20 7e 31 : ~25a State: ~1
c3a0: 35 61 20 53 74 61 74 75 73 3a 20 7e 31 35 61 20 5a Status: ~15a
c3b0: 52 75 6e 74 69 6d 65 3a 20 7e 35 40 61 73 20 54 Runtime: ~5@as T
c3c0: 69 6d 65 3a 20 7e 32 32 61 20 48 6f 73 74 3a 20 ime: ~22a Host:
c3d0: 7e 31 30 61 5c 6e 22 0a 09 09 09 09 09 20 20 28 ~10a\n"...... (
c3e0: 69 66 20 66 75 6c 6c 6e 61 6d 65 20 66 75 6c 6c if fullname full
c3f0: 6e 61 6d 65 20 22 22 29 0a 09 09 09 09 09 20 20 name "")......
c400: 28 69 66 20 74 73 74 61 74 65 20 20 20 74 73 74 (if tstate tst
c410: 61 74 65 20 20 20 22 22 29 0a 09 09 09 09 09 20 ate "")......
c420: 20 28 69 66 20 74 73 74 61 74 75 73 20 20 74 73 (if tstatus ts
c430: 74 61 74 75 73 20 20 22 22 29 0a 09 09 09 09 09 tatus "")......
c440: 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d (get-value-by-
c450: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
c460: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
c470: 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 3b "run_duration");
c480: 3b 28 69 66 20 74 65 73 74 20 20 20 20 20 28 64 ;(if test (d
c490: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 b:test-get-run_d
c4a0: 75 72 61 74 69 6f 6e 20 74 65 73 74 29 20 22 22 uration test) ""
c4b0: 29 0a 09 09 09 09 09 20 20 28 69 66 20 65 76 65 )...... (if eve
c4c0: 6e 74 2d 74 69 6d 65 20 65 76 65 6e 74 2d 74 69 nt-time event-ti
c4d0: 6d 65 20 22 22 29 0a 09 09 09 09 09 20 20 28 67 me "")...... (g
c4e0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
c4f0: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
c500: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 68 6f 73 field-index "hos
c510: 74 22 29 29 20 3b 3b 28 69 66 20 74 65 73 74 20 t")) ;;(if test
c520: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 (db:test-get-hos
c530: 74 20 74 65 73 74 29 29 20 22 22 29 0a 09 09 09 t test)) "")....
c540: 09 20 20 28 70 72 69 6e 74 20 22 20 20 54 65 73 . (print " Tes
c550: 74 3a 20 22 20 66 75 6c 6c 6e 61 6d 65 0a 09 09 t: " fullname...
c560: 09 09 09 20 28 69 66 20 74 73 74 61 74 65 20 20 ... (if tstate
c570: 28 63 6f 6e 63 20 22 20 53 74 61 74 65 3a 20 22 (conc " State: "
c580: 20 20 74 73 74 61 74 65 29 20 20 22 22 29 0a 09 tstate) "")..
c590: 09 09 09 09 20 28 69 66 20 74 73 74 61 74 75 73 .... (if tstatus
c5a0: 20 28 63 6f 6e 63 20 22 20 53 74 61 74 75 73 3a (conc " Status:
c5b0: 20 22 20 74 73 74 61 74 75 73 29 20 22 22 29 0a " tstatus) "").
c5c0: 09 09 09 09 09 20 28 69 66 20 28 67 65 74 2d 76 ..... (if (get-v
c5d0: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
c5e0: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
c5f0: 64 2d 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 d-index "run_dur
c600: 61 74 69 6f 6e 22 29 0a 09 09 09 09 09 20 20 20 ation")......
c610: 20 20 28 63 6f 6e 63 20 22 20 52 75 6e 74 69 6d (conc " Runtim
c620: 65 3a 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d e: " (get-value-
c630: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
c640: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
c650: 65 78 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e ex "run_duration
c660: 22 29 29 0a 09 09 09 09 09 20 20 20 20 20 22 22 "))...... ""
c670: 29 0a 09 09 09 09 09 20 28 69 66 20 65 76 65 6e )...... (if even
c680: 74 2d 74 69 6d 65 20 28 63 6f 6e 63 20 22 20 54 t-time (conc " T
c690: 69 6d 65 3a 20 22 20 65 76 65 6e 74 2d 74 69 6d ime: " event-tim
c6a0: 65 29 20 22 22 29 0a 09 09 09 09 09 20 28 69 66 e) "")...... (if
c6b0: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
c6c0: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
c6d0: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
c6e0: 68 6f 73 74 22 29 0a 09 09 09 09 09 20 20 20 20 host")......
c6f0: 20 28 63 6f 6e 63 20 22 20 48 6f 73 74 3a 20 22 (conc " Host: "
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: 68 6f 73 74 22 29 29 0a 09 09 09 09 09 20 20 20 host"))......
c740: 20 20 22 22 29 29 29 0a 09 09 09 20 20 20 20 20 "")))....
c750: 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 65 (if (not (or (e
c760: 71 75 61 6c 3f 20 28 67 65 74 2d 76 61 6c 75 65 qual? (get-value
c770: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
c780: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
c790: 64 65 78 20 22 73 74 61 74 75 73 22 29 20 22 50 dex "status") "P
c7a0: 41 53 53 22 29 0a 09 09 09 09 09 20 20 20 28 65 ASS")...... (e
c7b0: 71 75 61 6c 3f 20 28 67 65 74 2d 76 61 6c 75 65 qual? (get-value
c7c0: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
c7d0: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
c7e0: 64 65 78 20 22 73 74 61 74 75 73 22 29 20 22 57 dex "status") "W
c7f0: 41 52 4e 22 29 0a 09 09 09 09 09 20 20 20 28 65 ARN")...... (e
c800: 71 75 61 6c 3f 20 28 67 65 74 2d 76 61 6c 75 65 qual? (get-value
c810: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
c820: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
c830: 64 65 78 20 22 73 74 61 74 65 22 29 20 20 22 4e dex "state") "N
c840: 4f 54 5f 53 54 41 52 54 45 44 22 29 29 29 0a 09 OT_STARTED")))..
c850: 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 ... (begin.....
c860: 20 20 20 20 28 70 72 69 6e 74 20 20 20 28 69 66 (print (if
c870: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
c880: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
c890: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
c8a0: 63 70 75 6c 6f 61 64 22 29 0a 09 09 09 09 09 09 cpuload").......
c8b0: 20 28 63 6f 6e 63 20 22 20 20 20 20 20 20 20 20 (conc "
c8c0: 20 63 70 75 6c 6f 61 64 3a 20 20 22 20 20 20 28 cpuload: " (
c8d0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
c8e0: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
c8f0: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 63 70 -field-index "cp
c900: 75 6c 6f 61 64 22 29 29 0a 09 09 09 09 09 09 20 uload")).......
c910: 22 22 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d "") ;; (db:test-
c920: 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 73 74 get-cpuload test
c930: 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 )...... (if
c940: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
c950: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
c960: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 64 t-field-index "d
c970: 69 73 6b 66 72 65 65 22 29 0a 09 09 09 09 09 09 iskfree").......
c980: 20 28 63 6f 6e 63 20 22 5c 6e 20 20 20 20 20 20 (conc "\n
c990: 20 20 20 64 69 73 6b 66 72 65 65 3a 20 22 20 28 diskfree: " (
c9a0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
c9b0: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
c9c0: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 64 69 -field-index "di
c9d0: 73 6b 66 72 65 65 22 29 29 20 3b 3b 20 28 64 62 skfree")) ;; (db
c9e0: 3a 74 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 :test-get-diskfr
c9f0: 65 65 20 74 65 73 74 29 0a 09 09 09 09 09 09 20 ee test).......
ca00: 22 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 "")...... (i
ca10: 66 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d f (get-value-by-
ca20: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
ca30: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
ca40: 22 75 6e 61 6d 65 22 29 0a 09 09 09 09 09 09 20 "uname").......
ca50: 28 63 6f 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 (conc "\n
ca60: 20 20 75 6e 61 6d 65 3a 20 20 20 20 22 20 28 67 uname: " (g
ca70: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
ca80: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
ca90: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 75 6e 61 field-index "una
caa0: 6d 65 22 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 me")) ;; (db:tes
cab0: 74 2d 67 65 74 2d 75 6e 61 6d 65 20 74 65 73 74 t-get-uname test
cac0: 29 0a 09 09 09 09 09 09 20 22 22 29 0a 09 09 09 )....... "")....
cad0: 09 09 20 20 20 20 20 28 69 66 20 28 67 65 74 2d .. (if (get-
cae0: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
caf0: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
cb00: 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 64 69 72 ld-index "rundir
cb10: 22 29 0a 09 09 09 09 09 09 20 28 63 6f 6e 63 20 ")....... (conc
cb20: 22 5c 6e 20 20 20 20 20 20 20 20 20 72 75 6e 64 "\n rund
cb30: 69 72 3a 20 20 20 22 20 28 67 65 74 2d 76 61 6c ir: " (get-val
cb40: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
cb50: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
cb60: 69 6e 64 65 78 20 22 72 75 6e 64 69 72 22 29 29 index "rundir"))
cb70: 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ;; (db:test-get
cb80: 2d 72 75 6e 64 69 72 20 74 65 73 74 29 0a 09 09 -rundir test)...
cb90: 09 09 09 09 20 22 22 29 0a 3b 3b 09 09 09 09 09 .... "").;;.....
cba0: 20 20 20 20 20 22 5c 6e 20 20 20 20 20 20 20 20 "\n
cbb0: 20 72 75 6e 64 69 72 3a 20 20 20 22 20 28 67 65 rundir: " (ge
cbc0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
cbd0: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
cbe0: 69 65 6c 64 2d 69 6e 64 65 78 20 22 22 29 20 3b ield-index "") ;
cbf0: 3b 20 28 73 64 62 3a 71 72 79 20 27 67 65 74 73 ; (sdb:qry 'gets
cc00: 74 72 20 3b 3b 20 28 66 69 6c 65 64 62 3a 67 65 tr ;; (filedb:ge
cc10: 74 2d 70 61 74 68 20 2a 66 64 62 2a 20 0a 3b 3b t-path *fdb* .;;
cc20: 20 09 09 09 09 09 20 20 20 20 20 28 64 62 3a 74 ..... (db:t
cc30: 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 est-get-rundir t
cc40: 65 73 74 29 20 3b 3b 20 29 0a 09 09 09 09 09 20 est) ;; )......
cc50: 20 20 20 20 29 0a 09 09 09 09 20 20 20 20 3b 3b )..... ;;
cc60: 20 45 61 63 68 20 74 65 73 74 0a 09 09 09 09 20 Each test.....
cc70: 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 65 6d ;; DO NOT rem
cc80: 6f 74 65 20 72 75 6e 0a 09 09 09 09 20 20 20 20 ote run.....
cc90: 28 6c 65 74 20 28 28 73 74 65 70 73 20 28 64 62 (let ((steps (db
cca0: 3a 64 69 73 70 61 74 63 68 2d 71 75 65 72 79 20 :dispatch-query
ccb0: 61 63 63 65 73 73 2d 6d 6f 64 65 20 72 6d 74 3a access-mode rmt:
ccc0: 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 get-steps-for-te
ccd0: 73 74 20 64 62 3a 67 65 74 2d 73 74 65 70 73 2d st db:get-steps-
cce0: 66 6f 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 for-test run-id
ccf0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 (db:test-get-id
cd00: 74 65 73 74 29 29 29 29 20 3b 3b 20 28 64 62 3a test)))) ;; (db:
cd10: 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 get-steps-for-te
cd20: 73 74 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d st dbstruct run-
cd30: 69 64 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d id (db:test-get-
cd40: 69 64 20 74 65 73 74 29 29 29 29 0a 09 09 09 09 id test)))).....
cd50: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
cd60: 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d ..... (lam
cd70: 62 64 61 20 28 73 74 65 70 29 0a 09 09 09 09 09 bda (step)......
cd80: 20 28 66 6f 72 6d 61 74 20 23 74 20 0a 09 09 09 (format #t ....
cd90: 09 09 09 20 22 20 20 20 20 53 74 65 70 3a 20 7e ... " Step: ~
cda0: 32 30 61 20 53 74 61 74 65 3a 20 7e 31 30 61 20 20a State: ~10a
cdb0: 53 74 61 74 75 73 3a 20 7e 31 30 61 20 54 69 6d Status: ~10a Tim
cdc0: 65 20 7e 32 32 61 5c 6e 22 0a 09 09 09 09 09 09 e ~22a\n".......
cdd0: 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 (tdb:step-get-s
cde0: 74 65 70 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 tepname step)...
cdf0: 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 2d 67 .... (tdb:step-g
ce00: 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 et-state step)..
ce10: 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 2d ..... (tdb:step-
ce20: 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 70 29 get-status step)
ce30: 0a 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 ....... (tdb:ste
ce40: 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 p-get-event_time
ce50: 20 73 74 65 70 29 29 29 0a 09 09 09 09 20 20 20 step))).....
ce60: 20 20 20 20 73 74 65 70 73 29 29 29 29 29 29 29 steps)))))))
ce70: 29 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 ))... (if (
ce80: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
ce90: 6f 72 74 22 29 0a 09 09 09 20 20 28 73 6f 72 74 ort").... (sort
cea0: 20 74 65 73 74 73 0a 09 09 09 09 28 6c 61 6d 62 tests.....(lamb
ceb0: 64 61 20 28 61 2d 74 65 73 74 20 62 2d 74 65 73 da (a-test b-tes
cec0: 74 29 0a 09 09 09 09 20 20 28 6c 65 74 2a 20 28 t)..... (let* (
ced0: 28 6b 65 79 20 20 20 20 28 61 72 67 73 3a 67 65 (key (args:ge
cee0: 74 2d 61 72 67 20 22 2d 73 6f 72 74 22 29 29 0a t-arg "-sort")).
cef0: 09 09 09 09 09 20 28 66 69 72 73 74 20 20 28 67 ..... (first (g
cf00: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
cf10: 64 6e 61 6d 65 20 61 2d 74 65 73 74 20 74 65 73 dname a-test tes
cf20: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 6b 65 t-field-index ke
cf30: 79 29 29 0a 09 09 09 09 09 20 28 73 65 63 6f 6e y))...... (secon
cf40: 64 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d d (get-value-by-
cf50: 66 69 65 6c 64 6e 61 6d 65 20 62 2d 74 65 73 74 fieldname b-test
cf60: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
cf70: 78 20 6b 65 79 29 29 29 0a 09 09 09 09 20 20 20 x key))).....
cf80: 20 28 28 63 6f 6e 64 20 0a 09 09 09 09 20 20 20 ((cond .....
cf90: 20 20 20 28 28 61 6e 64 20 28 6e 75 6d 62 65 72 ((and (number
cfa0: 3f 20 66 69 72 73 74 29 28 6e 75 6d 62 65 72 3f ? first)(number?
cfb0: 20 73 65 63 6f 6e 64 29 29 20 3c 29 0a 09 09 09 second)) <)....
cfc0: 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 73 74 . ((and (st
cfd0: 72 69 6e 67 3f 20 66 69 72 73 74 29 28 73 74 72 ring? first)(str
cfe0: 69 6e 67 3f 20 73 65 63 6f 6e 64 29 29 20 73 74 ing? second)) st
cff0: 72 69 6e 67 3c 3d 3f 29 0a 09 09 09 09 20 20 20 ring<=?).....
d000: 20 20 20 28 65 6c 73 65 20 65 71 75 61 6c 3f 29 (else equal?)
d010: 29 0a 09 09 09 09 20 20 20 20 20 66 69 72 73 74 )..... first
d020: 20 73 65 63 6f 6e 64 29 29 29 29 0a 09 09 09 20 second))))....
d030: 20 74 65 73 74 73 29 29 29 29 29 29 0a 09 20 20 tests))))))..
d040: 20 72 75 6e 73 29 0a 09 20 20 28 69 66 20 28 65 runs).. (if (e
d050: 71 3f 20 64 6d 6f 64 65 20 27 6a 73 6f 6e 29 28 q? dmode 'json)(
d060: 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 29 json-write data)
d070: 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 6d 65 74 ).. (let* ((met
d080: 61 64 61 74 2d 66 69 65 6c 64 73 20 28 64 65 6c adat-fields (del
d090: 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 0a 09 ete-duplicates..
d0a0: 09 09 09 20 20 28 61 70 70 65 6e 64 20 6b 65 79 ... (append key
d0b0: 73 20 27 28 20 22 72 75 6e 6e 61 6d 65 22 20 22 s '( "runname" "
d0c0: 74 69 6d 65 22 20 22 6f 77 6e 65 72 22 20 22 70 time" "owner" "p
d0d0: 61 73 73 5f 63 6f 75 6e 74 22 20 22 66 61 69 6c ass_count" "fail
d0e0: 5f 63 6f 75 6e 74 22 20 22 73 74 61 74 65 22 20 _count" "state"
d0f0: 22 73 74 61 74 75 73 22 20 22 63 6f 6d 6d 65 6e "status" "commen
d100: 74 22 20 22 69 64 22 29 29 29 29 0a 09 09 20 28 t" "id"))))... (
d110: 72 75 6e 2d 66 69 65 6c 64 73 20 20 20 20 27 28 run-fields '(
d120: 0a 09 09 09 09 20 20 22 74 65 73 74 6e 61 6d 65 ..... "testname
d130: 22 0a 09 09 09 09 20 20 22 69 74 65 6d 5f 70 61 "..... "item_pa
d140: 74 68 22 0a 09 09 09 09 20 20 22 73 74 61 74 65 th"..... "state
d150: 22 0a 09 09 09 09 20 20 22 73 74 61 74 75 73 22 "..... "status"
d160: 0a 09 09 09 09 20 20 22 63 6f 6d 6d 65 6e 74 22 ..... "comment"
d170: 0a 09 09 09 09 20 20 22 65 76 65 6e 74 5f 74 69 ..... "event_ti
d180: 6d 65 22 0a 09 09 09 09 20 20 22 68 6f 73 74 22 me"..... "host"
d190: 0a 09 09 09 09 20 20 22 72 75 6e 5f 69 64 22 0a ..... "run_id".
d1a0: 09 09 09 09 20 20 22 72 75 6e 5f 64 75 72 61 74 .... "run_durat
d1b0: 69 6f 6e 22 0a 09 09 09 09 20 20 22 61 74 74 65 ion"..... "atte
d1c0: 6d 70 74 6e 75 6d 22 0a 09 09 09 09 20 20 22 69 mptnum"..... "i
d1d0: 64 22 0a 09 09 09 09 20 20 22 61 72 63 68 69 76 d"..... "archiv
d1e0: 65 64 22 0a 09 09 09 09 20 20 22 64 69 73 6b 66 ed"..... "diskf
d1f0: 72 65 65 22 0a 09 09 09 09 20 20 22 63 70 75 6c ree"..... "cpul
d200: 6f 61 64 22 0a 09 09 09 09 20 20 22 66 69 6e 61 oad"..... "fina
d210: 6c 5f 6c 6f 67 66 22 0a 09 09 09 09 20 20 22 73 l_logf"..... "s
d220: 68 6f 72 74 64 69 72 22 0a 09 09 09 09 20 20 22 hortdir"..... "
d230: 72 75 6e 64 69 72 22 0a 09 09 09 09 20 20 22 75 rundir"..... "u
d240: 6e 61 6d 65 22 0a 09 09 09 09 20 20 29 0a 09 09 name"..... )...
d250: 09 09 29 0a 09 09 20 28 6e 65 77 64 61 74 20 20 ..)... (newdat
d260: 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a (common:
d270: 74 6f 2d 61 6c 69 73 74 20 64 61 74 61 29 29 0a to-alist data)).
d280: 09 09 20 28 61 6c 6c 72 75 6e 64 61 74 20 20 20 .. (allrundat
d290: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6e (if (null? n
d2a0: 65 77 64 61 74 29 0a 09 09 09 09 20 20 20 20 20 ewdat).....
d2b0: 20 27 28 29 0a 09 09 09 09 20 20 20 20 20 20 28 '()..... (
d2c0: 63 61 72 20 28 6d 61 70 20 63 64 72 20 6e 65 77 car (map cdr new
d2d0: 64 61 74 29 29 29 29 20 3b 3b 20 28 63 61 72 20 dat)))) ;; (car
d2e0: 28 6d 61 70 20 63 64 72 20 28 63 61 72 20 28 6d (map cdr (car (m
d2f0: 61 70 20 63 64 72 20 6e 65 77 64 61 74 29 29 29 ap cdr newdat)))
d300: 29 29 0a 09 09 20 28 72 75 6e 73 20 20 20 20 20 ))... (runs
d310: 20 20 20 20 20 20 20 28 61 70 70 65 6e 64 0a 09 (append..
d320: 09 09 09 20 20 20 28 6c 69 73 74 20 22 72 75 6e ... (list "run
d330: 73 22 20 3b 3b 20 73 68 65 65 74 6e 61 6d 65 0a s" ;; sheetname.
d340: 09 09 09 09 09 20 6d 65 74 61 64 61 74 2d 66 69 ..... metadat-fi
d350: 65 6c 64 73 29 0a 09 09 09 09 20 20 20 28 6d 61 elds)..... (ma
d360: 70 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a p (lambda (run).
d370: 09 09 09 09 09 20 20 3b 3b 20 28 70 72 69 6e 74 ..... ;; (print
d380: 20 22 72 75 6e 3a 20 22 20 72 75 6e 29 0a 09 09 "run: " run)...
d390: 09 09 09 20 20 28 6c 65 74 2a 20 28 28 72 75 6e ... (let* ((run
d3a0: 6e 61 6d 65 20 28 63 61 72 20 72 75 6e 29 29 0a name (car run)).
d3b0: 09 09 09 09 09 09 20 28 72 75 6e 64 61 74 20 20 ...... (rundat
d3c0: 28 63 64 72 20 72 75 6e 29 29 0a 09 09 09 09 09 (cdr run))......
d3d0: 09 20 28 6d 65 74 61 64 61 74 20 28 6c 65 74 20 . (metadat (let
d3e0: 28 28 74 6d 70 20 28 61 73 73 6f 63 20 22 6d 65 ((tmp (assoc "me
d3f0: 74 61 22 20 72 75 6e 64 61 74 29 29 29 0a 09 09 ta" rundat)))...
d400: 09 09 09 09 09 20 20 20 20 28 69 66 20 74 6d 70 ..... (if tmp
d410: 20 28 63 64 72 20 74 6d 70 29 20 23 66 29 29 29 (cdr tmp) #f)))
d420: 29 0a 09 09 09 09 09 20 20 20 20 3b 3b 20 28 70 )...... ;; (p
d430: 72 69 6e 74 20 22 72 75 6e 6e 61 6d 65 3a 20 22 rint "runname: "
d440: 20 72 75 6e 6e 61 6d 65 20 22 5c 6e 5c 6e 72 75 runname "\n\nru
d450: 6e 64 61 74 3a 20 22 20 29 28 70 70 20 72 75 6e ndat: " )(pp run
d460: 64 61 74 29 28 70 72 69 6e 74 20 22 5c 6e 5c 6e dat)(print "\n\n
d470: 6d 65 74 61 64 61 74 3a 20 22 29 28 70 70 20 6d metadat: ")(pp m
d480: 65 74 61 64 61 74 29 0a 09 09 09 09 09 20 20 20 etadat)......
d490: 20 28 69 66 20 6d 65 74 61 64 61 74 0a 09 09 09 (if metadat....
d4a0: 09 09 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 ...(map (lambda
d4b0: 28 66 69 65 6c 64 29 0a 09 09 09 09 09 09 20 20 (field).......
d4c0: 20 20 20 20 20 28 6c 65 74 20 28 28 74 6d 70 20 (let ((tmp
d4d0: 28 61 73 73 6f 63 20 66 69 65 6c 64 20 6d 65 74 (assoc field met
d4e0: 61 64 61 74 29 29 29 0a 09 09 09 09 09 09 09 20 adat)))........
d4f0: 28 69 66 20 74 6d 70 20 28 63 64 72 20 74 6d 70 (if tmp (cdr tmp
d500: 29 20 22 22 29 29 29 0a 09 09 09 09 09 09 20 20 ) ""))).......
d510: 20 20 20 6d 65 74 61 64 61 74 2d 66 69 65 6c 64 metadat-field
d520: 73 29 0a 09 09 09 09 09 09 28 62 65 67 69 6e 0a s).......(begin.
d530: 09 09 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 ...... (debug:p
d540: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
d550: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
d560: 4e 47 3a 20 6d 65 74 61 20 64 61 74 61 20 66 6f NG: meta data fo
d570: 72 20 72 75 6e 20 22 20 72 75 6e 6e 61 6d 65 20 r run " runname
d580: 22 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 09 09 " not found")...
d590: 09 09 09 09 20 20 27 28 29 29 29 29 29 0a 09 09 .... '()))))...
d5a0: 09 09 09 61 6c 6c 72 75 6e 64 61 74 29 29 29 0a ...allrundat))).
d5b0: 09 09 20 3b 3b 20 27 28 20 28 20 22 74 61 72 67 .. ;; '( ( "targ
d5c0: 65 74 22 20 28 20 22 72 75 6e 6e 61 6d 65 22 20 et" ( "runname"
d5d0: 28 20 22 64 61 74 61 22 20 28 20 22 72 75 6e 69 ( "data" ( "runi
d5e0: 64 22 20 28 20 22 69 64 20 2e 20 22 33 37 22 20 d" ( "id . "37"
d5f0: 29 20 28 20 2e 2e 2e 20 29 29 29 29 0a 09 09 20 ) ( ... ))))...
d600: 28 72 75 6e 2d 70 61 67 65 73 20 20 20 20 20 20 (run-pages
d610: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 74 61 (map (lambda (ta
d620: 72 67 64 61 74 29 0a 09 09 09 09 09 28 6c 65 74 rgdat)......(let
d630: 2a 20 28 28 74 61 72 67 65 74 20 20 28 63 61 72 * ((target (car
d640: 20 74 61 72 67 64 61 74 29 29 0a 09 09 09 09 09 targdat))......
d650: 20 20 20 20 20 20 20 28 72 75 6e 73 64 61 74 20 (runsdat
d660: 28 63 64 72 20 74 61 72 67 64 61 74 29 29 29 0a (cdr targdat))).
d670: 09 09 09 09 09 20 20 28 69 66 20 72 75 6e 73 64 ..... (if runsd
d680: 61 74 0a 09 09 09 09 09 20 20 20 20 20 20 28 6d at...... (m
d690: 61 70 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 64 ap (lambda (rund
d6a0: 61 74 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 at)....... (
d6b0: 6c 65 74 2a 20 28 28 72 75 6e 6e 61 6d 65 20 20 let* ((runname
d6c0: 28 63 61 72 20 72 75 6e 64 61 74 29 29 0a 09 09 (car rundat))...
d6d0: 09 09 09 09 09 20 20 20 20 28 72 75 6e 64 61 74 ..... (rundat
d6e0: 20 20 20 28 63 64 72 20 72 75 6e 64 61 74 29 29 (cdr rundat))
d6f0: 0a 09 09 09 09 09 09 09 20 20 20 20 28 74 65 73 ........ (tes
d700: 74 73 64 61 74 20 28 6c 65 74 20 28 28 74 6d 70 tsdat (let ((tmp
d710: 20 28 61 73 73 6f 63 20 22 64 61 74 61 22 20 72 (assoc "data" r
d720: 75 6e 64 61 74 29 29 29 0a 09 09 09 09 09 09 09 undat)))........
d730: 09 09 28 69 66 20 74 6d 70 20 28 63 64 72 20 74 ..(if tmp (cdr t
d740: 6d 70 29 20 23 66 29 29 29 29 0a 09 09 09 09 09 mp) #f))))......
d750: 09 20 20 20 20 20 20 20 28 69 66 20 74 65 73 74 . (if test
d760: 73 64 61 74 0a 09 09 09 09 09 09 09 20 20 20 28 sdat........ (
d770: 6c 65 74 20 28 28 74 65 73 74 73 20 28 6d 61 70 let ((tests (map
d780: 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a (lambda (test).
d790: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
d7a0: 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 69 64 20 (let* ((test-id
d7b0: 20 28 63 61 72 20 74 65 73 74 29 29 0a 09 09 09 (car test))....
d7c0: 09 09 09 09 09 09 09 20 20 20 20 20 20 28 74 65 ....... (te
d7d0: 73 74 2d 64 61 74 20 28 63 64 72 20 74 65 73 74 st-dat (cdr test
d7e0: 29 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 28 )))........... (
d7f0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 66 69 65 map (lambda (fie
d800: 6c 64 29 0a 09 09 09 09 09 09 09 09 09 09 09 28 ld)............(
d810: 6c 65 74 20 28 28 74 6d 70 20 28 61 73 73 6f 63 let ((tmp (assoc
d820: 20 66 69 65 6c 64 20 74 65 73 74 2d 64 61 74 29 field test-dat)
d830: 29 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 ))............
d840: 28 69 66 20 74 6d 70 20 28 63 64 72 20 74 6d 70 (if tmp (cdr tmp
d850: 29 20 22 22 29 29 29 0a 09 09 09 09 09 09 09 09 ) ""))).........
d860: 09 09 20 20 20 20 20 20 72 75 6e 2d 66 69 65 6c .. run-fiel
d870: 64 73 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 ds)))..........
d880: 20 20 20 20 74 65 73 74 73 64 61 74 29 29 29 0a testsdat))).
d890: 09 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 28 ....... ;; (
d8a0: 70 72 69 6e 74 20 22 54 61 72 67 65 74 3a 20 22 print "Target: "
d8b0: 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e target "/" runn
d8c0: 61 6d 65 20 22 20 74 65 73 74 73 3a 22 29 0a 09 ame " tests:")..
d8d0: 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 28 70 ...... ;; (p
d8e0: 70 20 74 65 73 74 73 29 0a 09 09 09 09 09 09 09 p tests)........
d8f0: 20 20 20 20 20 28 63 6f 6e 73 20 28 63 6f 6e 63 (cons (conc
d900: 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e target "/" runn
d910: 61 6d 65 29 0a 09 09 09 09 09 09 09 09 20 20 20 ame).........
d920: 28 63 6f 6e 73 20 28 6c 69 73 74 20 28 63 6f 6e (cons (list (con
d930: 63 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e c target "/" run
d940: 6e 61 6d 65 29 29 0a 09 09 09 09 09 09 09 09 09 name))..........
d950: 20 28 63 6f 6e 73 20 27 28 29 0a 09 09 09 09 09 (cons '()......
d960: 09 09 09 09 20 20 20 20 20 20 20 28 63 6f 6e 73 .... (cons
d970: 20 72 75 6e 2d 66 69 65 6c 64 73 20 74 65 73 74 run-fields test
d980: 73 29 29 29 29 29 0a 09 09 09 09 09 09 09 20 20 s)))))........
d990: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 20 (begin........
d9a0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
d9b0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
d9c0: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
d9d0: 72 75 6e 20 22 20 74 61 72 67 65 74 20 22 2f 22 run " target "/"
d9e0: 20 72 75 6e 6e 61 6d 65 20 22 20 61 70 70 65 61 runname " appea
d9f0: 72 73 20 74 6f 20 68 61 76 65 20 6e 6f 20 64 61 rs to have no da
da00: 74 61 22 29 0a 09 09 09 09 09 09 09 20 20 20 20 ta")........
da10: 20 3b 3b 20 28 70 70 20 72 75 6e 64 61 74 29 0a ;; (pp rundat).
da20: 09 09 09 09 09 09 09 20 20 20 20 20 27 28 29 29 ....... '())
da30: 29 29 29 0a 09 09 09 09 09 09 20 20 20 72 75 6e )))....... run
da40: 73 64 61 74 29 0a 09 09 09 09 09 20 20 20 20 20 sdat)......
da50: 20 27 28 29 29 29 29 0a 09 09 09 09 20 20 20 20 '()))).....
da60: 20 20 6e 65 77 64 61 74 29 29 20 3b 3b 20 77 65 newdat)) ;; we
da70: 20 75 73 65 20 6e 65 77 64 61 74 20 74 6f 20 67 use newdat to g
da80: 65 74 20 74 61 72 67 65 74 0a 09 09 20 28 73 68 et target... (sh
da90: 65 65 74 73 20 20 20 20 20 20 20 20 20 28 66 69 eets (fi
daa0: 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 lter (lambda (x)
dab0: 0a 09 09 09 09 09 20 20 20 28 6e 6f 74 20 28 6e ...... (not (n
dac0: 75 6c 6c 3f 20 78 29 29 29 0a 09 09 09 09 09 20 ull? x)))......
dad0: 28 63 6f 6e 73 20 72 75 6e 73 20 28 6d 61 70 20 (cons runs (map
dae0: 63 61 72 20 72 75 6e 2d 70 61 67 65 73 29 29 29 car run-pages)))
daf0: 29 29 0a 09 20 20 20 20 3b 3b 20 28 70 72 69 6e )).. ;; (prin
db00: 74 20 22 61 6c 6c 72 75 6e 64 61 74 3a 22 29 0a t "allrundat:").
db10: 09 20 20 20 20 3b 3b 20 28 70 70 20 61 6c 6c 72 . ;; (pp allr
db20: 75 6e 64 61 74 29 0a 09 20 20 20 20 3b 3b 20 28 undat).. ;; (
db30: 70 72 69 6e 74 20 22 72 75 6e 73 3a 22 29 0a 09 print "runs:")..
db40: 20 20 20 20 3b 3b 20 28 70 70 20 72 75 6e 73 29 ;; (pp runs)
db50: 0a 09 20 20 20 20 3b 28 70 72 69 6e 74 20 22 73 .. ;(print "s
db60: 68 65 65 74 73 3a 20 22 29 0a 09 20 20 20 20 3b heets: ").. ;
db70: 3b 20 28 70 70 20 73 68 65 65 74 73 29 0a 09 20 ; (pp sheets)..
db80: 20 20 20 28 69 66 20 28 65 71 3f 20 64 6d 6f 64 (if (eq? dmod
db90: 65 20 27 6f 64 73 29 0a 09 09 28 6c 65 74 2a 20 e 'ods)...(let*
dba0: 28 28 74 65 6d 70 64 69 72 20 20 20 20 28 63 6f ((tempdir (co
dbb0: 6e 63 20 22 2f 74 6d 70 2f 22 20 28 63 75 72 72 nc "/tmp/" (curr
dbc0: 65 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 29 20 22 ent-user-name) "
dbd0: 2f 22 20 28 72 61 6e 64 6f 6d 20 31 30 30 30 30 /" (random 10000
dbe0: 29 20 22 5f 22 20 28 63 75 72 72 65 6e 74 2d 70 ) "_" (current-p
dbf0: 72 6f 63 65 73 73 2d 69 64 29 29 29 0a 09 09 20 rocess-id)))...
dc00: 20 20 20 20 20 20 28 6f 75 74 70 75 74 66 69 6c (outputfil
dc10: 65 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d e (or (args:get-
dc20: 61 72 67 20 22 2d 6f 22 29 20 22 6f 75 74 2e 6f arg "-o") "out.o
dc30: 64 73 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 ds"))... (
dc40: 6f 75 66 20 20 20 20 20 20 20 20 28 69 66 20 28 ouf (if (
dc50: 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 string-match (re
dc60: 67 65 78 70 20 22 5e 5b 2f 7e 5d 2b 2e 2a 22 29 gexp "^[/~]+.*")
dc70: 20 6f 75 74 70 75 74 66 69 6c 65 29 20 3b 3b 20 outputfile) ;;
dc80: 66 75 6c 6c 20 70 61 74 68 3f 0a 09 09 09 09 20 full path?.....
dc90: 20 20 20 20 20 20 6f 75 74 70 75 74 66 69 6c 65 outputfile
dca0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 62 65 67 ..... (beg
dcb0: 69 6e 0a 09 09 09 09 09 20 28 64 65 62 75 67 3a in...... (debug:
dcc0: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
dcd0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e -log-port* "WARN
dce0: 49 4e 47 3a 20 70 61 74 68 20 67 69 76 65 6e 2c ING: path given,
dcf0: 20 22 20 6f 75 74 70 75 74 66 69 6c 65 20 22 20 " outputfile "
dd00: 69 73 20 72 65 6c 61 74 69 76 65 2c 20 70 72 65 is relative, pre
dd10: 66 69 78 69 6e 67 20 77 69 74 68 20 63 75 72 72 fixing with curr
dd20: 65 6e 74 20 64 69 72 65 63 74 6f 72 79 22 29 0a ent directory").
dd30: 09 09 09 09 09 20 28 63 6f 6e 63 20 28 63 75 72 ..... (conc (cur
dd40: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 20 rent-directory)
dd50: 22 2f 22 20 6f 75 74 70 75 74 66 69 6c 65 29 29 "/" outputfile))
dd60: 29 29 29 0a 09 09 20 20 28 63 72 65 61 74 65 2d )))... (create-
dd70: 64 69 72 65 63 74 6f 72 79 20 74 65 6d 70 64 69 directory tempdi
dd80: 72 20 23 74 29 0a 09 09 20 20 28 6f 64 73 3a 6c r #t)... (ods:l
dd90: 69 73 74 2d 3e 6f 64 73 20 74 65 6d 70 64 69 72 ist->ods tempdir
dda0: 20 6f 75 66 20 73 68 65 65 74 73 29 29 29 29 0a ouf sheets)))).
ddb0: 09 20 20 3b 3b 20 28 73 79 73 74 65 6d 20 28 63 . ;; (system (c
ddc0: 6f 6e 63 20 22 72 6d 20 2d 72 66 20 22 20 74 65 onc "rm -rf " te
ddd0: 6d 70 64 69 72 29 29 0a 09 20 20 28 73 65 74 21 mpdir)).. (set!
dde0: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
ddf0: 23 74 29 29 29 29 0a 0a 3b 3b 20 44 6f 6e 27 74 #t))))..;; Don't
de00: 20 74 68 69 6e 6b 20 49 20 6e 65 65 64 20 74 68 think I need th
de10: 69 73 2e 20 49 6e 63 6f 72 70 6f 72 61 74 65 64 is. Incorporated
de20: 20 69 6e 74 6f 20 2d 6c 69 73 74 2d 72 75 6e 73 into -list-runs
de30: 20 69 6e 73 74 65 61 64 0a 3b 3b 0a 3b 3b 20 28 instead.;;.;; (
de40: 69 66 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 if (and (args:ge
de50: 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 22 29 0a t-arg "-since").
de60: 3b 3b 20 09 20 28 6c 61 75 6e 63 68 3a 73 65 74 ;; . (launch:set
de70: 75 70 29 29 0a 3b 3b 20 20 20 20 20 28 6c 65 74 up)).;; (let
de80: 2a 20 28 28 73 69 6e 63 65 2d 74 69 6d 65 20 28 * ((since-time (
de90: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
dea0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
deb0: 69 6e 63 65 22 29 29 29 0a 3b 3b 20 09 20 20 20 ince"))).;; .
dec0: 28 72 75 6e 2d 69 64 73 20 20 20 20 28 64 62 3a (run-ids (db:
ded0: 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 75 6e 2d get-changed-run-
dee0: 69 64 73 20 73 69 6e 63 65 2d 74 69 6d 65 29 29 ids since-time))
def0: 29 0a 3b 3b 20 20 20 20 20 20 20 3b 3b 20 28 72 ).;; ;; (r
df00: 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 mt:get-tests-for
df10: 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 20 72 75 -runs-mindata ru
df20: 6e 2d 69 64 73 20 74 65 73 74 70 61 74 74 20 73 n-ids testpatt s
df30: 74 61 74 65 73 20 73 74 61 74 75 73 20 6e 6f 74 tates status not
df40: 2d 69 6e 29 0a 3b 3b 20 20 20 20 20 20 20 28 70 -in).;; (p
df50: 72 69 6e 74 20 28 73 6f 72 74 20 72 75 6e 2d 69 rint (sort run-i
df60: 64 73 20 3c 29 29 0a 3b 3b 20 20 20 20 20 20 20 ds <)).;;
df70: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
df80: 69 6e 67 2a 20 23 74 29 29 29 0a 20 20 20 20 20 ing* #t))).
df90: 20 0a 20 20 20 20 20 20 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dfe0: 3d 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e 0a 3b 3b =.;; full run.;;
dff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e030: 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 20 6c ======..;; get l
e040: 6f 63 6b 20 69 6e 20 64 62 20 66 6f 72 20 66 75 ock in db for fu
e050: 6c 6c 20 72 75 6e 20 66 6f 72 20 74 68 69 73 20 ll run for this
e060: 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 66 6f 72 directory.;; for
e070: 20 61 6c 6c 20 74 65 73 74 73 20 77 69 74 68 20 all tests with
e080: 64 65 70 73 0a 3b 3b 20 20 20 77 61 6c 6b 20 74 deps.;; walk t
e090: 72 65 65 20 6f 66 20 74 65 73 74 73 20 74 6f 20 ree of tests to
e0a0: 66 69 6e 64 20 68 65 61 64 20 74 61 73 6b 73 0a find head tasks.
e0b0: 3b 3b 20 20 20 61 64 64 20 68 65 61 64 20 74 61 ;; add head ta
e0c0: 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 sks to task queu
e0d0: 65 0a 3b 3b 20 20 20 61 64 64 20 64 65 70 65 6e e.;; add depen
e0e0: 64 61 6e 74 20 74 61 73 6b 73 20 74 6f 20 74 61 dant tasks to ta
e0f0: 73 6b 20 71 75 65 75 65 20 0a 3b 3b 20 20 20 61 sk queue .;; a
e100: 64 64 20 72 65 6d 61 69 6e 69 6e 67 20 74 61 73 dd remaining tas
e110: 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 ks to task queue
e120: 0a 3b 3b 20 66 6f 72 20 65 61 63 68 20 74 61 73 .;; for each tas
e130: 6b 20 69 6e 20 74 61 73 6b 20 71 75 65 75 65 0a k in task queue.
e140: 3b 3b 20 20 20 69 66 20 68 61 76 65 20 61 64 65 ;; if have ade
e150: 71 75 61 74 65 20 72 65 73 6f 75 72 63 65 73 0a quate resources.
e160: 3b 3b 20 20 20 20 20 6c 61 75 6e 63 68 20 74 61 ;; launch ta
e170: 73 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b 20 sk.;; else.;;
e180: 20 20 20 20 70 75 74 20 74 61 73 6b 20 69 6e 20 put task in
e190: 64 65 66 65 72 72 65 64 20 71 75 65 75 65 0a 3b deferred queue.;
e1a0: 3b 20 69 66 20 73 74 69 6c 6c 20 6f 6b 20 74 6f ; if still ok to
e1b0: 20 72 75 6e 20 74 61 73 6b 73 0a 3b 3b 20 20 20 run tasks.;;
e1c0: 70 72 6f 63 65 73 73 20 64 65 66 65 72 72 65 64 process deferred
e1d0: 20 74 61 73 6b 73 20 70 65 72 20 61 62 6f 76 65 tasks per above
e1e0: 20 73 74 65 70 73 0a 0a 3b 3b 20 72 75 6e 20 61 steps..;; run a
e1f0: 6c 6c 20 74 65 73 74 73 20 61 72 65 20 61 72 65 ll tests are are
e200: 20 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 44 20 61 Not COMPLETED a
e210: 6e 64 20 50 41 53 53 20 6f 72 20 43 48 45 43 4b nd PASS or CHECK
e220: 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 .(if (or (args:g
e230: 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 et-arg "-runall"
e240: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
e250: 20 22 2d 72 75 6e 22 29 0a 09 28 61 72 67 73 3a "-run")..(args:
e260: 67 65 74 2d 61 72 67 20 22 2d 72 65 72 75 6e 2d get-arg "-rerun-
e270: 63 6c 65 61 6e 22 29 0a 09 28 61 72 67 73 3a 67 clean")..(args:g
e280: 65 74 2d 61 72 67 20 22 2d 72 65 72 75 6e 2d 61 et-arg "-rerun-a
e290: 6c 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d ll")..(args:get-
e2a0: 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
e2b0: 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 ). (general-r
e2c0: 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d un-call . "-
e2d0: 72 75 6e 61 6c 6c 22 0a 20 20 20 20 20 22 72 75 runall". "ru
e2e0: 6e 20 61 6c 6c 20 74 65 73 74 73 22 0a 20 20 20 n all tests".
e2f0: 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 (lambda (targe
e300: 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
e310: 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 eyvals). (
e320: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
e330: 20 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 22 29 "-rerun-clean")
e340: 20 3b 3b 20 66 69 72 73 74 20 73 65 74 20 73 74 ;; first set st
e350: 61 74 65 73 2f 73 74 61 74 75 73 65 73 20 63 6f ates/statuses co
e360: 72 72 65 63 74 0a 09 20 20 20 28 6c 65 74 20 28 rrect.. (let (
e370: 28 73 74 61 74 65 73 20 20 20 28 6f 72 20 28 63 (states (or (c
e380: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 onfigf:lookup *c
e390: 6f 6e 66 69 67 64 61 74 2a 20 22 76 61 6c 69 64 onfigdat* "valid
e3a0: 76 61 6c 75 65 73 22 20 22 63 6c 65 61 6e 72 65 values" "cleanre
e3b0: 72 75 6e 2d 73 74 61 74 65 73 22 29 0a 09 09 09 run-states")....
e3c0: 20 20 20 20 20 20 20 22 4b 49 4c 4c 52 45 51 2c "KILLREQ,
e3d0: 4b 49 4c 4c 45 44 2c 55 4e 4b 4e 4f 57 4e 2c 49 KILLED,UNKNOWN,I
e3e0: 4e 43 4f 4d 50 4c 45 54 45 2c 53 54 55 43 4b 2c NCOMPLETE,STUCK,
e3f0: 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 29 0a 09 NOT_STARTED"))..
e400: 09 20 28 73 74 61 74 75 73 65 73 20 28 6f 72 20 . (statuses (or
e410: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
e420: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 76 61 6c *configdat* "val
e430: 69 64 76 61 6c 75 65 73 22 20 22 63 6c 65 61 6e idvalues" "clean
e440: 72 65 72 75 6e 2d 73 74 61 74 75 73 65 73 22 29 rerun-statuses")
e450: 0a 09 09 09 20 20 20 20 20 20 20 22 46 41 49 4c .... "FAIL
e460: 2c 49 4e 43 4f 4d 50 4c 45 54 45 2c 41 42 4f 52 ,INCOMPLETE,ABOR
e470: 54 2c 43 48 45 43 4b 22 29 29 29 0a 09 20 20 20 T,CHECK")))..
e480: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
e490: 74 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 t! args:arg-hash
e4a0: 20 22 2d 70 72 65 63 6c 65 61 6e 22 20 23 74 29 "-preclean" #t)
e4b0: 0a 09 20 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 .. (runs:ope
e4c0: 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 rate-on 'set-sta
e4d0: 74 65 2d 73 74 61 74 75 73 0a 09 09 09 20 20 20 te-status....
e4e0: 20 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 20 target....
e4f0: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d (common:args-
e500: 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b get-runname) ;;
e510: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
e520: 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 rg "-runname")(a
e530: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 rgs:get-arg ":ru
e540: 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 20 20 nname"))....
e550: 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e "%" ;; (common
e560: 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 :args-get-testpa
e570: 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 3a tt #f) ;; (args:
e580: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
e590: 74 74 22 29 0a 09 09 09 20 20 20 20 20 20 73 74 tt").... st
e5a0: 61 74 65 3a 20 20 73 74 61 74 65 73 0a 09 09 09 ate: states....
e5b0: 20 20 20 20 20 20 3b 3b 20 73 74 61 74 75 73 3a ;; status:
e5c0: 20 73 74 61 74 75 73 65 73 0a 09 09 09 20 20 20 statuses....
e5d0: 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 new-state-sta
e5e0: 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 tus: "NOT_STARTE
e5f0: 44 2c 6e 2f 61 22 29 0a 09 20 20 20 20 20 28 72 D,n/a").. (r
e600: 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 uns:operate-on '
e610: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
e620: 0a 09 09 09 20 20 20 20 20 20 74 61 72 67 65 74 .... target
e630: 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f .... (commo
e640: 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 n:args-get-runna
e650: 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 me) ;; (or (arg
e660: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
e670: 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 ame")(args:get-a
e680: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a rg ":runname")).
e690: 09 09 09 20 20 20 20 20 20 22 25 22 20 3b 3b 20 ... "%" ;;
e6a0: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
e6b0: 2d 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b -testpatt #f) ;;
e6c0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
e6d0: 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 -testpatt")....
e6e0: 20 20 20 20 20 3b 3b 20 73 74 61 74 65 3a 20 20 ;; state:
e6f0: 73 74 61 74 65 73 0a 09 09 09 20 20 20 20 20 20 states....
e700: 73 74 61 74 75 73 3a 20 73 74 61 74 75 73 65 73 status: statuses
e710: 0a 09 09 09 20 20 20 20 20 20 6e 65 77 2d 73 74 .... new-st
e720: 61 74 65 2d 73 74 61 74 75 73 3a 20 22 4e 4f 54 ate-status: "NOT
e730: 5f 53 54 41 52 54 45 44 2c 6e 2f 61 22 29 29 29 _STARTED,n/a")))
e740: 0a 20 20 20 20 20 20 20 3b 3b 20 52 45 52 55 4e . ;; RERUN
e750: 20 41 4c 4c 0a 20 20 20 20 20 20 20 28 69 66 20 ALL. (if
e760: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
e770: 72 65 72 75 6e 2d 61 6c 6c 22 29 20 3b 3b 20 66 rerun-all") ;; f
e780: 69 72 73 74 20 73 65 74 20 73 74 61 74 65 73 2f irst set states/
e790: 73 74 61 74 75 73 65 73 20 63 6f 72 72 65 63 74 statuses correct
e7a0: 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 .. (begin..
e7b0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
e7c0: 74 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 t! args:arg-hash
e7d0: 20 22 2d 70 72 65 63 6c 65 61 6e 22 20 23 74 29 "-preclean" #t)
e7e0: 0a 09 20 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 .. (runs:ope
e7f0: 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 rate-on 'set-sta
e800: 74 65 2d 73 74 61 74 75 73 0a 09 09 09 20 20 20 te-status....
e810: 20 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 20 target....
e820: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d (common:args-
e830: 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b get-runname) ;;
e840: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
e850: 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 rg "-runname")(a
e860: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 rgs:get-arg ":ru
e870: 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 20 20 nname"))....
e880: 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e "%" ;; (common
e890: 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 :args-get-testpa
e8a0: 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 3a tt #f) ;; (args:
e8b0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
e8c0: 74 74 22 29 0a 09 09 09 20 20 20 20 20 20 73 74 tt").... st
e8d0: 61 74 65 3a 20 20 23 66 0a 09 09 09 20 20 20 20 ate: #f....
e8e0: 20 20 3b 3b 20 73 74 61 74 75 73 3a 20 73 74 61 ;; status: sta
e8f0: 74 75 73 65 73 0a 09 09 09 20 20 20 20 20 20 6e tuses.... n
e900: 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a ew-state-status:
e910: 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f "NOT_STARTED,n/
e920: 61 22 29 0a 09 20 20 20 20 20 28 72 75 6e 73 3a a").. (runs:
e930: 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d operate-on 'set-
e940: 73 74 61 74 65 2d 73 74 61 74 75 73 0a 09 09 09 state-status....
e950: 20 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 target....
e960: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 (common:ar
e970: 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 gs-get-runname)
e980: 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 ;; (or (args:ge
e990: 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
e9a0: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
e9b0: 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 :runname"))....
e9c0: 20 20 20 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d "%" ;; (com
e9d0: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 mon:args-get-tes
e9e0: 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 tpatt #f) ;; (ar
e9f0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
ea00: 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 tpatt")....
ea10: 20 3b 3b 20 73 74 61 74 65 3a 20 20 73 74 61 74 ;; state: stat
ea20: 65 73 0a 09 09 09 20 20 20 20 20 20 73 74 61 74 es.... stat
ea30: 75 73 3a 20 23 66 0a 09 09 09 20 20 20 20 20 20 us: #f....
ea40: 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 new-state-status
ea50: 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e : "NOT_STARTED,n
ea60: 2f 61 22 29 29 29 0a 20 20 20 20 20 20 20 28 72 /a"))). (r
ea70: 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 uns:run-tests ta
ea80: 72 67 65 74 0a 09 09 20 20 20 20 20 20 20 72 75 rget... ru
ea90: 6e 6e 61 6d 65 0a 09 09 20 20 20 20 20 20 20 23 nname... #
eaa0: 66 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 f ;; (common:arg
eab0: 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 s-get-testpatt #
eac0: 66 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 28 f)... ;; (
ead0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
eae0: 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 "-testpatt")...
eaf0: 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 22 25 ;; "%
eb00: 22 29 0a 09 09 20 20 20 20 20 20 20 75 73 65 72 ")... user
eb10: 0a 09 09 20 20 20 20 20 20 20 61 72 67 73 3a 61 ... args:a
eb20: 72 67 2d 68 61 73 68 29 29 29 29 0a 0a 3b 3b 3d rg-hash))))..;;=
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 3d 3d 3d 3d 3d 3d 3d ================
eb70: 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e 20 6f 6e 65 =====.;; run one
eb80: 20 74 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d test.;;========
eb90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ebb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ebc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
ebd0: 3b 3b 20 31 2e 20 66 69 6e 64 20 74 68 65 20 63 ;; 1. find the c
ebe0: 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b 20 32 2e onfig file.;; 2.
ebf0: 20 63 68 61 6e 67 65 20 74 6f 20 74 68 65 20 74 change to the t
ec00: 65 73 74 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b est directory.;;
ec10: 20 33 2e 20 75 70 64 61 74 65 20 74 68 65 20 64 3. update the d
ec20: 62 20 77 69 74 68 20 22 74 65 73 74 20 73 74 61 b with "test sta
ec30: 72 74 65 64 22 20 73 74 61 74 75 73 2c 20 73 65 rted" status, se
ec40: 74 20 72 75 6e 6e 69 6e 67 20 68 6f 73 74 0a 3b t running host.;
ec50: 3b 20 34 2e 20 70 72 6f 63 65 73 73 20 6c 61 75 ; 4. process lau
ec60: 6e 63 68 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 nch the test.;;
ec70: 20 20 20 2d 20 6d 6f 6e 69 74 6f 72 20 74 68 65 - monitor the
ec80: 20 70 72 6f 63 65 73 73 2c 20 75 70 64 61 74 65 process, update
ec90: 20 73 74 61 74 73 20 69 6e 20 74 68 65 20 64 62 stats in the db
eca0: 20 65 76 65 72 79 20 32 5e 6e 20 6d 69 6e 75 74 every 2^n minut
ecb0: 65 73 0a 3b 3b 20 35 2e 20 61 73 20 74 68 65 20 es.;; 5. as the
ecc0: 74 65 73 74 20 70 72 6f 63 65 65 64 73 20 69 6e test proceeds in
ecd0: 74 65 72 6e 61 6c 6c 79 20 69 74 20 63 61 6c 6c ternally it call
ece0: 73 20 6d 65 67 61 74 65 73 74 20 61 73 20 65 61 s megatest as ea
ecf0: 63 68 20 73 74 65 70 20 69 73 0a 3b 3b 20 20 20 ch step is.;;
ed00: 20 73 74 61 72 74 65 64 20 61 6e 64 20 63 6f 6d started and com
ed10: 70 6c 65 74 65 64 0a 3b 3b 20 20 20 20 2d 20 73 pleted.;; - s
ed20: 74 65 70 20 73 74 61 72 74 65 64 2c 20 74 69 6d tep started, tim
ed30: 65 73 74 61 6d 70 0a 3b 3b 20 20 20 20 2d 20 73 estamp.;; - s
ed40: 74 65 70 20 63 6f 6d 70 6c 65 74 65 64 2c 20 65 tep completed, e
ed50: 78 69 74 20 73 74 61 74 75 73 2c 20 74 69 6d 65 xit status, time
ed60: 73 74 61 6d 70 0a 3b 3b 20 36 2e 20 74 65 73 74 stamp.;; 6. test
ed70: 20 70 68 6f 6e 65 20 68 6f 6d 65 0a 3b 3b 20 20 phone home.;;
ed80: 20 20 2d 20 69 66 20 74 65 73 74 20 72 75 6e 20 - if test run
ed90: 74 69 6d 65 20 3e 20 61 6c 6c 6f 77 65 64 20 72 time > allowed r
eda0: 75 6e 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c un time then kil
edb0: 6c 20 6a 6f 62 0a 3b 3b 20 20 20 20 2d 20 69 66 l job.;; - if
edc0: 20 63 61 6e 6e 6f 74 20 61 63 63 65 73 73 20 64 cannot access d
edd0: 62 20 3e 20 61 6c 6c 6f 77 65 64 20 64 69 73 63 b > allowed disc
ede0: 6f 6e 6e 65 63 74 20 74 69 6d 65 20 74 68 65 6e onnect time then
edf0: 20 6b 69 6c 6c 20 6a 6f 62 0a 0a 3b 3b 20 3d 3d kill job..;; ==
ee00: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 28 duplicated == (
ee10: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
ee20: 2d 61 72 67 20 22 2d 72 75 6e 22 29 28 61 72 67 -arg "-run")(arg
ee30: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 s:get-arg "-runt
ee40: 65 73 74 73 22 29 29 0a 3b 3b 20 3d 3d 20 64 75 ests")).;; == du
ee50: 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 28 67 plicated == (g
ee60: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
ee70: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
ee80: 64 20 3d 3d 20 20 20 20 22 2d 72 75 6e 74 65 73 d == "-runtes
ee90: 74 73 22 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 ts" .;; == dupli
eea0: 63 61 74 65 64 20 3d 3d 20 20 20 20 22 72 75 6e cated == "run
eeb0: 20 61 20 74 65 73 74 22 20 0a 3b 3b 20 3d 3d 20 a test" .;; ==
eec0: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
eed0: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
eee0: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
eef0: 79 76 61 6c 73 29 0a 3b 3b 20 3d 3d 20 64 75 70 yvals).;; == dup
ef00: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 licated ==
ef10: 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 ;;.;; == duplica
ef20: 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 4d ted == ;; M
ef30: 61 79 20 6f 72 20 6d 61 79 20 6e 6f 74 20 69 6d ay or may not im
ef40: 70 6c 65 6d 65 6e 74 20 69 74 20 74 68 69 73 20 plement it this
ef50: 77 61 79 20 2e 2e 2e 0a 3b 3b 20 3d 3d 20 64 75 way ....;; == du
ef60: 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 plicated ==
ef70: 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 ;;.;; == duplic
ef80: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 ated == ;;
ef90: 49 6e 73 65 72 74 20 74 68 69 73 20 72 75 6e 20 Insert this run
efa0: 69 6e 74 6f 20 74 68 65 20 74 61 73 6b 73 20 71 into the tasks q
efb0: 75 65 75 65 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 ueue.;; == dupli
efc0: 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b cated == ;;
efd0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
efe0: 20 74 61 73 6b 73 3a 61 64 64 20 74 61 73 6b 73 tasks:add tasks
eff0: 3a 6f 70 65 6e 2d 64 62 20 0a 3b 3b 20 3d 3d 20 :open-db .;; ==
f000: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
f010: 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 22 ;; . "
f020: 72 75 6e 74 65 73 74 73 22 20 0a 3b 3b 20 3d 3d runtests" .;; ==
f030: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
f040: 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 ;; .
f050: 75 73 65 72 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 user.;; == dupli
f060: 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b cated == ;;
f070: 20 20 20 20 09 20 20 20 20 20 74 61 72 67 65 74 . target
f080: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
f090: 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 d == ;;
f0a0: 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a 3b 3b . runname.;;
f0b0: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
f0c0: 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 = ;; .
f0d0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
f0e0: 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 3b 3b "-runtests").;;
f0f0: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
f100: 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 = ;; .
f110: 20 20 20 23 66 29 29 29 29 0a 3b 3b 20 3d 3d 20 #f)))).;; ==
f120: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
f130: 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 (runs:run-tes
f140: 74 73 20 74 61 72 67 65 74 0a 3b 3b 20 3d 3d 20 ts target.;; ==
f150: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 duplicated == ..
f160: 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a 3b 3b 20 runname.;;
f170: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f180: 20 09 09 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a .. (common:
f190: 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 args-get-testpat
f1a0: 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 t #f) ;; (args:g
f1b0: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
f1c0: 73 22 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 s").;; == duplic
f1d0: 61 74 65 64 20 3d 3d 20 09 09 20 20 20 20 20 75 ated == .. u
f1e0: 73 65 72 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 ser.;; == duplic
f1f0: 61 74 65 64 20 3d 3d 20 09 09 20 20 20 20 20 61 ated == .. a
f200: 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 29 rgs:arg-hash))))
f210: 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 6f ==========.;; Ro
f260: 6c 6c 75 70 20 69 6e 74 6f 20 61 20 72 75 6e 0a llup into a run.
f270: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
f280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f2a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f2b0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
f2c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 6f rgs:get-arg "-ro
f2d0: 6c 6c 75 70 22 29 0a 20 20 20 20 28 67 65 6e 65 llup"). (gene
f2e0: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 ral-run-call .
f2f0: 20 20 20 22 2d 72 6f 6c 6c 75 70 22 20 0a 20 20 "-rollup" .
f300: 20 20 20 22 72 6f 6c 6c 75 70 20 74 65 73 74 73 "rollup tests
f310: 22 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 " . (lambda
f320: 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 (target runname
f330: 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 keys keyvals).
f340: 20 20 20 20 20 28 72 75 6e 73 3a 72 6f 6c 6c 75 (runs:rollu
f350: 70 2d 72 75 6e 20 6b 65 79 73 0a 09 09 09 6b 65 p-run keys....ke
f360: 79 76 61 6c 73 0a 09 09 09 28 6f 72 20 28 61 72 yvals....(or (ar
f370: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
f380: 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d name")(args:get-
f390: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 arg ":runname")
f3a0: 29 0a 09 09 09 75 73 65 72 29 29 29 29 0a 0a 3b )....user))))..;
f3b0: 3b 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 3d 3d 3d 3d 0a 3b 3b 20 4c 6f 63 6b 20 =======.;; Lock
f400: 6f 72 20 75 6e 6c 6f 63 6b 20 61 20 72 75 6e 0a or unlock a run.
f410: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
f420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f450: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f ========..(if (o
f460: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
f470: 22 2d 6c 6f 63 6b 22 29 28 61 72 67 73 3a 67 65 "-lock")(args:ge
f480: 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b 22 29 t-arg "-unlock")
f490: 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 ). (general-r
f4a0: 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 28 69 un-call . (i
f4b0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
f4c0: 22 2d 6c 6f 63 6b 22 29 20 22 2d 6c 6f 63 6b 22 "-lock") "-lock"
f4d0: 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 20 20 20 "-unlock").
f4e0: 20 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 20 74 65 "lock/unlock te
f4f0: 73 74 73 22 20 0a 20 20 20 20 20 28 6c 61 6d 62 sts" . (lamb
f500: 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 da (target runna
f510: 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 me keys keyvals)
f520: 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a 68 61 . (runs:ha
f530: 6e 64 6c 65 2d 6c 6f 63 6b 69 6e 67 20 0a 09 09 ndle-locking ...
f540: 20 20 74 61 72 67 65 74 0a 09 09 20 20 6b 65 79 target... key
f550: 73 0a 09 09 20 20 28 6f 72 20 28 61 72 67 73 3a s... (or (args:
f560: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d get-arg "-runnam
f570: 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 e")(args:get-arg
f580: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 29 0a 09 ":runname") )..
f590: 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 . (args:get-arg
f5a0: 20 22 2d 6c 6f 63 6b 22 29 0a 09 09 20 20 28 61 "-lock")... (a
f5b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e rgs:get-arg "-un
f5c0: 6c 6f 63 6b 22 29 0a 09 09 20 20 75 73 65 72 29 lock")... user)
f5d0: 29 29 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
f620: 20 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 Get paths to te
f630: 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d sts.;;==========
f640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
f680: 47 65 74 20 74 65 73 74 20 70 61 74 68 73 20 6d Get test paths m
f690: 61 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 atching target,
f6a0: 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 65 73 runname, and tes
f6b0: 74 70 61 74 74 0a 28 69 66 20 28 6f 72 20 28 61 tpatt.(if (or (a
f6c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
f6d0: 73 74 2d 66 69 6c 65 73 22 29 28 61 72 67 73 3a st-files")(args:
f6e0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 70 get-arg "-test-p
f6f0: 61 74 68 73 22 29 29 0a 20 20 20 20 3b 3b 20 69 aths")). ;; i
f700: 66 20 77 65 20 61 72 65 20 69 6e 20 61 20 74 65 f we are in a te
f710: 73 74 20 75 73 65 20 74 68 65 20 4d 54 5f 43 4d st use the MT_CM
f720: 44 49 4e 46 4f 20 64 61 74 61 0a 20 20 20 20 28 DINFO data. (
f730: 69 66 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 if (getenv "MT_C
f740: 4d 44 49 4e 46 4f 22 29 0a 09 28 6c 65 74 2a 20 MDINFO")..(let*
f750: 28 28 73 74 61 72 74 69 6e 67 64 69 72 20 28 63 ((startingdir (c
f760: 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 urrent-directory
f770: 29 29 0a 09 20 20 20 20 20 20 20 28 63 6d 64 69 )).. (cmdi
f780: 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 nfo (common:re
f790: 61 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e ad-encoded-strin
f7a0: 67 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d g (getenv "MT_CM
f7b0: 44 49 4e 46 4f 22 29 29 29 0a 09 20 20 20 20 20 DINFO")))..
f7c0: 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 73 (transport (as
f7d0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 61 soc/default 'tra
f7e0: 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 nsport cmdinfo))
f7f0: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 61 .. (testpa
f800: 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 th (assoc/defau
f810: 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 6d lt 'testpath cm
f820: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
f830: 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f (test-name (asso
f840: 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d c/default 'test-
f850: 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 name cmdinfo))..
f860: 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 (runscrip
f870: 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
f880: 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 'runscript cmdi
f890: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 nfo)).. (d
f8a0: 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f b-host (assoc/
f8b0: 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 default 'db-host
f8c0: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
f8d0: 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 (run-id
f8e0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
f8f0: 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 run-id cmdinf
f900: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 o)).. (ite
f910: 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 mdat (assoc/de
f920: 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 fault 'itemdat
f930: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
f940: 20 20 20 28 73 74 61 74 65 20 20 20 20 20 28 61 (state (a
f950: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
f960: 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 ate")).. (
f970: 73 74 61 74 75 73 20 20 20 20 28 61 72 67 73 3a status (args:
f980: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 get-arg ":status
f990: 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 61 72 ")).. (tar
f9a0: 67 65 74 20 20 20 20 28 61 72 67 73 3a 67 65 74 get (args:get
f9b0: 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 29 -arg "-target"))
f9c0: 0a 09 20 20 20 20 20 20 20 28 74 6f 70 70 61 74 .. (toppat
f9d0: 68 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 h (assoc/defau
f9e0: 6c 74 20 27 74 6f 70 70 61 74 68 20 20 20 63 6d lt 'toppath cm
f9f0: 64 69 6e 66 6f 29 29 29 0a 09 20 20 28 63 68 61 dinfo))).. (cha
fa00: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f nge-directory to
fa10: 70 70 61 74 68 29 0a 09 20 20 28 69 66 20 28 6e ppath).. (if (n
fa20: 6f 74 20 74 61 72 67 65 74 29 0a 09 20 20 20 20 ot target)..
fa30: 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 (begin...(debu
fa40: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
fa50: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
fa60: 74 2a 20 22 2d 74 61 72 67 65 74 20 69 73 20 72 t* "-target is r
fa70: 65 71 75 69 72 65 64 2e 22 29 0a 09 09 28 65 78 equired.")...(ex
fa80: 69 74 20 31 29 29 29 0a 09 20 20 28 69 66 20 28 it 1))).. (if (
fa90: 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 not (launch:setu
faa0: 70 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 p)).. (begi
fab0: 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 n...(debug:print
fac0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
fad0: 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f port* "Failed to
fae0: 20 73 65 74 75 70 2c 20 67 69 76 69 6e 67 20 75 setup, giving u
faf0: 70 20 6f 6e 20 2d 74 65 73 74 2d 70 61 74 68 73 p on -test-paths
fb00: 20 6f 72 20 2d 74 65 73 74 2d 66 69 6c 65 73 2c or -test-files,
fb10: 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 exiting")...(ex
fb20: 69 74 20 31 29 29 29 0a 09 20 20 28 6c 65 74 2a it 1))).. (let*
fb30: 20 28 28 6b 65 79 73 20 20 20 20 20 28 72 6d 74 ((keys (rmt
fb40: 3a 67 65 74 2d 6b 65 79 73 29 29 0a 09 09 20 3b :get-keys))... ;
fb50: 3b 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 ; db:test-get-pa
fb60: 74 68 73 20 6d 75 73 74 20 6e 6f 74 20 62 65 20 ths must not be
fb70: 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 28 70 run remote... (p
fb80: 61 74 68 73 20 20 20 20 28 74 65 73 74 73 3a 74 aths (tests:t
fb90: 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 est-get-paths-ma
fba0: 74 63 68 69 6e 67 20 6b 65 79 73 20 74 61 72 67 tching keys targ
fbb0: 65 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 et (args:get-arg
fbc0: 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 29 29 "-test-files"))
fbd0: 29 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 )).. (set! *d
fbe0: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
fbf0: 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 .. (for-each
fc00: 28 6c 61 6d 62 64 61 20 28 70 61 74 68 29 0a 09 (lambda (path)..
fc10: 09 09 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a ..(print path)).
fc20: 09 09 20 20 20 20 20 20 70 61 74 68 73 29 29 29 .. paths)))
fc30: 0a 09 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 67 ..;; else do a g
fc40: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a eneral-run-call.
fc50: 09 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 .(general-run-ca
fc60: 6c 6c 20 0a 09 20 22 2d 74 65 73 74 2d 66 69 6c ll .. "-test-fil
fc70: 65 73 22 0a 09 20 22 47 65 74 20 70 61 74 68 73 es".. "Get paths
fc80: 20 74 6f 20 74 65 73 74 22 0a 09 20 28 6c 61 6d to test".. (lam
fc90: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
fca0: 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 ame keys keyvals
fcb0: 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 64 62 ).. (let* ((db
fcc0: 20 20 20 20 20 20 20 23 66 29 0a 09 09 20 20 3b #f)... ;
fcd0: 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d ; DO NOT run rem
fce0: 6f 74 65 0a 09 09 20 20 28 70 61 74 68 73 20 20 ote... (paths
fcf0: 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 67 65 (tests:test-ge
fd00: 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 t-paths-matching
fd10: 20 6b 65 79 73 20 74 61 72 67 65 74 20 28 61 72 keys target (ar
fd20: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
fd30: 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 20 t-files"))))..
fd40: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
fd50: 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 20 mbda (path)....
fd60: 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 (print path))...
fd70: 20 20 20 20 20 20 20 70 61 74 68 73 29 29 29 29 paths))))
fd80: 29 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
fdd0: 41 72 63 68 69 76 65 20 74 65 73 74 73 0a 3b 3b Archive tests.;;
fde0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fdf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fe00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fe10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fe20: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 ======.;; Archiv
fe30: 65 20 74 65 73 74 73 20 6d 61 74 63 68 69 6e 67 e tests matching
fe40: 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 target, runname
fe50: 2c 20 61 6e 64 20 74 65 73 74 70 61 74 74 0a 28 , and testpatt.(
fe60: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
fe70: 20 22 2d 61 72 63 68 69 76 65 22 29 0a 20 20 20 "-archive").
fe80: 20 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 67 65 ;; else do a ge
fe90: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 neral-run-call.
fea0: 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
feb0: 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 61 72 63 call . "-arc
fec0: 68 69 76 65 22 0a 20 20 20 20 20 22 41 72 63 68 hive". "Arch
fed0: 69 76 65 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 ive". (lambd
fee0: 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
fef0: 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a e keys keyvals).
ff00: 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d (operate-
ff10: 6f 6e 20 27 61 72 63 68 69 76 65 29 29 29 29 0a on 'archive)))).
ff20: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
ff30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 45 78 74 =========.;; Ext
ff70: 72 61 63 74 20 61 20 73 70 72 65 61 64 73 68 65 ract a spreadshe
ff80: 65 74 20 66 72 6f 6d 20 74 68 65 20 72 75 6e 73 et from the runs
ff90: 20 64 61 74 61 62 61 73 65 0a 3b 3b 3d 3d 3d 3d database.;;====
ffa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ffb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ffc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ffd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ffe0: 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ==..(if (args:ge
fff0: 74 2d 61 72 67 20 22 2d 65 78 74 72 61 63 74 2d t-arg "-extract-
10000 6f 64 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 ods"). (gener
10010 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 al-run-call.
10020 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 0a "-extract-ods".
10030 20 20 20 20 20 22 4d 61 6b 65 20 6f 64 73 20 73 "Make ods s
10040 70 72 65 61 64 73 68 65 65 74 22 0a 20 20 20 20 preadsheet".
10050 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
10060 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
10070 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6c yvals). (l
10080 65 74 20 28 28 64 62 73 74 72 75 63 74 20 20 20 et ((dbstruct
10090 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 (make-dbr:dbstru
100a0 63 74 20 70 61 74 68 3a 20 2a 74 6f 70 70 61 74 ct path: *toppat
100b0 68 2a 20 6c 6f 63 61 6c 3a 20 23 74 29 29 0a 09 h* local: #t))..
100c0 20 20 20 20 20 28 6f 75 74 70 75 74 66 69 6c 65 (outputfile
100d0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
100e0 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 29 0a -extract-ods")).
100f0 09 20 20 20 20 20 28 72 75 6e 73 70 61 74 74 20 . (runspatt
10100 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d (or (args:get-
10110 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 arg "-runname")(
10120 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 args:get-arg ":r
10130 75 6e 6e 61 6d 65 22 29 29 29 0a 09 20 20 20 20 unname")))..
10140 20 28 70 61 74 68 6d 6f 64 20 20 20 20 28 61 72 (pathmod (ar
10150 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 61 74 gs:get-arg "-pat
10160 68 6d 6f 64 22 29 29 29 0a 09 20 20 20 20 20 3b hmod"))).. ;
10170 3b 20 28 6b 65 79 76 61 6c 61 6c 69 73 74 20 28 ; (keyvalalist (
10180 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 79 73 keys->alist keys
10190 20 22 25 22 29 29 29 0a 09 20 28 64 65 62 75 67 "%"))).. (debug
101a0 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 75 6c :print 2 *defaul
101b0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 78 74 t-log-port* "Ext
101c0 72 61 63 74 20 6f 64 73 2c 20 6f 75 74 70 75 74 ract ods, output
101d0 66 69 6c 65 3a 20 22 20 6f 75 74 70 75 74 66 69 file: " outputfi
101e0 6c 65 20 22 20 72 75 6e 73 70 61 74 74 3a 20 22 le " runspatt: "
101f0 20 72 75 6e 73 70 61 74 74 20 22 20 6b 65 79 76 runspatt " keyv
10200 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 29 0a als: " keyvals).
10210 09 20 28 64 62 3a 65 78 74 72 61 63 74 2d 6f 64 . (db:extract-od
10220 73 2d 66 69 6c 65 20 64 62 73 74 72 75 63 74 20 s-file dbstruct
10230 6f 75 74 70 75 74 66 69 6c 65 20 6b 65 79 76 61 outputfile keyva
10240 6c 73 20 28 69 66 20 72 75 6e 73 70 61 74 74 20 ls (if runspatt
10250 72 75 6e 73 70 61 74 74 20 22 25 22 29 20 70 61 runspatt "%") pa
10260 74 68 6d 6f 64 29 0a 09 20 28 64 62 3a 63 6c 6f thmod).. (db:clo
10270 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 29 se-all dbstruct)
10280 0a 09 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d .. (set! *didsom
10290 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 29 0a ething* #t))))).
102a0 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
102b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
102c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
102d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
102e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 =========.;; exe
102f0 63 75 74 65 20 74 68 65 20 74 65 73 74 0a 3b 3b cute the test.;;
10300 20 20 20 20 2d 20 67 65 74 73 20 63 61 6c 6c 65 - gets calle
10310 64 20 6f 6e 20 72 65 6d 6f 74 65 20 68 6f 73 74 d on remote host
10320 0a 3b 3b 20 20 20 20 2d 20 72 65 63 65 69 76 65 .;; - receive
10330 73 20 69 6e 66 6f 20 66 72 6f 6d 20 74 68 65 20 s info from the
10340 2d 65 78 65 63 75 74 65 20 70 61 72 61 6d 0a 3b -execute param.;
10350 3b 20 20 20 20 2d 20 70 61 73 73 65 73 20 69 6e ; - passes in
10360 66 6f 20 74 6f 20 73 74 65 70 73 20 76 69 61 20 fo to steps via
10370 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 MT_CMDINFO env v
10380 61 72 20 28 66 75 74 75 72 65 20 69 73 20 74 6f ar (future is to
10390 20 75 73 65 20 61 20 64 6f 74 20 66 69 6c 65 29 use a dot file)
103a0 0a 3b 3b 20 20 20 20 2d 20 67 61 74 68 65 72 73 .;; - gathers
103b0 20 68 6f 73 74 20 69 6e 66 6f 20 61 6e 64 20 0a host info and .
103c0 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
103d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
103e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
103f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10400 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
10410 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 rgs:get-arg "-ex
10420 65 63 75 74 65 22 29 0a 20 20 20 20 28 62 65 67 ecute"). (beg
10430 69 6e 0a 20 20 20 20 20 20 28 6c 61 75 6e 63 68 in. (launch
10440 3a 65 78 65 63 75 74 65 20 28 61 72 67 73 3a 67 :execute (args:g
10450 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 65 et-arg "-execute
10460 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ")). (set!
10470 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
10480 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
10490 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
104d0 3b 20 72 65 63 6f 76 65 72 20 66 72 6f 6d 20 61 ; recover from a
104e0 20 74 65 73 74 20 77 68 65 72 65 20 74 68 65 20 test where the
104f0 6d 61 6e 61 67 69 6e 67 20 6d 74 65 73 74 20 77 managing mtest w
10500 61 73 20 6b 69 6c 6c 65 64 20 62 75 74 20 74 68 as killed but th
10510 65 20 75 6e 64 65 72 6c 79 69 6e 67 0a 3b 3b 20 e underlying.;;
10520 70 72 6f 63 65 73 73 20 6d 69 67 68 74 20 73 74 process might st
10530 69 6c 6c 20 62 65 20 73 61 6c 76 61 67 65 61 62 ill be salvageab
10540 6c 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d le.;;===========
10550 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10560 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10570 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10580 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
10590 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
105a0 2d 72 65 63 6f 76 65 72 2d 74 65 73 74 22 29 0a -recover-test").
105b0 20 20 20 20 28 6c 65 74 2a 20 28 28 70 61 72 61 (let* ((para
105c0 6d 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 ms (string-split
105d0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
105e0 2d 72 65 63 6f 76 65 72 2d 74 65 73 74 22 29 20 -recover-test")
105f0 22 2c 22 29 29 29 0a 20 20 20 20 20 20 28 69 66 ","))). (if
10600 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 72 61 (> (length para
10610 6d 73 29 20 31 29 20 3b 3b 20 72 75 6e 2d 69 64 ms) 1) ;; run-id
10620 20 61 6e 64 20 74 65 73 74 2d 69 64 0a 09 20 20 and test-id..
10630 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 28 73 (let ((run-id (s
10640 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 tring->number (c
10650 61 72 20 70 61 72 61 6d 73 29 29 29 0a 09 09 28 ar params)))...(
10660 74 65 73 74 2d 69 64 20 28 73 74 72 69 6e 67 2d test-id (string-
10670 3e 6e 75 6d 62 65 72 20 28 63 61 64 72 20 70 61 >number (cadr pa
10680 72 61 6d 73 29 29 29 29 0a 09 20 20 20 20 28 69 rams)))).. (i
10690 66 20 28 61 6e 64 20 72 75 6e 2d 69 64 20 74 65 f (and run-id te
106a0 73 74 2d 69 64 29 0a 09 09 28 62 65 67 69 6e 0a st-id)...(begin.
106b0 09 09 20 20 28 6c 61 75 6e 63 68 3a 72 65 63 6f .. (launch:reco
106c0 76 65 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 ver-test run-id
106d0 74 65 73 74 2d 69 64 29 0a 09 09 20 20 28 73 65 test-id)... (se
106e0 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
106f0 2a 20 23 74 29 29 0a 09 09 28 62 65 67 69 6e 0a * #t))...(begin.
10700 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
10710 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
10720 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 62 61 64 t-log-port* "bad
10730 20 72 75 6e 2d 69 64 20 6f 72 20 74 65 73 74 2d run-id or test-
10740 69 64 2c 20 6d 75 73 74 20 62 65 20 69 6e 74 65 id, must be inte
10750 67 65 72 73 22 29 0a 09 09 20 20 28 65 78 69 74 gers")... (exit
10760 20 31 29 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 1)))))))..;;===
10770 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10780 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10790 3d 3d 3d 3d 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 0a 3b 3b 20 54 65 73 74 20 63 6f 6d 6d ===.;; Test comm
107c0 61 6e 64 73 20 28 69 2e 65 2e 20 66 6f 72 20 75 ands (i.e. for u
107d0 73 65 20 69 6e 73 69 64 65 20 74 65 73 74 73 29 se inside tests)
107e0 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
107f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10800 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10810 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10820 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
10830 6e 65 20 28 6d 65 67 61 74 65 73 74 3a 73 74 65 ne (megatest:ste
10840 70 20 73 74 65 70 20 73 74 61 74 65 20 73 74 61 p step state sta
10850 74 75 73 20 6c 6f 67 66 69 6c 65 20 6d 73 67 29 tus logfile msg)
10860 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 . (if (not (get
10870 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
10880 29 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a )). (begin.
10890 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 .(debug:print-er
108a0 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
108b0 6f 67 2d 70 6f 72 74 2a 20 22 4d 54 5f 43 4d 44 og-port* "MT_CMD
108c0 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 INFO env var not
108d0 20 73 65 74 2c 20 2d 73 74 65 70 20 6d 75 73 74 set, -step must
108e0 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 be called *insi
108f0 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 69 de* a megatest i
10900 6e 76 6f 6b 65 64 20 65 6e 76 69 72 6f 6e 6d 65 nvoked environme
10910 6e 74 21 22 29 0a 09 28 65 78 69 74 20 35 29 29 nt!")..(exit 5))
10920 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 . (let* ((c
10930 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e mdinfo (common
10940 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 74 :read-encoded-st
10950 72 69 6e 67 20 28 67 65 74 65 6e 76 20 22 4d 54 ring (getenv "MT
10960 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 20 20 _CMDINFO")))..
10970 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 (transport (a
10980 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 ssoc/default 'tr
10990 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 ansport cmdinfo)
109a0 29 0a 09 20 20 20 20 20 28 74 65 73 74 70 61 74 ).. (testpat
109b0 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c h (assoc/defaul
109c0 74 20 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 t 'testpath cmd
109d0 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 info)).. (te
109e0 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 st-name (assoc/d
109f0 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d efault 'test-nam
10a00 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 e cmdinfo))..
10a10 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 (runscript (as
10a20 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
10a30 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 script cmdinfo))
10a40 0a 09 20 20 20 20 20 28 64 62 2d 68 6f 73 74 20 .. (db-host
10a50 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
10a60 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 'db-host cmdi
10a70 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 75 6e nfo)).. (run
10a80 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 -id (assoc/de
10a90 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 fault 'run-id
10aa0 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
10ab0 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 73 73 (test-id (ass
10ac0 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
10ad0 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a -id cmdinfo)).
10ae0 09 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 . (itemdat
10af0 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
10b00 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 'itemdat cmdin
10b10 66 6f 29 29 0a 09 20 20 20 20 20 28 77 6f 72 6b fo)).. (work
10b20 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 65 66 -area (assoc/def
10b30 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 ault 'work-area
10b40 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
10b50 28 64 62 20 20 20 20 20 20 20 20 23 66 29 29 0a (db #f)).
10b60 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f .(change-directo
10b70 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 28 69 ry testpath)..(i
10b80 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
10b90 65 74 75 70 29 29 0a 09 20 20 20 20 28 62 65 67 etup)).. (beg
10ba0 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 in.. (debug
10bb0 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
10bc0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
10bd0 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
10be0 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 20 28 iting").. (
10bf0 65 78 69 74 20 31 29 29 29 0a 09 28 69 66 20 28 exit 1)))..(if (
10c00 61 6e 64 20 73 74 61 74 65 20 73 74 61 74 75 73 and state status
10c10 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 63 6f ).. (let ((co
10c20 6d 6d 65 6e 74 20 28 6c 61 75 6e 63 68 3a 6c 6f mment (launch:lo
10c30 61 64 2d 6c 6f 67 70 72 6f 2d 64 61 74 20 72 75 ad-logpro-dat ru
10c40 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 n-id test-id ste
10c50 70 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 p))).. ;; (
10c60 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 rmt:test-set-log
10c70 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
10c80 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
10c90 22 2e 68 74 6d 6c 22 29 29 29 29 0a 09 20 20 20 ".html"))))..
10ca0 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 65 70 (rmt:teststep
10cb0 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
10cc0 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 -id test-id step
10cd0 20 73 74 61 74 65 20 73 74 61 74 75 73 20 28 6f state status (o
10ce0 72 20 63 6f 6d 6d 65 6e 74 20 6d 73 67 29 20 6c r comment msg) l
10cf0 6f 67 66 69 6c 65 29 29 0a 09 20 20 20 20 28 62 ogfile)).. (b
10d00 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 egin.. (deb
10d10 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
10d20 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
10d30 72 74 2a 20 22 59 6f 75 20 6d 75 73 74 20 73 70 rt* "You must sp
10d40 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 ecify :state and
10d50 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 65 76 :status with ev
10d60 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 73 74 65 ery call to -ste
10d70 70 22 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 p").. (exit
10d80 20 36 29 29 29 29 29 29 0a 0a 28 69 66 20 28 61 6))))))..(if (a
10d90 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
10da0 65 70 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ep"). (begin.
10db0 20 20 20 20 20 20 28 6d 65 67 61 74 65 73 74 3a (megatest:
10dc0 73 74 65 70 20 0a 20 20 20 20 20 20 20 28 61 72 step . (ar
10dd0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 gs:get-arg "-ste
10de0 70 22 29 0a 20 20 20 20 20 20 20 28 6f 72 20 28 p"). (or (
10df0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
10e00 74 61 74 65 22 29 28 61 72 67 73 3a 67 65 74 2d tate")(args:get-
10e10 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a 20 arg ":state")).
10e20 20 20 20 20 20 20 28 6f 72 20 28 61 72 67 73 3a (or (args:
10e30 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 75 73 get-arg "-status
10e40 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
10e50 22 3a 73 74 61 74 75 73 22 29 29 0a 20 20 20 20 ":status")).
10e60 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
10e70 20 22 2d 73 65 74 6c 6f 67 22 29 0a 20 20 20 20 "-setlog").
10e80 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
10e90 20 22 2d 6d 22 29 29 0a 20 20 20 20 20 20 3b 3b "-m")). ;;
10ea0 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 (if db (sqlite3
10eb0 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
10ec0 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
10ed0 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
10ee0 0a 20 20 20 20 0a 28 69 66 20 28 6f 72 20 28 61 . .(if (or (a
10ef0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
10f00 74 6c 6f 67 22 29 20 20 20 20 20 20 20 3b 3b 20 tlog") ;;
10f10 73 69 6e 63 65 20 73 65 74 74 69 6e 67 20 75 70 since setting up
10f20 20 69 73 20 73 6f 20 63 6f 73 74 6c 79 20 6c 65 is so costly le
10f30 74 73 20 70 69 67 67 79 62 61 63 6b 20 6f 6e 20 ts piggyback on
10f40 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 09 3b 3b -test-status..;;
10f50 20 20 20 20 20 28 6e 6f 74 20 28 61 72 67 73 3a (not (args:
10f60 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 get-arg "-step")
10f70 29 29 20 20 3b 3b 20 2d 73 65 74 6c 6f 67 20 6d )) ;; -setlog m
10f80 61 79 20 68 61 76 65 20 62 65 65 6e 20 70 72 6f ay have been pro
10f90 63 65 73 73 65 64 20 61 6c 72 65 61 64 79 20 69 cessed already i
10fa0 6e 20 74 68 65 20 22 2d 73 74 65 70 22 20 70 72 n the "-step" pr
10fb0 65 76 69 6f 75 73 0a 09 3b 3b 20 20 20 20 20 4e evious..;; N
10fc0 45 57 20 50 4f 4c 49 43 59 20 2d 20 2d 73 65 74 EW POLICY - -set
10fd0 6c 6f 67 20 73 65 74 73 20 74 65 73 74 20 6f 76 log sets test ov
10fe0 65 72 61 6c 6c 20 6c 6f 67 20 6f 6e 20 65 76 65 erall log on eve
10ff0 72 79 20 63 61 6c 6c 2e 0a 09 28 61 72 67 73 3a ry call...(args:
11000 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f get-arg "-set-to
11010 70 6c 6f 67 22 29 0a 09 28 61 72 67 73 3a 67 65 plog")..(args:ge
11020 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 t-arg "-test-sta
11030 74 75 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 tus")..(args:get
11040 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 -arg "-set-value
11050 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 s")..(args:get-a
11060 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 rg "-load-test-d
11070 61 74 61 22 29 0a 09 28 61 72 67 73 3a 67 65 74 ata")..(args:get
11080 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 -arg "-runstep")
11090 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
110a0 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d "-summarize-item
110b0 73 22 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f s")). (if (no
110c0 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d t (getenv "MT_CM
110d0 44 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e DINFO"))..(begin
110e0 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
110f0 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
11100 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 54 5f t-log-port* "MT_
11110 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 CMDINFO env var
11120 6e 6f 74 20 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 not set, command
11130 73 20 2d 74 65 73 74 2d 73 74 61 74 75 73 2c 20 s -test-status,
11140 2d 72 75 6e 73 74 65 70 20 61 6e 64 20 2d 73 65 -runstep and -se
11150 74 6c 6f 67 20 6d 75 73 74 20 62 65 20 63 61 6c tlog must be cal
11160 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d led *inside* a m
11170 65 67 61 74 65 73 74 20 65 6e 76 69 72 6f 6e 6d egatest environm
11180 65 6e 74 21 22 29 0a 09 20 20 28 65 78 69 74 20 ent!").. (exit
11190 35 29 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 5))..(let* ((sta
111a0 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 65 6e rtingdir (curren
111b0 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 20 t-directory))..
111c0 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 (cmdinfo
111d0 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e (common:read-en
111e0 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 67 65 coded-string (ge
111f0 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
11200 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 72 "))).. (tr
11210 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f 64 ansport (assoc/d
11220 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f 72 efault 'transpor
11230 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
11240 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 (testpath (
11250 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
11260 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
11270 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
11280 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 -name (assoc/def
11290 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 ault 'test-name
112a0 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
112b0 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 (runscript (as
112c0 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
112d0 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 script cmdinfo))
112e0 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 .. (db-hos
112f0 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
11300 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d lt 'db-host cm
11310 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
11320 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f (run-id (asso
11330 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 c/default 'run-i
11340 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 d cmdinfo))..
11350 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 (test-id
11360 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
11370 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 'test-id cmdi
11380 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 nfo)).. (i
11390 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f temdat (assoc/
113a0 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 default 'itemdat
113b0 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
113c0 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 (work-area
113d0 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
113e0 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 66 work-area cmdinf
113f0 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 20 o)).. (db
11400 20 20 20 20 20 20 20 23 66 29 20 3b 3b 20 28 6f #f) ;; (o
11410 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 20 20 pen-db))..
11420 20 28 73 74 61 74 65 20 20 20 20 20 28 61 72 67 (state (arg
11430 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
11440 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 e")).. (st
11450 61 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 atus (args:ge
11460 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 t-arg ":status")
11470 29 0a 09 20 20 20 20 20 20 20 28 73 74 65 70 6e ).. (stepn
11480 61 6d 65 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ame (args:get-a
11490 72 67 20 22 2d 73 74 65 70 22 29 29 29 0a 09 20 rg "-step")))..
114a0 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 (if (not (launc
114b0 68 3a 73 65 74 75 70 29 29 0a 09 20 20 20 20 20 h:setup))..
114c0 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
114d0 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
114e0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
114f0 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
11500 69 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 iting")...(exit
11510 31 29 29 29 0a 0a 09 20 20 28 69 66 20 28 61 72 1)))... (if (ar
11520 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
11530 73 74 65 70 22 29 28 64 65 62 75 67 3a 70 72 69 step")(debug:pri
11540 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 nt-info 1 *defau
11550 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 75 lt-log-port* "Ru
11560 6e 6e 69 6e 67 20 2d 72 75 6e 73 74 65 70 2c 20 nning -runstep,
11570 66 69 72 73 74 20 63 68 61 6e 67 65 20 74 6f 20 first change to
11580 64 69 72 65 63 74 6f 72 79 20 22 20 77 6f 72 6b directory " work
11590 2d 61 72 65 61 29 29 0a 09 20 20 28 63 68 61 6e -area)).. (chan
115a0 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 ge-directory wor
115b0 6b 2d 61 72 65 61 29 0a 09 20 20 3b 3b 20 63 61 k-area).. ;; ca
115c0 6e 20 73 65 74 75 70 20 61 73 20 63 6c 69 65 6e n setup as clien
115d0 74 20 66 6f 72 20 73 65 72 76 65 72 20 6d 6f 64 t for server mod
115e0 65 20 6e 6f 77 0a 09 20 20 3b 3b 20 28 63 6c 69 e now.. ;; (cli
115f0 65 6e 74 3a 73 65 74 75 70 29 0a 0a 09 20 20 28 ent:setup)... (
11600 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
11610 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 "-load-test-dat
11620 61 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 68 61 a").. ;; ha
11630 73 20 73 75 62 20 63 6f 6d 6d 61 6e 64 73 20 74 s sub commands t
11640 68 61 74 20 61 72 65 20 72 64 62 3a 0a 09 20 20 hat are rdb:..
11650 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 70 75 ;; DO NOT pu
11660 74 20 74 68 69 73 20 6f 6e 65 20 69 6e 74 6f 20 t this one into
11670 65 69 74 68 65 72 20 72 6d 74 3a 20 6f 72 20 6f either rmt: or o
11680 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 0a 09 20 pen-run-close..
11690 20 20 20 20 20 28 74 64 62 3a 6c 6f 61 64 2d 74 (tdb:load-t
116a0 65 73 74 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 est-data run-id
116b0 74 65 73 74 2d 69 64 29 29 0a 09 20 20 28 69 66 test-id)).. (if
116c0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
116d0 2d 73 65 74 6c 6f 67 22 29 0a 09 20 20 20 20 20 -setlog")..
116e0 20 28 6c 65 74 20 28 28 6c 6f 67 66 6e 61 6d 65 (let ((logfname
116f0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
11700 2d 73 65 74 6c 6f 67 22 29 29 29 0a 09 09 28 72 -setlog")))...(r
11710 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 mt:test-set-log!
11720 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
11730 6c 6f 67 66 6e 61 6d 65 29 29 29 0a 09 20 20 28 logfname))).. (
11740 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
11750 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a "-set-toplog").
11760 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 . ;; DO NOT
11770 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 run remote..
11780 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 (tests:test-s
11790 65 74 2d 74 6f 70 6c 6f 67 21 20 72 75 6e 2d 69 et-toplog! run-i
117a0 64 20 74 65 73 74 2d 6e 61 6d 65 20 28 61 72 67 d test-name (arg
117b0 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
117c0 74 6f 70 6c 6f 67 22 29 29 29 0a 09 20 20 28 69 toplog"))).. (i
117d0 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
117e0 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d "-summarize-item
117f0 73 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 44 4f s").. ;; DO
11800 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a NOT run remote.
11810 09 20 20 20 20 20 20 28 74 65 73 74 73 3a 73 75 . (tests:su
11820 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 72 75 mmarize-items ru
11830 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 n-id test-id tes
11840 74 2d 6e 61 6d 65 20 23 74 29 29 20 3b 3b 20 64 t-name #t)) ;; d
11850 6f 20 66 6f 72 63 65 20 68 65 72 65 0a 09 20 20 o force here..
11860 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
11870 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 20 g "-runstep")..
11880 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
11890 72 65 6d 61 72 67 73 29 0a 09 09 20 20 28 62 65 remargs)... (be
118a0 67 69 6e 0a 09 09 20 20 20 20 28 64 65 62 75 67 gin... (debug
118b0 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
118c0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
118d0 2a 20 22 6e 6f 74 68 69 6e 67 20 73 70 65 63 69 * "nothing speci
118e0 66 69 65 64 20 74 6f 20 72 75 6e 21 22 29 0a 09 fied to run!")..
118f0 09 20 20 20 20 28 69 66 20 64 62 20 28 73 71 6c . (if db (sql
11900 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
11910 62 29 29 0a 09 09 20 20 20 20 28 65 78 69 74 20 b))... (exit
11920 36 29 29 0a 09 09 20 20 28 6c 65 74 2a 20 28 28 6))... (let* ((
11930 73 74 65 70 6e 61 6d 65 20 20 20 28 61 72 67 73 stepname (args
11940 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 :get-arg "-runst
11950 65 70 22 29 29 0a 09 09 09 20 28 6c 6f 67 70 72 ep")).... (logpr
11960 6f 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d ofile (args:get-
11970 61 72 67 20 22 2d 6c 6f 67 70 72 6f 22 29 29 0a arg "-logpro")).
11980 09 09 09 20 28 6c 6f 67 66 69 6c 65 20 20 20 20 ... (logfile
11990 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 (conc stepname "
119a0 2e 6c 6f 67 22 29 29 0a 09 09 09 20 28 63 6d 64 .log")).... (cmd
119b0 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c (if (nul
119c0 6c 3f 20 72 65 6d 61 72 67 73 29 20 23 66 20 28 l? remargs) #f (
119d0 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 0a 09 car remargs)))..
119e0 09 09 20 28 70 61 72 61 6d 73 20 20 20 20 20 28 .. (params (
119f0 69 66 20 63 6d 64 20 28 63 64 72 20 72 65 6d 61 if cmd (cdr rema
11a00 72 67 73 29 20 27 28 29 29 29 0a 09 09 09 20 28 rgs) '())).... (
11a10 65 78 69 74 73 74 61 74 20 20 20 23 66 29 0a 09 exitstat #f)..
11a20 09 09 20 28 73 68 65 6c 6c 20 20 20 20 20 20 28 .. (shell (
11a30 6c 65 74 20 28 28 73 68 20 28 67 65 74 2d 65 6e let ((sh (get-en
11a40 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
11a50 6c 65 20 22 53 48 45 4c 4c 22 29 20 29 29 0a 09 le "SHELL") ))..
11a60 09 09 09 20 20 20 20 20 20 20 28 69 66 20 73 68 ... (if sh
11a70 20 0a 09 09 09 09 09 20 20 20 28 6c 61 73 74 20 ...... (last
11a80 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 73 68 (string-split sh
11a90 20 22 2f 22 29 29 0a 09 09 09 09 09 20 20 20 22 "/"))...... "
11aa0 62 61 73 68 22 29 29 29 0a 09 09 09 20 28 72 65 bash"))).... (re
11ab0 64 69 72 20 20 20 20 20 20 28 63 61 73 65 20 28 dir (case (
11ac0 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 string->symbol s
11ad0 68 65 6c 6c 29 0a 09 09 09 09 20 20 20 20 20 20 hell).....
11ae0 20 28 28 74 63 73 68 20 63 73 68 20 6b 73 68 29 ((tcsh csh ksh)
11af0 20 20 20 20 22 3e 26 22 29 0a 09 09 09 09 20 20 ">&").....
11b00 20 20 20 20 20 28 28 7a 73 68 20 62 61 73 68 20 ((zsh bash
11b10 73 68 20 61 73 68 29 20 22 32 3e 26 31 20 3e 22 sh ash) "2>&1 >"
11b20 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 65 6c )..... (el
11b30 73 65 20 22 3e 26 22 29 29 29 0a 09 09 09 20 28 se ">&"))).... (
11b40 66 75 6c 6c 63 6d 64 20 20 20 20 28 63 6f 6e 63 fullcmd (conc
11b50 20 22 28 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 "(" (string-int
11b60 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 09 09 ersperse .......
11b70 28 63 6f 6e 73 20 63 6d 64 20 70 61 72 61 6d 73 (cons cmd params
11b80 29 20 22 20 22 29 0a 09 09 09 09 09 20 20 20 22 ) " ")...... "
11b90 29 20 22 20 72 65 64 69 72 20 22 20 22 20 6c 6f ) " redir " " lo
11ba0 67 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 3b gfile)))... ;
11bb0 3b 20 6d 61 72 6b 20 74 68 65 20 73 74 61 72 74 ; mark the start
11bc0 20 6f 66 20 74 68 65 20 74 65 73 74 0a 09 09 20 of the test...
11bd0 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 65 70 (rmt:teststep
11be0 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
11bf0 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 -id test-id step
11c00 6e 61 6d 65 20 22 73 74 61 72 74 22 20 22 6e 2f name "start" "n/
11c10 61 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 a" (args:get-arg
11c20 20 22 2d 6d 22 29 20 6c 6f 67 66 69 6c 65 29 0a "-m") logfile).
11c30 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 74 68 65 .. ;; run the
11c40 20 74 65 73 74 20 73 74 65 70 0a 09 09 20 20 20 test step...
11c50 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
11c60 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 2 *default-lo
11c70 67 2d 70 6f 72 74 2a 20 22 52 75 6e 6e 69 6e 67 g-port* "Running
11c80 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 5c 22 \"" fullcmd "\"
11c90 20 69 6e 20 64 69 72 65 63 74 6f 72 79 20 5c 22 in directory \"
11ca0 22 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 " startingdir)..
11cb0 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 . (change-dir
11cc0 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 64 ectory startingd
11cd0 69 72 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 ir)... (set!
11ce0 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65 6d exitstat (system
11cf0 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 20 20 20 fullcmd))...
11d00 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 (set! *globalex
11d10 69 74 73 74 61 74 75 73 2a 20 65 78 69 74 73 74 itstatus* exitst
11d20 61 74 29 0a 09 09 20 20 20 20 3b 3b 20 28 63 68 at)... ;; (ch
11d30 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
11d40 65 73 74 70 61 74 68 29 0a 09 09 20 20 20 20 3b estpath)... ;
11d50 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 66 20 ; run logpro if
11d60 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b 20 28 70 applicable ;; (p
11d70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c 73 22 20 rocess-run "ls"
11d80 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20 22 32 3e (list "/foo" "2>
11d90 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67 22 29 29 &1" "blah.log"))
11da0 0a 09 09 20 20 20 20 28 69 66 20 6c 6f 67 70 72 ... (if logpr
11db0 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74 2a 20 28 ofile....(let* (
11dc0 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 28 63 6f (htmllogfile (co
11dd0 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 nc stepname ".ht
11de0 6d 6c 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 ml"))....
11df0 28 6f 6c 64 65 78 69 74 73 74 61 74 20 65 78 69 (oldexitstat exi
11e00 74 73 74 61 74 29 0a 09 09 09 20 20 20 20 20 20 tstat)....
11e10 20 28 63 6d 64 20 20 20 20 20 20 20 20 20 28 73 (cmd (s
11e20 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
11e30 65 20 28 6c 69 73 74 20 22 6c 6f 67 70 72 6f 22 e (list "logpro"
11e40 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68 74 6d 6c logprofile html
11e50 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c 6f 67 66 logfile "<" logf
11e60 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63 20 73 74 ile ">" (conc st
11e70 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70 72 6f 2e epname "_logpro.
11e80 6c 6f 67 22 29 29 20 22 20 22 29 29 29 0a 09 09 log")) " ")))...
11e90 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
11ea0 69 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d info 2 *default-
11eb0 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 75 6e 6e 69 log-port* "runni
11ec0 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 29 ng \"" cmd "\"")
11ed0 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 .... (change-di
11ee0 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 rectory starting
11ef0 64 69 72 29 0a 09 09 09 20 20 28 73 65 74 21 20 dir).... (set!
11f00 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65 6d exitstat (system
11f10 20 63 6d 64 29 29 0a 09 09 09 20 20 28 73 65 74 cmd)).... (set
11f20 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 ! *globalexitsta
11f30 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 20 3b tus* exitstat) ;
11f40 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 0a 09 ; no necessary..
11f50 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 .. (change-dire
11f60 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a ctory testpath).
11f70 09 09 09 20 20 28 72 6d 74 3a 74 65 73 74 2d 73 ... (rmt:test-s
11f80 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 et-log! run-id t
11f90 65 73 74 2d 69 64 20 68 74 6d 6c 6c 6f 67 66 69 est-id htmllogfi
11fa0 6c 65 29 29 29 0a 09 09 20 20 20 20 28 6c 65 74 le)))... (let
11fb0 20 28 28 6d 73 67 20 28 61 72 67 73 3a 67 65 74 ((msg (args:get
11fc0 2d 61 72 67 20 22 2d 6d 22 29 29 29 0a 09 09 20 -arg "-m")))...
11fd0 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 (rmt:testst
11fe0 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 ep-set-status! r
11ff0 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 un-id test-id st
12000 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 78 69 epname "end" exi
12010 74 73 74 61 74 20 6d 73 67 20 6c 6f 67 66 69 6c tstat msg logfil
12020 65 29 29 0a 09 09 20 20 20 20 29 29 29 0a 09 20 e))... )))..
12030 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 (if (or (args:g
12040 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 et-arg "-test-st
12050 61 74 75 73 22 29 0a 09 09 20 20 28 61 72 67 73 atus")... (args
12060 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 :get-arg "-set-v
12070 61 6c 75 65 73 22 29 29 0a 09 20 20 20 20 20 20 alues"))..
12080 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 75 73 (let ((newstatus
12090 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e 75 6d (cond.....((num
120a0 62 65 72 3f 20 73 74 61 74 75 73 29 20 20 20 20 ber? status)
120b0 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 (if (equal? s
120c0 74 61 74 75 73 20 30 29 20 22 50 41 53 53 22 20 tatus 0) "PASS"
120d0 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 28 61 "FAIL")).....((a
120e0 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 74 61 74 nd (string? stat
120f0 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 28 73 us)..... (s
12100 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 tring->number st
12110 61 74 75 73 29 29 28 69 66 20 28 65 71 75 61 6c atus))(if (equal
12120 3f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 ? (string->numbe
12130 72 20 73 74 61 74 75 73 29 20 30 29 20 22 50 41 r status) 0) "PA
12140 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 09 09 SS" "FAIL"))....
12150 09 28 65 6c 73 65 20 73 74 61 74 75 73 29 29 29 .(else status)))
12160 0a 09 09 20 20 20 20 3b 3b 20 74 72 61 6e 73 66 ... ;; transf
12170 65 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 79 73 er relevant keys
12180 20 69 6e 74 6f 20 61 20 68 61 73 68 20 74 6f 20 into a hash to
12190 62 65 20 70 61 73 73 65 64 20 74 6f 20 74 65 73 be passed to tes
121a0 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a 09 09 t-set-status!...
121b0 20 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 73 65 ;; could use
121c0 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 20 49 an assoc list I
121d0 20 67 75 65 73 73 2e 20 0a 09 09 20 20 20 20 28 guess. ... (
121e0 6f 74 68 65 72 64 61 74 61 20 28 6c 65 74 20 28 otherdata (let (
121f0 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d (res (make-hash-
12200 74 61 62 6c 65 29 29 29 0a 09 09 09 09 20 28 66 table)))..... (f
12210 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
12220 28 6b 65 79 29 0a 09 09 09 09 09 20 20 20 20 20 (key)......
12230 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
12240 67 20 6b 65 79 29 0a 09 09 09 09 09 09 20 28 68 g key)....... (h
12250 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 ash-table-set! r
12260 65 73 20 6b 65 79 20 28 61 72 67 73 3a 67 65 74 es key (args:get
12270 2d 61 72 67 20 6b 65 79 29 29 29 29 0a 09 09 09 -arg key))))....
12280 09 09 20 20 20 28 6c 69 73 74 20 22 3a 76 61 6c .. (list ":val
12290 75 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 78 70 ue" ":tol" ":exp
122a0 65 63 74 65 64 22 20 22 3a 66 69 72 73 74 5f 65 ected" ":first_e
122b0 72 72 22 20 22 3a 66 69 72 73 74 5f 77 61 72 6e rr" ":first_warn
122c0 22 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 61 74 " ":units" ":cat
122d0 65 67 6f 72 79 22 20 22 3a 76 61 72 69 61 62 6c egory" ":variabl
122e0 65 22 29 29 0a 09 09 09 09 20 72 65 73 29 29 29 e"))..... res)))
122f0 0a 09 09 28 69 66 20 28 61 6e 64 20 28 61 72 67 ...(if (and (arg
12300 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
12310 2d 73 74 61 74 75 73 22 29 0a 09 09 09 20 28 6f -status").... (o
12320 72 20 28 6e 6f 74 20 73 74 61 74 65 29 0a 09 09 r (not state)...
12330 09 20 20 20 20 20 28 6e 6f 74 20 73 74 61 74 75 . (not statu
12340 73 29 29 29 0a 09 09 20 20 20 20 28 62 65 67 69 s)))... (begi
12350 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 67 n... (debug
12360 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
12370 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
12380 2a 20 22 59 6f 75 20 6d 75 73 74 20 73 70 65 63 * "You must spec
12390 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a ify :state and :
123a0 73 74 61 74 75 73 20 77 69 74 68 20 65 76 65 72 status with ever
123b0 79 20 63 61 6c 6c 20 74 6f 20 2d 74 65 73 74 2d y call to -test-
123c0 73 74 61 74 75 73 5c 6e 22 20 68 65 6c 70 29 0a status\n" help).
123d0 09 09 20 20 20 20 20 20 28 69 66 20 28 73 71 6c .. (if (sql
123e0 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 64 ite3:database? d
123f0 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c b)(sqlite3:final
12400 69 7a 65 21 20 64 62 29 29 0a 09 09 20 20 20 20 ize! db))...
12410 20 20 28 65 78 69 74 20 36 29 29 29 0a 09 09 28 (exit 6)))...(
12420 6c 65 74 2a 20 28 28 6d 73 67 20 20 20 20 28 61 let* ((msg (a
12430 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
12440 29 29 0a 09 09 20 20 20 20 20 20 20 28 6e 75 6d ))... (num
12450 6f 74 68 20 28 6c 65 6e 67 74 68 20 28 68 61 73 oth (length (has
12460 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 6f 74 68 h-table-keys oth
12470 65 72 64 61 74 61 29 29 29 29 0a 09 09 20 20 3b erdata))))... ;
12480 3b 20 43 6f 6e 76 65 72 74 20 74 6f 20 72 70 63 ; Convert to rpc
12490 20 69 6e 73 69 64 65 20 74 68 65 20 74 65 73 74 inside the test
124a0 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
124b0 73 21 20 63 61 6c 6c 2c 20 6e 6f 74 20 68 65 72 s! call, not her
124c0 65 0a 09 09 20 20 28 74 65 73 74 73 3a 74 65 73 e... (tests:tes
124d0 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 t-set-status! ru
124e0 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 61 n-id test-id sta
124f0 74 65 20 6e 65 77 73 74 61 74 75 73 20 6d 73 67 te newstatus msg
12500 20 6f 74 68 65 72 64 61 74 61 20 77 6f 72 6b 2d otherdata work-
12510 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 61 29 area: work-area)
12520 29 29 29 0a 09 20 20 28 69 66 20 28 73 71 6c 69 ))).. (if (sqli
12530 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 64 62 te3:database? db
12540 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 )(sqlite3:finali
12550 7a 65 21 20 64 62 29 29 0a 09 20 20 28 73 65 74 ze! db)).. (set
12560 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
12570 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d #t))))..;;=====
12580 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 56 61 72 69 6f 75 73 20 68 65 6c =.;; Various hel
125d0 70 65 72 20 63 6f 6d 6d 61 6e 64 73 20 63 61 6e per commands can
125e0 20 67 6f 20 62 65 6c 6f 77 20 68 65 72 65 0a 3b go below here.;
125f0 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
12600 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12610 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12620 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12630 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 =======..(if (or
12640 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
12650 2d 73 68 6f 77 6b 65 79 73 22 29 0a 20 20 20 20 -showkeys").
12660 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
12670 67 20 22 2d 73 68 6f 77 2d 6b 65 79 73 22 29 29 g "-show-keys"))
12680 0a 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 23 . (let ((db #
12690 66 29 0a 09 20 20 28 6b 65 79 73 20 23 66 29 29 f).. (keys #f))
126a0 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
126b0 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
126c0 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
126d0 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
126e0 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
126f0 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
12700 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 p, exiting")..
12710 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 (exit 1))).
12720 20 20 20 28 73 65 74 21 20 6b 65 79 73 20 28 72 (set! keys (r
12730 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 20 3b 3b mt:get-keys)) ;;
12740 20 20 64 62 29 29 0a 20 20 20 20 20 20 28 64 65 db)). (de
12750 62 75 67 3a 70 72 69 6e 74 20 31 20 2a 64 65 66 bug:print 1 *def
12760 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
12770 4b 65 79 73 3a 20 22 20 28 73 74 72 69 6e 67 2d Keys: " (string-
12780 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 73 intersperse keys
12790 20 22 2c 20 22 29 29 0a 20 20 20 20 20 20 28 69 ", ")). (i
127a0 66 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 62 f (sqlite3:datab
127b0 61 73 65 3f 20 64 62 29 28 73 71 6c 69 74 65 33 ase? db)(sqlite3
127c0 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
127d0 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
127e0 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
127f0 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
12800 61 72 67 20 22 2d 67 75 69 22 29 0a 20 20 20 20 arg "-gui").
12810 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 64 65 (begin. (de
12820 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
12830 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
12840 4c 6f 6f 6b 20 61 74 20 74 68 65 20 64 61 73 68 Look at the dash
12850 62 6f 61 72 64 20 66 6f 72 20 6e 6f 77 22 29 0a board for now").
12860 20 20 20 20 20 20 3b 3b 20 28 6d 65 67 61 74 65 ;; (megate
12870 73 74 2d 67 75 69 29 0a 20 20 20 20 20 20 28 73 st-gui). (s
12880 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
12890 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
128a0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 72 rgs:get-arg "-cr
128b0 65 61 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 72 eate-megatest-ar
128c0 65 61 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ea"). (begin.
128d0 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c (genexampl
128e0 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2e 63 6f e:mk-megatest.co
128f0 6e 66 69 67 29 0a 20 20 20 20 20 20 28 73 65 74 nfig). (set
12900 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
12910 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
12920 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 72 65 61 s:get-arg "-crea
12930 74 65 2d 74 65 73 74 22 29 0a 20 20 20 20 28 6c te-test"). (l
12940 65 74 20 28 28 74 65 73 74 6e 61 6d 65 20 28 61 et ((testname (a
12950 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 72 rgs:get-arg "-cr
12960 65 61 74 65 2d 74 65 73 74 22 29 29 29 0a 20 20 eate-test"))).
12970 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 3a (genexample:
12980 6d 6b 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 mk-megatest-test
12990 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 20 20 20 testname).
129a0 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
129b0 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d hing* #t)))..;;=
129c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
129d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
129e0 3d 3d 3d 3d 3d 3d 3d 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 0a 3b 3b 20 55 70 64 61 74 65 20 =====.;; Update
12a10 74 68 65 20 64 61 74 61 62 61 73 65 20 73 63 68 the database sch
12a20 65 6d 61 2c 20 63 6c 65 61 6e 20 75 70 20 74 68 ema, clean up th
12a30 65 20 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d e db.;;=========
12a40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
12a80 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
12a90 20 22 2d 72 65 62 75 69 6c 64 2d 64 62 22 29 0a "-rebuild-db").
12aa0 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
12ab0 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 (if (not (launc
12ac0 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 65 h:setup)).. (be
12ad0 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a gin.. (debug:
12ae0 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
12af0 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c -log-port* "Fail
12b00 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
12b10 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 78 ting") .. (ex
12b20 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 3b 3b it 1))). ;;
12b30 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c keep this one l
12b40 6f 63 61 6c 0a 20 20 20 20 20 20 28 6f 70 65 6e ocal. (open
12b50 2d 72 75 6e 2d 63 6c 6f 73 65 20 70 61 74 63 68 -run-close patch
12b60 2d 64 62 20 23 66 29 0a 20 20 20 20 20 20 28 73 -db #f). (s
12b70 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
12b80 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
12b90 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6c rgs:get-arg "-cl
12ba0 65 61 6e 75 70 2d 64 62 22 29 0a 20 20 20 20 28 eanup-db"). (
12bb0 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 begin. (if
12bc0 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 (not (launch:set
12bd0 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 up)).. (begin..
12be0 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
12bf0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
12c00 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f port* "Failed to
12c10 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
12c20 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ) .. (exit 1)
12c30 29 29 0a 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e )). (common
12c40 3a 63 6c 65 61 6e 75 70 2d 64 62 29 0a 20 20 20 :cleanup-db).
12c50 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
12c60 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 ething* #t)))..(
12c70 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
12c80 20 22 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 "-mark-incomple
12c90 74 65 73 22 29 0a 20 20 20 20 28 62 65 67 69 6e tes"). (begin
12ca0 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
12cb0 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
12cc0 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
12cd0 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
12ce0 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
12cf0 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
12d00 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 p, exiting")..
12d10 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 (exit 1))).
12d20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f (open-run-clo
12d30 73 65 20 64 62 3a 66 69 6e 64 2d 61 6e 64 2d 6d se db:find-and-m
12d40 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 20 23 ark-incomplete #
12d50 66 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a f). (set! *
12d60 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
12d70 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
12d80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12d90 3d 3d 3d 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 0a 3b 3b =============.;;
12dc0 20 55 70 64 61 74 65 20 74 68 65 20 74 65 73 74 Update the test
12dd0 73 20 6d 65 74 61 20 64 61 74 61 20 66 72 6f 6d s meta data from
12de0 20 74 68 65 20 74 65 73 74 63 6f 6e 66 69 67 20 the testconfig
12df0 66 69 6c 65 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d files.;;========
12e00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
12e40 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
12e50 67 20 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 22 g "-update-meta"
12e60 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
12e70 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 (if (not (lau
12e80 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 nch:setup)).. (
12e90 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 begin.. (debu
12ea0 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
12eb0 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 lt-log-port* "Fa
12ec0 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 iled to setup, e
12ed0 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 xiting") .. (
12ee0 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 exit 1))).
12ef0 3b 3b 20 6e 6f 77 20 63 61 6e 20 66 69 6e 64 20 ;; now can find
12f00 6f 75 72 20 64 62 0a 20 20 20 20 20 20 3b 3b 20 our db. ;;
12f10 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c 6f keep this one lo
12f20 63 61 6c 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d cal. (open-
12f30 72 75 6e 2d 63 6c 6f 73 65 20 72 75 6e 73 3a 75 run-close runs:u
12f40 70 64 61 74 65 2d 61 6c 6c 2d 74 65 73 74 5f 6d pdate-all-test_m
12f50 65 74 61 20 23 66 29 0a 20 20 20 20 20 20 28 73 eta #f). (s
12f60 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
12f70 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d g* #t)))..;;====
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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12fc0 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 61 20 72 65 ==.;; Start a re
12fd0 70 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d pl.;;===========
12fe0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ff0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13000 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13010 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
13020 66 61 6b 65 6f 75 74 20 72 65 61 64 6c 69 6e 65 fakeout readline
13030 0a 28 69 6e 63 6c 75 64 65 20 22 72 65 61 64 6c .(include "readl
13040 69 6e 65 2d 66 69 78 2e 73 63 6d 22 29 0a 0a 28 ine-fix.scm")..(
13050 69 66 20 28 6f 72 20 28 67 65 74 65 6e 76 20 22 if (or (getenv "
13060 4d 54 5f 52 55 4e 53 43 52 49 50 54 22 29 0a 09 MT_RUNSCRIPT")..
13070 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
13080 72 65 70 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 repl")..(args:ge
13090 74 2d 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 0a t-arg "-load")).
130a0 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 (let* ((topp
130b0 61 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 ath (launch:setu
130c0 70 29 29 0a 09 20 20 20 28 64 62 73 74 72 75 63 p)).. (dbstruc
130d0 74 20 28 69 66 20 28 61 6e 64 20 74 6f 70 70 61 t (if (and toppa
130e0 74 68 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 th.
130f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13100 20 28 63 6f 6d 6d 6f 6e 3a 6f 6e 2d 68 6f 6d 65 (common:on-home
13110 68 6f 73 74 3f 29 29 0a 20 20 20 20 20 20 20 20 host?)).
13120 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13130 20 28 64 62 3a 73 65 74 75 70 29 0a 20 20 20 20 (db:setup).
13140 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13150 20 20 20 20 20 23 66 29 29 29 20 3b 3b 20 6d 61 #f))) ;; ma
13160 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 ke-dbr:dbstruct
13170 70 61 74 68 3a 20 74 6f 70 70 61 74 68 20 6c 6f path: toppath lo
13180 63 61 6c 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 cal: (args:get-a
13190 72 67 20 22 2d 6c 6f 63 61 6c 22 29 29 20 23 66 rg "-local")) #f
131a0 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 2a 74 ))). (if *t
131b0 6f 70 70 61 74 68 2a 0a 09 20 20 28 63 6f 6e 64 oppath*.. (cond
131c0 0a 09 20 20 20 28 28 67 65 74 65 6e 76 20 22 4d .. ((getenv "M
131d0 54 5f 52 55 4e 53 43 52 49 50 54 22 29 0a 09 20 T_RUNSCRIPT")..
131e0 20 20 20 3b 3b 20 48 6f 77 20 74 6f 20 72 75 6e ;; How to run
131f0 20 6d 65 67 61 74 65 73 74 20 73 63 72 69 70 74 megatest script
13200 73 0a 09 20 20 20 20 3b 3b 0a 09 20 20 20 20 3b s.. ;;.. ;
13210 3b 20 23 21 2f 62 69 6e 2f 62 61 73 68 0a 09 20 ; #!/bin/bash..
13220 20 20 20 3b 3b 0a 09 20 20 20 20 3b 3b 20 65 78 ;;.. ;; ex
13230 70 6f 72 74 20 4d 54 5f 52 55 4e 53 43 52 49 50 port MT_RUNSCRIP
13240 54 3d 79 65 73 0a 09 20 20 20 20 3b 3b 20 6d 65 T=yes.. ;; me
13250 67 61 74 65 73 74 20 3c 3c 20 45 4f 46 0a 09 20 gatest << EOF..
13260 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 48 65 ;; (print "He
13270 6c 6c 6f 20 77 6f 72 6c 64 22 29 0a 09 20 20 20 llo world")..
13280 20 3b 3b 20 28 65 78 69 74 29 0a 09 20 20 20 20 ;; (exit)..
13290 3b 3b 20 45 4f 46 0a 0a 09 20 20 20 20 28 72 65 ;; EOF... (re
132a0 70 6c 29 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 pl)).. (else..
132b0 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 (begin..
132c0 20 20 28 73 65 74 21 20 2a 64 62 2a 20 64 62 73 (set! *db* dbs
132d0 74 72 75 63 74 29 0a 09 20 20 20 20 20 20 28 69 truct).. (i
132e0 6d 70 6f 72 74 20 65 78 74 72 61 73 29 20 3b 3b mport extras) ;;
132f0 20 6d 69 67 68 74 20 6e 6f 74 20 62 65 20 6e 65 might not be ne
13300 65 64 65 64 0a 09 20 20 20 20 20 20 3b 3b 20 28 eded.. ;; (
13310 69 6d 70 6f 72 74 20 63 73 69 29 0a 09 20 20 20 import csi)..
13320 20 20 20 28 69 6d 70 6f 72 74 20 72 65 61 64 6c (import readl
13330 69 6e 65 29 0a 09 20 20 20 20 20 20 28 69 6d 70 ine).. (imp
13340 6f 72 74 20 61 70 72 6f 70 6f 73 29 0a 09 20 20 ort apropos)..
13350 20 20 20 20 3b 3b 20 28 69 6d 70 6f 72 74 20 28 ;; (import (
13360 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 prefix sqlite3 s
13370 71 6c 69 74 65 33 3a 29 29 20 3b 3b 20 64 6f 65 qlite3:)) ;; doe
13380 73 6e 27 74 20 77 6f 72 6b 20 2e 2e 2e 0a 0a 09 sn't work ......
13390 20 20 20 20 20 20 28 69 66 20 2a 75 73 65 2d 6e (if *use-n
133a0 65 77 2d 72 65 61 64 6c 69 6e 65 2a 0a 09 09 20 ew-readline*...
133b0 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 69 (begin... (i
133c0 6e 73 74 61 6c 6c 2d 68 69 73 74 6f 72 79 2d 66 nstall-history-f
133d0 69 6c 65 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e ile (get-environ
133e0 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 48 ment-variable "H
133f0 4f 4d 45 22 29 20 22 2e 6d 65 67 61 74 65 73 74 OME") ".megatest
13400 5f 68 69 73 74 6f 72 79 22 29 20 3b 3b 20 20 5b _history") ;; [
13410 68 6f 6d 65 64 69 72 5d 20 5b 66 69 6c 65 6e 61 homedir] [filena
13420 6d 65 5d 20 5b 6e 6c 69 6e 65 73 5d 29 0a 09 09 me] [nlines])...
13430 20 20 20 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 (current-inp
13440 75 74 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 72 65 ut-port (make-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 0a 09 09 20 20 atest> ")))...
13470 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 67 6e (begin... (gn
13480 75 2d 68 69 73 74 6f 72 79 2d 69 6e 73 74 61 6c u-history-instal
13490 6c 2d 66 69 6c 65 2d 6d 61 6e 61 67 65 72 0a 09 l-file-manager..
134a0 09 20 20 20 20 20 28 73 74 72 69 6e 67 2d 61 70 . (string-ap
134b0 70 65 6e 64 0a 09 09 20 20 20 20 20 20 28 6f 72 pend... (or
134c0 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e (get-environmen
134d0 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 t-variable "HOME
134e0 22 29 20 22 2e 22 29 20 22 2f 2e 6d 65 67 61 74 ") ".") "/.megat
134f0 65 73 74 5f 68 69 73 74 6f 72 79 22 29 29 0a 09 est_history"))..
13500 09 20 20 20 20 28 63 75 72 72 65 6e 74 2d 69 6e . (current-in
13510 70 75 74 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 67 put-port (make-g
13520 6e 75 2d 72 65 61 64 6c 69 6e 65 2d 70 6f 72 74 nu-readline-port
13530 20 22 6d 65 67 61 74 65 73 74 3e 20 22 29 29 29 "megatest> ")))
13540 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 72 ).. (if (ar
13550 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 gs:get-arg "-rep
13560 6c 22 29 0a 09 09 20 20 28 72 65 70 6c 29 0a 09 l")... (repl)..
13570 09 20 20 28 6c 6f 61 64 20 28 61 72 67 73 3a 67 . (load (args:g
13580 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 et-arg "-load"))
13590 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 64 62 3a ).. ;; (db:
135a0 63 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 close-all dbstru
135b0 63 74 29 20 3c 3d 20 74 61 6b 65 6e 20 63 61 72 ct) <= taken car
135c0 65 20 6f 66 20 62 79 20 6f 6e 2d 65 78 69 74 20 e of by on-exit
135d0 63 61 6c 6c 0a 09 20 20 20 20 20 20 29 0a 09 20 call.. )..
135e0 20 20 20 28 65 78 69 74 29 29 29 0a 09 20 20 28 (exit))).. (
135f0 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
13600 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d ng* #t))))..;;==
13610 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13620 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13630 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13640 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13650 3d 3d 3d 3d 0a 3b 3b 20 57 61 69 74 20 6f 6e 20 ====.;; Wait on
13660 61 20 72 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 a run to complet
13670 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d e.;;============
13680 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13690 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
136a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
136b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
136c0 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 (and (args:get-a
136d0 72 67 20 22 2d 72 75 6e 2d 77 61 69 74 22 29 0a rg "-run-wait").
136e0 09 20 28 6e 6f 74 20 28 6f 72 20 28 61 72 67 73 . (not (or (args
136f0 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 :get-arg "-run")
13700 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ... (args:get-a
13710 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 29 rg "-runtests"))
13720 29 29 20 3b 3b 20 72 75 6e 2d 77 61 69 74 20 69 )) ;; run-wait i
13730 73 20 62 75 69 6c 74 20 69 6e 74 6f 20 72 75 6e s built into run
13740 74 65 73 74 73 20 6e 6f 77 0a 20 20 20 20 28 62 tests now. (b
13750 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 egin. (if (
13760 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 not (launch:setu
13770 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 p)).. (begin..
13780 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
13790 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
137a0 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 ort* "Failed to
137b0 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 setup, exiting")
137c0 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 .. (exit 1))
137d0 29 0a 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 ). (operate
137e0 2d 6f 6e 20 27 72 75 6e 2d 77 61 69 74 29 0a 20 -on 'run-wait).
137f0 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
13800 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
13810 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13820 65 20 3b 3b 20 4e 6f 74 20 63 6f 6e 76 65 72 74 e ;; Not convert
13830 65 64 20 74 6f 20 75 73 65 20 64 62 73 74 72 75 ed to use dbstru
13840 63 74 20 79 65 74 0a 3b 3b 20 3b 3b 20 3b 3b 20 ct yet.;; ;; ;;
13850 72 65 64 6f 20 6d 65 20 3b 3b 0a 3b 3b 20 3b 3b redo me ;;.;; ;;
13860 20 3b 3b 20 72 65 64 6f 20 6d 65 20 28 69 66 20 ;; redo me (if
13870 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
13880 63 6f 6e 76 65 72 74 2d 74 6f 2d 6e 6f 72 6d 22 convert-to-norm"
13890 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
138a0 6d 65 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 me (let* ((t
138b0 6f 70 70 61 74 68 20 28 73 65 74 75 70 2d 66 6f oppath (setup-fo
138c0 72 2d 72 75 6e 29 29 0a 3b 3b 20 3b 3b 20 3b 3b r-run)).;; ;; ;;
138d0 20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 64 62 redo me . (db
138e0 73 74 72 75 63 74 20 28 69 66 20 74 6f 70 70 61 struct (if toppa
138f0 74 68 20 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 th (make-dbr:dbs
13900 74 72 75 63 74 20 70 61 74 68 3a 20 74 6f 70 70 truct path: topp
13910 61 74 68 20 6c 6f 63 61 6c 3a 20 23 74 29 29 29 ath local: #t)))
13920 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
13930 6d 65 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 me (for-ea
13940 63 68 20 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ch .;; ;; ;; red
13950 6f 20 6d 65 20 20 20 20 20 20 20 20 28 6c 61 6d o me (lam
13960 62 64 61 20 28 66 69 65 6c 64 29 0a 3b 3b 20 3b bda (field).;; ;
13970 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 28 ; ;; redo me . (
13980 6c 65 74 20 28 28 64 61 74 20 27 28 29 29 29 0a let ((dat '())).
13990 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
139a0 20 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
139b0 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
139c0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 47 65 74 t-log-port* "Get
139d0 74 69 6e 67 20 64 61 74 61 20 66 6f 72 20 66 69 ting data for fi
139e0 65 6c 64 20 22 20 66 69 65 6c 64 29 0a 3b 3b 20 eld " field).;;
139f0 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 ;; ;; redo me .
13a00 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
13a10 61 63 68 2d 72 6f 77 0a 3b 3b 20 3b 3b 20 3b 3b ach-row.;; ;; ;;
13a20 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 28 6c redo me . (l
13a30 61 6d 62 64 61 20 28 69 64 20 76 61 6c 29 0a 3b ambda (id val).;
13a40 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
13a50 09 20 20 20 20 20 20 28 73 65 74 21 20 64 61 74 . (set! dat
13a60 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 69 64 20 (cons (list id
13a70 76 61 6c 29 20 64 61 74 29 29 29 0a 3b 3b 20 3b val) dat))).;; ;
13a80 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 ; ;; redo me .
13a90 20 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 20 (db:get-db db
13aa0 72 75 6e 2d 69 64 29 0a 3b 3b 20 3b 3b 20 3b 3b run-id).;; ;; ;;
13ab0 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 28 63 redo me . (c
13ac0 6f 6e 63 20 22 53 45 4c 45 43 54 20 69 64 2c 22 onc "SELECT id,"
13ad0 20 66 69 65 6c 64 20 22 20 46 52 4f 4d 20 74 65 field " FROM te
13ae0 73 74 73 3b 22 29 29 0a 3b 3b 20 3b 3b 20 3b 3b sts;")).;; ;; ;;
13af0 20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 64 65 redo me . (de
13b00 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
13b10 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
13b20 72 74 2a 20 22 66 6f 75 6e 64 20 22 20 28 6c 65 rt* "found " (le
13b30 6e 67 74 68 20 64 61 74 29 20 22 20 69 74 65 6d ngth dat) " item
13b40 73 20 66 6f 72 20 66 69 65 6c 64 20 22 20 66 69 s for field " fi
13b50 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 eld).;; ;; ;; re
13b60 64 6f 20 6d 65 20 09 20 20 20 28 6c 65 74 20 28 do me . (let (
13b70 28 71 72 79 20 28 73 71 6c 69 74 65 33 3a 70 72 (qry (sqlite3:pr
13b80 65 70 61 72 65 20 64 62 20 28 63 6f 6e 63 20 22 epare db (conc "
13b90 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 UPDATE tests SET
13ba0 20 22 20 66 69 65 6c 64 20 22 3d 3f 20 57 48 45 " field "=? WHE
13bb0 52 45 20 69 64 3d 3f 3b 22 29 29 29 29 0a 3b 3b RE id=?;")))).;;
13bc0 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
13bd0 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 3b (for-each.;
13be0 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
13bf0 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
13c00 69 74 65 6d 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 item).;; ;; ;; r
13c10 65 64 6f 20 6d 65 20 09 09 28 6c 65 74 20 28 28 edo me ..(let ((
13c20 6e 65 77 76 61 6c 20 3b 3b 20 28 73 64 62 3a 71 newval ;; (sdb:q
13c30 72 79 20 27 67 65 74 69 64 20 0a 3b 3b 20 3b 3b ry 'getid .;; ;;
13c40 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 20 20 ;; redo me ..
13c50 20 20 20 20 20 28 63 61 64 72 20 69 74 65 6d 29 (cadr item)
13c60 29 29 20 3b 3b 20 29 0a 3b 3b 20 3b 3b 20 3b 3b )) ;; ).;; ;; ;;
13c70 20 72 65 64 6f 20 6d 65 20 09 09 20 20 28 69 66 redo me .. (if
13c80 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 (not (equal? ne
13c90 77 76 61 6c 20 28 63 61 64 72 20 69 74 65 6d 29 wval (cadr item)
13ca0 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f )).;; ;; ;; redo
13cb0 20 6d 65 20 09 09 20 20 20 20 20 20 28 64 65 62 me .. (deb
13cc0 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
13cd0 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
13ce0 74 2a 20 22 43 6f 6e 76 65 72 74 69 6e 67 20 22 t* "Converting "
13cf0 20 28 63 61 64 72 20 69 74 65 6d 29 20 22 20 74 (cadr item) " t
13d00 6f 20 22 20 6e 65 77 76 61 6c 20 22 20 66 6f 72 o " newval " for
13d10 20 74 65 73 74 20 23 22 20 28 63 61 72 20 69 74 test #" (car it
13d20 65 6d 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 em))).;; ;; ;; r
13d30 65 64 6f 20 6d 65 20 09 09 20 20 28 73 71 6c 69 edo me .. (sqli
13d40 74 65 33 3a 65 78 65 63 75 74 65 20 71 72 79 20 te3:execute qry
13d50 6e 65 77 76 61 6c 20 28 63 61 72 20 69 74 65 6d newval (car item
13d60 29 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 )))).;; ;; ;; re
13d70 64 6f 20 6d 65 20 09 20 20 20 20 20 20 64 61 74 do me . dat
13d80 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
13d90 6d 65 20 09 20 20 20 20 20 28 73 71 6c 69 74 65 me . (sqlite
13da0 33 3a 66 69 6e 61 6c 69 7a 65 21 20 71 72 79 29 3:finalize! qry)
13db0 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ))).;; ;; ;; red
13dc0 6f 20 6d 65 20 20 20 20 20 20 20 20 28 64 62 3a o me (db:
13dd0 63 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 close-all dbstru
13de0 63 74 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ct).;; ;; ;; red
13df0 6f 20 6d 65 20 20 20 20 20 20 20 20 28 6c 69 73 o me (lis
13e00 74 20 22 75 6e 61 6d 65 22 20 22 72 75 6e 64 69 t "uname" "rundi
13e10 72 22 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 r" "final_logf"
13e20 22 63 6f 6d 6d 65 6e 74 22 29 29 0a 3b 3b 20 3b "comment")).;; ;
13e30 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 ; ;; redo me
13e40 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
13e50 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 ething* #t)))..(
13e60 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
13e70 20 22 2d 69 6d 70 6f 72 74 2d 6d 65 67 61 74 65 "-import-megate
13e80 73 74 2e 64 62 22 29 0a 20 20 20 20 28 62 65 67 st.db"). (beg
13e90 69 6e 0a 20 20 20 20 20 20 28 64 62 3a 6d 75 6c in. (db:mul
13ea0 74 69 2d 64 62 2d 73 79 6e 63 20 0a 20 20 20 20 ti-db-sync .
13eb0 20 20 20 28 64 62 3a 73 65 74 75 70 29 0a 20 20 (db:setup).
13ec0 20 20 20 20 20 27 6b 69 6c 6c 73 65 72 76 65 72 'killserver
13ed0 73 0a 20 20 20 20 20 20 20 27 64 65 6a 75 6e 6b s. 'dejunk
13ee0 0a 20 20 20 20 20 20 20 27 61 64 6a 2d 74 65 73 . 'adj-tes
13ef0 74 69 64 73 0a 20 20 20 20 20 20 20 27 6f 6c 64 tids. 'old
13f00 32 6e 65 77 0a 20 20 20 20 20 20 20 3b 3b 20 27 2new. ;; '
13f10 6e 65 77 32 6f 6c 64 0a 20 20 20 20 20 20 20 29 new2old. )
13f20 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
13f30 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
13f40 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
13f50 2d 61 72 67 20 22 2d 73 79 6e 63 2d 74 6f 2d 6d -arg "-sync-to-m
13f60 65 67 61 74 65 73 74 2e 64 62 22 29 0a 20 20 20 egatest.db").
13f70 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 64 (begin. (d
13f80 62 3a 6d 75 6c 74 69 2d 64 62 2d 73 79 6e 63 20 b:multi-db-sync
13f90 0a 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 75 . (db:setu
13fa0 70 29 0a 20 20 20 20 20 20 20 27 6e 65 77 32 6f p). 'new2o
13fb0 6c 64 0a 20 20 20 20 20 20 20 29 0a 20 20 20 20 ld. ).
13fc0 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
13fd0 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
13fe0 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
13ff0 22 2d 67 65 6e 65 72 61 74 65 2d 68 74 6d 6c 22 "-generate-html"
14000 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f ). (let* ((to
14010 70 70 61 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 ppath (launch:se
14020 74 75 70 29 29 29 0a 20 20 20 20 20 20 28 69 66 tup))). (if
14030 20 28 74 65 73 74 73 3a 63 72 65 61 74 65 2d 68 (tests:create-h
14040 74 6d 6c 2d 74 72 65 65 20 23 66 29 0a 20 20 20 tml-tree #f).
14050 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
14060 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
14070 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 48 ult-log-port* "H
14080 54 4d 4c 20 6f 75 74 70 75 74 20 63 72 65 61 74 TML output creat
14090 65 64 20 69 6e 20 22 20 74 6f 70 70 61 74 68 20 ed in " toppath
140a0 22 2f 6c 74 2f 72 75 6e 73 2d 69 6e 64 65 78 2e "/lt/runs-index.
140b0 68 74 6d 6c 22 29 0a 20 20 20 20 20 20 20 20 20 html").
140c0 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
140d0 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
140e0 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 63 72 t* "Failed to cr
140f0 65 61 74 65 20 48 54 4d 4c 20 6f 75 74 70 75 74 eate HTML output
14100 20 69 6e 20 22 20 74 6f 70 70 61 74 68 20 22 2f in " toppath "/
14110 6c 74 2f 72 75 6e 73 2d 69 6e 64 65 78 2e 68 74 lt/runs-index.ht
14120 6d 6c 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 ml")). (set
14130 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
14140 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d #t)))..;;======
14150 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14160 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14170 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14180 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14190 0a 3b 3b 20 45 78 69 74 20 61 6e 64 20 63 6c 65 .;; Exit and cle
141a0 61 6e 20 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d an up.;;========
141b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
141c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
141d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
141e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
141f0 28 69 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 (if *runremote*
14200 28 63 6c 6f 73 65 2d 61 6c 6c 2d 63 6f 6e 6e 65 (close-all-conne
14210 63 74 69 6f 6e 73 21 29 29 20 3b 3b 20 66 6f 72 ctions!)) ;; for
14220 20 68 74 74 70 2d 63 6c 69 65 6e 74 0a 0a 28 69 http-client..(i
14230 66 20 28 6e 6f 74 20 2a 64 69 64 73 6f 6d 65 74 f (not *didsomet
14240 68 69 6e 67 2a 29 0a 20 20 20 20 28 64 65 62 75 hing*). (debu
14250 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
14260 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 68 65 6c lt-log-port* hel
14270 70 29 29 0a 0a 28 73 65 74 21 20 2a 74 69 6d 65 p))..(set! *time
14280 2d 74 6f 2d 65 78 69 74 2a 20 23 74 29 0a 28 74 -to-exit* #t).(t
14290 68 72 65 61 64 2d 6a 6f 69 6e 21 20 2a 77 61 74 hread-join! *wat
142a0 63 68 64 6f 67 2a 29 0a 0a 28 69 66 20 28 6e 6f chdog*)..(if (no
142b0 74 20 28 65 71 3f 20 2a 67 6c 6f 62 61 6c 65 78 t (eq? *globalex
142c0 69 74 73 74 61 74 75 73 2a 20 30 29 29 0a 20 20 itstatus* 0)).
142d0 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a (if (or (args:
142e0 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 28 get-arg "-run")(
142f0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
14300 75 6e 74 65 73 74 73 22 29 28 61 72 67 73 3a 67 untests")(args:g
14310 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 et-arg "-runall"
14320 29 29 0a 20 20 20 20 20 20 20 20 28 62 65 67 69 )). (begi
14330 6e 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 65 n. (de
14340 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
14350 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
14360 4e 4f 54 45 3a 20 53 75 62 70 72 6f 63 65 73 73 NOTE: Subprocess
14370 65 73 20 77 69 74 68 20 6e 6f 6e 2d 7a 65 72 6f es with non-zero
14380 20 65 78 69 74 20 63 6f 64 65 20 64 65 74 65 63 exit code detec
14390 74 65 64 3a 20 22 20 2a 67 6c 6f 62 61 6c 65 78 ted: " *globalex
143a0 69 74 73 74 61 74 75 73 2a 29 0a 20 20 20 20 20 itstatus*).
143b0 20 20 20 20 20 20 28 65 78 69 74 20 30 29 29 0a (exit 0)).
143c0 20 20 20 20 20 20 20 20 28 63 61 73 65 20 2a 67 (case *g
143d0 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
143e0 0a 20 20 20 20 20 20 20 20 20 28 28 30 29 28 65 . ((0)(e
143f0 78 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 xit 0)).
14400 20 28 28 31 29 28 65 78 69 74 20 31 29 29 0a 20 ((1)(exit 1)).
14410 20 20 20 20 20 20 20 20 28 28 32 29 28 65 78 69 ((2)(exi
14420 74 20 32 29 29 0a 20 20 20 20 20 20 20 20 20 28 t 2)). (
14430 65 6c 73 65 20 28 65 78 69 74 20 33 29 29 29 29 else (exit 3))))
14440 29 0a ).