Artifact 8f5d47927b5ef05ebe0c3aea420dae5d68ed4b9b:
- File
megatest.scm
— part of check-in
[c9ec425fc4]
at
2016-12-09 17:33:35
on branch v1.63-fix-db-sync
— merged v1.62-rpc. Adds rpc transport capability but leaves default http.
NOTE: This commit appears to have broken the db sync-back to megatest.db. Moving this to side branch for repairs. (user: bjbarcla, size: 83184) [annotate] [blame] [check-ins using] [more...]
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 0a emargs here.;;..
3160: 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 6e (if (and (not (n
3170: 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 29 0a 09 ull? remargs))..
3180: 20 28 6e 6f 74 20 28 6f 72 0a 09 20 20 20 20 20 (not (or..
3190: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
31a0: 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 20 20 20 "-runstep")..
31b0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
31c0: 67 20 22 2d 65 6e 76 63 61 70 22 29 0a 09 20 20 g "-envcap")..
31d0: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
31e0: 72 67 20 22 2d 65 6e 76 64 65 6c 74 61 22 29 0a rg "-envdelta").
31f0: 09 20 20 20 20 20 20 20 29 0a 09 20 20 20 20 20 . )..
3200: 20 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 )). (debug:p
3210: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
3220: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3230: 22 55 6e 72 65 63 6f 67 6e 69 73 65 64 20 61 72 "Unrecognised ar
3240: 67 75 6d 65 6e 74 73 3a 20 22 20 28 73 74 72 69 guments: " (stri
3250: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
3260: 69 66 20 28 6c 69 73 74 3f 20 72 65 6d 61 72 67 if (list? remarg
3270: 73 29 20 72 65 6d 61 72 67 73 20 28 61 72 67 76 s) remargs (argv
3280: 29 29 20 20 22 20 22 29 29 29 0a 0a 3b 3b 20 69 )) " ")))..;; i
3290: 6d 6d 65 64 69 61 74 65 6c 79 20 73 65 74 20 4d mmediately set M
32a0: 54 5f 54 41 52 47 45 54 20 69 66 20 2d 72 65 71 T_TARGET if -req
32b0: 74 61 72 67 20 6f 72 20 2d 74 61 72 67 65 74 20 targ or -target
32c0: 61 72 65 20 61 76 61 69 6c 61 62 6c 65 0a 3b 3b are available.;;
32d0: 0a 28 6c 65 74 20 28 28 74 61 72 67 20 28 6f 72 .(let ((targ (or
32e0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
32f0: 2d 72 65 71 74 61 72 67 22 29 28 61 72 67 73 3a -reqtarg")(args:
3300: 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 get-arg "-target
3310: 22 29 29 29 29 0a 20 20 28 69 66 20 74 61 72 67 ")))). (if targ
3320: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 (setenv "MT_TAR
3330: 47 45 54 22 20 74 61 72 67 29 29 29 0a 0a 3b 3b GET" targ)))..;;
3340: 20 54 68 65 20 77 61 74 63 68 64 6f 67 20 69 73 The watchdog is
3350: 20 74 6f 20 6b 65 65 70 20 61 6e 20 65 79 65 20 to keep an eye
3360: 6f 6e 20 74 68 69 6e 67 73 20 6c 69 6b 65 20 64 on things like d
3370: 62 20 73 79 6e 63 20 65 74 63 2e 0a 3b 3b 0a 28 b sync etc..;;.(
3380: 64 65 66 69 6e 65 20 2a 77 61 74 63 68 64 6f 67 define *watchdog
3390: 2a 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 63 * (make-thread c
33a0: 6f 6d 6d 6f 6e 3a 77 61 74 63 68 64 6f 67 20 22 ommon:watchdog "
33b0: 57 61 74 63 68 64 6f 67 20 74 68 72 65 61 64 22 Watchdog thread"
33c0: 29 29 0a 0a 28 74 68 72 65 61 64 2d 73 74 61 72 ))..(thread-star
33d0: 74 21 20 2a 77 61 74 63 68 64 6f 67 2a 29 0a 0a t! *watchdog*)..
33e0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
33f0: 67 20 22 2d 6c 6f 67 22 29 0a 20 20 20 20 28 6c g "-log"). (l
3400: 65 74 20 28 28 6f 75 70 20 28 6f 70 65 6e 2d 6f et ((oup (open-o
3410: 75 74 70 75 74 2d 66 69 6c 65 20 28 61 72 67 73 utput-file (args
3420: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 :get-arg "-log")
3430: 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 ))). (debug
3440: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 :print-info 0 *d
3450: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
3460: 20 22 53 65 6e 64 69 6e 67 20 6c 6f 67 20 6f 75 "Sending log ou
3470: 74 70 75 74 20 74 6f 20 22 20 28 61 72 67 73 3a tput to " (args:
3480: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 29 get-arg "-log"))
3490: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 65 . (set! *de
34a0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
34b0: 6f 75 70 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 oup)))..(if (or
34c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
34d0: 68 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 h")..(args:get-a
34e0: 72 67 20 22 2d 68 65 6c 70 22 29 0a 09 28 61 72 rg "-help")..(ar
34f0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 2d 68 65 gs:get-arg "--he
3500: 6c 70 22 29 29 0a 20 20 20 20 28 62 65 67 69 6e lp")). (begin
3510: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 68 65 . (print he
3520: 6c 70 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 lp). (exit)
3530: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
3540: 74 2d 61 72 67 20 22 2d 6d 61 6e 75 61 6c 22 29 t-arg "-manual")
3550: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 68 74 6d . (let* ((htm
3560: 6c 76 69 65 77 65 72 63 6d 64 20 28 6f 72 20 28 lviewercmd (or (
3570: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a configf:lookup *
3580: 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 configdat* "setu
3590: 70 22 20 22 68 74 6d 6c 76 69 65 77 65 72 63 6d p" "htmlviewercm
35a0: 64 22 29 0a 09 09 09 20 20 20 20 20 20 28 63 6f d").... (co
35b0: 6d 6d 6f 6e 3a 77 68 69 63 68 20 27 28 22 66 69 mmon:which '("fi
35c0: 72 65 66 6f 78 22 20 22 61 72 6f 72 61 22 29 29 refox" "arora"))
35d0: 29 29 0a 09 20 20 20 28 69 6e 73 74 61 6c 6c 2d )).. (install-
35e0: 68 6f 6d 65 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 home (common:ge
35f0: 74 2d 69 6e 73 74 61 6c 6c 2d 61 72 65 61 29 29 t-install-area))
3600: 0a 09 20 20 20 28 6d 61 6e 75 61 6c 2d 68 74 6d .. (manual-htm
3610: 6c 20 20 20 28 63 6f 6e 63 20 69 6e 73 74 61 6c l (conc instal
3620: 6c 2d 68 6f 6d 65 20 22 2f 73 68 61 72 65 2f 64 l-home "/share/d
3630: 6f 63 73 2f 6d 65 67 61 74 65 73 74 5f 6d 61 6e ocs/megatest_man
3640: 75 61 6c 2e 68 74 6d 6c 22 29 29 29 0a 20 20 20 ual.html"))).
3650: 20 20 20 28 69 66 20 28 61 6e 64 20 69 6e 73 74 (if (and inst
3660: 61 6c 6c 2d 68 6f 6d 65 0a 09 20 20 20 20 20 20 all-home..
3670: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6d (file-exists? m
3680: 61 6e 75 61 6c 2d 68 74 6d 6c 29 29 0a 09 20 20 anual-html))..
3690: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 28 (system (conc "(
36a0: 22 20 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 " htmlviewercmd
36b0: 22 20 22 20 6d 61 6e 75 61 6c 2d 68 74 6d 6c 20 " " manual-html
36c0: 22 20 29 20 26 22 29 29 0a 09 20 20 28 73 79 73 " ) &")).. (sys
36d0: 74 65 6d 20 28 63 6f 6e 63 20 22 28 22 20 68 74 tem (conc "(" ht
36e0: 6d 6c 76 69 65 77 65 72 63 6d 64 20 22 20 68 74 mlviewercmd " ht
36f0: 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e tp://www.kiatoa.
3700: 63 6f 6d 2f 63 67 69 2d 62 69 6e 2f 66 6f 73 73 com/cgi-bin/foss
3710: 69 6c 73 2f 6d 65 67 61 74 65 73 74 2f 64 6f 63 ils/megatest/doc
3720: 2f 74 69 70 2f 64 6f 63 73 2f 6d 61 6e 75 61 6c /tip/docs/manual
3730: 2f 6d 65 67 61 74 65 73 74 5f 6d 61 6e 75 61 6c /megatest_manual
3740: 2e 68 74 6d 6c 20 29 20 26 22 29 29 29 0a 20 20 .html ) &"))).
3750: 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a 28 69 (exit)))..(i
3760: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
3770: 22 2d 73 74 61 72 74 2d 64 69 72 22 29 0a 20 20 "-start-dir").
3780: 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 (if (file-exis
3790: 74 73 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ts? (args:get-ar
37a0: 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 g "-start-dir"))
37b0: 0a 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 ..(change-direct
37c0: 6f 72 79 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ory (args:get-ar
37d0: 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 g "-start-dir"))
37e0: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 ..(begin.. (deb
37f0: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
3800: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
3810: 72 74 2a 20 22 6e 6f 6e 2d 65 78 69 73 74 61 6e rt* "non-existan
3820: 74 20 73 74 61 72 74 20 64 69 72 20 22 20 28 61 t start dir " (a
3830: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
3840: 61 72 74 2d 64 69 72 22 29 20 22 20 73 70 65 63 art-dir") " spec
3850: 69 66 69 65 64 2c 20 65 78 69 74 69 6e 67 2e 22 ified, exiting."
3860: 29 0a 09 20 20 28 65 78 69 74 20 31 29 29 29 29 ).. (exit 1))))
3870: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
3880: 61 72 67 20 22 2d 76 65 72 73 69 6f 6e 22 29 0a arg "-version").
3890: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
38a0: 20 28 70 72 69 6e 74 20 28 63 6f 6d 6d 6f 6e 3a (print (common:
38b0: 76 65 72 73 69 6f 6e 2d 73 69 67 6e 61 74 75 72 version-signatur
38c0: 65 29 29 20 3b 3b 20 28 70 72 69 6e 74 20 6d 65 e)) ;; (print me
38d0: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a gatest-version).
38e0: 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a (exit)))..
38f0: 28 64 65 66 69 6e 65 20 2a 64 69 64 73 6f 6d 65 (define *didsome
3900: 74 68 69 6e 67 2a 20 23 66 29 0a 0a 3b 3b 20 4f thing* #f)..;; O
3910: 76 65 72 61 6c 6c 20 65 78 69 74 20 68 61 6e 64 verall exit hand
3920: 6c 69 6e 67 20 73 65 74 75 70 20 69 6d 6d 65 64 ling setup immed
3930: 69 61 74 65 6c 79 0a 3b 3b 0a 28 69 66 20 28 6f iately.;;.(if (o
3940: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
3950: 22 2d 70 72 6f 63 65 73 73 2d 72 65 61 70 22 29 "-process-reap")
3960: 29 0a 20 20 20 20 20 20 20 20 3b 3b 20 28 61 72 ). ;; (ar
3970: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
3980: 74 65 73 74 73 22 29 0a 09 3b 3b 20 28 61 72 67 tests")..;; (arg
3990: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 s:get-arg "-exec
39a0: 75 74 65 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a ute")..;; (args:
39b0: 67 65 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 65 get-arg "-remove
39c0: 2d 72 75 6e 73 22 29 0a 09 3b 3b 20 28 61 72 67 -runs")..;; (arg
39d0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 s:get-arg "-runs
39e0: 74 65 70 22 29 29 0a 20 20 20 20 28 6c 65 74 20 tep")). (let
39f0: 28 28 6f 72 69 67 69 6e 61 6c 2d 65 78 69 74 20 ((original-exit
3a00: 28 65 78 69 74 2d 68 61 6e 64 6c 65 72 29 29 29 (exit-handler)))
3a10: 0a 20 20 20 20 20 20 28 65 78 69 74 2d 68 61 6e . (exit-han
3a20: 64 6c 65 72 20 28 6c 61 6d 62 64 61 20 28 23 21 dler (lambda (#!
3a30: 6f 70 74 69 6f 6e 61 6c 20 28 65 78 69 74 2d 63 optional (exit-c
3a40: 6f 64 65 20 30 29 29 0a 09 09 20 20 20 20 20 20 ode 0))...
3a50: 28 70 72 69 6e 74 66 20 22 50 72 65 70 61 72 69 (printf "Prepari
3a60: 6e 67 20 74 6f 20 65 78 69 74 20 77 69 74 68 20 ng to exit with
3a70: 65 78 69 74 20 63 6f 64 65 20 7e 41 20 2e 2e 2e exit code ~A ...
3a80: 5c 6e 22 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 \n" exit-code)..
3a90: 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 . (for-each
3aa0: 20 0a 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 ... (lamb
3ab0: 64 61 20 28 70 69 64 29 0a 09 09 09 20 28 68 61 da (pid).... (ha
3ac0: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
3ad0: 09 09 09 20 20 65 78 6e 0a 09 09 09 20 20 23 74 ... exn.... #t
3ae0: 0a 09 09 09 20 20 28 6c 65 74 2d 76 61 6c 75 65 .... (let-value
3af0: 73 20 28 28 28 70 69 64 2d 76 61 6c 20 65 78 69 s (((pid-val exi
3b00: 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f t-status exit-co
3b10: 64 65 29 20 28 70 72 6f 63 65 73 73 2d 77 61 69 de) (process-wai
3b20: 74 20 70 69 64 20 23 74 29 29 29 0a 09 09 09 09 t pid #t))).....
3b30: 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 65 (if (or (e
3b40: 71 3f 20 70 69 64 2d 76 61 6c 20 70 69 64 29 0a q? pid-val pid).
3b50: 09 09 09 09 09 20 20 20 20 20 20 28 65 71 3f 20 ..... (eq?
3b60: 70 69 64 2d 76 61 6c 20 30 29 29 0a 09 09 09 09 pid-val 0)).....
3b70: 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 . (begin......
3b80: 20 20 20 28 70 72 69 6e 74 66 20 22 53 65 6e 64 (printf "Send
3b90: 69 6e 67 20 73 69 67 6e 61 6c 2f 74 65 72 6d 20 ing signal/term
3ba0: 74 6f 20 7e 41 5c 6e 22 20 70 69 64 29 0a 09 09 to ~A\n" pid)...
3bb0: 09 09 09 20 20 20 20 28 70 72 6f 63 65 73 73 2d ... (process-
3bc0: 73 69 67 6e 61 6c 20 70 69 64 20 73 69 67 6e 61 signal pid signa
3bd0: 6c 2f 74 65 72 6d 29 29 29 29 29 29 0a 09 09 20 l/term))))))...
3be0: 20 20 20 20 20 20 28 70 72 6f 63 65 73 73 3a 63 (process:c
3bf0: 68 69 6c 64 72 65 6e 20 23 66 29 29 0a 09 09 20 hildren #f))...
3c00: 20 20 20 20 20 28 6f 72 69 67 69 6e 61 6c 2d 65 (original-e
3c10: 78 69 74 20 65 78 69 74 2d 63 6f 64 65 29 29 29 xit exit-code)))
3c20: 29 29 0a 0a 3b 3b 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 3d 0a 3b 3b 20 ============.;;
3c70: 4d 69 73 63 20 73 65 74 75 70 20 73 74 75 66 66 Misc setup stuff
3c80: 0a 3b 3b 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 3d 0a 0a 28 64 65 62 75 =========..(debu
3cd0: 67 3a 73 65 74 75 70 29 0a 0a 28 69 66 20 28 61 g:setup)..(if (a
3ce0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
3cf0: 67 67 69 6e 67 22 29 28 73 65 74 21 20 2a 6c 6f gging")(set! *lo
3d00: 67 67 69 6e 67 2a 20 23 74 29 29 0a 0a 28 69 66 gging* #t))..(if
3d10: 20 28 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f (debug:debug-mo
3d20: 64 65 20 33 29 20 3b 3b 20 77 65 20 61 72 65 20 de 3) ;; we are
3d30: 6f 62 76 69 6f 75 73 6c 79 20 64 65 62 75 67 67 obviously debugg
3d40: 69 6e 67 0a 20 20 20 20 28 73 65 74 21 20 6f 70 ing. (set! op
3d50: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 6f 70 65 en-run-close ope
3d60: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 n-run-close-no-e
3d70: 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e xception-handlin
3d80: 67 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 g))..(if (args:g
3d90: 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 et-arg "-itempat
3da0: 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 6e t"). (let ((n
3db0: 65 77 76 61 6c 20 28 63 6f 6e 63 20 28 61 72 67 ewval (conc (arg
3dc0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
3dd0: 70 61 74 74 22 29 20 22 2f 22 20 28 61 72 67 73 patt") "/" (args
3de0: 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 :get-arg "-itemp
3df0: 61 74 74 22 29 29 29 29 0a 20 20 20 20 20 20 28 att")))). (
3e00: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
3e10: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
3e20: 20 22 57 41 52 4e 49 4e 47 3a 20 2d 69 74 65 6d "WARNING: -item
3e30: 70 61 74 74 20 68 61 73 20 62 65 65 6e 20 64 65 patt has been de
3e40: 70 72 65 63 61 74 65 64 2c 20 70 6c 65 61 73 65 precated, please
3e50: 20 75 73 65 20 2d 74 65 73 74 70 61 74 74 20 74 use -testpatt t
3e60: 65 73 74 70 61 74 74 2f 69 74 65 6d 70 61 74 74 estpatt/itempatt
3e70: 20 6d 65 74 68 6f 64 2c 20 6e 65 77 20 74 65 73 method, new tes
3e80: 74 70 61 74 74 20 69 73 20 22 6e 65 77 76 61 6c tpatt is "newval
3e90: 29 0a 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 ). (hash-ta
3ea0: 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 ble-set! args:ar
3eb0: 67 2d 68 61 73 68 20 22 2d 74 65 73 74 70 61 74 g-hash "-testpat
3ec0: 74 22 20 6e 65 77 76 61 6c 29 0a 20 20 20 20 20 t" newval).
3ed0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c (hash-table-del
3ee0: 65 74 65 21 20 61 72 67 73 3a 61 72 67 2d 68 61 ete! args:arg-ha
3ef0: 73 68 20 22 2d 69 74 65 6d 70 61 74 74 22 29 29 sh "-itempatt"))
3f00: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
3f10: 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 -arg "-runtests"
3f20: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
3f30: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
3f40: 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 g-port* "WARNING
3f50: 3a 20 5c 22 2d 72 75 6e 74 65 73 74 73 5c 22 20 : \"-runtests\"
3f60: 69 73 20 64 65 70 72 65 63 61 74 65 64 2e 20 55 is deprecated. U
3f70: 73 65 20 5c 22 2d 72 75 6e 5c 22 20 77 69 74 68 se \"-run\" with
3f80: 20 5c 22 2d 74 65 73 74 70 61 74 74 5c 22 20 69 \"-testpatt\" i
3f90: 6e 73 74 65 61 64 22 29 29 0a 0a 28 6f 6e 2d 65 nstead"))..(on-e
3fa0: 78 69 74 20 73 74 64 2d 65 78 69 74 2d 70 72 6f xit std-exit-pro
3fb0: 63 65 64 75 72 65 29 0a 0a 3b 3b 3d 3d 3d 3d 3d cedure)..;;=====
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: 3d 0a 3b 3b 20 4d 69 73 63 20 67 65 6e 65 72 61 =.;; Misc genera
4010: 6c 20 63 61 6c 6c 73 0a 3b 3b 3d 3d 3d 3d 3d 3d l 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 3d ================
4060: 0a 0a 28 69 66 20 28 61 6e 64 20 28 61 72 67 73 ..(if (and (args
4070: 3a 67 65 74 2d 61 72 67 20 22 2d 63 61 63 68 65 :get-arg "-cache
4080: 2d 64 62 22 29 0a 20 20 20 20 20 20 20 20 20 28 -db"). (
4090: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
40a0: 6f 75 72 63 65 2d 64 62 22 29 29 0a 20 20 20 20 ource-db")).
40b0: 28 6c 65 74 2a 20 28 28 74 65 6d 70 2d 64 69 72 (let* ((temp-dir
40c0: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
40d0: 72 67 20 22 2d 74 61 72 67 65 74 2d 64 62 22 29 rg "-target-db")
40e0: 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f (create-directo
40f0: 72 79 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 ry (conc "/tmp/"
4100: 20 28 67 65 74 65 6e 76 20 22 55 53 45 52 22 29 (getenv "USER")
4110: 20 22 2f 22 20 28 73 74 72 69 6e 67 2d 74 72 61 "/" (string-tra
4120: 6e 73 6c 61 74 65 20 28 63 75 72 72 65 6e 74 2d nslate (current-
4130: 64 69 72 65 63 74 6f 72 79 29 20 22 2f 22 20 22 directory) "/" "
4140: 5f 22 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 _"))))).
4150: 20 20 20 28 74 61 72 67 65 74 2d 64 62 20 28 63 (target-db (c
4160: 6f 6e 63 20 74 65 6d 70 2d 64 69 72 20 22 2f 63 onc temp-dir "/c
4170: 61 63 68 65 64 2e 64 62 22 29 29 0a 20 20 20 20 ached.db")).
4180: 20 20 20 20 20 20 20 28 73 6f 75 72 63 65 2d 64 (source-d
4190: 62 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 b (args:get-arg
41a0: 22 2d 73 6f 75 72 63 65 2d 64 62 22 29 29 29 20 "-source-db")))
41b0: 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 28 64 . (d
41c0: 62 3a 63 61 63 68 65 2d 66 6f 72 2d 72 65 61 64 b:cache-for-read
41d0: 2d 6f 6e 6c 79 20 73 6f 75 72 63 65 2d 64 62 20 -only source-db
41e0: 74 61 72 67 65 74 2d 64 62 29 0a 20 20 20 20 20 target-db).
41f0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
4200: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 hing* #t)))..;;
4210: 68 61 6e 64 6c 65 20 61 20 63 6c 65 61 6e 2d 63 handle a clean-c
4220: 61 63 68 65 20 72 65 71 75 65 73 74 20 61 73 20 ache request as
4230: 65 61 72 6c 79 20 61 73 20 70 6f 73 73 69 62 6c early as possibl
4240: 65 0a 3b 3b 0a 28 69 66 20 28 61 72 67 73 3a 67 e.;;.(if (args:g
4250: 65 74 2d 61 72 67 20 22 2d 63 6c 65 61 6e 2d 63 et-arg "-clean-c
4260: 61 63 68 65 22 29 0a 20 20 20 20 28 62 65 67 69 ache"). (begi
4270: 6e 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 n. (set! *d
4280: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
4290: 20 3b 3b 20 73 75 70 70 72 65 73 73 20 74 68 65 ;; suppress the
42a0: 20 68 65 6c 70 20 6f 75 74 70 75 74 2e 0a 20 20 help output..
42b0: 20 20 20 20 28 69 66 20 28 67 65 74 65 6e 76 20 (if (getenv
42c0: 22 4d 54 5f 54 41 52 47 45 54 22 29 20 3b 3b 20 "MT_TARGET") ;;
42d0: 6e 6f 20 70 6f 69 6e 74 20 69 6e 20 74 72 79 69 no point in tryi
42e0: 6e 67 20 69 66 20 6e 6f 20 74 61 72 67 65 74 0a ng if no target.
42f0: 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 . (if (args:get
4300: 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 -arg "-runname")
4310: 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 .. (let* ((
4320: 74 6f 70 70 61 74 68 20 20 28 6c 61 75 6e 63 68 toppath (launch
4330: 3a 73 65 74 75 70 29 29 0a 09 09 20 20 20 20 20 :setup))...
4340: 28 6c 69 6e 6b 74 72 65 65 20 28 69 66 20 74 6f (linktree (if to
4350: 70 70 61 74 68 20 28 63 6f 6e 66 69 67 66 3a 6c ppath (configf:l
4360: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
4370: 2a 20 22 73 65 74 75 70 22 20 22 6c 69 6e 6b 74 * "setup" "linkt
4380: 72 65 65 22 29 29 29 0a 09 09 20 20 20 20 20 28 ree")))... (
4390: 72 75 6e 74 6f 70 20 20 20 28 63 6f 6e 63 20 6c runtop (conc l
43a0: 69 6e 6b 74 72 65 65 20 22 2f 22 20 28 67 65 74 inktree "/" (get
43b0: 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 env "MT_TARGET")
43c0: 20 22 2f 22 20 28 61 72 67 73 3a 67 65 74 2d 61 "/" (args:get-a
43d0: 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 29 29 rg "-runname")))
43e0: 0a 09 09 20 20 20 20 20 28 66 69 6c 65 73 20 20 ... (files
43f0: 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 (if (file-exis
4400: 74 73 3f 20 72 75 6e 74 6f 70 29 0a 09 09 09 09 ts? runtop).....
4410: 20 20 20 28 61 70 70 65 6e 64 20 28 67 6c 6f 62 (append (glob
4420: 20 28 63 6f 6e 63 20 72 75 6e 74 6f 70 20 22 2f (conc runtop "/
4430: 2e 6d 65 67 61 74 65 73 74 2a 22 29 29 0a 09 09 .megatest*"))...
4440: 09 09 09 20 20 20 28 67 6c 6f 62 20 28 63 6f 6e ... (glob (con
4450: 63 20 72 75 6e 74 6f 70 20 22 2f 2e 72 75 6e 63 c runtop "/.runc
4460: 6f 6e 66 69 67 2a 22 29 29 29 0a 09 09 09 09 20 onfig*"))).....
4470: 20 20 27 28 29 29 29 29 0a 09 09 28 69 66 20 28 '())))...(if (
4480: 6e 75 6c 6c 3f 20 66 69 6c 65 73 29 0a 09 09 20 null? files)...
4490: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
44a0: 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
44b0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f 20 63 61 log-port* "No ca
44c0: 63 68 65 64 20 6d 65 67 61 74 65 73 74 20 6f 72 ched megatest or
44d0: 20 72 75 6e 63 6f 6e 66 69 67 73 20 66 69 6c 65 runconfigs file
44e0: 73 20 66 6f 75 6e 64 2e 20 4e 6f 6e 65 20 72 65 s found. None re
44f0: 6d 6f 76 65 64 2e 22 29 0a 09 09 20 20 20 20 28 moved.")... (
4500: 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 begin... (d
4510: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
4520: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
4530: 6f 72 74 2a 20 22 52 65 6d 6f 76 69 6e 67 20 63 ort* "Removing c
4540: 61 63 68 65 64 20 66 69 6c 65 73 3a 5c 6e 20 20 ached files:\n
4550: 20 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 " (string-inte
4560: 72 73 70 65 72 73 65 20 66 69 6c 65 73 20 22 5c rsperse files "\
4570: 6e 20 20 20 20 22 29 29 0a 09 09 20 20 20 20 20 n "))...
4580: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 20 20 (for-each ...
4590: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 29 (lambda (f)
45a0: 0a 09 09 09 20 28 68 61 6e 64 6c 65 2d 65 78 63 .... (handle-exc
45b0: 65 70 74 69 6f 6e 73 0a 09 09 09 20 20 20 20 20 eptions....
45c0: 65 78 6e 0a 09 09 09 20 20 20 20 20 28 64 65 62 exn.... (deb
45d0: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
45e0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 ult-log-port* "W
45f0: 41 52 4e 49 4e 47 3a 20 46 61 69 6c 65 64 20 74 ARNING: Failed t
4600: 6f 20 72 65 6d 6f 76 65 20 66 69 6c 65 20 22 20 o remove file "
4610: 66 29 0a 09 09 09 20 20 20 28 64 65 6c 65 74 65 f).... (delete
4620: 2d 66 69 6c 65 20 66 29 29 29 0a 09 09 20 20 20 -file f)))...
4630: 20 20 20 20 66 69 6c 65 73 29 29 29 29 0a 09 20 files))))..
4640: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
4650: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
4660: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 63 lt-log-port* "-c
4670: 6c 65 61 6e 2d 63 61 63 68 65 20 72 65 71 75 69 lean-cache requi
4680: 72 65 73 20 2d 72 75 6e 6e 61 6d 65 2e 22 29 29 res -runname."))
4690: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
46a0: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
46b0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 63 6c t-log-port* "-cl
46c0: 65 61 6e 2d 63 61 63 68 65 20 72 65 71 75 69 72 ean-cache requir
46d0: 65 73 20 2d 74 61 72 67 65 74 20 6f 72 20 2d 72 es -target or -r
46e0: 65 71 74 61 72 67 22 29 29 29 29 0a 09 20 20 20 eqtarg"))))..
46f0: 20 0a 09 20 20 0a 28 69 66 20 28 61 72 67 73 3a .. .(if (args:
4700: 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 32 66 69 get-arg "-env2fi
4710: 6c 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a le"). (begin.
4720: 20 20 20 20 20 20 28 73 61 76 65 2d 65 6e 76 69 (save-envi
4730: 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 ronment-as-files
4740: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4750: 2d 65 6e 76 32 66 69 6c 65 22 29 29 0a 20 20 20 -env2file")).
4760: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
4770: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 ething* #t)))..(
4780: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
4790: 20 22 2d 6c 69 73 74 2d 64 69 73 6b 73 22 29 0a "-list-disks").
47a0: 20 20 20 20 28 6c 65 74 20 28 28 74 6f 70 70 61 (let ((toppa
47b0: 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 th (launch:setup
47c0: 29 29 29 0a 20 20 20 20 20 20 28 70 72 69 6e 74 ))). (print
47d0: 20 0a 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 . (string
47e0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 28 -intersperse ..(
47f0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a map (lambda (x).
4800: 09 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d . (string-
4810: 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 09 78 intersperse ...x
4820: 0a 09 09 22 20 3d 3e 20 22 29 29 0a 09 20 20 20 ..." => "))..
4830: 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 64 69 (common:get-di
4840: 73 6b 73 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 sks *configdat*)
4850: 29 0a 09 22 5c 6e 22 29 29 0a 20 20 20 20 20 20 ).."\n")).
4860: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
4870: 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 63 ing* #t)))..;; c
4880: 73 76 20 70 72 6f 63 65 73 73 69 6e 67 20 72 65 sv processing re
4890: 63 6f 72 64 0a 28 64 65 66 69 6e 65 20 28 6d 61 cord.(define (ma
48a0: 6b 65 2d 72 65 66 64 62 3a 63 73 76 29 0a 20 20 ke-refdb:csv).
48b0: 28 76 65 63 74 6f 72 20 0a 20 20 20 28 6d 61 6b (vector . (mak
48c0: 65 2d 73 70 61 72 73 65 2d 61 72 72 61 79 29 0a e-sparse-array).
48d0: 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 (make-hash-ta
48e0: 62 6c 65 29 0a 20 20 20 28 6d 61 6b 65 2d 68 61 ble). (make-ha
48f0: 73 68 2d 74 61 62 6c 65 29 0a 20 20 20 30 0a 20 sh-table). 0.
4900: 20 20 30 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 0)).(define-in
4910: 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d line (refdb:csv-
4920: 67 65 74 2d 73 76 65 63 20 20 20 20 20 76 65 63 get-svec vec
4930: 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 ) (vector-ref
4940: 20 20 76 65 63 20 30 29 29 0a 28 64 65 66 69 6e vec 0)).(defin
4950: 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a e-inline (refdb:
4960: 63 73 76 2d 67 65 74 2d 72 6f 77 73 20 20 20 20 csv-get-rows
4970: 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 vec) (vector
4980: 2d 72 65 66 20 20 76 65 63 20 31 29 29 0a 28 64 -ref vec 1)).(d
4990: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 efine-inline (re
49a0: 66 64 62 3a 63 73 76 2d 67 65 74 2d 63 6f 6c 73 fdb:csv-get-cols
49b0: 20 20 20 20 20 76 65 63 29 20 20 20 20 28 76 65 vec) (ve
49c0: 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 32 29 ctor-ref vec 2)
49d0: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 ).(define-inline
49e0: 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d (refdb:csv-get-
49f0: 6d 61 78 72 6f 77 20 20 20 76 65 63 29 20 20 20 maxrow vec)
4a00: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 (vector-ref ve
4a10: 63 20 33 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e c 3)).(define-in
4a20: 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d line (refdb:csv-
4a30: 67 65 74 2d 6d 61 78 63 6f 6c 20 20 20 76 65 63 get-maxcol vec
4a40: 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 ) (vector-ref
4a50: 20 20 76 65 63 20 34 29 29 0a 28 64 65 66 69 6e vec 4)).(defin
4a60: 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a e-inline (refdb:
4a70: 63 73 76 2d 73 65 74 2d 73 76 65 63 21 20 20 20 csv-set-svec!
4a80: 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 vec val)(vector
4a90: 2d 73 65 74 21 20 76 65 63 20 30 20 76 61 6c 29 -set! vec 0 val)
4aa0: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 ).(define-inline
4ab0: 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d (refdb:csv-set-
4ac0: 72 6f 77 73 21 20 20 20 20 76 65 63 20 76 61 6c rows! vec val
4ad0: 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 )(vector-set! ve
4ae0: 63 20 31 20 76 61 6c 29 29 0a 28 64 65 66 69 6e c 1 val)).(defin
4af0: 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a e-inline (refdb:
4b00: 63 73 76 2d 73 65 74 2d 63 6f 6c 73 21 20 20 20 csv-set-cols!
4b10: 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 vec val)(vector
4b20: 2d 73 65 74 21 20 76 65 63 20 32 20 76 61 6c 29 -set! vec 2 val)
4b30: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 ).(define-inline
4b40: 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d (refdb:csv-set-
4b50: 6d 61 78 72 6f 77 21 20 20 76 65 63 20 76 61 6c maxrow! vec val
4b60: 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 )(vector-set! ve
4b70: 63 20 33 20 76 61 6c 29 29 0a 28 64 65 66 69 6e c 3 val)).(defin
4b80: 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a e-inline (refdb:
4b90: 63 73 76 2d 73 65 74 2d 6d 61 78 63 6f 6c 21 20 csv-set-maxcol!
4ba0: 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 vec val)(vector
4bb0: 2d 73 65 74 21 20 76 65 63 20 34 20 76 61 6c 29 -set! vec 4 val)
4bc0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d )..(define (get-
4bd0: 64 61 74 20 72 65 73 75 6c 74 73 20 73 68 65 65 dat results shee
4be0: 74 6e 61 6d 65 29 0a 20 20 28 6f 72 20 28 68 61 tname). (or (ha
4bf0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
4c00: 61 75 6c 74 20 72 65 73 75 6c 74 73 20 73 68 65 ault results she
4c10: 65 74 6e 61 6d 65 20 23 66 29 0a 20 20 20 20 20 etname #f).
4c20: 20 28 6c 65 74 20 28 28 74 6d 70 2d 76 65 63 20 (let ((tmp-vec
4c30: 20 28 6d 61 6b 65 2d 72 65 66 64 62 3a 63 73 76 (make-refdb:csv
4c40: 29 29 29 0a 09 28 68 61 73 68 2d 74 61 62 6c 65 )))..(hash-table
4c50: 2d 73 65 74 21 20 72 65 73 75 6c 74 73 20 73 68 -set! results sh
4c60: 65 65 74 6e 61 6d 65 20 74 6d 70 2d 76 65 63 29 eetname tmp-vec)
4c70: 0a 09 74 6d 70 2d 76 65 63 29 29 29 0a 0a 28 69 ..tmp-vec)))..(i
4c80: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
4c90: 22 2d 72 65 66 64 62 32 64 61 74 22 29 0a 20 20 "-refdb2dat").
4ca0: 20 20 28 6c 65 74 2a 20 28 28 69 6e 70 75 74 2d (let* ((input-
4cb0: 64 62 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 db (args:get-arg
4cc0: 20 22 2d 72 65 66 64 62 32 64 61 74 22 29 29 0a "-refdb2dat")).
4cd0: 09 20 20 20 28 6f 75 74 2d 66 69 6c 65 20 28 61 . (out-file (a
4ce0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 22 rgs:get-arg "-o"
4cf0: 29 29 0a 09 20 20 20 28 6f 75 74 2d 66 6d 74 20 )).. (out-fmt
4d00: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
4d10: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 rg "-dumpmode")
4d20: 22 73 63 68 65 6d 65 22 29 29 0a 09 20 20 20 28 "scheme")).. (
4d30: 6f 75 74 2d 70 6f 72 74 20 28 69 66 20 28 61 6e out-port (if (an
4d40: 64 20 6f 75 74 2d 66 69 6c 65 20 0a 09 09 09 20 d out-file ....
4d50: 20 20 20 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 (not (membe
4d60: 72 20 6f 75 74 2d 66 6d 74 20 27 28 22 73 71 6c r out-fmt '("sql
4d70: 69 74 65 33 22 20 22 63 73 76 22 29 29 29 29 0a ite3" "csv")))).
4d80: 09 09 09 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 ... (open-output
4d90: 2d 66 69 6c 65 20 6f 75 74 2d 66 69 6c 65 29 0a -file out-file).
4da0: 09 09 09 20 28 63 75 72 72 65 6e 74 2d 6f 75 74 ... (current-out
4db0: 70 75 74 2d 70 6f 72 74 29 29 29 0a 09 20 20 20 put-port)))..
4dc0: 28 72 65 73 2d 64 61 74 61 20 28 63 6f 6e 66 69 (res-data (confi
4dd0: 67 66 3a 72 65 61 64 2d 72 65 66 64 62 20 69 6e gf:read-refdb in
4de0: 70 75 74 2d 64 62 29 29 0a 09 20 20 20 28 64 61 put-db)).. (da
4df0: 74 61 20 20 20 20 20 28 63 61 72 20 72 65 73 2d ta (car res-
4e00: 64 61 74 61 29 29 0a 09 20 20 20 28 6d 73 67 20 data)).. (msg
4e10: 20 20 20 20 20 28 63 61 64 72 20 72 65 73 2d 64 (cadr res-d
4e20: 61 74 61 29 29 29 0a 20 20 20 20 20 20 28 69 66 ata))). (if
4e30: 20 28 6e 6f 74 20 64 61 74 61 29 0a 09 20 20 28 (not data).. (
4e40: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
4e50: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
4e60: 20 22 42 61 64 20 69 6e 70 75 74 3f 20 64 61 74 "Bad input? dat
4e70: 61 3d 22 20 64 61 74 61 29 20 3b 3b 20 73 6f 6d a=" data) ;; som
4e80: 65 20 65 72 72 6f 72 20 6f 63 63 75 72 72 65 64 e error occurred
4e90: 0a 09 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 .. (with-output
4ea0: 2d 74 6f 2d 70 6f 72 74 20 6f 75 74 2d 70 6f 72 -to-port out-por
4eb0: 74 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 t.. (lambda (
4ec0: 29 0a 09 20 20 20 20 20 20 28 63 61 73 65 20 28 ).. (case (
4ed0: 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 6f string->symbol o
4ee0: 75 74 2d 66 6d 74 29 0a 09 09 28 28 73 63 68 65 ut-fmt)...((sche
4ef0: 6d 65 29 28 70 70 20 64 61 74 61 29 29 0a 09 09 me)(pp data))...
4f00: 28 28 70 65 72 6c 29 0a 09 09 20 3b 3b 20 28 70 ((perl)... ;; (p
4f10: 72 69 6e 74 20 22 25 68 61 73 68 20 3d 20 28 22 rint "%hash = ("
4f20: 29 0a 09 09 20 3b 3b 20 20 20 20 20 20 20 20 6b )... ;; k
4f30: 65 79 31 20 3d 3e 20 27 76 61 6c 75 65 31 27 2c ey1 => 'value1',
4f40: 0a 09 09 20 3b 3b 20 20 20 20 20 20 20 20 6b 65 ... ;; ke
4f50: 79 32 20 3d 3e 20 27 76 61 6c 75 65 32 27 2c 0a y2 => 'value2',.
4f60: 09 09 20 3b 3b 20 20 20 20 20 20 20 20 6b 65 79 .. ;; key
4f70: 33 20 3d 3e 20 27 76 61 6c 75 65 33 27 2c 0a 09 3 => 'value3',..
4f80: 09 20 3b 3b 20 29 3b 0a 09 09 20 28 63 6f 6e 66 . ;; );... (conf
4f90: 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 igf:map-all-hier
4fa0: 2d 61 6c 69 73 74 20 0a 09 09 20 20 64 61 74 61 -alist ... data
4fb0: 20 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 28 73 ... (lambda (s
4fc0: 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e heetname section
4fd0: 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c name varname val
4fe0: 29 0a 09 09 20 20 20 20 28 70 72 69 6e 74 20 22 )... (print "
4ff0: 24 64 61 74 61 7b 5c 22 22 20 73 68 65 65 74 6e $data{\"" sheetn
5000: 61 6d 65 20 22 5c 22 7d 7b 5c 22 22 20 73 65 63 ame "\"}{\"" sec
5010: 74 69 6f 6e 6e 61 6d 65 20 22 5c 22 7d 7b 5c 22 tionname "\"}{\"
5020: 22 20 76 61 72 6e 61 6d 65 20 22 5c 22 7d 20 3d " varname "\"} =
5030: 20 5c 22 22 20 76 61 6c 20 22 5c 22 3b 22 29 29 \"" val "\";"))
5040: 29 29 0a 09 09 28 28 70 79 74 68 6f 6e 20 72 75 ))...((python ru
5050: 62 79 29 0a 09 09 20 28 70 72 69 6e 74 20 22 64 by)... (print "d
5060: 61 74 61 3d 7b 7d 22 29 0a 09 09 20 28 63 6f 6e ata={}")... (con
5070: 66 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 figf:map-all-hie
5080: 72 2d 61 6c 69 73 74 0a 09 09 20 20 64 61 74 61 r-alist... data
5090: 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 28 73 68 ... (lambda (sh
50a0: 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e eetname sectionn
50b0: 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 ame varname val)
50c0: 0a 09 09 20 20 20 20 28 70 72 69 6e 74 20 22 64 ... (print "d
50d0: 61 74 61 5b 5c 22 22 20 73 68 65 65 74 6e 61 6d ata[\"" sheetnam
50e0: 65 20 22 5c 22 5d 5b 5c 22 22 20 73 65 63 74 69 e "\"][\"" secti
50f0: 6f 6e 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 22 20 onname "\"][\""
5100: 76 61 72 6e 61 6d 65 20 22 5c 22 5d 20 3d 20 5c varname "\"] = \
5110: 22 22 20 76 61 6c 20 22 5c 22 22 29 29 0a 09 09 "" val "\""))...
5120: 20 20 69 6e 69 74 70 72 6f 63 31 3a 0a 09 09 20 initproc1:...
5130: 20 28 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e (lambda (sheetn
5140: 61 6d 65 29 0a 09 09 20 20 20 20 28 70 72 69 6e ame)... (prin
5150: 74 20 22 64 61 74 61 5b 5c 22 22 20 73 68 65 65 t "data[\"" shee
5160: 74 6e 61 6d 65 20 22 5c 22 5d 20 3d 20 7b 7d 22 tname "\"] = {}"
5170: 29 29 0a 09 09 20 20 69 6e 69 74 70 72 6f 63 32 ))... initproc2
5180: 3a 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 28 73 :... (lambda (s
5190: 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e heetname section
51a0: 6e 61 6d 65 29 0a 09 09 20 20 20 20 28 70 72 69 name)... (pri
51b0: 6e 74 20 22 64 61 74 61 5b 5c 22 22 20 73 68 65 nt "data[\"" she
51c0: 65 74 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 22 20 etname "\"][\""
51d0: 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 5c 22 5d sectionname "\"]
51e0: 20 3d 20 7b 7d 22 29 29 29 29 0a 09 09 28 28 63 = {}"))))...((c
51f0: 73 76 29 0a 09 09 20 28 6c 65 74 2a 20 28 28 72 sv)... (let* ((r
5200: 65 73 75 6c 74 73 20 20 28 6d 61 6b 65 2d 68 61 esults (make-ha
5210: 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 28 6d sh-table)) ;; (m
5220: 61 6b 65 2d 73 70 61 72 73 65 2d 61 72 72 61 79 ake-sparse-array
5230: 29 29 29 0a 09 09 09 28 72 6f 77 2d 63 6f 6c 73 )))....(row-cols
5240: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
5250: 65 29 29 29 20 3b 3b 20 68 61 73 68 20 6f 66 20 e))) ;; hash of
5260: 68 61 73 68 65 73 20 77 68 65 72 65 20 73 65 63 hashes where sec
5270: 74 69 6f 6e 20 3d 3e 20 68 74 20 7b 20 72 6f 77 tion => ht { row
5280: 2d 3c 6e 61 6d 65 3e 20 3d 3e 20 6e 75 6d 20 6f -<name> => num o
5290: 72 20 63 6f 6c 2d 3c 6e 61 6d 65 3e 20 3d 3e 20 r col-<name> =>
52a0: 6e 75 6d 0a 09 09 20 20 20 3b 3b 20 28 70 72 69 num... ;; (pri
52b0: 6e 74 20 22 64 61 74 61 3d 22 29 0a 09 09 20 20 nt "data=")...
52c0: 20 3b 3b 20 28 70 70 20 64 61 74 61 29 0a 09 09 ;; (pp data)...
52d0: 20 20 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d (configf:map-
52e0: 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 0a 09 all-hier-alist..
52f0: 09 20 20 20 20 64 61 74 61 0a 09 09 20 20 20 20 . data...
5300: 28 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 (lambda (sheetna
5310: 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 me sectionname v
5320: 61 72 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 arname val)...
5330: 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 ;; (print "s
5340: 68 65 65 74 6e 61 6d 65 3a 20 22 20 73 68 65 65 heetname: " shee
5350: 74 6e 61 6d 65 20 22 2c 20 73 65 63 74 69 6f 6e tname ", section
5360: 6e 61 6d 65 3a 20 22 20 73 65 63 74 69 6f 6e 6e name: " sectionn
5370: 61 6d 65 20 22 2c 20 76 61 72 6e 61 6d 65 3a 20 ame ", varname:
5380: 22 20 76 61 72 6e 61 6d 65 20 22 2c 20 76 61 6c " varname ", val
5390: 3a 20 22 20 76 61 6c 29 0a 09 09 20 20 20 20 20 : " val)...
53a0: 20 28 6c 65 74 2a 20 28 28 64 61 74 20 20 20 20 (let* ((dat
53b0: 20 20 28 67 65 74 2d 64 61 74 20 72 65 73 75 6c (get-dat resul
53c0: 74 73 20 73 68 65 65 74 6e 61 6d 65 29 29 0a 09 ts sheetname))..
53d0: 09 09 20 20 20 20 20 28 76 65 63 20 20 20 20 20 .. (vec
53e0: 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d (refdb:csv-get-
53f0: 73 76 65 63 20 64 61 74 29 29 0a 09 09 09 20 20 svec dat))....
5400: 20 20 20 28 72 6f 77 6e 61 6d 65 73 20 28 72 65 (rownames (re
5410: 66 64 62 3a 63 73 76 2d 67 65 74 2d 72 6f 77 73 fdb:csv-get-rows
5420: 20 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 dat)).... (
5430: 63 6f 6c 6e 61 6d 65 73 20 28 72 65 66 64 62 3a colnames (refdb:
5440: 63 73 76 2d 67 65 74 2d 63 6f 6c 73 20 64 61 74 csv-get-cols dat
5450: 29 29 0a 09 09 09 20 20 20 20 20 28 63 75 72 72 )).... (curr
5460: 72 6f 77 6e 20 28 68 61 73 68 2d 74 61 62 6c 65 rown (hash-table
5470: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 6f 77 -ref/default row
5480: 6e 61 6d 65 73 20 76 61 72 6e 61 6d 65 20 23 66 names varname #f
5490: 29 29 0a 09 09 09 20 20 20 20 20 28 63 75 72 72 )).... (curr
54a0: 63 6f 6c 6e 20 28 68 61 73 68 2d 74 61 62 6c 65 coln (hash-table
54b0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 6f 6c -ref/default col
54c0: 6e 61 6d 65 73 20 73 65 63 74 69 6f 6e 6e 61 6d names sectionnam
54d0: 65 20 23 66 29 29 0a 09 09 09 20 20 20 20 20 28 e #f)).... (
54e0: 72 6f 77 6e 20 20 20 20 20 28 6f 72 20 63 75 72 rown (or cur
54f0: 72 72 6f 77 6e 20 0a 09 09 09 09 09 20 20 20 28 rrown ...... (
5500: 6c 65 74 2a 20 28 28 6c 61 73 74 6e 20 20 20 28 let* ((lastn (
5510: 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 refdb:csv-get-ma
5520: 78 72 6f 77 20 64 61 74 29 29 0a 09 09 09 09 09 xrow dat))......
5530: 09 20 20 28 6e 65 77 72 6f 77 6e 20 28 2b 20 6c . (newrown (+ l
5540: 61 73 74 6e 20 31 29 29 29 0a 09 09 09 09 09 20 astn 1)))......
5550: 20 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 73 (refdb:csv-s
5560: 65 74 2d 6d 61 78 72 6f 77 21 20 64 61 74 20 6e et-maxrow! dat n
5570: 65 77 72 6f 77 6e 29 0a 09 09 09 09 09 20 20 20 ewrown)......
5580: 20 20 6e 65 77 72 6f 77 6e 29 29 29 0a 09 09 09 newrown)))....
5590: 20 20 20 20 20 28 63 6f 6c 6e 20 20 20 20 20 28 (coln (
55a0: 6f 72 20 63 75 72 72 63 6f 6c 6e 20 0a 09 09 09 or currcoln ....
55b0: 09 09 20 20 20 28 6c 65 74 2a 20 28 28 6c 61 73 .. (let* ((las
55c0: 74 6e 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d tn (refdb:csv-
55d0: 67 65 74 2d 6d 61 78 63 6f 6c 20 64 61 74 29 29 get-maxcol dat))
55e0: 0a 09 09 09 09 09 09 20 20 28 6e 65 77 63 6f 6c ....... (newcol
55f0: 6e 20 28 2b 20 6c 61 73 74 6e 20 31 29 29 29 0a n (+ lastn 1))).
5600: 09 09 09 09 09 20 20 20 20 20 28 72 65 66 64 62 ..... (refdb
5610: 3a 63 73 76 2d 73 65 74 2d 6d 61 78 63 6f 6c 21 :csv-set-maxcol!
5620: 20 64 61 74 20 6e 65 77 63 6f 6c 6e 29 0a 09 09 dat newcoln)...
5630: 09 09 09 20 20 20 20 20 6e 65 77 63 6f 6c 6e 29 ... newcoln)
5640: 29 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 )))....(if (not
5650: 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 (sparse-array-re
5660: 66 20 76 65 63 20 30 20 63 6f 6c 6e 29 29 20 3b f vec 0 coln)) ;
5670: 3b 20 28 65 71 3f 20 72 6f 77 6e 20 30 29 0a 09 ; (eq? rown 0)..
5680: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 .. (begin....
5690: 20 20 20 20 20 20 28 73 70 61 72 73 65 2d 61 72 (sparse-ar
56a0: 72 61 79 2d 73 65 74 21 20 76 65 63 20 30 20 63 ray-set! vec 0 c
56b0: 6f 6c 6e 20 73 65 63 74 69 6f 6e 6e 61 6d 65 29 oln sectionname)
56c0: 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 28 70 72 .... ;; (pr
56d0: 69 6e 74 20 22 73 70 61 72 73 65 2d 61 72 72 61 int "sparse-arra
56e0: 79 2d 72 65 66 20 22 20 30 20 22 2c 22 20 63 6f y-ref " 0 "," co
56f0: 6c 6e 20 22 3d 22 20 28 73 70 61 72 73 65 2d 61 ln "=" (sparse-a
5700: 72 72 61 79 2d 72 65 66 20 76 65 63 20 30 20 63 rray-ref vec 0 c
5710: 6f 6c 6e 29 29 0a 09 09 09 20 20 20 20 20 20 29 oln)).... )
5720: 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 28 73 )....(if (not (s
5730: 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 parse-array-ref
5740: 76 65 63 20 72 6f 77 6e 20 30 29 29 20 3b 3b 20 vec rown 0)) ;;
5750: 28 65 71 3f 20 63 6f 6c 6e 20 30 29 0a 09 09 09 (eq? coln 0)....
5760: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 (begin....
5770: 20 20 20 20 28 73 70 61 72 73 65 2d 61 72 72 61 (sparse-arra
5780: 79 2d 73 65 74 21 20 76 65 63 20 72 6f 77 6e 20 y-set! vec rown
5790: 30 20 76 61 72 6e 61 6d 65 29 0a 09 09 09 20 20 0 varname)....
57a0: 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 ;; (print "s
57b0: 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 parse-array-ref
57c0: 22 20 72 6f 77 6e 20 22 2c 22 20 30 20 22 3d 22 " rown "," 0 "="
57d0: 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 (sparse-array-r
57e0: 65 66 20 76 65 63 20 72 6f 77 6e 20 30 29 29 0a ef vec rown 0)).
57f0: 09 09 09 20 20 20 20 20 20 29 29 0a 09 09 09 28 ... ))....(
5800: 69 66 20 28 6e 6f 74 20 63 75 72 72 72 6f 77 6e if (not currrown
5810: 29 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 )(hash-table-set
5820: 21 20 72 6f 77 6e 61 6d 65 73 20 76 61 72 6e 61 ! rownames varna
5830: 6d 65 20 72 6f 77 6e 29 29 0a 09 09 09 28 69 66 me rown))....(if
5840: 20 28 6e 6f 74 20 63 75 72 72 63 6f 6c 6e 29 28 (not currcoln)(
5850: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
5860: 63 6f 6c 6e 61 6d 65 73 20 73 65 63 74 69 6f 6e colnames section
5870: 6e 61 6d 65 20 63 6f 6c 6e 29 29 0a 09 09 09 3b name coln))....;
5880: 3b 20 28 70 72 69 6e 74 20 22 64 61 74 3d 22 20 ; (print "dat="
5890: 64 61 74 20 22 2c 20 72 6f 77 6e 3d 22 20 72 6f dat ", rown=" ro
58a0: 77 6e 20 22 2c 20 63 6f 6c 6e 3d 22 20 63 6f 6c wn ", coln=" col
58b0: 6e 29 0a 09 09 09 28 73 70 61 72 73 65 2d 61 72 n)....(sparse-ar
58c0: 72 61 79 2d 73 65 74 21 20 76 65 63 20 72 6f 77 ray-set! vec row
58d0: 6e 20 63 6f 6c 6e 20 76 61 6c 29 0a 09 09 09 3b n coln val)....;
58e0: 3b 20 28 70 72 69 6e 74 20 22 73 70 61 72 73 65 ; (print "sparse
58f0: 2d 61 72 72 61 79 2d 72 65 66 20 22 20 72 6f 77 -array-ref " row
5900: 6e 20 22 2c 22 20 63 6f 6c 6e 20 22 3d 22 20 28 n "," coln "=" (
5910: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 sparse-array-ref
5920: 20 76 65 63 20 72 6f 77 6e 20 63 6f 6c 6e 29 29 vec rown coln))
5930: 0a 09 09 09 29 29 29 0a 09 09 20 20 20 28 66 6f ....)))... (fo
5940: 72 2d 65 61 63 68 0a 09 09 20 20 20 20 28 6c 61 r-each... (la
5950: 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 29 mbda (sheetname)
5960: 0a 09 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 ... (let* (
5970: 28 73 68 65 65 74 64 61 74 20 28 67 65 74 2d 64 (sheetdat (get-d
5980: 61 74 20 72 65 73 75 6c 74 73 20 73 68 65 65 74 at results sheet
5990: 6e 61 6d 65 29 29 0a 09 09 09 20 20 20 20 20 28 name)).... (
59a0: 73 76 65 63 20 20 20 20 20 28 72 65 66 64 62 3a svec (refdb:
59b0: 63 73 76 2d 67 65 74 2d 73 76 65 63 20 73 68 65 csv-get-svec she
59c0: 65 74 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 etdat))....
59d0: 28 6d 61 78 72 6f 77 20 20 20 28 72 65 66 64 62 (maxrow (refdb
59e0: 3a 63 73 76 2d 67 65 74 2d 6d 61 78 72 6f 77 20 :csv-get-maxrow
59f0: 73 68 65 65 74 64 61 74 29 29 0a 09 09 09 20 20 sheetdat))....
5a00: 20 20 20 28 6d 61 78 63 6f 6c 20 20 20 28 72 65 (maxcol (re
5a10: 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 63 fdb:csv-get-maxc
5a20: 6f 6c 20 73 68 65 65 74 64 61 74 29 29 0a 09 09 ol sheetdat))...
5a30: 09 20 20 20 20 20 28 66 6e 61 6d 65 20 20 20 20 . (fname
5a40: 28 69 66 20 6f 75 74 2d 66 69 6c 65 20 0a 09 09 (if out-file ...
5a50: 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d 73 75 ... (string-su
5a60: 62 73 74 69 74 75 74 65 20 22 25 73 22 20 73 68 bstitute "%s" sh
5a70: 65 65 74 6e 61 6d 65 20 6f 75 74 2d 66 69 6c 65 eetname out-file
5a80: 29 20 3b 3b 20 22 2f 66 6f 6f 2f 62 61 72 2f 25 ) ;; "/foo/bar/%
5a90: 73 2e 63 73 76 22 29 0a 09 09 09 09 09 20 20 20 s.csv")......
5aa0: 28 63 6f 6e 63 20 73 68 65 65 74 6e 61 6d 65 20 (conc sheetname
5ab0: 22 2e 63 73 76 22 29 29 29 29 0a 09 09 09 28 77 ".csv"))))....(w
5ac0: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 ith-output-to-fi
5ad0: 6c 65 20 66 6e 61 6d 65 0a 09 09 09 20 20 28 6c le fname.... (l
5ae0: 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 20 ambda ()....
5af0: 3b 3b 20 28 70 72 69 6e 74 20 22 53 68 65 65 74 ;; (print "Sheet
5b00: 6e 61 6d 65 3a 20 22 20 73 68 65 65 74 6e 61 6d name: " sheetnam
5b10: 65 29 0a 09 09 09 20 20 20 20 28 6c 65 74 20 6c e).... (let l
5b20: 6f 6f 70 20 28 28 72 6f 77 20 20 20 20 20 20 20 oop ((row
5b30: 30 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 63 0)..... (c
5b40: 6f 6c 20 20 20 20 20 20 20 30 29 0a 09 09 09 09 ol 0).....
5b50: 20 20 20 20 20 20 20 28 63 75 72 72 2d 72 6f 77 (curr-row
5b60: 20 27 28 29 29 0a 09 09 09 09 20 20 20 20 20 20 '()).....
5b70: 20 28 72 65 73 75 6c 74 20 20 20 27 28 29 29 29 (result '()))
5b80: 0a 09 09 09 20 20 20 20 20 20 28 6c 65 74 2a 20 .... (let*
5b90: 28 28 76 61 6c 20 28 73 70 61 72 73 65 2d 61 72 ((val (sparse-ar
5ba0: 72 61 79 2d 72 65 66 20 73 76 65 63 20 72 6f 77 ray-ref svec row
5bb0: 20 63 6f 6c 29 29 0a 09 09 09 09 20 20 20 20 20 col)).....
5bc0: 28 64 69 73 70 2d 76 61 6c 20 28 69 66 20 76 61 (disp-val (if va
5bd0: 6c 0a 09 09 09 09 09 09 20 20 20 28 63 6f 6e 63 l....... (conc
5be0: 20 22 5c 22 22 20 76 61 6c 20 22 5c 22 22 29 0a "\"" val "\"").
5bf0: 09 09 09 09 09 09 20 20 20 22 22 29 29 29 0a 09 ...... "")))..
5c00: 09 09 09 28 69 66 20 28 3e 20 63 6f 6c 20 30 29 ...(if (> col 0)
5c10: 28 64 69 73 70 6c 61 79 20 22 2c 22 29 29 0a 09 (display ","))..
5c20: 09 09 09 28 64 69 73 70 6c 61 79 20 64 69 73 70 ...(display disp
5c30: 2d 76 61 6c 29 0a 09 09 09 09 28 63 6f 6e 64 0a -val).....(cond.
5c40: 09 09 09 09 20 28 28 3e 20 72 6f 77 20 6d 61 78 .... ((> row max
5c50: 72 6f 77 29 28 64 69 73 70 6c 61 79 20 22 5c 6e row)(display "\n
5c60: 22 29 20 72 65 73 75 6c 74 29 0a 09 09 09 09 20 ") result).....
5c70: 28 28 3e 3d 20 63 6f 6c 20 6d 61 78 63 6f 6c 29 ((>= col maxcol)
5c80: 0a 09 09 09 09 20 20 28 64 69 73 70 6c 61 79 20 ..... (display
5c90: 22 5c 6e 22 29 0a 09 09 09 09 20 20 28 6c 6f 6f "\n")..... (loo
5ca0: 70 20 28 2b 20 72 6f 77 20 31 29 20 30 20 27 28 p (+ row 1) 0 '(
5cb0: 29 20 28 61 70 70 65 6e 64 20 72 65 73 75 6c 74 ) (append result
5cc0: 20 28 6c 69 73 74 20 63 75 72 72 2d 72 6f 77 29 (list curr-row)
5cd0: 29 29 29 0a 09 09 09 09 20 28 65 6c 73 65 0a 09 )))..... (else..
5ce0: 09 09 09 20 20 28 6c 6f 6f 70 20 72 6f 77 20 28 ... (loop row (
5cf0: 2b 20 63 6f 6c 20 31 29 20 28 61 70 70 65 6e 64 + col 1) (append
5d00: 20 63 75 72 72 2d 72 6f 77 20 28 6c 69 73 74 20 curr-row (list
5d10: 76 61 6c 29 29 20 72 65 73 75 6c 74 29 29 29 29 val)) result))))
5d20: 29 29 29 29 29 0a 09 09 20 20 20 20 28 68 61 73 )))))... (has
5d30: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 65 73 h-table-keys res
5d40: 75 6c 74 73 29 29 29 29 0a 09 09 28 28 73 71 6c ults))))...((sql
5d50: 69 74 65 33 29 0a 09 09 20 28 6c 65 74 2a 20 28 ite3)... (let* (
5d60: 28 64 62 2d 66 69 6c 65 20 20 20 28 6f 72 20 6f (db-file (or o
5d70: 75 74 2d 66 69 6c 65 20 28 70 61 74 68 6e 61 6d ut-file (pathnam
5d80: 65 2d 66 69 6c 65 20 69 6e 70 75 74 2d 64 62 29 e-file input-db)
5d90: 29 29 0a 09 09 09 28 64 62 2d 65 78 69 73 74 73 ))....(db-exists
5da0: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 (file-exists? d
5db0: 62 2d 66 69 6c 65 29 29 0a 09 09 09 28 64 62 20 b-file))....(db
5dc0: 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a (sqlite3:
5dd0: 6f 70 65 6e 2d 64 61 74 61 62 61 73 65 20 64 62 open-database db
5de0: 2d 66 69 6c 65 29 29 29 0a 09 09 20 20 20 28 69 -file)))... (i
5df0: 66 20 28 6e 6f 74 20 64 62 2d 65 78 69 73 74 73 f (not db-exists
5e00: 29 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 )(sqlite3:execut
5e10: 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42 e db "CREATE TAB
5e20: 4c 45 20 64 61 74 61 20 28 73 68 65 65 74 2c 73 LE data (sheet,s
5e30: 65 63 74 69 6f 6e 2c 76 61 72 2c 76 61 6c 29 3b ection,var,val);
5e40: 22 29 29 0a 09 09 20 20 20 28 63 6f 6e 66 69 67 "))... (config
5e50: 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 f:map-all-hier-a
5e60: 6c 69 73 74 0a 09 09 20 20 20 20 64 61 74 61 0a list... data.
5e70: 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 .. (lambda (s
5e80: 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e heetname section
5e90: 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c name varname val
5ea0: 29 0a 09 09 20 20 20 20 20 20 28 73 71 6c 69 74 )... (sqlit
5eb0: 65 33 3a 65 78 65 63 75 74 65 20 64 62 0a 09 09 e3:execute db...
5ec0: 09 09 20 20 20 20 20 20 20 22 49 4e 53 45 52 54 .. "INSERT
5ed0: 20 4f 52 20 52 45 50 4c 41 43 45 20 49 4e 54 4f OR REPLACE INTO
5ee0: 20 64 61 74 61 20 28 73 68 65 65 74 2c 73 65 63 data (sheet,sec
5ef0: 74 69 6f 6e 2c 76 61 72 2c 76 61 6c 29 20 56 41 tion,var,val) VA
5f00: 4c 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 29 3b 22 LUES (?,?,?,?);"
5f10: 0a 09 09 09 09 20 20 20 20 20 20 20 73 68 65 65 ..... shee
5f20: 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d tname sectionnam
5f30: 65 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 29 29 e varname val)))
5f40: 0a 09 09 20 20 20 28 73 71 6c 69 74 65 33 3a 66 ... (sqlite3:f
5f50: 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 29 0a 09 inalize! db)))..
5f60: 09 28 65 6c 73 65 0a 09 09 20 28 70 70 20 64 61 .(else... (pp da
5f70: 74 61 29 29 29 29 29 29 0a 20 20 20 20 20 20 28 ta)))))). (
5f80: 69 66 20 6f 75 74 2d 66 69 6c 65 20 28 63 6c 6f if out-file (clo
5f90: 73 65 2d 6f 75 74 70 75 74 2d 70 6f 72 74 20 6f se-output-port o
5fa0: 75 74 2d 70 6f 72 74 29 29 0a 20 20 20 20 20 20 ut-port)).
5fb0: 28 65 78 69 74 29 20 3b 3b 20 79 65 73 2c 20 62 (exit) ;; yes, b
5fc0: 65 6e 64 69 6e 67 20 74 68 65 20 72 75 6c 65 73 ending the rules
5fd0: 20 68 65 72 65 20 2d 20 6e 65 65 64 20 74 6f 20 here - need to
5fe0: 65 78 69 74 20 73 69 6e 63 65 20 74 68 69 73 20 exit since this
5ff0: 69 73 20 61 20 75 74 69 6c 69 74 79 0a 20 20 20 is a utility.
6000: 20 20 20 29 29 0a 0a 28 69 66 20 28 61 72 67 73 ))..(if (args
6010: 3a 67 65 74 2d 61 72 67 20 22 2d 70 69 6e 67 22 :get-arg "-ping"
6020: 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 73 65 ). (let* ((se
6030: 72 76 65 72 2d 69 64 20 20 20 20 20 28 73 74 72 rver-id (str
6040: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 ing->number (arg
6050: 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 69 6e 67 s:get-arg "-ping
6060: 22 29 29 29 20 3b 3b 20 65 78 74 72 61 63 74 20 "))) ;; extract
6070: 72 75 6e 2d 69 64 20 28 69 2e 65 2e 20 6e 6f 20 run-id (i.e. no
6080: 22 3a 22 0a 09 20 20 20 28 68 6f 73 74 3a 70 6f ":".. (host:po
6090: 72 74 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 rt (args:get
60a0: 2d 61 72 67 20 22 2d 70 69 6e 67 22 29 29 29 0a -arg "-ping"))).
60b0: 20 20 20 20 20 20 28 73 65 72 76 65 72 3a 70 69 (server:pi
60c0: 6e 67 20 28 6f 72 20 73 65 72 76 65 72 2d 69 64 ng (or server-id
60d0: 20 68 6f 73 74 3a 70 6f 72 74 29 20 64 6f 2d 65 host:port) do-e
60e0: 78 69 74 3a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d xit: #t)))..;;==
60f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6130: 3d 3d 3d 3d 0a 3b 3b 20 43 61 70 74 75 72 65 2c ====.;; Capture,
6140: 20 73 61 76 65 20 61 6e 64 20 6d 61 6e 69 70 75 save and manipu
6150: 6c 61 74 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 late environment
6160: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
6170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
61a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e ==========..;; N
61b0: 4f 54 45 3a 20 4b 65 65 70 20 74 68 65 73 65 20 OTE: Keep these
61c0: 61 62 6f 76 65 20 74 68 65 20 73 65 63 74 69 6f above the sectio
61d0: 6e 20 77 68 65 72 65 20 74 68 65 20 73 65 72 76 n where the serv
61e0: 65 72 20 6f 72 20 63 6c 69 65 6e 74 20 63 6f 64 er or client cod
61f0: 65 20 69 73 20 73 65 74 75 70 0a 0a 28 6c 65 74 e is setup..(let
6200: 20 28 28 65 6e 76 63 61 70 20 28 61 72 67 73 3a ((envcap (args:
6210: 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 63 61 70 get-arg "-envcap
6220: 22 29 29 29 0a 20 20 28 69 66 20 65 6e 76 63 61 "))). (if envca
6230: 70 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 p. (let* ((
6240: 64 62 20 20 20 20 20 20 28 65 6e 76 3a 6f 70 65 db (env:ope
6250: 6e 2d 64 62 20 28 69 66 20 28 6e 75 6c 6c 3f 20 n-db (if (null?
6260: 72 65 6d 61 72 67 73 29 20 22 65 6e 76 64 61 74 remargs) "envdat
6270: 2e 64 62 22 20 28 63 61 72 20 72 65 6d 61 72 67 .db" (car remarg
6280: 73 29 29 29 29 29 0a 09 28 65 6e 76 3a 73 61 76 s)))))..(env:sav
6290: 65 2d 65 6e 76 2d 76 61 72 73 20 64 62 20 65 6e e-env-vars db en
62a0: 76 63 61 70 29 0a 09 28 65 6e 76 3a 63 6c 6f 73 vcap)..(env:clos
62b0: 65 2d 64 61 74 61 62 61 73 65 20 64 62 29 0a 09 e-database db)..
62c0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
62d0: 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 20 ing* #t))))..;;
62e0: 64 65 6c 74 61 20 22 6c 61 6e 67 75 61 67 65 22 delta "language"
62f0: 20 77 69 6c 6c 20 65 76 65 6e 74 75 61 6c 6c 79 will eventually
6300: 20 62 65 20 72 65 73 3d 61 2b 62 2d 63 20 62 75 be res=a+b-c bu
6310: 74 20 66 6f 72 20 6e 6f 77 20 69 74 20 69 73 20 t for now it is
6320: 6a 75 73 74 20 72 65 73 3d 61 2d 62 20 0a 3b 3b just res=a-b .;;
6330: 0a 28 6c 65 74 20 28 28 65 6e 76 64 65 6c 74 61 .(let ((envdelta
6340: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6350: 2d 65 6e 76 64 65 6c 74 61 22 29 29 29 0a 20 20 -envdelta"))).
6360: 28 69 66 20 65 6e 76 64 65 6c 74 61 0a 20 20 20 (if envdelta.
6370: 20 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 20 (let ((match
6380: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 65 6e (string-split en
6390: 76 64 65 6c 74 61 20 22 2d 22 29 29 29 3b 3b 20 vdelta "-")));;
63a0: 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 22 28 (string-match "(
63b0: 5b 61 2d 7a 30 2d 39 5f 5d 2b 29 3d 28 5b 61 2d [a-z0-9_]+)=([a-
63c0: 7a 30 2d 39 5f 5c 5c 2d 2c 5d 2b 29 22 20 65 6e z0-9_\\-,]+)" en
63d0: 76 64 65 6c 74 61 29 29 29 0a 09 28 69 66 20 28 vdelta)))..(if (
63e0: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 6d 61 74 63 68 not (null? match
63f0: 29 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 )).. (let* ((
6400: 64 62 20 20 20 20 20 20 20 20 28 65 6e 76 3a 6f db (env:o
6410: 70 65 6e 2d 64 62 20 28 69 66 20 28 6e 75 6c 6c pen-db (if (null
6420: 3f 20 72 65 6d 61 72 67 73 29 20 22 65 6e 76 64 ? remargs) "envd
6430: 61 74 2e 64 62 22 20 28 63 61 72 20 72 65 6d 61 at.db" (car rema
6440: 72 67 73 29 29 29 29 0a 09 09 20 20 20 3b 3b 20 rgs))))... ;;
6450: 28 72 65 73 63 74 78 20 20 20 20 28 63 61 64 72 (resctx (cadr
6460: 20 6d 61 74 63 68 29 29 0a 09 09 20 20 20 3b 3b match))... ;;
6470: 20 28 65 71 75 6e 20 20 20 20 20 20 28 63 61 64 (equn (cad
6480: 64 72 20 6d 61 74 63 68 29 29 0a 09 09 20 20 20 dr match))...
6490: 28 70 61 72 74 73 20 20 20 20 20 6d 61 74 63 68 (parts match
64a0: 29 20 3b 3b 20 28 73 74 72 69 6e 67 2d 73 70 6c ) ;; (string-spl
64b0: 69 74 20 65 71 75 6e 20 22 2d 22 29 29 0a 09 09 it equn "-"))...
64c0: 20 20 20 28 6d 69 6e 75 65 6e 64 20 20 20 28 63 (minuend (c
64d0: 61 72 20 70 61 72 74 73 29 29 0a 09 09 20 20 20 ar parts))...
64e0: 28 73 75 62 74 72 61 65 6e 64 20 28 63 61 64 72 (subtraend (cadr
64f0: 20 70 61 72 74 73 29 29 0a 09 09 20 20 20 28 61 parts))... (a
6500: 64 64 65 64 20 20 20 20 20 28 65 6e 76 3a 67 65 dded (env:ge
6510: 74 2d 61 64 64 65 64 20 20 20 64 62 20 6d 69 6e t-added db min
6520: 75 65 6e 64 20 73 75 62 74 72 61 65 6e 64 29 29 uend subtraend))
6530: 0a 09 09 20 20 20 28 72 65 6d 6f 76 65 64 20 20 ... (removed
6540: 20 28 65 6e 76 3a 67 65 74 2d 72 65 6d 6f 76 65 (env:get-remove
6550: 64 20 64 62 20 6d 69 6e 75 65 6e 64 20 73 75 62 d db minuend sub
6560: 74 72 61 65 6e 64 29 29 0a 09 09 20 20 20 28 63 traend))... (c
6570: 68 61 6e 67 65 64 20 20 20 28 65 6e 76 3a 67 65 hanged (env:ge
6580: 74 2d 63 68 61 6e 67 65 64 20 64 62 20 6d 69 6e t-changed db min
6590: 75 65 6e 64 20 73 75 62 74 72 61 65 6e 64 29 29 uend subtraend))
65a0: 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 70 70 20 ).. ;; (pp
65b0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 (hash-table->ali
65c0: 73 74 20 61 64 64 65 64 29 29 0a 09 20 20 20 20 st added))..
65d0: 20 20 3b 3b 20 28 70 70 20 28 68 61 73 68 2d 74 ;; (pp (hash-t
65e0: 61 62 6c 65 2d 3e 61 6c 69 73 74 20 72 65 6d 6f able->alist remo
65f0: 76 65 64 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 ved)).. ;;
6600: 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (pp (hash-table-
6610: 3e 61 6c 69 73 74 20 63 68 61 6e 67 65 64 29 29 >alist changed))
6620: 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 72 67 .. (if (arg
6630: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 0a s:get-arg "-o").
6640: 09 09 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 .. (with-output
6650: 2d 74 6f 2d 66 69 6c 65 0a 09 09 20 20 20 20 20 -to-file...
6660: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6670: 2d 6f 22 29 0a 09 09 20 20 20 20 28 6c 61 6d 62 -o")... (lamb
6680: 64 61 20 28 29 0a 09 09 20 20 20 20 20 20 28 65 da ()... (e
6690: 6e 76 3a 70 72 69 6e 74 20 61 64 64 65 64 20 72 nv:print added r
66a0: 65 6d 6f 76 65 64 20 63 68 61 6e 67 65 64 29 29 emoved changed))
66b0: 29 0a 09 09 20 20 28 65 6e 76 3a 70 72 69 6e 74 )... (env:print
66c0: 20 61 64 64 65 64 20 72 65 6d 6f 76 65 64 20 63 added removed c
66d0: 68 61 6e 67 65 64 29 29 0a 09 20 20 20 20 20 20 hanged))..
66e0: 28 65 6e 76 3a 63 6c 6f 73 65 2d 64 61 74 61 62 (env:close-datab
66f0: 61 73 65 20 64 62 29 0a 09 20 20 20 20 20 20 28 ase db).. (
6700: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
6710: 6e 67 2a 20 23 74 29 29 0a 09 20 20 20 20 28 64 ng* #t)).. (d
6720: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
6730: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
6740: 70 6f 72 74 2a 20 22 50 61 72 61 6d 65 74 65 72 port* "Parameter
6750: 20 74 6f 20 2d 65 6e 76 64 65 6c 74 61 20 73 68 to -envdelta sh
6760: 6f 75 6c 64 20 62 65 20 6e 65 77 3d 73 74 61 72 ould be new=star
6770: 2d 65 6e 64 22 29 29 29 29 29 0a 0a 3b 3b 3d 3d -end")))))..;;==
6780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67c0: 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 74 68 ====.;; Start th
67d0: 65 20 73 65 72 76 65 72 20 2d 20 63 61 6e 20 62 e server - can b
67e0: 65 20 64 6f 6e 65 20 69 6e 20 63 6f 6e 6a 75 6e e done in conjun
67f0: 63 74 69 6f 6e 20 77 69 74 68 20 2d 72 75 6e 61 ction with -runa
6800: 6c 6c 20 6f 72 20 2d 72 75 6e 74 65 73 74 73 20 ll or -runtests
6810: 28 6f 6e 65 20 64 61 79 2e 2e 2e 29 0a 3b 3b 20 (one day...).;;
6820: 20 20 77 65 20 73 74 61 72 74 20 74 68 65 20 73 we start the s
6830: 65 72 76 65 72 20 69 66 20 6e 6f 74 20 72 75 6e erver if not run
6840: 6e 69 6e 67 20 65 6c 73 65 20 73 74 61 72 74 20 ning else start
6850: 74 68 65 20 63 6c 69 65 6e 74 20 74 68 72 65 61 the client threa
6860: 64 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d d.;;============
6870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
68a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
68b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
68c0: 73 65 72 76 65 72 22 29 0a 0a 20 20 20 20 3b 3b server").. ;;
68d0: 20 53 65 72 76 65 72 3f 20 53 74 61 72 74 20 75 Server? Start u
68e0: 70 20 68 65 72 65 2e 0a 20 20 20 20 3b 3b 0a 20 p here.. ;;.
68f0: 20 20 20 28 6c 65 74 20 28 28 74 6c 20 20 20 20 (let ((tl
6900: 20 20 20 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 (launch:setu
6910: 70 29 29 0a 09 3b 3b 20 28 72 75 6e 2d 69 64 20 p))..;; (run-id
6920: 20 20 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 (and (args:ge
6930: 74 2d 61 72 67 20 22 2d 72 75 6e 2d 69 64 22 29 t-arg "-run-id")
6940: 0a 09 3b 3b 20 09 09 20 20 28 73 74 72 69 6e 67 ..;; .. (string
6950: 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 ->number (args:g
6960: 65 74 2d 61 72 67 20 22 2d 72 75 6e 2d 69 64 22 et-arg "-run-id"
6970: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 )))). (
6980: 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 20 2a transport-type *
6990: 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 2a 20 transport-type*
69a0: 20 29 29 0a 20 20 20 20 20 20 28 73 65 72 76 65 )). (serve
69b0: 72 3a 6c 61 75 6e 63 68 20 30 20 74 72 61 6e 73 r:launch 0 trans
69c0: 70 6f 72 74 2d 74 79 70 65 29 0a 20 20 20 20 20 port-type).
69d0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
69e0: 68 69 6e 67 2a 20 23 74 29 29 29 0a 3b 3b 20 20 hing* #t))).;;
69f0: 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 ;; (debug:pri
6a00: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
6a10: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 73 ult-log-port* "s
6a20: 65 72 76 65 72 20 72 65 71 75 69 72 65 73 20 72 erver requires r
6a30: 75 6e 2d 69 64 20 62 65 20 73 70 65 63 69 66 69 un-id be specifi
6a40: 65 64 20 77 69 74 68 20 2d 72 75 6e 2d 69 64 22 ed with -run-id"
6a50: 29 29 29 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 3b ))).;; .;; ;
6a60: 3b 20 4e 6f 74 20 61 20 73 65 72 76 65 72 3f 20 ; Not a server?
6a70: 54 68 69 73 20 73 65 63 74 69 6f 6e 20 77 69 6c This section wil
6a80: 6c 20 64 65 63 69 64 65 20 68 6f 77 20 74 6f 20 l decide how to
6a90: 63 6f 6d 6d 75 6e 69 63 61 74 65 0a 3b 3b 20 20 communicate.;;
6aa0: 20 20 20 3b 3b 0a 3b 3b 20 20 20 20 20 3b 3b 20 ;;.;; ;;
6ab0: 20 53 65 74 75 70 20 63 6c 69 65 6e 74 20 66 6f Setup client fo
6ac0: 72 20 61 6c 6c 20 65 78 70 65 63 74 20 6c 69 73 r all expect lis
6ad0: 74 65 64 20 68 65 72 65 0a 3b 3b 20 20 20 20 20 ted here.;;
6ae0: 28 69 66 20 28 6e 75 6c 6c 3f 20 28 6c 73 65 74 (if (null? (lset
6af0: 2d 69 6e 74 65 72 73 65 63 74 69 6f 6e 20 0a 3b -intersection .;
6b00: 3b 20 09 09 65 71 75 61 6c 3f 0a 3b 3b 20 09 09 ; ..equal?.;; ..
6b10: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
6b20: 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 0a args:arg-hash).
6b30: 3b 3b 20 09 09 27 28 22 2d 6c 69 73 74 2d 73 65 ;; ..'("-list-se
6b40: 72 76 65 72 73 22 0a 3b 3b 20 09 09 20 20 22 2d rvers".;; .. "-
6b50: 73 74 6f 70 2d 73 65 72 76 65 72 22 0a 3b 3b 20 stop-server".;;
6b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b70: 20 20 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 "-kill-server"
6b80: 0a 3b 3b 20 09 09 20 20 22 2d 73 68 6f 77 2d 63 .;; .. "-show-c
6b90: 6d 64 69 6e 66 6f 22 0a 3b 3b 20 09 09 20 20 22 mdinfo".;; .. "
6ba0: 2d 6c 69 73 74 2d 72 75 6e 73 22 0a 3b 3b 20 09 -list-runs".;; .
6bb0: 09 20 20 22 2d 70 69 6e 67 22 29 29 29 0a 3b 3b . "-ping"))).;;
6bc0: 20 09 28 69 66 20 28 6c 61 75 6e 63 68 3a 73 65 .(if (launch:se
6bd0: 74 75 70 29 0a 3b 3b 20 09 20 20 20 20 28 6c 65 tup).;; . (le
6be0: 74 20 28 28 72 75 6e 2d 69 64 20 20 20 20 28 61 t ((run-id (a
6bf0: 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 nd (args:get-arg
6c00: 20 22 2d 72 75 6e 2d 69 64 22 29 0a 3b 3b 20 09 "-run-id").;; .
6c10: 09 09 09 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 ... (string->nu
6c20: 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 mber (args:get-a
6c30: 72 67 20 22 2d 72 75 6e 2d 69 64 22 29 29 29 29 rg "-run-id"))))
6c40: 29 0a 3b 3b 20 09 20 20 20 20 20 20 3b 3b 20 28 ).;; . ;; (
6c50: 73 65 74 21 20 2a 66 64 62 2a 20 20 20 28 66 69 set! *fdb* (fi
6c60: 6c 65 64 62 3a 6f 70 65 6e 2d 64 62 20 28 63 6f ledb:open-db (co
6c70: 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 64 nc *toppath* "/d
6c80: 62 2f 70 61 74 68 73 2e 64 62 22 29 29 29 0a 3b b/paths.db"))).;
6c90: 3b 20 09 20 20 20 20 20 20 3b 3b 20 69 66 20 6e ; . ;; if n
6ca0: 6f 74 20 6c 69 73 74 20 6f 72 20 6b 69 6c 6c 20 ot list or kill
6cb0: 74 68 65 6e 20 73 74 61 72 74 20 61 20 63 6c 69 then start a cli
6cc0: 65 6e 74 20 28 69 66 20 61 70 70 72 6f 70 72 69 ent (if appropri
6cd0: 61 74 65 29 0a 3b 3b 20 09 20 20 20 20 20 20 28 ate).;; . (
6ce0: 69 66 20 28 6f 72 20 28 61 72 67 73 2d 64 65 66 if (or (args-def
6cf0: 69 6e 65 64 3f 20 22 2d 68 22 20 22 2d 76 65 72 ined? "-h" "-ver
6d00: 73 69 6f 6e 22 20 22 2d 63 72 65 61 74 65 2d 6d sion" "-create-m
6d10: 65 67 61 74 65 73 74 2d 61 72 65 61 22 20 22 2d egatest-area" "-
6d20: 63 72 65 61 74 65 2d 74 65 73 74 22 29 0a 3b 3b create-test").;;
6d30: 20 09 09 20 20 20 20 20 20 28 65 71 3f 20 28 6c .. (eq? (l
6d40: 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 6c ength (hash-tabl
6d50: 65 2d 6b 65 79 73 20 61 72 67 73 3a 61 72 67 2d e-keys args:arg-
6d60: 68 61 73 68 29 29 20 30 29 29 0a 3b 3b 20 09 09 hash)) 0)).;; ..
6d70: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
6d80: 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 1 *default-l
6d90: 6f 67 2d 70 6f 72 74 2a 20 22 53 65 72 76 65 72 og-port* "Server
6da0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 6e 6f 74 20 connection not
6db0: 6e 65 65 64 65 64 22 29 0a 3b 3b 20 09 09 20 20 needed").;; ..
6dc0: 28 62 65 67 69 6e 0a 3b 3b 20 09 09 20 20 20 20 (begin.;; ..
6dd0: 3b 3b 20 28 69 66 20 72 75 6e 2d 69 64 20 0a 3b ;; (if run-id .;
6de0: 3b 20 09 09 20 20 20 20 3b 3b 20 20 20 20 20 28 ; .. ;; (
6df0: 63 6c 69 65 6e 74 3a 6c 61 75 6e 63 68 20 72 75 client:launch ru
6e00: 6e 2d 69 64 29 20 0a 3b 3b 20 09 09 20 20 20 20 n-id) .;; ..
6e10: 3b 3b 20 20 20 20 20 28 63 6c 69 65 6e 74 3a 6c ;; (client:l
6e20: 61 75 6e 63 68 20 30 29 20 20 20 20 20 20 3b 3b aunch 0) ;;
6e30: 20 77 69 74 68 6f 75 74 20 72 75 6e 2d 69 64 20 without run-id
6e40: 77 65 27 6c 6c 20 73 74 61 72 74 20 61 20 73 65 we'll start a se
6e50: 72 76 65 72 20 66 6f 72 20 22 30 22 0a 3b 3b 20 rver for "0".;;
6e60: 09 09 20 20 20 20 23 74 0a 3b 3b 20 09 09 20 20 .. #t.;; ..
6e70: 20 20 29 29 29 29 29 29 0a 0a 28 69 66 20 28 6f ))))))..(if (o
6e80: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
6e90: 22 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 29 "-list-servers")
6ea0: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
6eb0: 22 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 29 0a "-stop-server").
6ec0: 20 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 (args:ge
6ed0: 74 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 72 t-arg "-kill-ser
6ee0: 76 65 72 22 29 29 0a 20 20 20 20 28 6c 65 74 20 ver")). (let
6ef0: 28 28 74 6c 20 28 6c 61 75 6e 63 68 3a 73 65 74 ((tl (launch:set
6f00: 75 70 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 up))). (if
6f10: 74 6c 20 0a 09 20 20 28 6c 65 74 2a 20 28 28 74 tl .. (let* ((t
6f20: 64 62 64 61 74 20 20 28 74 61 73 6b 73 3a 6f 70 dbdat (tasks:op
6f30: 65 6e 2d 64 62 29 29 0a 09 09 20 28 73 65 72 76 en-db))... (serv
6f40: 65 72 73 20 28 74 61 73 6b 73 3a 67 65 74 2d 61 ers (tasks:get-a
6f50: 6c 6c 2d 73 65 72 76 65 72 73 20 28 64 62 3a 64 ll-servers (db:d
6f60: 65 6c 61 79 2d 69 66 2d 62 75 73 79 20 74 64 62 elay-if-busy tdb
6f70: 64 61 74 29 29 29 0a 09 09 20 28 66 6d 74 73 74 dat)))... (fmtst
6f80: 72 20 20 22 7e 35 61 7e 31 32 61 7e 38 61 7e 32 r "~5a~12a~8a~2
6f90: 30 61 7e 32 34 61 7e 31 30 61 7e 31 30 61 7e 31 0a~24a~10a~10a~1
6fa0: 30 61 7e 31 30 61 5c 6e 22 29 0a 09 09 20 28 73 0a~10a\n")... (s
6fb0: 65 72 76 65 72 73 2d 74 6f 2d 6b 69 6c 6c 20 27 ervers-to-kill '
6fc0: 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ()).
6fd0: 20 20 20 20 20 28 6b 69 6c 6c 2d 73 77 69 74 63 (kill-switc
6fe0: 68 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 h (if (args:get
6ff0: 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 72 76 -arg "-kill-serv
7000: 65 72 22 29 20 22 2d 39 22 20 22 22 29 29 0a 20 er") "-9" "")).
7010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7020: 28 6b 69 6c 6c 69 6e 66 6f 20 20 20 28 6f 72 20 (killinfo (or
7030: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7040: 73 74 6f 70 2d 73 65 72 76 65 72 22 29 20 28 61 stop-server") (a
7050: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6b 69 rgs:get-arg "-ki
7060: 6c 6c 2d 73 65 72 76 65 72 22 29 20 29 29 0a 09 ll-server") ))..
7070: 09 20 28 6b 68 6f 73 74 2d 70 6f 72 74 20 28 69 . (khost-port (i
7080: 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 69 66 20 28 f killinfo (if (
7090: 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 substring-index
70a0: 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f 29 28 73 74 ":" killinfo)(st
70b0: 72 69 6e 67 2d 73 70 6c 69 74 20 22 3a 22 29 20 ring-split ":")
70c0: 23 66 29 20 23 66 29 29 0a 09 09 20 28 73 69 64 #f) #f))... (sid
70d0: 20 20 20 20 20 20 20 20 28 69 66 20 6b 69 6c 6c (if kill
70e0: 69 6e 66 6f 20 28 69 66 20 28 73 75 62 73 74 72 info (if (substr
70f0: 69 6e 67 2d 69 6e 64 65 78 20 22 3a 22 20 6b 69 ing-index ":" ki
7100: 6c 6c 69 6e 66 6f 29 20 23 66 20 28 73 74 72 69 llinfo) #f (stri
7110: 6e 67 2d 3e 6e 75 6d 62 65 72 20 6b 69 6c 6c 69 ng->number killi
7120: 6e 66 6f 29 29 20 23 66 29 29 29 0a 09 20 20 20 nfo)) #f)))..
7130: 20 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 (format #t fmts
7140: 74 72 20 22 49 64 22 20 22 4d 54 76 65 72 22 20 tr "Id" "MTver"
7150: 22 50 69 64 22 20 22 48 6f 73 74 22 20 22 49 6e "Pid" "Host" "In
7160: 74 65 72 66 61 63 65 3a 4f 75 74 50 6f 72 74 22 terface:OutPort"
7170: 20 22 49 6e 50 6f 72 74 22 20 22 4c 61 73 74 42 "InPort" "LastB
7180: 65 61 74 22 20 22 53 74 61 74 65 22 20 22 54 72 eat" "State" "Tr
7190: 61 6e 73 70 6f 72 74 22 29 0a 09 20 20 20 20 28 ansport").. (
71a0: 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 74 72 format #t fmtstr
71b0: 20 22 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d "==" "=====" "=
71c0: 3d 3d 22 20 22 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d ==" "====" "====
71d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 =============" "
71e0: 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d ======" "=======
71f0: 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d =" "=====" "====
7200: 3d 3d 3d 3d 3d 22 29 0a 09 20 20 20 20 28 66 6f =====").. (fo
7210: 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 28 6c r-each .. (l
7220: 61 6d 62 64 61 20 28 73 65 72 76 65 72 29 0a 09 ambda (server)..
7230: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 69 (let* ((i
7240: 64 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f d (vecto
7250: 72 2d 72 65 66 20 73 65 72 76 65 72 20 30 29 29 r-ref server 0))
7260: 0a 09 09 20 20 20 20 20 20 28 70 69 64 20 20 20 ... (pid
7270: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref
7280: 20 73 65 72 76 65 72 20 31 29 29 0a 09 09 20 20 server 1))...
7290: 20 20 20 20 28 68 6f 73 74 6e 61 6d 65 20 20 20 (hostname
72a0: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 (vector-ref serv
72b0: 65 72 20 32 29 29 0a 09 09 20 20 20 20 20 20 28 er 2))... (
72c0: 69 6e 74 65 72 66 61 63 65 20 20 28 76 65 63 74 interface (vect
72d0: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 33 29 or-ref server 3)
72e0: 29 20 0a 09 09 20 20 20 20 20 20 28 70 75 6c 6c ) ... (pull
72f0: 70 6f 72 74 20 20 20 28 76 65 63 74 6f 72 2d 72 port (vector-r
7300: 65 66 20 73 65 72 76 65 72 20 34 29 29 0a 09 09 ef server 4))...
7310: 20 20 20 20 20 20 28 70 75 62 70 6f 72 74 20 20 (pubport
7320: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
7330: 72 76 65 72 20 35 29 29 0a 09 09 20 20 20 20 20 rver 5))...
7340: 20 28 73 74 61 72 74 2d 74 69 6d 65 20 28 76 65 (start-time (ve
7350: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
7360: 36 29 29 0a 09 09 20 20 20 20 20 20 28 70 72 69 6))... (pri
7370: 6f 72 69 74 79 20 20 20 28 76 65 63 74 6f 72 2d ority (vector-
7380: 72 65 66 20 73 65 72 76 65 72 20 37 29 29 0a 09 ref server 7))..
7390: 09 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 . (state
73a0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
73b0: 65 72 76 65 72 20 38 29 29 0a 09 09 20 20 20 20 erver 8))...
73c0: 20 20 28 6d 74 2d 76 65 72 20 20 20 20 20 28 76 (mt-ver (v
73d0: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
73e0: 20 39 29 29 0a 09 09 20 20 20 20 20 20 28 6c 61 9))... (la
73f0: 73 74 2d 75 70 64 61 74 65 20 28 76 65 63 74 6f st-update (vecto
7400: 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 30 29 r-ref server 10)
7410: 29 20 0a 09 09 20 20 20 20 20 20 28 74 72 61 6e ) ... (tran
7420: 73 70 6f 72 74 20 20 28 76 65 63 74 6f 72 2d 72 sport (vector-r
7430: 65 66 20 73 65 72 76 65 72 20 31 31 29 29 0a 09 ef server 11))..
7440: 09 20 20 20 20 20 20 28 6b 69 6c 6c 65 64 20 20 . (killed
7450: 20 20 20 23 66 29 0a 09 09 20 20 20 20 20 20 28 #f)... (
7460: 73 74 61 74 75 73 20 20 20 20 20 28 3c 20 6c 61 status (< la
7470: 73 74 2d 75 70 64 61 74 65 20 32 30 29 29 29 0a st-update 20))).
7480: 09 09 20 3b 3b 20 20 20 28 7a 6d 71 2d 73 6f 63 .. ;; (zmq-soc
7490: 6b 65 74 73 20 28 69 66 20 73 74 61 74 75 73 20 kets (if status
74a0: 28 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d 63 (server:client-c
74b0: 6f 6e 6e 65 63 74 20 68 6f 73 74 6e 61 6d 65 20 onnect hostname
74c0: 70 6f 72 74 29 20 23 66 29 29 29 0a 09 09 20 3b port) #f)))... ;
74d0: 3b 20 6e 6f 20 6e 65 65 64 20 74 6f 20 6c 6f 67 ; no need to log
74e0: 69 6e 20 61 73 20 73 74 61 74 75 73 20 6f 66 20 in as status of
74f0: 23 74 20 69 6e 64 69 63 61 74 65 73 20 77 65 20 #t indicates we
7500: 61 72 65 20 63 6f 6e 6e 65 63 74 69 6e 67 20 74 are connecting t
7510: 6f 20 63 6f 72 72 65 63 74 20 0a 09 09 20 3b 3b o correct ... ;;
7520: 20 73 65 72 76 65 72 0a 09 09 20 28 69 66 20 28 server... (if (
7530: 65 71 75 61 6c 3f 20 73 74 61 74 65 20 22 64 65 equal? state "de
7540: 61 64 22 29 0a 09 09 20 20 20 20 20 28 69 66 20 ad")... (if
7550: 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 28 (> last-update (
7560: 2a 20 32 35 20 36 30 20 36 30 29 29 20 3b 3b 20 * 25 60 60)) ;;
7570: 6b 65 65 70 20 72 65 63 6f 72 64 73 20 61 72 6f keep records aro
7580: 75 6e 64 20 66 6f 72 20 73 6c 69 67 68 6c 79 20 und for slighly
7590: 6f 76 65 72 20 61 20 64 61 79 2e 0a 09 09 09 20 over a day.....
75a0: 28 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 65 (tasks:server-de
75b0: 72 65 67 69 73 74 65 72 20 28 64 62 3a 64 65 6c register (db:del
75c0: 61 79 2d 69 66 2d 62 75 73 79 20 74 64 62 64 61 ay-if-busy tdbda
75d0: 74 29 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c 6c t) hostname pull
75e0: 70 6f 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 70 port: pullport p
75f0: 69 64 3a 20 70 69 64 20 61 63 74 69 6f 6e 3a 20 id: pid action:
7600: 27 64 65 6c 65 74 65 29 29 0a 09 09 20 20 20 20 'delete))...
7610: 20 28 69 66 20 28 3e 20 6c 61 73 74 2d 75 70 64 (if (> last-upd
7620: 61 74 65 20 32 30 29 20 20 20 20 20 20 20 20 3b ate 20) ;
7630: 3b 20 4d 61 72 6b 20 61 73 20 64 65 61 64 20 69 ; Mark as dead i
7640: 66 20 6e 6f 74 20 75 70 64 61 74 65 64 20 69 6e f not updated in
7650: 20 6c 61 73 74 20 32 30 20 73 65 63 6f 6e 64 73 last 20 seconds
7660: 0a 09 09 09 20 28 74 61 73 6b 73 3a 73 65 72 76 .... (tasks:serv
7670: 65 72 2d 64 65 72 65 67 69 73 74 65 72 20 28 64 er-deregister (d
7680: 62 3a 64 65 6c 61 79 2d 69 66 2d 62 75 73 79 20 b:delay-if-busy
7690: 74 64 62 64 61 74 29 20 68 6f 73 74 6e 61 6d 65 tdbdat) hostname
76a0: 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 6c 6c 70 pullport: pullp
76b0: 6f 72 74 20 70 69 64 3a 20 70 69 64 29 29 29 0a ort pid: pid))).
76c0: 09 09 20 28 66 6f 72 6d 61 74 20 23 74 20 66 6d .. (format #t fm
76d0: 74 73 74 72 20 69 64 20 6d 74 2d 76 65 72 20 70 tstr id mt-ver p
76e0: 69 64 20 68 6f 73 74 6e 61 6d 65 20 28 63 6f 6e id hostname (con
76f0: 63 20 69 6e 74 65 72 66 61 63 65 20 22 3a 22 20 c interface ":"
7700: 70 75 6c 6c 70 6f 72 74 29 20 70 75 62 70 6f 72 pullport) pubpor
7710: 74 20 6c 61 73 74 2d 75 70 64 61 74 65 0a 09 09 t last-update...
7720: 09 20 28 69 66 20 73 74 61 74 75 73 20 22 61 6c . (if status "al
7730: 69 76 65 22 20 22 64 65 61 64 22 29 20 74 72 61 ive" "dead") tra
7740: 6e 73 70 6f 72 74 29 0a 09 09 20 28 69 66 20 28 nsport)... (if (
7750: 6f 72 20 28 65 71 75 61 6c 3f 20 69 64 20 73 69 or (equal? id si
7760: 64 29 0a 09 09 09 20 28 65 71 75 61 6c 3f 20 73 d).... (equal? s
7770: 69 64 20 30 29 29 20 3b 3b 20 6b 69 6c 6c 20 61 id 0)) ;; kill a
7780: 6c 6c 2f 61 6e 79 0a 09 09 20 20 20 20 20 28 62 ll/any... (b
7790: 65 67 69 6e 0a 09 09 20 20 20 20 20 20 20 28 64 egin... (d
77a0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
77b0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
77c0: 6f 72 74 2a 20 22 41 74 74 65 6d 70 74 69 6e 67 ort* "Attempting
77d0: 20 74 6f 20 6b 69 6c 6c 20 22 6b 69 6c 6c 2d 73 to kill "kill-s
77e0: 77 69 74 63 68 22 20 73 65 72 76 65 72 20 77 69 witch" server wi
77f0: 74 68 20 70 69 64 20 22 20 70 69 64 29 0a 09 09 th pid " pid)...
7800: 20 20 20 20 20 20 20 28 74 61 73 6b 73 3a 6b 69 (tasks:ki
7810: 6c 6c 2d 73 65 72 76 65 72 20 68 6f 73 74 6e 61 ll-server hostna
7820: 6d 65 20 70 69 64 20 6b 69 6c 6c 2d 73 77 69 74 me pid kill-swit
7830: 63 68 3a 20 6b 69 6c 6c 2d 73 77 69 74 63 68 29 ch: kill-switch)
7840: 29 29 29 29 0a 09 20 20 20 20 20 73 65 72 76 65 )))).. serve
7850: 72 73 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a rs).. (debug:
7860: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 print-info 1 *de
7870: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
7880: 22 44 6f 6e 65 20 77 69 74 68 20 6c 69 73 74 73 "Done with lists
7890: 65 72 76 65 72 73 22 29 0a 09 20 20 20 20 28 73 ervers").. (s
78a0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
78b0: 67 2a 20 23 74 29 0a 09 20 20 20 20 28 65 78 69 g* #t).. (exi
78c0: 74 29 29 20 3b 3b 20 6d 75 73 74 20 64 6f 2c 20 t)) ;; must do,
78d0: 77 6f 75 6c 64 20 68 61 76 65 20 74 6f 20 61 64 would have to ad
78e0: 64 20 63 68 65 63 6b 73 20 74 6f 20 6d 61 6e 79 d checks to many
78f0: 2f 61 6c 6c 20 63 61 6c 6c 73 20 62 65 6c 6f 77 /all calls below
7900: 0a 09 20 20 28 65 78 69 74 29 29 29 29 0a 0a 3b .. (exit))))..;
7910: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
7920: 3d 3d 3d 3d 3d 3d 3d 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 0a 3b 3b 20 57 65 69 72 64 =======.;; Weird
7960: 20 73 70 65 63 69 61 6c 20 63 61 6c 6c 73 20 74 special calls t
7970: 68 61 74 20 6e 65 65 64 20 74 6f 20 72 75 6e 20 hat need to run
7980: 2a 61 66 74 65 72 2a 20 74 68 65 20 73 65 72 76 *after* the serv
7990: 65 72 20 68 61 73 20 73 74 61 72 74 65 64 3f 0a er has started?.
79a0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
79b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 69 66 20 28 61 ========..(if (a
79f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
7a00: 73 74 2d 74 61 72 67 65 74 73 22 29 0a 20 20 20 st-targets").
7a10: 20 28 69 66 20 28 6c 61 75 6e 63 68 3a 73 65 74 (if (launch:set
7a20: 75 70 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 up). (let
7a30: 20 28 28 74 61 72 67 65 74 73 20 28 63 6f 6d 6d ((targets (comm
7a40: 6f 6e 3a 67 65 74 2d 72 75 6e 63 6f 6e 66 69 67 on:get-runconfig
7a50: 2d 74 61 72 67 65 74 73 29 29 29 0a 20 20 20 20 -targets))).
7a60: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
7a70: 6e 74 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 1 *default-lo
7a80: 67 2d 70 6f 72 74 2a 20 22 46 6f 75 6e 64 20 22 g-port* "Found "
7a90: 28 6c 65 6e 67 74 68 20 74 61 72 67 65 74 73 29 (length targets)
7aa0: 20 22 20 74 61 72 67 65 74 73 22 29 0a 20 20 20 " targets").
7ab0: 20 20 20 20 20 20 20 28 63 61 73 65 20 28 73 74 (case (st
7ac0: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 ring->symbol (or
7ad0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7ae0: 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 61 6c 69 -dumpmode") "ali
7af0: 73 74 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 st")).
7b00: 20 20 28 28 61 6c 69 73 74 29 0a 20 20 20 20 20 ((alist).
7b10: 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 (for-eac
7b20: 68 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 h (lambda (x).
7b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b40: 20 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 ;; (print
7b50: 20 22 5b 22 20 78 20 22 5d 22 29 29 0a 20 20 20 "[" x "]")).
7b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b70: 20 20 20 20 20 20 28 70 72 69 6e 74 20 78 29 29 (print x))
7b80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7b90: 20 20 20 20 20 20 20 20 74 61 72 67 65 74 73 29 targets)
7ba0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ). ((
7bb0: 6a 73 6f 6e 29 0a 20 20 20 20 20 20 20 20 20 20 json).
7bc0: 20 20 20 28 6a 73 6f 6e 2d 77 72 69 74 65 20 74 (json-write t
7bd0: 61 72 67 65 74 73 29 29 0a 20 20 20 20 20 20 20 argets)).
7be0: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
7bf0: 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 (debug:p
7c00: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
7c10: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
7c20: 22 64 75 6d 70 20 6f 75 74 70 75 74 20 66 6f 72 "dump output for
7c30: 6d 61 74 20 22 20 28 61 72 67 73 3a 67 65 74 2d mat " (args:get-
7c40: 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 arg "-dumpmode")
7c50: 20 22 20 6e 6f 74 20 73 75 70 70 6f 72 74 65 64 " not supported
7c60: 20 66 6f 72 20 2d 6c 69 73 74 2d 74 61 72 67 65 for -list-targe
7c70: 74 73 22 29 29 29 0a 20 20 20 20 20 20 20 20 20 ts"))).
7c80: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
7c90: 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b hing* #t))))..;;
7ca0: 20 63 61 63 68 65 20 74 68 65 20 72 75 6e 63 6f cache the runco
7cb0: 6e 66 69 67 73 20 69 6e 20 24 4d 54 5f 4c 49 4e nfigs in $MT_LIN
7cc0: 4b 54 52 45 45 2f 24 4d 54 5f 54 41 52 47 45 54 KTREE/$MT_TARGET
7cd0: 2f 24 4d 54 5f 52 55 4e 4e 41 4d 45 2f 2e 72 75 /$MT_RUNNAME/.ru
7ce0: 6e 63 6f 6e 66 69 67 0a 3b 3b 0a 28 64 65 66 69 nconfig.;;.(defi
7cf0: 6e 65 20 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e 66 ne (full-runconf
7d00: 69 67 73 2d 72 65 61 64 29 0a 3b 3b 20 69 6e 20 igs-read).;; in
7d10: 74 68 65 20 65 6e 76 70 72 6f 63 65 73 73 69 6e the envprocessin
7d20: 67 20 62 72 61 6e 63 68 20 74 68 65 20 62 65 6c g branch the bel
7d30: 6f 77 20 63 6f 64 65 20 72 65 70 6c 61 63 65 73 ow code replaces
7d40: 20 74 68 65 20 66 75 72 74 68 65 72 20 62 65 6c the further bel
7d50: 6f 77 20 63 6f 64 65 0a 3b 3b 20 20 28 69 66 20 ow code.;; (if
7d60: 28 65 71 3f 20 2a 63 6f 6e 66 69 67 73 74 61 74 (eq? *configstat
7d70: 75 73 2a 20 27 66 75 6c 6c 64 61 74 61 29 0a 3b us* 'fulldata).;
7d80: 3b 20 20 20 20 20 20 2a 72 75 6e 63 6f 6e 66 69 ; *runconfi
7d90: 67 64 61 74 2a 0a 3b 3b 20 20 20 20 20 20 28 62 gdat*.;; (b
7da0: 65 67 69 6e 0a 3b 3b 09 28 6c 61 75 6e 63 68 3a egin.;;.(launch:
7db0: 73 65 74 75 70 29 0a 3b 3b 09 2a 72 75 6e 63 6f setup).;;.*runco
7dc0: 6e 66 69 67 64 61 74 2a 29 29 29 0a 0a 20 20 28 nfigdat*))).. (
7dd0: 6c 65 74 2a 20 28 28 72 75 6e 64 69 72 20 28 69 let* ((rundir (i
7de0: 66 20 28 61 6e 64 20 28 67 65 74 65 6e 76 20 22 f (and (getenv "
7df0: 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 29 28 67 65 MT_LINKTREE")(ge
7e00: 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 tenv "MT_TARGET"
7e10: 29 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e )(getenv "MT_RUN
7e20: 4e 41 4d 45 22 29 29 0a 09 09 20 20 20 20 20 28 NAME"))... (
7e30: 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 22 4d 54 conc (getenv "MT
7e40: 5f 4c 49 4e 4b 54 52 45 45 22 29 20 22 2f 22 20 _LINKTREE") "/"
7e50: 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 (getenv "MT_TARG
7e60: 45 54 22 29 20 22 2f 22 20 28 67 65 74 65 6e 76 ET") "/" (getenv
7e70: 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 29 29 0a "MT_RUNNAME")).
7e80: 09 09 20 20 20 20 20 23 66 29 29 0a 09 20 28 63 .. #f)).. (c
7e90: 66 67 66 20 20 20 28 69 66 20 72 75 6e 64 69 72 fgf (if rundir
7ea0: 20 28 63 6f 6e 63 20 72 75 6e 64 69 72 20 22 2f (conc rundir "/
7eb0: 2e 72 75 6e 63 6f 6e 66 69 67 2e 22 20 6d 65 67 .runconfig." meg
7ec0: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 2d atest-version "-
7ed0: 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 " megatest-fossi
7ee0: 6c 2d 68 61 73 68 29 20 23 66 29 29 29 0a 20 20 l-hash) #f))).
7ef0: 20 20 28 69 66 20 28 61 6e 64 20 63 66 67 66 0a (if (and cfgf.
7f00: 09 20 20 20 20 20 28 66 69 6c 65 2d 65 78 69 73 . (file-exis
7f10: 74 73 3f 20 63 66 67 66 29 0a 09 20 20 20 20 20 ts? cfgf)..
7f20: 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 (file-write-acce
7f30: 73 73 3f 20 63 66 67 66 29 29 0a 09 28 63 6f 6e ss? cfgf))..(con
7f40: 66 69 67 66 3a 72 65 61 64 2d 61 6c 69 73 74 20 figf:read-alist
7f50: 63 66 67 66 29 0a 09 28 6c 65 74 2a 20 28 28 6b cfgf)..(let* ((k
7f60: 65 79 73 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b eys (rmt:get-k
7f70: 65 79 73 29 29 0a 09 20 20 20 20 20 20 20 28 74 eys)).. (t
7f80: 61 72 67 65 74 20 28 63 6f 6d 6d 6f 6e 3a 61 72 arget (common:ar
7f90: 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 29 0a gs-get-target)).
7fa0: 09 20 20 20 20 20 20 20 28 6b 65 79 2d 76 61 6c . (key-val
7fb0: 73 20 28 69 66 20 74 61 72 67 65 74 20 28 6b 65 s (if target (ke
7fc0: 79 73 3a 74 61 72 67 65 74 2d 3e 6b 65 79 76 61 ys:target->keyva
7fd0: 6c 20 6b 65 79 73 20 74 61 72 67 65 74 29 20 23 l keys target) #
7fe0: 66 29 29 0a 09 20 20 20 20 20 20 20 28 73 65 63 f)).. (sec
7ff0: 74 69 6f 6e 73 20 28 69 66 20 74 61 72 67 65 74 tions (if target
8000: 20 28 6c 69 73 74 20 22 64 65 66 61 75 6c 74 22 (list "default"
8010: 20 74 61 72 67 65 74 29 20 23 66 29 29 0a 09 20 target) #f))..
8020: 20 20 20 20 20 20 28 64 61 74 61 20 20 20 20 20 (data
8030: 28 62 65 67 69 6e 0a 09 09 09 20 20 20 28 73 65 (begin.... (se
8040: 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 45 tenv "MT_RUN_ARE
8050: 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 A_HOME" *toppath
8060: 2a 29 0a 09 09 09 20 20 20 28 69 66 20 6b 65 79 *).... (if key
8070: 2d 76 61 6c 73 0a 09 09 09 20 20 20 20 20 20 20 -vals....
8080: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
8090: 61 20 28 6b 74 29 0a 09 09 09 09 09 20 20 20 28 a (kt)...... (
80a0: 73 65 74 65 6e 76 20 28 63 61 72 20 6b 74 29 20 setenv (car kt)
80b0: 28 63 61 64 72 20 6b 74 29 29 29 0a 09 09 09 09 (cadr kt))).....
80c0: 09 20 6b 65 79 2d 76 61 6c 73 29 29 0a 09 09 09 . key-vals))....
80d0: 20 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 (read-config
80e0: 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 (conc *toppath*
80f0: 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e "/runconfigs.con
8100: 66 69 67 22 29 20 23 66 20 23 74 20 73 65 63 74 fig") #f #t sect
8110: 69 6f 6e 73 3a 20 73 65 63 74 69 6f 6e 73 29 29 ions: sections))
8120: 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 72 )).. (if (and r
8130: 75 6e 64 69 72 20 3b 3b 20 68 61 76 65 20 61 6c undir ;; have al
8140: 6c 20 6e 65 65 64 65 64 20 76 61 72 69 61 62 6c l needed variabl
8150: 65 73 73 0a 09 09 20 20 20 28 64 69 72 65 63 74 ess... (direct
8160: 6f 72 79 2d 65 78 69 73 74 73 3f 20 72 75 6e 64 ory-exists? rund
8170: 69 72 29 0a 09 09 20 20 20 28 66 69 6c 65 2d 77 ir)... (file-w
8180: 72 69 74 65 2d 61 63 63 65 73 73 3f 20 72 75 6e rite-access? run
8190: 64 69 72 29 29 0a 09 20 20 20 20 20 20 28 62 65 dir)).. (be
81a0: 67 69 6e 0a 09 09 28 63 6f 6e 66 69 67 66 3a 77 gin...(configf:w
81b0: 72 69 74 65 2d 61 6c 69 73 74 20 64 61 74 61 20 rite-alist data
81c0: 63 66 67 66 29 0a 09 09 3b 3b 20 66 6f 72 63 65 cfgf)...;; force
81d0: 20 72 65 2d 72 65 61 64 20 6f 66 20 6d 65 67 61 re-read of mega
81e0: 74 65 73 74 2e 63 6f 6e 66 69 67 20 2d 20 74 68 test.config - th
81f0: 69 73 20 72 65 73 6f 6c 76 65 73 20 63 69 72 63 is resolves circ
8200: 75 6c 61 72 20 72 65 66 65 72 65 6e 63 65 73 20 ular references
8210: 62 65 74 77 65 65 6e 20 6d 65 67 61 74 65 73 74 between megatest
8220: 2e 63 6f 6e 66 69 67 0a 09 09 28 6c 61 75 6e 63 .config...(launc
8230: 68 3a 73 65 74 75 70 20 66 6f 72 63 65 3a 20 23 h:setup force: #
8240: 74 29 0a 09 09 28 6c 61 75 6e 63 68 3a 63 61 63 t)...(launch:cac
8250: 68 65 2d 63 6f 6e 66 69 67 29 29 29 20 3b 3b 20 he-config))) ;;
8260: 77 65 20 63 61 6e 20 73 61 66 65 6c 79 20 63 61 we can safely ca
8270: 63 68 65 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e che megatest.con
8280: 66 69 67 20 73 69 6e 63 65 20 77 65 20 68 61 76 fig since we hav
8290: 65 20 61 20 76 61 6c 69 64 20 72 75 6e 63 6f 6e e a valid runcon
82a0: 66 69 67 0a 09 20 20 64 61 74 61 29 29 29 29 0a fig.. data)))).
82b0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
82c0: 72 67 20 22 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e rg "-show-runcon
82d0: 66 69 67 22 29 0a 20 20 20 20 28 6c 65 74 20 28 fig"). (let (
82e0: 28 74 6c 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 (tl (launch:setu
82f0: 70 29 29 29 0a 20 20 20 20 20 20 28 70 75 73 68 p))). (push
8300: 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 -directory *topp
8310: 61 74 68 2a 29 0a 20 20 20 20 20 20 28 6c 65 74 ath*). (let
8320: 20 28 28 64 61 74 61 20 28 66 75 6c 6c 2d 72 75 ((data (full-ru
8330: 6e 63 6f 6e 66 69 67 73 2d 72 65 61 64 29 29 29 nconfigs-read)))
8340: 0a 09 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 6f ..;; keep this o
8350: 6e 65 20 6c 6f 63 61 6c 0a 09 28 63 6f 6e 64 0a ne local..(cond.
8360: 09 20 28 28 61 6e 64 20 28 61 72 67 73 3a 67 65 . ((and (args:ge
8370: 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 t-arg "-section"
8380: 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 3a ).. (args:
8390: 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 get-arg "-var"))
83a0: 0a 09 20 20 28 6c 65 74 20 28 28 76 61 6c 20 28 .. (let ((val (
83b0: 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b or (configf:look
83c0: 75 70 20 64 61 74 61 20 28 61 72 67 73 3a 67 65 up data (args:ge
83d0: 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 t-arg "-section"
83e0: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
83f0: 2d 76 61 72 22 29 29 0a 09 09 09 20 28 63 6f 6e -var")).... (con
8400: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 61 figf:lookup data
8410: 20 22 64 65 66 61 75 6c 74 22 20 28 61 72 67 73 "default" (args
8420: 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 :get-arg "-var")
8430: 29 29 29 29 0a 09 20 20 20 20 28 69 66 20 76 61 )))).. (if va
8440: 6c 20 28 70 72 69 6e 74 20 76 61 6c 29 29 29 29 l (print val))))
8450: 0a 09 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 .. ((not (args:g
8460: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
8470: 65 22 29 29 0a 09 20 20 28 70 70 20 28 68 61 73 e")).. (pp (has
8480: 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 64 h-table->alist d
8490: 61 74 61 29 29 29 0a 09 20 28 28 73 74 72 69 6e ata))).. ((strin
84a0: 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 g=? (args:get-ar
84b0: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
84c0: 6a 73 6f 6e 22 29 0a 09 20 20 28 6a 73 6f 6e 2d json").. (json-
84d0: 77 72 69 74 65 20 64 61 74 61 29 29 0a 09 20 28 write data)).. (
84e0: 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a (string=? (args:
84f0: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
8500: 64 65 22 29 20 22 69 6e 69 22 29 0a 09 20 20 28 de") "ini").. (
8510: 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 69 67 2d 3e configf:config->
8520: 69 6e 69 20 64 61 74 61 29 29 0a 09 20 28 65 6c ini data)).. (el
8530: 73 65 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 se.. (debug:pri
8540: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
8550: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d ult-log-port* "-
8560: 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 61 dumpmode of " (a
8570: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
8580: 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 72 mpmode") " not r
8590: 65 63 6f 67 6e 69 73 65 64 22 29 29 29 0a 09 28 ecognised")))..(
85a0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
85b0: 6e 67 2a 20 23 74 29 29 0a 20 20 20 20 20 20 28 ng* #t)). (
85c0: 70 6f 70 2d 64 69 72 65 63 74 6f 72 79 29 29 29 pop-directory)))
85d0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
85e0: 61 72 67 20 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 arg "-show-confi
85f0: 67 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 g"). (let ((t
8600: 6c 20 20 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 l (launch:setu
8610: 70 29 29 0a 09 20 20 28 64 61 74 61 20 2a 63 6f p)).. (data *co
8620: 6e 66 69 67 64 61 74 2a 29 29 20 3b 3b 20 28 72 nfigdat*)) ;; (r
8630: 65 61 64 2d 63 6f 6e 66 69 67 20 22 6d 65 67 61 ead-config "mega
8640: 74 65 73 74 2e 63 6f 6e 66 69 67 22 20 23 66 20 test.config" #f
8650: 23 74 29 29 29 0a 20 20 20 20 20 20 28 70 75 73 #t))). (pus
8660: 68 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 h-directory *top
8670: 70 61 74 68 2a 29 0a 20 20 20 20 20 20 3b 3b 20 path*). ;;
8680: 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c 6f keep this one lo
8690: 63 61 6c 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 cal. (cond
86a0: 0a 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 61 . ((and (a
86b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
86c0: 63 74 69 6f 6e 22 29 0a 09 20 20 20 20 20 28 61 ction").. (a
86d0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 rgs:get-arg "-va
86e0: 72 22 29 29 0a 09 28 6c 65 74 20 28 28 76 61 6c r"))..(let ((val
86f0: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
8700: 20 64 61 74 61 20 28 61 72 67 73 3a 67 65 74 2d data (args:get-
8710: 61 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 28 arg "-section")(
8720: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 args:get-arg "-v
8730: 61 72 22 29 29 29 29 0a 09 20 20 28 69 66 20 76 ar")))).. (if v
8740: 61 6c 20 28 70 72 69 6e 74 20 76 61 6c 29 29 29 al (print val)))
8750: 29 0a 0a 20 20 20 20 20 20 20 3b 3b 20 70 72 69 ).. ;; pri
8760: 6e 74 20 6a 75 73 74 20 61 20 73 65 63 74 69 6f nt just a sectio
8770: 6e 20 69 66 20 6f 6e 6c 79 20 2d 73 65 63 74 69 n if only -secti
8780: 6f 6e 0a 0a 20 20 20 20 20 20 20 28 28 6e 6f 74 on.. ((not
8790: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
87a0: 2d 64 75 6d 70 6d 6f 64 65 22 29 29 0a 09 28 70 -dumpmode"))..(p
87b0: 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 p (hash-table->a
87c0: 6c 69 73 74 20 64 61 74 61 29 29 29 0a 20 20 20 list data))).
87d0: 20 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 ((string=? (
87e0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
87f0: 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 umpmode") "json"
8800: 29 0a 09 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 )..(json-write d
8810: 61 74 61 29 29 0a 20 20 20 20 20 20 20 28 28 73 ata)). ((s
8820: 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 tring=? (args:ge
8830: 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 t-arg "-dumpmode
8840: 22 29 20 22 69 6e 69 22 29 0a 09 28 63 6f 6e 66 ") "ini")..(conf
8850: 69 67 66 3a 63 6f 6e 66 69 67 2d 3e 69 6e 69 20 igf:config->ini
8860: 64 61 74 61 29 29 0a 20 20 20 20 20 20 20 28 65 data)). (e
8870: 6c 73 65 0a 09 28 64 65 62 75 67 3a 70 72 69 6e lse..(debug:prin
8880: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
8890: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 64 lt-log-port* "-d
88a0: 75 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 61 72 umpmode of " (ar
88b0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d gs:get-arg "-dum
88c0: 70 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 72 65 pmode") " not re
88d0: 63 6f 67 6e 69 73 65 64 22 29 29 29 0a 20 20 20 cognised"))).
88e0: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
88f0: 65 74 68 69 6e 67 2a 20 23 74 29 0a 20 20 20 20 ething* #t).
8900: 20 20 28 70 6f 70 2d 64 69 72 65 63 74 6f 72 79 (pop-directory
8910: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
8920: 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 6d et-arg "-show-cm
8930: 64 69 6e 66 6f 22 29 0a 20 20 20 20 28 69 66 20 dinfo"). (if
8940: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
8950: 67 20 22 3a 76 61 6c 75 65 22 29 28 67 65 74 65 g ":value")(gete
8960: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
8970: 29 0a 09 28 6c 65 74 20 28 28 64 61 74 61 20 28 )..(let ((data (
8980: 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f common:read-enco
8990: 64 65 64 2d 73 74 72 69 6e 67 20 28 6f 72 20 28 ded-string (or (
89a0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 76 args:get-arg ":v
89b0: 61 6c 75 65 22 29 28 67 65 74 65 6e 76 20 22 4d alue")(getenv "M
89c0: 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a T_CMDINFO"))))).
89d0: 09 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 . (if (equal? (
89e0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
89f0: 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 umpmode") "json"
8a00: 29 0a 09 20 20 20 20 20 20 28 6a 73 6f 6e 2d 77 ).. (json-w
8a10: 72 69 74 65 20 64 61 74 61 29 0a 09 20 20 20 20 rite data)..
8a20: 20 20 28 70 70 20 64 61 74 61 29 29 0a 09 20 20 (pp data))..
8a30: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
8a40: 69 6e 67 2a 20 23 74 29 29 0a 09 28 64 65 62 75 ing* #t))..(debu
8a50: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
8a60: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
8a70: 2a 20 22 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 * "environment v
8a80: 61 72 69 61 62 6c 65 20 4d 54 5f 43 4d 44 49 4e ariable MT_CMDIN
8a90: 46 4f 20 69 73 20 6e 6f 74 20 73 65 74 22 29 29 FO is not set"))
8aa0: 29 0a 0a 3b 3b 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 3d ================
8ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 ===========.;; R
8af0: 65 6d 6f 76 65 20 6f 6c 64 20 72 75 6e 28 73 29 emove old run(s)
8b00: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
8b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 69 =========..;; si
8b50: 6e 63 65 20 73 65 76 65 72 61 6c 20 61 63 74 69 nce several acti
8b60: 6f 6e 73 20 63 61 6e 20 62 65 20 73 70 65 63 69 ons can be speci
8b70: 66 69 65 64 20 6f 6e 20 74 68 65 20 63 6f 6d 6d fied on the comm
8b80: 61 6e 64 20 6c 69 6e 65 20 74 68 65 20 72 65 6d and line the rem
8b90: 6f 76 61 6c 0a 3b 3b 20 69 73 20 64 6f 6e 65 20 oval.;; is done
8ba0: 66 69 72 73 74 0a 28 64 65 66 69 6e 65 20 28 6f first.(define (o
8bb0: 70 65 72 61 74 65 2d 6f 6e 20 61 63 74 69 6f 6e perate-on action
8bc0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 72 ). (let* ((runr
8bd0: 65 63 20 28 72 75 6e 73 3a 72 75 6e 72 65 63 2d ec (runs:runrec-
8be0: 6d 61 6b 65 2d 72 65 63 6f 72 64 29 29 0a 09 20 make-record))..
8bf0: 28 74 61 72 67 65 74 20 28 63 6f 6d 6d 6f 6e 3a (target (common:
8c00: 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 args-get-target)
8c10: 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 )). (cond.
8c20: 20 20 28 28 6e 6f 74 20 74 61 72 67 65 74 29 0a ((not target).
8c30: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
8c40: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
8c50: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d ult-log-port* "M
8c60: 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 issing required
8c70: 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 parameter for "
8c80: 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 action ", you mu
8c90: 73 74 20 73 70 65 63 69 66 79 20 2d 74 61 72 67 st specify -targ
8ca0: 65 74 20 6f 72 20 2d 72 65 71 74 61 72 67 22 29 et or -reqtarg")
8cb0: 0a 20 20 20 20 20 20 28 65 78 69 74 20 31 29 29 . (exit 1))
8cc0: 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 6f 72 20 . ((not (or
8cd0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
8ce0: 72 75 6e 6e 61 6d 65 22 29 0a 09 20 20 20 20 20 runname")..
8cf0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
8d00: 22 2d 72 75 6e 6e 61 6d 65 22 29 29 29 0a 20 20 "-runname"))).
8d10: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
8d20: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
8d30: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 73 t-log-port* "Mis
8d40: 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 sing required pa
8d50: 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 rameter for " ac
8d60: 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 tion ", you must
8d70: 20 73 70 65 63 69 66 79 20 74 68 65 20 72 75 6e specify the run
8d80: 20 6e 61 6d 65 20 70 61 74 74 65 72 6e 20 77 69 name pattern wi
8d90: 74 68 20 2d 72 75 6e 6e 61 6d 65 20 70 61 74 74 th -runname patt
8da0: 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 32 "). (exit 2
8db0: 29 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 61 )). ((not (a
8dc0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
8dd0: 73 74 70 61 74 74 22 29 29 0a 20 20 20 20 20 20 stpatt")).
8de0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
8df0: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
8e00: 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 69 6e 67 g-port* "Missing
8e10: 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 required parame
8e20: 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f 6e ter for " action
8e30: 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 ", you must spe
8e40: 63 69 66 79 20 74 68 65 20 74 65 73 74 20 70 61 cify the test pa
8e50: 74 74 65 72 6e 20 77 69 74 68 20 2d 74 65 73 74 ttern with -test
8e60: 70 61 74 74 22 29 0a 20 20 20 20 20 20 28 65 78 patt"). (ex
8e70: 69 74 20 33 29 29 0a 20 20 20 20 20 28 65 6c 73 it 3)). (els
8e80: 65 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 e. (if (not
8e90: 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 (car *configinf
8ea0: 6f 2a 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 o*)).. (begin..
8eb0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
8ec0: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
8ed0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 41 74 74 t-log-port* "Att
8ee0: 65 6d 70 74 65 64 20 22 20 61 63 74 69 6f 6e 20 empted " action
8ef0: 22 6f 6e 20 74 65 73 74 28 73 29 20 62 75 74 20 "on test(s) but
8f00: 72 75 6e 20 61 72 65 61 20 63 6f 6e 66 69 67 20 run area config
8f10: 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 22 29 file not found")
8f20: 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 0a .. (exit 1)).
8f30: 09 20 20 3b 3b 20 70 75 74 20 74 65 73 74 20 70 . ;; put test p
8f40: 61 72 61 6d 65 74 65 72 73 20 69 6e 74 6f 20 63 arameters into c
8f50: 6f 6e 76 65 6e 69 65 6e 74 20 76 61 72 69 61 62 onvenient variab
8f60: 6c 65 73 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 les.. (begin..
8f70: 20 20 20 3b 3b 20 63 68 65 63 6b 20 66 6f 72 20 ;; check for
8f80: 63 6f 72 72 65 63 74 20 76 65 72 73 69 6f 6e 2c correct version,
8f90: 20 65 78 69 74 20 77 69 74 68 20 6d 65 73 73 61 exit with messa
8fa0: 67 65 20 69 66 20 6e 6f 74 20 63 6f 72 72 65 63 ge if not correc
8fb0: 74 0a 09 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 65 t.. (common:e
8fc0: 78 69 74 2d 6f 6e 2d 76 65 72 73 69 6f 6e 2d 63 xit-on-version-c
8fd0: 68 61 6e 67 65 64 29 0a 09 20 20 20 20 28 72 75 hanged).. (ru
8fe0: 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 20 61 ns:operate-on a
8ff0: 63 74 69 6f 6e 0a 09 09 09 20 20 20 20 20 20 74 ction.... t
9000: 61 72 67 65 74 0a 09 09 09 20 20 20 20 20 20 28 arget.... (
9010: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
9020: 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 runname) ;; (or
9030: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9040: 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a -runname")(args:
9050: 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d get-arg ":runnam
9060: 65 22 29 29 0a 09 09 09 20 20 20 20 20 20 28 63 e")).... (c
9070: 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 ommon:args-get-t
9080: 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 estpatt #f) ;; (
9090: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
90a0: 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 estpatt")....
90b0: 20 20 20 73 74 61 74 65 3a 20 28 63 6f 6d 6d 6f state: (commo
90c0: 6e 3a 61 72 67 73 2d 67 65 74 2d 73 74 61 74 65 n:args-get-state
90d0: 29 0a 09 09 09 20 20 20 20 20 20 73 74 61 74 75 ).... statu
90e0: 73 3a 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d s: (common:args-
90f0: 67 65 74 2d 73 74 61 74 75 73 29 0a 09 09 09 20 get-status)....
9100: 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 new-state-s
9110: 74 61 74 75 73 3a 20 28 61 72 67 73 3a 67 65 74 tatus: (args:get
9120: 2d 61 72 67 20 22 2d 73 65 74 2d 73 74 61 74 65 -arg "-set-state
9130: 2d 73 74 61 74 75 73 22 29 29 29 29 0a 20 20 20 -status")))).
9140: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
9150: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 29 0a ething* #t))))).
9160: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
9170: 72 67 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 rg "-remove-runs
9180: 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d "). (general-
9190: 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 run-call . "
91a0: 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 0a 20 20 -remove-runs".
91b0: 20 20 20 22 72 65 6d 6f 76 65 20 72 75 6e 73 22 "remove runs"
91c0: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 . (lambda (t
91d0: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
91e0: 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 ys keyvals).
91f0: 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 (operate-on '
9200: 72 65 6d 6f 76 65 2d 72 75 6e 73 29 29 29 29 0a remove-runs)))).
9210: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
9220: 72 67 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 rg "-set-state-s
9230: 74 61 74 75 73 22 29 0a 20 20 20 20 28 67 65 6e tatus"). (gen
9240: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 eral-run-call .
9250: 20 20 20 20 22 2d 73 65 74 2d 73 74 61 74 65 2d "-set-state-
9260: 73 74 61 74 75 73 22 0a 20 20 20 20 20 22 73 65 status". "se
9270: 74 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 t state and stat
9280: 75 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 us". (lambda
9290: 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 (target runname
92a0: 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 keys keyvals).
92b0: 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d 6f (operate-o
92c0: 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 61 n 'set-state-sta
92d0: 74 75 73 29 29 29 29 0a 0a 28 69 66 20 28 6f 72 tus))))..(if (or
92e0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
92f0: 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 -set-run-status"
9300: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
9310: 20 22 2d 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 "-get-run-statu
9320: 73 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 s")). (genera
9330: 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 20 l-run-call.
9340: 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 "-set-run-status
9350: 22 0a 20 20 20 20 20 22 73 65 74 20 72 75 6e 20 ". "set run
9360: 73 74 61 74 75 73 22 0a 20 20 20 20 20 28 6c 61 status". (la
9370: 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
9380: 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c name keys keyval
9390: 73 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 s). (let*
93a0: 28 28 72 75 6e 73 64 61 74 20 20 28 72 6d 74 3a ((runsdat (rmt:
93b0: 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 get-runs-by-patt
93c0: 20 6b 65 79 73 20 72 75 6e 6e 61 6d 65 20 0a 09 keys runname ..
93d0: 09 09 09 09 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 ....(common:args
93e0: 2d 67 65 74 2d 74 61 72 67 65 74 29 0a 09 09 09 -get-target)....
93f0: 09 09 23 66 20 23 66 20 23 66 20 23 66 29 29 0a ..#f #f #f #f)).
9400: 09 20 20 20 20 20 20 28 68 65 61 64 65 72 20 20 . (header
9410: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e (vector-ref run
9420: 73 64 61 74 20 30 29 29 0a 09 20 20 20 20 20 20 sdat 0))..
9430: 28 72 6f 77 73 20 20 20 20 20 28 76 65 63 74 6f (rows (vecto
9440: 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 31 29 r-ref runsdat 1)
9450: 29 29 0a 09 20 28 69 66 20 28 6e 75 6c 6c 3f 20 )).. (if (null?
9460: 72 6f 77 73 29 0a 09 20 20 20 20 20 28 62 65 67 rows).. (beg
9470: 69 6e 0a 09 20 20 20 20 20 20 20 28 64 65 62 75 in.. (debu
9480: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
9490: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
94a0: 2a 20 22 4e 6f 20 6d 61 74 63 68 69 6e 67 20 72 * "No matching r
94b0: 75 6e 20 66 6f 75 6e 64 2e 22 29 0a 09 20 20 20 un found.")..
94c0: 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 09 20 (exit 1))..
94d0: 20 20 20 20 28 6c 65 74 2a 20 28 28 72 6f 77 20 (let* ((row
94e0: 20 20 20 20 20 28 63 61 72 20 28 76 65 63 74 6f (car (vecto
94f0: 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 31 29 r-ref runsdat 1)
9500: 29 29 0a 09 09 20 20 20 20 28 72 75 6e 2d 69 64 ))... (run-id
9510: 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 (db:get-value
9520: 2d 62 79 2d 68 65 61 64 65 72 20 72 6f 77 20 68 -by-header row h
9530: 65 61 64 65 72 20 22 69 64 22 29 29 29 0a 09 20 eader "id")))..
9540: 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a (if (args:
9550: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 72 75 get-arg "-set-ru
9560: 6e 2d 73 74 61 74 75 73 22 29 0a 09 09 20 20 20 n-status")...
9570: 28 72 6d 74 3a 73 65 74 2d 72 75 6e 2d 73 74 61 (rmt:set-run-sta
9580: 74 75 73 20 72 75 6e 2d 69 64 20 28 61 72 67 73 tus run-id (args
9590: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 72 :get-arg "-set-r
95a0: 75 6e 2d 73 74 61 74 75 73 22 29 20 6d 73 67 3a un-status") msg:
95b0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
95c0: 2d 6d 22 29 29 0a 09 09 20 20 20 28 70 72 69 6e -m"))... (prin
95d0: 74 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 t (rmt:get-run-s
95e0: 74 61 74 75 73 20 72 75 6e 2d 69 64 29 29 0a 09 tatus run-id))..
95f0: 09 20 20 20 29 29 29 29 29 29 29 0a 0a 3b 3b 3d . )))))))..;;=
9600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9640: 3d 3d 3d 3d 3d 0a 3b 3b 20 51 75 65 72 79 20 72 =====.;; Query r
9650: 75 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d uns.;;==========
9660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
96a0: 20 2d 66 69 65 6c 64 73 20 72 75 6e 73 3a 69 64 -fields runs:id
96b0: 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 2c ,target,runname,
96c0: 63 6f 6d 6d 65 6e 74 2b 74 65 73 74 73 3a 69 64 comment+tests:id
96d0: 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 ,testname,item_p
96e0: 61 74 68 2b 73 74 65 70 73 0a 3b 3b 0a 3b 3b 20 ath+steps.;;.;;
96f0: 63 73 69 3e 20 28 65 78 74 72 61 63 74 2d 66 69 csi> (extract-fi
9700: 65 6c 64 73 2d 63 6f 6e 73 74 72 61 69 6e 74 73 elds-constraints
9710: 20 22 72 75 6e 73 3a 69 64 2c 74 61 72 67 65 74 "runs:id,target
9720: 2c 72 75 6e 6e 61 6d 65 2c 63 6f 6d 6d 65 6e 74 ,runname,comment
9730: 2b 74 65 73 74 73 3a 69 64 2c 74 65 73 74 6e 61 +tests:id,testna
9740: 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2b 73 74 65 me,item_path+ste
9750: 70 73 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 ps").;;
9760: 3d 3e 20 28 28 22 72 75 6e 73 22 20 22 69 64 22 => (("runs" "id"
9770: 20 22 74 61 72 67 65 74 22 20 22 72 75 6e 6e 61 "target" "runna
9780: 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 20 28 me" "comment") (
9790: 22 74 65 73 74 73 22 20 22 69 64 22 20 22 74 65 "tests" "id" "te
97a0: 73 74 6e 61 6d 65 22 20 22 69 74 65 6d 5f 70 61 stname" "item_pa
97b0: 74 68 22 29 20 28 22 73 74 65 70 73 22 29 29 0a th") ("steps")).
97c0: 3b 3b 0a 3b 3b 20 20 20 4e 4f 54 45 3a 20 72 65 ;;.;; NOTE: re
97d0: 6d 65 6d 62 65 72 20 74 68 61 74 20 74 68 65 20 member that the
97e0: 63 64 72 20 77 69 6c 6c 20 62 65 20 74 68 65 20 cdr will be the
97f0: 6c 69 73 74 20 79 6f 75 20 65 78 70 65 63 74 20 list you expect
9800: 28 63 64 72 20 28 22 72 75 6e 73 22 20 22 69 64 (cdr ("runs" "id
9810: 22 20 22 74 61 72 67 65 74 22 20 22 72 75 6e 6e " "target" "runn
9820: 61 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 29 ame" "comment"))
9830: 20 3d 3e 20 28 22 69 64 22 20 22 74 61 72 67 65 => ("id" "targe
9840: 74 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 63 6f t" "runname" "co
9850: 6d 6d 65 6e 74 22 29 0a 3b 3b 20 20 20 20 20 20 mment").;;
9860: 20 20 20 61 6e 64 20 73 6f 20 61 6c 69 73 74 2d and so alist-
9870: 72 65 66 20 77 69 6c 6c 20 79 69 65 6c 64 20 77 ref will yield w
9880: 68 61 74 20 79 6f 75 20 65 78 70 65 63 74 0a 3b hat you expect.;
9890: 3b 0a 28 64 65 66 69 6e 65 20 28 65 78 74 72 61 ;.(define (extra
98a0: 63 74 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 74 72 ct-fields-constr
98b0: 61 69 6e 74 73 20 66 69 65 6c 64 73 2d 73 70 65 aints fields-spe
98c0: 63 29 0a 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 c). (map (lambd
98d0: 61 20 28 74 61 62 6c 65 2d 73 70 65 63 29 20 3b a (table-spec) ;
98e0: 3b 20 72 75 6e 73 3a 69 64 2c 74 61 72 67 65 74 ; runs:id,target
98f0: 2c 72 75 6e 6e 61 6d 65 0a 09 20 28 6c 65 74 20 ,runname.. (let
9900: 28 28 64 61 74 20 28 73 74 72 69 6e 67 2d 73 70 ((dat (string-sp
9910: 6c 69 74 20 74 61 62 6c 65 2d 73 70 65 63 20 22 lit table-spec "
9920: 3a 22 29 29 29 20 3b 3b 20 28 22 72 75 6e 73 22 :"))) ;; ("runs"
9930: 20 22 69 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e "id,target,runn
9940: 61 6d 65 22 29 0a 09 20 20 20 28 69 66 20 28 3e ame").. (if (>
9950: 20 28 6c 65 6e 67 74 68 20 64 61 74 29 20 31 29 (length dat) 1)
9960: 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 .. (cons (
9970: 63 61 72 20 64 61 74 29 28 73 74 72 69 6e 67 2d car dat)(string-
9980: 73 70 6c 69 74 20 28 63 61 64 72 20 64 61 74 29 split (cadr dat)
9990: 20 22 2c 22 29 29 20 3b 3b 20 22 69 64 2c 74 61 ",")) ;; "id,ta
99a0: 72 67 65 74 2c 72 75 6e 6e 61 6d 65 22 0a 09 20 rget,runname"..
99b0: 20 20 20 20 20 20 64 61 74 29 29 29 0a 20 20 20 dat))).
99c0: 20 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 (string-spli
99d0: 74 20 66 69 65 6c 64 73 2d 73 70 65 63 20 22 2b t fields-spec "+
99e0: 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 ")))..(define (g
99f0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
9a00: 64 6e 61 6d 65 20 64 61 74 61 76 65 63 20 74 65 dname datavec te
9a10: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 66 st-field-index f
9a20: 69 65 6c 64 6e 61 6d 65 29 0a 20 20 28 6c 65 74 ieldname). (let
9a30: 20 28 28 69 6e 64 78 20 28 68 61 73 68 2d 74 61 ((indx (hash-ta
9a40: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
9a50: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
9a60: 20 66 69 65 6c 64 6e 61 6d 65 20 23 66 29 29 29 fieldname #f)))
9a70: 0a 20 20 20 20 28 69 66 20 69 6e 64 78 0a 09 28 . (if indx..(
9a80: 69 66 20 28 3e 3d 20 69 6e 64 78 20 28 76 65 63 if (>= indx (vec
9a90: 74 6f 72 2d 6c 65 6e 67 74 68 20 64 61 74 61 76 tor-length datav
9aa0: 65 63 29 29 0a 09 20 20 20 20 23 66 20 3b 3b 20 ec)).. #f ;;
9ab0: 69 6e 64 65 78 20 74 6f 6f 20 68 69 67 68 2c 20 index too high,
9ac0: 73 68 6f 75 6c 64 20 72 61 69 73 65 20 61 6e 20 should raise an
9ad0: 65 72 72 6f 72 20 49 20 73 75 70 70 6f 73 65 0a error I suppose.
9ae0: 09 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 . (vector-ref
9af0: 20 64 61 74 61 76 65 63 20 69 6e 64 78 29 29 0a datavec indx)).
9b00: 09 23 66 29 29 29 0a 0a 3b 3b 20 4e 4f 54 45 3a .#f)))..;; NOTE:
9b10: 20 6c 69 73 74 2d 72 75 6e 73 20 61 6e 64 20 6c list-runs and l
9b20: 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 20 6f ist-db-targets o
9b30: 70 65 72 61 74 65 20 6f 6e 20 6c 6f 63 61 6c 20 perate on local
9b40: 64 62 21 21 21 0a 3b 3b 0a 3b 3b 20 49 44 45 41 db!!!.;;.;; IDEA
9b50: 3a 20 6d 65 67 61 74 65 73 74 20 6c 69 73 74 20 : megatest list
9b60: 2d 72 75 6e 6e 61 6d 65 20 62 6c 61 68 25 20 2e -runname blah% .
9b70: 2e 2e 0a 3b 3b 0a 28 69 66 20 28 6f 72 20 28 61 ...;;.(if (or (a
9b80: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
9b90: 73 74 2d 72 75 6e 73 22 29 0a 09 28 61 72 67 73 st-runs")..(args
9ba0: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d :get-arg "-list-
9bb0: 64 62 2d 74 61 72 67 65 74 73 22 29 29 0a 20 20 db-targets")).
9bc0: 20 20 28 69 66 20 28 6c 61 75 6e 63 68 3a 73 65 (if (launch:se
9bd0: 74 75 70 29 0a 09 28 6c 65 74 2a 20 28 3b 3b 20 tup)..(let* (;;
9be0: 28 64 62 73 74 72 75 63 74 20 20 20 20 28 6d 61 (dbstruct (ma
9bf0: 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 ke-dbr:dbstruct
9c00: 70 61 74 68 3a 20 2a 74 6f 70 70 61 74 68 2a 20 path: *toppath*
9c10: 6c 6f 63 61 6c 3a 20 28 61 72 67 73 3a 67 65 74 local: (args:get
9c20: 2d 61 72 67 20 22 2d 6c 6f 63 61 6c 22 29 29 29 -arg "-local")))
9c30: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 70 61 74 .. (runpat
9c40: 74 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d t (args:get-
9c50: 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 arg "-list-runs"
9c60: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
9c70: 20 20 28 61 63 63 65 73 73 2d 6d 6f 64 65 20 28 (access-mode (
9c80: 64 62 3a 67 65 74 2d 61 63 63 65 73 73 2d 6d 6f db:get-access-mo
9c90: 64 65 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 de)).. (te
9ca0: 73 74 70 61 74 74 20 20 20 20 28 63 6f 6d 6d 6f stpatt (commo
9cb0: 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 n:args-get-testp
9cc0: 61 74 74 20 23 66 29 29 0a 09 20 20 20 20 20 20 att #f))..
9cd0: 20 3b 3b 20 28 69 66 20 28 61 72 67 73 3a 67 65 ;; (if (args:ge
9ce0: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
9cf0: 22 29 20 0a 09 20 20 20 20 20 20 20 3b 3b 20 20 ") .. ;;
9d00: 09 20 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 . (args:g
9d10: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
9d20: 74 22 29 20 0a 09 20 20 20 20 20 20 20 3b 3b 20 t") .. ;;
9d30: 20 09 20 20 20 20 20 20 20 20 22 25 22 29 29 0a . "%")).
9d40: 09 20 20 20 20 20 20 20 28 6b 65 79 73 20 20 20 . (keys
9d50: 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 (rmt:get-ke
9d60: 79 73 29 29 20 3b 3b 20 28 64 62 3a 67 65 74 2d ys)) ;; (db:get-
9d70: 6b 65 79 73 20 64 62 73 74 72 75 63 74 29 29 0a keys dbstruct)).
9d80: 09 20 20 20 20 20 20 20 3b 3b 20 28 72 75 6e 73 . ;; (runs
9d90: 64 61 74 20 20 28 64 62 3a 67 65 74 2d 72 75 6e dat (db:get-run
9da0: 73 20 64 62 73 74 72 75 63 74 20 72 75 6e 70 61 s dbstruct runpa
9db0: 74 74 20 23 66 20 23 66 20 27 28 29 29 29 0a 09 tt #f #f '()))..
9dc0: 3b 3b 20 28 72 75 6e 73 64 61 74 20 20 20 20 20 ;; (runsdat
9dd0: 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 (rmt:get-runs-by
9de0: 2d 70 61 74 74 20 6b 65 79 73 20 28 6f 72 20 72 -patt keys (or r
9df0: 75 6e 70 61 74 74 20 22 25 22 29 20 28 63 6f 6d unpatt "%") (com
9e00: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 mon:args-get-tar
9e10: 67 65 74 29 20 3b 3b 20 28 64 62 3a 67 65 74 2d get) ;; (db:get-
9e20: 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 64 62 73 runs-by-patt dbs
9e30: 74 72 75 63 74 20 6b 65 79 73 20 28 6f 72 20 72 truct keys (or r
9e40: 75 6e 70 61 74 74 20 22 25 22 29 20 28 63 6f 6d unpatt "%") (com
9e50: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 mon:args-get-tar
9e60: 67 65 74 29 0a 09 3b 3b 20 09 09 20 20 20 20 20 get)..;; ..
9e70: 20 20 20 20 20 20 09 20 23 66 20 23 66 20 27 28 . #f #f '(
9e80: 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 "id" "runname" "
9e90: 73 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 state" "status"
9ea0: 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 "owner" "event_t
9eb0: 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 20 ime" "comment")
9ec0: 30 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 0)).. (run
9ed0: 73 64 61 74 20 20 20 20 20 28 72 6d 74 3a 67 65 sdat (rmt:ge
9ee0: 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 6b t-runs-by-patt k
9ef0: 65 79 73 20 28 6f 72 20 72 75 6e 70 61 74 74 20 eys (or runpatt
9f00: 22 25 22 29 20 0a 20 20 20 20 20 20 20 20 20 20 "%") .
9f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9f30: 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a (common:
9f40: 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 args-get-target)
9f50: 20 23 66 20 23 66 20 27 28 22 69 64 22 20 22 72 #f #f '("id" "r
9f60: 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 20 unname" "state"
9f70: 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 22 "status" "owner"
9f80: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 22 63 "event_time" "c
9f90: 6f 6d 6d 65 6e 74 22 29 20 30 29 29 0a 09 20 20 omment") 0))..
9fa0: 20 20 20 20 20 28 72 75 6e 73 74 6d 70 20 20 20 (runstmp
9fb0: 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 (db:get-rows r
9fc0: 75 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 20 unsdat))..
9fd0: 20 28 68 65 61 64 65 72 20 20 20 20 20 20 28 64 (header (d
9fe0: 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e b:get-header run
9ff0: 73 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 3b sdat)).. ;
a000: 3b 20 74 68 69 73 20 69 73 20 22 2d 73 69 6e 63 ; this is "-sinc
a010: 65 22 20 73 75 70 70 6f 72 74 2e 20 54 68 69 73 e" support. This
a020: 20 6c 6f 6f 6b 73 20 61 74 20 6c 61 73 74 20 6d looks at last m
a030: 6f 64 20 74 69 6d 65 73 20 6f 66 20 3c 72 75 6e od times of <run
a040: 2d 69 64 3e 2e 64 62 20 66 69 6c 65 73 0a 09 20 -id>.db files..
a050: 20 20 20 20 20 20 3b 3b 20 61 6e 64 20 63 6f 6c ;; and col
a060: 6c 65 63 74 73 20 74 68 6f 73 65 20 6d 6f 64 69 lects those modi
a070: 66 69 65 64 20 73 69 6e 63 65 20 74 68 65 20 2d fied since the -
a080: 73 69 6e 63 65 20 74 69 6d 65 2e 0a 09 20 20 20 since time...
a090: 20 20 20 20 28 72 75 6e 73 20 20 20 20 20 20 20 (runs
a0a0: 20 72 75 6e 73 74 6d 70 29 0a 20 20 20 20 20 20 runstmp).
a0b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a0c0: 20 20 3b 3b 20 28 69 66 20 28 61 6e 64 20 28 6e ;; (if (and (n
a0d0: 6f 74 20 28 6e 75 6c 6c 3f 20 72 75 6e 73 74 6d ot (null? runstm
a0e0: 70 29 29 0a 09 09 09 3b 3b 20 20 20 20 20 20 20 p))....;;
a0f0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
a100: 2d 73 69 6e 63 65 22 29 29 0a 09 09 09 3b 3b 20 -since"))....;;
a110: 20 20 28 6c 65 74 20 28 28 63 68 61 6e 67 65 64 (let ((changed
a120: 2d 69 64 73 20 28 64 62 3a 67 65 74 2d 63 68 61 -ids (db:get-cha
a130: 6e 67 65 64 2d 72 75 6e 2d 69 64 73 20 28 73 74 nged-run-ids (st
a140: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 ring->number (ar
a150: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 6e gs:get-arg "-sin
a160: 63 65 22 29 29 29 29 29 0a 09 09 09 3b 3b 20 20 ce")))))....;;
a170: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 (let loop ((h
a180: 65 64 20 28 63 61 72 20 72 75 6e 73 74 6d 70 29 ed (car runstmp)
a190: 29 0a 09 09 09 3b 3b 20 20 20 09 20 20 20 20 20 )....;; .
a1a0: 28 74 61 6c 20 28 63 64 72 20 72 75 6e 73 74 6d (tal (cdr runstm
a1b0: 70 29 29 0a 09 09 09 3b 3b 20 20 20 09 20 20 20 p))....;; .
a1c0: 20 20 28 72 65 73 20 27 28 29 29 29 0a 09 09 09 (res '()))....
a1d0: 3b 3b 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 ;; (let ((
a1e0: 6e 65 77 2d 72 65 73 20 28 69 66 20 28 6d 65 6d new-res (if (mem
a1f0: 62 65 72 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 ber (db:get-valu
a200: 65 2d 62 79 2d 68 65 61 64 65 72 20 68 65 64 20 e-by-header hed
a210: 68 65 61 64 65 72 20 22 69 64 22 29 20 63 68 61 header "id") cha
a220: 6e 67 65 64 2d 69 64 73 29 0a 09 09 09 3b 3b 20 nged-ids)....;;
a230: 20 20 09 09 20 20 20 20 20 20 20 28 63 6f 6e 73 .. (cons
a240: 20 68 65 64 20 72 65 73 29 0a 09 09 09 3b 3b 20 hed res)....;;
a250: 20 20 09 09 20 20 20 20 20 20 20 72 65 73 29 29 .. res))
a260: 29 0a 09 09 09 3b 3b 20 20 20 20 20 20 20 20 20 )....;;
a270: 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a (if (null? tal).
a280: 09 09 09 3b 3b 20 20 20 09 20 20 28 72 65 76 65 ...;; . (reve
a290: 72 73 65 20 6e 65 77 2d 72 65 73 29 0a 09 09 09 rse new-res)....
a2a0: 3b 3b 20 20 20 09 20 20 28 6c 6f 6f 70 20 28 63 ;; . (loop (c
a2b0: 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 ar tal)(cdr tal)
a2c0: 20 6e 65 77 2d 72 65 73 29 29 29 29 29 0a 09 09 new-res)))))...
a2d0: 09 3b 3b 20 20 20 72 75 6e 73 74 6d 70 29 29 0a .;; runstmp)).
a2e0: 09 20 20 20 20 20 20 20 28 64 62 2d 74 61 72 67 . (db-targ
a2f0: 65 74 73 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ets (args:get-a
a300: 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 rg "-list-db-tar
a310: 67 65 74 73 22 29 29 0a 09 20 20 20 20 20 20 20 gets"))..
a320: 28 73 65 65 6e 20 20 20 20 20 20 20 20 28 6d 61 (seen (ma
a330: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
a340: 09 20 20 20 20 20 20 20 28 64 6d 6f 64 65 20 20 . (dmode
a350: 20 20 20 20 20 28 6c 65 74 20 28 28 64 20 28 61 (let ((d (a
a360: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
a370: 6d 70 6d 6f 64 65 22 29 29 29 0a 09 09 09 20 20 mpmode")))....
a380: 20 20 20 20 28 69 66 20 64 20 28 73 74 72 69 6e (if d (strin
a390: 67 2d 3e 73 79 6d 62 6f 6c 20 64 29 20 23 66 29 g->symbol d) #f)
a3a0: 29 29 0a 09 20 20 20 20 20 20 20 28 64 61 74 61 )).. (data
a3b0: 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 (make-ha
a3c0: 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 20 20 sh-table))..
a3d0: 20 20 20 28 66 69 65 6c 64 73 2d 73 70 65 63 20 (fields-spec
a3e0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
a3f0: 67 20 22 2d 66 69 65 6c 64 73 22 29 0a 09 09 09 g "-fields")....
a400: 09 28 65 78 74 72 61 63 74 2d 66 69 65 6c 64 73 .(extract-fields
a410: 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 28 61 72 -constraints (ar
a420: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 66 69 65 gs:get-arg "-fie
a430: 6c 64 73 22 29 29 0a 09 09 09 09 28 6c 69 73 74 lds")).....(list
a440: 20 28 63 6f 6e 73 20 22 72 75 6e 73 22 20 28 61 (cons "runs" (a
a450: 70 70 65 6e 64 20 6b 65 79 73 20 28 6c 69 73 74 ppend keys (list
a460: 20 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 "id" "runname"
a470: 22 73 74 61 74 65 22 20 22 73 74 61 74 75 73 22 "state" "status"
a480: 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f "owner" "event_
a490: 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 20 time" "comment"
a4a0: 22 66 61 69 6c 5f 63 6f 75 6e 74 22 20 22 70 61 "fail_count" "pa
a4b0: 73 73 5f 63 6f 75 6e 74 22 29 29 29 0a 09 09 09 ss_count")))....
a4c0: 09 20 20 20 20 20 20 28 63 6f 6e 73 20 22 74 65 . (cons "te
a4d0: 73 74 73 22 20 20 64 62 3a 74 65 73 74 2d 72 65 sts" db:test-re
a4e0: 63 6f 72 64 2d 66 69 65 6c 64 73 29 20 3b 3b 20 cord-fields) ;;
a4f0: 22 69 64 22 20 22 74 65 73 74 6e 61 6d 65 22 20 "id" "testname"
a500: 22 74 65 73 74 5f 70 61 74 68 22 29 0a 09 09 09 "test_path")....
a510: 09 20 20 20 20 20 20 28 6c 69 73 74 20 22 73 74 . (list "st
a520: 65 70 73 22 20 22 69 64 22 20 22 73 74 65 70 6e eps" "id" "stepn
a530: 61 6d 65 22 29 29 29 29 0a 09 20 20 20 20 20 20 ame"))))..
a540: 20 28 72 75 6e 73 2d 73 70 65 63 20 20 20 28 6c (runs-spec (l
a550: 65 74 20 28 28 72 20 28 61 6c 69 73 74 2d 72 65 et ((r (alist-re
a560: 66 20 22 72 75 6e 73 22 20 20 66 69 65 6c 64 73 f "runs" fields
a570: 2d 73 70 65 63 20 65 71 75 61 6c 3f 29 29 29 20 -spec equal?)))
a580: 3b 3b 20 74 68 65 20 63 68 65 63 6b 20 69 73 20 ;; the check is
a590: 6e 6f 77 20 75 6e 6e 65 63 65 73 73 61 72 79 0a now unnecessary.
a5a0: 09 09 09 20 20 20 20 20 20 28 69 66 20 28 61 6e ... (if (an
a5b0: 64 20 72 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 d r (not (null?
a5c0: 72 29 29 29 20 72 20 28 6c 69 73 74 20 22 69 64 r))) r (list "id
a5d0: 22 20 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 " )))).. (
a5e0: 74 65 73 74 73 2d 73 70 65 63 20 20 28 6c 65 74 tests-spec (let
a5f0: 20 28 28 74 20 28 61 6c 69 73 74 2d 72 65 66 20 ((t (alist-ref
a600: 22 74 65 73 74 73 22 20 66 69 65 6c 64 73 2d 73 "tests" fields-s
a610: 70 65 63 20 65 71 75 61 6c 3f 29 29 29 0a 09 09 pec equal?)))...
a620: 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 . (if (and
a630: 74 20 28 6e 75 6c 6c 3f 20 74 29 29 20 3b 3b 20 t (null? t)) ;;
a640: 61 6c 6c 20 66 69 65 6c 64 73 0a 09 09 09 09 20 all fields.....
a650: 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d db:test-record-
a660: 66 69 65 6c 64 73 0a 09 09 09 09 20 20 74 29 29 fields..... t))
a670: 29 0a 09 20 20 20 20 20 20 20 28 61 64 6a 2d 74 ).. (adj-t
a680: 65 73 74 73 2d 73 70 65 63 20 28 64 65 6c 65 74 ests-spec (delet
a690: 65 2d 64 75 70 6c 69 63 61 74 65 73 20 28 69 66 e-duplicates (if
a6a0: 20 74 65 73 74 73 2d 73 70 65 63 20 28 63 6f 6e tests-spec (con
a6b0: 73 20 22 69 64 22 20 74 65 73 74 73 2d 73 70 65 s "id" tests-spe
a6c0: 63 29 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 c) db:test-recor
a6d0: 64 2d 66 69 65 6c 64 73 29 29 29 20 3b 3b 20 27 d-fields))) ;; '
a6e0: 28 22 69 64 22 29 29 29 29 0a 09 20 20 20 20 20 ("id"))))..
a6f0: 20 20 28 73 74 65 70 73 2d 73 70 65 63 20 20 28 (steps-spec (
a700: 61 6c 69 73 74 2d 72 65 66 20 22 73 74 65 70 73 alist-ref "steps
a710: 22 20 66 69 65 6c 64 73 2d 73 70 65 63 20 65 71 " fields-spec eq
a720: 75 61 6c 3f 29 29 0a 09 20 20 20 20 20 20 20 28 ual?)).. (
a730: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
a740: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
a750: 65 29 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 e))).. (if (and
a760: 20 74 65 73 74 73 2d 73 70 65 63 20 28 6e 6f 74 tests-spec (not
a770: 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 2d 73 70 (null? tests-sp
a780: 65 63 29 29 29 20 3b 3b 20 64 6f 20 73 6f 6d 65 ec))) ;; do some
a790: 20 76 61 6c 69 64 61 74 69 6f 6e 20 61 6e 64 20 validation and
a7a0: 70 72 6f 63 65 73 73 69 6e 67 20 6f 66 20 74 68 processing of th
a7b0: 65 20 74 65 73 74 2d 73 70 65 63 0a 09 20 20 20 e test-spec..
a7c0: 20 20 20 28 6c 65 74 20 28 28 69 6e 76 61 6c 69 (let ((invali
a7d0: 64 2d 74 65 73 74 73 2d 73 70 65 63 20 28 66 69 d-tests-spec (fi
a7e0: 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 lter (lambda (x)
a7f0: 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 78 20 64 (not (member x d
a800: 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 b:test-record-fi
a810: 65 6c 64 73 29 29 29 20 74 65 73 74 73 2d 73 70 elds))) tests-sp
a820: 65 63 29 29 29 0a 09 09 28 69 66 20 28 6e 75 6c ec)))...(if (nul
a830: 6c 3f 20 69 6e 76 61 6c 69 64 2d 74 65 73 74 73 l? invalid-tests
a840: 2d 73 70 65 63 29 0a 09 09 20 20 20 20 3b 3b 20 -spec)... ;;
a850: 67 65 6e 65 72 61 74 65 20 74 68 65 20 6c 6f 6f generate the loo
a860: 6b 75 70 20 6d 61 70 20 74 65 73 74 2d 66 69 65 kup map test-fie
a870: 6c 64 2d 6e 61 6d 65 20 3d 3e 20 69 6e 64 65 78 ld-name => index
a880: 2d 6e 75 6d 62 65 72 0a 09 09 20 20 20 20 28 6c -number... (l
a890: 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 et loop ((hed (c
a8a0: 61 72 20 61 64 6a 2d 74 65 73 74 73 2d 73 70 65 ar adj-tests-spe
a8b0: 63 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 74 c)).... (t
a8c0: 61 6c 20 28 63 64 72 20 61 64 6a 2d 74 65 73 74 al (cdr adj-test
a8d0: 73 2d 73 70 65 63 29 29 0a 09 09 09 20 20 20 20 s-spec))....
a8e0: 20 20 20 28 69 64 78 20 30 29 29 0a 09 09 20 20 (idx 0))...
a8f0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
a900: 73 65 74 21 20 74 65 73 74 2d 66 69 65 6c 64 2d set! test-field-
a910: 69 6e 64 65 78 20 68 65 64 20 69 64 78 29 0a 09 index hed idx)..
a920: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
a930: 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 28 6c 6f 6f (null? tal))(loo
a940: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
a950: 74 61 6c 29 28 2b 20 69 64 78 20 31 29 29 29 29 tal)(+ idx 1))))
a960: 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ... (begin...
a970: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
a980: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
a990: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 ult-log-port* "I
a9a0: 6e 76 61 6c 69 64 20 74 65 73 74 20 66 69 65 6c nvalid test fiel
a9b0: 64 73 20 73 70 65 63 69 66 69 65 64 3a 20 22 20 ds specified: "
a9c0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
a9d0: 72 73 65 20 69 6e 76 61 6c 69 64 2d 74 65 73 74 rse invalid-test
a9e0: 73 2d 73 70 65 63 20 22 2c 20 22 29 29 0a 09 09 s-spec ", "))...
a9f0: 20 20 20 20 20 20 28 65 78 69 74 29 29 29 29 29 (exit)))))
aa00: 0a 0a 09 20 20 3b 3b 20 45 61 63 68 20 72 75 6e ... ;; Each run
aa10: 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 .. (for-each ..
aa20: 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 (lambda (run)
aa30: 0a 09 20 20 20 20 20 28 6c 65 74 20 28 28 74 61 .. (let ((ta
aa40: 72 67 65 74 73 74 72 20 28 73 74 72 69 6e 67 2d rgetstr (string-
aa50: 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 intersperse (map
aa60: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x)....
aa70: 09 09 09 09 20 28 64 62 3a 67 65 74 2d 76 61 6c .... (db:get-val
aa80: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
aa90: 20 68 65 61 64 65 72 20 78 29 29 0a 09 09 09 09 header x)).....
aaa0: 09 09 20 20 20 20 20 20 20 6b 65 79 73 29 20 22 .. keys) "
aab0: 2f 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 69 /"))).. (i
aac0: 66 20 64 62 2d 74 61 72 67 65 74 73 0a 09 09 20 f db-targets...
aad0: 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 (if (not (hash
aae0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
aaf0: 6c 74 20 73 65 65 6e 20 74 61 72 67 65 74 73 74 lt seen targetst
ab00: 72 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 20 r #f))...
ab10: 28 62 65 67 69 6e 0a 09 09 09 20 28 68 61 73 68 (begin.... (hash
ab20: 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 65 65 6e -table-set! seen
ab30: 20 74 61 72 67 65 74 73 74 72 20 23 74 29 0a 09 targetstr #t)..
ab40: 09 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 5b 22 .. ;; (print "["
ab50: 20 74 61 72 67 65 74 73 74 72 20 22 5d 22 29 29 targetstr "]"))
ab60: 29 29 0a 09 09 09 20 28 69 66 20 28 6e 6f 74 20 )).... (if (not
ab70: 64 6d 6f 64 65 29 0a 09 09 09 20 20 20 20 20 28 dmode).... (
ab80: 70 72 69 6e 74 20 74 61 72 67 65 74 73 74 72 29 print targetstr)
ab90: 0a 09 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 .... (hash-t
aba0: 61 62 6c 65 2d 73 65 74 21 20 64 61 74 61 20 22 able-set! data "
abb0: 74 61 72 67 65 74 73 22 20 28 63 6f 6e 73 20 74 targets" (cons t
abc0: 61 72 67 65 74 73 74 72 20 28 68 61 73 68 2d 74 argetstr (hash-t
abd0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
abe0: 20 64 61 74 61 20 22 74 61 72 67 65 74 73 22 20 data "targets"
abf0: 27 28 29 29 29 29 0a 09 09 09 20 20 20 20 20 29 '()))).... )
ac00: 29 29 0a 09 09 20 20 20 28 6c 65 74 2a 20 28 28 ))... (let* ((
ac10: 72 75 6e 2d 69 64 20 20 28 64 62 3a 67 65 74 2d run-id (db:get-
ac20: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
ac30: 72 75 6e 20 68 65 61 64 65 72 20 22 69 64 22 29 run header "id")
ac40: 29 0a 09 09 09 20 20 28 72 75 6e 6e 61 6d 65 20 ).... (runname
ac50: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
ac60: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
ac70: 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 20 0a er "runname")) .
ac80: 09 09 09 20 20 28 73 74 61 74 65 73 20 20 28 73 ... (states (s
ac90: 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 6f 72 20 tring-split (or
aca0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
acb0: 73 74 61 74 65 22 29 20 22 22 29 20 22 2c 22 29 state") "") ",")
acc0: 29 0a 09 09 09 20 20 28 73 74 61 74 75 73 65 73 ).... (statuses
acd0: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 (string-split (
ace0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
acf0: 20 22 2d 73 74 61 74 75 73 22 29 20 22 22 29 20 "-status") "")
ad00: 22 2c 22 29 29 0a 09 09 09 20 20 28 74 65 73 74 ",")).... (test
ad10: 73 20 20 20 28 69 66 20 74 65 73 74 73 2d 73 70 s (if tests-sp
ad20: 65 63 0a 09 09 09 09 20 20 20 20 20 20 20 28 64 ec..... (d
ad30: 62 3a 64 69 73 70 61 74 63 68 2d 71 75 65 72 79 b:dispatch-query
ad40: 20 61 63 63 65 73 73 2d 6d 6f 64 65 20 72 6d 74 access-mode rmt
ad50: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
ad60: 75 6e 20 64 62 3a 67 65 74 2d 74 65 73 74 73 2d un db:get-tests-
ad70: 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 64 20 74 for-run run-id t
ad80: 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 estpatt states s
ad90: 74 61 74 75 73 65 73 20 23 66 20 23 66 20 23 66 tatuses #f #f #f
ada0: 20 27 74 65 73 74 6e 61 6d 65 20 27 61 73 63 20 'testname 'asc
adb0: 3b 3b 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 ;; (db:get-tests
adc0: 2d 66 6f 72 2d 72 75 6e 20 64 62 73 74 72 75 63 -for-run dbstruc
add0: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 74 t run-id testpat
ade0: 74 20 27 28 29 20 27 28 29 20 23 66 20 23 66 20 t '() '() #f #f
adf0: 23 66 20 27 74 65 73 74 6e 61 6d 65 20 27 61 73 #f 'testname 'as
ae00: 63 20 0a 09 09 09 09 09 09 09 20 20 20 20 20 3b c ........ ;
ae10: 3b 20 75 73 65 20 71 72 79 76 61 6c 73 20 69 66 ; use qryvals if
ae20: 20 74 65 73 74 2d 73 70 65 63 20 70 72 6f 76 69 test-spec provi
ae30: 64 65 64 0a 09 09 09 09 09 09 09 20 20 20 20 20 ded........
ae40: 28 69 66 20 74 65 73 74 73 2d 73 70 65 63 0a 09 (if tests-spec..
ae50: 09 09 09 09 09 09 09 20 28 73 74 72 69 6e 67 2d ....... (string-
ae60: 69 6e 74 65 72 73 70 65 72 73 65 20 61 64 6a 2d intersperse adj-
ae70: 74 65 73 74 73 2d 73 70 65 63 20 22 2c 22 29 0a tests-spec ",").
ae80: 09 09 09 09 09 09 09 09 20 3b 3b 20 64 62 3a 74 ........ ;; db:t
ae90: 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 est-record-field
aea0: 73 0a 09 09 09 09 09 09 09 09 20 23 66 29 0a 09 s......... #f)..
aeb0: 09 09 09 09 09 09 20 20 20 20 20 23 66 0a 09 09 ...... #f...
aec0: 09 09 09 09 09 20 20 20 20 20 27 6e 6f 72 6d 61 ..... 'norma
aed0: 6c 29 0a 09 09 09 09 20 20 20 20 20 20 20 27 28 l)..... '(
aee0: 29 29 29 29 0a 09 09 20 20 20 20 20 28 63 61 73 ))))... (cas
aef0: 65 20 64 6d 6f 64 65 0a 09 09 20 20 20 20 20 20 e dmode...
af00: 20 28 28 6a 73 6f 6e 20 6f 64 73 29 0a 09 09 09 ((json ods)....
af10: 28 69 66 20 72 75 6e 73 2d 73 70 65 63 0a 09 09 (if runs-spec...
af20: 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a . (for-each .
af30: 09 09 09 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ... (lambda
af40: 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 (field-name)....
af50: 20 20 20 20 20 20 20 28 6d 75 74 69 6c 73 3a 68 (mutils:h
af60: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
af70: 61 20 28 63 6f 6e 63 20 28 64 62 3a 67 65 74 2d a (conc (db:get-
af80: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
af90: 72 75 6e 20 68 65 61 64 65 72 20 66 69 65 6c 64 run header field
afa0: 2d 6e 61 6d 65 29 29 20 74 61 72 67 65 74 73 74 -name)) targetst
afb0: 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 r runname "meta"
afc0: 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 0a 09 09 field-name))...
afd0: 09 20 20 20 20 20 72 75 6e 73 2d 73 70 65 63 29 . runs-spec)
afe0: 29 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 ))....;; (mutils
aff0: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
b000: 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 ata (db:get-valu
b010: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
b020: 68 65 61 64 65 72 20 22 73 74 61 74 75 73 22 29 header "status")
b030: 20 20 20 20 20 74 61 72 67 65 74 73 74 72 20 72 targetstr r
b040: 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 73 unname "meta" "s
b050: 74 61 74 75 73 22 20 20 20 20 20 29 0a 09 09 09 tatus" )....
b060: 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ;; (mutils:hierh
b070: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 64 ash-set! data (d
b080: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
b090: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
b0a0: 20 22 73 74 61 74 65 22 29 20 20 20 20 20 20 74 "state") t
b0b0: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
b0c0: 20 22 6d 65 74 61 22 20 22 73 74 61 74 65 22 20 "meta" "state"
b0d0: 20 20 20 20 20 29 0a 09 09 09 3b 3b 20 28 6d 75 )....;; (mu
b0e0: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
b0f0: 74 21 20 64 61 74 61 20 28 63 6f 6e 63 20 28 64 t! data (conc (d
b100: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
b110: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
b120: 20 22 69 64 22 29 29 20 20 74 61 72 67 65 74 73 "id")) targets
b130: 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 tr runname "meta
b140: 22 20 22 69 64 22 20 20 20 20 20 20 20 20 20 29 " "id" )
b150: 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 ....;; (mutils:h
b160: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
b170: 61 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d a (db:get-value-
b180: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
b190: 61 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 ader "event_time
b1a0: 22 29 20 74 61 72 67 65 74 73 74 72 20 72 75 6e ") targetstr run
b1b0: 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 65 76 65 name "meta" "eve
b1c0: 6e 74 5f 74 69 6d 65 22 20 29 0a 09 09 09 3b 3b nt_time" )....;;
b1d0: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
b1e0: 68 2d 73 65 74 21 20 64 61 74 61 20 28 64 62 3a h-set! data (db:
b1f0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
b200: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 der run header "
b210: 63 6f 6d 6d 65 6e 74 22 29 20 20 20 20 74 61 72 comment") tar
b220: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
b230: 6d 65 74 61 22 20 22 63 6f 6d 6d 65 6e 74 22 20 meta" "comment"
b240: 20 20 20 29 0a 09 09 09 3b 3b 20 3b 3b 20 61 64 )....;; ;; ad
b250: 64 20 6c 61 73 74 20 65 6e 74 72 79 20 74 77 69 d last entry twi
b260: 63 65 20 2d 20 73 65 65 6d 73 20 74 6f 20 62 65 ce - seems to be
b270: 20 61 20 62 75 67 20 69 6e 20 68 69 65 72 68 61 a bug in hierha
b280: 73 68 3f 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c sh?....;; (mutil
b290: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
b2a0: 64 61 74 61 20 28 64 62 3a 67 65 74 2d 76 61 6c data (db:get-val
b2b0: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
b2c0: 20 68 65 61 64 65 72 20 22 63 6f 6d 6d 65 6e 74 header "comment
b2d0: 22 29 20 20 20 20 74 61 72 67 65 74 73 74 72 20 ") targetstr
b2e0: 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 runname "meta" "
b2f0: 63 6f 6d 6d 65 6e 74 22 20 20 20 20 29 0a 09 09 comment" )...
b300: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 09 09 (else....
b310: 28 69 66 20 28 6e 75 6c 6c 3f 20 72 75 6e 73 2d (if (null? runs-
b320: 73 70 65 63 29 0a 09 09 09 20 20 20 20 28 70 72 spec).... (pr
b330: 69 6e 74 20 22 52 75 6e 3a 20 22 20 74 61 72 67 int "Run: " targ
b340: 65 74 73 74 72 20 22 2f 22 20 72 75 6e 6e 61 6d etstr "/" runnam
b350: 65 20 0a 09 09 09 09 20 20 20 22 20 73 74 61 74 e ..... " stat
b360: 75 73 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 61 us: " (db:get-va
b370: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
b380: 6e 20 68 65 61 64 65 72 20 22 73 74 61 74 65 22 n header "state"
b390: 29 0a 09 09 09 09 20 20 20 22 20 72 75 6e 2d 69 )..... " run-i
b3a0: 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 2c 20 6e d: " run-id ", n
b3b0: 75 6d 62 65 72 20 74 65 73 74 73 3a 20 22 20 28 umber tests: " (
b3c0: 6c 65 6e 67 74 68 20 74 65 73 74 73 29 0a 09 09 length tests)...
b3d0: 09 09 20 20 20 22 20 65 76 65 6e 74 5f 74 69 6d .. " event_tim
b3e0: 65 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 61 6c e: " (db:get-val
b3f0: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
b400: 20 68 65 61 64 65 72 20 22 65 76 65 6e 74 5f 74 header "event_t
b410: 69 6d 65 22 29 29 0a 09 09 09 20 20 20 20 28 62 ime")).... (b
b420: 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 69 egin.... (i
b430: 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 22 f (not (member "
b440: 74 61 72 67 65 74 22 20 72 75 6e 73 2d 73 70 65 target" runs-spe
b450: 63 29 29 0a 09 09 09 20 20 20 20 20 20 20 20 20 c))....
b460: 20 3b 3b 20 28 64 69 73 70 6c 61 79 20 28 63 6f ;; (display (co
b470: 6e 63 20 22 54 61 72 67 65 74 3a 20 22 20 74 61 nc "Target: " ta
b480: 72 67 65 74 73 74 72 29 29 0a 09 09 09 20 20 20 rgetstr))....
b490: 20 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 (display
b4a0: 28 63 6f 6e 63 20 22 52 75 6e 3a 20 22 20 74 61 (conc "Run: " ta
b4b0: 72 67 65 74 73 74 72 20 22 2f 22 20 72 75 6e 6e rgetstr "/" runn
b4c0: 61 6d 65 20 22 20 22 29 29 29 0a 09 09 09 20 20 ame " ")))....
b4d0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 (for-each...
b4e0: 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 . (lambda
b4f0: 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 (field-name)....
b500: 09 20 28 69 66 20 28 65 71 75 61 6c 3f 20 66 69 . (if (equal? fi
b510: 65 6c 64 2d 6e 61 6d 65 20 22 74 61 72 67 65 74 eld-name "target
b520: 22 29 0a 09 09 09 09 20 20 20 20 20 28 64 69 73 ")..... (dis
b530: 70 6c 61 79 20 28 63 6f 6e 63 20 22 74 61 72 67 play (conc "targ
b540: 65 74 3a 20 22 20 74 61 72 67 65 74 73 74 72 20 et: " targetstr
b550: 22 20 22 29 29 0a 09 09 09 09 20 20 20 20 20 28 " "))..... (
b560: 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 66 69 display (conc fi
b570: 65 6c 64 2d 6e 61 6d 65 20 22 3a 20 22 20 28 64 eld-name ": " (d
b580: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
b590: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
b5a0: 20 28 63 6f 6e 63 20 66 69 65 6c 64 2d 6e 61 6d (conc field-nam
b5b0: 65 29 29 20 22 20 22 29 29 29 29 0a 09 09 09 20 e)) " "))))....
b5c0: 20 20 20 20 20 20 72 75 6e 73 2d 73 70 65 63 29 runs-spec)
b5d0: 0a 09 09 09 20 20 20 20 20 20 28 6e 65 77 6c 69 .... (newli
b5e0: 6e 65 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 ne)))))...
b5f0: 20 0a 09 09 20 20 20 20 20 28 66 6f 72 2d 65 61 ... (for-ea
b600: 63 68 20 0a 09 09 20 20 20 20 20 20 28 6c 61 6d ch ... (lam
b610: 62 64 61 20 28 74 65 73 74 29 0a 09 09 20 20 20 bda (test)...
b620: 20 20 20 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 .(handle-exce
b630: 70 74 69 6f 6e 73 0a 09 09 09 20 65 78 6e 0a 09 ptions.... exn..
b640: 09 09 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 .. (begin....
b650: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
b660: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
b670: 67 2d 70 6f 72 74 2a 20 22 42 61 64 20 64 61 74 g-port* "Bad dat
b680: 61 20 69 6e 20 74 65 73 74 20 72 65 63 6f 72 64 a in test record
b690: 3f 20 22 20 74 65 73 74 29 0a 09 09 09 20 20 20 ? " test)....
b6a0: 28 70 72 69 6e 74 20 22 65 78 6e 3d 22 20 28 63 (print "exn=" (c
b6b0: 6f 6e 64 69 74 69 6f 6e 2d 3e 6c 69 73 74 20 65 ondition->list e
b6c0: 78 6e 29 29 0a 09 09 09 20 20 20 28 64 65 62 75 xn)).... (debu
b6d0: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
b6e0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 6d lt-log-port* " m
b6f0: 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 essage: " ((cond
b700: 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 ition-property-a
b710: 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 ccessor 'exn 'me
b720: 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 09 09 ssage) exn))....
b730: 20 20 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 (print-call-c
b740: 68 61 69 6e 20 28 63 75 72 72 65 6e 74 2d 65 72 hain (current-er
b750: 72 6f 72 2d 70 6f 72 74 29 29 29 0a 09 09 09 20 ror-port)))....
b760: 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 69 64 20 (let* ((test-id
b770: 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 (if (member
b780: 20 22 69 64 22 20 20 20 20 20 20 20 20 20 20 20 "id"
b790: 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d tests-spec)(get-
b7a0: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
b7b0: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
b7c0: 6c 64 2d 69 6e 64 65 78 20 22 69 64 22 20 20 20 ld-index "id"
b7d0: 20 20 20 20 20 20 20 29 20 23 66 29 29 20 3b 3b ) #f)) ;;
b7e0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 (db:test-get-id
b7f0: 20 20 20 20 20 20 20 20 20 74 65 73 74 29 29 0a test)).
b800: 09 09 09 09 28 74 65 73 74 6e 61 6d 65 20 20 20 ....(testname
b810: 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 74 (if (member "t
b820: 65 73 74 6e 61 6d 65 22 20 20 20 20 20 74 65 73 estname" tes
b830: 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c ts-spec)(get-val
b840: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
b850: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
b860: 69 6e 64 65 78 20 22 74 65 73 74 6e 61 6d 65 22 index "testname"
b870: 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 ) #f)) ;; (d
b880: 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn
b890: 61 6d 65 20 20 20 74 65 73 74 29 29 0a 09 09 09 ame test))....
b8a0: 09 28 69 74 65 6d 70 61 74 68 20 20 20 20 20 28 .(itempath (
b8b0: 69 66 20 28 6d 65 6d 62 65 72 20 22 69 74 65 6d if (member "item
b8c0: 5f 70 61 74 68 22 20 20 20 20 74 65 73 74 73 2d _path" tests-
b8d0: 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d spec)(get-value-
b8e0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
b8f0: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
b900: 65 78 20 22 69 74 65 6d 5f 70 61 74 68 22 20 20 ex "item_path"
b910: 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 ) #f)) ;; (db:t
b920: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
b930: 68 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 63 h test)).....(c
b940: 6f 6d 6d 65 6e 74 20 20 20 20 20 20 28 69 66 20 omment (if
b950: 28 6d 65 6d 62 65 72 20 22 63 6f 6d 6d 65 6e 74 (member "comment
b960: 22 20 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 " tests-spe
b970: 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d c)(get-value-by-
b980: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
b990: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
b9a0: 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 20 29 20 "comment" )
b9b0: 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 #f)) ;; (db:test
b9c0: 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 20 20 20 -get-comment
b9d0: 74 65 73 74 29 29 0a 09 09 09 09 28 74 73 74 61 test)).....(tsta
b9e0: 74 65 20 20 20 20 20 20 20 28 69 66 20 28 6d 65 te (if (me
b9f0: 6d 62 65 72 20 22 73 74 61 74 65 22 20 20 20 20 mber "state"
ba00: 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 tests-spec)(
ba10: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
ba20: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
ba30: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 -field-index "st
ba40: 61 74 65 22 20 20 20 20 20 20 20 29 20 23 66 29 ate" ) #f)
ba50: 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 ) ;; (db:test-ge
ba60: 74 2d 73 74 61 74 65 20 20 20 20 20 20 74 65 73 t-state tes
ba70: 74 29 29 0a 09 09 09 09 28 74 73 74 61 74 75 73 t)).....(tstatus
ba80: 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 (if (membe
ba90: 72 20 22 73 74 61 74 75 73 22 20 20 20 20 20 20 r "status"
baa0: 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 tests-spec)(get
bab0: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
bac0: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
bad0: 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 75 eld-index "statu
bae0: 73 22 20 20 20 20 20 20 29 20 23 66 29 29 20 3b s" ) #f)) ;
baf0: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ; (db:test-get-s
bb00: 74 61 74 75 73 20 20 20 20 20 74 65 73 74 29 29 tatus test))
bb10: 0a 09 09 09 09 28 65 76 65 6e 74 2d 74 69 6d 65 .....(event-time
bb20: 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 (if (member "
bb30: 65 76 65 6e 74 5f 74 69 6d 65 22 20 20 20 74 65 event_time" te
bb40: 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 sts-spec)(get-va
bb50: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
bb60: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
bb70: 2d 69 6e 64 65 78 20 22 65 76 65 6e 74 5f 74 69 -index "event_ti
bb80: 6d 65 22 20 20 29 20 23 66 29 29 20 3b 3b 20 28 me" ) #f)) ;; (
bb90: 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e db:test-get-even
bba0: 74 5f 74 69 6d 65 20 74 65 73 74 29 29 0a 09 09 t_time test))...
bbb0: 09 09 28 72 75 6e 64 69 72 20 20 20 20 20 20 20 ..(rundir
bbc0: 28 69 66 20 28 6d 65 6d 62 65 72 20 22 72 75 6e (if (member "run
bbd0: 64 69 72 22 20 20 20 20 20 20 20 74 65 73 74 73 dir" tests
bbe0: 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 -spec)(get-value
bbf0: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
bc00: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
bc10: 64 65 78 20 22 72 75 6e 64 69 72 22 20 20 20 20 dex "rundir"
bc20: 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a ) #f)) ;; (db:
bc30: 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 test-get-rundir
bc40: 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 test)).....(
bc50: 66 69 6e 61 6c 5f 6c 6f 67 66 20 20 20 28 69 66 final_logf (if
bc60: 20 28 6d 65 6d 62 65 72 20 22 66 69 6e 61 6c 5f (member "final_
bc70: 6c 6f 67 66 22 20 20 20 74 65 73 74 73 2d 73 70 logf" tests-sp
bc80: 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 ec)(get-value-by
bc90: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
bca0: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
bcb0: 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 20 29 "final_logf" )
bcc0: 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 #f)) ;; (db:tes
bcd0: 74 2d 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 t-get-final_logf
bce0: 20 74 65 73 74 29 29 0a 09 09 09 09 28 72 75 6e test)).....(run
bcf0: 5f 64 75 72 61 74 69 6f 6e 20 28 69 66 20 28 6d _duration (if (m
bd00: 65 6d 62 65 72 20 22 72 75 6e 5f 64 75 72 61 74 ember "run_durat
bd10: 69 6f 6e 22 20 74 65 73 74 73 2d 73 70 65 63 29 ion" tests-spec)
bd20: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
bd30: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
bd40: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 t-field-index "r
bd50: 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 20 23 66 un_duration") #f
bd60: 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 )) ;; (db:test-g
bd70: 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 et-run_duration
bd80: 74 65 73 74 29 29 0a 09 09 09 09 28 66 75 6c 6c test)).....(full
bd90: 6e 61 6d 65 20 20 20 20 20 28 63 6f 6e 63 20 74 name (conc t
bda0: 65 73 74 6e 61 6d 65 0a 09 09 09 09 09 09 20 20 estname.......
bdb0: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 74 (if (equal? it
bdc0: 65 6d 70 61 74 68 20 22 22 29 0a 09 09 09 09 09 empath "")......
bdd0: 09 09 22 22 20 0a 09 09 09 09 09 09 09 28 63 6f .."" ........(co
bde0: 6e 63 20 22 28 22 20 69 74 65 6d 70 61 74 68 20 nc "(" itempath
bdf0: 22 29 22 29 29 29 29 29 0a 09 09 09 20 20 20 28 ")"))))).... (
be00: 63 61 73 65 20 64 6d 6f 64 65 0a 09 09 09 20 20 case dmode....
be10: 20 20 20 28 28 6a 73 6f 6e 20 6f 64 73 29 0a 09 ((json ods)..
be20: 09 09 20 20 20 20 20 20 28 69 66 20 74 65 73 74 .. (if test
be30: 73 2d 73 70 65 63 0a 09 09 09 09 20 20 28 66 6f s-spec..... (fo
be40: 72 2d 65 61 63 68 0a 09 09 09 09 20 20 20 28 6c r-each..... (l
be50: 61 6d 62 64 61 20 28 66 69 65 6c 64 2d 6e 61 6d ambda (field-nam
be60: 65 29 0a 09 09 09 09 20 20 20 20 20 28 6d 75 74 e)..... (mut
be70: 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 ils:hierhash-set
be80: 21 20 64 61 74 61 20 20 28 67 65 74 2d 76 61 6c ! data (get-val
be90: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
bea0: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
beb0: 69 6e 64 65 78 20 66 69 65 6c 64 2d 6e 61 6d 65 index field-name
bec0: 29 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e ) targetstr runn
bed0: 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 ame "data" (conc
bee0: 20 74 65 73 74 2d 69 64 29 20 66 69 65 6c 64 2d test-id) field-
bef0: 6e 61 6d 65 29 29 0a 09 09 09 09 20 20 20 74 65 name))..... te
bf00: 73 74 73 2d 73 70 65 63 29 29 29 0a 09 09 09 20 sts-spec)))....
bf10: 20 20 20 20 3b 3b 20 3b 3b 20 28 6d 75 74 69 6c ;; ;; (mutil
bf20: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
bf30: 64 61 74 61 20 20 66 75 6c 6c 6e 61 6d 65 20 20 data fullname
bf40: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
bf50: 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 me "data" (conc
bf60: 74 65 73 74 2d 69 64 29 20 22 74 6e 61 6d 65 22 test-id) "tname"
bf70: 20 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b ).... ;
bf80: 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ; (mutils:hierh
bf90: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 74 ash-set! data t
bfa0: 65 73 74 6e 61 6d 65 20 20 20 74 61 72 67 65 74 estname target
bfb0: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 str runname "dat
bfc0: 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 a" (conc test-id
bfd0: 29 20 22 74 65 73 74 6e 61 6d 65 22 20 20 29 0a ) "testname" ).
bfe0: 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 ... ;; (mut
bff0: 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 ils:hierhash-set
c000: 21 20 64 61 74 61 20 20 69 74 65 6d 70 61 74 68 ! data itempath
c010: 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e targetstr run
c020: 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e name "data" (con
c030: 63 20 74 65 73 74 2d 69 64 29 20 22 69 74 65 6d c test-id) "item
c040: 70 61 74 68 22 20 20 29 0a 09 09 09 20 20 20 20 path" )....
c050: 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 ;; (mutils:hie
c060: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
c070: 20 63 6f 6d 6d 65 6e 74 20 20 20 20 74 61 72 67 comment targ
c080: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 etstr runname "d
c090: 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d ata" (conc test-
c0a0: 69 64 29 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 id) "comment"
c0b0: 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d ).... ;; (m
c0c0: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
c0d0: 65 74 21 20 64 61 74 61 20 20 74 73 74 61 74 65 et! data tstate
c0e0: 20 20 20 20 20 74 61 72 67 65 74 73 74 72 20 72 targetstr r
c0f0: 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 unname "data" (c
c100: 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 73 74 onc test-id) "st
c110: 61 74 65 22 20 20 20 20 20 29 0a 09 09 09 20 20 ate" )....
c120: 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 ;; (mutils:h
c130: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
c140: 61 20 20 74 73 74 61 74 75 73 20 20 20 20 74 61 a tstatus ta
c150: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
c160: 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 "data" (conc tes
c170: 74 2d 69 64 29 20 22 73 74 61 74 75 73 22 20 20 t-id) "status"
c180: 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 ).... ;;
c190: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
c1a0: 2d 73 65 74 21 20 64 61 74 61 20 20 72 75 6e 64 -set! data rund
c1b0: 69 72 20 20 20 20 20 74 61 72 67 65 74 73 74 72 ir targetstr
c1c0: 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 runname "data"
c1d0: 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 (conc test-id) "
c1e0: 72 75 6e 64 69 72 22 20 20 20 20 29 0a 09 09 09 rundir" )....
c1f0: 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 ;; (mutils
c200: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
c210: 61 74 61 20 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 ata final_logf
c220: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
c230: 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 e "data" (conc t
c240: 65 73 74 2d 69 64 29 20 22 66 69 6e 61 6c 5f 6c est-id) "final_l
c250: 6f 67 66 22 29 0a 09 09 09 20 20 20 20 20 3b 3b ogf").... ;;
c260: 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 (mutils:hierha
c270: 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 72 75 sh-set! data ru
c280: 6e 5f 64 75 72 61 74 69 6f 6e 20 74 61 72 67 65 n_duration targe
c290: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 tstr runname "da
c2a0: 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 ta" (conc test-i
c2b0: 64 29 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e d) "run_duration
c2c0: 22 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 ").... ;; (
c2d0: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
c2e0: 73 65 74 21 20 64 61 74 61 20 20 65 76 65 6e 74 set! data event
c2f0: 2d 74 69 6d 65 20 74 61 72 67 65 74 73 74 72 20 -time targetstr
c300: 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 runname "data" (
c310: 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 65 conc test-id) "e
c320: 76 65 6e 74 5f 74 69 6d 65 22 29 0a 09 09 09 20 vent_time")....
c330: 20 20 20 20 3b 3b 20 20 3b 3b 20 61 64 64 20 6c ;; ;; add l
c340: 61 73 74 20 65 6e 74 72 79 20 74 77 69 63 65 20 ast entry twice
c350: 2d 20 73 65 65 6d 73 20 74 6f 20 62 65 20 61 20 - seems to be a
c360: 62 75 67 20 69 6e 20 68 69 65 72 68 61 73 68 3f bug in hierhash?
c370: 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 .... ;; (mu
c380: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
c390: 74 21 20 64 61 74 61 20 20 65 76 65 6e 74 2d 74 t! data event-t
c3a0: 69 6d 65 20 74 61 72 67 65 74 73 74 72 20 72 75 ime targetstr ru
c3b0: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
c3c0: 6e 63 20 74 65 73 74 2d 69 64 29 20 22 65 76 65 nc test-id) "eve
c3d0: 6e 74 5f 74 69 6d 65 22 29 0a 09 09 09 20 20 20 nt_time")....
c3e0: 20 20 3b 3b 20 20 29 0a 09 09 09 20 20 20 20 20 ;; )....
c3f0: 28 65 6c 73 65 0a 09 09 09 20 20 20 20 20 20 28 (else.... (
c400: 69 66 20 28 61 6e 64 20 74 73 74 61 74 65 20 74 if (and tstate t
c410: 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d status event-tim
c420: 65 29 0a 09 09 09 09 20 20 28 66 6f 72 6d 61 74 e)..... (format
c430: 20 23 74 0a 09 09 09 09 09 20 20 22 20 20 54 65 #t...... " Te
c440: 73 74 3a 20 7e 32 35 61 20 53 74 61 74 65 3a 20 st: ~25a State:
c450: 7e 31 35 61 20 53 74 61 74 75 73 3a 20 7e 31 35 ~15a Status: ~15
c460: 61 20 52 75 6e 74 69 6d 65 3a 20 7e 35 40 61 73 a Runtime: ~5@as
c470: 20 54 69 6d 65 3a 20 7e 32 32 61 20 48 6f 73 74 Time: ~22a Host
c480: 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 09 09 09 20 : ~10a\n"......
c490: 20 28 69 66 20 66 75 6c 6c 6e 61 6d 65 20 66 75 (if fullname fu
c4a0: 6c 6c 6e 61 6d 65 20 22 22 29 0a 09 09 09 09 09 llname "")......
c4b0: 20 20 28 69 66 20 74 73 74 61 74 65 20 20 20 74 (if tstate t
c4c0: 73 74 61 74 65 20 20 20 22 22 29 0a 09 09 09 09 state "").....
c4d0: 09 20 20 28 69 66 20 74 73 74 61 74 75 73 20 20 . (if tstatus
c4e0: 74 73 74 61 74 75 73 20 20 22 22 29 0a 09 09 09 tstatus "")....
c4f0: 09 09 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 .. (get-value-b
c500: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
c510: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
c520: 78 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 x "run_duration"
c530: 29 3b 3b 28 69 66 20 74 65 73 74 20 20 20 20 20 );;(if test
c540: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e (db:test-get-run
c550: 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 29 20 _duration test)
c560: 22 22 29 0a 09 09 09 09 09 20 20 28 69 66 20 65 "")...... (if e
c570: 76 65 6e 74 2d 74 69 6d 65 20 65 76 65 6e 74 2d vent-time event-
c580: 74 69 6d 65 20 22 22 29 0a 09 09 09 09 09 20 20 time "")......
c590: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
c5a0: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
c5b0: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 68 t-field-index "h
c5c0: 6f 73 74 22 29 29 20 3b 3b 28 69 66 20 74 65 73 ost")) ;;(if tes
c5d0: 74 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 t (db:test-get-h
c5e0: 6f 73 74 20 74 65 73 74 29 29 20 22 22 29 0a 09 ost test)) "")..
c5f0: 09 09 09 20 20 28 70 72 69 6e 74 20 22 20 20 54 ... (print " T
c600: 65 73 74 3a 20 22 20 66 75 6c 6c 6e 61 6d 65 0a est: " fullname.
c610: 09 09 09 09 09 20 28 69 66 20 74 73 74 61 74 65 ..... (if tstate
c620: 20 20 28 63 6f 6e 63 20 22 20 53 74 61 74 65 3a (conc " State:
c630: 20 22 20 20 74 73 74 61 74 65 29 20 20 22 22 29 " tstate) "")
c640: 0a 09 09 09 09 09 20 28 69 66 20 74 73 74 61 74 ...... (if tstat
c650: 75 73 20 28 63 6f 6e 63 20 22 20 53 74 61 74 75 us (conc " Statu
c660: 73 3a 20 22 20 74 73 74 61 74 75 73 29 20 22 22 s: " tstatus) ""
c670: 29 0a 09 09 09 09 09 20 28 69 66 20 28 67 65 74 )...... (if (get
c680: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
c690: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
c6a0: 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 5f 64 eld-index "run_d
c6b0: 75 72 61 74 69 6f 6e 22 29 0a 09 09 09 09 09 20 uration")......
c6c0: 20 20 20 20 28 63 6f 6e 63 20 22 20 52 75 6e 74 (conc " Runt
c6d0: 69 6d 65 3a 20 22 20 28 67 65 74 2d 76 61 6c 75 ime: " (get-valu
c6e0: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
c6f0: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
c700: 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 61 74 69 ndex "run_durati
c710: 6f 6e 22 29 29 0a 09 09 09 09 09 20 20 20 20 20 on"))......
c720: 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 65 76 "")...... (if ev
c730: 65 6e 74 2d 74 69 6d 65 20 28 63 6f 6e 63 20 22 ent-time (conc "
c740: 20 54 69 6d 65 3a 20 22 20 65 76 65 6e 74 2d 74 Time: " event-t
c750: 69 6d 65 29 20 22 22 29 0a 09 09 09 09 09 20 28 ime) "")...... (
c760: 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 if (get-value-by
c770: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
c780: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
c790: 20 22 68 6f 73 74 22 29 0a 09 09 09 09 09 20 20 "host")......
c7a0: 20 20 20 28 63 6f 6e 63 20 22 20 48 6f 73 74 3a (conc " Host:
c7b0: 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 " (get-value-by
c7c0: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
c7d0: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
c7e0: 20 22 68 6f 73 74 22 29 29 0a 09 09 09 09 09 20 "host"))......
c7f0: 20 20 20 20 22 22 29 29 29 0a 09 09 09 20 20 20 "")))....
c800: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 (if (not (or
c810: 28 65 71 75 61 6c 3f 20 28 67 65 74 2d 76 61 6c (equal? (get-val
c820: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
c830: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
c840: 69 6e 64 65 78 20 22 73 74 61 74 75 73 22 29 20 index "status")
c850: 22 50 41 53 53 22 29 0a 09 09 09 09 09 20 20 20 "PASS")......
c860: 28 65 71 75 61 6c 3f 20 28 67 65 74 2d 76 61 6c (equal? (get-val
c870: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
c880: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
c890: 69 6e 64 65 78 20 22 73 74 61 74 75 73 22 29 20 index "status")
c8a0: 22 57 41 52 4e 22 29 0a 09 09 09 09 09 20 20 20 "WARN")......
c8b0: 28 65 71 75 61 6c 3f 20 28 67 65 74 2d 76 61 6c (equal? (get-val
c8c0: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
c8d0: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
c8e0: 69 6e 64 65 78 20 22 73 74 61 74 65 22 29 20 20 index "state")
c8f0: 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 29 29 "NOT_STARTED")))
c900: 0a 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 ..... (begin...
c910: 09 09 20 20 20 20 28 70 72 69 6e 74 20 20 20 28 .. (print (
c920: 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 if (get-value-by
c930: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
c940: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
c950: 20 22 63 70 75 6c 6f 61 64 22 29 0a 09 09 09 09 "cpuload").....
c960: 09 09 20 28 63 6f 6e 63 20 22 20 20 20 20 20 20 .. (conc "
c970: 20 20 20 63 70 75 6c 6f 61 64 3a 20 20 22 20 20 cpuload: "
c980: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
c990: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
c9a0: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
c9b0: 63 70 75 6c 6f 61 64 22 29 29 0a 09 09 09 09 09 cpuload"))......
c9c0: 09 20 22 22 29 20 3b 3b 20 28 64 62 3a 74 65 73 . "") ;; (db:tes
c9d0: 74 2d 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 t-get-cpuload te
c9e0: 73 74 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 st)...... (i
c9f0: 66 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d f (get-value-by-
ca00: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
ca10: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
ca20: 22 64 69 73 6b 66 72 65 65 22 29 0a 09 09 09 09 "diskfree").....
ca30: 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 20 20 20 .. (conc "\n
ca40: 20 20 20 20 20 64 69 73 6b 66 72 65 65 3a 20 22 diskfree: "
ca50: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
ca60: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
ca70: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
ca80: 64 69 73 6b 66 72 65 65 22 29 29 20 3b 3b 20 28 diskfree")) ;; (
ca90: 64 62 3a 74 65 73 74 2d 67 65 74 2d 64 69 73 6b db:test-get-disk
caa0: 66 72 65 65 20 74 65 73 74 29 0a 09 09 09 09 09 free test)......
cab0: 09 20 22 22 29 0a 09 09 09 09 09 20 20 20 20 20 . "")......
cac0: 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 (if (get-value-b
cad0: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
cae0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
caf0: 78 20 22 75 6e 61 6d 65 22 29 0a 09 09 09 09 09 x "uname")......
cb00: 09 20 28 63 6f 6e 63 20 22 5c 6e 20 20 20 20 20 . (conc "\n
cb10: 20 20 20 20 75 6e 61 6d 65 3a 20 20 20 20 22 20 uname: "
cb20: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
cb30: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
cb40: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 75 t-field-index "u
cb50: 6e 61 6d 65 22 29 29 20 3b 3b 20 28 64 62 3a 74 name")) ;; (db:t
cb60: 65 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 74 65 est-get-uname te
cb70: 73 74 29 0a 09 09 09 09 09 09 20 22 22 29 0a 09 st)....... "")..
cb80: 09 09 09 09 20 20 20 20 20 28 69 66 20 28 67 65 .... (if (ge
cb90: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
cba0: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
cbb0: 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 64 ield-index "rund
cbc0: 69 72 22 29 0a 09 09 09 09 09 09 20 28 63 6f 6e ir")....... (con
cbd0: 63 20 22 5c 6e 20 20 20 20 20 20 20 20 20 72 75 c "\n ru
cbe0: 6e 64 69 72 3a 20 20 20 22 20 28 67 65 74 2d 76 ndir: " (get-v
cbf0: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
cc00: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
cc10: 64 2d 69 6e 64 65 78 20 22 72 75 6e 64 69 72 22 d-index "rundir"
cc20: 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 )) ;; (db:test-g
cc30: 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 0a et-rundir test).
cc40: 09 09 09 09 09 09 20 22 22 29 0a 3b 3b 09 09 09 ...... "").;;...
cc50: 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 20 .. "\n
cc60: 20 20 20 72 75 6e 64 69 72 3a 20 20 20 22 20 28 rundir: " (
cc70: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
cc80: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
cc90: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 22 29 -field-index "")
cca0: 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 67 65 ;; (sdb:qry 'ge
ccb0: 74 73 74 72 20 3b 3b 20 28 66 69 6c 65 64 62 3a tstr ;; (filedb:
ccc0: 67 65 74 2d 70 61 74 68 20 2a 66 64 62 2a 20 0a get-path *fdb* .
ccd0: 3b 3b 20 09 09 09 09 09 20 20 20 20 20 28 64 62 ;; ..... (db
cce0: 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 :test-get-rundir
ccf0: 20 74 65 73 74 29 20 3b 3b 20 29 0a 09 09 09 09 test) ;; ).....
cd00: 09 20 20 20 20 20 29 0a 09 09 09 09 20 20 20 20 . ).....
cd10: 3b 3b 20 45 61 63 68 20 74 65 73 74 0a 09 09 09 ;; Each test....
cd20: 09 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 . ;; DO NOT r
cd30: 65 6d 6f 74 65 20 72 75 6e 0a 09 09 09 09 20 20 emote run.....
cd40: 20 20 28 6c 65 74 20 28 28 73 74 65 70 73 20 28 (let ((steps (
cd50: 64 62 3a 64 69 73 70 61 74 63 68 2d 71 75 65 72 db:dispatch-quer
cd60: 79 20 61 63 63 65 73 73 2d 6d 6f 64 65 20 72 6d y access-mode rm
cd70: 74 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d t:get-steps-for-
cd80: 74 65 73 74 20 64 62 3a 67 65 74 2d 73 74 65 70 test db:get-step
cd90: 73 2d 66 6f 72 2d 74 65 73 74 20 72 75 6e 2d 69 s-for-test run-i
cda0: 64 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 d (db:test-get-i
cdb0: 64 20 74 65 73 74 29 29 29 29 20 3b 3b 20 28 64 d test)))) ;; (d
cdc0: 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d b:get-steps-for-
cdd0: 74 65 73 74 20 64 62 73 74 72 75 63 74 20 72 75 test dbstruct ru
cde0: 6e 2d 69 64 20 28 64 62 3a 74 65 73 74 2d 67 65 n-id (db:test-ge
cdf0: 74 2d 69 64 20 74 65 73 74 29 29 29 29 0a 09 09 t-id test))))...
ce00: 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 .. (for-eac
ce10: 68 20 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c h ..... (l
ce20: 61 6d 62 64 61 20 28 73 74 65 70 29 0a 09 09 09 ambda (step)....
ce30: 09 09 20 28 66 6f 72 6d 61 74 20 23 74 20 0a 09 .. (format #t ..
ce40: 09 09 09 09 09 20 22 20 20 20 20 53 74 65 70 3a ..... " Step:
ce50: 20 7e 32 30 61 20 53 74 61 74 65 3a 20 7e 31 30 ~20a State: ~10
ce60: 61 20 53 74 61 74 75 73 3a 20 7e 31 30 61 20 54 a Status: ~10a T
ce70: 69 6d 65 20 7e 32 32 61 5c 6e 22 0a 09 09 09 09 ime ~22a\n".....
ce80: 09 09 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 .. (tdb:step-get
ce90: 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 70 29 0a -stepname step).
cea0: 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 ...... (tdb:step
ceb0: 2d 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 -get-state step)
cec0: 0a 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 ....... (tdb:ste
ced0: 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 p-get-status ste
cee0: 70 29 0a 09 09 09 09 09 09 20 28 74 64 62 3a 73 p)....... (tdb:s
cef0: 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 tep-get-event_ti
cf00: 6d 65 20 73 74 65 70 29 29 29 0a 09 09 09 09 20 me step))).....
cf10: 20 20 20 20 20 20 73 74 65 70 73 29 29 29 29 29 steps)))))
cf20: 29 29 29 29 0a 09 09 20 20 20 20 20 20 28 69 66 ))))... (if
cf30: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
cf40: 2d 73 6f 72 74 22 29 0a 09 09 09 20 20 28 73 6f -sort").... (so
cf50: 72 74 20 74 65 73 74 73 0a 09 09 09 09 28 6c 61 rt tests.....(la
cf60: 6d 62 64 61 20 28 61 2d 74 65 73 74 20 62 2d 74 mbda (a-test b-t
cf70: 65 73 74 29 0a 09 09 09 09 20 20 28 6c 65 74 2a est)..... (let*
cf80: 20 28 28 6b 65 79 20 20 20 20 28 61 72 67 73 3a ((key (args:
cf90: 67 65 74 2d 61 72 67 20 22 2d 73 6f 72 74 22 29 get-arg "-sort")
cfa0: 29 0a 09 09 09 09 09 20 28 66 69 72 73 74 20 20 )...... (first
cfb0: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
cfc0: 65 6c 64 6e 61 6d 65 20 61 2d 74 65 73 74 20 74 eldname a-test t
cfd0: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
cfe0: 6b 65 79 29 29 0a 09 09 09 09 09 20 28 73 65 63 key))...... (sec
cff0: 6f 6e 64 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 ond (get-value-b
d000: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 62 2d 74 65 y-fieldname b-te
d010: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
d020: 64 65 78 20 6b 65 79 29 29 29 0a 09 09 09 09 20 dex key))).....
d030: 20 20 20 28 28 63 6f 6e 64 20 0a 09 09 09 09 20 ((cond .....
d040: 20 20 20 20 20 28 28 61 6e 64 20 28 6e 75 6d 62 ((and (numb
d050: 65 72 3f 20 66 69 72 73 74 29 28 6e 75 6d 62 65 er? first)(numbe
d060: 72 3f 20 73 65 63 6f 6e 64 29 29 20 3c 29 0a 09 r? second)) <)..
d070: 09 09 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 ... ((and (
d080: 73 74 72 69 6e 67 3f 20 66 69 72 73 74 29 28 73 string? first)(s
d090: 74 72 69 6e 67 3f 20 73 65 63 6f 6e 64 29 29 20 tring? second))
d0a0: 73 74 72 69 6e 67 3c 3d 3f 29 0a 09 09 09 09 20 string<=?).....
d0b0: 20 20 20 20 20 28 65 6c 73 65 20 65 71 75 61 6c (else equal
d0c0: 3f 29 29 0a 09 09 09 09 20 20 20 20 20 66 69 72 ?))..... fir
d0d0: 73 74 20 73 65 63 6f 6e 64 29 29 29 29 0a 09 09 st second))))...
d0e0: 09 20 20 74 65 73 74 73 29 29 29 29 29 29 0a 09 . tests))))))..
d0f0: 20 20 20 72 75 6e 73 29 0a 09 20 20 28 69 66 20 runs).. (if
d100: 28 65 71 3f 20 64 6d 6f 64 65 20 27 6a 73 6f 6e (eq? dmode 'json
d110: 29 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 74 )(json-write dat
d120: 61 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 6d a)).. (let* ((m
d130: 65 74 61 64 61 74 2d 66 69 65 6c 64 73 20 28 64 etadat-fields (d
d140: 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 elete-duplicates
d150: 0a 09 09 09 09 20 20 28 61 70 70 65 6e 64 20 6b ..... (append k
d160: 65 79 73 20 27 28 20 22 72 75 6e 6e 61 6d 65 22 eys '( "runname"
d170: 20 22 74 69 6d 65 22 20 22 6f 77 6e 65 72 22 20 "time" "owner"
d180: 22 70 61 73 73 5f 63 6f 75 6e 74 22 20 22 66 61 "pass_count" "fa
d190: 69 6c 5f 63 6f 75 6e 74 22 20 22 73 74 61 74 65 il_count" "state
d1a0: 22 20 22 73 74 61 74 75 73 22 20 22 63 6f 6d 6d " "status" "comm
d1b0: 65 6e 74 22 20 22 69 64 22 29 29 29 29 0a 09 09 ent" "id"))))...
d1c0: 20 28 72 75 6e 2d 66 69 65 6c 64 73 20 20 20 20 (run-fields
d1d0: 27 28 0a 09 09 09 09 20 20 22 74 65 73 74 6e 61 '(..... "testna
d1e0: 6d 65 22 0a 09 09 09 09 20 20 22 69 74 65 6d 5f me"..... "item_
d1f0: 70 61 74 68 22 0a 09 09 09 09 20 20 22 73 74 61 path"..... "sta
d200: 74 65 22 0a 09 09 09 09 20 20 22 73 74 61 74 75 te"..... "statu
d210: 73 22 0a 09 09 09 09 20 20 22 63 6f 6d 6d 65 6e s"..... "commen
d220: 74 22 0a 09 09 09 09 20 20 22 65 76 65 6e 74 5f t"..... "event_
d230: 74 69 6d 65 22 0a 09 09 09 09 20 20 22 68 6f 73 time"..... "hos
d240: 74 22 0a 09 09 09 09 20 20 22 72 75 6e 5f 69 64 t"..... "run_id
d250: 22 0a 09 09 09 09 20 20 22 72 75 6e 5f 64 75 72 "..... "run_dur
d260: 61 74 69 6f 6e 22 0a 09 09 09 09 20 20 22 61 74 ation"..... "at
d270: 74 65 6d 70 74 6e 75 6d 22 0a 09 09 09 09 20 20 temptnum".....
d280: 22 69 64 22 0a 09 09 09 09 20 20 22 61 72 63 68 "id"..... "arch
d290: 69 76 65 64 22 0a 09 09 09 09 20 20 22 64 69 73 ived"..... "dis
d2a0: 6b 66 72 65 65 22 0a 09 09 09 09 20 20 22 63 70 kfree"..... "cp
d2b0: 75 6c 6f 61 64 22 0a 09 09 09 09 20 20 22 66 69 uload"..... "fi
d2c0: 6e 61 6c 5f 6c 6f 67 66 22 0a 09 09 09 09 20 20 nal_logf".....
d2d0: 22 73 68 6f 72 74 64 69 72 22 0a 09 09 09 09 20 "shortdir".....
d2e0: 20 22 72 75 6e 64 69 72 22 0a 09 09 09 09 20 20 "rundir".....
d2f0: 22 75 6e 61 6d 65 22 0a 09 09 09 09 20 20 29 0a "uname"..... ).
d300: 09 09 09 09 29 0a 09 09 20 28 6e 65 77 64 61 74 ....)... (newdat
d310: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f (commo
d320: 6e 3a 74 6f 2d 61 6c 69 73 74 20 64 61 74 61 29 n:to-alist data)
d330: 29 0a 09 09 20 28 61 6c 6c 72 75 6e 64 61 74 20 )... (allrundat
d340: 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f (if (null?
d350: 20 6e 65 77 64 61 74 29 0a 09 09 09 09 20 20 20 newdat).....
d360: 20 20 20 27 28 29 0a 09 09 09 09 20 20 20 20 20 '().....
d370: 20 28 63 61 72 20 28 6d 61 70 20 63 64 72 20 6e (car (map cdr n
d380: 65 77 64 61 74 29 29 29 29 20 3b 3b 20 28 63 61 ewdat)))) ;; (ca
d390: 72 20 28 6d 61 70 20 63 64 72 20 28 63 61 72 20 r (map cdr (car
d3a0: 28 6d 61 70 20 63 64 72 20 6e 65 77 64 61 74 29 (map cdr newdat)
d3b0: 29 29 29 29 0a 09 09 20 28 72 75 6e 73 20 20 20 ))))... (runs
d3c0: 20 20 20 20 20 20 20 20 20 28 61 70 70 65 6e 64 (append
d3d0: 0a 09 09 09 09 20 20 20 28 6c 69 73 74 20 22 72 ..... (list "r
d3e0: 75 6e 73 22 20 3b 3b 20 73 68 65 65 74 6e 61 6d uns" ;; sheetnam
d3f0: 65 0a 09 09 09 09 09 20 6d 65 74 61 64 61 74 2d e...... metadat-
d400: 66 69 65 6c 64 73 29 0a 09 09 09 09 20 20 20 28 fields)..... (
d410: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 75 6e map (lambda (run
d420: 29 0a 09 09 09 09 09 20 20 3b 3b 20 28 70 72 69 )...... ;; (pri
d430: 6e 74 20 22 72 75 6e 3a 20 22 20 72 75 6e 29 0a nt "run: " run).
d440: 09 09 09 09 09 20 20 28 6c 65 74 2a 20 28 28 72 ..... (let* ((r
d450: 75 6e 6e 61 6d 65 20 28 63 61 72 20 72 75 6e 29 unname (car run)
d460: 29 0a 09 09 09 09 09 09 20 28 72 75 6e 64 61 74 )....... (rundat
d470: 20 20 28 63 64 72 20 72 75 6e 29 29 0a 09 09 09 (cdr run))....
d480: 09 09 09 20 28 6d 65 74 61 64 61 74 20 28 6c 65 ... (metadat (le
d490: 74 20 28 28 74 6d 70 20 28 61 73 73 6f 63 20 22 t ((tmp (assoc "
d4a0: 6d 65 74 61 22 20 72 75 6e 64 61 74 29 29 29 0a meta" rundat))).
d4b0: 09 09 09 09 09 09 09 20 20 20 20 28 69 66 20 74 ....... (if t
d4c0: 6d 70 20 28 63 64 72 20 74 6d 70 29 20 23 66 29 mp (cdr tmp) #f)
d4d0: 29 29 29 0a 09 09 09 09 09 20 20 20 20 3b 3b 20 )))...... ;;
d4e0: 28 70 72 69 6e 74 20 22 72 75 6e 6e 61 6d 65 3a (print "runname:
d4f0: 20 22 20 72 75 6e 6e 61 6d 65 20 22 5c 6e 5c 6e " runname "\n\n
d500: 72 75 6e 64 61 74 3a 20 22 20 29 28 70 70 20 72 rundat: " )(pp r
d510: 75 6e 64 61 74 29 28 70 72 69 6e 74 20 22 5c 6e undat)(print "\n
d520: 5c 6e 6d 65 74 61 64 61 74 3a 20 22 29 28 70 70 \nmetadat: ")(pp
d530: 20 6d 65 74 61 64 61 74 29 0a 09 09 09 09 09 20 metadat)......
d540: 20 20 20 28 69 66 20 6d 65 74 61 64 61 74 0a 09 (if metadat..
d550: 09 09 09 09 09 28 6d 61 70 20 28 6c 61 6d 62 64 .....(map (lambd
d560: 61 20 28 66 69 65 6c 64 29 0a 09 09 09 09 09 09 a (field).......
d570: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 6d (let ((tm
d580: 70 20 28 61 73 73 6f 63 20 66 69 65 6c 64 20 6d p (assoc field m
d590: 65 74 61 64 61 74 29 29 29 0a 09 09 09 09 09 09 etadat))).......
d5a0: 09 20 28 69 66 20 74 6d 70 20 28 63 64 72 20 74 . (if tmp (cdr t
d5b0: 6d 70 29 20 22 22 29 29 29 0a 09 09 09 09 09 09 mp) ""))).......
d5c0: 20 20 20 20 20 6d 65 74 61 64 61 74 2d 66 69 65 metadat-fie
d5d0: 6c 64 73 29 0a 09 09 09 09 09 09 28 62 65 67 69 lds).......(begi
d5e0: 6e 0a 09 09 09 09 09 09 20 20 28 64 65 62 75 67 n....... (debug
d5f0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
d600: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 t-log-port* "WAR
d610: 4e 49 4e 47 3a 20 6d 65 74 61 20 64 61 74 61 20 NING: meta data
d620: 66 6f 72 20 72 75 6e 20 22 20 72 75 6e 6e 61 6d for run " runnam
d630: 65 20 22 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a e " not found").
d640: 09 09 09 09 09 09 20 20 27 28 29 29 29 29 29 0a ...... '())))).
d650: 09 09 09 09 09 61 6c 6c 72 75 6e 64 61 74 29 29 .....allrundat))
d660: 29 0a 09 09 20 3b 3b 20 27 28 20 28 20 22 74 61 )... ;; '( ( "ta
d670: 72 67 65 74 22 20 28 20 22 72 75 6e 6e 61 6d 65 rget" ( "runname
d680: 22 20 28 20 22 64 61 74 61 22 20 28 20 22 72 75 " ( "data" ( "ru
d690: 6e 69 64 22 20 28 20 22 69 64 20 2e 20 22 33 37 nid" ( "id . "37
d6a0: 22 20 29 20 28 20 2e 2e 2e 20 29 29 29 29 0a 09 " ) ( ... ))))..
d6b0: 09 20 28 72 75 6e 2d 70 61 67 65 73 20 20 20 20 . (run-pages
d6c0: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
d6d0: 74 61 72 67 64 61 74 29 0a 09 09 09 09 09 28 6c targdat)......(l
d6e0: 65 74 2a 20 28 28 74 61 72 67 65 74 20 20 28 63 et* ((target (c
d6f0: 61 72 20 74 61 72 67 64 61 74 29 29 0a 09 09 09 ar targdat))....
d700: 09 09 20 20 20 20 20 20 20 28 72 75 6e 73 64 61 .. (runsda
d710: 74 20 28 63 64 72 20 74 61 72 67 64 61 74 29 29 t (cdr targdat))
d720: 29 0a 09 09 09 09 09 20 20 28 69 66 20 72 75 6e )...... (if run
d730: 73 64 61 74 0a 09 09 09 09 09 20 20 20 20 20 20 sdat......
d740: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 75 (map (lambda (ru
d750: 6e 64 61 74 29 0a 09 09 09 09 09 09 20 20 20 20 ndat).......
d760: 20 28 6c 65 74 2a 20 28 28 72 75 6e 6e 61 6d 65 (let* ((runname
d770: 20 20 28 63 61 72 20 72 75 6e 64 61 74 29 29 0a (car rundat)).
d780: 09 09 09 09 09 09 09 20 20 20 20 28 72 75 6e 64 ....... (rund
d790: 61 74 20 20 20 28 63 64 72 20 72 75 6e 64 61 74 at (cdr rundat
d7a0: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 74 ))........ (t
d7b0: 65 73 74 73 64 61 74 20 28 6c 65 74 20 28 28 74 estsdat (let ((t
d7c0: 6d 70 20 28 61 73 73 6f 63 20 22 64 61 74 61 22 mp (assoc "data"
d7d0: 20 72 75 6e 64 61 74 29 29 29 0a 09 09 09 09 09 rundat)))......
d7e0: 09 09 09 09 28 69 66 20 74 6d 70 20 28 63 64 72 ....(if tmp (cdr
d7f0: 20 74 6d 70 29 20 23 66 29 29 29 29 0a 09 09 09 tmp) #f))))....
d800: 09 09 09 20 20 20 20 20 20 20 28 69 66 20 74 65 ... (if te
d810: 73 74 73 64 61 74 0a 09 09 09 09 09 09 09 20 20 stsdat........
d820: 20 28 6c 65 74 20 28 28 74 65 73 74 73 20 28 6d (let ((tests (m
d830: 61 70 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 ap (lambda (test
d840: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
d850: 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 69 (let* ((test-i
d860: 64 20 20 28 63 61 72 20 74 65 73 74 29 29 0a 09 d (car test))..
d870: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 ......... (
d880: 74 65 73 74 2d 64 61 74 20 28 63 64 72 20 74 65 test-dat (cdr te
d890: 73 74 29 29 29 0a 09 09 09 09 09 09 09 09 09 09 st)))...........
d8a0: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 66 (map (lambda (f
d8b0: 69 65 6c 64 29 0a 09 09 09 09 09 09 09 09 09 09 ield)...........
d8c0: 09 28 6c 65 74 20 28 28 74 6d 70 20 28 61 73 73 .(let ((tmp (ass
d8d0: 6f 63 20 66 69 65 6c 64 20 74 65 73 74 2d 64 61 oc field test-da
d8e0: 74 29 29 29 0a 09 09 09 09 09 09 09 09 09 09 09 t)))............
d8f0: 20 20 28 69 66 20 74 6d 70 20 28 63 64 72 20 74 (if tmp (cdr t
d900: 6d 70 29 20 22 22 29 29 29 0a 09 09 09 09 09 09 mp) ""))).......
d910: 09 09 09 09 20 20 20 20 20 20 72 75 6e 2d 66 69 .... run-fi
d920: 65 6c 64 73 29 29 29 0a 09 09 09 09 09 09 09 09 elds))).........
d930: 09 20 20 20 20 20 74 65 73 74 73 64 61 74 29 29 . testsdat))
d940: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 3b 3b )........ ;;
d950: 20 28 70 72 69 6e 74 20 22 54 61 72 67 65 74 3a (print "Target:
d960: 20 22 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 " target "/" ru
d970: 6e 6e 61 6d 65 20 22 20 74 65 73 74 73 3a 22 29 nname " tests:")
d980: 0a 09 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 ........ ;;
d990: 28 70 70 20 74 65 73 74 73 29 0a 09 09 09 09 09 (pp tests)......
d9a0: 09 09 20 20 20 20 20 28 63 6f 6e 73 20 28 63 6f .. (cons (co
d9b0: 6e 63 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 nc target "/" ru
d9c0: 6e 6e 61 6d 65 29 0a 09 09 09 09 09 09 09 09 20 nname).........
d9d0: 20 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 28 63 (cons (list (c
d9e0: 6f 6e 63 20 74 61 72 67 65 74 20 22 2f 22 20 72 onc target "/" r
d9f0: 75 6e 6e 61 6d 65 29 29 0a 09 09 09 09 09 09 09 unname))........
da00: 09 09 20 28 63 6f 6e 73 20 27 28 29 0a 09 09 09 .. (cons '()....
da10: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 6f ...... (co
da20: 6e 73 20 72 75 6e 2d 66 69 65 6c 64 73 20 74 65 ns run-fields te
da30: 73 74 73 29 29 29 29 29 0a 09 09 09 09 09 09 09 sts)))))........
da40: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 (begin.......
da50: 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
da60: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
da70: 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 g-port* "WARNING
da80: 3a 20 72 75 6e 20 22 20 74 61 72 67 65 74 20 22 : run " target "
da90: 2f 22 20 72 75 6e 6e 61 6d 65 20 22 20 61 70 70 /" runname " app
daa0: 65 61 72 73 20 74 6f 20 68 61 76 65 20 6e 6f 20 ears to have no
dab0: 64 61 74 61 22 29 0a 09 09 09 09 09 09 09 20 20 data")........
dac0: 20 20 20 3b 3b 20 28 70 70 20 72 75 6e 64 61 74 ;; (pp rundat
dad0: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 27 28 )........ '(
dae0: 29 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 72 )))))....... r
daf0: 75 6e 73 64 61 74 29 0a 09 09 09 09 09 20 20 20 unsdat)......
db00: 20 20 20 27 28 29 29 29 29 0a 09 09 09 09 20 20 '()))).....
db10: 20 20 20 20 6e 65 77 64 61 74 29 29 20 3b 3b 20 newdat)) ;;
db20: 77 65 20 75 73 65 20 6e 65 77 64 61 74 20 74 6f we use newdat to
db30: 20 67 65 74 20 74 61 72 67 65 74 0a 09 09 20 28 get target... (
db40: 73 68 65 65 74 73 20 20 20 20 20 20 20 20 20 28 sheets (
db50: 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 filter (lambda (
db60: 78 29 0a 09 09 09 09 09 20 20 20 28 6e 6f 74 20 x)...... (not
db70: 28 6e 75 6c 6c 3f 20 78 29 29 29 0a 09 09 09 09 (null? x))).....
db80: 09 20 28 63 6f 6e 73 20 72 75 6e 73 20 28 6d 61 . (cons runs (ma
db90: 70 20 63 61 72 20 72 75 6e 2d 70 61 67 65 73 29 p car run-pages)
dba0: 29 29 29 29 0a 09 20 20 20 20 3b 3b 20 28 70 72 )))).. ;; (pr
dbb0: 69 6e 74 20 22 61 6c 6c 72 75 6e 64 61 74 3a 22 int "allrundat:"
dbc0: 29 0a 09 20 20 20 20 3b 3b 20 28 70 70 20 61 6c ).. ;; (pp al
dbd0: 6c 72 75 6e 64 61 74 29 0a 09 20 20 20 20 3b 3b lrundat).. ;;
dbe0: 20 28 70 72 69 6e 74 20 22 72 75 6e 73 3a 22 29 (print "runs:")
dbf0: 0a 09 20 20 20 20 3b 3b 20 28 70 70 20 72 75 6e .. ;; (pp run
dc00: 73 29 0a 09 20 20 20 20 3b 28 70 72 69 6e 74 20 s).. ;(print
dc10: 22 73 68 65 65 74 73 3a 20 22 29 0a 09 20 20 20 "sheets: ")..
dc20: 20 3b 3b 20 28 70 70 20 73 68 65 65 74 73 29 0a ;; (pp sheets).
dc30: 09 20 20 20 20 28 69 66 20 28 65 71 3f 20 64 6d . (if (eq? dm
dc40: 6f 64 65 20 27 6f 64 73 29 0a 09 09 28 6c 65 74 ode 'ods)...(let
dc50: 2a 20 28 28 74 65 6d 70 64 69 72 20 20 20 20 28 * ((tempdir (
dc60: 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 28 63 75 conc "/tmp/" (cu
dc70: 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 29 rrent-user-name)
dc80: 20 22 2f 22 20 28 72 61 6e 64 6f 6d 20 31 30 30 "/" (random 100
dc90: 30 30 29 20 22 5f 22 20 28 63 75 72 72 65 6e 74 00) "_" (current
dca0: 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 29 0a 09 -process-id)))..
dcb0: 09 20 20 20 20 20 20 20 28 6f 75 74 70 75 74 66 . (outputf
dcc0: 69 6c 65 20 28 6f 72 20 28 61 72 67 73 3a 67 65 ile (or (args:ge
dcd0: 74 2d 61 72 67 20 22 2d 6f 22 29 20 22 6f 75 74 t-arg "-o") "out
dce0: 2e 6f 64 73 22 29 29 0a 09 09 20 20 20 20 20 20 .ods"))...
dcf0: 20 28 6f 75 66 20 20 20 20 20 20 20 20 28 69 66 (ouf (if
dd00: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 (string-match (
dd10: 72 65 67 65 78 70 20 22 5e 5b 2f 7e 5d 2b 2e 2a regexp "^[/~]+.*
dd20: 22 29 20 6f 75 74 70 75 74 66 69 6c 65 29 20 3b ") outputfile) ;
dd30: 3b 20 66 75 6c 6c 20 70 61 74 68 3f 0a 09 09 09 ; full path?....
dd40: 09 20 20 20 20 20 20 20 6f 75 74 70 75 74 66 69 . outputfi
dd50: 6c 65 0a 09 09 09 09 20 20 20 20 20 20 20 28 62 le..... (b
dd60: 65 67 69 6e 0a 09 09 09 09 09 20 28 64 65 62 75 egin...... (debu
dd70: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
dd80: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 lt-log-port* "WA
dd90: 52 4e 49 4e 47 3a 20 70 61 74 68 20 67 69 76 65 RNING: path give
dda0: 6e 2c 20 22 20 6f 75 74 70 75 74 66 69 6c 65 20 n, " outputfile
ddb0: 22 20 69 73 20 72 65 6c 61 74 69 76 65 2c 20 70 " is relative, p
ddc0: 72 65 66 69 78 69 6e 67 20 77 69 74 68 20 63 75 refixing with cu
ddd0: 72 72 65 6e 74 20 64 69 72 65 63 74 6f 72 79 22 rrent directory"
dde0: 29 0a 09 09 09 09 09 20 28 63 6f 6e 63 20 28 63 )...... (conc (c
ddf0: 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 urrent-directory
de00: 29 20 22 2f 22 20 6f 75 74 70 75 74 66 69 6c 65 ) "/" outputfile
de10: 29 29 29 29 29 0a 09 09 20 20 28 63 72 65 61 74 )))))... (creat
de20: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 6d 70 e-directory temp
de30: 64 69 72 20 23 74 29 0a 09 09 20 20 28 6f 64 73 dir #t)... (ods
de40: 3a 6c 69 73 74 2d 3e 6f 64 73 20 74 65 6d 70 64 :list->ods tempd
de50: 69 72 20 6f 75 66 20 73 68 65 65 74 73 29 29 29 ir ouf sheets)))
de60: 29 0a 09 20 20 3b 3b 20 28 73 79 73 74 65 6d 20 ).. ;; (system
de70: 28 63 6f 6e 63 20 22 72 6d 20 2d 72 66 20 22 20 (conc "rm -rf "
de80: 74 65 6d 70 64 69 72 29 29 0a 09 20 20 28 73 65 tempdir)).. (se
de90: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
dea0: 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 20 44 6f 6e * #t))))..;; Don
deb0: 27 74 20 74 68 69 6e 6b 20 49 20 6e 65 65 64 20 't think I need
dec0: 74 68 69 73 2e 20 49 6e 63 6f 72 70 6f 72 61 74 this. Incorporat
ded0: 65 64 20 69 6e 74 6f 20 2d 6c 69 73 74 2d 72 75 ed into -list-ru
dee0: 6e 73 20 69 6e 73 74 65 61 64 0a 3b 3b 0a 3b 3b ns instead.;;.;;
def0: 20 28 69 66 20 28 61 6e 64 20 28 61 72 67 73 3a (if (and (args:
df00: 67 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 22 get-arg "-since"
df10: 29 0a 3b 3b 20 09 20 28 6c 61 75 6e 63 68 3a 73 ).;; . (launch:s
df20: 65 74 75 70 29 29 0a 3b 3b 20 20 20 20 20 28 6c etup)).;; (l
df30: 65 74 2a 20 28 28 73 69 6e 63 65 2d 74 69 6d 65 et* ((since-time
df40: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
df50: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
df60: 2d 73 69 6e 63 65 22 29 29 29 0a 3b 3b 20 09 20 -since"))).;; .
df70: 20 20 28 72 75 6e 2d 69 64 73 20 20 20 20 28 64 (run-ids (d
df80: 62 3a 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 75 b:get-changed-ru
df90: 6e 2d 69 64 73 20 73 69 6e 63 65 2d 74 69 6d 65 n-ids since-time
dfa0: 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 3b 3b 20 ))).;; ;;
dfb0: 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 (rmt:get-tests-f
dfc0: 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 20 or-runs-mindata
dfd0: 72 75 6e 2d 69 64 73 20 74 65 73 74 70 61 74 74 run-ids testpatt
dfe0: 20 73 74 61 74 65 73 20 73 74 61 74 75 73 20 6e states status n
dff0: 6f 74 2d 69 6e 29 0a 3b 3b 20 20 20 20 20 20 20 ot-in).;;
e000: 28 70 72 69 6e 74 20 28 73 6f 72 74 20 72 75 6e (print (sort run
e010: 2d 69 64 73 20 3c 29 29 0a 3b 3b 20 20 20 20 20 -ids <)).;;
e020: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
e030: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 20 20 20 thing* #t))).
e040: 20 20 20 0a 20 20 20 20 20 20 0a 3b 3b 3d 3d 3d . .;;===
e050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e090: 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e 0a ===.;; full run.
e0a0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
e0b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e0c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e0d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e0e0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 ========..;; get
e0f0: 20 6c 6f 63 6b 20 69 6e 20 64 62 20 66 6f 72 20 lock in db for
e100: 66 75 6c 6c 20 72 75 6e 20 66 6f 72 20 74 68 69 full run for thi
e110: 73 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 66 s directory.;; f
e120: 6f 72 20 61 6c 6c 20 74 65 73 74 73 20 77 69 74 or all tests wit
e130: 68 20 64 65 70 73 0a 3b 3b 20 20 20 77 61 6c 6b h deps.;; walk
e140: 20 74 72 65 65 20 6f 66 20 74 65 73 74 73 20 74 tree of tests t
e150: 6f 20 66 69 6e 64 20 68 65 61 64 20 74 61 73 6b o find head task
e160: 73 0a 3b 3b 20 20 20 61 64 64 20 68 65 61 64 20 s.;; add head
e170: 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 tasks to task qu
e180: 65 75 65 0a 3b 3b 20 20 20 61 64 64 20 64 65 70 eue.;; add dep
e190: 65 6e 64 61 6e 74 20 74 61 73 6b 73 20 74 6f 20 endant tasks to
e1a0: 74 61 73 6b 20 71 75 65 75 65 20 0a 3b 3b 20 20 task queue .;;
e1b0: 20 61 64 64 20 72 65 6d 61 69 6e 69 6e 67 20 74 add remaining t
e1c0: 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 asks to task que
e1d0: 75 65 0a 3b 3b 20 66 6f 72 20 65 61 63 68 20 74 ue.;; for each t
e1e0: 61 73 6b 20 69 6e 20 74 61 73 6b 20 71 75 65 75 ask in task queu
e1f0: 65 0a 3b 3b 20 20 20 69 66 20 68 61 76 65 20 61 e.;; if have a
e200: 64 65 71 75 61 74 65 20 72 65 73 6f 75 72 63 65 dequate resource
e210: 73 0a 3b 3b 20 20 20 20 20 6c 61 75 6e 63 68 20 s.;; launch
e220: 74 61 73 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b task.;; else.;
e230: 3b 20 20 20 20 20 70 75 74 20 74 61 73 6b 20 69 ; put task i
e240: 6e 20 64 65 66 65 72 72 65 64 20 71 75 65 75 65 n deferred queue
e250: 0a 3b 3b 20 69 66 20 73 74 69 6c 6c 20 6f 6b 20 .;; if still ok
e260: 74 6f 20 72 75 6e 20 74 61 73 6b 73 0a 3b 3b 20 to run tasks.;;
e270: 20 20 70 72 6f 63 65 73 73 20 64 65 66 65 72 72 process deferr
e280: 65 64 20 74 61 73 6b 73 20 70 65 72 20 61 62 6f ed tasks per abo
e290: 76 65 20 73 74 65 70 73 0a 0a 3b 3b 20 72 75 6e ve steps..;; run
e2a0: 20 61 6c 6c 20 74 65 73 74 73 20 61 72 65 20 61 all tests are a
e2b0: 72 65 20 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 44 re Not COMPLETED
e2c0: 20 61 6e 64 20 50 41 53 53 20 6f 72 20 43 48 45 and PASS or CHE
e2d0: 43 4b 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 CK.(if (or (args
e2e0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c :get-arg "-runal
e2f0: 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 l")..(args:get-a
e300: 72 67 20 22 2d 72 75 6e 22 29 0a 09 28 61 72 67 rg "-run")..(arg
e310: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 72 75 s:get-arg "-reru
e320: 6e 2d 63 6c 65 61 6e 22 29 0a 09 28 61 72 67 73 n-clean")..(args
e330: 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 72 75 6e :get-arg "-rerun
e340: 2d 61 6c 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 -all")..(args:ge
e350: 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 t-arg "-runtests
e360: 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c ")). (general
e370: 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 -run-call .
e380: 22 2d 72 75 6e 61 6c 6c 22 0a 20 20 20 20 20 22 "-runall". "
e390: 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 22 0a 20 run all tests".
e3a0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
e3b0: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
e3c0: 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 keyvals).
e3d0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
e3e0: 72 67 20 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e rg "-rerun-clean
e3f0: 22 29 20 3b 3b 20 66 69 72 73 74 20 73 65 74 20 ") ;; first set
e400: 73 74 61 74 65 73 2f 73 74 61 74 75 73 65 73 20 states/statuses
e410: 63 6f 72 72 65 63 74 0a 09 20 20 20 28 6c 65 74 correct.. (let
e420: 20 28 28 73 74 61 74 65 73 20 20 20 28 6f 72 20 ((states (or
e430: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
e440: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 76 61 6c *configdat* "val
e450: 69 64 76 61 6c 75 65 73 22 20 22 63 6c 65 61 6e idvalues" "clean
e460: 72 65 72 75 6e 2d 73 74 61 74 65 73 22 29 0a 09 rerun-states")..
e470: 09 09 20 20 20 20 20 20 20 22 4b 49 4c 4c 52 45 .. "KILLRE
e480: 51 2c 4b 49 4c 4c 45 44 2c 55 4e 4b 4e 4f 57 4e Q,KILLED,UNKNOWN
e490: 2c 49 4e 43 4f 4d 50 4c 45 54 45 2c 53 54 55 43 ,INCOMPLETE,STUC
e4a0: 4b 2c 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 29 K,NOT_STARTED"))
e4b0: 0a 09 09 20 28 73 74 61 74 75 73 65 73 20 28 6f ... (statuses (o
e4c0: 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 r (configf:looku
e4d0: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 76 p *configdat* "v
e4e0: 61 6c 69 64 76 61 6c 75 65 73 22 20 22 63 6c 65 alidvalues" "cle
e4f0: 61 6e 72 65 72 75 6e 2d 73 74 61 74 75 73 65 73 anrerun-statuses
e500: 22 29 0a 09 09 09 20 20 20 20 20 20 20 22 46 41 ").... "FA
e510: 49 4c 2c 49 4e 43 4f 4d 50 4c 45 54 45 2c 41 42 IL,INCOMPLETE,AB
e520: 4f 52 54 2c 43 48 45 43 4b 22 29 29 29 0a 09 20 ORT,CHECK")))..
e530: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
e540: 73 65 74 21 20 61 72 67 73 3a 61 72 67 2d 68 61 set! args:arg-ha
e550: 73 68 20 22 2d 70 72 65 63 6c 65 61 6e 22 20 23 sh "-preclean" #
e560: 74 29 0a 09 20 20 20 20 20 28 72 75 6e 73 3a 6f t).. (runs:o
e570: 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 perate-on 'set-s
e580: 74 61 74 65 2d 73 74 61 74 75 73 0a 09 09 09 20 tate-status....
e590: 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 20 target....
e5a0: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 (common:arg
e5b0: 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 s-get-runname)
e5c0: 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 ;; (or (args:get
e5d0: 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 -arg "-runname")
e5e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
e5f0: 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 runname"))....
e600: 20 20 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d 6d "%" ;; (comm
e610: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
e620: 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 patt #f) ;; (arg
e630: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
e640: 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 20 patt")....
e650: 73 74 61 74 65 3a 20 20 73 74 61 74 65 73 0a 09 state: states..
e660: 09 09 20 20 20 20 20 20 3b 3b 20 73 74 61 74 75 .. ;; statu
e670: 73 3a 20 73 74 61 74 75 73 65 73 0a 09 09 09 20 s: statuses....
e680: 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 new-state-s
e690: 74 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 tatus: "NOT_STAR
e6a0: 54 45 44 2c 6e 2f 61 22 29 0a 09 20 20 20 20 20 TED,n/a")..
e6b0: 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e (runs:operate-on
e6c0: 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 'set-state-stat
e6d0: 75 73 0a 09 09 09 20 20 20 20 20 20 74 61 72 67 us.... targ
e6e0: 65 74 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d et.... (com
e6f0: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e mon:args-get-run
e700: 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 name) ;; (or (a
e710: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
e720: 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 nname")(args:get
e730: 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 -arg ":runname")
e740: 29 0a 09 09 09 20 20 20 20 20 20 22 25 22 20 3b ).... "%" ;
e750: 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 ; (common:args-g
e760: 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 20 et-testpatt #f)
e770: 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ;; (args:get-arg
e780: 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 "-testpatt")...
e790: 09 20 20 20 20 20 20 3b 3b 20 73 74 61 74 65 3a . ;; state:
e7a0: 20 20 73 74 61 74 65 73 0a 09 09 09 20 20 20 20 states....
e7b0: 20 20 73 74 61 74 75 73 3a 20 73 74 61 74 75 73 status: status
e7c0: 65 73 0a 09 09 09 20 20 20 20 20 20 6e 65 77 2d es.... new-
e7d0: 73 74 61 74 65 2d 73 74 61 74 75 73 3a 20 22 4e state-status: "N
e7e0: 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 22 29 OT_STARTED,n/a")
e7f0: 29 29 0a 20 20 20 20 20 20 20 3b 3b 20 52 45 52 )). ;; RER
e800: 55 4e 20 41 4c 4c 0a 20 20 20 20 20 20 20 28 69 UN ALL. (i
e810: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
e820: 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 29 20 3b 3b "-rerun-all") ;;
e830: 20 66 69 72 73 74 20 73 65 74 20 73 74 61 74 65 first set state
e840: 73 2f 73 74 61 74 75 73 65 73 20 63 6f 72 72 65 s/statuses corre
e850: 63 74 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 ct.. (begin..
e860: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
e870: 73 65 74 21 20 61 72 67 73 3a 61 72 67 2d 68 61 set! args:arg-ha
e880: 73 68 20 22 2d 70 72 65 63 6c 65 61 6e 22 20 23 sh "-preclean" #
e890: 74 29 0a 09 20 20 20 20 20 28 72 75 6e 73 3a 6f t).. (runs:o
e8a0: 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 perate-on 'set-s
e8b0: 74 61 74 65 2d 73 74 61 74 75 73 0a 09 09 09 20 tate-status....
e8c0: 20 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 20 target....
e8d0: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 (common:arg
e8e0: 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 s-get-runname)
e8f0: 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 ;; (or (args:get
e900: 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 -arg "-runname")
e910: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
e920: 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 runname"))....
e930: 20 20 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d 6d "%" ;; (comm
e940: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
e950: 70 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 patt #f) ;; (arg
e960: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
e970: 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 20 patt")....
e980: 73 74 61 74 65 3a 20 20 23 66 0a 09 09 09 20 20 state: #f....
e990: 20 20 20 20 3b 3b 20 73 74 61 74 75 73 3a 20 73 ;; status: s
e9a0: 74 61 74 75 73 65 73 0a 09 09 09 20 20 20 20 20 tatuses....
e9b0: 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 new-state-statu
e9c0: 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c s: "NOT_STARTED,
e9d0: 6e 2f 61 22 29 0a 09 20 20 20 20 20 28 72 75 6e n/a").. (run
e9e0: 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 s:operate-on 'se
e9f0: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a 09 t-state-status..
ea00: 09 09 20 20 20 20 20 20 74 61 72 67 65 74 0a 09 .. target..
ea10: 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a .. (common:
ea20: 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 args-get-runname
ea30: 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a ) ;; (or (args:
ea40: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d get-arg "-runnam
ea50: 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 e")(args:get-arg
ea60: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 ":runname"))...
ea70: 09 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 63 . "%" ;; (c
ea80: 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 ommon:args-get-t
ea90: 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 estpatt #f) ;; (
eaa0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
eab0: 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 estpatt")....
eac0: 20 20 20 3b 3b 20 73 74 61 74 65 3a 20 20 73 74 ;; state: st
ead0: 61 74 65 73 0a 09 09 09 20 20 20 20 20 20 73 74 ates.... st
eae0: 61 74 75 73 3a 20 23 66 0a 09 09 09 20 20 20 20 atus: #f....
eaf0: 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 new-state-stat
eb00: 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 us: "NOT_STARTED
eb10: 2c 6e 2f 61 22 29 29 29 0a 20 20 20 20 20 20 20 ,n/a"))).
eb20: 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 (runs:run-tests
eb30: 74 61 72 67 65 74 0a 09 09 20 20 20 20 20 20 20 target...
eb40: 72 75 6e 6e 61 6d 65 0a 09 09 20 20 20 20 20 20 runname...
eb50: 20 23 66 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 #f ;; (common:a
eb60: 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 rgs-get-testpatt
eb70: 20 23 66 29 0a 09 09 20 20 20 20 20 20 20 3b 3b #f)... ;;
eb80: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
eb90: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a rg "-testpatt").
eba0: 09 09 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 .. ;;
ebb0: 22 25 22 29 0a 09 09 20 20 20 20 20 20 20 75 73 "%")... us
ebc0: 65 72 0a 09 09 20 20 20 20 20 20 20 61 72 67 73 er... args
ebd0: 3a 61 72 67 2d 68 61 73 68 29 29 29 29 0a 0a 3b :arg-hash))))..;
ebe0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
ebf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ec00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ec10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ec20: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e 20 6f =======.;; run o
ec30: 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d ne test.;;======
ec40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ec50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ec60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ec70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ec80: 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 20 74 68 65 ..;; 1. find the
ec90: 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b 20 config file.;;
eca0: 32 2e 20 63 68 61 6e 67 65 20 74 6f 20 74 68 65 2. change to the
ecb0: 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 79 0a test directory.
ecc0: 3b 3b 20 33 2e 20 75 70 64 61 74 65 20 74 68 65 ;; 3. update the
ecd0: 20 64 62 20 77 69 74 68 20 22 74 65 73 74 20 73 db with "test s
ece0: 74 61 72 74 65 64 22 20 73 74 61 74 75 73 2c 20 tarted" status,
ecf0: 73 65 74 20 72 75 6e 6e 69 6e 67 20 68 6f 73 74 set running host
ed00: 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 73 73 20 6c .;; 4. process l
ed10: 61 75 6e 63 68 20 74 68 65 20 74 65 73 74 0a 3b aunch the test.;
ed20: 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 6f 72 20 74 ; - monitor t
ed30: 68 65 20 70 72 6f 63 65 73 73 2c 20 75 70 64 61 he process, upda
ed40: 74 65 20 73 74 61 74 73 20 69 6e 20 74 68 65 20 te stats in the
ed50: 64 62 20 65 76 65 72 79 20 32 5e 6e 20 6d 69 6e db every 2^n min
ed60: 75 74 65 73 0a 3b 3b 20 35 2e 20 61 73 20 74 68 utes.;; 5. as th
ed70: 65 20 74 65 73 74 20 70 72 6f 63 65 65 64 73 20 e test proceeds
ed80: 69 6e 74 65 72 6e 61 6c 6c 79 20 69 74 20 63 61 internally it ca
ed90: 6c 6c 73 20 6d 65 67 61 74 65 73 74 20 61 73 20 lls megatest as
eda0: 65 61 63 68 20 73 74 65 70 20 69 73 0a 3b 3b 20 each step is.;;
edb0: 20 20 20 73 74 61 72 74 65 64 20 61 6e 64 20 63 started and c
edc0: 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 20 20 20 2d ompleted.;; -
edd0: 20 73 74 65 70 20 73 74 61 72 74 65 64 2c 20 74 step started, t
ede0: 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 20 20 20 2d imestamp.;; -
edf0: 20 73 74 65 70 20 63 6f 6d 70 6c 65 74 65 64 2c step completed,
ee00: 20 65 78 69 74 20 73 74 61 74 75 73 2c 20 74 69 exit status, ti
ee10: 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 2e 20 74 65 mestamp.;; 6. te
ee20: 73 74 20 70 68 6f 6e 65 20 68 6f 6d 65 0a 3b 3b st phone home.;;
ee30: 20 20 20 20 2d 20 69 66 20 74 65 73 74 20 72 75 - if test ru
ee40: 6e 20 74 69 6d 65 20 3e 20 61 6c 6c 6f 77 65 64 n time > allowed
ee50: 20 72 75 6e 20 74 69 6d 65 20 74 68 65 6e 20 6b run time then k
ee60: 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 20 20 2d 20 ill job.;; -
ee70: 69 66 20 63 61 6e 6e 6f 74 20 61 63 63 65 73 73 if cannot access
ee80: 20 64 62 20 3e 20 61 6c 6c 6f 77 65 64 20 64 69 db > allowed di
ee90: 73 63 6f 6e 6e 65 63 74 20 74 69 6d 65 20 74 68 sconnect time th
eea0: 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 0a 3b 3b 20 en kill job..;;
eeb0: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
eec0: 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 (if (or (args:g
eed0: 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 28 61 et-arg "-run")(a
eee0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
eef0: 6e 74 65 73 74 73 22 29 29 0a 3b 3b 20 3d 3d 20 ntests")).;; ==
ef00: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
ef10: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
ef20: 6c 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 l .;; == duplica
ef30: 74 65 64 20 3d 3d 20 20 20 20 22 2d 72 75 6e 74 ted == "-runt
ef40: 65 73 74 73 22 20 0a 3b 3b 20 3d 3d 20 64 75 70 ests" .;; == dup
ef50: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 22 72 licated == "r
ef60: 75 6e 20 61 20 74 65 73 74 22 20 0a 3b 3b 20 3d un a test" .;; =
ef70: 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
ef80: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
ef90: 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
efa0: 6b 65 79 76 61 6c 73 29 0a 3b 3b 20 3d 3d 20 64 keyvals).;; == d
efb0: 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
efc0: 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 ;;.;; == dupli
efd0: 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b cated == ;;
efe0: 20 4d 61 79 20 6f 72 20 6d 61 79 20 6e 6f 74 20 May or may not
eff0: 69 6d 70 6c 65 6d 65 6e 74 20 69 74 20 74 68 69 implement it thi
f000: 73 20 77 61 79 20 2e 2e 2e 0a 3b 3b 20 3d 3d 20 s way ....;; ==
f010: 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
f020: 20 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 70 6c ;;.;; == dupl
f030: 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b icated == ;
f040: 3b 20 49 6e 73 65 72 74 20 74 68 69 73 20 72 75 ; Insert this ru
f050: 6e 20 69 6e 74 6f 20 74 68 65 20 74 61 73 6b 73 n into the tasks
f060: 20 71 75 65 75 65 0a 3b 3b 20 3d 3d 20 64 75 70 queue.;; == dup
f070: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 licated ==
f080: 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f ;; (open-run-clo
f090: 73 65 20 74 61 73 6b 73 3a 61 64 64 20 74 61 73 se tasks:add tas
f0a0: 6b 73 3a 6f 70 65 6e 2d 64 62 20 0a 3b 3b 20 3d ks:open-db .;; =
f0b0: 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
f0c0: 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 ;; .
f0d0: 20 22 72 75 6e 74 65 73 74 73 22 20 0a 3b 3b 20 "runtests" .;;
f0e0: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f0f0: 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 ;; .
f100: 20 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 64 75 70 user.;; == dup
f110: 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 licated ==
f120: 3b 3b 20 20 20 20 09 20 20 20 20 20 74 61 72 67 ;; . targ
f130: 65 74 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 et.;; == duplica
f140: 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 ted == ;;
f150: 20 20 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a . runname.
f160: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f170: 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 == ;; .
f180: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
f190: 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a rg "-runtests").
f1a0: 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
f1b0: 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 == ;; .
f1c0: 20 20 20 20 20 23 66 29 29 29 29 0a 3b 3b 20 3d #f)))).;; =
f1d0: 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
f1e0: 20 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 (runs:run-t
f1f0: 65 73 74 73 20 74 61 72 67 65 74 0a 3b 3b 20 3d ests target.;; =
f200: 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
f210: 09 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a 3b .. runname.;
f220: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
f230: 3d 3d 20 09 09 20 20 20 20 20 28 63 6f 6d 6d 6f == .. (commo
f240: 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 n:args-get-testp
f250: 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 att #f) ;; (args
f260: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
f270: 73 74 73 22 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c sts").;; == dupl
f280: 69 63 61 74 65 64 20 3d 3d 20 09 09 20 20 20 20 icated == ..
f290: 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 64 75 70 6c user.;; == dupl
f2a0: 69 63 61 74 65 64 20 3d 3d 20 09 09 20 20 20 20 icated == ..
f2b0: 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 args:arg-hash))
f2c0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
f2d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f2e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f2f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
f310: 52 6f 6c 6c 75 70 20 69 6e 74 6f 20 61 20 72 75 Rollup into a ru
f320: 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d n.;;============
f330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
f370: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
f380: 72 6f 6c 6c 75 70 22 29 0a 20 20 20 20 28 67 65 rollup"). (ge
f390: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
f3a0: 20 20 20 20 20 22 2d 72 6f 6c 6c 75 70 22 20 0a "-rollup" .
f3b0: 20 20 20 20 20 22 72 6f 6c 6c 75 70 20 74 65 73 "rollup tes
f3c0: 74 73 22 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 ts" . (lambd
f3d0: 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
f3e0: 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a e keys keyvals).
f3f0: 20 20 20 20 20 20 20 28 72 75 6e 73 3a 72 6f 6c (runs:rol
f400: 6c 75 70 2d 72 75 6e 20 6b 65 79 73 0a 09 09 09 lup-run keys....
f410: 6b 65 79 76 61 6c 73 0a 09 09 09 28 6f 72 20 28 keyvals....(or (
f420: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
f430: 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 unname")(args:ge
f440: 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 t-arg ":runname"
f450: 29 20 29 0a 09 09 09 75 73 65 72 29 29 29 29 0a ) )....user)))).
f460: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
f470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f4a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 6f 63 =========.;; Loc
f4b0: 6b 20 6f 72 20 75 6e 6c 6f 63 6b 20 61 20 72 75 k or unlock a ru
f4c0: 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d n.;;============
f4d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f4e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f4f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
f510: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
f520: 67 20 22 2d 6c 6f 63 6b 22 29 28 61 72 67 73 3a g "-lock")(args:
f530: 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b get-arg "-unlock
f540: 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c ")). (general
f550: 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 -run-call .
f560: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
f570: 67 20 22 2d 6c 6f 63 6b 22 29 20 22 2d 6c 6f 63 g "-lock") "-loc
f580: 6b 22 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 20 k" "-unlock").
f590: 20 20 20 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 20 "lock/unlock
f5a0: 74 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c 61 tests" . (la
f5b0: 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
f5c0: 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c name keys keyval
f5d0: 73 29 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a s). (runs:
f5e0: 68 61 6e 64 6c 65 2d 6c 6f 63 6b 69 6e 67 20 0a handle-locking .
f5f0: 09 09 20 20 74 61 72 67 65 74 0a 09 09 20 20 6b .. target... k
f600: 65 79 73 0a 09 09 20 20 28 6f 72 20 28 61 72 67 eys... (or (arg
f610: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
f620: 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 ame")(args:get-a
f630: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 29 rg ":runname") )
f640: 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ... (args:get-a
f650: 72 67 20 22 2d 6c 6f 63 6b 22 29 0a 09 09 20 20 rg "-lock")...
f660: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
f670: 75 6e 6c 6f 63 6b 22 29 0a 09 09 20 20 75 73 65 unlock")... use
f680: 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d r))))..;;=======
f690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f6a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f6b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f6c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
f6d0: 3b 3b 20 47 65 74 20 70 61 74 68 73 20 74 6f 20 ;; Get paths to
f6e0: 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d tests.;;========
f6f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
f730: 3b 20 47 65 74 20 74 65 73 74 20 70 61 74 68 73 ; Get test paths
f740: 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 74 matching target
f750: 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 , runname, and t
f760: 65 73 74 70 61 74 74 0a 28 69 66 20 28 6f 72 20 estpatt.(if (or
f770: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
f780: 74 65 73 74 2d 66 69 6c 65 73 22 29 28 61 72 67 test-files")(arg
f790: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
f7a0: 2d 70 61 74 68 73 22 29 29 0a 20 20 20 20 3b 3b -paths")). ;;
f7b0: 20 69 66 20 77 65 20 61 72 65 20 69 6e 20 61 20 if we are in a
f7c0: 74 65 73 74 20 75 73 65 20 74 68 65 20 4d 54 5f test use the MT_
f7d0: 43 4d 44 49 4e 46 4f 20 64 61 74 61 0a 20 20 20 CMDINFO data.
f7e0: 20 28 69 66 20 28 67 65 74 65 6e 76 20 22 4d 54 (if (getenv "MT
f7f0: 5f 43 4d 44 49 4e 46 4f 22 29 0a 09 28 6c 65 74 _CMDINFO")..(let
f800: 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 20 * ((startingdir
f810: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
f820: 72 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 6d ry)).. (cm
f830: 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e 3a dinfo (common:
f840: 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 read-encoded-str
f850: 69 6e 67 20 28 67 65 74 65 6e 76 20 22 4d 54 5f ing (getenv "MT_
f860: 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 20 20 20 CMDINFO")))..
f870: 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 (transport (
f880: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
f890: 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f ransport cmdinfo
f8a0: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
f8b0: 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 path (assoc/def
f8c0: 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 ault 'testpath
f8d0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
f8e0: 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 (test-name (as
f8f0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
f900: 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 t-name cmdinfo))
f910: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 .. (runscr
f920: 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ipt (assoc/defau
f930: 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d lt 'runscript cm
f940: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
f950: 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f (db-host (asso
f960: 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f c/default 'db-ho
f970: 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 st cmdinfo))..
f980: 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 (run-id
f990: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
f9a0: 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 'run-id cmdi
f9b0: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 nfo)).. (i
f9c0: 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f temdat (assoc/
f9d0: 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 default 'itemdat
f9e0: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
f9f0: 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 20 (state
fa00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
fa10: 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 state"))..
fa20: 20 28 73 74 61 74 75 73 20 20 20 20 28 61 72 67 (status (arg
fa30: 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
fa40: 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 us")).. (t
fa50: 61 72 67 65 74 20 20 20 20 28 61 72 67 73 3a 67 arget (args:g
fa60: 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 et-arg "-target"
fa70: 29 29 0a 09 20 20 20 20 20 20 20 28 74 6f 70 70 )).. (topp
fa80: 61 74 68 20 20 20 28 61 73 73 6f 63 2f 64 65 66 ath (assoc/def
fa90: 61 75 6c 74 20 27 74 6f 70 70 61 74 68 20 20 20 ault 'toppath
faa0: 63 6d 64 69 6e 66 6f 29 29 29 0a 09 20 20 28 63 cmdinfo))).. (c
fab0: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
fac0: 74 6f 70 70 61 74 68 29 0a 09 20 20 28 69 66 20 toppath).. (if
fad0: 28 6e 6f 74 20 74 61 72 67 65 74 29 0a 09 20 20 (not target)..
fae0: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 (begin...(de
faf0: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
fb00: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
fb10: 6f 72 74 2a 20 22 2d 74 61 72 67 65 74 20 69 73 ort* "-target is
fb20: 20 72 65 71 75 69 72 65 64 2e 22 29 0a 09 09 28 required.")...(
fb30: 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 69 66 exit 1))).. (if
fb40: 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
fb50: 74 75 70 29 29 0a 09 20 20 20 20 20 20 28 62 65 tup)).. (be
fb60: 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 gin...(debug:pri
fb70: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
fb80: 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 g-port* "Failed
fb90: 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 6e 67 to setup, giving
fba0: 20 75 70 20 6f 6e 20 2d 74 65 73 74 2d 70 61 74 up on -test-pat
fbb0: 68 73 20 6f 72 20 2d 74 65 73 74 2d 66 69 6c 65 hs or -test-file
fbc0: 73 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 s, exiting")...(
fbd0: 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 6c 65 exit 1))).. (le
fbe0: 74 2a 20 28 28 6b 65 79 73 20 20 20 20 20 28 72 t* ((keys (r
fbf0: 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 0a 09 09 mt:get-keys))...
fc00: 20 3b 3b 20 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; db:test-get-
fc10: 70 61 74 68 73 20 6d 75 73 74 20 6e 6f 74 20 62 paths must not b
fc20: 65 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 e run remote...
fc30: 28 70 61 74 68 73 20 20 20 20 28 74 65 73 74 73 (paths (tests
fc40: 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d :test-get-paths-
fc50: 6d 61 74 63 68 69 6e 67 20 6b 65 79 73 20 74 61 matching keys ta
fc60: 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d 61 rget (args:get-a
fc70: 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 rg "-test-files"
fc80: 29 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 20 )))).. (set!
fc90: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
fca0: 74 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 t).. (for-eac
fcb0: 68 20 28 6c 61 6d 62 64 61 20 28 70 61 74 68 29 h (lambda (path)
fcc0: 0a 09 09 09 28 70 72 69 6e 74 20 70 61 74 68 29 ....(print path)
fcd0: 29 0a 09 09 20 20 20 20 20 20 70 61 74 68 73 29 )... paths)
fce0: 29 29 0a 09 3b 3b 20 65 6c 73 65 20 64 6f 20 61 ))..;; else do a
fcf0: 20 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c general-run-cal
fd00: 6c 0a 09 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d l..(general-run-
fd10: 63 61 6c 6c 20 0a 09 20 22 2d 74 65 73 74 2d 66 call .. "-test-f
fd20: 69 6c 65 73 22 0a 09 20 22 47 65 74 20 70 61 74 iles".. "Get pat
fd30: 68 73 20 74 6f 20 74 65 73 74 22 0a 09 20 28 6c hs to test".. (l
fd40: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
fd50: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 nname keys keyva
fd60: 6c 73 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 ls).. (let* ((
fd70: 64 62 20 20 20 20 20 20 20 23 66 29 0a 09 09 20 db #f)...
fd80: 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 ;; DO NOT run r
fd90: 65 6d 6f 74 65 0a 09 09 20 20 28 70 61 74 68 73 emote... (paths
fda0: 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d (tests:test-
fdb0: 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 get-paths-matchi
fdc0: 6e 67 20 6b 65 79 73 20 74 61 72 67 65 74 20 28 ng keys target (
fdd0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
fde0: 65 73 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 est-files"))))..
fdf0: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 (for-each (
fe00: 6c 61 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 lambda (path)...
fe10: 09 20 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a . (print path)).
fe20: 09 09 20 20 20 20 20 20 20 70 61 74 68 73 29 29 .. paths))
fe30: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
fe40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fe50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fe60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fe70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
fe80: 3b 20 41 72 63 68 69 76 65 20 74 65 73 74 73 0a ; Archive tests.
fe90: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
fea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
feb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fed0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 ========.;; Arch
fee0: 69 76 65 20 74 65 73 74 73 20 6d 61 74 63 68 69 ive tests matchi
fef0: 6e 67 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 ng target, runna
ff00: 6d 65 2c 20 61 6e 64 20 74 65 73 74 70 61 74 74 me, and testpatt
ff10: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
ff20: 72 67 20 22 2d 61 72 63 68 69 76 65 22 29 0a 20 rg "-archive").
ff30: 20 20 20 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 ;; else do a
ff40: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
ff50: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
ff60: 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 61 n-call . "-a
ff70: 72 63 68 69 76 65 22 0a 20 20 20 20 20 22 41 72 rchive". "Ar
ff80: 63 68 69 76 65 22 0a 20 20 20 20 20 28 6c 61 6d chive". (lam
ff90: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
ffa0: 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 ame keys keyvals
ffb0: 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 ). (operat
ffc0: 65 2d 6f 6e 20 27 61 72 63 68 69 76 65 29 29 29 e-on 'archive)))
ffd0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
ffe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10000 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10010 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 ===========.;; E
10020 78 74 72 61 63 74 20 61 20 73 70 72 65 61 64 73 xtract a spreads
10030 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 72 75 heet from the ru
10040 6e 73 20 64 61 74 61 62 61 73 65 0a 3b 3b 3d 3d ns database.;;==
10050 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10060 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10070 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10080 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10090 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
100a0 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 61 63 get-arg "-extrac
100b0 74 2d 6f 64 73 22 29 0a 20 20 20 20 28 67 65 6e t-ods"). (gen
100c0 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 eral-run-call.
100d0 20 20 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 "-extract-ods
100e0 22 0a 20 20 20 20 20 22 4d 61 6b 65 20 6f 64 73 ". "Make ods
100f0 20 73 70 72 65 61 64 73 68 65 65 74 22 0a 20 20 spreadsheet".
10100 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
10110 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
10120 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 keyvals).
10130 28 6c 65 74 20 28 28 64 62 73 74 72 75 63 74 20 (let ((dbstruct
10140 20 20 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 (make-dbr:dbst
10150 72 75 63 74 20 70 61 74 68 3a 20 2a 74 6f 70 70 ruct path: *topp
10160 61 74 68 2a 20 6c 6f 63 61 6c 3a 20 23 74 29 29 ath* local: #t))
10170 0a 09 20 20 20 20 20 28 6f 75 74 70 75 74 66 69 .. (outputfi
10180 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 le (args:get-arg
10190 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 "-extract-ods")
101a0 29 0a 09 20 20 20 20 20 28 72 75 6e 73 70 61 74 ).. (runspat
101b0 74 20 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 t (or (args:ge
101c0 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
101d0 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
101e0 3a 72 75 6e 6e 61 6d 65 22 29 29 29 0a 09 20 20 :runname")))..
101f0 20 20 20 28 70 61 74 68 6d 6f 64 20 20 20 20 28 (pathmod (
10200 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 args:get-arg "-p
10210 61 74 68 6d 6f 64 22 29 29 29 0a 09 20 20 20 20 athmod")))..
10220 20 3b 3b 20 28 6b 65 79 76 61 6c 61 6c 69 73 74 ;; (keyvalalist
10230 20 28 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 (keys->alist ke
10240 79 73 20 22 25 22 29 29 29 0a 09 20 28 64 65 62 ys "%"))).. (deb
10250 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 ug:print 2 *defa
10260 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 ult-log-port* "E
10270 78 74 72 61 63 74 20 6f 64 73 2c 20 6f 75 74 70 xtract ods, outp
10280 75 74 66 69 6c 65 3a 20 22 20 6f 75 74 70 75 74 utfile: " output
10290 66 69 6c 65 20 22 20 72 75 6e 73 70 61 74 74 3a file " runspatt:
102a0 20 22 20 72 75 6e 73 70 61 74 74 20 22 20 6b 65 " runspatt " ke
102b0 79 76 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 yvals: " keyvals
102c0 29 0a 09 20 28 64 62 3a 65 78 74 72 61 63 74 2d ).. (db:extract-
102d0 6f 64 73 2d 66 69 6c 65 20 64 62 73 74 72 75 63 ods-file dbstruc
102e0 74 20 6f 75 74 70 75 74 66 69 6c 65 20 6b 65 79 t outputfile key
102f0 76 61 6c 73 20 28 69 66 20 72 75 6e 73 70 61 74 vals (if runspat
10300 74 20 72 75 6e 73 70 61 74 74 20 22 25 22 29 20 t runspatt "%")
10310 70 61 74 68 6d 6f 64 29 0a 09 20 28 64 62 3a 63 pathmod).. (db:c
10320 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 lose-all dbstruc
10330 74 29 0a 09 20 28 73 65 74 21 20 2a 64 69 64 73 t).. (set! *dids
10340 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 omething* #t))))
10350 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
10360 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10370 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10380 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10390 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 ===========.;; e
103a0 78 65 63 75 74 65 20 74 68 65 20 74 65 73 74 0a xecute the test.
103b0 3b 3b 20 20 20 20 2d 20 67 65 74 73 20 63 61 6c ;; - gets cal
103c0 6c 65 64 20 6f 6e 20 72 65 6d 6f 74 65 20 68 6f led on remote ho
103d0 73 74 0a 3b 3b 20 20 20 20 2d 20 72 65 63 65 69 st.;; - recei
103e0 76 65 73 20 69 6e 66 6f 20 66 72 6f 6d 20 74 68 ves info from th
103f0 65 20 2d 65 78 65 63 75 74 65 20 70 61 72 61 6d e -execute param
10400 0a 3b 3b 20 20 20 20 2d 20 70 61 73 73 65 73 20 .;; - passes
10410 69 6e 66 6f 20 74 6f 20 73 74 65 70 73 20 76 69 info to steps vi
10420 61 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 a MT_CMDINFO env
10430 20 76 61 72 20 28 66 75 74 75 72 65 20 69 73 20 var (future is
10440 74 6f 20 75 73 65 20 61 20 64 6f 74 20 66 69 6c to use a dot fil
10450 65 29 0a 3b 3b 20 20 20 20 2d 20 67 61 74 68 65 e).;; - gathe
10460 72 73 20 68 6f 73 74 20 69 6e 66 6f 20 61 6e 64 rs host info and
10470 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;============
10480 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 69 66 20 ==========..(if
104c0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
104d0 65 78 65 63 75 74 65 22 29 0a 20 20 20 20 28 62 execute"). (b
104e0 65 67 69 6e 0a 20 20 20 20 20 20 28 6c 61 75 6e egin. (laun
104f0 63 68 3a 65 78 65 63 75 74 65 20 28 61 72 67 73 ch:execute (args
10500 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 :get-arg "-execu
10510 74 65 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 te")). (set
10520 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
10530 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d #t)))..;;======
10540 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 72 65 63 6f 76 65 72 20 66 72 6f 6d .;; recover from
10590 20 61 20 74 65 73 74 20 77 68 65 72 65 20 74 68 a test where th
105a0 65 20 6d 61 6e 61 67 69 6e 67 20 6d 74 65 73 74 e managing mtest
105b0 20 77 61 73 20 6b 69 6c 6c 65 64 20 62 75 74 20 was killed but
105c0 74 68 65 20 75 6e 64 65 72 6c 79 69 6e 67 0a 3b the underlying.;
105d0 3b 20 70 72 6f 63 65 73 73 20 6d 69 67 68 74 20 ; process might
105e0 73 74 69 6c 6c 20 62 65 20 73 61 6c 76 61 67 65 still be salvage
105f0 61 62 6c 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d able.;;=========
10600 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10610 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10620 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10630 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
10640 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
10650 20 22 2d 72 65 63 6f 76 65 72 2d 74 65 73 74 22 "-recover-test"
10660 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 70 61 ). (let* ((pa
10670 72 61 6d 73 20 28 73 74 72 69 6e 67 2d 73 70 6c rams (string-spl
10680 69 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 it (args:get-arg
10690 20 22 2d 72 65 63 6f 76 65 72 2d 74 65 73 74 22 "-recover-test"
106a0 29 20 22 2c 22 29 29 29 0a 20 20 20 20 20 20 28 ) ","))). (
106b0 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 if (> (length pa
106c0 72 61 6d 73 29 20 31 29 20 3b 3b 20 72 75 6e 2d rams) 1) ;; run-
106d0 69 64 20 61 6e 64 20 74 65 73 74 2d 69 64 0a 09 id and test-id..
106e0 20 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 (let ((run-id
106f0 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
10700 28 63 61 72 20 70 61 72 61 6d 73 29 29 29 0a 09 (car params)))..
10710 09 28 74 65 73 74 2d 69 64 20 28 73 74 72 69 6e .(test-id (strin
10720 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 64 72 20 g->number (cadr
10730 70 61 72 61 6d 73 29 29 29 29 0a 09 20 20 20 20 params))))..
10740 28 69 66 20 28 61 6e 64 20 72 75 6e 2d 69 64 20 (if (and run-id
10750 74 65 73 74 2d 69 64 29 0a 09 09 28 62 65 67 69 test-id)...(begi
10760 6e 0a 09 09 20 20 28 6c 61 75 6e 63 68 3a 72 65 n... (launch:re
10770 63 6f 76 65 72 2d 74 65 73 74 20 72 75 6e 2d 69 cover-test run-i
10780 64 20 74 65 73 74 2d 69 64 29 0a 09 09 20 20 28 d test-id)... (
10790 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
107a0 6e 67 2a 20 23 74 29 29 0a 09 09 28 62 65 67 69 ng* #t))...(begi
107b0 6e 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 n... (debug:pri
107c0 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
107d0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 62 ult-log-port* "b
107e0 61 64 20 72 75 6e 2d 69 64 20 6f 72 20 74 65 73 ad run-id or tes
107f0 74 2d 69 64 2c 20 6d 75 73 74 20 62 65 20 69 6e t-id, must be in
10800 74 65 67 65 72 73 22 29 0a 09 09 20 20 28 65 78 tegers")... (ex
10810 69 74 20 31 29 29 29 29 29 29 29 0a 0a 3b 3b 3d it 1)))))))..;;=
10820 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10830 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10840 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10850 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10860 3d 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 20 63 6f =====.;; Test co
10870 6d 6d 61 6e 64 73 20 28 69 2e 65 2e 20 66 6f 72 mmands (i.e. for
10880 20 75 73 65 20 69 6e 73 69 64 65 20 74 65 73 74 use inside test
10890 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s).;;===========
108a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 ===========..(de
108e0 66 69 6e 65 20 28 6d 65 67 61 74 65 73 74 3a 73 fine (megatest:s
108f0 74 65 70 20 73 74 65 70 20 73 74 61 74 65 20 73 tep step state s
10900 74 61 74 75 73 20 6c 6f 67 66 69 6c 65 20 6d 73 tatus logfile ms
10910 67 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 67 g). (if (not (g
10920 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
10930 4f 22 29 29 0a 20 20 20 20 20 20 28 62 65 67 69 O")). (begi
10940 6e 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d n..(debug:print-
10950 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
10960 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 54 5f 43 -log-port* "MT_C
10970 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e MDINFO env var n
10980 6f 74 20 73 65 74 2c 20 2d 73 74 65 70 20 6d 75 ot set, -step mu
10990 73 74 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e st be called *in
109a0 73 69 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 side* a megatest
109b0 20 69 6e 76 6f 6b 65 64 20 65 6e 76 69 72 6f 6e invoked environ
109c0 6d 65 6e 74 21 22 29 0a 09 28 65 78 69 74 20 35 ment!")..(exit 5
109d0 29 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 )). (let* (
109e0 28 63 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d (cmdinfo (comm
109f0 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d on:read-encoded-
10a00 73 74 72 69 6e 67 20 28 67 65 74 65 6e 76 20 22 string (getenv "
10a10 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 MT_CMDINFO")))..
10a20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 (transport
10a30 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
10a40 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 transport cmdinf
10a50 6f 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 70 o)).. (testp
10a60 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
10a70 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
10a80 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 mdinfo)).. (
10a90 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 test-name (assoc
10aa0 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e /default 'test-n
10ab0 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ame cmdinfo))..
10ac0 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 (runscript (
10ad0 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
10ae0 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f unscript cmdinfo
10af0 29 29 0a 09 20 20 20 20 20 28 64 62 2d 68 6f 73 )).. (db-hos
10b00 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
10b10 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d lt 'db-host cm
10b20 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 dinfo)).. (r
10b30 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f un-id (assoc/
10b40 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 default 'run-id
10b50 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
10b60 20 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 (test-id (a
10b70 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
10b80 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 st-id cmdinfo)
10b90 29 0a 09 20 20 20 20 20 28 69 74 65 6d 64 61 74 ).. (itemdat
10ba0 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
10bb0 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 t 'itemdat cmd
10bc0 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 77 6f info)).. (wo
10bd0 72 6b 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 rk-area (assoc/d
10be0 65 66 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 efault 'work-are
10bf0 61 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 a cmdinfo))..
10c00 20 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 (db #f)
10c10 29 0a 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 )..(change-direc
10c20 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
10c30 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 (if (not (launch
10c40 3a 73 65 74 75 70 29 29 0a 09 20 20 20 20 28 62 :setup)).. (b
10c50 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 egin.. (deb
10c60 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
10c70 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 ult-log-port* "F
10c80 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 ailed to setup,
10c90 65 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 exiting")..
10ca0 20 28 65 78 69 74 20 31 29 29 29 0a 09 28 69 66 (exit 1)))..(if
10cb0 20 28 61 6e 64 20 73 74 61 74 65 20 73 74 61 74 (and state stat
10cc0 75 73 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 us).. (let ((
10cd0 63 6f 6d 6d 65 6e 74 20 28 6c 61 75 6e 63 68 3a comment (launch:
10ce0 6c 6f 61 64 2d 6c 6f 67 70 72 6f 2d 64 61 74 20 load-logpro-dat
10cf0 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 run-id test-id s
10d00 74 65 70 29 29 29 0a 09 20 20 20 20 20 20 3b 3b tep))).. ;;
10d10 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c (rmt:test-set-l
10d20 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d og! run-id test-
10d30 69 64 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d id (conc stepnam
10d40 65 20 22 2e 68 74 6d 6c 22 29 29 29 29 0a 09 20 e ".html"))))..
10d50 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 (rmt:testst
10d60 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 ep-set-status! r
10d70 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 un-id test-id st
10d80 65 70 20 73 74 61 74 65 20 73 74 61 74 75 73 20 ep state status
10d90 28 6f 72 20 63 6f 6d 6d 65 6e 74 20 6d 73 67 29 (or comment msg)
10da0 20 6c 6f 67 66 69 6c 65 29 29 0a 09 20 20 20 20 logfile))..
10db0 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 (begin.. (d
10dc0 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
10dd0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
10de0 70 6f 72 74 2a 20 22 59 6f 75 20 6d 75 73 74 20 port* "You must
10df0 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 specify :state a
10e00 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 nd :status with
10e10 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 73 every call to -s
10e20 74 65 70 22 29 0a 09 20 20 20 20 20 20 28 65 78 tep").. (ex
10e30 69 74 20 36 29 29 29 29 29 29 0a 0a 28 69 66 20 it 6))))))..(if
10e40 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
10e50 73 74 65 70 22 29 0a 20 20 20 20 28 62 65 67 69 step"). (begi
10e60 6e 0a 20 20 20 20 20 20 28 6d 65 67 61 74 65 73 n. (megates
10e70 74 3a 73 74 65 70 20 0a 20 20 20 20 20 20 20 28 t:step . (
10e80 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
10e90 74 65 70 22 29 0a 20 20 20 20 20 20 20 28 6f 72 tep"). (or
10ea0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
10eb0 2d 73 74 61 74 65 22 29 28 61 72 67 73 3a 67 65 -state")(args:ge
10ec0 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 t-arg ":state"))
10ed0 0a 20 20 20 20 20 20 20 28 6f 72 20 28 61 72 67 . (or (arg
10ee0 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 s:get-arg "-stat
10ef0 75 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 us")(args:get-ar
10f00 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a 20 20 g ":status")).
10f10 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
10f20 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a 20 20 rg "-setlog").
10f30 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
10f40 72 67 20 22 2d 6d 22 29 29 0a 20 20 20 20 20 20 rg "-m")).
10f50 3b 3b 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 ;; (if db (sqlit
10f60 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
10f70 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
10f80 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
10f90 29 29 0a 20 20 20 20 0a 28 69 66 20 28 6f 72 20 )). .(if (or
10fa0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
10fb0 73 65 74 6c 6f 67 22 29 20 20 20 20 20 20 20 3b setlog") ;
10fc0 3b 20 73 69 6e 63 65 20 73 65 74 74 69 6e 67 20 ; since setting
10fd0 75 70 20 69 73 20 73 6f 20 63 6f 73 74 6c 79 20 up is so costly
10fe0 6c 65 74 73 20 70 69 67 67 79 62 61 63 6b 20 6f lets piggyback o
10ff0 6e 20 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 09 n -test-status..
11000 3b 3b 20 20 20 20 20 28 6e 6f 74 20 28 61 72 67 ;; (not (arg
11010 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 s:get-arg "-step
11020 22 29 29 29 20 20 3b 3b 20 2d 73 65 74 6c 6f 67 "))) ;; -setlog
11030 20 6d 61 79 20 68 61 76 65 20 62 65 65 6e 20 70 may have been p
11040 72 6f 63 65 73 73 65 64 20 61 6c 72 65 61 64 79 rocessed already
11050 20 69 6e 20 74 68 65 20 22 2d 73 74 65 70 22 20 in the "-step"
11060 70 72 65 76 69 6f 75 73 0a 09 3b 3b 20 20 20 20 previous..;;
11070 20 4e 45 57 20 50 4f 4c 49 43 59 20 2d 20 2d 73 NEW POLICY - -s
11080 65 74 6c 6f 67 20 73 65 74 73 20 74 65 73 74 20 etlog sets test
11090 6f 76 65 72 61 6c 6c 20 6c 6f 67 20 6f 6e 20 65 overall log on e
110a0 76 65 72 79 20 63 61 6c 6c 2e 0a 09 28 61 72 67 very call...(arg
110b0 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
110c0 74 6f 70 6c 6f 67 22 29 0a 09 28 61 72 67 73 3a toplog")..(args:
110d0 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 get-arg "-test-s
110e0 74 61 74 75 73 22 29 0a 09 28 61 72 67 73 3a 67 tatus")..(args:g
110f0 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 6c et-arg "-set-val
11100 75 65 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 ues")..(args:get
11110 2d 61 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 74 -arg "-load-test
11120 2d 64 61 74 61 22 29 0a 09 28 61 72 67 73 3a 67 -data")..(args:g
11130 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 et-arg "-runstep
11140 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
11150 67 20 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 g "-summarize-it
11160 65 6d 73 22 29 29 0a 20 20 20 20 28 69 66 20 28 ems")). (if (
11170 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f not (getenv "MT_
11180 43 4d 44 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 CMDINFO"))..(beg
11190 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 in.. (debug:pri
111a0 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
111b0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d ult-log-port* "M
111c0 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 T_CMDINFO env va
111d0 72 20 6e 6f 74 20 73 65 74 2c 20 63 6f 6d 6d 61 r not set, comma
111e0 6e 64 73 20 2d 74 65 73 74 2d 73 74 61 74 75 73 nds -test-status
111f0 2c 20 2d 72 75 6e 73 74 65 70 20 61 6e 64 20 2d , -runstep and -
11200 73 65 74 6c 6f 67 20 6d 75 73 74 20 62 65 20 63 setlog must be c
11210 61 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 alled *inside* a
11220 20 6d 65 67 61 74 65 73 74 20 65 6e 76 69 72 6f megatest enviro
11230 6e 6d 65 6e 74 21 22 29 0a 09 20 20 28 65 78 69 nment!").. (exi
11240 74 20 35 29 29 0a 09 28 6c 65 74 2a 20 28 28 73 t 5))..(let* ((s
11250 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 tartingdir (curr
11260 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a ent-directory)).
11270 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f . (cmdinfo
11280 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d (common:read-
11290 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 encoded-string (
112a0 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e getenv "MT_CMDIN
112b0 46 4f 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 FO"))).. (
112c0 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 transport (assoc
112d0 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 /default 'transp
112e0 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ort cmdinfo))..
112f0 20 20 20 20 20 20 28 74 65 73 74 70 61 74 68 20 (testpath
11300 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
11310 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 'testpath cmdin
11320 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 fo)).. (te
11330 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 st-name (assoc/d
11340 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d efault 'test-nam
11350 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 e cmdinfo))..
11360 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 (runscript (
11370 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
11380 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f unscript cmdinfo
11390 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 )).. (db-h
113a0 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 ost (assoc/def
113b0 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 ault 'db-host
113c0 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
113d0 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 (run-id (as
113e0 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
113f0 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 -id cmdinfo))
11400 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 .. (test-i
11410 64 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 d (assoc/defau
11420 6c 74 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d lt 'test-id cm
11430 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
11440 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f (itemdat (asso
11450 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 c/default 'itemd
11460 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 at cmdinfo))..
11470 20 20 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 (work-are
11480 61 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 a (assoc/default
11490 20 27 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 'work-area cmdi
114a0 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 nfo)).. (d
114b0 62 20 20 20 20 20 20 20 20 23 66 29 20 3b 3b 20 b #f) ;;
114c0 28 6f 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 (open-db))..
114d0 20 20 20 28 73 74 61 74 65 20 20 20 20 20 28 61 (state (a
114e0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
114f0 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 ate")).. (
11500 73 74 61 74 75 73 20 20 20 20 28 61 72 67 73 3a status (args:
11510 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 get-arg ":status
11520 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 65 ")).. (ste
11530 70 6e 61 6d 65 20 20 28 61 72 67 73 3a 67 65 74 pname (args:get
11540 2d 61 72 67 20 22 2d 73 74 65 70 22 29 29 29 0a -arg "-step"))).
11550 09 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 . (if (not (lau
11560 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 20 nch:setup))..
11570 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 (begin...(deb
11580 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
11590 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 ult-log-port* "F
115a0 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 ailed to setup,
115b0 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 69 exiting")...(exi
115c0 74 20 31 29 29 29 0a 0a 09 20 20 28 69 66 20 28 t 1)))... (if (
115d0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
115e0 75 6e 73 74 65 70 22 29 28 64 65 62 75 67 3a 70 unstep")(debug:p
115f0 72 69 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 rint-info 1 *def
11600 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
11610 52 75 6e 6e 69 6e 67 20 2d 72 75 6e 73 74 65 70 Running -runstep
11620 2c 20 66 69 72 73 74 20 63 68 61 6e 67 65 20 74 , first change t
11630 6f 20 64 69 72 65 63 74 6f 72 79 20 22 20 77 6f o directory " wo
11640 72 6b 2d 61 72 65 61 29 29 0a 09 20 20 28 63 68 rk-area)).. (ch
11650 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 ange-directory w
11660 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 3b 3b 20 ork-area).. ;;
11670 63 61 6e 20 73 65 74 75 70 20 61 73 20 63 6c 69 can setup as cli
11680 65 6e 74 20 66 6f 72 20 73 65 72 76 65 72 20 6d ent for server m
11690 6f 64 65 20 6e 6f 77 0a 09 20 20 3b 3b 20 28 63 ode now.. ;; (c
116a0 6c 69 65 6e 74 3a 73 65 74 75 70 29 0a 0a 09 20 lient:setup)...
116b0 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
116c0 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 rg "-load-test-d
116d0 61 74 61 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 ata").. ;;
116e0 68 61 73 20 73 75 62 20 63 6f 6d 6d 61 6e 64 73 has sub commands
116f0 20 74 68 61 74 20 61 72 65 20 72 64 62 3a 0a 09 that are rdb:..
11700 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 ;; DO NOT
11710 70 75 74 20 74 68 69 73 20 6f 6e 65 20 69 6e 74 put this one int
11720 6f 20 65 69 74 68 65 72 20 72 6d 74 3a 20 6f 72 o either rmt: or
11730 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 0a open-run-close.
11740 09 20 20 20 20 20 20 28 74 64 62 3a 6c 6f 61 64 . (tdb:load
11750 2d 74 65 73 74 2d 64 61 74 61 20 72 75 6e 2d 69 -test-data run-i
11760 64 20 74 65 73 74 2d 69 64 29 29 0a 09 20 20 28 d test-id)).. (
11770 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
11780 20 22 2d 73 65 74 6c 6f 67 22 29 0a 09 20 20 20 "-setlog")..
11790 20 20 20 28 6c 65 74 20 28 28 6c 6f 67 66 6e 61 (let ((logfna
117a0 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 me (args:get-arg
117b0 20 22 2d 73 65 74 6c 6f 67 22 29 29 29 0a 09 09 "-setlog")))...
117c0 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f (rmt:test-set-lo
117d0 67 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 g! run-id test-i
117e0 64 20 6c 6f 67 66 6e 61 6d 65 29 29 29 0a 09 20 d logfname)))..
117f0 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
11800 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 rg "-set-toplog"
11810 29 0a 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e ).. ;; DO N
11820 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 OT run remote..
11830 20 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 (tests:test
11840 2d 73 65 74 2d 74 6f 70 6c 6f 67 21 20 72 75 6e -set-toplog! run
11850 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 28 61 -id test-name (a
11860 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
11870 74 2d 74 6f 70 6c 6f 67 22 29 29 29 0a 09 20 20 t-toplog")))..
11880 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
11890 67 20 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 g "-summarize-it
118a0 65 6d 73 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 ems").. ;;
118b0 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 DO NOT run remot
118c0 65 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 3a e.. (tests:
118d0 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 summarize-items
118e0 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 run-id test-id t
118f0 65 73 74 2d 6e 61 6d 65 20 23 74 29 29 20 3b 3b est-name #t)) ;;
11900 20 64 6f 20 66 6f 72 63 65 20 68 65 72 65 0a 09 do force here..
11910 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
11920 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a arg "-runstep").
11930 09 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c . (if (null
11940 3f 20 72 65 6d 61 72 67 73 29 0a 09 09 20 20 28 ? remargs)... (
11950 62 65 67 69 6e 0a 09 09 20 20 20 20 28 64 65 62 begin... (deb
11960 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
11970 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
11980 72 74 2a 20 22 6e 6f 74 68 69 6e 67 20 73 70 65 rt* "nothing spe
11990 63 69 66 69 65 64 20 74 6f 20 72 75 6e 21 22 29 cified to run!")
119a0 0a 09 09 20 20 20 20 28 69 66 20 64 62 20 28 73 ... (if db (s
119b0 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
119c0 20 64 62 29 29 0a 09 09 20 20 20 20 28 65 78 69 db))... (exi
119d0 74 20 36 29 29 0a 09 09 20 20 28 6c 65 74 2a 20 t 6))... (let*
119e0 28 28 73 74 65 70 6e 61 6d 65 20 20 20 28 61 72 ((stepname (ar
119f0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
11a00 73 74 65 70 22 29 29 0a 09 09 09 20 28 6c 6f 67 step")).... (log
11a10 70 72 6f 66 69 6c 65 20 28 61 72 67 73 3a 67 65 profile (args:ge
11a20 74 2d 61 72 67 20 22 2d 6c 6f 67 70 72 6f 22 29 t-arg "-logpro")
11a30 29 0a 09 09 09 20 28 6c 6f 67 66 69 6c 65 20 20 ).... (logfile
11a40 20 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 (conc stepname
11a50 20 22 2e 6c 6f 67 22 29 29 0a 09 09 09 20 28 63 ".log")).... (c
11a60 6d 64 20 20 20 20 20 20 20 20 28 69 66 20 28 6e md (if (n
11a70 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 23 66 ull? remargs) #f
11a80 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 (car remargs)))
11a90 0a 09 09 09 20 28 70 61 72 61 6d 73 20 20 20 20 .... (params
11aa0 20 28 69 66 20 63 6d 64 20 28 63 64 72 20 72 65 (if cmd (cdr re
11ab0 6d 61 72 67 73 29 20 27 28 29 29 29 0a 09 09 09 margs) '()))....
11ac0 20 28 65 78 69 74 73 74 61 74 20 20 20 23 66 29 (exitstat #f)
11ad0 0a 09 09 09 20 28 73 68 65 6c 6c 20 20 20 20 20 .... (shell
11ae0 20 28 6c 65 74 20 28 28 73 68 20 28 67 65 74 2d (let ((sh (get-
11af0 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
11b00 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 20 29 29 able "SHELL") ))
11b10 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ..... (if
11b20 73 68 20 0a 09 09 09 09 09 20 20 20 28 6c 61 73 sh ...... (las
11b30 74 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 t (string-split
11b40 73 68 20 22 2f 22 29 29 0a 09 09 09 09 09 20 20 sh "/"))......
11b50 20 22 62 61 73 68 22 29 29 29 0a 09 09 09 20 28 "bash"))).... (
11b60 72 65 64 69 72 20 20 20 20 20 20 28 63 61 73 65 redir (case
11b70 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
11b80 20 73 68 65 6c 6c 29 0a 09 09 09 09 20 20 20 20 shell).....
11b90 20 20 20 28 28 74 63 73 68 20 63 73 68 20 6b 73 ((tcsh csh ks
11ba0 68 29 20 20 20 20 22 3e 26 22 29 0a 09 09 09 09 h) ">&").....
11bb0 20 20 20 20 20 20 20 28 28 7a 73 68 20 62 61 73 ((zsh bas
11bc0 68 20 73 68 20 61 73 68 29 20 22 32 3e 26 31 20 h sh ash) "2>&1
11bd0 3e 22 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 >")..... (
11be0 65 6c 73 65 20 22 3e 26 22 29 29 29 0a 09 09 09 else ">&")))....
11bf0 20 28 66 75 6c 6c 63 6d 64 20 20 20 20 28 63 6f (fullcmd (co
11c00 6e 63 20 22 28 22 20 28 73 74 72 69 6e 67 2d 69 nc "(" (string-i
11c10 6e 74 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 ntersperse .....
11c20 09 09 28 63 6f 6e 73 20 63 6d 64 20 70 61 72 61 ..(cons cmd para
11c30 6d 73 29 20 22 20 22 29 0a 09 09 09 09 09 20 20 ms) " ")......
11c40 20 22 29 20 22 20 72 65 64 69 72 20 22 20 22 20 ") " redir " "
11c50 6c 6f 67 66 69 6c 65 29 29 29 0a 09 09 20 20 20 logfile)))...
11c60 20 3b 3b 20 6d 61 72 6b 20 74 68 65 20 73 74 61 ;; mark the sta
11c70 72 74 20 6f 66 20 74 68 65 20 74 65 73 74 0a 09 rt of the test..
11c80 09 20 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 . (rmt:testst
11c90 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 ep-set-status! r
11ca0 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 un-id test-id st
11cb0 65 70 6e 61 6d 65 20 22 73 74 61 72 74 22 20 22 epname "start" "
11cc0 6e 2f 61 22 20 28 61 72 67 73 3a 67 65 74 2d 61 n/a" (args:get-a
11cd0 72 67 20 22 2d 6d 22 29 20 6c 6f 67 66 69 6c 65 rg "-m") logfile
11ce0 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 74 )... ;; run t
11cf0 68 65 20 74 65 73 74 20 73 74 65 70 0a 09 09 20 he test step...
11d00 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
11d10 69 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d info 2 *default-
11d20 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 75 6e 6e 69 log-port* "Runni
11d30 6e 67 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 ng \"" fullcmd "
11d40 5c 22 20 69 6e 20 64 69 72 65 63 74 6f 72 79 20 \" in directory
11d50 5c 22 22 20 73 74 61 72 74 69 6e 67 64 69 72 29 \"" startingdir)
11d60 0a 09 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 ... (change-d
11d70 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e irectory startin
11d80 67 64 69 72 29 0a 09 09 20 20 20 20 28 73 65 74 gdir)... (set
11d90 21 20 65 78 69 74 73 74 61 74 20 28 73 79 73 74 ! exitstat (syst
11da0 65 6d 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 20 em fullcmd))...
11db0 20 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c (set! *global
11dc0 65 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 74 exitstatus* exit
11dd0 73 74 61 74 29 0a 09 09 20 20 20 20 3b 3b 20 28 stat)... ;; (
11de0 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
11df0 20 74 65 73 74 70 61 74 68 29 0a 09 09 20 20 20 testpath)...
11e00 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 ;; run logpro i
11e10 66 20 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b 20 f applicable ;;
11e20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c 73 (process-run "ls
11e30 22 20 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20 22 " (list "/foo" "
11e40 32 3e 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67 22 2>&1" "blah.log"
11e50 29 29 0a 09 09 20 20 20 20 28 69 66 20 6c 6f 67 ))... (if log
11e60 70 72 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74 2a profile....(let*
11e70 20 28 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 28 ((htmllogfile (
11e80 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e conc stepname ".
11e90 68 74 6d 6c 22 29 29 0a 09 09 09 20 20 20 20 20 html"))....
11ea0 20 20 28 6f 6c 64 65 78 69 74 73 74 61 74 20 65 (oldexitstat e
11eb0 78 69 74 73 74 61 74 29 0a 09 09 09 20 20 20 20 xitstat)....
11ec0 20 20 20 28 63 6d 64 20 20 20 20 20 20 20 20 20 (cmd
11ed0 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
11ee0 72 73 65 20 28 6c 69 73 74 20 22 6c 6f 67 70 72 rse (list "logpr
11ef0 6f 22 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68 74 o" logprofile ht
11f00 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c 6f mllogfile "<" lo
11f10 67 66 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63 20 gfile ">" (conc
11f20 73 74 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70 72 stepname "_logpr
11f30 6f 2e 6c 6f 67 22 29 29 20 22 20 22 29 29 29 0a o.log")) " "))).
11f40 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
11f50 74 2d 69 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c t-info 2 *defaul
11f60 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 75 6e t-log-port* "run
11f70 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 ning \"" cmd "\"
11f80 22 29 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d ").... (change-
11f90 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 directory starti
11fa0 6e 67 64 69 72 29 0a 09 09 09 20 20 28 73 65 74 ngdir).... (set
11fb0 21 20 65 78 69 74 73 74 61 74 20 28 73 79 73 74 ! exitstat (syst
11fc0 65 6d 20 63 6d 64 29 29 0a 09 09 09 20 20 28 73 em cmd)).... (s
11fd0 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 et! *globalexits
11fe0 74 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 tatus* exitstat)
11ff0 20 3b 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 ;; no necessary
12000 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 .... (change-di
12010 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 rectory testpath
12020 29 0a 09 09 09 20 20 28 72 6d 74 3a 74 65 73 74 ).... (rmt:test
12030 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 -set-log! run-id
12040 20 74 65 73 74 2d 69 64 20 68 74 6d 6c 6c 6f 67 test-id htmllog
12050 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 28 6c file)))... (l
12060 65 74 20 28 28 6d 73 67 20 28 61 72 67 73 3a 67 et ((msg (args:g
12070 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 29 0a 09 et-arg "-m")))..
12080 09 20 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 . (rmt:test
12090 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
120a0 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
120b0 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 stepname "end" e
120c0 78 69 74 73 74 61 74 20 6d 73 67 20 6c 6f 67 66 xitstat msg logf
120d0 69 6c 65 29 29 0a 09 09 20 20 20 20 29 29 29 0a ile))... ))).
120e0 09 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 . (if (or (args
120f0 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d :get-arg "-test-
12100 73 74 61 74 75 73 22 29 0a 09 09 20 20 28 61 72 status")... (ar
12110 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
12120 2d 76 61 6c 75 65 73 22 29 29 0a 09 20 20 20 20 -values"))..
12130 20 20 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 (let ((newstat
12140 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e us (cond.....((n
12150 75 6d 62 65 72 3f 20 73 74 61 74 75 73 29 20 20 umber? status)
12160 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f (if (equal?
12170 20 73 74 61 74 75 73 20 30 29 20 22 50 41 53 53 status 0) "PASS
12180 22 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 " "FAIL")).....(
12190 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 74 (and (string? st
121a0 61 74 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 atus).....
121b0 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
121c0 73 74 61 74 75 73 29 29 28 69 66 20 28 65 71 75 status))(if (equ
121d0 61 6c 3f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d al? (string->num
121e0 62 65 72 20 73 74 61 74 75 73 29 20 30 29 20 22 ber status) 0) "
121f0 50 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 PASS" "FAIL"))..
12200 09 09 09 28 65 6c 73 65 20 73 74 61 74 75 73 29 ...(else status)
12210 29 29 0a 09 09 20 20 20 20 3b 3b 20 74 72 61 6e ))... ;; tran
12220 73 66 65 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 sfer relevant ke
12230 79 73 20 69 6e 74 6f 20 61 20 68 61 73 68 20 74 ys into a hash t
12240 6f 20 62 65 20 70 61 73 73 65 64 20 74 6f 20 74 o be passed to t
12250 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a est-set-status!.
12260 09 09 20 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 .. ;; could u
12270 73 65 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 se an assoc list
12280 20 49 20 67 75 65 73 73 2e 20 0a 09 09 20 20 20 I guess. ...
12290 20 28 6f 74 68 65 72 64 61 74 61 20 28 6c 65 74 (otherdata (let
122a0 20 28 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 ((res (make-has
122b0 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 09 20 h-table))).....
122c0 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
122d0 61 20 28 6b 65 79 29 0a 09 09 09 09 09 20 20 20 a (key)......
122e0 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
122f0 61 72 67 20 6b 65 79 29 0a 09 09 09 09 09 09 20 arg key).......
12300 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
12310 20 72 65 73 20 6b 65 79 20 28 61 72 67 73 3a 67 res key (args:g
12320 65 74 2d 61 72 67 20 6b 65 79 29 29 29 29 0a 09 et-arg key))))..
12330 09 09 09 09 20 20 20 28 6c 69 73 74 20 22 3a 76 .... (list ":v
12340 61 6c 75 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 alue" ":tol" ":e
12350 78 70 65 63 74 65 64 22 20 22 3a 66 69 72 73 74 xpected" ":first
12360 5f 65 72 72 22 20 22 3a 66 69 72 73 74 5f 77 61 _err" ":first_wa
12370 72 6e 22 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 rn" ":units" ":c
12380 61 74 65 67 6f 72 79 22 20 22 3a 76 61 72 69 61 ategory" ":varia
12390 62 6c 65 22 29 29 0a 09 09 09 09 20 72 65 73 29 ble"))..... res)
123a0 29 29 0a 09 09 28 69 66 20 28 61 6e 64 20 28 61 ))...(if (and (a
123b0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
123c0 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 09 20 st-status")....
123d0 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 65 29 0a (or (not state).
123e0 09 09 09 20 20 20 20 20 28 6e 6f 74 20 73 74 61 ... (not sta
123f0 74 75 73 29 29 29 0a 09 09 20 20 20 20 28 62 65 tus)))... (be
12400 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 gin... (deb
12410 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
12420 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
12430 72 74 2a 20 22 59 6f 75 20 6d 75 73 74 20 73 70 rt* "You must sp
12440 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 ecify :state and
12450 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 65 76 :status with ev
12460 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 74 65 73 ery call to -tes
12470 74 2d 73 74 61 74 75 73 5c 6e 22 20 68 65 6c 70 t-status\n" help
12480 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 73 )... (if (s
12490 71 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f qlite3:database?
124a0 20 64 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e db)(sqlite3:fin
124b0 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 09 20 20 alize! db))...
124c0 20 20 20 20 28 65 78 69 74 20 36 29 29 29 0a 09 (exit 6)))..
124d0 09 28 6c 65 74 2a 20 28 28 6d 73 67 20 20 20 20 .(let* ((msg
124e0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
124f0 6d 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 6e m"))... (n
12500 75 6d 6f 74 68 20 28 6c 65 6e 67 74 68 20 28 68 umoth (length (h
12510 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 6f ash-table-keys o
12520 74 68 65 72 64 61 74 61 29 29 29 29 0a 09 09 20 therdata))))...
12530 20 3b 3b 20 43 6f 6e 76 65 72 74 20 74 6f 20 72 ;; Convert to r
12540 70 63 20 69 6e 73 69 64 65 20 74 68 65 20 74 65 pc inside the te
12550 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 sts:test-set-sta
12560 74 75 73 21 20 63 61 6c 6c 2c 20 6e 6f 74 20 68 tus! call, not h
12570 65 72 65 0a 09 09 20 20 28 74 65 73 74 73 3a 74 ere... (tests:t
12580 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
12590 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 run-id test-id s
125a0 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 20 6d tate newstatus m
125b0 73 67 20 6f 74 68 65 72 64 61 74 61 20 77 6f 72 sg otherdata wor
125c0 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 k-area: work-are
125d0 61 29 29 29 29 0a 09 20 20 28 69 66 20 28 73 71 a)))).. (if (sq
125e0 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 lite3:database?
125f0 64 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 db)(sqlite3:fina
12600 6c 69 7a 65 21 20 64 62 29 29 0a 09 20 20 28 73 lize! db)).. (s
12610 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
12620 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d g* #t))))..;;===
12630 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12640 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12650 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12660 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12670 3d 3d 3d 0a 3b 3b 20 56 61 72 69 6f 75 73 20 68 ===.;; Various h
12680 65 6c 70 65 72 20 63 6f 6d 6d 61 6e 64 73 20 63 elper commands c
12690 61 6e 20 67 6f 20 62 65 6c 6f 77 20 68 65 72 65 an go below here
126a0 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
126b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
126c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
126d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
126e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
126f0 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
12700 20 22 2d 73 68 6f 77 6b 65 79 73 22 29 0a 20 20 "-showkeys").
12710 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
12720 61 72 67 20 22 2d 73 68 6f 77 2d 6b 65 79 73 22 arg "-show-keys"
12730 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 64 62 )). (let ((db
12740 20 23 66 29 0a 09 20 20 28 6b 65 79 73 20 23 66 #f).. (keys #f
12750 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f )). (if (no
12760 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 t (launch:setup)
12770 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 ).. (begin..
12780 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
12790 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
127a0 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 t* "Failed to se
127b0 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 tup, exiting")..
127c0 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
127d0 20 20 20 20 20 28 73 65 74 21 20 6b 65 79 73 20 (set! keys
127e0 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 20 (rmt:get-keys))
127f0 3b 3b 20 20 64 62 29 29 0a 20 20 20 20 20 20 28 ;; db)). (
12800 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 2a 64 debug:print 1 *d
12810 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
12820 20 22 4b 65 79 73 3a 20 22 20 28 73 74 72 69 6e "Keys: " (strin
12830 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 g-intersperse ke
12840 79 73 20 22 2c 20 22 29 29 0a 20 20 20 20 20 20 ys ", ")).
12850 28 69 66 20 28 73 71 6c 69 74 65 33 3a 64 61 74 (if (sqlite3:dat
12860 61 62 61 73 65 3f 20 64 62 29 28 73 71 6c 69 74 abase? db)(sqlit
12870 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
12880 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
12890 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
128a0 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
128b0 74 2d 61 72 67 20 22 2d 67 75 69 22 29 0a 20 20 t-arg "-gui").
128c0 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
128d0 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
128e0 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
128f0 20 22 4c 6f 6f 6b 20 61 74 20 74 68 65 20 64 61 "Look at the da
12900 73 68 62 6f 61 72 64 20 66 6f 72 20 6e 6f 77 22 shboard for now"
12910 29 0a 20 20 20 20 20 20 3b 3b 20 28 6d 65 67 61 ). ;; (mega
12920 74 65 73 74 2d 67 75 69 29 0a 20 20 20 20 20 20 test-gui).
12930 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
12940 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
12950 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
12960 63 72 65 61 74 65 2d 6d 65 67 61 74 65 73 74 2d create-megatest-
12970 61 72 65 61 22 29 0a 20 20 20 20 28 62 65 67 69 area"). (begi
12980 6e 0a 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d n. (genexam
12990 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2e ple:mk-megatest.
129a0 63 6f 6e 66 69 67 29 0a 20 20 20 20 20 20 28 73 config). (s
129b0 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
129c0 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
129d0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 72 rgs:get-arg "-cr
129e0 65 61 74 65 2d 74 65 73 74 22 29 0a 20 20 20 20 eate-test").
129f0 28 6c 65 74 20 28 28 74 65 73 74 6e 61 6d 65 20 (let ((testname
12a00 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
12a10 63 72 65 61 74 65 2d 74 65 73 74 22 29 29 29 0a create-test"))).
12a20 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c (genexampl
12a30 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2d 74 65 e:mk-megatest-te
12a40 73 74 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 20 st testname).
12a50 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
12a60 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b ething* #t)))..;
12a70 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
12a80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12aa0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ab0 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 =======.;; Updat
12ac0 65 20 74 68 65 20 64 61 74 61 62 61 73 65 20 73 e the database s
12ad0 63 68 65 6d 61 2c 20 63 6c 65 61 6e 20 75 70 20 chema, clean up
12ae0 74 68 65 20 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d the db.;;=======
12af0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
12b30 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
12b40 72 67 20 22 2d 72 65 62 75 69 6c 64 2d 64 62 22 rg "-rebuild-db"
12b50 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
12b60 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 (if (not (lau
12b70 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 nch:setup)).. (
12b80 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 begin.. (debu
12b90 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
12ba0 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 lt-log-port* "Fa
12bb0 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 iled to setup, e
12bc0 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 xiting") .. (
12bd0 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 exit 1))).
12be0 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 ;; keep this one
12bf0 20 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 6f 70 local. (op
12c00 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 70 61 74 en-run-close pat
12c10 63 68 2d 64 62 20 23 66 29 0a 20 20 20 20 20 20 ch-db #f).
12c20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
12c30 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
12c40 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
12c50 63 6c 65 61 6e 75 70 2d 64 62 22 29 0a 20 20 20 cleanup-db").
12c60 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 (begin. (i
12c70 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
12c80 65 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e etup)).. (begin
12c90 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
12ca0 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
12cb0 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 g-port* "Failed
12cc0 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
12cd0 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 g") .. (exit
12ce0 31 29 29 29 0a 20 20 20 20 20 20 28 6c 65 74 20 1))). (let
12cf0 28 28 64 62 73 74 72 75 63 74 20 28 64 62 3a 73 ((dbstruct (db:s
12d00 65 74 75 70 20 2a 74 6f 70 70 61 74 68 2a 29 29 etup *toppath*))
12d10 29 0a 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f ). (commo
12d20 6e 3a 63 6c 65 61 6e 75 70 2d 64 62 20 64 62 73 n:cleanup-db dbs
12d30 74 72 75 63 74 29 29 0a 20 20 20 20 20 20 28 73 truct)). (s
12d40 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
12d50 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
12d60 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 61 rgs:get-arg "-ma
12d70 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 22 29 rk-incompletes")
12d80 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
12d90 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e (if (not (laun
12da0 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 ch:setup)).. (b
12db0 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 egin.. (debug
12dc0 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
12dd0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
12de0 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
12df0 69 74 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 iting").. (ex
12e00 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 6f it 1))). (o
12e10 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 pen-run-close db
12e20 3a 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 :find-and-mark-i
12e30 6e 63 6f 6d 70 6c 65 74 65 20 23 66 29 0a 20 20 ncomplete #f).
12e40 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
12e50 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
12e60 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
12e70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ea0 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 ========.;; Upda
12eb0 74 65 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 te the tests met
12ec0 61 20 64 61 74 61 20 66 72 6f 6d 20 74 68 65 20 a data from the
12ed0 74 65 73 74 63 6f 6e 66 69 67 20 66 69 6c 65 73 testconfig files
12ee0 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
12ef0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f20 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
12f30 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 args:get-arg "-u
12f40 70 64 61 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 pdate-meta").
12f50 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 (begin. (i
12f60 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
12f70 65 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e etup)).. (begin
12f80 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
12f90 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
12fa0 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 g-port* "Failed
12fb0 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
12fc0 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 g") .. (exit
12fd0 31 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6e 6f 1))). ;; no
12fe0 77 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 64 w can find our d
12ff0 62 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 b. ;; keep
13000 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 this one local.
13010 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
13020 6c 6f 73 65 20 72 75 6e 73 3a 75 70 64 61 74 65 lose runs:update
13030 2d 61 6c 6c 2d 74 65 73 74 5f 6d 65 74 61 20 23 -all-test_meta #
13040 66 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a f). (set! *
13050 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
13060 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
13070 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13080 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13090 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
130a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
130b0 20 53 74 61 72 74 20 61 20 72 65 70 6c 0a 3b 3b Start a repl.;;
130c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
130d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
130e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
130f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13100 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 66 61 6b 65 6f ======..;; fakeo
13110 75 74 20 72 65 61 64 6c 69 6e 65 0a 28 69 6e 63 ut readline.(inc
13120 6c 75 64 65 20 22 72 65 61 64 6c 69 6e 65 2d 66 lude "readline-f
13130 69 78 2e 73 63 6d 22 29 0a 0a 28 69 66 20 28 6f ix.scm")..(if (o
13140 72 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 r (getenv "MT_RU
13150 4e 53 43 52 49 50 54 22 29 0a 09 28 61 72 67 73 NSCRIPT")..(args
13160 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 :get-arg "-repl"
13170 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
13180 20 22 2d 6c 6f 61 64 22 29 29 0a 20 20 20 20 28 "-load")). (
13190 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 let* ((toppath (
131a0 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 launch:setup))..
131b0 20 20 20 28 64 62 73 74 72 75 63 74 20 28 69 66 (dbstruct (if
131c0 20 28 61 6e 64 20 74 6f 70 70 61 74 68 0a 20 20 (and toppath.
131d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
131e0 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d (com
131f0 6d 6f 6e 3a 6f 6e 2d 68 6f 6d 65 68 6f 73 74 3f mon:on-homehost?
13200 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
13210 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a (db:
13220 73 65 74 75 70 29 0a 20 20 20 20 20 20 20 20 20 setup).
13230 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13240 23 66 29 29 29 20 3b 3b 20 6d 61 6b 65 2d 64 62 #f))) ;; make-db
13250 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 68 3a r:dbstruct path:
13260 20 74 6f 70 70 61 74 68 20 6c 6f 63 61 6c 3a 20 toppath local:
13270 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
13280 6c 6f 63 61 6c 22 29 29 20 23 66 29 29 29 0a 20 local")) #f))).
13290 20 20 20 20 20 28 69 66 20 2a 74 6f 70 70 61 74 (if *toppat
132a0 68 2a 0a 09 20 20 28 63 6f 6e 64 0a 09 20 20 20 h*.. (cond..
132b0 28 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e ((getenv "MT_RUN
132c0 53 43 52 49 50 54 22 29 0a 09 20 20 20 20 3b 3b SCRIPT").. ;;
132d0 20 48 6f 77 20 74 6f 20 72 75 6e 20 6d 65 67 61 How to run mega
132e0 74 65 73 74 20 73 63 72 69 70 74 73 0a 09 20 20 test scripts..
132f0 20 20 3b 3b 0a 09 20 20 20 20 3b 3b 20 23 21 2f ;;.. ;; #!/
13300 62 69 6e 2f 62 61 73 68 0a 09 20 20 20 20 3b 3b bin/bash.. ;;
13310 0a 09 20 20 20 20 3b 3b 20 65 78 70 6f 72 74 20 .. ;; export
13320 4d 54 5f 52 55 4e 53 43 52 49 50 54 3d 79 65 73 MT_RUNSCRIPT=yes
13330 0a 09 20 20 20 20 3b 3b 20 6d 65 67 61 74 65 73 .. ;; megates
13340 74 20 3c 3c 20 45 4f 46 0a 09 20 20 20 20 3b 3b t << EOF.. ;;
13350 20 28 70 72 69 6e 74 20 22 48 65 6c 6c 6f 20 77 (print "Hello w
13360 6f 72 6c 64 22 29 0a 09 20 20 20 20 3b 3b 20 28 orld").. ;; (
13370 65 78 69 74 29 0a 09 20 20 20 20 3b 3b 20 45 4f exit).. ;; EO
13380 46 0a 0a 09 20 20 20 20 28 72 65 70 6c 29 29 0a F... (repl)).
13390 09 20 20 20 28 65 6c 73 65 0a 09 20 20 20 20 28 . (else.. (
133a0 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 73 65 begin.. (se
133b0 74 21 20 2a 64 62 2a 20 64 62 73 74 72 75 63 74 t! *db* dbstruct
133c0 29 0a 09 20 20 20 20 20 20 28 69 6d 70 6f 72 74 ).. (import
133d0 20 65 78 74 72 61 73 29 20 3b 3b 20 6d 69 67 68 extras) ;; migh
133e0 74 20 6e 6f 74 20 62 65 20 6e 65 65 64 65 64 0a t not be needed.
133f0 09 20 20 20 20 20 20 3b 3b 20 28 69 6d 70 6f 72 . ;; (impor
13400 74 20 63 73 69 29 0a 09 20 20 20 20 20 20 28 69 t csi).. (i
13410 6d 70 6f 72 74 20 72 65 61 64 6c 69 6e 65 29 0a mport readline).
13420 09 20 20 20 20 20 20 28 69 6d 70 6f 72 74 20 61 . (import a
13430 70 72 6f 70 6f 73 29 0a 09 20 20 20 20 20 20 3b propos).. ;
13440 3b 20 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 ; (import (prefi
13450 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 x sqlite3 sqlite
13460 33 3a 29 29 20 3b 3b 20 64 6f 65 73 6e 27 74 20 3:)) ;; doesn't
13470 77 6f 72 6b 20 2e 2e 2e 0a 0a 09 20 20 20 20 20 work ......
13480 20 28 69 66 20 2a 75 73 65 2d 6e 65 77 2d 72 65 (if *use-new-re
13490 61 64 6c 69 6e 65 2a 0a 09 09 20 20 28 62 65 67 adline*... (beg
134a0 69 6e 0a 09 09 20 20 20 20 28 69 6e 73 74 61 6c in... (instal
134b0 6c 2d 68 69 73 74 6f 72 79 2d 66 69 6c 65 20 28 l-history-file (
134c0 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
134d0 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 variable "HOME")
134e0 20 22 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 74 ".megatest_hist
134f0 6f 72 79 22 29 20 3b 3b 20 20 5b 68 6f 6d 65 64 ory") ;; [homed
13500 69 72 5d 20 5b 66 69 6c 65 6e 61 6d 65 5d 20 5b ir] [filename] [
13510 6e 6c 69 6e 65 73 5d 29 0a 09 09 20 20 20 20 28 nlines])... (
13520 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f current-input-po
13530 72 74 20 28 6d 61 6b 65 2d 72 65 61 64 6c 69 6e rt (make-readlin
13540 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 65 73 74 e-port "megatest
13550 3e 20 22 29 29 29 0a 09 09 20 20 28 62 65 67 69 > ")))... (begi
13560 6e 0a 09 09 20 20 20 20 28 67 6e 75 2d 68 69 73 n... (gnu-his
13570 74 6f 72 79 2d 69 6e 73 74 61 6c 6c 2d 66 69 6c tory-install-fil
13580 65 2d 6d 61 6e 61 67 65 72 0a 09 09 20 20 20 20 e-manager...
13590 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 0a (string-append.
135a0 09 09 20 20 20 20 20 20 28 6f 72 20 28 67 65 74 .. (or (get
135b0 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
135c0 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2e iable "HOME") ".
135d0 22 29 20 22 2f 2e 6d 65 67 61 74 65 73 74 5f 68 ") "/.megatest_h
135e0 69 73 74 6f 72 79 22 29 29 0a 09 09 20 20 20 20 istory"))...
135f0 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 (current-input-p
13600 6f 72 74 20 28 6d 61 6b 65 2d 67 6e 75 2d 72 65 ort (make-gnu-re
13610 61 64 6c 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 adline-port "meg
13620 61 74 65 73 74 3e 20 22 29 29 29 29 0a 09 20 20 atest> "))))..
13630 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 (if (args:ge
13640 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 29 0a 09 t-arg "-repl")..
13650 09 20 20 28 72 65 70 6c 29 0a 09 09 20 20 28 6c . (repl)... (l
13660 6f 61 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 oad (args:get-ar
13670 67 20 22 2d 6c 6f 61 64 22 29 29 29 0a 09 20 20 g "-load")))..
13680 20 20 20 20 3b 3b 20 28 64 62 3a 63 6c 6f 73 65 ;; (db:close
13690 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 29 20 3c -all dbstruct) <
136a0 3d 20 74 61 6b 65 6e 20 63 61 72 65 20 6f 66 20 = taken care of
136b0 62 79 20 6f 6e 2d 65 78 69 74 20 63 61 6c 6c 0a by on-exit call.
136c0 09 20 20 20 20 20 20 29 0a 09 20 20 20 20 28 65 . ).. (e
136d0 78 69 74 29 29 29 0a 09 20 20 28 73 65 74 21 20 xit))).. (set!
136e0 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
136f0 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d t))))..;;=======
13700 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13710 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13720 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13730 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
13740 3b 3b 20 57 61 69 74 20 6f 6e 20 61 20 72 75 6e ;; Wait on a run
13750 20 74 6f 20 63 6f 6d 70 6c 65 74 65 0a 3b 3b 3d to complete.;;=
13760 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13770 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13780 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13790 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
137a0 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 6e 64 20 =====..(if (and
137b0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
137c0 72 75 6e 2d 77 61 69 74 22 29 0a 09 20 28 6e 6f run-wait").. (no
137d0 74 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d t (or (args:get-
137e0 61 72 67 20 22 2d 72 75 6e 22 29 0a 09 09 20 20 arg "-run")...
137f0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
13800 72 75 6e 74 65 73 74 73 22 29 29 29 29 20 3b 3b runtests")))) ;;
13810 20 72 75 6e 2d 77 61 69 74 20 69 73 20 62 75 69 run-wait is bui
13820 6c 74 20 69 6e 74 6f 20 72 75 6e 74 65 73 74 73 lt into runtests
13830 20 6e 6f 77 0a 20 20 20 20 28 62 65 67 69 6e 0a now. (begin.
13840 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
13850 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 launch:setup))..
13860 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 (begin.. (d
13870 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
13880 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
13890 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 "Failed to setup
138a0 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 , exiting") ..
138b0 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 (exit 1))).
138c0 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 (operate-on '
138d0 72 75 6e 2d 77 61 69 74 29 0a 20 20 20 20 20 20 run-wait).
138e0 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
138f0 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 3b ing* #t)))..;; ;
13900 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 3b 3b 20 ; ;; redo me ;;
13910 4e 6f 74 20 63 6f 6e 76 65 72 74 65 64 20 74 6f Not converted to
13920 20 75 73 65 20 64 62 73 74 72 75 63 74 20 79 65 use dbstruct ye
13930 74 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 t.;; ;; ;; redo
13940 6d 65 20 3b 3b 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 me ;;.;; ;; ;; r
13950 65 64 6f 20 6d 65 20 28 69 66 20 28 61 72 67 73 edo me (if (args
13960 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e 76 65 :get-arg "-conve
13970 72 74 2d 74 6f 2d 6e 6f 72 6d 22 29 0a 3b 3b 20 rt-to-norm").;;
13980 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
13990 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 (let* ((toppat
139a0 68 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e h (setup-for-run
139b0 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f )).;; ;; ;; redo
139c0 20 6d 65 20 09 20 20 20 28 64 62 73 74 72 75 63 me . (dbstruc
139d0 74 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 6d t (if toppath (m
139e0 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 ake-dbr:dbstruct
139f0 20 70 61 74 68 3a 20 74 6f 70 70 61 74 68 20 6c path: toppath l
13a00 6f 63 61 6c 3a 20 23 74 29 29 29 29 0a 3b 3b 20 ocal: #t)))).;;
13a10 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
13a20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 3b (for-each .;
13a30 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
13a40 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
13a50 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 field).;; ;; ;;
13a60 72 65 64 6f 20 6d 65 20 09 20 28 6c 65 74 20 28 redo me . (let (
13a70 28 64 61 74 20 27 28 29 29 29 0a 3b 3b 20 3b 3b (dat '())).;; ;;
13a80 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
13a90 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
13aa0 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 0 *default-log
13ab0 2d 70 6f 72 74 2a 20 22 47 65 74 74 69 6e 67 20 -port* "Getting
13ac0 64 61 74 61 20 66 6f 72 20 66 69 65 6c 64 20 22 data for field "
13ad0 20 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b field).;; ;; ;;
13ae0 20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 73 71 redo me . (sq
13af0 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
13b00 6f 77 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f ow.;; ;; ;; redo
13b10 20 6d 65 20 09 20 20 20 20 28 6c 61 6d 62 64 61 me . (lambda
13b20 20 28 69 64 20 76 61 6c 29 0a 3b 3b 20 3b 3b 20 (id val).;; ;;
13b30 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 ;; redo me .
13b40 20 20 28 73 65 74 21 20 64 61 74 20 28 63 6f 6e (set! dat (con
13b50 73 20 28 6c 69 73 74 20 69 64 20 76 61 6c 29 20 s (list id val)
13b60 64 61 74 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 dat))).;; ;; ;;
13b70 72 65 64 6f 20 6d 65 20 09 20 20 20 20 28 64 62 redo me . (db
13b80 3a 67 65 74 2d 64 62 20 64 62 20 72 75 6e 2d 69 :get-db db run-i
13b90 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f d).;; ;; ;; redo
13ba0 20 6d 65 20 09 20 20 20 20 28 63 6f 6e 63 20 22 me . (conc "
13bb0 53 45 4c 45 43 54 20 69 64 2c 22 20 66 69 65 6c SELECT id," fiel
13bc0 64 20 22 20 46 52 4f 4d 20 74 65 73 74 73 3b 22 d " FROM tests;"
13bd0 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f )).;; ;; ;; redo
13be0 20 6d 65 20 09 20 20 20 28 64 65 62 75 67 3a 70 me . (debug:p
13bf0 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
13c00 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
13c10 66 6f 75 6e 64 20 22 20 28 6c 65 6e 67 74 68 20 found " (length
13c20 64 61 74 29 20 22 20 69 74 65 6d 73 20 66 6f 72 dat) " items for
13c30 20 66 69 65 6c 64 20 22 20 66 69 65 6c 64 29 0a field " field).
13c40 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
13c50 20 09 20 20 20 28 6c 65 74 20 28 28 71 72 79 20 . (let ((qry
13c60 28 73 71 6c 69 74 65 33 3a 70 72 65 70 61 72 65 (sqlite3:prepare
13c70 20 64 62 20 28 63 6f 6e 63 20 22 55 50 44 41 54 db (conc "UPDAT
13c80 45 20 74 65 73 74 73 20 53 45 54 20 22 20 66 69 E tests SET " fi
13c90 65 6c 64 20 22 3d 3f 20 57 48 45 52 45 20 69 64 eld "=? WHERE id
13ca0 3d 3f 3b 22 29 29 29 29 0a 3b 3b 20 3b 3b 20 3b =?;")))).;; ;; ;
13cb0 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 ; redo me .
13cc0 28 66 6f 72 2d 65 61 63 68 0a 3b 3b 20 3b 3b 20 (for-each.;; ;;
13cd0 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 ;; redo me .
13ce0 20 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 (lambda (item)
13cf0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13d00 65 20 09 09 28 6c 65 74 20 28 28 6e 65 77 76 61 e ..(let ((newva
13d10 6c 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 67 l ;; (sdb:qry 'g
13d20 65 74 69 64 20 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 etid .;; ;; ;; r
13d30 65 64 6f 20 6d 65 20 09 09 20 20 20 20 20 20 20 edo me ..
13d40 28 63 61 64 72 20 69 74 65 6d 29 29 29 20 3b 3b (cadr item))) ;;
13d50 20 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f ).;; ;; ;; redo
13d60 20 6d 65 20 09 09 20 20 28 69 66 20 28 6e 6f 74 me .. (if (not
13d70 20 28 65 71 75 61 6c 3f 20 6e 65 77 76 61 6c 20 (equal? newval
13d80 28 63 61 64 72 20 69 74 65 6d 29 29 29 0a 3b 3b (cadr item))).;;
13d90 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
13da0 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
13db0 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
13dc0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 ult-log-port* "C
13dd0 6f 6e 76 65 72 74 69 6e 67 20 22 20 28 63 61 64 onverting " (cad
13de0 72 20 69 74 65 6d 29 20 22 20 74 6f 20 22 20 6e r item) " to " n
13df0 65 77 76 61 6c 20 22 20 66 6f 72 20 74 65 73 74 ewval " for test
13e00 20 23 22 20 28 63 61 72 20 69 74 65 6d 29 29 29 #" (car item)))
13e10 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13e20 65 20 09 09 20 20 28 73 71 6c 69 74 65 33 3a 65 e .. (sqlite3:e
13e30 78 65 63 75 74 65 20 71 72 79 20 6e 65 77 76 61 xecute qry newva
13e40 6c 20 28 63 61 72 20 69 74 65 6d 29 29 29 29 0a l (car item)))).
13e50 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
13e60 20 09 20 20 20 20 20 20 64 61 74 29 0a 3b 3b 20 . dat).;;
13e70 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 ;; ;; redo me .
13e80 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e (sqlite3:fin
13e90 61 6c 69 7a 65 21 20 71 72 79 29 29 29 29 0a 3b alize! qry)))).;
13ea0 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
13eb0 20 20 20 20 20 20 20 28 64 62 3a 63 6c 6f 73 65 (db:close
13ec0 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 29 0a 3b -all dbstruct).;
13ed0 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
13ee0 20 20 20 20 20 20 20 28 6c 69 73 74 20 22 75 6e (list "un
13ef0 61 6d 65 22 20 22 72 75 6e 64 69 72 22 20 22 66 ame" "rundir" "f
13f00 69 6e 61 6c 5f 6c 6f 67 66 22 20 22 63 6f 6d 6d inal_logf" "comm
13f10 65 6e 74 22 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 ent")).;; ;; ;;
13f20 72 65 64 6f 20 6d 65 20 20 20 20 20 20 20 28 73 redo me (s
13f30 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
13f40 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
13f50 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 6d rgs:get-arg "-im
13f60 70 6f 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 port-megatest.db
13f70 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
13f80 20 20 20 20 28 64 62 3a 6d 75 6c 74 69 2d 64 62 (db:multi-db
13f90 2d 73 79 6e 63 20 0a 20 20 20 20 20 20 20 28 64 -sync . (d
13fa0 62 3a 73 65 74 75 70 29 0a 20 20 20 20 20 20 20 b:setup).
13fb0 27 6b 69 6c 6c 73 65 72 76 65 72 73 0a 20 20 20 'killservers.
13fc0 20 20 20 20 27 64 65 6a 75 6e 6b 0a 20 20 20 20 'dejunk.
13fd0 20 20 20 27 61 64 6a 2d 74 65 73 74 69 64 73 0a 'adj-testids.
13fe0 20 20 20 20 20 20 20 27 6f 6c 64 32 6e 65 77 0a 'old2new.
13ff0 20 20 20 20 20 20 20 3b 3b 20 27 6e 65 77 32 6f ;; 'new2o
14000 6c 64 0a 20 20 20 20 20 20 20 29 0a 20 20 20 20 ld. ).
14010 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
14020 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
14030 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
14040 22 2d 73 79 6e 63 2d 74 6f 2d 6d 65 67 61 74 65 "-sync-to-megate
14050 73 74 2e 64 62 22 29 0a 20 20 20 20 28 62 65 67 st.db"). (beg
14060 69 6e 0a 20 20 20 20 20 20 28 64 62 3a 6d 75 6c in. (db:mul
14070 74 69 2d 64 62 2d 73 79 6e 63 20 0a 20 20 20 20 ti-db-sync .
14080 20 20 20 28 64 62 3a 73 65 74 75 70 29 0a 20 20 (db:setup).
14090 20 20 20 20 20 27 6e 65 77 32 6f 6c 64 0a 20 20 'new2old.
140a0 20 20 20 20 20 29 0a 20 20 20 20 20 20 28 73 65 ). (se
140b0 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
140c0 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 * #t)))..(if (ar
140d0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 6e gs:get-arg "-gen
140e0 65 72 61 74 65 2d 68 74 6d 6c 22 29 0a 20 20 20 erate-html").
140f0 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 (let* ((toppath
14100 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
14110 29 0a 20 20 20 20 20 20 28 69 66 20 28 74 65 73 ). (if (tes
14120 74 73 3a 63 72 65 61 74 65 2d 68 74 6d 6c 2d 74 ts:create-html-t
14130 72 65 65 20 23 66 29 0a 20 20 20 20 20 20 20 20 ree #f).
14140 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
14150 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
14160 6f 67 2d 70 6f 72 74 2a 20 22 48 54 4d 4c 20 6f og-port* "HTML o
14170 75 74 70 75 74 20 63 72 65 61 74 65 64 20 69 6e utput created in
14180 20 22 20 74 6f 70 70 61 74 68 20 22 2f 6c 74 2f " toppath "/lt/
14190 72 75 6e 73 2d 69 6e 64 65 78 2e 68 74 6d 6c 22 runs-index.html"
141a0 29 0a 20 20 20 20 20 20 20 20 20 20 28 64 65 62 ). (deb
141b0 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
141c0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 ult-log-port* "F
141d0 61 69 6c 65 64 20 74 6f 20 63 72 65 61 74 65 20 ailed to create
141e0 48 54 4d 4c 20 6f 75 74 70 75 74 20 69 6e 20 22 HTML output in "
141f0 20 74 6f 70 70 61 74 68 20 22 2f 6c 74 2f 72 75 toppath "/lt/ru
14200 6e 73 2d 69 6e 64 65 78 2e 68 74 6d 6c 22 29 29 ns-index.html"))
14210 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
14220 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
14230 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
14240 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14250 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14260 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14270 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 ===========.;; E
14280 78 69 74 20 61 6e 64 20 63 6c 65 61 6e 20 75 70 xit and clean up
14290 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
142a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
142b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
142c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
142d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 0a 28 69 66 20 =========...(if
142e0 28 6e 6f 74 20 2a 64 69 64 73 6f 6d 65 74 68 69 (not *didsomethi
142f0 6e 67 2a 29 0a 20 20 20 20 28 64 65 62 75 67 3a ng*). (debug:
14300 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
14310 2d 6c 6f 67 2d 70 6f 72 74 2a 20 68 65 6c 70 29 -log-port* help)
14320 29 0a 0a 28 73 65 74 21 20 2a 74 69 6d 65 2d 74 )..(set! *time-t
14330 6f 2d 65 78 69 74 2a 20 23 74 29 0a 28 74 68 72 o-exit* #t).(thr
14340 65 61 64 2d 6a 6f 69 6e 21 20 2a 77 61 74 63 68 ead-join! *watch
14350 64 6f 67 2a 29 0a 0a 28 69 66 20 28 6e 6f 74 20 dog*)..(if (not
14360 28 65 71 3f 20 2a 67 6c 6f 62 61 6c 65 78 69 74 (eq? *globalexit
14370 73 74 61 74 75 73 2a 20 30 29 29 0a 20 20 20 20 status* 0)).
14380 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
14390 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 28 61 72 t-arg "-run")(ar
143a0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
143b0 74 65 73 74 73 22 29 28 61 72 67 73 3a 67 65 74 tests")(args:get
143c0 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 29 -arg "-runall"))
143d0 0a 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a . (begin.
143e0 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 (debu
143f0 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
14400 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 4f lt-log-port* "NO
14410 54 45 3a 20 53 75 62 70 72 6f 63 65 73 73 65 73 TE: Subprocesses
14420 20 77 69 74 68 20 6e 6f 6e 2d 7a 65 72 6f 20 65 with non-zero e
14430 78 69 74 20 63 6f 64 65 20 64 65 74 65 63 74 65 xit code detecte
14440 64 3a 20 22 20 2a 67 6c 6f 62 61 6c 65 78 69 74 d: " *globalexit
14450 73 74 61 74 75 73 2a 29 0a 20 20 20 20 20 20 20 status*).
14460 20 20 20 20 28 65 78 69 74 20 30 29 29 0a 20 20 (exit 0)).
14470 20 20 20 20 20 20 28 63 61 73 65 20 2a 67 6c 6f (case *glo
14480 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 0a 20 balexitstatus*.
14490 20 20 20 20 20 20 20 20 28 28 30 29 28 65 78 69 ((0)(exi
144a0 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 28 t 0)). (
144b0 28 31 29 28 65 78 69 74 20 31 29 29 0a 20 20 20 (1)(exit 1)).
144c0 20 20 20 20 20 20 28 28 32 29 28 65 78 69 74 20 ((2)(exit
144d0 32 29 29 0a 20 20 20 20 20 20 20 20 20 28 65 6c 2)). (el
144e0 73 65 20 28 65 78 69 74 20 33 29 29 29 29 29 0a se (exit 3))))).