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: 6f 75 74 20 72 65 61 64 6c 69 6e 65 0a 28 64 65 out readline.(de
01a0: 66 69 6e 65 20 28 74 6f 70 6c 65 76 65 6c 2d 63 fine (toplevel-c
01b0: 6f 6d 6d 61 6e 64 20 2e 20 61 29 20 23 66 29 0a ommand . a) #f).
01c0: 0a 28 75 73 65 20 73 71 6c 69 74 65 33 20 73 72 .(use sqlite3 sr
01d0: 66 69 2d 31 20 70 6f 73 69 78 20 72 65 67 65 78 fi-1 posix regex
01e0: 20 72 65 67 65 78 2d 63 61 73 65 20 73 72 66 69 regex-case srfi
01f0: 2d 36 39 20 62 61 73 65 36 34 20 72 65 61 64 6c -69 base64 readl
0200: 69 6e 65 20 61 70 72 6f 70 6f 73 20 6a 73 6f 6e ine apropos json
0210: 20 68 74 74 70 2d 63 6c 69 65 6e 74 20 64 69 72 http-client dir
0220: 65 63 74 6f 72 79 2d 75 74 69 6c 73 20 72 70 63 ectory-utils rpc
0230: 20 3b 3b 20 28 73 72 66 69 20 31 38 29 20 65 78 ;; (srfi 18) ex
0240: 74 72 61 73 29 0a 20 20 20 20 20 68 74 74 70 2d tras). http-
0250: 63 6c 69 65 6e 74 20 73 72 66 69 2d 31 38 20 65 client srfi-18 e
0260: 78 74 72 61 73 20 66 6f 72 6d 61 74 29 20 3b 3b xtras format) ;;
0270: 20 20 7a 6d 71 20 65 78 74 72 61 73 29 0a 0a 3b zmq extras)..;
0280: 3b 20 41 64 64 65 64 20 66 6f 72 20 63 73 76 20 ; Added for csv
0290: 73 74 75 66 66 20 2d 20 77 69 6c 6c 20 62 65 20 stuff - will be
02a0: 72 65 6d 6f 76 65 64 0a 3b 3b 0a 28 75 73 65 20 removed.;;.(use
02b0: 73 70 61 72 73 65 2d 76 65 63 74 6f 72 73 29 0a sparse-vectors).
02c0: 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 .(import (prefix
02d0: 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 sqlite3 sqlite3
02e0: 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 :)).(import (pre
02f0: 66 69 78 20 62 61 73 65 36 34 20 62 61 73 65 36 fix base64 base6
0300: 34 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 4:)).(import (pr
0310: 65 66 69 78 20 72 70 63 20 72 70 63 3a 29 29 0a efix rpc rpc:)).
0320: 28 72 65 71 75 69 72 65 2d 6c 69 62 72 61 72 79 (require-library
0330: 20 6d 75 74 69 6c 73 29 0a 0a 3b 3b 20 28 75 73 mutils)..;; (us
0340: 65 20 7a 6d 71 29 0a 0a 28 64 65 63 6c 61 72 65 e zmq)..(declare
0350: 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a (uses common)).
0360: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
0370: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 egatest-version)
0380: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0390: 20 6d 61 72 67 73 29 29 0a 28 64 65 63 6c 61 72 margs)).(declar
03a0: 65 20 28 75 73 65 73 20 72 75 6e 73 29 29 0a 28 e (uses runs)).(
03b0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6c 61 declare (uses la
03c0: 75 6e 63 68 29 29 0a 28 64 65 63 6c 61 72 65 20 unch)).(declare
03d0: 28 75 73 65 73 20 73 65 72 76 65 72 29 29 0a 28 (uses server)).(
03e0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6c declare (uses cl
03f0: 69 65 6e 74 29 29 0a 28 64 65 63 6c 61 72 65 20 ient)).(declare
0400: 28 75 73 65 73 20 74 65 73 74 73 29 29 0a 28 64 (uses tests)).(d
0410: 65 63 6c 61 72 65 20 28 75 73 65 73 20 67 65 6e eclare (uses gen
0420: 65 78 61 6d 70 6c 65 29 29 0a 28 64 65 63 6c 61 example)).(decla
0430: 72 65 20 28 75 73 65 73 20 64 61 65 6d 6f 6e 29 re (uses daemon)
0440: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0450: 20 64 62 29 29 0a 0a 28 64 65 63 6c 61 72 65 20 db))..(declare
0460: 28 75 73 65 73 20 74 64 62 29 29 0a 28 64 65 63 (uses tdb)).(dec
0470: 6c 61 72 65 20 28 75 73 65 73 20 6d 74 29 29 0a lare (uses mt)).
0480: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 61 (declare (uses a
0490: 70 69 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 pi)).(declare (u
04a0: 73 65 73 20 74 61 73 6b 73 29 29 20 3b 3b 20 6f ses tasks)) ;; o
04b0: 6e 6c 79 20 75 73 65 64 20 66 6f 72 20 64 65 62 nly used for deb
04c0: 75 67 67 69 6e 67 2e 0a 0a 28 64 65 66 69 6e 65 ugging...(define
04d0: 20 2a 64 62 2a 20 23 66 29 20 3b 3b 20 74 68 69 *db* #f) ;; thi
04e0: 73 20 69 73 20 6f 6e 6c 79 20 66 6f 72 20 74 68 s is only for th
04f0: 65 20 72 65 70 6c 2c 20 64 6f 20 6e 6f 74 20 75 e repl, do not u
0500: 73 65 20 69 6e 20 67 65 6e 65 72 61 6c 21 21 21 se in general!!!
0510: 21 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d !..(include "com
0520: 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 mon_records.scm"
0530: 29 0a 28 69 6e 63 6c 75 64 65 20 22 6b 65 79 5f ).(include "key_
0540: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 records.scm").(i
0550: 6e 63 6c 75 64 65 20 22 64 62 5f 72 65 63 6f 72 nclude "db_recor
0560: 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 ds.scm").(includ
0570: 65 20 22 72 75 6e 5f 72 65 63 6f 72 64 73 2e 73 e "run_records.s
0580: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 6d cm").(include "m
0590: 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 egatest-fossil-h
05a0: 61 73 68 2e 73 63 6d 22 29 0a 0a 28 6c 65 74 20 ash.scm")..(let
05b0: 28 28 64 65 62 75 67 63 6f 6e 74 72 6f 6c 66 20 ((debugcontrolf
05c0: 28 63 6f 6e 63 20 28 67 65 74 2d 65 6e 76 69 72 (conc (get-envir
05d0: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
05e0: 22 48 4f 4d 45 22 29 20 22 2f 2e 6d 65 67 61 74 "HOME") "/.megat
05f0: 65 73 74 72 63 22 29 29 29 0a 20 20 28 69 66 20 estrc"))). (if
0600: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 65 (file-exists? de
0610: 62 75 67 63 6f 6e 74 72 6f 6c 66 29 0a 20 20 20 bugcontrolf).
0620: 20 20 20 28 6c 6f 61 64 20 64 65 62 75 67 63 6f (load debugco
0630: 6e 74 72 6f 6c 66 29 29 29 0a 0a 28 64 65 66 69 ntrolf)))..(defi
0640: 6e 65 20 2a 61 72 65 61 2d 64 61 74 2a 20 28 6d ne *area-dat* (m
0650: 61 6b 65 2d 6d 65 67 61 74 65 73 74 3a 61 72 65 ake-megatest:are
0660: 61 0a 09 09 20 20 20 20 22 64 65 66 61 75 6c 74 a... "default
0670: 22 20 20 20 20 20 20 20 20 20 3b 3b 20 61 72 65 " ;; are
0680: 61 20 6e 61 6d 65 0a 09 09 20 20 20 20 23 66 20 a name... #f
0690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
06a0: 3b 20 61 72 65 61 20 70 61 74 68 0a 09 09 20 20 ; area path...
06b0: 20 20 27 68 74 74 70 20 20 20 20 20 20 20 20 20 'http
06c0: 20 20 20 20 3b 3b 20 74 72 61 6e 73 70 6f 72 74 ;; transport
06d0: 0a 09 09 20 20 20 20 23 66 20 20 20 20 20 20 20 ... #f
06e0: 20 20 20 20 20 20 20 20 20 3b 3b 20 63 6f 6e 66 ;; conf
06f0: 69 67 69 6e 66 6f 0a 09 09 20 20 20 20 23 66 20 iginfo... #f
0700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
0710: 3b 20 63 6f 6e 66 69 67 64 61 74 0a 09 09 20 20 ; configdat...
0720: 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 (make-hash-tab
0730: 6c 65 29 20 3b 3b 20 64 65 6e 6f 69 73 65 0a 09 le) ;; denoise..
0740: 09 20 20 20 20 23 66 20 20 20 20 20 20 20 20 20 . #f
0750: 20 20 20 20 20 20 20 3b 3b 20 63 6c 69 65 6e 74 ;; client
0760: 20 73 69 67 6e 61 74 75 72 65 0a 09 09 20 20 20 signature...
0770: 20 23 66 20 20 20 20 20 20 20 20 20 20 20 20 20 #f
0780: 20 20 20 3b 3b 20 72 65 6d 6f 74 65 20 63 6f 6e ;; remote con
0790: 6e 65 63 74 69 6f 6e 73 0a 09 09 20 20 20 20 29 nections... )
07a0: 29 0a 0a 28 64 65 66 69 6e 65 20 2a 72 75 6e 72 )..(define *runr
07b0: 65 6d 6f 74 65 2a 20 23 66 29 20 3b 3b 20 42 55 emote* #f) ;; BU
07c0: 47 3a 20 52 65 6d 6f 76 65 20 74 68 69 73 20 41 G: Remove this A
07d0: 53 41 50 20 61 6e 64 20 75 70 64 61 74 65 20 63 SAP and update c
07e0: 6f 6d 6d 6f 6e 3a 2a 72 65 6d 6f 74 65 2a 20 74 ommon:*remote* t
07f0: 6f 20 6e 6f 74 20 72 65 66 65 72 20 74 6f 20 2a o not refer to *
0800: 72 75 6e 72 65 6d 6f 74 65 2a 0a 0a 3b 3b 20 44 runremote*..;; D
0810: 69 73 61 62 6c 65 64 20 68 65 6c 70 20 69 74 65 isabled help ite
0820: 6d 73 0a 3b 3b 20 20 2d 72 6f 6c 6c 75 70 20 20 ms.;; -rollup
0830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0840: 20 28 63 75 72 72 65 6e 74 6c 79 20 64 69 73 61 (currently disa
0850: 62 6c 65 64 29 20 66 69 6c 6c 20 72 75 6e 20 28 bled) fill run (
0860: 73 65 74 20 62 79 20 3a 72 75 6e 6e 61 6d 65 29 set by :runname)
0870: 20 20 77 69 74 68 20 6c 61 74 65 73 74 20 74 65 with latest te
0880: 73 74 28 73 29 0a 3b 3b 20 20 20 20 20 20 20 20 st(s).;;
0890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
08a0: 20 20 20 20 66 72 6f 6d 20 70 72 69 6f 72 20 72 from prior r
08b0: 75 6e 73 20 77 69 74 68 20 73 61 6d 65 20 6b 65 uns with same ke
08c0: 79 73 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 ys..(define help
08d0: 20 28 63 6f 6e 63 20 22 0a 4d 65 67 61 74 65 73 (conc ".Megates
08e0: 74 2c 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e t, documentation
08f0: 20 61 74 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b at http://www.k
0900: 69 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c iatoa.com/fossil
0910: 73 2f 6d 65 67 61 74 65 73 74 0a 20 20 76 65 72 s/megatest. ver
0920: 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 2d sion " megatest-
0930: 76 65 72 73 69 6f 6e 20 22 0a 20 20 6c 69 63 65 version ". lice
0940: 6e 73 65 20 47 50 4c 2c 20 43 6f 70 79 72 69 67 nse GPL, Copyrig
0950: 68 74 20 4d 61 74 74 20 57 65 6c 6c 61 6e 64 20 ht Matt Welland
0960: 32 30 30 36 2d 32 30 31 35 0a 0a 55 73 61 67 65 2006-2015..Usage
0970: 3a 20 6d 65 67 61 74 65 73 74 20 5b 6f 70 74 69 : megatest [opti
0980: 6f 6e 73 5d 0a 20 20 2d 68 20 20 20 20 20 20 20 ons]. -h
0990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
09a0: 20 74 68 69 73 20 68 65 6c 70 0a 20 20 2d 76 65 this help. -ve
09b0: 72 73 69 6f 6e 20 20 20 20 20 20 20 20 20 20 20 rsion
09c0: 20 20 20 20 20 3a 20 70 72 69 6e 74 20 6d 65 67 : print meg
09d0: 61 74 65 73 74 20 76 65 72 73 69 6f 6e 20 28 63 atest version (c
09e0: 75 72 72 65 6e 74 6c 79 20 22 20 6d 65 67 61 74 urrently " megat
09f0: 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 29 0a 0a est-version ")..
0a00: 4c 61 75 6e 63 68 69 6e 67 20 61 6e 64 20 6d 61 Launching and ma
0a10: 6e 61 67 69 6e 67 20 72 75 6e 73 0a 20 20 2d 72 naging runs. -r
0a20: 75 6e 61 6c 6c 20 20 20 20 20 20 20 20 20 20 20 unall
0a30: 20 20 20 20 20 20 3a 20 72 75 6e 20 61 6c 6c 20 : run all
0a40: 74 65 73 74 73 20 74 68 61 74 20 61 72 65 20 6e tests that are n
0a50: 6f 74 20 73 74 61 74 65 20 43 4f 4d 50 4c 45 54 ot state COMPLET
0a60: 45 44 20 61 6e 64 20 73 74 61 74 75 73 20 50 41 ED and status PA
0a70: 53 53 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 SS, .
0a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a90: 20 43 48 45 43 4b 20 6f 72 20 4b 49 4c 4c 45 44 CHECK or KILLED
0aa0: 0a 20 20 2d 72 75 6e 74 65 73 74 73 20 74 73 74 . -runtests tst
0ab0: 31 2c 74 73 74 32 20 2e 2e 2e 20 3a 20 72 75 6e 1,tst2 ... : run
0ac0: 20 74 65 73 74 73 0a 20 20 2d 72 65 6d 6f 76 65 tests. -remove
0ad0: 2d 72 75 6e 73 20 20 20 20 20 20 20 20 20 20 20 -runs
0ae0: 20 3a 20 72 65 6d 6f 76 65 20 74 68 65 20 64 61 : remove the da
0af0: 74 61 20 66 6f 72 20 61 20 72 75 6e 2c 20 72 65 ta for a run, re
0b00: 71 75 69 72 65 73 20 2d 72 75 6e 6e 61 6d 65 20 quires -runname
0b10: 61 6e 64 20 2d 74 65 73 74 70 61 74 74 0a 20 20 and -testpatt.
0b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b30: 20 20 20 20 20 20 20 20 20 20 4f 70 74 69 6f 6e Option
0b40: 61 6c 6c 79 20 75 73 65 20 3a 73 74 61 74 65 20 ally use :state
0b50: 61 6e 64 20 3a 73 74 61 74 75 73 0a 20 20 2d 73 and :status. -s
0b60: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 et-state-status
0b70: 58 2c 59 20 20 20 3a 20 73 65 74 20 73 74 61 74 X,Y : set stat
0b80: 65 20 74 6f 20 58 20 61 6e 64 20 73 74 61 74 75 e to X and statu
0b90: 73 20 74 6f 20 59 2c 20 72 65 71 75 69 72 65 73 s to Y, requires
0ba0: 20 63 6f 6e 74 72 6f 6c 73 20 70 65 72 20 2d 72 controls per -r
0bb0: 65 6d 6f 76 65 2d 72 75 6e 73 0a 20 20 2d 72 65 emove-runs. -re
0bc0: 72 75 6e 20 46 41 49 4c 2c 57 41 52 4e 2e 2e 2e run FAIL,WARN...
0bd0: 20 20 20 20 20 3a 20 66 6f 72 63 65 20 72 65 2d : force re-
0be0: 72 75 6e 20 66 6f 72 20 74 65 73 74 73 20 77 69 run for tests wi
0bf0: 74 68 20 73 70 65 63 69 66 69 63 65 64 20 73 74 th specificed st
0c00: 61 74 75 73 28 73 29 0a 20 20 2d 6c 6f 63 6b 20 atus(s). -lock
0c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c20: 20 20 3a 20 6c 6f 63 6b 20 72 75 6e 20 73 70 65 : lock run spe
0c30: 63 69 66 69 65 64 20 62 79 20 74 61 72 67 65 74 cified by target
0c40: 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 20 2d and runname. -
0c50: 75 6e 6c 6f 63 6b 20 20 20 20 20 20 20 20 20 20 unlock
0c60: 20 20 20 20 20 20 20 3a 20 75 6e 6c 6f 63 6b 20 : unlock
0c70: 72 75 6e 20 73 70 65 63 69 66 69 65 64 20 62 79 run specified by
0c80: 20 74 61 72 67 65 74 20 61 6e 64 20 72 75 6e 6e target and runn
0c90: 61 6d 65 0a 20 20 2d 73 65 74 2d 72 75 6e 2d 73 ame. -set-run-s
0ca0: 74 61 74 75 73 20 73 74 61 74 75 73 20 20 3a 20 tatus status :
0cb0: 73 65 74 73 20 73 74 61 74 75 73 20 66 6f 72 20 sets status for
0cc0: 72 75 6e 20 74 6f 20 73 74 61 74 75 73 2c 20 72 run to status, r
0cd0: 65 71 75 69 72 65 73 20 2d 74 61 72 67 65 74 20 equires -target
0ce0: 61 6e 64 20 2d 72 75 6e 6e 61 6d 65 0a 20 20 2d and -runname. -
0cf0: 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 20 get-run-status
0d00: 20 20 20 20 20 20 20 3a 20 67 65 74 73 20 73 74 : gets st
0d10: 61 74 75 73 20 66 6f 72 20 72 75 6e 20 73 70 65 atus for run spe
0d20: 63 69 66 69 65 64 20 62 79 20 74 61 72 67 65 74 cified by target
0d30: 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 20 2d and runname. -
0d40: 72 75 6e 2d 77 61 69 74 20 20 20 20 20 20 20 20 run-wait
0d50: 20 20 20 20 20 20 20 3a 20 77 61 69 74 20 6f 6e : wait on
0d60: 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 20 62 run specified b
0d70: 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 75 6e y target and run
0d80: 6e 61 6d 65 0a 20 20 2d 70 72 65 63 6c 65 61 6e name. -preclean
0d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0da0: 20 72 65 6d 6f 76 65 20 74 68 65 20 65 78 69 73 remove the exis
0db0: 74 69 6e 67 20 74 65 73 74 20 64 69 72 65 63 74 ting test direct
0dc0: 6f 72 79 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 ory before runni
0dd0: 6e 67 20 74 68 65 20 74 65 73 74 0a 0a 53 65 6c ng the test..Sel
0de0: 65 63 74 6f 72 73 20 28 65 2e 67 2e 20 75 73 65 ectors (e.g. use
0df0: 20 66 6f 72 20 2d 72 75 6e 74 65 73 74 73 2c 20 for -runtests,
0e00: 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 2c 20 2d 73 -remove-runs, -s
0e10: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2c et-state-status,
0e20: 20 2d 6c 69 73 74 2d 72 75 6e 73 20 65 74 63 2e -list-runs etc.
0e30: 29 0a 20 20 2d 74 61 72 67 65 74 20 6b 65 79 31 ). -target key1
0e40: 2f 6b 65 79 32 2f 2e 2e 2e 20 20 20 3a 20 72 75 /key2/... : ru
0e50: 6e 20 66 6f 72 20 6b 65 79 31 2c 20 6b 65 79 32 n for key1, key2
0e60: 2c 20 65 74 63 2e 0a 20 20 2d 72 65 71 74 61 72 , etc.. -reqtar
0e70: 67 20 6b 65 79 31 2f 6b 65 79 32 2f 2e 2e 2e 20 g key1/key2/...
0e80: 20 3a 20 72 75 6e 20 66 6f 72 20 6b 65 79 31 2c : run for key1,
0e90: 20 6b 65 79 32 2c 20 65 74 63 2e 20 62 75 74 20 key2, etc. but
0ea0: 6b 65 79 31 2f 6b 65 79 32 20 6d 75 73 74 20 62 key1/key2 must b
0eb0: 65 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 0a 20 e in runconfig.
0ec0: 20 2d 74 65 73 74 70 61 74 74 20 70 61 74 74 31 -testpatt patt1
0ed0: 2f 70 61 74 74 32 2c 70 61 74 74 33 2f 2e 2e 2e /patt2,patt3/...
0ee0: 20 20 3a 20 25 20 69 73 20 77 69 6c 64 63 61 72 : % is wildcar
0ef0: 64 0a 20 20 2d 72 75 6e 6e 61 6d 65 20 20 20 20 d. -runname
0f00: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 : re
0f10: 71 75 69 72 65 64 2c 20 6e 61 6d 65 20 66 6f 72 quired, name for
0f20: 20 74 68 69 73 20 70 61 72 74 69 63 75 6c 61 72 this particular
0f30: 20 74 65 73 74 20 72 75 6e 0a 20 20 2d 73 74 61 test run. -sta
0f40: 74 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 te
0f50: 20 20 20 20 3a 20 41 70 70 6c 69 65 73 20 74 6f : Applies to
0f60: 20 72 75 6e 73 2c 20 74 65 73 74 73 20 6f 72 20 runs, tests or
0f70: 73 74 65 70 73 20 64 65 70 65 6e 64 69 6e 67 20 steps depending
0f80: 6f 6e 20 63 6f 6e 74 65 78 74 0a 20 20 2d 73 74 on context. -st
0f90: 61 74 75 73 20 20 20 20 20 20 20 20 20 20 20 20 atus
0fa0: 20 20 20 20 20 3a 20 41 70 70 6c 69 65 73 20 74 : Applies t
0fb0: 6f 20 72 75 6e 73 2c 20 74 65 73 74 73 20 6f 72 o runs, tests or
0fc0: 20 73 74 65 70 73 20 64 65 70 65 6e 64 69 6e 67 steps depending
0fd0: 20 6f 6e 20 63 6f 6e 74 65 78 74 0a 0a 54 65 73 on context..Tes
0fe0: 74 20 68 65 6c 70 65 72 73 20 28 66 6f 72 20 75 t helpers (for u
0ff0: 73 65 20 69 6e 73 69 64 65 20 74 65 73 74 73 29 se inside tests)
1000: 0a 20 20 2d 73 74 65 70 20 73 74 65 70 6e 61 6d . -step stepnam
1010: 65 0a 20 20 2d 74 65 73 74 2d 73 74 61 74 75 73 e. -test-status
1020: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 : se
1030: 74 20 74 68 65 20 73 74 61 74 65 20 61 6e 64 20 t the state and
1040: 73 74 61 74 75 73 20 6f 66 20 61 20 74 65 73 74 status of a test
1050: 20 28 75 73 65 20 3a 73 74 61 74 65 20 61 6e 64 (use :state and
1060: 20 3a 73 74 61 74 75 73 29 0a 20 20 2d 73 65 74 :status). -set
1070: 6c 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 log logfname
1080: 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 70 61 : set the pa
1090: 74 68 2f 66 69 6c 65 6e 61 6d 65 20 74 6f 20 74 th/filename to t
10a0: 68 65 20 66 69 6e 61 6c 20 6c 6f 67 20 72 65 6c he final log rel
10b0: 61 74 69 76 65 20 74 6f 20 74 68 65 20 74 65 73 ative to the tes
10c0: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
10d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 64 69 di
10e0: 72 65 63 74 6f 72 79 2e 20 6d 61 79 20 62 65 20 rectory. may be
10f0: 75 73 65 64 20 77 69 74 68 20 2d 74 65 73 74 2d used with -test-
1100: 73 74 61 74 75 73 0a 20 20 2d 73 65 74 2d 74 6f status. -set-to
1110: 70 6c 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 20 20 plog logfname
1120: 20 3a 20 73 65 74 20 74 68 65 20 6f 76 65 72 61 : set the overa
1130: 6c 6c 20 6c 6f 67 20 66 6f 72 20 61 20 73 75 69 ll log for a sui
1140: 74 65 20 6f 66 20 73 75 62 2d 74 65 73 74 73 0a te of sub-tests.
1150: 20 20 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 -summarize-ite
1160: 6d 73 20 20 20 20 20 20 20 20 3a 20 66 6f 72 20 ms : for
1170: 61 6e 20 69 74 65 6d 69 7a 65 64 20 74 65 73 74 an itemized test
1180: 20 63 72 65 61 74 65 20 61 20 73 75 6d 6d 61 72 create a summar
1190: 79 20 68 74 6d 6c 20 0a 20 20 2d 6d 20 63 6f 6d y html . -m com
11a0: 6d 65 6e 74 20 20 20 20 20 20 20 20 20 20 20 20 ment
11b0: 20 20 3a 20 69 6e 73 65 72 74 20 61 20 63 6f 6d : insert a com
11c0: 6d 65 6e 74 20 66 6f 72 20 74 68 69 73 20 74 65 ment for this te
11d0: 73 74 0a 0a 54 65 73 74 20 64 61 74 61 20 63 61 st..Test data ca
11e0: 70 74 75 72 65 0a 20 20 2d 73 65 74 2d 76 61 6c pture. -set-val
11f0: 75 65 73 20 20 20 20 20 20 20 20 20 20 20 20 20 ues
1200: 3a 20 75 70 64 61 74 65 20 6f 72 20 73 65 74 20 : update or set
1210: 76 61 6c 75 65 73 20 69 6e 20 74 68 65 20 74 65 values in the te
1220: 73 74 64 61 74 61 20 74 61 62 6c 65 0a 20 20 3a stdata table. :
1230: 63 61 74 65 67 6f 72 79 20 20 20 20 20 20 20 20 category
1240: 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 : set the
1250: 20 63 61 74 65 67 6f 72 79 20 66 69 65 6c 64 20 category field
1260: 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 (optional). :va
1270: 72 69 61 62 6c 65 20 20 20 20 20 20 20 20 20 20 riable
1280: 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 76 : set the v
1290: 61 72 69 61 62 6c 65 20 6e 61 6d 65 20 28 6f 70 ariable name (op
12a0: 74 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 6c 75 65 tional). :value
12b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12c0: 20 20 3a 20 76 61 6c 75 65 20 6d 65 61 73 75 72 : value measur
12d0: 65 64 20 28 72 65 71 75 69 72 65 64 29 0a 20 20 ed (required).
12e0: 3a 65 78 70 65 63 74 65 64 20 20 20 20 20 20 20 :expected
12f0: 20 20 20 20 20 20 20 20 3a 20 76 61 6c 75 65 20 : value
1300: 65 78 70 65 63 74 65 64 20 28 72 65 71 75 69 72 expected (requir
1310: 65 64 29 0a 20 20 3a 74 6f 6c 20 20 20 20 20 20 ed). :tol
1320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
1330: 7c 76 61 6c 75 65 2d 65 78 70 65 63 74 7c 20 3c |value-expect| <
1340: 3d 20 74 6f 6c 20 28 72 65 71 75 69 72 65 64 2c = tol (required,
1350: 20 63 61 6e 20 62 65 20 3c 2c 20 3e 2c 20 3e 3d can be <, >, >=
1360: 2c 20 3c 3d 20 6f 72 20 6e 75 6d 62 65 72 29 0a , <= or number).
1370: 20 20 3a 75 6e 69 74 73 20 20 20 20 20 20 20 20 :units
1380: 20 20 20 20 20 20 20 20 20 20 3a 20 6e 61 6d 65 : name
1390: 20 6f 66 20 74 68 65 20 75 6e 69 74 73 20 66 6f of the units fo
13a0: 72 20 76 61 6c 75 65 2c 20 65 78 70 65 63 74 65 r value, expecte
13b0: 64 5f 76 61 6c 75 65 20 65 74 63 2e 20 28 6f 70 d_value etc. (op
13c0: 74 69 6f 6e 61 6c 29 0a 20 20 2d 6c 6f 61 64 2d tional). -load-
13d0: 74 65 73 74 2d 64 61 74 61 20 20 20 20 20 20 20 test-data
13e0: 20 20 3a 20 72 65 61 64 20 74 65 73 74 20 73 70 : read test sp
13f0: 65 63 69 66 69 63 20 64 61 74 61 20 66 6f 72 20 ecific data for
1400: 73 74 6f 72 61 67 65 20 69 6e 20 74 68 65 20 74 storage in the t
1410: 65 73 74 5f 64 61 74 61 20 74 61 62 6c 65 0a 20 est_data table.
1420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1430: 20 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d 20 from
1440: 73 74 61 6e 64 61 72 64 20 69 6e 2e 20 45 61 63 standard in. Eac
1450: 68 20 6c 69 6e 65 20 69 73 20 63 6f 6d 6d 61 20 h line is comma
1460: 64 65 6c 69 6d 69 74 65 64 20 77 69 74 68 20 66 delimited with f
1470: 6f 75 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 our.
1480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1490: 66 69 65 6c 64 73 20 63 61 74 65 67 6f 72 79 2c fields category,
14a0: 76 61 72 69 61 62 6c 65 2c 76 61 6c 75 65 2c 63 variable,value,c
14b0: 6f 6d 6d 65 6e 74 0a 0a 51 75 65 72 69 65 73 0a omment..Queries.
14c0: 20 20 2d 6c 69 73 74 2d 72 75 6e 73 20 70 61 74 -list-runs pat
14d0: 74 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 t : list
14e0: 20 72 75 6e 73 20 6d 61 74 63 68 69 6e 67 20 70 runs matching p
14f0: 61 74 74 65 72 6e 20 5c 22 70 61 74 74 5c 22 2c attern \"patt\",
1500: 20 25 20 69 73 20 74 68 65 20 77 69 6c 64 63 61 % is the wildca
1510: 72 64 0a 20 20 2d 73 68 6f 77 2d 6b 65 79 73 20 rd. -show-keys
1520: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 : s
1530: 68 6f 77 20 74 68 65 20 6b 65 79 73 20 75 73 65 how the keys use
1540: 64 20 69 6e 20 74 68 69 73 20 6d 65 67 61 74 65 d in this megate
1550: 73 74 20 73 65 74 75 70 0a 20 20 2d 74 65 73 74 st setup. -test
1560: 2d 66 69 6c 65 73 20 74 61 72 67 70 61 74 74 20 -files targpatt
1570: 20 20 20 3a 20 67 65 74 20 74 68 65 20 6d 6f 73 : get the mos
1580: 74 20 72 65 63 65 6e 74 20 74 65 73 74 20 70 61 t recent test pa
1590: 74 68 2f 66 69 6c 65 20 6d 61 74 63 68 69 6e 67 th/file matching
15a0: 20 74 61 72 67 70 61 74 74 20 65 2e 67 2e 20 25 targpatt e.g. %
15b0: 2f 25 2e 2e 2e 20 0a 20 20 20 20 20 20 20 20 20 /%... .
15c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15d0: 20 20 20 72 65 74 75 72 6e 73 20 6c 69 73 74 20 returns list
15e0: 73 6f 72 74 65 64 20 62 79 20 61 67 65 20 61 73 sorted by age as
15f0: 63 65 6e 64 69 6e 67 2c 20 73 65 65 20 65 78 61 cending, see exa
1600: 6d 70 6c 65 73 20 62 65 6c 6f 77 0a 20 20 2d 74 mples below. -t
1610: 65 73 74 2d 70 61 74 68 73 20 20 20 20 20 20 20 est-paths
1620: 20 20 20 20 20 20 3a 20 67 65 74 20 74 68 65 20 : get the
1630: 74 65 73 74 20 70 61 74 68 73 20 6d 61 74 63 68 test paths match
1640: 69 6e 67 20 74 61 72 67 65 74 2c 20 72 75 6e 6e ing target, runn
1650: 61 6d 65 2c 20 69 74 65 6d 20 61 6e 64 20 74 65 ame, item and te
1660: 73 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 st.
1670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 p
1680: 61 74 74 65 72 6e 73 2e 0a 20 20 2d 6c 69 73 74 atterns.. -list
1690: 2d 64 69 73 6b 73 20 20 20 20 20 20 20 20 20 20 -disks
16a0: 20 20 20 3a 20 6c 69 73 74 20 74 68 65 20 64 69 : list the di
16b0: 73 6b 73 20 61 76 61 69 6c 61 62 6c 65 20 66 6f sks available fo
16c0: 72 20 73 74 6f 72 69 6e 67 20 72 75 6e 73 0a 20 r storing runs.
16d0: 20 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 20 20 -list-targets
16e0: 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 : list
16f0: 74 68 65 20 74 61 72 67 65 74 73 20 69 6e 20 72 the targets in r
1700: 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 unconfigs.config
1710: 0a 20 20 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 . -list-db-targ
1720: 65 74 73 20 20 20 20 20 20 20 20 3a 20 6c 69 73 ets : lis
1730: 74 20 74 68 65 20 74 61 72 67 65 74 20 63 6f 6d t the target com
1740: 62 69 6e 61 74 69 6f 6e 73 20 75 73 65 64 20 69 binations used i
1750: 6e 20 74 68 65 20 64 62 0a 20 20 2d 73 68 6f 77 n the db. -show
1760: 2d 63 6f 6e 66 69 67 20 20 20 20 20 20 20 20 20 -config
1770: 20 20 20 3a 20 64 75 6d 70 20 74 68 65 20 69 6e : dump the in
1780: 74 65 72 6e 61 6c 20 72 65 70 72 65 73 65 6e 74 ternal represent
1790: 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 6d 65 67 ation of the meg
17a0: 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 66 69 6c atest.config fil
17b0: 65 0a 20 20 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e e. -show-runcon
17c0: 66 69 67 20 20 20 20 20 20 20 20 20 3a 20 64 75 fig : du
17d0: 6d 70 20 74 68 65 20 69 6e 74 65 72 6e 61 6c 20 mp the internal
17e0: 72 65 70 72 65 73 65 6e 74 61 74 69 6f 6e 20 6f representation o
17f0: 66 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 73 f the runconfigs
1800: 2e 63 6f 6e 66 69 67 20 66 69 6c 65 0a 20 20 2d .config file. -
1810: 64 75 6d 70 6d 6f 64 65 20 6a 73 6f 6e 20 20 20 dumpmode json
1820: 20 20 20 20 20 20 20 3a 20 64 75 6d 70 20 69 6e : dump in
1830: 20 6a 73 6f 6e 20 66 6f 72 6d 61 74 20 69 6e 73 json format ins
1840: 74 65 61 64 20 6f 66 20 73 65 78 70 72 0a 20 20 tead of sexpr.
1850: 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 6f 20 20 20 -show-cmdinfo
1860: 20 20 20 20 20 20 20 20 3a 20 64 75 6d 70 20 74 : dump t
1870: 68 65 20 63 6f 6d 6d 61 6e 64 20 69 6e 66 6f 20 he command info
1880: 66 6f 72 20 61 20 74 65 73 74 20 28 72 75 6e 20 for a test (run
1890: 69 6e 20 74 65 73 74 20 65 6e 76 69 72 6f 6e 6d in test environm
18a0: 65 6e 74 29 0a 20 20 2d 73 65 63 74 69 6f 6e 20 ent). -section
18b0: 73 65 63 74 69 6f 6e 4e 61 6d 65 0a 20 20 2d 76 sectionName. -v
18c0: 61 72 20 76 61 72 4e 61 6d 65 20 20 20 20 20 20 ar varName
18d0: 20 20 20 20 20 20 3a 20 66 6f 72 20 63 6f 6e 66 : for conf
18e0: 69 67 20 61 6e 64 20 72 75 6e 63 6f 6e 66 69 67 ig and runconfig
18f0: 20 6c 6f 6f 6b 75 70 20 76 61 6c 75 65 20 66 6f lookup value fo
1900: 72 20 73 65 63 74 69 6f 6e 4e 61 6d 65 20 76 61 r sectionName va
1910: 72 4e 61 6d 65 0a 0a 4d 69 73 63 20 0a 20 20 2d rName..Misc . -
1920: 73 74 61 72 74 2d 64 69 72 20 70 61 74 68 20 20 start-dir path
1930: 20 20 20 20 20 20 20 3a 20 73 77 69 74 63 68 20 : switch
1940: 74 6f 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 to this director
1950: 79 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 6e 67 y before running
1960: 20 6d 65 67 61 74 65 73 74 0a 20 20 2d 72 65 62 megatest. -reb
1970: 75 69 6c 64 2d 64 62 20 20 20 20 20 20 20 20 20 uild-db
1980: 20 20 20 20 3a 20 62 72 69 6e 67 20 74 68 65 20 : bring the
1990: 64 61 74 61 62 61 73 65 20 73 63 68 65 6d 61 20 database schema
19a0: 75 70 20 74 6f 20 64 61 74 65 0a 20 20 2d 63 6c up to date. -cl
19b0: 65 61 6e 75 70 2d 64 62 20 20 20 20 20 20 20 20 eanup-db
19c0: 20 20 20 20 20 3a 20 72 65 6d 6f 76 65 20 61 6e : remove an
19d0: 79 20 6f 72 70 68 61 6e 20 72 65 63 6f 72 64 73 y orphan records
19e0: 2c 20 76 61 63 75 75 6d 20 74 68 65 20 64 62 0a , vacuum the db.
19f0: 20 20 2d 69 6d 70 6f 72 74 2d 6d 65 67 61 74 65 -import-megate
1a00: 73 74 2e 64 62 20 20 20 20 20 3a 20 6d 69 67 72 st.db : migr
1a10: 61 74 65 20 61 20 64 61 74 61 62 61 73 65 20 66 ate a database f
1a20: 72 6f 6d 20 76 31 2e 35 35 20 73 65 72 69 65 73 rom v1.55 series
1a30: 20 74 6f 20 76 31 2e 36 30 20 73 65 72 69 65 73 to v1.60 series
1a40: 0a 20 20 2d 73 79 6e 63 2d 74 6f 2d 6d 65 67 61 . -sync-to-mega
1a50: 74 65 73 74 2e 64 62 20 20 20 20 3a 20 6d 69 67 test.db : mig
1a60: 72 61 74 65 20 64 61 74 61 20 62 61 63 6b 20 74 rate data back t
1a70: 6f 20 6d 65 67 61 74 65 73 74 2e 64 62 0a 20 20 o megatest.db.
1a80: 2d 75 70 64 61 74 65 2d 6d 65 74 61 20 20 20 20 -update-meta
1a90: 20 20 20 20 20 20 20 20 3a 20 75 70 64 61 74 65 : update
1aa0: 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 61 64 the tests metad
1ab0: 61 74 61 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 ata for all test
1ac0: 73 0a 20 20 2d 73 65 74 76 61 72 73 20 56 41 52 s. -setvars VAR
1ad0: 31 3d 76 61 6c 31 2c 56 41 52 32 3d 76 61 6c 32 1=val1,VAR2=val2
1ae0: 20 3a 20 41 64 64 20 65 6e 76 69 72 6f 6e 6d 65 : Add environme
1af0: 6e 74 20 76 61 72 69 61 62 6c 65 73 20 74 6f 20 nt variables to
1b00: 61 20 72 75 6e 20 4e 42 2f 2f 20 74 68 65 73 65 a run NB// these
1b10: 20 61 72 65 0a 20 20 20 20 20 20 20 20 20 20 20 are.
1b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b30: 20 20 20 20 20 20 6f 76 65 72 77 72 69 74 74 65 overwritte
1b40: 6e 20 62 79 20 76 61 6c 75 65 73 20 73 65 74 20 n by values set
1b50: 69 6e 20 63 6f 6e 66 69 67 20 66 69 6c 65 73 2e in config files.
1b60: 0a 20 20 2d 73 65 72 76 65 72 20 2d 7c 68 6f 73 . -server -|hos
1b70: 74 6e 61 6d 65 20 20 20 20 20 20 3a 20 73 74 61 tname : sta
1b80: 72 74 20 74 68 65 20 73 65 72 76 65 72 20 28 72 rt the server (r
1b90: 65 64 75 63 65 73 20 63 6f 6e 74 65 6e 74 69 6f educes contentio
1ba0: 6e 20 6f 6e 20 6d 65 67 61 74 65 73 74 2e 64 62 n on megatest.db
1bb0: 29 2c 20 75 73 65 0a 20 20 20 20 20 20 20 20 20 ), use.
1bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bd0: 20 20 20 2d 20 74 6f 20 61 75 74 6f 6d 61 74 69 - to automati
1be0: 63 61 6c 6c 79 20 66 69 67 75 72 65 20 6f 75 74 cally figure out
1bf0: 20 68 6f 73 74 6e 61 6d 65 0a 20 20 2d 74 72 61 hostname. -tra
1c00: 6e 73 70 6f 72 74 20 68 74 74 70 7c 7a 6d 71 20 nsport http|zmq
1c10: 20 20 20 20 3a 20 75 73 65 20 68 74 74 70 20 6f : use http o
1c20: 72 20 7a 6d 71 20 66 6f 72 20 74 72 61 6e 73 70 r zmq for transp
1c30: 6f 72 74 20 28 64 65 66 61 75 6c 74 20 69 73 20 ort (default is
1c40: 68 74 74 70 29 20 0a 20 20 2d 64 61 65 6d 6f 6e http) . -daemon
1c50: 69 7a 65 20 20 20 20 20 20 20 20 20 20 20 20 20 ize
1c60: 20 3a 20 66 6f 72 6b 20 69 6e 74 6f 20 62 61 63 : fork into bac
1c70: 6b 67 72 6f 75 6e 64 20 61 6e 64 20 64 69 73 63 kground and disc
1c80: 6f 6e 6e 65 63 74 20 66 72 6f 6d 20 73 74 64 69 onnect from stdi
1c90: 6e 2f 6f 75 74 0a 20 20 2d 6c 6f 67 20 6c 6f 67 n/out. -log log
1ca0: 66 69 6c 65 20 20 20 20 20 20 20 20 20 20 20 20 file
1cb0: 3a 20 73 65 6e 64 20 73 74 64 6f 75 74 20 61 6e : send stdout an
1cc0: 64 20 73 74 64 65 72 72 20 74 6f 20 6c 6f 67 66 d stderr to logf
1cd0: 69 6c 65 0a 20 20 2d 6c 69 73 74 2d 73 65 72 76 ile. -list-serv
1ce0: 65 72 73 20 20 20 20 20 20 20 20 20 20 20 3a 20 ers :
1cf0: 6c 69 73 74 20 74 68 65 20 73 65 72 76 65 72 73 list the servers
1d00: 20 0a 20 20 2d 73 74 6f 70 2d 73 65 72 76 65 72 . -stop-server
1d10: 20 69 64 20 20 20 20 20 20 20 20 20 3a 20 73 74 id : st
1d20: 6f 70 20 73 65 72 76 65 72 20 73 70 65 63 69 66 op server specif
1d30: 69 65 64 20 62 79 20 69 64 20 28 73 65 65 20 6f ied by id (see o
1d40: 75 74 70 75 74 20 6f 66 20 2d 6c 69 73 74 2d 73 utput of -list-s
1d50: 65 72 76 65 72 73 29 2c 20 75 73 65 0a 20 20 20 ervers), use.
1d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d70: 20 20 20 20 20 20 20 20 20 30 20 74 6f 20 6b 69 0 to ki
1d80: 6c 6c 20 61 6c 6c 0a 20 20 2d 72 65 70 6c 20 20 ll all. -repl
1d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1da0: 20 3a 20 73 74 61 72 74 20 61 20 72 65 70 6c 20 : start a repl
1db0: 28 75 73 65 66 75 6c 20 66 6f 72 20 65 78 74 65 (useful for exte
1dc0: 6e 64 69 6e 67 20 6d 65 67 61 74 65 73 74 29 0a nding megatest).
1dd0: 20 20 2d 6c 6f 61 64 20 66 69 6c 65 2e 73 63 6d -load file.scm
1de0: 20 20 20 20 20 20 20 20 20 20 3a 20 6c 6f 61 64 : load
1df0: 20 61 6e 64 20 72 75 6e 20 66 69 6c 65 2e 73 63 and run file.sc
1e00: 6d 0a 20 20 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 m. -mark-incomp
1e10: 6c 65 74 65 73 20 20 20 20 20 20 20 3a 20 66 69 letes : fi
1e20: 6e 64 20 61 6e 64 20 6d 61 72 6b 20 69 6e 63 6f nd and mark inco
1e30: 6d 70 6c 65 74 65 20 74 65 73 74 73 0a 20 20 2d mplete tests. -
1e40: 70 69 6e 67 20 72 75 6e 2d 69 64 7c 68 6f 73 74 ping run-id|host
1e50: 3a 70 6f 72 74 20 20 3a 20 70 69 6e 67 20 73 65 :port : ping se
1e60: 72 76 65 72 2c 20 65 78 69 74 20 77 69 74 68 20 rver, exit with
1e70: 30 20 69 66 20 66 6f 75 6e 64 0a 0a 55 74 69 6c 0 if found..Util
1e80: 69 74 69 65 73 0a 20 20 2d 65 6e 76 32 66 69 6c ities. -env2fil
1e90: 65 20 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 e fname
1ea0: 3a 20 77 72 69 74 65 20 74 68 65 20 65 6e 76 69 : write the envi
1eb0: 72 6f 6e 6d 65 6e 74 20 74 6f 20 66 6e 61 6d 65 ronment to fname
1ec0: 2e 63 73 68 20 61 6e 64 20 66 6e 61 6d 65 2e 73 .csh and fname.s
1ed0: 68 0a 20 20 2d 72 65 66 64 62 32 64 61 74 20 72 h. -refdb2dat r
1ee0: 65 66 64 62 20 20 20 20 20 20 20 20 3a 20 63 6f efdb : co
1ef0: 6e 76 65 72 74 20 72 65 66 64 62 20 74 6f 20 73 nvert refdb to s
1f00: 65 78 70 20 6f 72 20 74 6f 20 66 6f 72 6d 61 74 exp or to format
1f10: 20 73 70 65 63 69 66 69 65 64 20 62 79 20 2d 64 specified by -d
1f20: 75 6d 70 6d 6f 64 65 0a 20 20 20 20 20 20 20 20 umpmode.
1f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f40: 20 20 20 20 66 6f 72 6d 61 74 73 3a 20 70 65 72 formats: per
1f50: 6c 2c 20 72 75 62 79 2c 20 73 71 6c 69 74 65 33 l, ruby, sqlite3
1f60: 2c 20 63 73 76 20 28 66 6f 72 20 63 73 76 20 74 , csv (for csv t
1f70: 68 65 20 2d 6f 20 70 61 72 61 6d 0a 20 20 20 20 he -o param.
1f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f90: 20 20 20 20 20 20 20 20 77 69 6c 6c 20 73 75 62 will sub
1fa0: 73 74 69 74 75 74 65 20 25 73 20 66 6f 72 20 74 stitute %s for t
1fb0: 68 65 20 73 68 65 65 74 20 6e 61 6d 65 20 69 6e he sheet name in
1fc0: 20 67 65 6e 65 72 61 74 69 6e 67 20 0a 20 20 20 generating .
1fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fe0: 20 20 20 20 20 20 20 20 20 6d 75 6c 74 69 70 6c multipl
1ff0: 65 20 73 68 65 65 74 73 29 0a 20 20 2d 6f 20 20 e sheets). -o
2000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2010: 20 20 20 20 3a 20 6f 75 74 70 75 74 20 66 69 6c : output fil
2020: 65 20 66 6f 72 20 72 65 66 64 62 32 64 61 74 20 e for refdb2dat
2030: 28 64 65 66 61 75 6c 74 73 20 74 6f 20 73 74 64 (defaults to std
2040: 6f 75 74 29 0a 20 20 2d 61 72 63 68 69 76 65 20 out). -archive
2050: 63 6d 64 20 20 20 20 20 20 20 20 20 20 20 20 3a cmd :
2060: 20 61 72 63 68 69 76 65 20 72 75 6e 73 20 73 70 archive runs sp
2070: 65 63 69 66 69 65 64 20 62 79 20 73 65 6c 65 63 ecified by selec
2080: 74 6f 72 73 20 74 6f 20 6f 6e 65 20 6f 66 20 64 tors to one of d
2090: 69 73 6b 73 20 73 70 65 63 69 66 69 65 64 0a 20 isks specified.
20a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20b0: 20 20 20 20 20 20 20 20 20 20 20 69 6e 20 74 68 in th
20c0: 65 20 5b 61 72 63 68 69 76 65 2d 64 69 73 6b 73 e [archive-disks
20d0: 5d 20 73 65 63 74 69 6f 6e 2e 0a 20 20 20 20 20 ] section..
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 63 6d 64 3a 20 6b 65 65 70 cmd: keep
2100: 2d 68 74 6d 6c 2c 20 72 65 73 74 6f 72 65 2c 20 -html, restore,
2110: 73 61 76 65 2c 20 73 61 76 65 2d 72 65 6d 6f 76 save, save-remov
2120: 65 0a 0a 53 70 72 65 61 64 73 68 65 65 74 20 67 e..Spreadsheet g
2130: 65 6e 65 72 61 74 69 6f 6e 0a 20 20 2d 65 78 74 eneration. -ext
2140: 72 61 63 74 2d 6f 64 73 20 66 6e 61 6d 65 2e 6f ract-ods fname.o
2150: 64 73 20 20 3a 20 65 78 74 72 61 63 74 20 61 6e ds : extract an
2160: 20 6f 70 65 6e 20 64 6f 63 75 6d 65 6e 74 20 73 open document s
2170: 70 72 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 preadsheet from
2180: 74 68 65 20 64 61 74 61 62 61 73 65 0a 20 20 2d the database. -
2190: 70 61 74 68 6d 6f 64 20 70 61 74 68 20 20 20 20 pathmod path
21a0: 20 20 20 20 20 20 20 3a 20 69 6e 73 65 72 74 20 : insert
21b0: 70 61 74 68 2c 20 69 2e 65 2e 20 70 61 74 68 2f path, i.e. path/
21c0: 72 75 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f runame/itempath/
21d0: 6c 6f 67 66 69 6c 65 2e 68 74 6d 6c 0a 20 20 20 logfile.html.
21e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21f0: 20 20 20 20 20 20 20 20 20 77 69 6c 6c 20 63 6c will cl
2200: 65 61 72 20 74 68 65 20 66 69 65 6c 64 20 69 66 ear the field if
2210: 20 6e 6f 20 72 75 6e 64 69 72 2f 74 65 73 74 6e no rundir/testn
2220: 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f 67 ame/itempath/log
2230: 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 file.
2240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2250: 20 69 66 20 69 74 20 63 6f 6e 74 61 69 6e 73 20 if it contains
2260: 66 6f 72 77 61 72 64 20 73 6c 61 73 68 65 73 20 forward slashes
2270: 74 68 65 20 70 61 74 68 20 77 69 6c 6c 20 62 65 the path will be
2280: 20 63 6f 6e 76 65 72 74 65 64 0a 20 20 20 20 20 converted.
2290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22a0: 20 20 20 20 20 20 20 74 6f 20 77 69 6e 64 6f 77 to window
22b0: 73 20 73 74 79 6c 65 0a 47 65 74 74 69 6e 67 20 s style.Getting
22c0: 73 74 61 72 74 65 64 0a 20 20 2d 67 65 6e 2d 6d started. -gen-m
22d0: 65 67 61 74 65 73 74 2d 61 72 65 61 20 20 20 20 egatest-area
22e0: 20 20 20 3a 20 63 72 65 61 74 65 20 61 20 73 6b : create a sk
22f0: 65 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 74 20 eleton megatest
2300: 61 72 65 61 2e 20 59 6f 75 20 77 69 6c 6c 20 62 area. You will b
2310: 65 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 20 70 e prompted for p
2320: 61 74 68 73 0a 20 20 2d 67 65 6e 2d 6d 65 67 61 aths. -gen-mega
2330: 74 65 73 74 2d 74 65 73 74 20 74 6e 61 6d 65 20 test-test tname
2340: 3a 20 63 72 65 61 74 65 20 61 20 73 6b 65 6c 65 : create a skele
2350: 74 6f 6e 20 6d 65 67 61 74 65 73 74 20 74 65 73 ton megatest tes
2360: 74 2e 20 59 6f 75 20 77 69 6c 6c 20 62 65 20 70 t. You will be p
2370: 72 6f 6d 70 74 65 64 20 66 6f 72 20 69 6e 66 6f rompted for info
2380: 0a 0a 45 78 61 6d 70 6c 65 73 0a 0a 23 20 47 65 ..Examples..# Ge
2390: 74 20 74 65 73 74 20 70 61 74 68 2c 20 75 73 65 t test path, use
23a0: 20 27 2e 27 20 74 6f 20 67 65 74 20 61 20 73 69 '.' to get a si
23b0: 6e 67 6c 65 20 70 61 74 68 20 6f 72 20 61 20 73 ngle path or a s
23c0: 70 65 63 69 66 69 63 20 70 61 74 68 2f 66 69 6c pecific path/fil
23d0: 65 20 70 61 74 74 65 72 6e 0a 6d 65 67 61 74 65 e pattern.megate
23e0: 73 74 20 2d 74 65 73 74 2d 66 69 6c 65 73 20 27 st -test-files '
23f0: 6c 6f 67 73 2f 2a 2e 6c 6f 67 27 20 2d 74 61 72 logs/*.log' -tar
2400: 67 65 74 20 75 62 75 6e 74 75 2f 6e 25 2f 6e 6f get ubuntu/n%/no
2410: 25 20 2d 72 75 6e 6e 61 6d 65 20 77 34 39 25 20 % -runname w49%
2420: 2d 74 65 73 74 70 61 74 74 20 74 65 73 74 5f 6d -testpatt test_m
2430: 74 25 0a 0a 43 61 6c 6c 65 64 20 61 73 20 22 20 t%..Called as "
2440: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
2450: 72 73 65 20 28 61 72 67 76 29 20 22 20 22 29 20 rse (argv) " ")
2460: 22 0a 56 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 ".Version " mega
2470: 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 2c 20 test-version ",
2480: 62 75 69 6c 74 20 66 72 6f 6d 20 22 20 6d 65 67 built from " meg
2490: 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 atest-fossil-has
24a0: 68 20 29 29 0a 0a 3b 3b 20 20 2d 67 75 69 20 20 h ))..;; -gui
24b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24c0: 20 20 3a 20 73 74 61 72 74 20 61 20 67 75 69 20 : start a gui
24d0: 69 6e 74 65 72 66 61 63 65 0a 3b 3b 20 20 2d 63 interface.;; -c
24e0: 6f 6e 66 69 67 20 66 6e 61 6d 65 20 20 20 20 20 onfig fname
24f0: 20 20 20 20 20 20 3a 20 6f 76 65 72 72 69 64 65 : override
2500: 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 20 66 the runconfig f
2510: 69 6c 65 20 77 69 74 68 20 66 6e 61 6d 65 0a 0a ile with fname..
2520: 3b 3b 20 70 72 6f 63 65 73 73 20 61 72 67 73 0a ;; process args.
2530: 28 64 65 66 69 6e 65 20 72 65 6d 61 72 67 73 20 (define remargs
2540: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 73 20 0a (args:get-args .
2550: 09 09 20 28 61 72 67 76 29 0a 09 09 20 28 6c 69 .. (argv)... (li
2560: 73 74 20 20 22 2d 72 75 6e 74 65 73 74 73 22 20 st "-runtests"
2570: 20 3b 3b 20 72 75 6e 20 61 20 73 70 65 63 69 66 ;; run a specif
2580: 69 63 20 74 65 73 74 0a 09 09 09 22 2d 63 6f 6e ic test...."-con
2590: 66 69 67 22 20 20 20 20 3b 3b 20 6f 76 65 72 72 fig" ;; overr
25a0: 69 64 65 20 74 68 65 20 63 6f 6e 66 69 67 20 66 ide the config f
25b0: 69 6c 65 20 6e 61 6d 65 0a 09 09 09 22 2d 65 78 ile name...."-ex
25c0: 65 63 75 74 65 22 20 20 20 3b 3b 20 72 75 6e 20 ecute" ;; run
25d0: 74 68 65 20 63 6f 6d 6d 61 6e 64 20 65 6e 63 6f the command enco
25e0: 64 65 64 20 69 6e 20 74 68 65 20 62 61 73 65 36 ded in the base6
25f0: 34 20 70 61 72 61 6d 65 74 65 72 0a 09 09 09 22 4 parameter...."
2600: 2d 73 74 65 70 22 0a 09 09 09 22 2d 74 61 72 67 -step"...."-targ
2610: 65 74 22 0a 09 09 09 22 2d 72 65 71 74 61 72 67 et"...."-reqtarg
2620: 22 0a 09 09 09 22 3a 72 75 6e 6e 61 6d 65 22 0a "....":runname".
2630: 09 09 09 22 2d 72 75 6e 6e 61 6d 65 22 0a 09 09 ..."-runname"...
2640: 09 22 3a 73 74 61 74 65 22 20 20 0a 09 09 09 22 .":state" ...."
2650: 2d 73 74 61 74 65 22 0a 09 09 09 22 3a 73 74 61 -state"....":sta
2660: 74 75 73 22 0a 09 09 09 22 2d 73 74 61 74 75 73 tus"...."-status
2670: 22 0a 09 09 09 22 2d 6c 69 73 74 2d 72 75 6e 73 "...."-list-runs
2680: 22 0a 09 09 09 22 2d 74 65 73 74 70 61 74 74 22 "...."-testpatt"
2690: 20 0a 09 09 09 22 2d 69 74 65 6d 70 61 74 74 22 ...."-itempatt"
26a0: 0a 09 09 09 22 2d 73 65 74 6c 6f 67 22 0a 09 09 ...."-setlog"...
26b0: 09 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 0a 09 ."-set-toplog"..
26c0: 09 09 22 2d 72 75 6e 73 74 65 70 22 0a 09 09 09 .."-runstep"....
26d0: 22 2d 6c 6f 67 70 72 6f 22 0a 09 09 09 22 2d 6d "-logpro"...."-m
26e0: 22 0a 09 09 09 22 2d 72 65 72 75 6e 22 0a 09 09 "...."-rerun"...
26f0: 09 22 2d 64 61 79 73 22 0a 09 09 09 22 2d 72 65 ."-days"...."-re
2700: 6e 61 6d 65 2d 72 75 6e 22 0a 09 09 09 22 2d 74 name-run"...."-t
2710: 6f 22 0a 09 09 09 3b 3b 20 76 61 6c 75 65 73 20 o"....;; values
2720: 61 6e 64 20 6d 65 73 73 61 67 65 73 0a 09 09 09 and messages....
2730: 22 3a 63 61 74 65 67 6f 72 79 22 0a 09 09 09 22 ":category"...."
2740: 3a 76 61 72 69 61 62 6c 65 22 0a 09 09 09 22 3a :variable"....":
2750: 76 61 6c 75 65 22 0a 09 09 09 22 3a 65 78 70 65 value"....":expe
2760: 63 74 65 64 22 0a 09 09 09 22 3a 74 6f 6c 22 0a cted"....":tol".
2770: 09 09 09 22 3a 75 6e 69 74 73 22 0a 09 09 09 3b ...":units"....;
2780: 3b 20 6d 69 73 63 0a 09 09 09 22 2d 73 74 61 72 ; misc...."-star
2790: 74 2d 64 69 72 22 0a 09 09 09 22 2d 73 65 72 76 t-dir"...."-serv
27a0: 65 72 22 0a 09 09 09 22 2d 73 74 6f 70 2d 73 65 er"...."-stop-se
27b0: 72 76 65 72 22 0a 09 09 09 22 2d 74 72 61 6e 73 rver"...."-trans
27c0: 70 6f 72 74 22 0a 09 09 09 22 2d 6b 69 6c 6c 2d port"...."-kill-
27d0: 73 65 72 76 65 72 22 0a 09 09 09 22 2d 70 6f 72 server"...."-por
27e0: 74 22 0a 09 09 09 22 2d 65 78 74 72 61 63 74 2d t"...."-extract-
27f0: 6f 64 73 22 0a 09 09 09 22 2d 70 61 74 68 6d 6f ods"...."-pathmo
2800: 64 22 0a 09 09 09 22 2d 65 6e 76 32 66 69 6c 65 d"...."-env2file
2810: 22 0a 09 09 09 22 2d 73 65 74 76 61 72 73 22 0a "...."-setvars".
2820: 09 09 09 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 ..."-set-state-s
2830: 74 61 74 75 73 22 0a 09 09 09 22 2d 73 65 74 2d tatus"...."-set-
2840: 72 75 6e 2d 73 74 61 74 75 73 22 0a 09 09 09 22 run-status"...."
2850: 2d 64 65 62 75 67 22 20 3b 3b 20 66 6f 72 20 2a -debug" ;; for *
2860: 76 65 72 62 6f 73 69 74 79 2a 20 3e 20 32 0a 09 verbosity* > 2..
2870: 09 09 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 .."-gen-megatest
2880: 2d 74 65 73 74 22 0a 09 09 09 22 2d 6f 76 65 72 -test"...."-over
2890: 72 69 64 65 2d 74 69 6d 65 6f 75 74 22 0a 09 09 ride-timeout"...
28a0: 09 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 20 20 ."-test-files"
28b0: 3b 3b 20 2d 74 65 73 74 2d 70 61 74 68 73 20 69 ;; -test-paths i
28c0: 73 20 66 6f 72 20 6c 69 73 74 69 6e 67 20 61 6c s for listing al
28d0: 6c 0a 09 09 09 22 2d 6c 6f 61 64 22 20 20 20 20 l...."-load"
28e0: 20 20 20 20 3b 3b 20 6c 6f 61 64 20 61 6e 64 20 ;; load and
28f0: 65 78 65 63 74 75 74 65 20 61 20 73 63 68 65 6d exectute a schem
2900: 65 20 66 69 6c 65 0a 09 09 09 22 2d 73 65 63 74 e file...."-sect
2910: 69 6f 6e 22 0a 09 09 09 22 2d 76 61 72 22 0a 09 ion"...."-var"..
2920: 09 09 22 2d 64 75 6d 70 6d 6f 64 65 22 0a 09 09 .."-dumpmode"...
2930: 09 22 2d 72 75 6e 2d 69 64 22 0a 09 09 09 22 2d ."-run-id"...."-
2940: 70 69 6e 67 22 0a 09 09 09 22 2d 72 65 66 64 62 ping"...."-refdb
2950: 32 64 61 74 22 0a 09 09 09 22 2d 6f 22 0a 09 09 2dat"...."-o"...
2960: 09 22 2d 6c 6f 67 22 0a 09 09 09 22 2d 61 72 63 ."-log"...."-arc
2970: 68 69 76 65 22 0a 09 09 09 29 20 0a 09 09 20 28 hive"....) ... (
2980: 6c 69 73 74 20 20 22 2d 68 22 20 22 2d 68 65 6c list "-h" "-hel
2990: 70 22 20 22 2d 2d 68 65 6c 70 22 0a 09 09 09 22 p" "--help"...."
29a0: 2d 76 65 72 73 69 6f 6e 22 0a 09 09 20 20 20 20 -version"...
29b0: 20 20 20 20 22 2d 66 6f 72 63 65 22 0a 09 09 20 "-force"...
29c0: 20 20 20 20 20 20 20 22 2d 78 74 65 72 6d 22 0a "-xterm".
29d0: 09 09 20 20 20 20 20 20 20 20 22 2d 73 68 6f 77 .. "-show
29e0: 6b 65 79 73 22 0a 09 09 20 20 20 20 20 20 20 20 keys"...
29f0: 22 2d 73 68 6f 77 2d 6b 65 79 73 22 0a 09 09 20 "-show-keys"...
2a00: 20 20 20 20 20 20 20 22 2d 74 65 73 74 2d 73 74 "-test-st
2a10: 61 74 75 73 22 0a 09 09 09 22 2d 73 65 74 2d 76 atus"...."-set-v
2a20: 61 6c 75 65 73 22 0a 09 09 09 22 2d 6c 6f 61 64 alues"...."-load
2a30: 2d 74 65 73 74 2d 64 61 74 61 22 0a 09 09 09 22 -test-data"...."
2a40: 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 -summarize-items
2a50: 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d 67 75 "... "-gu
2a60: 69 22 0a 09 09 09 22 2d 64 61 65 6d 6f 6e 69 7a i"...."-daemoniz
2a70: 65 22 0a 09 09 09 22 2d 70 72 65 63 6c 65 61 6e e"...."-preclean
2a80: 22 0a 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 09 "....;; misc....
2a90: 22 2d 72 65 70 6c 22 0a 09 09 09 22 2d 6c 6f 63 "-repl"...."-loc
2aa0: 6b 22 0a 09 09 09 22 2d 75 6e 6c 6f 63 6b 22 0a k"...."-unlock".
2ab0: 09 09 09 22 2d 6c 69 73 74 2d 73 65 72 76 65 72 ..."-list-server
2ac0: 73 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s".
2ad0: 20 20 20 20 20 20 20 20 20 20 20 22 2d 72 75 6e "-run
2ae0: 2d 77 61 69 74 22 20 20 20 20 20 20 3b 3b 20 77 -wait" ;; w
2af0: 61 69 74 20 6f 6e 20 61 20 72 75 6e 20 74 6f 20 ait on a run to
2b00: 63 6f 6d 70 6c 65 74 65 20 28 69 2e 65 2e 20 6e complete (i.e. n
2b10: 6f 20 52 55 4e 4e 49 4e 47 29 0a 0a 09 09 09 3b o RUNNING).....;
2b20: 3b 20 6d 69 73 63 20 71 75 65 72 69 65 73 0a 09 ; misc queries..
2b30: 09 09 22 2d 6c 69 73 74 2d 64 69 73 6b 73 22 0a .."-list-disks".
2b40: 09 09 09 22 2d 6c 69 73 74 2d 74 61 72 67 65 74 ..."-list-target
2b50: 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d 64 62 2d s"...."-list-db-
2b60: 74 61 72 67 65 74 73 22 0a 09 09 09 22 2d 73 68 targets"...."-sh
2b70: 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 22 0a 09 09 ow-runconfig"...
2b80: 09 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 22 0a ."-show-config".
2b90: 09 09 09 22 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 ..."-show-cmdinf
2ba0: 6f 22 0a 09 09 09 22 2d 67 65 74 2d 72 75 6e 2d o"...."-get-run-
2bb0: 73 74 61 74 75 73 22 0a 0a 09 09 09 3b 3b 20 71 status".....;; q
2bc0: 75 65 72 69 65 73 0a 09 09 09 22 2d 74 65 73 74 ueries...."-test
2bd0: 2d 70 61 74 68 73 22 20 3b 3b 20 67 65 74 20 70 -paths" ;; get p
2be0: 61 74 68 28 73 29 20 74 6f 20 61 20 74 65 73 74 ath(s) to a test
2bf0: 2c 20 6f 72 64 65 72 65 64 20 62 79 20 79 6f 75 , ordered by you
2c00: 6e 67 65 73 74 20 66 69 72 73 74 0a 0a 09 09 09 ngest first.....
2c10: 22 2d 72 75 6e 61 6c 6c 22 20 20 20 20 3b 3b 20 "-runall" ;;
2c20: 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 0a 09 09 run all tests...
2c30: 09 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 0a ."-remove-runs".
2c40: 09 09 09 22 2d 72 65 62 75 69 6c 64 2d 64 62 22 ..."-rebuild-db"
2c50: 0a 09 09 09 22 2d 63 6c 65 61 6e 75 70 2d 64 62 ...."-cleanup-db
2c60: 22 0a 09 09 09 22 2d 72 6f 6c 6c 75 70 22 0a 09 "...."-rollup"..
2c70: 09 09 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 22 .."-update-meta"
2c80: 0a 09 09 09 22 2d 67 65 6e 2d 6d 65 67 61 74 65 ...."-gen-megate
2c90: 73 74 2d 61 72 65 61 22 0a 09 09 09 22 2d 6d 61 st-area"...."-ma
2ca0: 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 22 0a rk-incompletes".
2cb0: 0a 09 09 09 22 2d 63 6f 6e 76 65 72 74 2d 74 6f ...."-convert-to
2cc0: 2d 6e 6f 72 6d 22 0a 09 09 09 22 2d 63 6f 6e 76 -norm"...."-conv
2cd0: 65 72 74 2d 74 6f 2d 6f 6c 64 22 0a 09 09 09 22 ert-to-old"...."
2ce0: 2d 69 6d 70 6f 72 74 2d 6d 65 67 61 74 65 73 74 -import-megatest
2cf0: 2e 64 62 22 0a 09 09 09 22 2d 73 79 6e 63 2d 74 .db"...."-sync-t
2d00: 6f 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 0a 0a o-megatest.db"..
2d10: 09 09 09 22 2d 6c 6f 67 67 69 6e 67 22 0a 09 09 ..."-logging"...
2d20: 09 22 2d 76 22 20 3b 3b 20 76 65 72 62 6f 73 65 ."-v" ;; verbose
2d30: 20 32 2c 20 6d 6f 72 65 20 74 68 61 6e 20 6e 6f 2, more than no
2d40: 72 6d 61 6c 20 28 6e 6f 72 6d 61 6c 20 69 73 20 rmal (normal is
2d50: 31 29 0a 09 09 09 22 2d 71 22 20 3b 3b 20 71 75 1)...."-q" ;; qu
2d60: 69 65 74 20 30 2c 20 65 72 72 6f 72 73 2f 77 61 iet 0, errors/wa
2d70: 72 6e 69 6e 67 73 20 6f 6e 6c 79 0a 09 09 20 20 rnings only...
2d80: 20 20 20 20 20 29 0a 09 09 20 61 72 67 73 3a 61 )... args:a
2d90: 72 67 2d 68 61 73 68 0a 09 09 20 30 29 29 0a 0a rg-hash... 0))..
2da0: 3b 3b 20 54 68 65 20 77 61 74 63 68 64 6f 67 20 ;; The watchdog
2db0: 69 73 20 74 6f 20 6b 65 65 70 20 61 6e 20 65 79 is to keep an ey
2dc0: 65 20 6f 6e 20 74 68 69 6e 67 73 20 6c 69 6b 65 e on things like
2dd0: 20 64 62 20 73 79 6e 63 20 65 74 63 2e 0a 3b 3b db sync etc..;;
2de0: 0a 28 64 65 66 69 6e 65 20 2a 74 69 6d 65 2d 7a .(define *time-z
2df0: 65 72 6f 2a 20 28 63 75 72 72 65 6e 74 2d 73 65 ero* (current-se
2e00: 63 6f 6e 64 73 29 29 0a 28 64 65 66 69 6e 65 20 conds)).(define
2e10: 2a 77 61 74 63 68 64 6f 67 2a 0a 20 20 28 6d 61 *watchdog*. (ma
2e20: 6b 65 2d 74 68 72 65 61 64 20 0a 20 20 20 28 6c ke-thread . (l
2e30: 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 28 74 ambda (). (t
2e40: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 30 hread-sleep! 0.0
2e50: 35 29 20 3b 3b 20 64 65 6c 61 79 20 66 6f 72 20 5) ;; delay for
2e60: 73 74 61 72 74 75 70 0a 20 20 20 20 20 3b 3b 20 startup. ;;
2e70: 74 68 65 20 71 75 65 72 79 20 74 6f 20 67 65 74 the query to get
2e80: 20 6d 65 67 61 74 65 73 74 2d 64 62 20 73 65 74 megatest-db set
2e90: 74 69 6e 67 20 6d 69 67 68 74 20 6e 6f 74 20 77 ting might not w
2ea0: 6f 72 6b 2c 20 66 6f 72 63 69 6e 67 20 69 74 20 ork, forcing it
2eb0: 74 6f 20 62 65 20 64 65 66 61 75 6c 74 20 6f 6e to be default on
2ec0: 2e 20 55 73 65 20 22 6e 6f 22 20 74 6f 20 74 75 . Use "no" to tu
2ed0: 72 6e 20 6f 66 66 0a 20 20 20 20 20 28 6c 65 74 rn off. (let
2ee0: 20 28 28 6c 65 67 61 63 79 2d 73 79 6e 63 20 28 ((legacy-sync (
2ef0: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 28 configf:lookup (
2f00: 6d 65 67 61 74 65 73 74 3a 61 72 65 61 2d 63 6f megatest:area-co
2f10: 6e 66 69 67 64 61 74 20 2a 61 72 65 61 2d 64 61 nfigdat *area-da
2f20: 74 2a 29 20 22 73 65 74 75 70 22 20 22 6d 65 67 t*) "setup" "meg
2f30: 61 74 65 73 74 2d 64 62 22 29 29 0a 09 20 20 20 atest-db"))..
2f40: 28 64 65 62 75 67 2d 6d 6f 64 65 20 20 28 64 65 (debug-mode (de
2f50: 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 31 bug:debug-mode 1
2f60: 29 29 0a 09 20 20 20 28 6c 61 73 74 2d 74 69 6d )).. (last-tim
2f70: 65 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 e (current-sec
2f80: 6f 6e 64 73 29 29 29 0a 20 20 20 20 20 20 20 28 onds))). (
2f90: 6c 65 74 20 6c 6f 6f 70 20 28 29 0a 09 20 3b 3b let loop ().. ;;
2fa0: 20 73 79 6e 63 20 66 6f 72 20 66 69 6c 65 73 79 sync for filesy
2fb0: 73 74 65 6d 20 6c 6f 63 61 6c 20 64 62 20 77 72 stem local db wr
2fc0: 69 74 65 73 0a 09 20 3b 3b 0a 09 20 28 6c 65 74 ites.. ;;.. (let
2fd0: 20 28 28 73 74 61 72 74 2d 74 69 6d 65 20 20 20 ((start-time
2fe0: 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (current-seco
2ff0: 6e 64 73 29 29 0a 09 20 20 20 20 20 20 20 28 73 nds)).. (s
3000: 65 72 76 65 72 73 2d 73 74 61 72 74 65 64 20 28 ervers-started (
3010: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
3020: 29 29 0a 09 20 20 20 28 66 6f 72 2d 65 61 63 68 )).. (for-each
3030: 20 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 .. (lambda (
3040: 72 75 6e 2d 69 64 29 0a 09 20 20 20 20 20 20 28 run-id).. (
3050: 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 64 62 2d mutex-lock! *db-
3060: 6d 75 6c 74 69 2d 73 79 6e 63 2d 6d 75 74 65 78 multi-sync-mutex
3070: 2a 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 *).. (if (a
3080: 6e 64 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 nd (not (equal?
3090: 6c 65 67 61 63 79 2d 73 79 6e 63 20 22 6e 6f 22 legacy-sync "no"
30a0: 29 29 0a 09 09 20 20 20 20 20 20 20 28 68 61 73 ))... (has
30b0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
30c0: 75 6c 74 20 2a 64 62 2d 6c 6f 63 61 6c 2d 73 79 ult *db-local-sy
30d0: 6e 63 2a 20 72 75 6e 2d 69 64 20 23 66 29 29 0a nc* run-id #f)).
30e0: 09 09 20 20 3b 3b 20 28 69 66 20 28 3e 20 28 2d .. ;; (if (> (-
30f0: 20 73 74 61 72 74 2d 74 69 6d 65 20 6c 61 73 74 start-time last
3100: 2d 77 72 69 74 65 29 20 35 29 20 3b 3b 20 65 76 -write) 5) ;; ev
3110: 65 72 79 20 66 69 76 65 20 73 65 63 6f 6e 64 73 ery five seconds
3120: 0a 09 09 20 20 28 62 65 67 69 6e 20 3b 3b 20 6c ... (begin ;; l
3130: 65 74 20 28 28 73 79 6e 63 2d 74 69 6d 65 20 28 et ((sync-time (
3140: 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e - (current-secon
3150: 64 73 29 20 73 74 61 72 74 2d 74 69 6d 65 29 29 ds) start-time))
3160: 29 0a 09 09 20 20 20 20 28 64 62 3a 6d 75 6c 74 )... (db:mult
3170: 69 2d 64 62 2d 73 79 6e 63 20 28 6c 69 73 74 20 i-db-sync (list
3180: 72 75 6e 2d 69 64 29 20 27 6e 65 77 32 6f 6c 64 run-id) 'new2old
3190: 29 0a 09 09 20 20 20 20 28 69 66 20 28 63 6f 6d )... (if (com
31a0: 6d 6f 6e 3a 6c 6f 77 2d 6e 6f 69 73 65 2d 70 72 mon:low-noise-pr
31b0: 69 6e 74 20 33 30 20 22 73 79 6e 63 20 6e 65 77 int 30 "sync new
31c0: 20 74 6f 20 6f 6c 64 22 29 0a 09 09 09 28 6c 65 to old")....(le
31d0: 74 20 28 28 73 79 6e 63 2d 74 69 6d 65 20 28 2d t ((sync-time (-
31e0: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
31f0: 73 29 20 73 74 61 72 74 2d 74 69 6d 65 29 29 29 s) start-time)))
3200: 0a 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 .... (debug:pri
3210: 6e 74 2d 69 6e 66 6f 20 30 20 22 53 79 6e 63 20 nt-info 0 "Sync
3220: 6f 66 20 6e 65 77 64 62 20 74 6f 20 6f 6c 64 64 of newdb to oldd
3230: 62 20 66 6f 72 20 72 75 6e 2d 69 64 20 22 20 72 b for run-id " r
3240: 75 6e 2d 69 64 20 22 20 63 6f 6d 70 6c 65 74 65 un-id " complete
3250: 64 20 69 6e 20 22 20 73 79 6e 63 2d 74 69 6d 65 d in " sync-time
3260: 20 22 20 73 65 63 6f 6e 64 73 22 29 29 29 0a 09 " seconds")))..
3270: 09 20 20 20 20 3b 3b 20 28 69 66 20 28 3e 20 73 . ;; (if (> s
3280: 79 6e 63 2d 74 69 6d 65 20 31 30 29 20 3b 3b 20 ync-time 10) ;;
3290: 74 6f 6f 6b 20 6d 6f 72 65 20 74 68 61 6e 20 74 took more than t
32a0: 65 6e 20 73 65 63 6f 6e 64 73 2c 20 73 74 61 72 en seconds, star
32b0: 74 20 61 20 73 65 72 76 65 72 20 66 6f 72 20 74 t a server for t
32c0: 68 69 73 20 72 75 6e 0a 09 09 20 20 20 20 3b 3b his run... ;;
32d0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 (begin...
32e0: 20 20 3b 3b 20 20 20 20 20 20 20 28 64 65 62 75 ;; (debu
32f0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 g:print-info 0 "
3300: 53 79 6e 63 20 69 73 20 74 61 6b 69 6e 67 20 61 Sync is taking a
3310: 20 6c 6f 6e 67 20 74 69 6d 65 2c 20 73 74 61 72 long time, star
3320: 74 20 75 70 20 61 20 73 65 72 76 65 72 20 74 6f t up a server to
3330: 20 61 73 73 69 73 74 20 66 6f 72 20 72 75 6e 20 assist for run
3340: 22 20 72 75 6e 2d 69 64 29 0a 09 09 20 20 20 20 " run-id)...
3350: 3b 3b 20 20 20 20 20 20 20 28 73 65 72 76 65 72 ;; (server
3360: 3a 6b 69 6e 64 2d 72 75 6e 20 72 75 6e 2d 69 64 :kind-run run-id
3370: 29 29 29 29 29 0a 09 09 20 20 20 20 28 68 61 73 )))))... (has
3380: 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 h-table-delete!
3390: 2a 64 62 2d 6c 6f 63 61 6c 2d 73 79 6e 63 2a 20 *db-local-sync*
33a0: 72 75 6e 2d 69 64 29 29 29 0a 09 20 20 20 20 20 run-id)))..
33b0: 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 (mutex-unlock!
33c0: 2a 64 62 2d 6d 75 6c 74 69 2d 73 79 6e 63 2d 6d *db-multi-sync-m
33d0: 75 74 65 78 2a 29 29 0a 09 20 20 20 20 28 68 61 utex*)).. (ha
33e0: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 2a 64 sh-table-keys *d
33f0: 62 2d 6c 6f 63 61 6c 2d 73 79 6e 63 2a 29 29 0a b-local-sync*)).
3400: 09 20 20 20 28 69 66 20 28 61 6e 64 20 64 65 62 . (if (and deb
3410: 75 67 2d 6d 6f 64 65 0a 09 09 20 20 20 20 28 3e ug-mode... (>
3420: 20 28 2d 20 73 74 61 72 74 2d 74 69 6d 65 20 6c (- start-time l
3430: 61 73 74 2d 74 69 6d 65 29 20 36 30 29 29 0a 09 ast-time) 60))..
3440: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 (begin...
3450: 20 28 73 65 74 21 20 6c 61 73 74 2d 74 69 6d 65 (set! last-time
3460: 20 73 74 61 72 74 2d 74 69 6d 65 29 0a 09 09 20 start-time)...
3470: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
3480: 6f 20 34 20 22 74 69 6d 65 73 74 61 6d 70 20 2d o 4 "timestamp -
3490: 3e 20 22 20 28 73 65 63 6f 6e 64 73 2d 3e 74 69 > " (seconds->ti
34a0: 6d 65 2d 73 74 72 69 6e 67 20 28 63 75 72 72 65 me-string (curre
34b0: 6e 74 2d 73 65 63 6f 6e 64 73 29 29 20 22 2c 20 nt-seconds)) ",
34c0: 74 69 6d 65 20 73 69 6e 63 65 20 73 74 61 72 74 time since start
34d0: 20 2d 3e 20 22 20 28 73 65 63 6f 6e 64 73 2d 3e -> " (seconds->
34e0: 68 72 2d 6d 69 6e 2d 73 65 63 20 28 2d 20 28 63 hr-min-sec (- (c
34f0: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 urrent-seconds)
3500: 2a 74 69 6d 65 2d 7a 65 72 6f 2a 29 29 29 29 29 *time-zero*)))))
3510: 29 0a 09 20 0a 09 20 3b 3b 20 6b 65 65 70 20 67 ).. .. ;; keep g
3520: 6f 69 6e 67 20 75 6e 6c 65 73 73 20 74 69 6d 65 oing unless time
3530: 20 74 6f 20 65 78 69 74 0a 09 20 3b 3b 0a 09 20 to exit.. ;;..
3540: 28 69 66 20 28 6e 6f 74 20 2a 74 69 6d 65 2d 74 (if (not *time-t
3550: 6f 2d 65 78 69 74 2a 29 0a 09 20 20 20 20 20 28 o-exit*).. (
3560: 6c 65 74 20 64 65 6c 61 79 2d 6c 6f 6f 70 20 28 let delay-loop (
3570: 28 63 6f 75 6e 74 20 30 29 29 0a 09 20 20 20 20 (count 0))..
3580: 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 (if (and (not
3590: 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a 29 *time-to-exit*)
35a0: 0a 09 09 09 28 3c 20 63 6f 75 6e 74 20 31 31 29 ....(< count 11)
35b0: 29 20 3b 3b 20 61 70 72 6f 78 20 35 2d 36 20 73 ) ;; aprox 5-6 s
35c0: 65 63 6f 6e 64 73 0a 09 09 20 20 20 28 62 65 67 econds... (beg
35d0: 69 6e 0a 09 09 20 20 20 20 20 28 74 68 72 65 61 in... (threa
35e0: 64 2d 73 6c 65 65 70 21 20 31 29 0a 09 09 20 20 d-sleep! 1)...
35f0: 20 20 20 28 64 65 6c 61 79 2d 6c 6f 6f 70 20 28 (delay-loop (
3600: 2b 20 63 6f 75 6e 74 20 31 29 29 29 29 0a 09 20 + count 1))))..
3610: 20 20 20 20 20 20 28 6c 6f 6f 70 29 29 29 29 29 (loop)))))
3620: 29 0a 20 20 20 22 57 61 74 63 68 64 6f 67 20 74 ). "Watchdog t
3630: 68 72 65 61 64 22 29 29 0a 0a 28 74 68 72 65 61 hread"))..(threa
3640: 64 2d 73 74 61 72 74 21 20 2a 77 61 74 63 68 64 d-start! *watchd
3650: 6f 67 2a 29 0a 0a 28 69 66 20 28 61 72 67 73 3a og*)..(if (args:
3660: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 0a get-arg "-log").
3670: 20 20 20 20 28 6c 65 74 20 28 28 6f 75 70 20 28 (let ((oup (
3680: 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 open-output-file
3690: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
36a0: 2d 6c 6f 67 22 29 29 29 29 0a 20 20 20 20 20 20 -log")))).
36b0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
36c0: 6f 20 30 20 22 53 65 6e 64 69 6e 67 20 6c 6f 67 o 0 "Sending log
36d0: 20 6f 75 74 70 75 74 20 74 6f 20 22 20 28 61 72 output to " (ar
36e0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 gs:get-arg "-log
36f0: 22 29 29 0a 20 20 20 20 20 20 28 63 75 72 72 65 ")). (curre
3700: 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 74 20 6f 75 nt-error-port ou
3710: 70 29 0a 20 20 20 20 20 20 28 63 75 72 72 65 6e p). (curren
3720: 74 2d 6f 75 74 70 75 74 2d 70 6f 72 74 20 6f 75 t-output-port ou
3730: 70 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 p)))..(if (or (a
3740: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 22 rgs:get-arg "-h"
3750: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
3760: 20 22 2d 68 65 6c 70 22 29 0a 09 28 61 72 67 73 "-help")..(args
3770: 3a 67 65 74 2d 61 72 67 20 22 2d 2d 68 65 6c 70 :get-arg "--help
3780: 22 29 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 ")). (begin.
3790: 20 20 20 20 20 28 70 72 69 6e 74 20 68 65 6c 70 (print help
37a0: 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 29 ). (exit)))
37b0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
37c0: 61 72 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 arg "-start-dir"
37d0: 29 0a 20 20 20 20 28 69 66 20 28 66 69 6c 65 2d ). (if (file-
37e0: 65 78 69 73 74 73 3f 20 28 61 72 67 73 3a 67 65 exists? (args:ge
37f0: 74 2d 61 72 67 20 22 2d 73 74 61 72 74 2d 64 69 t-arg "-start-di
3800: 72 22 29 29 0a 09 28 63 68 61 6e 67 65 2d 64 69 r"))..(change-di
3810: 72 65 63 74 6f 72 79 20 28 61 72 67 73 3a 67 65 rectory (args:ge
3820: 74 2d 61 72 67 20 22 2d 73 74 61 72 74 2d 64 69 t-arg "-start-di
3830: 72 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 r"))..(begin..
3840: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
3850: 45 52 52 4f 52 3a 20 6e 6f 6e 2d 65 78 69 73 74 ERROR: non-exist
3860: 61 6e 74 20 73 74 61 72 74 20 64 69 72 20 22 20 ant start dir "
3870: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3880: 73 74 61 72 74 2d 64 69 72 22 29 20 22 20 73 70 start-dir") " sp
3890: 65 63 69 66 69 65 64 2c 20 65 78 69 74 69 6e 67 ecified, exiting
38a0: 2e 22 29 0a 09 20 20 28 65 78 69 74 20 31 29 29 .").. (exit 1))
38b0: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
38c0: 74 2d 61 72 67 20 22 2d 76 65 72 73 69 6f 6e 22 t-arg "-version"
38d0: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
38e0: 20 20 20 28 70 72 69 6e 74 20 6d 65 67 61 74 65 (print megate
38f0: 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 20 20 20 st-version).
3900: 20 20 28 65 78 69 74 29 29 29 0a 0a 28 64 65 66 (exit)))..(def
3910: 69 6e 65 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e ine *didsomethin
3920: 67 2a 20 23 66 29 0a 0a 3b 3b 20 4f 76 65 72 61 g* #f)..;; Overa
3930: 6c 6c 20 65 78 69 74 20 68 61 6e 64 6c 69 6e 67 ll exit handling
3940: 20 73 65 74 75 70 20 69 6d 6d 65 64 69 61 74 65 setup immediate
3950: 6c 79 0a 3b 3b 0a 28 69 66 20 28 6f 72 20 28 61 ly.;;.(if (or (a
3960: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 72 rgs:get-arg "-pr
3970: 6f 63 65 73 73 2d 72 65 61 70 22 29 29 0a 20 20 ocess-reap")).
3980: 20 20 20 20 20 20 3b 3b 20 28 61 72 67 73 3a 67 ;; (args:g
3990: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
39a0: 73 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a 67 65 s")..;; (args:ge
39b0: 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 t-arg "-execute"
39c0: 29 0a 09 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d )..;; (args:get-
39d0: 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e arg "-remove-run
39e0: 73 22 29 0a 09 3b 3b 20 28 61 72 67 73 3a 67 65 s")..;; (args:ge
39f0: 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 t-arg "-runstep"
3a00: 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 6f 72 )). (let ((or
3a10: 69 67 69 6e 61 6c 2d 65 78 69 74 20 28 65 78 69 iginal-exit (exi
3a20: 74 2d 68 61 6e 64 6c 65 72 29 29 29 0a 20 20 20 t-handler))).
3a30: 20 20 20 28 65 78 69 74 2d 68 61 6e 64 6c 65 72 (exit-handler
3a40: 20 28 6c 61 6d 62 64 61 20 28 23 21 6f 70 74 69 (lambda (#!opti
3a50: 6f 6e 61 6c 20 28 65 78 69 74 2d 63 6f 64 65 20 onal (exit-code
3a60: 30 29 29 0a 09 09 20 20 20 20 20 20 28 70 72 69 0))... (pri
3a70: 6e 74 66 20 22 50 72 65 70 61 72 69 6e 67 20 74 ntf "Preparing t
3a80: 6f 20 65 78 69 74 20 77 69 74 68 20 65 78 69 74 o exit with exit
3a90: 20 63 6f 64 65 20 7e 41 20 2e 2e 2e 5c 6e 22 20 code ~A ...\n"
3aa0: 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 20 20 20 exit-code)...
3ab0: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 (for-each ...
3ac0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
3ad0: 70 69 64 29 0a 09 09 09 20 28 68 61 6e 64 6c 65 pid).... (handle
3ae0: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 20 -exceptions....
3af0: 20 65 78 6e 0a 09 09 09 20 20 23 74 0a 09 09 09 exn.... #t....
3b00: 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 (let-values ((
3b10: 28 70 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 (pid-val exit-st
3b20: 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 20 atus exit-code)
3b30: 28 70 72 6f 63 65 73 73 2d 77 61 69 74 20 70 69 (process-wait pi
3b40: 64 20 23 74 29 29 29 0a 09 09 09 09 20 20 20 20 d #t))).....
3b50: 20 20 28 69 66 20 28 6f 72 20 28 65 71 3f 20 70 (if (or (eq? p
3b60: 69 64 2d 76 61 6c 20 70 69 64 29 0a 09 09 09 09 id-val pid).....
3b70: 09 20 20 20 20 20 20 28 65 71 3f 20 70 69 64 2d . (eq? pid-
3b80: 76 61 6c 20 30 29 29 0a 09 09 09 09 09 20 20 28 val 0))...... (
3b90: 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 20 28 begin...... (
3ba0: 70 72 69 6e 74 66 20 22 53 65 6e 64 69 6e 67 20 printf "Sending
3bb0: 73 69 67 6e 61 6c 2f 74 65 72 6d 20 74 6f 20 7e signal/term to ~
3bc0: 41 5c 6e 22 20 70 69 64 29 0a 09 09 09 09 09 20 A\n" pid)......
3bd0: 20 20 20 28 70 72 6f 63 65 73 73 2d 73 69 67 6e (process-sign
3be0: 61 6c 20 70 69 64 20 73 69 67 6e 61 6c 2f 74 65 al pid signal/te
3bf0: 72 6d 29 29 29 29 29 29 0a 09 09 20 20 20 20 20 rm))))))...
3c00: 20 20 28 70 72 6f 63 65 73 73 3a 63 68 69 6c 64 (process:child
3c10: 72 65 6e 20 23 66 29 29 0a 09 09 20 20 20 20 20 ren #f))...
3c20: 20 28 6f 72 69 67 69 6e 61 6c 2d 65 78 69 74 20 (original-exit
3c30: 65 78 69 74 2d 63 6f 64 65 29 29 29 29 29 0a 0a exit-code)))))..
3c40: 3b 3b 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 3d 3d 3d 3d ================
3c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c80: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 ========.;; Misc
3c90: 20 73 65 74 75 70 20 73 74 75 66 66 0a 3b 3b 3d setup stuff.;;=
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 3d 3d 3d 3d 3d 3d 3d ================
3cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ce0: 3d 3d 3d 3d 3d 0a 0a 28 64 65 62 75 67 3a 73 65 =====..(debug:se
3cf0: 74 75 70 29 0a 0a 28 69 66 20 28 61 72 67 73 3a tup)..(if (args:
3d00: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 67 69 6e get-arg "-loggin
3d10: 67 22 29 28 73 65 74 21 20 2a 6c 6f 67 67 69 6e g")(set! *loggin
3d20: 67 2a 20 23 74 29 29 0a 0a 28 69 66 20 28 64 65 g* #t))..(if (de
3d30: 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 33 bug:debug-mode 3
3d40: 29 20 3b 3b 20 77 65 20 61 72 65 20 6f 62 76 69 ) ;; we are obvi
3d50: 6f 75 73 6c 79 20 64 65 62 75 67 67 69 6e 67 0a ously debugging.
3d60: 20 20 20 20 28 73 65 74 21 20 6f 70 65 6e 2d 72 (set! open-r
3d70: 75 6e 2d 63 6c 6f 73 65 20 6f 70 65 6e 2d 72 75 un-close open-ru
3d80: 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 n-close-no-excep
3d90: 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 29 29 0a tion-handling)).
3da0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
3db0: 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 29 0a rg "-itempatt").
3dc0: 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 (let ((newva
3dd0: 6c 20 28 63 6f 6e 63 20 28 61 72 67 73 3a 67 65 l (conc (args:ge
3de0: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
3df0: 22 29 20 22 2f 22 20 28 61 72 67 73 3a 67 65 74 ") "/" (args:get
3e00: 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 -arg "-itempatt"
3e10: 29 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 )))). (debu
3e20: 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 g:print 0 "WARNI
3e30: 4e 47 3a 20 2d 69 74 65 6d 70 61 74 74 20 68 61 NG: -itempatt ha
3e40: 73 20 62 65 65 6e 20 64 65 70 72 65 63 61 74 65 s been deprecate
3e50: 64 2c 20 70 6c 65 61 73 65 20 75 73 65 20 2d 74 d, please use -t
3e60: 65 73 74 70 61 74 74 20 74 65 73 74 70 61 74 74 estpatt testpatt
3e70: 2f 69 74 65 6d 70 61 74 74 20 6d 65 74 68 6f 64 /itempatt method
3e80: 2c 20 6e 65 77 20 74 65 73 74 70 61 74 74 20 69 , new testpatt i
3e90: 73 20 22 6e 65 77 76 61 6c 29 0a 20 20 20 20 20 s "newval).
3ea0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
3eb0: 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 ! args:arg-hash
3ec0: 22 2d 74 65 73 74 70 61 74 74 22 20 6e 65 77 76 "-testpatt" newv
3ed0: 61 6c 29 0a 20 20 20 20 20 20 28 68 61 73 68 2d al). (hash-
3ee0: 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 61 72 table-delete! ar
3ef0: 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 69 74 gs:arg-hash "-it
3f00: 65 6d 70 61 74 74 22 29 29 29 0a 0a 28 6f 6e 2d empatt")))..(on-
3f10: 65 78 69 74 20 28 6c 61 6d 62 64 61 20 28 29 0a exit (lambda ().
3f20: 09 20 20 20 28 73 74 64 2d 65 78 69 74 2d 70 72 . (std-exit-pr
3f30: 6f 63 65 64 75 72 65 20 2a 61 72 65 61 2d 64 61 ocedure *area-da
3f40: 74 2a 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d t*)))..;;=======
3f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
3f90: 3b 3b 20 4d 69 73 63 20 67 65 6e 65 72 61 6c 20 ;; Misc general
3fa0: 63 61 6c 6c 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d calls.;;========
3fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a ==============..
3ff0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
4000: 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 29 0a 20 g "-env2file").
4010: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
4020: 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e (save-environmen
4030: 74 2d 61 73 2d 66 69 6c 65 73 20 28 61 72 67 73 t-as-files (args
4040: 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 32 66 :get-arg "-env2f
4050: 69 6c 65 22 29 29 0a 20 20 20 20 20 20 28 73 65 ile")). (se
4060: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
4070: 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 * #t)))..(if (ar
4080: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 gs:get-arg "-lis
4090: 74 2d 64 69 73 6b 73 22 29 0a 20 20 20 20 28 6c t-disks"). (l
40a0: 65 74 20 28 28 74 6f 70 70 61 74 68 20 28 6c 61 et ((toppath (la
40b0: 75 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d 72 unch:setup-for-r
40c0: 75 6e 20 2a 61 72 65 61 2d 64 61 74 2a 29 29 29 un *area-dat*)))
40d0: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 0a 20 . (print .
40e0: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e (string-in
40f0: 74 65 72 73 70 65 72 73 65 20 0a 09 28 6d 61 70 tersperse ..(map
4100: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 20 (lambda (x)..
4110: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 (string-int
4120: 65 72 73 70 65 72 73 65 20 0a 09 09 78 0a 09 09 ersperse ...x...
4130: 22 20 3d 3e 20 22 29 29 0a 09 20 20 20 20 20 28 " => ")).. (
4140: 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 64 69 73 6b 73 common:get-disks
4150: 20 28 6d 65 67 61 74 65 73 74 3a 61 72 65 61 2d (megatest:area-
4160: 63 6f 6e 66 69 67 64 61 74 20 2a 61 72 65 61 2d configdat *area-
4170: 64 61 74 2a 29 29 29 0a 09 22 5c 6e 22 29 29 0a dat*))).."\n")).
4180: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
4190: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
41a0: 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d ..(define (make-
41b0: 73 70 61 72 73 65 2d 61 72 72 61 79 29 0a 20 20 sparse-array).
41c0: 28 6c 65 74 20 28 28 61 20 28 6d 61 6b 65 2d 73 (let ((a (make-s
41d0: 70 61 72 73 65 2d 76 65 63 74 6f 72 29 29 29 0a parse-vector))).
41e0: 20 20 20 20 28 73 70 61 72 73 65 2d 76 65 63 74 (sparse-vect
41f0: 6f 72 2d 73 65 74 21 20 61 20 30 20 28 6d 61 6b or-set! a 0 (mak
4200: 65 2d 73 70 61 72 73 65 2d 76 65 63 74 6f 72 29 e-sparse-vector)
4210: 29 0a 20 20 20 20 61 29 29 0a 0a 28 64 65 66 69 ). a))..(defi
4220: 6e 65 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 ne (sparse-array
4230: 3f 20 61 29 0a 20 20 28 61 6e 64 20 28 73 70 61 ? a). (and (spa
4240: 72 73 65 2d 76 65 63 74 6f 72 3f 20 61 29 0a 20 rse-vector? a).
4250: 20 20 20 20 20 20 28 73 70 61 72 73 65 2d 76 65 (sparse-ve
4260: 63 74 6f 72 3f 20 28 73 70 61 72 73 65 2d 76 65 ctor? (sparse-ve
4270: 63 74 6f 72 2d 72 65 66 20 61 20 30 29 29 29 29 ctor-ref a 0))))
4280: 0a 0a 28 64 65 66 69 6e 65 20 28 73 70 61 72 73 ..(define (spars
4290: 65 2d 61 72 72 61 79 2d 72 65 66 20 61 20 78 20 e-array-ref a x
42a0: 79 29 0a 20 20 28 6c 65 74 20 28 28 72 6f 77 20 y). (let ((row
42b0: 28 73 70 61 72 73 65 2d 76 65 63 74 6f 72 2d 72 (sparse-vector-r
42c0: 65 66 20 61 20 78 29 29 29 0a 20 20 20 20 28 69 ef a x))). (i
42d0: 66 20 72 6f 77 0a 09 28 73 70 61 72 73 65 2d 76 f row..(sparse-v
42e0: 65 63 74 6f 72 2d 72 65 66 20 72 6f 77 20 79 29 ector-ref row y)
42f0: 0a 09 23 66 29 29 29 0a 0a 28 64 65 66 69 6e 65 ..#f)))..(define
4300: 20 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d 73 (sparse-array-s
4310: 65 74 21 20 61 20 78 20 79 20 76 61 6c 29 0a 20 et! a x y val).
4320: 20 28 6c 65 74 20 28 28 72 6f 77 20 28 73 70 61 (let ((row (spa
4330: 72 73 65 2d 76 65 63 74 6f 72 2d 72 65 66 20 61 rse-vector-ref a
4340: 20 78 29 29 29 0a 20 20 20 20 28 69 66 20 72 6f x))). (if ro
4350: 77 0a 09 28 73 70 61 72 73 65 2d 76 65 63 74 6f w..(sparse-vecto
4360: 72 2d 73 65 74 21 20 72 6f 77 20 79 20 76 61 6c r-set! row y val
4370: 29 0a 09 28 6c 65 74 20 28 28 6e 65 77 2d 72 6f )..(let ((new-ro
4380: 77 20 28 6d 61 6b 65 2d 73 70 61 72 73 65 2d 76 w (make-sparse-v
4390: 65 63 74 6f 72 29 29 29 0a 09 20 20 28 73 70 61 ector))).. (spa
43a0: 72 73 65 2d 76 65 63 74 6f 72 2d 73 65 74 21 20 rse-vector-set!
43b0: 61 20 78 20 6e 65 77 2d 72 6f 77 29 0a 09 20 20 a x new-row)..
43c0: 28 73 70 61 72 73 65 2d 76 65 63 74 6f 72 2d 73 (sparse-vector-s
43d0: 65 74 21 20 6e 65 77 2d 72 6f 77 20 79 20 76 61 et! new-row y va
43e0: 6c 29 29 29 29 29 0a 0a 3b 3b 20 63 73 76 20 70 l)))))..;; csv p
43f0: 72 6f 63 65 73 73 69 6e 67 20 72 65 63 6f 72 64 rocessing record
4400: 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 72 .(define (make-r
4410: 65 66 64 62 3a 63 73 76 29 0a 20 20 28 76 65 63 efdb:csv). (vec
4420: 74 6f 72 20 0a 20 20 20 28 6d 61 6b 65 2d 73 70 tor . (make-sp
4430: 61 72 73 65 2d 61 72 72 61 79 29 0a 20 20 20 28 arse-array). (
4440: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
4450: 0a 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 . (make-hash-t
4460: 61 62 6c 65 29 0a 20 20 20 30 0a 20 20 20 30 29 able). 0. 0)
4470: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 ).(define-inline
4480: 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d (refdb:csv-get-
4490: 73 76 65 63 20 20 20 20 20 76 65 63 29 20 20 20 svec vec)
44a0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 (vector-ref ve
44b0: 63 20 30 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e c 0)).(define-in
44c0: 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d line (refdb:csv-
44d0: 67 65 74 2d 72 6f 77 73 20 20 20 20 20 76 65 63 get-rows vec
44e0: 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 ) (vector-ref
44f0: 20 20 76 65 63 20 31 29 29 0a 28 64 65 66 69 6e vec 1)).(defin
4500: 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a e-inline (refdb:
4510: 63 73 76 2d 67 65 74 2d 63 6f 6c 73 20 20 20 20 csv-get-cols
4520: 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 vec) (vector
4530: 2d 72 65 66 20 20 76 65 63 20 32 29 29 0a 28 64 -ref vec 2)).(d
4540: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 efine-inline (re
4550: 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 72 fdb:csv-get-maxr
4560: 6f 77 20 20 20 76 65 63 29 20 20 20 20 28 76 65 ow vec) (ve
4570: 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 33 29 ctor-ref vec 3)
4580: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 ).(define-inline
4590: 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d (refdb:csv-get-
45a0: 6d 61 78 63 6f 6c 20 20 20 76 65 63 29 20 20 20 maxcol vec)
45b0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 (vector-ref ve
45c0: 63 20 34 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e c 4)).(define-in
45d0: 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d line (refdb:csv-
45e0: 73 65 74 2d 73 76 65 63 21 20 20 20 20 76 65 63 set-svec! vec
45f0: 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 val)(vector-set
4600: 21 20 76 65 63 20 30 20 76 61 6c 29 29 0a 28 64 ! vec 0 val)).(d
4610: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 efine-inline (re
4620: 66 64 62 3a 63 73 76 2d 73 65 74 2d 72 6f 77 73 fdb:csv-set-rows
4630: 21 20 20 20 20 76 65 63 20 76 61 6c 29 28 76 65 ! vec val)(ve
4640: 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 31 20 ctor-set! vec 1
4650: 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e val)).(define-in
4660: 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d line (refdb:csv-
4670: 73 65 74 2d 63 6f 6c 73 21 20 20 20 20 76 65 63 set-cols! vec
4680: 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 val)(vector-set
4690: 21 20 76 65 63 20 32 20 76 61 6c 29 29 0a 28 64 ! vec 2 val)).(d
46a0: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 efine-inline (re
46b0: 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d 61 78 72 fdb:csv-set-maxr
46c0: 6f 77 21 20 20 76 65 63 20 76 61 6c 29 28 76 65 ow! vec val)(ve
46d0: 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 33 20 ctor-set! vec 3
46e0: 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e val)).(define-in
46f0: 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d line (refdb:csv-
4700: 73 65 74 2d 6d 61 78 63 6f 6c 21 20 20 76 65 63 set-maxcol! vec
4710: 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 val)(vector-set
4720: 21 20 76 65 63 20 34 20 76 61 6c 29 29 0a 0a 28 ! vec 4 val))..(
4730: 64 65 66 69 6e 65 20 28 67 65 74 2d 64 61 74 20 define (get-dat
4740: 72 65 73 75 6c 74 73 20 73 68 65 65 74 6e 61 6d results sheetnam
4750: 65 29 0a 20 20 28 6f 72 20 28 68 61 73 68 2d 74 e). (or (hash-t
4760: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
4770: 20 72 65 73 75 6c 74 73 20 73 68 65 65 74 6e 61 results sheetna
4780: 6d 65 20 23 66 29 0a 20 20 20 20 20 20 28 6c 65 me #f). (le
4790: 74 20 28 28 74 6d 70 2d 76 65 63 20 20 28 6d 61 t ((tmp-vec (ma
47a0: 6b 65 2d 72 65 66 64 62 3a 63 73 76 29 29 29 0a ke-refdb:csv))).
47b0: 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 .(hash-table-set
47c0: 21 20 72 65 73 75 6c 74 73 20 73 68 65 65 74 6e ! results sheetn
47d0: 61 6d 65 20 74 6d 70 2d 76 65 63 29 0a 09 74 6d ame tmp-vec)..tm
47e0: 70 2d 76 65 63 29 29 29 0a 0a 28 69 66 20 28 61 p-vec)))..(if (a
47f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
4800: 66 64 62 32 64 61 74 22 29 0a 20 20 20 20 28 6c fdb2dat"). (l
4810: 65 74 2a 20 28 28 69 6e 70 75 74 2d 64 62 20 28 et* ((input-db (
4820: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
4830: 65 66 64 62 32 64 61 74 22 29 29 0a 09 20 20 20 efdb2dat"))..
4840: 28 6f 75 74 2d 66 69 6c 65 20 28 61 72 67 73 3a (out-file (args:
4850: 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 29 0a 09 get-arg "-o"))..
4860: 20 20 20 28 6f 75 74 2d 66 6d 74 20 20 28 6f 72 (out-fmt (or
4870: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4880: 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 73 63 68 -dumpmode") "sch
4890: 65 6d 65 22 29 29 0a 09 20 20 20 28 6f 75 74 2d eme")).. (out-
48a0: 70 6f 72 74 20 28 69 66 20 28 61 6e 64 20 6f 75 port (if (and ou
48b0: 74 2d 66 69 6c 65 20 0a 09 09 09 20 20 20 20 20 t-file ....
48c0: 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 6f 75 (not (member ou
48d0: 74 2d 66 6d 74 20 27 28 22 73 71 6c 69 74 65 33 t-fmt '("sqlite3
48e0: 22 20 22 63 73 76 22 29 29 29 29 0a 09 09 09 20 " "csv"))))....
48f0: 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c (open-output-fil
4900: 65 20 6f 75 74 2d 66 69 6c 65 29 0a 09 09 09 20 e out-file)....
4910: 28 63 75 72 72 65 6e 74 2d 6f 75 74 70 75 74 2d (current-output-
4920: 70 6f 72 74 29 29 29 0a 09 20 20 20 28 72 65 73 port))).. (res
4930: 2d 64 61 74 61 20 28 63 6f 6e 66 69 67 66 3a 72 -data (configf:r
4940: 65 61 64 2d 72 65 66 64 62 20 69 6e 70 75 74 2d ead-refdb input-
4950: 64 62 29 29 0a 09 20 20 20 28 64 61 74 61 20 20 db)).. (data
4960: 20 20 20 28 63 61 72 20 72 65 73 2d 64 61 74 61 (car res-data
4970: 29 29 0a 09 20 20 20 28 6d 73 67 20 20 20 20 20 )).. (msg
4980: 20 28 63 61 64 72 20 72 65 73 2d 64 61 74 61 29 (cadr res-data)
4990: 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f )). (if (no
49a0: 74 20 64 61 74 61 29 0a 09 20 20 28 64 65 62 75 t data).. (debu
49b0: 67 3a 70 72 69 6e 74 20 30 20 22 42 61 64 20 69 g:print 0 "Bad i
49c0: 6e 70 75 74 3f 20 64 61 74 61 3d 22 20 64 61 74 nput? data=" dat
49d0: 61 29 20 3b 3b 20 73 6f 6d 65 20 65 72 72 6f 72 a) ;; some error
49e0: 20 6f 63 63 75 72 72 65 64 0a 09 20 20 28 77 69 occurred.. (wi
49f0: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 70 6f 72 th-output-to-por
4a00: 74 20 6f 75 74 2d 70 6f 72 74 0a 09 20 20 20 20 t out-port..
4a10: 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 20 20 (lambda ()..
4a20: 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d (case (string-
4a30: 3e 73 79 6d 62 6f 6c 20 6f 75 74 2d 66 6d 74 29 >symbol out-fmt)
4a40: 0a 09 09 28 28 73 63 68 65 6d 65 29 28 70 70 20 ...((scheme)(pp
4a50: 64 61 74 61 29 29 0a 09 09 28 28 70 65 72 6c 29 data))...((perl)
4a60: 0a 09 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 25 ... ;; (print "%
4a70: 68 61 73 68 20 3d 20 28 22 29 0a 09 09 20 3b 3b hash = (")... ;;
4a80: 20 20 20 20 20 20 20 20 6b 65 79 31 20 3d 3e 20 key1 =>
4a90: 27 76 61 6c 75 65 31 27 2c 0a 09 09 20 3b 3b 20 'value1',... ;;
4aa0: 20 20 20 20 20 20 20 6b 65 79 32 20 3d 3e 20 27 key2 => '
4ab0: 76 61 6c 75 65 32 27 2c 0a 09 09 20 3b 3b 20 20 value2',... ;;
4ac0: 20 20 20 20 20 20 6b 65 79 33 20 3d 3e 20 27 76 key3 => 'v
4ad0: 61 6c 75 65 33 27 2c 0a 09 09 20 3b 3b 20 29 3b alue3',... ;; );
4ae0: 0a 09 09 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 ... (configf:map
4af0: 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 20 -all-hier-alist
4b00: 0a 09 09 20 20 64 61 74 61 20 0a 09 09 20 20 28 ... data ... (
4b10: 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d lambda (sheetnam
4b20: 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 e sectionname va
4b30: 72 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 rname val)...
4b40: 20 28 70 72 69 6e 74 20 22 24 64 61 74 61 7b 5c (print "$data{\
4b50: 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 "" sheetname "\"
4b60: 7d 7b 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d }{\"" sectionnam
4b70: 65 20 22 5c 22 7d 7b 5c 22 22 20 76 61 72 6e 61 e "\"}{\"" varna
4b80: 6d 65 20 22 5c 22 7d 20 3d 20 5c 22 22 20 76 61 me "\"} = \"" va
4b90: 6c 20 22 5c 22 3b 22 29 29 29 29 0a 09 09 28 28 l "\";"))))...((
4ba0: 70 79 74 68 6f 6e 20 72 75 62 79 29 0a 09 09 20 python ruby)...
4bb0: 28 70 72 69 6e 74 20 22 64 61 74 61 3d 7b 7d 22 (print "data={}"
4bc0: 29 0a 09 09 20 28 63 6f 6e 66 69 67 66 3a 6d 61 )... (configf:ma
4bd0: 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 p-all-hier-alist
4be0: 0a 09 09 20 20 64 61 74 61 0a 09 09 20 20 28 6c ... data... (l
4bf0: 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 ambda (sheetname
4c00: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 sectionname var
4c10: 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 name val)...
4c20: 28 70 72 69 6e 74 20 22 64 61 74 61 5b 5c 22 22 (print "data[\""
4c30: 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 5d 5b sheetname "\"][
4c40: 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 \"" sectionname
4c50: 22 5c 22 5d 5b 5c 22 22 20 76 61 72 6e 61 6d 65 "\"][\"" varname
4c60: 20 22 5c 22 5d 20 3d 20 5c 22 22 20 76 61 6c 20 "\"] = \"" val
4c70: 22 5c 22 22 29 29 0a 09 09 20 20 69 6e 69 74 70 "\""))... initp
4c80: 72 6f 63 31 3a 0a 09 09 20 20 28 6c 61 6d 62 64 roc1:... (lambd
4c90: 61 20 28 73 68 65 65 74 6e 61 6d 65 29 0a 09 09 a (sheetname)...
4ca0: 20 20 20 20 28 70 72 69 6e 74 20 22 64 61 74 61 (print "data
4cb0: 5b 5c 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 [\"" sheetname "
4cc0: 5c 22 5d 20 3d 20 7b 7d 22 29 29 0a 09 09 20 20 \"] = {}"))...
4cd0: 69 6e 69 74 70 72 6f 63 32 3a 0a 09 09 20 20 28 initproc2:... (
4ce0: 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d lambda (sheetnam
4cf0: 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 29 0a 09 e sectionname)..
4d00: 09 20 20 20 20 28 70 72 69 6e 74 20 22 64 61 74 . (print "dat
4d10: 61 5b 5c 22 22 20 73 68 65 65 74 6e 61 6d 65 20 a[\"" sheetname
4d20: 22 5c 22 5d 5b 5c 22 22 20 73 65 63 74 69 6f 6e "\"][\"" section
4d30: 6e 61 6d 65 20 22 5c 22 5d 20 3d 20 7b 7d 22 29 name "\"] = {}")
4d40: 29 29 29 0a 09 09 28 28 63 73 76 29 0a 09 09 20 )))...((csv)...
4d50: 28 6c 65 74 2a 20 28 28 72 65 73 75 6c 74 73 20 (let* ((results
4d60: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
4d70: 65 29 29 20 3b 3b 20 28 6d 61 6b 65 2d 73 70 61 e)) ;; (make-spa
4d80: 72 73 65 2d 61 72 72 61 79 29 29 29 0a 09 09 09 rse-array)))....
4d90: 28 72 6f 77 2d 63 6f 6c 73 20 28 6d 61 6b 65 2d (row-cols (make-
4da0: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 20 3b 3b hash-table))) ;;
4db0: 20 68 61 73 68 20 6f 66 20 68 61 73 68 65 73 20 hash of hashes
4dc0: 77 68 65 72 65 20 73 65 63 74 69 6f 6e 20 3d 3e where section =>
4dd0: 20 68 74 20 7b 20 72 6f 77 2d 3c 6e 61 6d 65 3e ht { row-<name>
4de0: 20 3d 3e 20 6e 75 6d 20 6f 72 20 63 6f 6c 2d 3c => num or col-<
4df0: 6e 61 6d 65 3e 20 3d 3e 20 6e 75 6d 0a 09 09 20 name> => num...
4e00: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 64 61 74 ;; (print "dat
4e10: 61 3d 22 29 0a 09 09 20 20 20 3b 3b 20 28 70 70 a=")... ;; (pp
4e20: 20 64 61 74 61 29 0a 09 09 20 20 20 28 63 6f 6e data)... (con
4e30: 66 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 figf:map-all-hie
4e40: 72 2d 61 6c 69 73 74 0a 09 09 20 20 20 20 64 61 r-alist... da
4e50: 74 61 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 61 ta... (lambda
4e60: 20 28 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 (sheetname sect
4e70: 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 ionname varname
4e80: 76 61 6c 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 val)... ;;
4e90: 28 70 72 69 6e 74 20 22 73 68 65 65 74 6e 61 6d (print "sheetnam
4ea0: 65 3a 20 22 20 73 68 65 65 74 6e 61 6d 65 20 22 e: " sheetname "
4eb0: 2c 20 73 65 63 74 69 6f 6e 6e 61 6d 65 3a 20 22 , sectionname: "
4ec0: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 2c 20 sectionname ",
4ed0: 76 61 72 6e 61 6d 65 3a 20 22 20 76 61 72 6e 61 varname: " varna
4ee0: 6d 65 20 22 2c 20 76 61 6c 3a 20 22 20 76 61 6c me ", val: " val
4ef0: 29 0a 09 09 20 20 20 20 20 20 28 6c 65 74 2a 20 )... (let*
4f00: 28 28 64 61 74 20 20 20 20 20 20 28 67 65 74 2d ((dat (get-
4f10: 64 61 74 20 72 65 73 75 6c 74 73 20 73 68 65 65 dat results shee
4f20: 74 6e 61 6d 65 29 29 0a 09 09 09 20 20 20 20 20 tname))....
4f30: 28 76 65 63 20 20 20 20 20 20 28 72 65 66 64 62 (vec (refdb
4f40: 3a 63 73 76 2d 67 65 74 2d 73 76 65 63 20 64 61 :csv-get-svec da
4f50: 74 29 29 0a 09 09 09 20 20 20 20 20 28 72 6f 77 t)).... (row
4f60: 6e 61 6d 65 73 20 28 72 65 66 64 62 3a 63 73 76 names (refdb:csv
4f70: 2d 67 65 74 2d 72 6f 77 73 20 64 61 74 29 29 0a -get-rows dat)).
4f80: 09 09 09 20 20 20 20 20 28 63 6f 6c 6e 61 6d 65 ... (colname
4f90: 73 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 s (refdb:csv-get
4fa0: 2d 63 6f 6c 73 20 64 61 74 29 29 0a 09 09 09 20 -cols dat))....
4fb0: 20 20 20 20 28 63 75 72 72 72 6f 77 6e 20 28 68 (currrown (h
4fc0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
4fd0: 66 61 75 6c 74 20 72 6f 77 6e 61 6d 65 73 20 76 fault rownames v
4fe0: 61 72 6e 61 6d 65 20 23 66 29 29 0a 09 09 09 20 arname #f))....
4ff0: 20 20 20 20 28 63 75 72 72 63 6f 6c 6e 20 28 68 (currcoln (h
5000: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
5010: 66 61 75 6c 74 20 63 6f 6c 6e 61 6d 65 73 20 73 fault colnames s
5020: 65 63 74 69 6f 6e 6e 61 6d 65 20 23 66 29 29 0a ectionname #f)).
5030: 09 09 09 20 20 20 20 20 28 72 6f 77 6e 20 20 20 ... (rown
5040: 20 20 28 6f 72 20 63 75 72 72 72 6f 77 6e 20 0a (or currrown .
5050: 09 09 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 ..... (let* ((
5060: 6c 61 73 74 6e 20 20 20 28 72 65 66 64 62 3a 63 lastn (refdb:c
5070: 73 76 2d 67 65 74 2d 6d 61 78 72 6f 77 20 64 61 sv-get-maxrow da
5080: 74 29 29 0a 09 09 09 09 09 09 20 20 28 6e 65 77 t))....... (new
5090: 72 6f 77 6e 20 28 2b 20 6c 61 73 74 6e 20 31 29 rown (+ lastn 1)
50a0: 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 72 65 ))...... (re
50b0: 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d 61 78 72 fdb:csv-set-maxr
50c0: 6f 77 21 20 64 61 74 20 6e 65 77 72 6f 77 6e 29 ow! dat newrown)
50d0: 0a 09 09 09 09 09 20 20 20 20 20 6e 65 77 72 6f ...... newro
50e0: 77 6e 29 29 29 0a 09 09 09 20 20 20 20 20 28 63 wn))).... (c
50f0: 6f 6c 6e 20 20 20 20 20 28 6f 72 20 63 75 72 72 oln (or curr
5100: 63 6f 6c 6e 20 0a 09 09 09 09 09 20 20 20 28 6c coln ...... (l
5110: 65 74 2a 20 28 28 6c 61 73 74 6e 20 20 20 28 72 et* ((lastn (r
5120: 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 efdb:csv-get-max
5130: 63 6f 6c 20 64 61 74 29 29 0a 09 09 09 09 09 09 col dat)).......
5140: 20 20 28 6e 65 77 63 6f 6c 6e 20 28 2b 20 6c 61 (newcoln (+ la
5150: 73 74 6e 20 31 29 29 29 0a 09 09 09 09 09 20 20 stn 1)))......
5160: 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 (refdb:csv-se
5170: 74 2d 6d 61 78 63 6f 6c 21 20 64 61 74 20 6e 65 t-maxcol! dat ne
5180: 77 63 6f 6c 6e 29 0a 09 09 09 09 09 20 20 20 20 wcoln)......
5190: 20 6e 65 77 63 6f 6c 6e 29 29 29 29 0a 09 09 09 newcoln))))....
51a0: 28 69 66 20 28 6e 6f 74 20 28 73 70 61 72 73 65 (if (not (sparse
51b0: 2d 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 30 -array-ref vec 0
51c0: 20 63 6f 6c 6e 29 29 20 3b 3b 20 28 65 71 3f 20 coln)) ;; (eq?
51d0: 72 6f 77 6e 20 30 29 0a 09 09 09 20 20 20 20 28 rown 0).... (
51e0: 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 begin.... (
51f0: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 sparse-array-set
5200: 21 20 76 65 63 20 30 20 63 6f 6c 6e 20 73 65 63 ! vec 0 coln sec
5210: 74 69 6f 6e 6e 61 6d 65 29 0a 09 09 09 20 20 20 tionname)....
5220: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 70 ;; (print "sp
5230: 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 22 arse-array-ref "
5240: 20 30 20 22 2c 22 20 63 6f 6c 6e 20 22 3d 22 20 0 "," coln "="
5250: 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 (sparse-array-re
5260: 66 20 76 65 63 20 30 20 63 6f 6c 6e 29 29 0a 09 f vec 0 coln))..
5270: 09 09 20 20 20 20 20 20 29 29 0a 09 09 09 28 69 .. ))....(i
5280: 66 20 28 6e 6f 74 20 28 73 70 61 72 73 65 2d 61 f (not (sparse-a
5290: 72 72 61 79 2d 72 65 66 20 76 65 63 20 72 6f 77 rray-ref vec row
52a0: 6e 20 30 29 29 20 3b 3b 20 28 65 71 3f 20 63 6f n 0)) ;; (eq? co
52b0: 6c 6e 20 30 29 0a 09 09 09 20 20 20 20 28 62 65 ln 0).... (be
52c0: 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 73 70 gin.... (sp
52d0: 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 21 20 arse-array-set!
52e0: 76 65 63 20 72 6f 77 6e 20 30 20 76 61 72 6e 61 vec rown 0 varna
52f0: 6d 65 29 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 me).... ;;
5300: 28 70 72 69 6e 74 20 22 73 70 61 72 73 65 2d 61 (print "sparse-a
5310: 72 72 61 79 2d 72 65 66 20 22 20 72 6f 77 6e 20 rray-ref " rown
5320: 22 2c 22 20 30 20 22 3d 22 20 28 73 70 61 72 73 "," 0 "=" (spars
5330: 65 2d 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 e-array-ref vec
5340: 72 6f 77 6e 20 30 29 29 0a 09 09 09 20 20 20 20 rown 0))....
5350: 20 20 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 ))....(if (not
5360: 20 63 75 72 72 72 6f 77 6e 29 28 68 61 73 68 2d currrown)(hash-
5370: 74 61 62 6c 65 2d 73 65 74 21 20 72 6f 77 6e 61 table-set! rowna
5380: 6d 65 73 20 76 61 72 6e 61 6d 65 20 72 6f 77 6e mes varname rown
5390: 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 63 ))....(if (not c
53a0: 75 72 72 63 6f 6c 6e 29 28 68 61 73 68 2d 74 61 urrcoln)(hash-ta
53b0: 62 6c 65 2d 73 65 74 21 20 63 6f 6c 6e 61 6d 65 ble-set! colname
53c0: 73 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 63 6f s sectionname co
53d0: 6c 6e 29 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e ln))....;; (prin
53e0: 74 20 22 64 61 74 3d 22 20 64 61 74 20 22 2c 20 t "dat=" dat ",
53f0: 72 6f 77 6e 3d 22 20 72 6f 77 6e 20 22 2c 20 63 rown=" rown ", c
5400: 6f 6c 6e 3d 22 20 63 6f 6c 6e 29 0a 09 09 09 28 oln=" coln)....(
5410: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 sparse-array-set
5420: 21 20 76 65 63 20 72 6f 77 6e 20 63 6f 6c 6e 20 ! vec rown coln
5430: 76 61 6c 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e val)....;; (prin
5440: 74 20 22 73 70 61 72 73 65 2d 61 72 72 61 79 2d t "sparse-array-
5450: 72 65 66 20 22 20 72 6f 77 6e 20 22 2c 22 20 63 ref " rown "," c
5460: 6f 6c 6e 20 22 3d 22 20 28 73 70 61 72 73 65 2d oln "=" (sparse-
5470: 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 72 6f array-ref vec ro
5480: 77 6e 20 63 6f 6c 6e 29 29 0a 09 09 09 29 29 29 wn coln))....)))
5490: 0a 09 09 20 20 20 28 66 6f 72 2d 65 61 63 68 0a ... (for-each.
54a0: 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 .. (lambda (s
54b0: 68 65 65 74 6e 61 6d 65 29 0a 09 09 20 20 20 20 heetname)...
54c0: 20 20 28 6c 65 74 2a 20 28 28 73 68 65 65 74 64 (let* ((sheetd
54d0: 61 74 20 28 67 65 74 2d 64 61 74 20 72 65 73 75 at (get-dat resu
54e0: 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 29 29 0a lts sheetname)).
54f0: 09 09 09 20 20 20 20 20 28 73 76 65 63 20 20 20 ... (svec
5500: 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 (refdb:csv-get
5510: 2d 73 76 65 63 20 73 68 65 65 74 64 61 74 29 29 -svec sheetdat))
5520: 0a 09 09 09 20 20 20 20 20 28 6d 61 78 72 6f 77 .... (maxrow
5530: 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 (refdb:csv-ge
5540: 74 2d 6d 61 78 72 6f 77 20 73 68 65 65 74 64 61 t-maxrow sheetda
5550: 74 29 29 0a 09 09 09 20 20 20 20 20 28 6d 61 78 t)).... (max
5560: 63 6f 6c 20 20 20 28 72 65 66 64 62 3a 63 73 76 col (refdb:csv
5570: 2d 67 65 74 2d 6d 61 78 63 6f 6c 20 73 68 65 65 -get-maxcol shee
5580: 74 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 tdat)).... (
5590: 66 6e 61 6d 65 20 20 20 20 28 69 66 20 6f 75 74 fname (if out
55a0: 2d 66 69 6c 65 20 0a 09 09 09 09 09 20 20 20 28 -file ...... (
55b0: 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 string-substitut
55c0: 65 20 22 25 73 22 20 73 68 65 65 74 6e 61 6d 65 e "%s" sheetname
55d0: 20 6f 75 74 2d 66 69 6c 65 29 20 3b 3b 20 22 2f out-file) ;; "/
55e0: 66 6f 6f 2f 62 61 72 2f 25 73 2e 63 73 76 22 29 foo/bar/%s.csv")
55f0: 0a 09 09 09 09 09 20 20 20 28 63 6f 6e 63 20 73 ...... (conc s
5600: 68 65 65 74 6e 61 6d 65 20 22 2e 63 73 76 22 29 heetname ".csv")
5610: 29 29 29 0a 09 09 09 28 77 69 74 68 2d 6f 75 74 )))....(with-out
5620: 70 75 74 2d 74 6f 2d 66 69 6c 65 20 66 6e 61 6d put-to-file fnam
5630: 65 0a 09 09 09 20 20 28 6c 61 6d 62 64 61 20 28 e.... (lambda (
5640: 29 0a 09 09 09 20 20 20 20 3b 3b 20 28 70 72 69 ).... ;; (pri
5650: 6e 74 20 22 53 68 65 65 74 6e 61 6d 65 3a 20 22 nt "Sheetname: "
5660: 20 73 68 65 65 74 6e 61 6d 65 29 0a 09 09 09 20 sheetname)....
5670: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 (let loop ((r
5680: 6f 77 20 20 20 20 20 20 20 30 29 0a 09 09 09 09 ow 0).....
5690: 20 20 20 20 20 20 20 28 63 6f 6c 20 20 20 20 20 (col
56a0: 20 20 30 29 0a 09 09 09 09 20 20 20 20 20 20 20 0).....
56b0: 28 63 75 72 72 2d 72 6f 77 20 27 28 29 29 0a 09 (curr-row '())..
56c0: 09 09 09 20 20 20 20 20 20 20 28 72 65 73 75 6c ... (resul
56d0: 74 20 20 20 27 28 29 29 29 0a 09 09 09 20 20 20 t '()))....
56e0: 20 20 20 28 6c 65 74 2a 20 28 28 76 61 6c 20 28 (let* ((val (
56f0: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 sparse-array-ref
5700: 20 73 76 65 63 20 72 6f 77 20 63 6f 6c 29 29 0a svec row col)).
5710: 09 09 09 09 20 20 20 20 20 28 64 69 73 70 2d 76 .... (disp-v
5720: 61 6c 20 28 69 66 20 76 61 6c 0a 09 09 09 09 09 al (if val......
5730: 09 20 20 20 28 63 6f 6e 63 20 22 5c 22 22 20 76 . (conc "\"" v
5740: 61 6c 20 22 5c 22 22 29 0a 09 09 09 09 09 09 20 al "\"").......
5750: 20 20 22 22 29 29 29 0a 09 09 09 09 28 69 66 20 ""))).....(if
5760: 28 3e 20 63 6f 6c 20 30 29 28 64 69 73 70 6c 61 (> col 0)(displa
5770: 79 20 22 2c 22 29 29 0a 09 09 09 09 28 64 69 73 y ",")).....(dis
5780: 70 6c 61 79 20 64 69 73 70 2d 76 61 6c 29 0a 09 play disp-val)..
5790: 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 20 28 28 ...(cond..... ((
57a0: 3e 20 72 6f 77 20 6d 61 78 72 6f 77 29 28 64 69 > row maxrow)(di
57b0: 73 70 6c 61 79 20 22 5c 6e 22 29 20 72 65 73 75 splay "\n") resu
57c0: 6c 74 29 0a 09 09 09 09 20 28 28 3e 3d 20 63 6f lt)..... ((>= co
57d0: 6c 20 6d 61 78 63 6f 6c 29 0a 09 09 09 09 20 20 l maxcol).....
57e0: 28 64 69 73 70 6c 61 79 20 22 5c 6e 22 29 0a 09 (display "\n")..
57f0: 09 09 09 20 20 28 6c 6f 6f 70 20 28 2b 20 72 6f ... (loop (+ ro
5800: 77 20 31 29 20 30 20 27 28 29 20 28 61 70 70 65 w 1) 0 '() (appe
5810: 6e 64 20 72 65 73 75 6c 74 20 28 6c 69 73 74 20 nd result (list
5820: 63 75 72 72 2d 72 6f 77 29 29 29 29 0a 09 09 09 curr-row))))....
5830: 09 20 28 65 6c 73 65 0a 09 09 09 09 20 20 28 6c . (else..... (l
5840: 6f 6f 70 20 72 6f 77 20 28 2b 20 63 6f 6c 20 31 oop row (+ col 1
5850: 29 20 28 61 70 70 65 6e 64 20 63 75 72 72 2d 72 ) (append curr-r
5860: 6f 77 20 28 6c 69 73 74 20 76 61 6c 29 29 20 72 ow (list val)) r
5870: 65 73 75 6c 74 29 29 29 29 29 29 29 29 29 0a 09 esult)))))))))..
5880: 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
5890: 2d 6b 65 79 73 20 72 65 73 75 6c 74 73 29 29 29 -keys results)))
58a0: 29 0a 09 09 28 28 73 71 6c 69 74 65 33 29 0a 09 )...((sqlite3)..
58b0: 09 20 28 6c 65 74 2a 20 28 28 64 62 2d 66 69 6c . (let* ((db-fil
58c0: 65 20 20 20 28 6f 72 20 6f 75 74 2d 66 69 6c 65 e (or out-file
58d0: 20 28 70 61 74 68 6e 61 6d 65 2d 66 69 6c 65 20 (pathname-file
58e0: 69 6e 70 75 74 2d 64 62 29 29 29 0a 09 09 09 28 input-db)))....(
58f0: 64 62 2d 65 78 69 73 74 73 20 28 66 69 6c 65 2d db-exists (file-
5900: 65 78 69 73 74 73 3f 20 64 62 2d 66 69 6c 65 29 exists? db-file)
5910: 29 0a 09 09 09 28 64 62 20 20 20 20 20 20 20 20 )....(db
5920: 28 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 (sqlite3:open-da
5930: 74 61 62 61 73 65 20 64 62 2d 66 69 6c 65 29 29 tabase db-file))
5940: 29 0a 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 )... (if (not
5950: 64 62 2d 65 78 69 73 74 73 29 28 73 71 6c 69 74 db-exists)(sqlit
5960: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 e3:execute db "C
5970: 52 45 41 54 45 20 54 41 42 4c 45 20 64 61 74 61 REATE TABLE data
5980: 20 28 73 68 65 65 74 2c 73 65 63 74 69 6f 6e 2c (sheet,section,
5990: 76 61 72 2c 76 61 6c 29 3b 22 29 29 0a 09 09 20 var,val);"))...
59a0: 20 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 (configf:map-a
59b0: 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 0a 09 09 ll-hier-alist...
59c0: 20 20 20 20 64 61 74 61 0a 09 09 20 20 20 20 28 data... (
59d0: 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d lambda (sheetnam
59e0: 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 e sectionname va
59f0: 72 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 rname val)...
5a00: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
5a10: 75 74 65 20 64 62 0a 09 09 09 09 20 20 20 20 20 ute db.....
5a20: 20 20 22 49 4e 53 45 52 54 20 4f 52 20 52 45 50 "INSERT OR REP
5a30: 4c 41 43 45 20 49 4e 54 4f 20 64 61 74 61 20 28 LACE INTO data (
5a40: 73 68 65 65 74 2c 73 65 63 74 69 6f 6e 2c 76 61 sheet,section,va
5a50: 72 2c 76 61 6c 29 20 56 41 4c 55 45 53 20 28 3f r,val) VALUES (?
5a60: 2c 3f 2c 3f 2c 3f 29 3b 22 0a 09 09 09 09 20 20 ,?,?,?);".....
5a70: 20 20 20 20 20 73 68 65 65 74 6e 61 6d 65 20 73 sheetname s
5a80: 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 ectionname varna
5a90: 6d 65 20 76 61 6c 29 29 29 0a 09 09 20 20 20 28 me val)))... (
5aa0: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
5ab0: 21 20 64 62 29 29 29 0a 09 09 28 65 6c 73 65 0a ! db)))...(else.
5ac0: 09 09 20 28 70 70 20 64 61 74 61 29 29 29 29 29 .. (pp data)))))
5ad0: 29 0a 20 20 20 20 20 20 28 69 66 20 6f 75 74 2d ). (if out-
5ae0: 66 69 6c 65 20 28 63 6c 6f 73 65 2d 6f 75 74 70 file (close-outp
5af0: 75 74 2d 70 6f 72 74 20 6f 75 74 2d 70 6f 72 74 ut-port out-port
5b00: 29 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 20 )). (exit)
5b10: 3b 3b 20 79 65 73 2c 20 62 65 6e 64 69 6e 67 20 ;; yes, bending
5b20: 74 68 65 20 72 75 6c 65 73 20 68 65 72 65 20 2d the rules here -
5b30: 20 6e 65 65 64 20 74 6f 20 65 78 69 74 20 73 69 need to exit si
5b40: 6e 63 65 20 74 68 69 73 20 69 73 20 61 20 75 74 nce this is a ut
5b50: 69 6c 69 74 79 0a 20 20 20 20 20 20 29 29 0a 0a ility. ))..
5b60: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
5b70: 67 20 22 2d 70 69 6e 67 22 29 0a 20 20 20 20 28 g "-ping"). (
5b80: 6c 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 20 20 let* ((run-id
5b90: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 (string->nu
5ba0: 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 mber (args:get-a
5bb0: 72 67 20 22 2d 72 75 6e 2d 69 64 22 29 29 29 0a rg "-run-id"))).
5bc0: 09 20 20 20 28 68 6f 73 74 3a 70 6f 72 74 20 20 . (host:port
5bd0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
5be0: 20 22 2d 70 69 6e 67 22 29 29 29 0a 20 20 20 20 "-ping"))).
5bf0: 20 20 28 73 65 72 76 65 72 3a 70 69 6e 67 20 72 (server:ping r
5c00: 75 6e 2d 69 64 20 68 6f 73 74 3a 70 6f 72 74 29 un-id host:port)
5c10: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
5c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
5c60: 53 74 61 72 74 20 74 68 65 20 73 65 72 76 65 72 Start the server
5c70: 20 2d 20 63 61 6e 20 62 65 20 64 6f 6e 65 20 69 - can be done i
5c80: 6e 20 63 6f 6e 6a 75 6e 63 74 69 6f 6e 20 77 69 n conjunction wi
5c90: 74 68 20 2d 72 75 6e 61 6c 6c 20 6f 72 20 2d 72 th -runall or -r
5ca0: 75 6e 74 65 73 74 73 20 28 6f 6e 65 20 64 61 79 untests (one day
5cb0: 2e 2e 2e 29 0a 3b 3b 20 20 20 77 65 20 73 74 61 ...).;; we sta
5cc0: 72 74 20 74 68 65 20 73 65 72 76 65 72 20 69 66 rt the server if
5cd0: 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 65 6c 73 not running els
5ce0: 65 20 73 74 61 72 74 20 74 68 65 20 63 6c 69 65 e start the clie
5cf0: 6e 74 20 74 68 72 65 61 64 0a 3b 3b 3d 3d 3d 3d nt thread.;;====
5d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d40: 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ==..(if (args:ge
5d50: 74 2d 61 72 67 20 22 2d 73 65 72 76 65 72 22 29 t-arg "-server")
5d60: 0a 0a 20 20 20 20 3b 3b 20 53 65 72 76 65 72 3f .. ;; Server?
5d70: 20 53 74 61 72 74 20 75 70 20 68 65 72 65 2e 0a Start up here..
5d80: 20 20 20 20 3b 3b 0a 20 20 20 20 28 6c 65 74 20 ;;. (let
5d90: 28 28 74 6c 20 20 20 20 20 20 20 20 28 6c 61 75 ((tl (lau
5da0: 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d 72 75 nch:setup-for-ru
5db0: 6e 20 2a 61 72 65 61 2d 64 61 74 2a 29 29 0a 09 n *area-dat*))..
5dc0: 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 6e (run-id (an
5dd0: 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
5de0: 22 2d 72 75 6e 2d 69 64 22 29 0a 09 09 09 20 20 "-run-id")....
5df0: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
5e00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5e10: 72 75 6e 2d 69 64 22 29 29 29 29 29 0a 20 20 20 run-id"))))).
5e20: 20 20 20 28 69 66 20 72 75 6e 2d 69 64 0a 09 20 (if run-id..
5e30: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 73 65 (begin.. (se
5e40: 72 76 65 72 3a 6c 61 75 6e 63 68 20 72 75 6e 2d rver:launch run-
5e50: 69 64 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a id).. (set! *
5e60: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
5e70: 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 )).. (debug:pri
5e80: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 73 65 72 nt 0 "ERROR: ser
5e90: 76 65 72 20 72 65 71 75 69 72 65 73 20 72 75 6e ver requires run
5ea0: 2d 69 64 20 62 65 20 73 70 65 63 69 66 69 65 64 -id be specified
5eb0: 20 77 69 74 68 20 2d 72 75 6e 2d 69 64 22 29 29 with -run-id"))
5ec0: 29 0a 0a 20 20 20 20 3b 3b 20 4e 6f 74 20 61 20 ).. ;; Not a
5ed0: 73 65 72 76 65 72 3f 20 54 68 69 73 20 73 65 63 server? This sec
5ee0: 74 69 6f 6e 20 77 69 6c 6c 20 64 65 63 69 64 65 tion will decide
5ef0: 20 68 6f 77 20 74 6f 20 63 6f 6d 6d 75 6e 69 63 how to communic
5f00: 61 74 65 0a 20 20 20 20 3b 3b 0a 20 20 20 20 3b ate. ;;. ;
5f10: 3b 20 20 53 65 74 75 70 20 63 6c 69 65 6e 74 20 ; Setup client
5f20: 66 6f 72 20 61 6c 6c 20 65 78 70 65 63 74 20 6c for all expect l
5f30: 69 73 74 65 64 20 68 65 72 65 0a 20 20 20 20 28 isted here. (
5f40: 69 66 20 28 6e 75 6c 6c 3f 20 28 6c 73 65 74 2d if (null? (lset-
5f50: 69 6e 74 65 72 73 65 63 74 69 6f 6e 20 0a 09 09 intersection ...
5f60: 20 20 20 20 20 65 71 75 61 6c 3f 0a 09 09 20 20 equal?...
5f70: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b (hash-table-k
5f80: 65 79 73 20 61 72 67 73 3a 61 72 67 2d 68 61 73 eys args:arg-has
5f90: 68 29 0a 09 09 20 20 20 20 20 27 28 22 2d 6c 69 h)... '("-li
5fa0: 73 74 2d 73 65 72 76 65 72 73 22 0a 09 09 20 20 st-servers"...
5fb0: 20 20 20 20 20 22 2d 73 74 6f 70 2d 73 65 72 76 "-stop-serv
5fc0: 65 72 22 0a 09 09 20 20 20 20 20 20 20 22 2d 73 er"... "-s
5fd0: 68 6f 77 2d 63 6d 64 69 6e 66 6f 22 0a 09 09 20 how-cmdinfo"...
5fe0: 20 20 20 20 20 20 22 2d 6c 69 73 74 2d 72 75 6e "-list-run
5ff0: 73 22 0a 09 09 20 20 20 20 20 20 20 22 2d 70 69 s"... "-pi
6000: 6e 67 22 29 29 29 0a 09 28 69 66 20 28 6c 61 75 ng")))..(if (lau
6010: 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d 72 75 nch:setup-for-ru
6020: 6e 20 2a 61 72 65 61 2d 64 61 74 2a 29 0a 09 20 n *area-dat*)..
6030: 20 20 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 (let ((run-id
6040: 20 20 20 20 28 61 6e 64 20 28 61 72 67 73 3a 67 (and (args:g
6050: 65 74 2d 61 72 67 20 22 2d 72 75 6e 2d 69 64 22 et-arg "-run-id"
6060: 29 0a 09 09 09 09 20 20 28 73 74 72 69 6e 67 2d )..... (string-
6070: 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 >number (args:ge
6080: 74 2d 61 72 67 20 22 2d 72 75 6e 2d 69 64 22 29 t-arg "-run-id")
6090: 29 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 )))).. ;; (
60a0: 73 65 74 21 20 2a 66 64 62 2a 20 20 20 28 66 69 set! *fdb* (fi
60b0: 6c 65 64 62 3a 6f 70 65 6e 2d 64 62 20 28 63 6f ledb:open-db (co
60c0: 6e 63 20 74 6f 70 70 61 74 68 20 22 2f 64 62 2f nc toppath "/db/
60d0: 70 61 74 68 73 2e 64 62 22 29 29 29 0a 09 20 20 paths.db")))..
60e0: 20 20 20 20 3b 3b 20 69 66 20 6e 6f 74 20 6c 69 ;; if not li
60f0: 73 74 20 6f 72 20 6b 69 6c 6c 20 74 68 65 6e 20 st or kill then
6100: 73 74 61 72 74 20 61 20 63 6c 69 65 6e 74 20 28 start a client (
6110: 69 66 20 61 70 70 72 6f 70 72 69 61 74 65 29 0a if appropriate).
6120: 09 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 . (if (or (
6130: 61 72 67 73 2d 64 65 66 69 6e 65 64 3f 20 22 2d args-defined? "-
6140: 68 22 20 22 2d 76 65 72 73 69 6f 6e 22 20 22 2d h" "-version" "-
6150: 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 gen-megatest-are
6160: 61 22 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 a" "-gen-megates
6170: 74 2d 74 65 73 74 22 29 0a 09 09 20 20 20 20 20 t-test")...
6180: 20 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 28 68 (eq? (length (h
6190: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 61 ash-table-keys a
61a0: 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 20 30 rgs:arg-hash)) 0
61b0: 29 29 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 ))... (debug:pr
61c0: 69 6e 74 2d 69 6e 66 6f 20 31 20 22 53 65 72 76 int-info 1 "Serv
61d0: 65 72 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 6e 6f er connection no
61e0: 74 20 6e 65 65 64 65 64 22 29 0a 09 09 20 20 28 t needed")... (
61f0: 62 65 67 69 6e 0a 09 09 20 20 20 20 3b 3b 20 28 begin... ;; (
6200: 69 66 20 72 75 6e 2d 69 64 20 0a 09 09 20 20 20 if run-id ...
6210: 20 3b 3b 20 20 20 20 20 28 63 6c 69 65 6e 74 3a ;; (client:
6220: 6c 61 75 6e 63 68 20 72 75 6e 2d 69 64 29 20 0a launch run-id) .
6230: 09 09 20 20 20 20 3b 3b 20 20 20 20 20 28 63 6c .. ;; (cl
6240: 69 65 6e 74 3a 6c 61 75 6e 63 68 20 30 29 20 20 ient:launch 0)
6250: 20 20 20 20 3b 3b 20 77 69 74 68 6f 75 74 20 72 ;; without r
6260: 75 6e 2d 69 64 20 77 65 27 6c 6c 20 73 74 61 72 un-id we'll star
6270: 74 20 61 20 73 65 72 76 65 72 20 66 6f 72 20 22 t a server for "
6280: 30 22 0a 09 09 20 20 20 20 23 74 0a 09 09 20 20 0"... #t...
6290: 20 20 29 29 29 29 29 29 0a 0a 3b 3b 20 4d 41 59 ))))))..;; MAY
62a0: 20 53 54 49 4c 4c 20 4e 45 45 44 20 54 48 49 53 STILL NEED THIS
62b0: 0a 3b 3b 09 09 20 20 20 20 20 20 20 28 73 65 74 .;;.. (set
62c0: 21 20 2a 6d 65 67 61 74 65 73 74 2d 64 62 2a 20 ! *megatest-db*
62d0: 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 (make-dbr:dbstru
62e0: 63 74 20 70 61 74 68 3a 20 74 6f 70 70 61 74 68 ct path: toppath
62f0: 20 6c 6f 63 61 6c 3a 20 23 74 29 29 29 29 29 29 local: #t))))))
6300: 29 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 ))))..(if (or (a
6310: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
6320: 73 74 2d 73 65 72 76 65 72 73 22 29 0a 09 28 61 st-servers")..(a
6330: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
6340: 6f 70 2d 73 65 72 76 65 72 22 29 29 0a 20 20 20 op-server")).
6350: 20 28 6c 65 74 20 28 28 74 6c 20 28 6c 61 75 6e (let ((tl (laun
6360: 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e ch:setup-for-run
6370: 20 2a 61 72 65 61 2d 64 61 74 2a 29 29 29 0a 20 *area-dat*))).
6380: 20 20 20 20 20 28 69 66 20 74 6c 20 0a 09 20 20 (if tl ..
6390: 28 6c 65 74 2a 20 28 28 74 64 62 64 61 74 20 20 (let* ((tdbdat
63a0: 28 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 29 (tasks:open-db))
63b0: 0a 09 09 20 28 73 65 72 76 65 72 73 20 28 74 61 ... (servers (ta
63c0: 73 6b 73 3a 67 65 74 2d 61 6c 6c 2d 73 65 72 76 sks:get-all-serv
63d0: 65 72 73 20 28 64 62 3a 64 65 6c 61 79 2d 69 66 ers (db:delay-if
63e0: 2d 62 75 73 79 20 74 64 62 64 61 74 29 29 29 0a -busy tdbdat))).
63f0: 09 09 20 28 66 6d 74 73 74 72 20 20 22 7e 35 61 .. (fmtstr "~5a
6400: 7e 31 32 61 7e 38 61 7e 32 30 61 7e 32 34 61 7e ~12a~8a~20a~24a~
6410: 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 5c 10a~10a~10a~10a\
6420: 6e 22 29 0a 09 09 20 28 73 65 72 76 65 72 73 2d n")... (servers-
6430: 74 6f 2d 6b 69 6c 6c 20 27 28 29 29 0a 09 09 20 to-kill '())...
6440: 28 6b 69 6c 6c 69 6e 66 6f 20 20 20 28 61 72 67 (killinfo (arg
6450: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 6f 70 s:get-arg "-stop
6460: 2d 73 65 72 76 65 72 22 29 29 0a 09 09 20 28 6b -server"))... (k
6470: 68 6f 73 74 2d 70 6f 72 74 20 28 69 66 20 6b 69 host-port (if ki
6480: 6c 6c 69 6e 66 6f 20 28 69 66 20 28 73 75 62 73 llinfo (if (subs
6490: 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 3a 22 20 tring-index ":"
64a0: 6b 69 6c 6c 69 6e 66 6f 29 28 73 74 72 69 6e 67 killinfo)(string
64b0: 2d 73 70 6c 69 74 20 22 3a 22 29 20 23 66 29 20 -split ":") #f)
64c0: 23 66 29 29 0a 09 09 20 28 73 69 64 20 20 20 20 #f))... (sid
64d0: 20 20 20 20 28 69 66 20 6b 69 6c 6c 69 6e 66 6f (if killinfo
64e0: 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d (if (substring-
64f0: 69 6e 64 65 78 20 22 3a 22 20 6b 69 6c 6c 69 6e index ":" killin
6500: 66 6f 29 20 23 66 20 28 73 74 72 69 6e 67 2d 3e fo) #f (string->
6510: 6e 75 6d 62 65 72 20 6b 69 6c 6c 69 6e 66 6f 29 number killinfo)
6520: 29 20 23 66 29 29 29 0a 09 20 20 20 20 28 66 6f ) #f))).. (fo
6530: 72 6d 61 74 20 23 74 20 66 6d 74 73 74 72 20 22 rmat #t fmtstr "
6540: 49 64 22 20 22 4d 54 76 65 72 22 20 22 50 69 64 Id" "MTver" "Pid
6550: 22 20 22 48 6f 73 74 22 20 22 49 6e 74 65 72 66 " "Host" "Interf
6560: 61 63 65 3a 4f 75 74 50 6f 72 74 22 20 22 49 6e ace:OutPort" "In
6570: 50 6f 72 74 22 20 22 4c 61 73 74 42 65 61 74 22 Port" "LastBeat"
6580: 20 22 53 74 61 74 65 22 20 22 54 72 61 6e 73 70 "State" "Transp
6590: 6f 72 74 22 29 0a 09 20 20 20 20 28 66 6f 72 6d ort").. (form
65a0: 61 74 20 23 74 20 66 6d 74 73 74 72 20 22 3d 3d at #t fmtstr "==
65b0: 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 20 " "=====" "==="
65c0: 22 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d "====" "========
65d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d =========" "====
65e0: 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 ==" "========" "
65f0: 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d =====" "========
6600: 3d 22 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 =").. (for-ea
6610: 63 68 20 0a 09 20 20 20 20 20 28 6c 61 6d 62 64 ch .. (lambd
6620: 61 20 28 73 65 72 76 65 72 29 0a 09 20 20 20 20 a (server)..
6630: 20 20 20 28 6c 65 74 2a 20 28 28 69 64 20 20 20 (let* ((id
6640: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re
6650: 66 20 73 65 72 76 65 72 20 30 29 29 0a 09 09 20 f server 0))...
6660: 20 20 20 20 20 28 70 69 64 20 20 20 20 20 20 20 (pid
6670: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
6680: 76 65 72 20 31 29 29 0a 09 09 20 20 20 20 20 20 ver 1))...
6690: 28 68 6f 73 74 6e 61 6d 65 20 20 20 28 76 65 63 (hostname (vec
66a0: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 32 tor-ref server 2
66b0: 29 29 0a 09 09 20 20 20 20 20 20 28 69 6e 74 65 ))... (inte
66c0: 72 66 61 63 65 20 20 28 76 65 63 74 6f 72 2d 72 rface (vector-r
66d0: 65 66 20 73 65 72 76 65 72 20 33 29 29 20 0a 09 ef server 3)) ..
66e0: 09 20 20 20 20 20 20 28 70 75 6c 6c 70 6f 72 74 . (pullport
66f0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
6700: 65 72 76 65 72 20 34 29 29 0a 09 09 20 20 20 20 erver 4))...
6710: 20 20 28 70 75 62 70 6f 72 74 20 20 20 20 28 76 (pubport (v
6720: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
6730: 20 35 29 29 0a 09 09 20 20 20 20 20 20 28 73 74 5))... (st
6740: 61 72 74 2d 74 69 6d 65 20 28 76 65 63 74 6f 72 art-time (vector
6750: 2d 72 65 66 20 73 65 72 76 65 72 20 36 29 29 0a -ref server 6)).
6760: 09 09 20 20 20 20 20 20 28 70 72 69 6f 72 69 74 .. (priorit
6770: 79 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 y (vector-ref
6780: 73 65 72 76 65 72 20 37 29 29 0a 09 09 20 20 20 server 7))...
6790: 20 20 20 28 73 74 61 74 65 20 20 20 20 20 20 28 (state (
67a0: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
67b0: 72 20 38 29 29 0a 09 09 20 20 20 20 20 20 28 6d r 8))... (m
67c0: 74 2d 76 65 72 20 20 20 20 20 28 76 65 63 74 6f t-ver (vecto
67d0: 72 2d 72 65 66 20 73 65 72 76 65 72 20 39 29 29 r-ref server 9))
67e0: 0a 09 09 20 20 20 20 20 20 28 6c 61 73 74 2d 75 ... (last-u
67f0: 70 64 61 74 65 20 28 76 65 63 74 6f 72 2d 72 65 pdate (vector-re
6800: 66 20 73 65 72 76 65 72 20 31 30 29 29 20 0a 09 f server 10)) ..
6810: 09 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 . (transpor
6820: 74 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 t (vector-ref s
6830: 65 72 76 65 72 20 31 31 29 29 0a 09 09 20 20 20 erver 11))...
6840: 20 20 20 28 6b 69 6c 6c 65 64 20 20 20 20 20 23 (killed #
6850: 66 29 0a 09 09 20 20 20 20 20 20 28 73 74 61 74 f)... (stat
6860: 75 73 20 20 20 20 20 28 3c 20 6c 61 73 74 2d 75 us (< last-u
6870: 70 64 61 74 65 20 32 30 29 29 29 0a 09 09 20 3b pdate 20)))... ;
6880: 3b 20 20 20 28 7a 6d 71 2d 73 6f 63 6b 65 74 73 ; (zmq-sockets
6890: 20 28 69 66 20 73 74 61 74 75 73 20 28 73 65 72 (if status (ser
68a0: 76 65 72 3a 63 6c 69 65 6e 74 2d 63 6f 6e 6e 65 ver:client-conne
68b0: 63 74 20 68 6f 73 74 6e 61 6d 65 20 70 6f 72 74 ct hostname port
68c0: 29 20 23 66 29 29 29 0a 09 09 20 3b 3b 20 6e 6f ) #f)))... ;; no
68d0: 20 6e 65 65 64 20 74 6f 20 6c 6f 67 69 6e 20 61 need to login a
68e0: 73 20 73 74 61 74 75 73 20 6f 66 20 23 74 20 69 s status of #t i
68f0: 6e 64 69 63 61 74 65 73 20 77 65 20 61 72 65 20 ndicates we are
6900: 63 6f 6e 6e 65 63 74 69 6e 67 20 74 6f 20 63 6f connecting to co
6910: 72 72 65 63 74 20 0a 09 09 20 3b 3b 20 73 65 72 rrect ... ;; ser
6920: 76 65 72 0a 09 09 20 28 69 66 20 28 65 71 75 61 ver... (if (equa
6930: 6c 3f 20 73 74 61 74 65 20 22 64 65 61 64 22 29 l? state "dead")
6940: 0a 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 6c ... (if (> l
6950: 61 73 74 2d 75 70 64 61 74 65 20 28 2a 20 32 35 ast-update (* 25
6960: 20 36 30 20 36 30 29 29 20 3b 3b 20 6b 65 65 70 60 60)) ;; keep
6970: 20 72 65 63 6f 72 64 73 20 61 72 6f 75 6e 64 20 records around
6980: 66 6f 72 20 73 6c 69 67 68 6c 79 20 6f 76 65 72 for slighly over
6990: 20 61 20 64 61 79 2e 0a 09 09 09 20 28 74 61 73 a day..... (tas
69a0: 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 ks:server-deregi
69b0: 73 74 65 72 20 28 64 62 3a 64 65 6c 61 79 2d 69 ster (db:delay-i
69c0: 66 2d 62 75 73 79 20 74 64 62 64 61 74 29 20 68 f-busy tdbdat) h
69d0: 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 74 ostname pullport
69e0: 3a 20 70 75 6c 6c 70 6f 72 74 20 70 69 64 3a 20 : pullport pid:
69f0: 70 69 64 20 61 63 74 69 6f 6e 3a 20 27 64 65 6c pid action: 'del
6a00: 65 74 65 29 29 0a 09 09 20 20 20 20 20 28 69 66 ete))... (if
6a10: 20 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 (> last-update
6a20: 32 30 29 20 20 20 20 20 20 20 20 3b 3b 20 4d 61 20) ;; Ma
6a30: 72 6b 20 61 73 20 64 65 61 64 20 69 66 20 6e 6f rk as dead if no
6a40: 74 20 75 70 64 61 74 65 64 20 69 6e 20 6c 61 73 t updated in las
6a50: 74 20 32 30 20 73 65 63 6f 6e 64 73 0a 09 09 09 t 20 seconds....
6a60: 20 28 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 (tasks:server-d
6a70: 65 72 65 67 69 73 74 65 72 20 28 64 62 3a 64 65 eregister (db:de
6a80: 6c 61 79 2d 69 66 2d 62 75 73 79 20 74 64 62 64 lay-if-busy tdbd
6a90: 61 74 29 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c at) hostname pul
6aa0: 6c 70 6f 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 lport: pullport
6ab0: 70 69 64 3a 20 70 69 64 29 29 29 0a 09 09 20 28 pid: pid)))... (
6ac0: 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 74 72 format #t fmtstr
6ad0: 20 69 64 20 6d 74 2d 76 65 72 20 70 69 64 20 68 id mt-ver pid h
6ae0: 6f 73 74 6e 61 6d 65 20 28 63 6f 6e 63 20 69 6e ostname (conc in
6af0: 74 65 72 66 61 63 65 20 22 3a 22 20 70 75 6c 6c terface ":" pull
6b00: 70 6f 72 74 29 20 70 75 62 70 6f 72 74 20 6c 61 port) pubport la
6b10: 73 74 2d 75 70 64 61 74 65 0a 09 09 09 20 28 69 st-update.... (i
6b20: 66 20 73 74 61 74 75 73 20 22 61 6c 69 76 65 22 f status "alive"
6b30: 20 22 64 65 61 64 22 29 20 74 72 61 6e 73 70 6f "dead") transpo
6b40: 72 74 29 0a 09 09 20 28 69 66 20 28 6f 72 20 28 rt)... (if (or (
6b50: 65 71 75 61 6c 3f 20 69 64 20 73 69 64 29 0a 09 equal? id sid)..
6b60: 09 09 20 28 65 71 75 61 6c 3f 20 73 69 64 20 30 .. (equal? sid 0
6b70: 29 29 20 3b 3b 20 6b 69 6c 6c 20 61 6c 6c 2f 61 )) ;; kill all/a
6b80: 6e 79 0a 09 09 20 20 20 20 20 28 62 65 67 69 6e ny... (begin
6b90: 0a 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 ... (debug
6ba0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 41 :print-info 0 "A
6bb0: 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 73 74 6f ttempting to sto
6bc0: 70 20 73 65 72 76 65 72 20 77 69 74 68 20 70 69 p server with pi
6bd0: 64 20 22 20 70 69 64 29 0a 09 09 20 20 20 20 20 d " pid)...
6be0: 20 20 28 74 61 73 6b 73 3a 6b 69 6c 6c 2d 73 65 (tasks:kill-se
6bf0: 72 76 65 72 20 73 74 61 74 75 73 20 68 6f 73 74 rver status host
6c00: 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 74 20 70 69 name pullport pi
6c10: 64 20 74 72 61 6e 73 70 6f 72 74 29 29 29 29 29 d transport)))))
6c20: 0a 09 20 20 20 20 20 73 65 72 76 65 72 73 29 0a .. servers).
6c30: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
6c40: 74 2d 69 6e 66 6f 20 31 20 22 44 6f 6e 65 20 77 t-info 1 "Done w
6c50: 69 74 68 20 6c 69 73 74 73 65 72 76 65 72 73 22 ith listservers"
6c60: 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 69 ).. (set! *di
6c70: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a dsomething* #t).
6c80: 09 20 20 20 20 28 65 78 69 74 29 29 20 3b 3b 20 . (exit)) ;;
6c90: 6d 75 73 74 20 64 6f 2c 20 77 6f 75 6c 64 20 68 must do, would h
6ca0: 61 76 65 20 74 6f 20 61 64 64 20 63 68 65 63 6b ave to add check
6cb0: 73 20 74 6f 20 6d 61 6e 79 2f 61 6c 6c 20 63 61 s to many/all ca
6cc0: 6c 6c 73 20 62 65 6c 6f 77 0a 09 20 20 28 65 78 lls below.. (ex
6cd0: 69 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d it))))..;;======
6ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d20: 0a 3b 3b 20 57 65 69 72 64 20 73 70 65 63 69 61 .;; Weird specia
6d30: 6c 20 63 61 6c 6c 73 20 74 68 61 74 20 6e 65 65 l calls that nee
6d40: 64 20 74 6f 20 72 75 6e 20 2a 61 66 74 65 72 2a d to run *after*
6d50: 20 74 68 65 20 73 65 72 76 65 72 20 68 61 73 20 the server has
6d60: 73 74 61 72 74 65 64 3f 0a 3b 3b 3d 3d 3d 3d 3d started?.;;=====
6d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6db0: 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 =..(if (args:get
6dc0: 2d 61 72 67 20 22 2d 6c 69 73 74 2d 74 61 72 67 -arg "-list-targ
6dd0: 65 74 73 22 29 0a 20 20 20 20 28 6c 65 74 20 28 ets"). (let (
6de0: 28 74 61 72 67 65 74 73 20 28 63 6f 6d 6d 6f 6e (targets (common
6df0: 3a 67 65 74 2d 72 75 6e 63 6f 6e 66 69 67 2d 74 :get-runconfig-t
6e00: 61 72 67 65 74 73 29 29 29 0a 20 20 20 20 20 20 argets))).
6e10: 28 70 72 69 6e 74 20 22 46 6f 75 6e 64 20 22 28 (print "Found "(
6e20: 6c 65 6e 67 74 68 20 74 61 72 67 65 74 73 29 20 length targets)
6e30: 22 20 74 61 72 67 65 74 73 22 29 0a 20 20 20 20 " targets").
6e40: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
6e50: 62 64 61 20 28 78 29 0a 09 09 20 20 3b 3b 20 28 bda (x)... ;; (
6e60: 70 72 69 6e 74 20 22 5b 22 20 78 20 22 5d 22 29 print "[" x "]")
6e70: 29 0a 09 09 20 20 28 70 72 69 6e 74 20 78 29 29 )... (print x))
6e80: 0a 09 09 74 61 72 67 65 74 73 29 0a 20 20 20 20 ...targets).
6e90: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
6ea0: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 64 thing* #t)))..(d
6eb0: 65 66 69 6e 65 20 28 66 75 6c 6c 2d 72 75 6e 63 efine (full-runc
6ec0: 6f 6e 66 69 67 73 2d 72 65 61 64 20 61 72 65 61 onfigs-read area
6ed0: 2d 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 -dat). (let* ((
6ee0: 74 6f 70 70 61 74 68 20 20 28 6d 65 67 61 74 65 toppath (megate
6ef0: 73 74 3a 61 72 65 61 2d 70 61 74 68 20 61 72 65 st:area-path are
6f00: 61 2d 64 61 74 29 29 0a 09 20 28 6b 65 79 73 20 a-dat)).. (keys
6f10: 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 (rmt:get-key
6f20: 73 29 29 0a 09 20 28 74 61 72 67 65 74 20 20 20 s)).. (target
6f30: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
6f40: 2d 74 61 72 67 65 74 29 29 0a 09 20 28 6b 65 79 -target)).. (key
6f50: 2d 76 61 6c 73 20 28 69 66 20 74 61 72 67 65 74 -vals (if target
6f60: 20 28 6b 65 79 73 3a 74 61 72 67 65 74 2d 3e 6b (keys:target->k
6f70: 65 79 76 61 6c 20 6b 65 79 73 20 74 61 72 67 65 eyval keys targe
6f80: 74 29 20 23 66 29 29 0a 09 20 28 73 65 63 74 69 t) #f)).. (secti
6f90: 6f 6e 73 20 28 69 66 20 74 61 72 67 65 74 20 28 ons (if target (
6fa0: 6c 69 73 74 20 22 64 65 66 61 75 6c 74 22 20 74 list "default" t
6fb0: 61 72 67 65 74 29 20 23 66 29 29 0a 09 20 28 64 arget) #f)).. (d
6fc0: 61 74 61 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ata (begin..
6fd0: 09 20 20 20 20 20 28 73 65 74 65 6e 76 20 22 4d . (setenv "M
6fe0: 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 T_RUN_AREA_HOME"
6ff0: 20 74 6f 70 70 61 74 68 29 0a 09 09 20 20 20 20 toppath)...
7000: 20 28 69 66 20 6b 65 79 2d 76 61 6c 73 0a 09 09 (if key-vals...
7010: 09 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d . (for-each (lam
7020: 62 64 61 20 28 6b 74 29 0a 09 09 09 09 20 20 20 bda (kt).....
7030: 20 20 28 73 65 74 65 6e 76 20 28 63 61 72 20 6b (setenv (car k
7040: 74 29 20 28 63 61 64 72 20 6b 74 29 29 29 0a 09 t) (cadr kt)))..
7050: 09 09 09 20 20 20 6b 65 79 2d 76 61 6c 73 29 29 ... key-vals))
7060: 0a 09 09 20 20 20 20 20 28 72 65 61 64 2d 63 6f ... (read-co
7070: 6e 66 69 67 20 28 63 6f 6e 63 20 74 6f 70 70 61 nfig (conc toppa
7080: 74 68 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e th "/runconfigs.
7090: 63 6f 6e 66 69 67 22 29 20 23 66 20 23 74 20 73 config") #f #t s
70a0: 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f 6e ections: section
70b0: 73 29 29 29 29 0a 20 20 20 20 64 61 74 61 29 29 s)))). data))
70c0: 0a 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 ...(if (args:get
70d0: 2d 61 72 67 20 22 2d 73 68 6f 77 2d 72 75 6e 63 -arg "-show-runc
70e0: 6f 6e 66 69 67 22 29 0a 20 20 20 20 28 6c 65 74 onfig"). (let
70f0: 20 28 28 74 6c 20 28 6c 61 75 6e 63 68 3a 73 65 ((tl (launch:se
7100: 74 75 70 2d 66 6f 72 2d 72 75 6e 20 2a 61 72 65 tup-for-run *are
7110: 61 2d 64 61 74 2a 29 29 29 0a 20 20 20 20 20 20 a-dat*))).
7120: 28 70 75 73 68 2d 64 69 72 65 63 74 6f 72 79 20 (push-directory
7130: 28 6d 65 67 61 74 65 73 74 3a 61 72 65 61 2d 70 (megatest:area-p
7140: 61 74 68 20 2a 61 72 65 61 2d 64 61 74 2a 29 29 ath *area-dat*))
7150: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 61 . (let ((da
7160: 74 61 20 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e 66 ta (full-runconf
7170: 69 67 73 2d 72 65 61 64 29 29 29 0a 09 3b 3b 20 igs-read)))..;;
7180: 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c 6f keep this one lo
7190: 63 61 6c 0a 09 28 63 6f 6e 64 0a 09 20 28 28 61 cal..(cond.. ((a
71a0: 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 nd (args:get-arg
71b0: 20 22 2d 73 65 63 74 69 6f 6e 22 29 0a 09 20 20 "-section")..
71c0: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
71d0: 72 67 20 22 2d 76 61 72 22 29 29 0a 09 20 20 28 rg "-var")).. (
71e0: 6c 65 74 20 28 28 76 61 6c 20 28 63 6f 6e 66 69 let ((val (confi
71f0: 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 61 20 28 gf:lookup data (
7200: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
7210: 65 63 74 69 6f 6e 22 29 28 61 72 67 73 3a 67 65 ection")(args:ge
7220: 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 29 29 t-arg "-var"))))
7230: 0a 09 20 20 20 20 28 69 66 20 76 61 6c 20 28 70 .. (if val (p
7240: 72 69 6e 74 20 76 61 6c 29 29 29 29 0a 09 20 28 rint val)))).. (
7250: 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 (not (args:get-a
7260: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 29 rg "-dumpmode"))
7270: 0a 09 20 20 28 70 70 20 28 68 61 73 68 2d 74 61 .. (pp (hash-ta
7280: 62 6c 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 29 ble->alist data)
7290: 29 29 0a 09 20 28 28 73 74 72 69 6e 67 3d 3f 20 )).. ((string=?
72a0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
72b0: 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e dumpmode") "json
72c0: 22 29 0a 09 28 6a 73 6f 6e 2d 77 72 69 74 65 20 ")..(json-write
72d0: 64 61 74 61 29 29 0a 09 20 28 65 6c 73 65 0a 09 data)).. (else..
72e0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
72f0: 20 22 45 52 52 4f 52 3a 20 2d 64 75 6d 70 6d 6f "ERROR: -dumpmo
7300: 64 65 20 6f 66 20 22 20 28 61 72 67 73 3a 67 65 de of " (args:ge
7310: 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 t-arg "-dumpmode
7320: 22 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 6e 69 ") " not recogni
7330: 73 65 64 22 29 29 29 0a 09 28 73 65 74 21 20 2a sed")))..(set! *
7340: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
7350: 29 29 0a 20 20 20 20 20 20 28 70 6f 70 2d 64 69 )). (pop-di
7360: 72 65 63 74 6f 72 79 29 29 29 0a 0a 28 69 66 20 rectory)))..(if
7370: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7380: 73 68 6f 77 2d 63 6f 6e 66 69 67 22 29 0a 20 20 show-config").
7390: 20 20 28 6c 65 74 20 28 28 74 6c 20 20 20 28 6c (let ((tl (l
73a0: 61 75 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d aunch:setup-for-
73b0: 72 75 6e 20 2a 61 72 65 61 2d 64 61 74 2a 29 29 run *area-dat*))
73c0: 0a 09 20 20 28 64 61 74 61 20 28 6d 65 67 61 74 .. (data (megat
73d0: 65 73 74 3a 61 72 65 61 2d 63 6f 6e 66 69 67 64 est:area-configd
73e0: 61 74 20 2a 61 72 65 61 2d 64 61 74 2a 29 29 29 at *area-dat*)))
73f0: 0a 20 20 20 20 20 20 28 70 75 73 68 2d 64 69 72 . (push-dir
7400: 65 63 74 6f 72 79 20 28 6d 65 67 61 74 65 73 74 ectory (megatest
7410: 3a 61 72 65 61 2d 70 61 74 68 20 2a 61 72 65 61 :area-path *area
7420: 2d 64 61 74 2a 29 29 0a 20 20 20 20 20 20 3b 3b -dat*)). ;;
7430: 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c keep this one l
7440: 6f 63 61 6c 0a 20 20 20 20 20 20 28 63 6f 6e 64 ocal. (cond
7450: 20 0a 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 . ((and (
7460: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
7470: 65 63 74 69 6f 6e 22 29 0a 09 20 20 20 20 20 28 ection").. (
7480: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 args:get-arg "-v
7490: 61 72 22 29 29 0a 09 28 6c 65 74 20 28 28 76 61 ar"))..(let ((va
74a0: 6c 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 l (configf:looku
74b0: 70 20 64 61 74 61 20 28 61 72 67 73 3a 67 65 74 p data (args:get
74c0: 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 -arg "-section")
74d0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
74e0: 76 61 72 22 29 29 29 29 0a 09 20 20 28 69 66 20 var")))).. (if
74f0: 76 61 6c 20 28 70 72 69 6e 74 20 76 61 6c 29 29 val (print val))
7500: 29 29 0a 20 20 20 20 20 20 20 28 28 6e 6f 74 20 )). ((not
7510: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7520: 64 75 6d 70 6d 6f 64 65 22 29 29 0a 09 28 70 70 dumpmode"))..(pp
7530: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c (hash-table->al
7540: 69 73 74 20 64 61 74 61 29 29 29 0a 20 20 20 20 ist data))).
7550: 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 ((string=? (a
7560: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
7570: 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 29 mpmode") "json")
7580: 0a 09 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 ..(json-write da
7590: 74 61 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 ta)). (els
75a0: 65 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 e..(debug:print
75b0: 30 20 22 45 52 52 4f 52 3a 20 2d 64 75 6d 70 6d 0 "ERROR: -dumpm
75c0: 6f 64 65 20 6f 66 20 22 20 28 61 72 67 73 3a 67 ode of " (args:g
75d0: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
75e0: 65 22 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 6e e") " not recogn
75f0: 69 73 65 64 22 29 29 29 0a 20 20 20 20 20 20 28 ised"))). (
7600: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
7610: 6e 67 2a 20 23 74 29 0a 20 20 20 20 20 20 28 70 ng* #t). (p
7620: 6f 70 2d 64 69 72 65 63 74 6f 72 79 29 29 29 0a op-directory))).
7630: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
7640: 72 67 20 22 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 rg "-show-cmdinf
7650: 6f 22 29 0a 20 20 20 20 28 69 66 20 28 67 65 74 o"). (if (get
7660: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
7670: 29 0a 09 28 6c 65 74 20 28 28 64 61 74 61 20 28 )..(let ((data (
7680: 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f common:read-enco
7690: 64 65 64 2d 73 74 72 69 6e 67 20 28 67 65 74 65 ded-string (gete
76a0: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
76b0: 29 29 29 0a 09 20 20 28 69 66 20 28 65 71 75 61 ))).. (if (equa
76c0: 6c 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 l? (args:get-arg
76d0: 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a "-dumpmode") "j
76e0: 73 6f 6e 22 29 0a 09 20 20 20 20 20 20 28 6a 73 son").. (js
76f0: 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 29 0a 09 on-write data)..
7700: 20 20 20 20 20 20 28 70 70 20 64 61 74 61 29 29 (pp data))
7710: 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f .. (set! *didso
7720: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 0a 09 28 mething* #t))..(
7730: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
7740: 20 30 20 22 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 0 "environment
7750: 76 61 72 69 61 62 6c 65 20 4d 54 5f 43 4d 44 49 variable MT_CMDI
7760: 4e 46 4f 20 69 73 20 6e 6f 74 20 73 65 74 22 29 NFO is not set")
7770: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
7780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
77a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
77b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
77c0: 52 65 6d 6f 76 65 20 6f 6c 64 20 72 75 6e 28 73 Remove old run(s
77d0: 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ).;;============
77e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
77f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 ==========..;; s
7820: 69 6e 63 65 20 73 65 76 65 72 61 6c 20 61 63 74 ince several act
7830: 69 6f 6e 73 20 63 61 6e 20 62 65 20 73 70 65 63 ions can be spec
7840: 69 66 69 65 64 20 6f 6e 20 74 68 65 20 63 6f 6d ified on the com
7850: 6d 61 6e 64 20 6c 69 6e 65 20 74 68 65 20 72 65 mand line the re
7860: 6d 6f 76 61 6c 0a 3b 3b 20 69 73 20 64 6f 6e 65 moval.;; is done
7870: 20 66 69 72 73 74 0a 28 64 65 66 69 6e 65 20 28 first.(define (
7880: 6f 70 65 72 61 74 65 2d 6f 6e 20 61 63 74 69 6f operate-on actio
7890: 6e 20 61 72 65 61 2d 64 61 74 29 0a 20 20 28 6c n area-dat). (l
78a0: 65 74 2a 20 28 28 72 75 6e 72 65 63 20 20 20 20 et* ((runrec
78b0: 20 28 72 75 6e 73 3a 72 75 6e 72 65 63 2d 6d 61 (runs:runrec-ma
78c0: 6b 65 2d 72 65 63 6f 72 64 29 29 0a 09 20 28 74 ke-record)).. (t
78d0: 61 72 67 65 74 20 20 20 20 20 28 63 6f 6d 6d 6f arget (commo
78e0: 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 n:args-get-targe
78f0: 74 29 29 0a 09 20 28 63 6f 6e 66 69 67 69 6e 66 t)).. (configinf
7900: 6f 20 28 6d 65 67 61 74 65 73 74 3a 61 72 65 61 o (megatest:area
7910: 2d 63 6f 6e 66 69 67 69 6e 66 6f 20 61 72 65 61 -configinfo area
7920: 2d 64 61 74 29 29 29 0a 20 20 20 20 28 63 6f 6e -dat))). (con
7930: 64 0a 20 20 20 20 20 28 28 6e 6f 74 20 74 61 72 d. ((not tar
7940: 67 65 74 29 0a 20 20 20 20 20 20 28 64 65 62 75 get). (debu
7950: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
7960: 3a 20 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 : Missing requir
7970: 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 ed parameter for
7980: 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 " action ", you
7990: 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 2d 74 must specify -t
79a0: 61 72 67 65 74 20 6f 72 20 2d 72 65 71 74 61 72 arget or -reqtar
79b0: 67 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 g"). (exit
79c0: 31 29 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 1)). ((not (
79d0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
79e0: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 0a 09 20 20 ":runname")..
79f0: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
7a00: 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 29 29 rg "-runname")))
7a10: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
7a20: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4d 69 int 0 "ERROR: Mi
7a30: 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 ssing required p
7a40: 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 61 arameter for " a
7a50: 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 ction ", you mus
7a60: 74 20 73 70 65 63 69 66 79 20 74 68 65 20 72 75 t specify the ru
7a70: 6e 20 6e 61 6d 65 20 70 61 74 74 65 72 6e 20 77 n name pattern w
7a80: 69 74 68 20 2d 72 75 6e 6e 61 6d 65 20 70 61 74 ith -runname pat
7a90: 74 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 t"). (exit
7aa0: 32 29 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 2)). ((not (
7ab0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
7ac0: 65 73 74 70 61 74 74 22 29 29 0a 20 20 20 20 20 estpatt")).
7ad0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
7ae0: 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 20 "ERROR: Missing
7af0: 72 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 74 required paramet
7b00: 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f 6e 20 er for " action
7b10: 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 ", you must spec
7b20: 69 66 79 20 74 68 65 20 74 65 73 74 20 70 61 74 ify the test pat
7b30: 74 65 72 6e 20 77 69 74 68 20 2d 74 65 73 74 70 tern with -testp
7b40: 61 74 74 22 29 0a 20 20 20 20 20 20 28 65 78 69 att"). (exi
7b50: 74 20 33 29 29 0a 20 20 20 20 20 28 65 6c 73 65 t 3)). (else
7b60: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
7b70: 28 63 61 72 20 63 6f 6e 66 69 67 69 6e 66 6f 29 (car configinfo)
7b80: 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 ).. (begin..
7b90: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
7ba0: 22 45 52 52 4f 52 3a 20 41 74 74 65 6d 70 74 65 "ERROR: Attempte
7bb0: 64 20 22 20 61 63 74 69 6f 6e 20 22 6f 6e 20 74 d " action "on t
7bc0: 65 73 74 28 73 29 20 62 75 74 20 72 75 6e 20 61 est(s) but run a
7bd0: 72 65 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 rea config file
7be0: 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 09 20 20 20 not found")..
7bf0: 20 28 65 78 69 74 20 31 29 29 0a 09 20 20 3b 3b (exit 1)).. ;;
7c00: 20 70 75 74 20 74 65 73 74 20 70 61 72 61 6d 65 put test parame
7c10: 74 65 72 73 20 69 6e 74 6f 20 63 6f 6e 76 65 6e ters into conven
7c20: 69 65 6e 74 20 76 61 72 69 61 62 6c 65 73 0a 09 ient variables..
7c30: 20 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d (runs:operate-
7c40: 6f 6e 20 20 61 63 74 69 6f 6e 0a 09 09 09 20 20 on action....
7c50: 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 target....
7c60: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
7c70: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 g "-runname")(ar
7c80: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
7c90: 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 20 20 28 name")).... (
7ca0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
7cb0: 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 estpatt")....
7cc0: 20 61 72 65 61 2d 64 61 74 0a 09 09 09 20 20 20 area-dat....
7cd0: 20 73 74 61 74 65 3a 20 28 6f 72 20 28 61 72 67 state: (or (arg
7ce0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 s:get-arg "-stat
7cf0: 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 e")(args:get-arg
7d00: 20 22 3a 73 74 61 74 65 22 29 20 29 0a 09 09 09 ":state") )....
7d10: 20 20 20 20 73 74 61 74 75 73 3a 20 28 6f 72 20 status: (or
7d20: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7d30: 73 74 61 74 75 73 22 29 28 61 72 67 73 3a 67 65 status")(args:ge
7d40: 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 t-arg ":status")
7d50: 29 0a 09 09 09 20 20 20 20 6e 65 77 2d 73 74 61 ).... new-sta
7d60: 74 65 2d 73 74 61 74 75 73 3a 20 28 61 72 67 73 te-status: (args
7d70: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 :get-arg "-set-s
7d80: 74 61 74 65 2d 73 74 61 74 75 73 22 29 29 29 0a tate-status"))).
7d90: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
7da0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
7db0: 29 29 0a 09 20 20 0a 28 69 66 20 28 61 72 67 73 )).. .(if (args
7dc0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 :get-arg "-remov
7dd0: 65 2d 72 75 6e 73 22 29 0a 20 20 20 20 28 67 65 e-runs"). (ge
7de0: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
7df0: 20 20 20 20 20 22 2d 72 65 6d 6f 76 65 2d 72 75 "-remove-ru
7e00: 6e 73 22 0a 20 20 20 20 20 22 72 65 6d 6f 76 65 ns". "remove
7e10: 20 72 75 6e 73 22 0a 20 20 20 20 20 28 6c 61 6d runs". (lam
7e20: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
7e30: 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 ame keys keyvals
7e40: 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 ). (operat
7e50: 65 2d 6f 6e 20 27 72 65 6d 6f 76 65 2d 72 75 6e e-on 'remove-run
7e60: 73 29 29 0a 20 20 20 20 20 2a 61 72 65 61 2d 64 s)). *area-d
7e70: 61 74 2a 29 29 0a 0a 28 69 66 20 28 61 72 67 73 at*))..(if (args
7e80: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 :get-arg "-set-s
7e90: 74 61 74 65 2d 73 74 61 74 75 73 22 29 0a 20 20 tate-status").
7ea0: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
7eb0: 61 6c 6c 20 0a 20 20 20 20 20 22 2d 73 65 74 2d all . "-set-
7ec0: 73 74 61 74 65 2d 73 74 61 74 75 73 22 0a 20 20 state-status".
7ed0: 20 20 20 22 73 65 74 20 73 74 61 74 65 20 61 6e "set state an
7ee0: 64 20 73 74 61 74 75 73 22 0a 20 20 20 20 20 28 d status". (
7ef0: 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 lambda (target r
7f00: 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 unname keys keyv
7f10: 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6f 70 65 als). (ope
7f20: 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 rate-on 'set-sta
7f30: 74 65 2d 73 74 61 74 75 73 29 29 0a 20 20 20 20 te-status)).
7f40: 20 2a 61 72 65 61 2d 64 61 74 2a 29 29 0a 0a 28 *area-dat*))..(
7f50: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
7f60: 2d 61 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 -arg "-set-run-s
7f70: 74 61 74 75 73 22 29 0a 09 28 61 72 67 73 3a 67 tatus")..(args:g
7f80: 65 74 2d 61 72 67 20 22 2d 67 65 74 2d 72 75 6e et-arg "-get-run
7f90: 2d 73 74 61 74 75 73 22 29 29 0a 20 20 20 20 28 -status")). (
7fa0: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
7fb0: 0a 20 20 20 20 20 22 2d 73 65 74 2d 72 75 6e 2d . "-set-run-
7fc0: 73 74 61 74 75 73 22 0a 20 20 20 20 20 22 73 65 status". "se
7fd0: 74 20 72 75 6e 20 73 74 61 74 75 73 22 0a 20 20 t run status".
7fe0: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
7ff0: 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
8000: 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 keyvals).
8010: 28 6c 65 74 2a 20 28 28 72 75 6e 73 64 61 74 20 (let* ((runsdat
8020: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 (rmt:get-runs-b
8030: 79 2d 70 61 74 74 20 6b 65 79 73 20 72 75 6e 6e y-patt keys runn
8040: 61 6d 65 20 0a 09 09 09 09 09 28 63 6f 6d 6d 6f ame ......(commo
8050: 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 n:args-get-targe
8060: 74 29 0a 09 09 09 09 09 23 66 20 23 66 29 29 0a t)......#f #f)).
8070: 09 20 20 20 20 20 20 28 68 65 61 64 65 72 20 20 . (header
8080: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e (vector-ref run
8090: 73 64 61 74 20 30 29 29 0a 09 20 20 20 20 20 20 sdat 0))..
80a0: 28 72 6f 77 73 20 20 20 20 20 28 76 65 63 74 6f (rows (vecto
80b0: 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 31 29 r-ref runsdat 1)
80c0: 29 29 0a 09 20 28 69 66 20 28 6e 75 6c 6c 3f 20 )).. (if (null?
80d0: 72 6f 77 73 29 0a 09 20 20 20 20 20 28 62 65 67 rows).. (beg
80e0: 69 6e 0a 09 20 20 20 20 20 20 20 28 64 65 62 75 in.. (debu
80f0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 g:print-info 0 "
8100: 4e 6f 20 6d 61 74 63 68 69 6e 67 20 72 75 6e 20 No matching run
8110: 66 6f 75 6e 64 2e 22 29 0a 09 20 20 20 20 20 20 found.")..
8120: 20 28 65 78 69 74 20 31 29 29 0a 09 20 20 20 20 (exit 1))..
8130: 20 28 6c 65 74 2a 20 28 28 72 6f 77 20 20 20 20 (let* ((row
8140: 20 20 28 63 61 72 20 28 76 65 63 74 6f 72 2d 72 (car (vector-r
8150: 65 66 20 72 75 6e 73 64 61 74 20 31 29 29 29 0a ef runsdat 1))).
8160: 09 09 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 .. (run-id
8170: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
8180: 2d 68 65 61 64 65 72 20 72 6f 77 20 68 65 61 64 -header row head
8190: 65 72 20 22 69 64 22 29 29 29 0a 09 20 20 20 20 er "id")))..
81a0: 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 (if (args:get
81b0: 2d 61 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 -arg "-set-run-s
81c0: 74 61 74 75 73 22 29 0a 09 09 20 20 20 28 72 6d tatus")... (rm
81d0: 74 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 t:set-run-status
81e0: 20 72 75 6e 2d 69 64 20 28 61 72 67 73 3a 67 65 run-id (args:ge
81f0: 74 2d 61 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d t-arg "-set-run-
8200: 73 74 61 74 75 73 22 29 20 6d 73 67 3a 20 28 61 status") msg: (a
8210: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
8220: 29 29 0a 09 09 20 20 20 28 70 72 69 6e 74 20 28 ))... (print (
8230: 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 rmt:get-run-stat
8240: 75 73 20 72 75 6e 2d 69 64 29 29 0a 09 09 20 20 us run-id))...
8250: 20 29 29 29 29 29 0a 20 20 20 20 20 2a 61 72 65 ))))). *are
8260: 61 2d 64 61 74 2a 29 29 0a 0a 3b 3b 3d 3d 3d 3d a-dat*))..;;====
8270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82b0: 3d 3d 0a 3b 3b 20 51 75 65 72 79 20 72 75 6e 73 ==.;; Query runs
82c0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
82d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f =========..;; NO
8310: 54 45 3a 20 6c 69 73 74 2d 72 75 6e 73 20 61 6e TE: list-runs an
8320: 64 20 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 d list-db-target
8330: 73 20 6f 70 65 72 61 74 65 20 6f 6e 20 6c 6f 63 s operate on loc
8340: 61 6c 20 64 62 21 21 21 0a 3b 3b 0a 28 69 66 20 al db!!!.;;.(if
8350: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
8360: 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 0a g "-list-runs").
8370: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
8380: 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 -list-db-targets
8390: 22 29 29 0a 20 20 20 20 28 69 66 20 28 6c 61 75 ")). (if (lau
83a0: 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d 72 75 nch:setup-for-ru
83b0: 6e 20 2a 61 72 65 61 2d 64 61 74 2a 29 0a 09 28 n *area-dat*)..(
83c0: 6c 65 74 2a 20 28 28 64 62 73 74 72 75 63 74 20 let* ((dbstruct
83d0: 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 (make-dbr:dbstru
83e0: 63 74 20 70 61 74 68 3a 20 28 6d 65 67 61 74 65 ct path: (megate
83f0: 73 74 3a 61 72 65 61 2d 70 61 74 68 20 2a 61 72 st:area-path *ar
8400: 65 61 2d 64 61 74 2a 29 20 6c 6f 63 61 6c 3a 20 ea-dat*) local:
8410: 23 74 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 #t)).. (ru
8420: 6e 70 61 74 74 20 20 28 61 72 67 73 3a 67 65 74 npatt (args:get
8430: 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 -arg "-list-runs
8440: 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 ")).. (tes
8450: 74 70 61 74 74 20 28 69 66 20 28 61 72 67 73 3a tpatt (if (args:
8460: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
8470: 74 74 22 29 20 0a 09 09 09 20 20 20 20 20 28 61 tt") .... (a
8480: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
8490: 73 74 70 61 74 74 22 29 20 0a 09 09 09 20 20 20 stpatt") ....
84a0: 20 20 22 25 22 29 29 0a 09 20 20 20 20 20 20 20 "%"))..
84b0: 28 6b 65 79 73 20 20 20 20 20 28 64 62 3a 67 65 (keys (db:ge
84c0: 74 2d 6b 65 79 73 20 64 62 73 74 72 75 63 74 29 t-keys dbstruct)
84d0: 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 72 75 ).. ;; (ru
84e0: 6e 73 64 61 74 20 20 28 64 62 3a 67 65 74 2d 72 nsdat (db:get-r
84f0: 75 6e 73 20 64 62 73 74 72 75 63 74 20 72 75 6e uns dbstruct run
8500: 70 61 74 74 20 23 66 20 23 66 20 27 28 29 29 29 patt #f #f '()))
8510: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 64 61 .. (runsda
8520: 74 20 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 2d t (db:get-runs-
8530: 62 79 2d 70 61 74 74 20 64 62 73 74 72 75 63 74 by-patt dbstruct
8540: 20 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 61 74 keys (or runpat
8550: 74 20 22 25 22 29 20 28 63 6f 6d 6d 6f 6e 3a 61 t "%") (common:a
8560: 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 0a rgs-get-target).
8570: 09 09 09 09 09 20 23 66 20 23 66 29 29 0a 09 09 ..... #f #f))...
8580: 3b 3b 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 ;; (cdb:remote-r
8590: 75 6e 20 64 62 3a 67 65 74 2d 72 75 6e 73 20 23 un db:get-runs #
85a0: 66 20 72 75 6e 70 61 74 74 20 23 66 20 23 66 20 f runpatt #f #f
85b0: 27 28 29 29 29 0a 09 20 20 20 20 20 20 20 28 72 '())).. (r
85c0: 75 6e 73 20 20 20 20 20 28 64 62 3a 67 65 74 2d uns (db:get-
85d0: 72 6f 77 73 20 72 75 6e 73 64 61 74 29 29 0a 09 rows runsdat))..
85e0: 20 20 20 20 20 20 20 28 68 65 61 64 65 72 20 20 (header
85f0: 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 (db:get-header
8600: 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 runsdat))..
8610: 20 20 28 64 62 2d 74 61 72 67 65 74 73 20 28 61 (db-targets (a
8620: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
8630: 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 29 29 st-db-targets"))
8640: 0a 09 20 20 20 20 20 20 20 28 73 65 65 6e 20 20 .. (seen
8650: 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 (make-hash-ta
8660: 62 6c 65 29 29 0a 09 20 20 20 20 20 20 20 28 64 ble)).. (d
8670: 6d 6f 64 65 20 20 20 20 28 6c 65 74 20 28 28 64 mode (let ((d
8680: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8690: 2d 64 75 6d 70 6d 6f 64 65 22 29 29 29 0a 09 09 -dumpmode")))...
86a0: 09 20 20 20 28 69 66 20 64 20 28 73 74 72 69 6e . (if d (strin
86b0: 67 2d 3e 73 79 6d 62 6f 6c 20 64 29 20 23 66 29 g->symbol d) #f)
86c0: 29 29 0a 09 20 20 20 20 20 20 20 28 64 61 74 61 )).. (data
86d0: 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d (make-hash-
86e0: 74 61 62 6c 65 29 29 29 0a 09 20 20 3b 3b 20 45 table))).. ;; E
86f0: 61 63 68 20 72 75 6e 0a 09 20 20 28 66 6f 72 2d ach run.. (for-
8700: 65 61 63 68 20 0a 09 20 20 20 28 6c 61 6d 62 64 each .. (lambd
8710: 61 20 28 72 75 6e 29 0a 09 20 20 20 20 20 28 6c a (run).. (l
8720: 65 74 20 28 28 74 61 72 67 65 74 73 74 72 20 28 et ((targetstr (
8730: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
8740: 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 se (map (lambda
8750: 28 78 29 0a 09 09 09 09 09 09 09 20 28 64 62 3a (x)........ (db:
8760: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
8770: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 78 der run header x
8780: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
8790: 6b 65 79 73 29 20 22 2f 22 29 29 29 0a 09 20 20 keys) "/")))..
87a0: 20 20 20 20 20 28 69 66 20 64 62 2d 74 61 72 67 (if db-targ
87b0: 65 74 73 0a 09 09 20 20 20 28 69 66 20 28 6e 6f ets... (if (no
87c0: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
87d0: 66 2f 64 65 66 61 75 6c 74 20 73 65 65 6e 20 74 f/default seen t
87e0: 61 72 67 65 74 73 74 72 20 23 66 29 29 0a 09 09 argetstr #f))...
87f0: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 (begin...
8800: 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 . (hash-table-se
8810: 74 21 20 73 65 65 6e 20 74 61 72 67 65 74 73 74 t! seen targetst
8820: 72 20 23 74 29 0a 09 09 09 20 3b 3b 20 28 70 72 r #t).... ;; (pr
8830: 69 6e 74 20 22 5b 22 20 74 61 72 67 65 74 73 74 int "[" targetst
8840: 72 20 22 5d 22 29 29 29 29 0a 09 09 09 20 28 69 r "]")))).... (i
8850: 66 20 28 6e 6f 74 20 64 6d 6f 64 65 29 28 70 72 f (not dmode)(pr
8860: 69 6e 74 20 74 61 72 67 65 74 73 74 72 29 29 29 int targetstr)))
8870: 29 0a 09 09 20 20 20 28 6c 65 74 2a 20 28 28 72 )... (let* ((r
8880: 75 6e 2d 69 64 20 20 28 64 62 3a 67 65 74 2d 76 un-id (db:get-v
8890: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
88a0: 75 6e 20 68 65 61 64 65 72 20 22 69 64 22 29 29 un header "id"))
88b0: 0a 09 09 09 20 20 28 72 75 6e 6e 61 6d 65 20 28 .... (runname (
88c0: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
88d0: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
88e0: 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 20 0a 09 r "runname")) ..
88f0: 09 09 20 20 28 74 65 73 74 73 20 20 28 64 62 3a .. (tests (db:
8900: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
8910: 6e 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 n dbstruct run-i
8920: 64 20 74 65 73 74 70 61 74 74 20 27 28 29 20 27 d testpatt '() '
8930: 28 29 20 23 66 20 23 66 20 23 66 20 27 74 65 73 () #f #f #f 'tes
8940: 74 6e 61 6d 65 20 27 61 73 63 20 23 66 29 29 29 tname 'asc #f)))
8950: 0a 09 09 20 20 20 20 20 28 63 61 73 65 20 64 6d ... (case dm
8960: 6f 64 65 0a 09 09 20 20 20 20 20 20 20 28 28 6a ode... ((j
8970: 73 6f 6e 29 0a 09 09 09 28 6d 75 74 69 6c 73 3a son)....(mutils:
8980: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
8990: 74 61 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 ta (db:get-value
89a0: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
89b0: 65 61 64 65 72 20 22 73 74 61 74 75 73 22 29 20 eader "status")
89c0: 20 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 targetstr ru
89d0: 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 73 74 nname "meta" "st
89e0: 61 74 75 73 22 20 20 20 20 20 29 0a 09 09 09 28 atus" )....(
89f0: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
8a00: 73 65 74 21 20 64 61 74 61 20 28 64 62 3a 67 65 set! data (db:ge
8a10: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
8a20: 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 73 74 r run header "st
8a30: 61 74 65 22 29 20 20 20 20 20 20 74 61 72 67 65 ate") targe
8a40: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 tstr runname "me
8a50: 74 61 22 20 22 73 74 61 74 65 22 20 20 20 20 20 ta" "state"
8a60: 20 29 0a 09 09 09 28 6d 75 74 69 6c 73 3a 68 69 )....(mutils:hi
8a70: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
8a80: 20 28 63 6f 6e 63 20 28 64 62 3a 67 65 74 2d 76 (conc (db:get-v
8a90: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
8aa0: 75 6e 20 68 65 61 64 65 72 20 22 69 64 22 29 29 un header "id"))
8ab0: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
8ac0: 61 6d 65 20 22 6d 65 74 61 22 20 22 69 64 22 20 ame "meta" "id"
8ad0: 20 20 20 20 20 20 20 20 29 0a 09 09 09 28 6d 75 )....(mu
8ae0: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
8af0: 74 21 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d t! data (db:get-
8b00: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
8b10: 72 75 6e 20 68 65 61 64 65 72 20 22 65 76 65 6e run header "even
8b20: 74 5f 74 69 6d 65 22 29 20 74 61 72 67 65 74 73 t_time") targets
8b30: 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 tr runname "meta
8b40: 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 29 " "event_time" )
8b50: 29 0a 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 )... (else
8b60: 0a 09 09 09 28 70 72 69 6e 74 20 22 52 75 6e 3a ....(print "Run:
8b70: 20 22 20 74 61 72 67 65 74 73 74 72 20 22 2f 22 " targetstr "/"
8b80: 20 72 75 6e 6e 61 6d 65 20 0a 09 09 09 20 20 20 runname ....
8b90: 20 20 20 20 22 20 73 74 61 74 75 73 3a 20 22 20 " status: "
8ba0: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
8bb0: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
8bc0: 65 72 20 22 73 74 61 74 65 22 29 0a 09 09 09 20 er "state")....
8bd0: 20 20 20 20 20 20 22 20 72 75 6e 2d 69 64 3a 20 " run-id:
8be0: 22 20 72 75 6e 2d 69 64 20 22 2c 20 6e 75 6d 62 " run-id ", numb
8bf0: 65 72 20 74 65 73 74 73 3a 20 22 20 28 6c 65 6e er tests: " (len
8c00: 67 74 68 20 74 65 73 74 73 29 29 29 29 0a 09 09 gth tests))))...
8c10: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
8c20: 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
8c30: 28 74 65 73 74 29 0a 09 09 20 20 20 20 20 20 09 (test)... .
8c40: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
8c50: 6e 73 0a 09 09 09 20 65 78 6e 0a 09 09 09 20 28 ns.... exn.... (
8c60: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
8c70: 52 52 4f 52 3a 20 42 61 64 20 64 61 74 61 20 69 RROR: Bad data i
8c80: 6e 20 74 65 73 74 20 72 65 63 6f 72 64 3f 20 22 n test record? "
8c90: 20 74 65 73 74 29 0a 09 09 09 20 28 6c 65 74 20 test).... (let
8ca0: 28 28 74 65 73 74 2d 69 64 20 20 20 20 28 64 62 ((test-id (db
8cb0: 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 :test-get-id tes
8cc0: 74 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 66 t)).... (f
8cd0: 75 6c 6c 6e 61 6d 65 20 20 20 28 63 6f 6e 63 20 ullname (conc
8ce0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 (db:test-get-tes
8cf0: 74 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 09 09 tname test).....
8d00: 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 .. (if (equal? (
8d10: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d db:test-get-item
8d20: 2d 70 61 74 68 20 74 65 73 74 29 20 22 22 29 0a -path test) "").
8d30: 09 09 09 09 09 09 20 20 20 20 20 22 22 20 0a 09 ...... "" ..
8d40: 09 09 09 09 09 20 20 20 20 20 28 63 6f 6e 63 20 ..... (conc
8d50: 22 28 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 "(" (db:test-get
8d60: 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 -item-path test)
8d70: 20 22 29 22 29 29 29 29 0a 09 09 09 20 20 20 20 ")"))))....
8d80: 20 20 20 28 74 73 74 61 74 65 20 20 20 20 20 28 (tstate (
8d90: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
8da0: 65 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 20 e test))....
8db0: 20 20 20 28 74 73 74 61 74 75 73 20 20 20 20 28 (tstatus (
8dc0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
8dd0: 75 73 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 us test))....
8de0: 20 20 20 20 28 65 76 65 6e 74 2d 74 69 6d 65 20 (event-time
8df0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 (db:test-get-eve
8e00: 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 29 29 0a nt_time test))).
8e10: 09 09 09 20 20 20 28 63 61 73 65 20 64 6d 6f 64 ... (case dmod
8e20: 65 0a 09 09 09 20 20 20 20 20 28 28 6a 73 6f 6e e.... ((json
8e30: 29 0a 09 09 09 20 20 20 20 20 20 28 6d 75 74 69 ).... (muti
8e40: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
8e50: 20 64 61 74 61 20 20 66 75 6c 6c 6e 61 6d 65 20 data fullname
8e60: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
8e70: 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 ame "data" (conc
8e80: 20 74 65 73 74 2d 69 64 29 20 22 74 6e 61 6d 65 test-id) "tname
8e90: 22 20 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 " )....
8ea0: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
8eb0: 68 2d 73 65 74 21 20 64 61 74 61 20 20 74 73 74 h-set! data tst
8ec0: 61 74 65 20 20 20 20 20 74 61 72 67 65 74 73 74 ate targetst
8ed0: 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 r runname "data"
8ee0: 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 (conc test-id)
8ef0: 22 73 74 61 74 65 22 20 20 20 20 20 29 0a 09 09 "state" )...
8f00: 09 20 20 20 20 20 20 28 6d 75 74 69 6c 73 3a 68 . (mutils:h
8f10: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
8f20: 61 20 20 74 73 74 61 74 75 73 20 20 20 20 74 61 a tstatus ta
8f30: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
8f40: 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 "data" (conc tes
8f50: 74 2d 69 64 29 20 22 73 74 61 74 75 73 22 20 20 t-id) "status"
8f60: 20 20 29 0a 09 09 09 20 20 20 20 20 20 28 6d 75 ).... (mu
8f70: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
8f80: 74 21 20 64 61 74 61 20 20 65 76 65 6e 74 2d 74 t! data event-t
8f90: 69 6d 65 20 74 61 72 67 65 74 73 74 72 20 72 75 ime targetstr ru
8fa0: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
8fb0: 6e 63 20 74 65 73 74 2d 69 73 29 20 22 65 76 65 nc test-is) "eve
8fc0: 6e 74 5f 74 69 6d 65 22 29 29 0a 09 09 09 20 20 nt_time"))....
8fd0: 20 20 20 28 65 6c 73 65 0a 09 09 09 20 20 20 20 (else....
8fe0: 20 20 28 66 6f 72 6d 61 74 20 23 74 0a 09 09 09 (format #t....
8ff0: 09 20 20 20 20 20 20 22 20 20 54 65 73 74 3a 20 . " Test:
9000: 7e 32 35 61 20 53 74 61 74 65 3a 20 7e 31 35 61 ~25a State: ~15a
9010: 20 53 74 61 74 75 73 3a 20 7e 31 35 61 20 52 75 Status: ~15a Ru
9020: 6e 74 69 6d 65 3a 20 7e 35 40 61 73 20 54 69 6d ntime: ~5@as Tim
9030: 65 3a 20 7e 32 32 61 20 48 6f 73 74 3a 20 7e 31 e: ~22a Host: ~1
9040: 30 61 5c 6e 22 0a 09 09 09 09 20 20 20 20 20 20 0a\n".....
9050: 66 75 6c 6c 6e 61 6d 65 0a 09 09 09 09 20 20 20 fullname.....
9060: 20 20 20 74 73 74 61 74 65 0a 09 09 09 09 20 20 tstate.....
9070: 20 20 20 20 74 73 74 61 74 75 73 0a 09 09 09 09 tstatus.....
9080: 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 (db:test-g
9090: 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 et-run_duration
90a0: 74 65 73 74 29 0a 09 09 09 09 20 20 20 20 20 20 test).....
90b0: 65 76 65 6e 74 2d 74 69 6d 65 0a 09 09 09 09 20 event-time.....
90c0: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 (db:test-ge
90d0: 74 2d 68 6f 73 74 20 74 65 73 74 29 29 0a 09 09 t-host test))...
90e0: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
90f0: 28 6f 72 20 28 65 71 75 61 6c 3f 20 28 64 62 3a (or (equal? (db:
9100: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 test-get-status
9110: 74 65 73 74 29 20 22 50 41 53 53 22 29 0a 09 09 test) "PASS")...
9120: 09 09 09 20 20 20 28 65 71 75 61 6c 3f 20 28 64 ... (equal? (d
9130: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 b:test-get-statu
9140: 73 20 74 65 73 74 29 20 22 57 41 52 4e 22 29 0a s test) "WARN").
9150: 09 09 09 09 09 20 20 20 28 65 71 75 61 6c 3f 20 ..... (equal?
9160: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
9170: 74 65 20 74 65 73 74 29 20 20 22 4e 4f 54 5f 53 te test) "NOT_S
9180: 54 41 52 54 45 44 22 29 29 29 0a 09 09 09 09 20 TARTED"))).....
9190: 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 20 20 (begin.....
91a0: 28 70 72 69 6e 74 20 20 20 22 20 20 20 20 20 20 (print "
91b0: 20 20 20 63 70 75 6c 6f 61 64 3a 20 20 22 20 28 cpuload: " (
91c0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 70 75 6c db:test-get-cpul
91d0: 6f 61 64 20 74 65 73 74 29 0a 09 09 09 09 09 20 oad test)......
91e0: 20 20 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 "\n
91f0: 64 69 73 6b 66 72 65 65 3a 20 22 20 28 64 62 3a diskfree: " (db:
9200: 74 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 test-get-diskfre
9210: 65 20 74 65 73 74 29 0a 09 09 09 09 09 20 20 20 e test)......
9220: 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 75 6e "\n un
9230: 61 6d 65 3a 20 20 20 20 22 20 28 64 62 3a 74 65 ame: " (db:te
9240: 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 74 65 73 st-get-uname tes
9250: 74 29 0a 09 09 09 09 09 20 20 20 20 20 22 5c 6e t)...... "\n
9260: 20 20 20 20 20 20 20 20 20 72 75 6e 64 69 72 3a rundir:
9270: 20 20 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 " (db:test-ge
9280: 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 0a 09 t-rundir test)..
9290: 09 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 .... "\n
92a0: 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 20 22 rundir: "
92b0: 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 67 65 ;; (sdb:qry 'ge
92c0: 74 73 74 72 20 3b 3b 20 28 66 69 6c 65 64 62 3a tstr ;; (filedb:
92d0: 67 65 74 2d 70 61 74 68 20 2a 66 64 62 2a 20 0a get-path *fdb* .
92e0: 09 09 09 09 09 20 20 20 20 20 28 64 62 3a 74 65 ..... (db:te
92f0: 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 st-get-rundir te
9300: 73 74 29 20 3b 3b 20 29 0a 09 09 09 09 09 20 20 st) ;; )......
9310: 20 20 20 29 0a 09 09 09 09 20 20 20 20 3b 3b 20 )..... ;;
9320: 45 61 63 68 20 74 65 73 74 0a 09 09 09 09 20 20 Each test.....
9330: 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 65 6d 6f ;; DO NOT remo
9340: 74 65 20 72 75 6e 0a 09 09 09 09 20 20 20 20 28 te run..... (
9350: 6c 65 74 20 28 28 73 74 65 70 73 20 28 64 62 3a let ((steps (db:
9360: 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 get-steps-for-te
9370: 73 74 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d st dbstruct run-
9380: 69 64 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d id (db:test-get-
9390: 69 64 20 74 65 73 74 29 29 29 29 0a 09 09 09 09 id test)))).....
93a0: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
93b0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d ..... (lam
93c0: 62 64 61 20 28 73 74 65 70 29 0a 09 09 09 09 09 bda (step)......
93d0: 20 28 66 6f 72 6d 61 74 20 23 74 20 0a 09 09 09 (format #t ....
93e0: 09 09 09 20 22 20 20 20 20 53 74 65 70 3a 20 7e ... " Step: ~
93f0: 32 30 61 20 53 74 61 74 65 3a 20 7e 31 30 61 20 20a State: ~10a
9400: 53 74 61 74 75 73 3a 20 7e 31 30 61 20 54 69 6d Status: ~10a Tim
9410: 65 20 7e 32 32 61 5c 6e 22 0a 09 09 09 09 09 09 e ~22a\n".......
9420: 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 (tdb:step-get-s
9430: 74 65 70 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 tepname step)...
9440: 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 2d 67 .... (tdb:step-g
9450: 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 et-state step)..
9460: 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 2d ..... (tdb:step-
9470: 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 70 29 get-status step)
9480: 0a 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 ....... (tdb:ste
9490: 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 p-get-event_time
94a0: 20 73 74 65 70 29 29 29 0a 09 09 09 09 20 20 20 step))).....
94b0: 20 20 20 20 73 74 65 70 73 29 29 29 29 29 29 29 steps)))))))
94c0: 29 29 0a 09 09 20 20 20 20 20 20 74 65 73 74 73 ))... tests
94d0: 29 29 29 29 29 0a 09 20 20 20 72 75 6e 73 29 0a ))))).. runs).
94e0: 09 20 20 28 69 66 20 28 65 71 3f 20 64 6d 6f 64 . (if (eq? dmod
94f0: 65 20 27 6a 73 6f 6e 29 28 6a 73 6f 6e 2d 77 72 e 'json)(json-wr
9500: 69 74 65 20 64 61 74 61 29 29 0a 09 20 20 28 73 ite data)).. (s
9510: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
9520: 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d g* #t))))..;;===
9530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9570: 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e 0a ===.;; full run.
9580: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
9590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
95a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
95b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
95c0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 ========..;; get
95d0: 20 6c 6f 63 6b 20 69 6e 20 64 62 20 66 6f 72 20 lock in db for
95e0: 66 75 6c 6c 20 72 75 6e 20 66 6f 72 20 74 68 69 full run for thi
95f0: 73 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 66 s directory.;; f
9600: 6f 72 20 61 6c 6c 20 74 65 73 74 73 20 77 69 74 or all tests wit
9610: 68 20 64 65 70 73 0a 3b 3b 20 20 20 77 61 6c 6b h deps.;; walk
9620: 20 74 72 65 65 20 6f 66 20 74 65 73 74 73 20 74 tree of tests t
9630: 6f 20 66 69 6e 64 20 68 65 61 64 20 74 61 73 6b o find head task
9640: 73 0a 3b 3b 20 20 20 61 64 64 20 68 65 61 64 20 s.;; add head
9650: 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 tasks to task qu
9660: 65 75 65 0a 3b 3b 20 20 20 61 64 64 20 64 65 70 eue.;; add dep
9670: 65 6e 64 61 6e 74 20 74 61 73 6b 73 20 74 6f 20 endant tasks to
9680: 74 61 73 6b 20 71 75 65 75 65 20 0a 3b 3b 20 20 task queue .;;
9690: 20 61 64 64 20 72 65 6d 61 69 6e 69 6e 67 20 74 add remaining t
96a0: 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 asks to task que
96b0: 75 65 0a 3b 3b 20 66 6f 72 20 65 61 63 68 20 74 ue.;; for each t
96c0: 61 73 6b 20 69 6e 20 74 61 73 6b 20 71 75 65 75 ask in task queu
96d0: 65 0a 3b 3b 20 20 20 69 66 20 68 61 76 65 20 61 e.;; if have a
96e0: 64 65 71 75 61 74 65 20 72 65 73 6f 75 72 63 65 dequate resource
96f0: 73 0a 3b 3b 20 20 20 20 20 6c 61 75 6e 63 68 20 s.;; launch
9700: 74 61 73 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b task.;; else.;
9710: 3b 20 20 20 20 20 70 75 74 20 74 61 73 6b 20 69 ; put task i
9720: 6e 20 64 65 66 65 72 72 65 64 20 71 75 65 75 65 n deferred queue
9730: 0a 3b 3b 20 69 66 20 73 74 69 6c 6c 20 6f 6b 20 .;; if still ok
9740: 74 6f 20 72 75 6e 20 74 61 73 6b 73 0a 3b 3b 20 to run tasks.;;
9750: 20 20 70 72 6f 63 65 73 73 20 64 65 66 65 72 72 process deferr
9760: 65 64 20 74 61 73 6b 73 20 70 65 72 20 61 62 6f ed tasks per abo
9770: 76 65 20 73 74 65 70 73 0a 0a 3b 3b 20 72 75 6e ve steps..;; run
9780: 20 61 6c 6c 20 74 65 73 74 73 20 61 72 65 20 61 all tests are a
9790: 72 65 20 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 44 re Not COMPLETED
97a0: 20 61 6e 64 20 50 41 53 53 20 6f 72 20 43 48 45 and PASS or CHE
97b0: 43 4b 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 CK.(if (args:get
97c0: 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 0a -arg "-runall").
97d0: 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e (general-run
97e0: 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 75 -call . "-ru
97f0: 6e 61 6c 6c 22 0a 20 20 20 20 20 22 72 75 6e 20 nall". "run
9800: 61 6c 6c 20 74 65 73 74 73 22 0a 20 20 20 20 20 all tests".
9810: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
9820: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
9830: 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 72 75 vals). (ru
9840: 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 72 ns:run-tests tar
9850: 67 65 74 0a 09 09 20 20 20 20 20 20 20 72 75 6e get... run
9860: 6e 61 6d 65 0a 09 09 20 20 20 20 20 20 20 28 61 name... (a
9870: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
9880: 73 74 70 61 74 74 22 29 0a 09 09 20 20 20 20 20 stpatt")...
9890: 20 20 75 73 65 72 0a 09 09 20 20 20 20 20 20 20 user...
98a0: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 0a 09 09 args:arg-hash...
98b0: 20 20 20 20 20 20 20 2a 61 72 65 61 2d 64 61 74 *area-dat
98c0: 2a 29 29 0a 20 20 20 20 20 2a 61 72 65 61 2d 64 *)). *area-d
98d0: 61 74 2a 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d at*))..;;=======
98e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
98f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
9920: 3b 3b 20 72 75 6e 20 6f 6e 65 20 74 65 73 74 0a ;; run one test.
9930: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
9940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9970: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e 20 ========..;; 1.
9980: 66 69 6e 64 20 74 68 65 20 63 6f 6e 66 69 67 20 find the config
9990: 66 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 61 6e 67 file.;; 2. chang
99a0: 65 20 74 6f 20 74 68 65 20 74 65 73 74 20 64 69 e to the test di
99b0: 72 65 63 74 6f 72 79 0a 3b 3b 20 33 2e 20 75 70 rectory.;; 3. up
99c0: 64 61 74 65 20 74 68 65 20 64 62 20 77 69 74 68 date the db with
99d0: 20 22 74 65 73 74 20 73 74 61 72 74 65 64 22 20 "test started"
99e0: 73 74 61 74 75 73 2c 20 73 65 74 20 72 75 6e 6e status, set runn
99f0: 69 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 2e 20 70 ing host.;; 4. p
9a00: 72 6f 63 65 73 73 20 6c 61 75 6e 63 68 20 74 68 rocess launch th
9a10: 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 6d e test.;; - m
9a20: 6f 6e 69 74 6f 72 20 74 68 65 20 70 72 6f 63 65 onitor the proce
9a30: 73 73 2c 20 75 70 64 61 74 65 20 73 74 61 74 73 ss, update stats
9a40: 20 69 6e 20 74 68 65 20 64 62 20 65 76 65 72 79 in the db every
9a50: 20 32 5e 6e 20 6d 69 6e 75 74 65 73 0a 3b 3b 20 2^n minutes.;;
9a60: 35 2e 20 61 73 20 74 68 65 20 74 65 73 74 20 70 5. as the test p
9a70: 72 6f 63 65 65 64 73 20 69 6e 74 65 72 6e 61 6c roceeds internal
9a80: 6c 79 20 69 74 20 63 61 6c 6c 73 20 6d 65 67 61 ly it calls mega
9a90: 74 65 73 74 20 61 73 20 65 61 63 68 20 73 74 65 test as each ste
9aa0: 70 20 69 73 0a 3b 3b 20 20 20 20 73 74 61 72 74 p is.;; start
9ab0: 65 64 20 61 6e 64 20 63 6f 6d 70 6c 65 74 65 64 ed and completed
9ac0: 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 73 74 .;; - step st
9ad0: 61 72 74 65 64 2c 20 74 69 6d 65 73 74 61 6d 70 arted, timestamp
9ae0: 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 63 6f .;; - step co
9af0: 6d 70 6c 65 74 65 64 2c 20 65 78 69 74 20 73 74 mpleted, exit st
9b00: 61 74 75 73 2c 20 74 69 6d 65 73 74 61 6d 70 0a atus, timestamp.
9b10: 3b 3b 20 36 2e 20 74 65 73 74 20 70 68 6f 6e 65 ;; 6. test phone
9b20: 20 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d 20 69 66 home.;; - if
9b30: 20 74 65 73 74 20 72 75 6e 20 74 69 6d 65 20 3e test run time >
9b40: 20 61 6c 6c 6f 77 65 64 20 72 75 6e 20 74 69 6d allowed run tim
9b50: 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a e then kill job.
9b60: 3b 3b 20 20 20 20 2d 20 69 66 20 63 61 6e 6e 6f ;; - if canno
9b70: 74 20 61 63 63 65 73 73 20 64 62 20 3e 20 61 6c t access db > al
9b80: 6c 6f 77 65 64 20 64 69 73 63 6f 6e 6e 65 63 74 lowed disconnect
9b90: 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 time then kill
9ba0: 6a 6f 62 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 job..(if (args:g
9bb0: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
9bc0: 73 22 29 0a 20 20 28 67 65 6e 65 72 61 6c 2d 72 s"). (general-r
9bd0: 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 22 2d 72 75 un-call . "-ru
9be0: 6e 74 65 73 74 73 22 20 0a 20 20 20 22 72 75 6e ntests" . "run
9bf0: 20 61 20 74 65 73 74 22 20 0a 20 20 20 28 6c 61 a test" . (la
9c00: 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
9c10: 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c name keys keyval
9c20: 73 29 0a 20 20 20 20 20 3b 3b 0a 20 20 20 20 20 s). ;;.
9c30: 3b 3b 20 4d 61 79 20 6f 72 20 6d 61 79 20 6e 6f ;; May or may no
9c40: 74 20 69 6d 70 6c 65 6d 65 6e 74 20 69 74 20 74 t implement it t
9c50: 68 69 73 20 77 61 79 20 2e 2e 2e 0a 20 20 20 20 his way ....
9c60: 20 3b 3b 0a 20 20 20 20 20 3b 3b 20 49 6e 73 65 ;;. ;; Inse
9c70: 72 74 20 74 68 69 73 20 72 75 6e 20 69 6e 74 6f rt this run into
9c80: 20 74 68 65 20 74 61 73 6b 73 20 71 75 65 75 65 the tasks queue
9c90: 0a 20 20 20 20 20 3b 3b 20 28 6f 70 65 6e 2d 72 . ;; (open-r
9ca0: 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 61 un-close tasks:a
9cb0: 64 64 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 dd tasks:open-db
9cc0: 20 0a 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 . ;; .
9cd0: 20 20 20 22 72 75 6e 74 65 73 74 73 22 20 0a 20 "runtests" .
9ce0: 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 ;; .
9cf0: 75 73 65 72 0a 20 20 20 20 20 3b 3b 20 20 20 20 user. ;;
9d00: 09 20 20 20 20 20 74 61 72 67 65 74 0a 20 20 20 . target.
9d10: 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 72 75 ;; . ru
9d20: 6e 6e 61 6d 65 0a 20 20 20 20 20 3b 3b 20 20 20 nname. ;;
9d30: 20 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 . (args:get
9d40: 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 -arg "-runtests"
9d50: 29 0a 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 ). ;; .
9d60: 20 20 20 23 66 29 29 29 29 0a 20 20 20 20 20 28 #f)))). (
9d70: 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 runs:run-tests t
9d80: 61 72 67 65 74 0a 09 09 20 20 20 20 20 72 75 6e arget... run
9d90: 6e 61 6d 65 0a 09 09 20 20 20 20 20 28 61 72 67 name... (arg
9da0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 s:get-arg "-runt
9db0: 65 73 74 73 22 29 0a 09 09 20 20 20 20 20 75 73 ests")... us
9dc0: 65 72 0a 09 09 20 20 20 20 20 61 72 67 73 3a 61 er... args:a
9dd0: 72 67 2d 68 61 73 68 0a 09 09 20 20 20 20 20 2a rg-hash... *
9de0: 61 72 65 61 2d 64 61 74 2a 29 29 0a 20 20 20 2a area-dat*)). *
9df0: 61 72 65 61 2d 64 61 74 2a 29 29 0a 0a 3b 3b 3d area-dat*))..;;=
9e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e40: 3d 3d 3d 3d 3d 0a 3b 3b 20 52 6f 6c 6c 75 70 20 =====.;; Rollup
9e50: 69 6e 74 6f 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d into a run.;;===
9e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ea0: 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
9eb0: 65 74 2d 61 72 67 20 22 2d 72 6f 6c 6c 75 70 22 et-arg "-rollup"
9ec0: 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 ). (general-r
9ed0: 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d un-call . "-
9ee0: 72 6f 6c 6c 75 70 22 20 0a 20 20 20 20 20 22 72 rollup" . "r
9ef0: 6f 6c 6c 75 70 20 74 65 73 74 73 22 20 0a 20 20 ollup tests" .
9f00: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
9f10: 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
9f20: 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 keyvals).
9f30: 28 72 75 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e (runs:rollup-run
9f40: 20 6b 65 79 73 0a 09 09 09 6b 65 79 76 61 6c 73 keys....keyvals
9f50: 0a 09 09 09 28 6f 72 20 28 61 72 67 73 3a 67 65 ....(or (args:ge
9f60: 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
9f70: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
9f80: 3a 72 75 6e 6e 61 6d 65 22 29 20 29 0a 09 09 09 :runname") )....
9f90: 75 73 65 72 29 29 0a 20 20 20 20 20 2a 61 72 65 user)). *are
9fa0: 61 2d 64 61 74 2a 29 29 0a 0a 3b 3b 3d 3d 3d 3d a-dat*))..;;====
9fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ff0: 3d 3d 0a 3b 3b 20 4c 6f 63 6b 20 6f 72 20 75 6e ==.;; Lock or un
a000: 6c 6f 63 6b 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d lock a run.;;===
a010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a050: 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 ===..(if (or (ar
a060: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 gs:get-arg "-loc
a070: 6b 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 k")(args:get-arg
a080: 20 22 2d 75 6e 6c 6f 63 6b 22 29 29 0a 20 20 20 "-unlock")).
a090: 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 (general-run-ca
a0a0: 6c 6c 20 0a 20 20 20 20 20 28 69 66 20 28 61 72 ll . (if (ar
a0b0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 gs:get-arg "-loc
a0c0: 6b 22 29 20 22 2d 6c 6f 63 6b 22 20 22 2d 75 6e k") "-lock" "-un
a0d0: 6c 6f 63 6b 22 29 0a 20 20 20 20 20 22 6c 6f 63 lock"). "loc
a0e0: 6b 2f 75 6e 6c 6f 63 6b 20 74 65 73 74 73 22 20 k/unlock tests"
a0f0: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 . (lambda (t
a100: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
a110: 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 ys keyvals).
a120: 20 20 20 28 72 75 6e 73 3a 68 61 6e 64 6c 65 2d (runs:handle-
a130: 6c 6f 63 6b 69 6e 67 20 0a 09 09 20 20 74 61 72 locking ... tar
a140: 67 65 74 0a 09 09 20 20 6b 65 79 73 0a 09 09 20 get... keys...
a150: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
a160: 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 rg "-runname")(a
a170: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 rgs:get-arg ":ru
a180: 6e 6e 61 6d 65 22 29 20 29 0a 09 09 20 20 28 61 nname") )... (a
a190: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
a1a0: 63 6b 22 29 0a 09 09 20 20 28 61 72 67 73 3a 67 ck")... (args:g
a1b0: 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b 22 et-arg "-unlock"
a1c0: 29 0a 09 09 20 20 75 73 65 72 29 29 0a 20 20 20 )... user)).
a1d0: 20 20 2a 61 72 65 61 2d 64 61 74 2a 29 29 0a 0a *area-dat*))..
a1e0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
a1f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a220: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 65 74 20 ========.;; Get
a230: 70 61 74 68 73 20 74 6f 20 74 65 73 74 73 0a 3b paths to tests.;
a240: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
a250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a280: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 65 74 20 74 =======.;; Get t
a290: 65 73 74 20 70 61 74 68 73 20 6d 61 74 63 68 69 est paths matchi
a2a0: 6e 67 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 ng target, runna
a2b0: 6d 65 2c 20 61 6e 64 20 74 65 73 74 70 61 74 74 me, and testpatt
a2c0: 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 .(if (or (args:g
a2d0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 et-arg "-test-fi
a2e0: 6c 65 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 les")(args:get-a
a2f0: 72 67 20 22 2d 74 65 73 74 2d 70 61 74 68 73 22 rg "-test-paths"
a300: 29 29 0a 20 20 20 20 3b 3b 20 69 66 20 77 65 20 )). ;; if we
a310: 61 72 65 20 69 6e 20 61 20 74 65 73 74 20 75 73 are in a test us
a320: 65 20 74 68 65 20 4d 54 5f 43 4d 44 49 4e 46 4f e the MT_CMDINFO
a330: 20 64 61 74 61 0a 20 20 20 20 28 69 66 20 28 67 data. (if (g
a340: 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
a350: 4f 22 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 O")..(let* ((sta
a360: 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 65 6e rtingdir (curren
a370: 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 20 t-directory))..
a380: 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 (cmdinfo
a390: 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e (common:read-en
a3a0: 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 67 65 coded-string (ge
a3b0: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
a3c0: 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 72 "))).. (tr
a3d0: 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f 64 ansport (assoc/d
a3e0: 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f 72 efault 'transpor
a3f0: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
a400: 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 (testpath (
a410: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
a420: 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
a430: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
a440: 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 -name (assoc/def
a450: 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 ault 'test-name
a460: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
a470: 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 (runscript (as
a480: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
a490: 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 script cmdinfo))
a4a0: 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 .. (db-hos
a4b0: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
a4c0: 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d lt 'db-host cm
a4d0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
a4e0: 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f (run-id (asso
a4f0: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 c/default 'run-i
a500: 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 d cmdinfo))..
a510: 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 (itemdat
a520: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
a530: 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 'itemdat cmdi
a540: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 73 nfo)).. (s
a550: 74 61 74 65 20 20 20 20 20 28 61 72 67 73 3a 67 tate (args:g
a560: 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 et-arg ":state")
a570: 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 75 ).. (statu
a580: 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 s (args:get-a
a590: 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a 09 rg ":status"))..
a5a0: 20 20 20 20 20 20 20 28 74 61 72 67 65 74 20 20 (target
a5b0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
a5c0: 22 2d 74 61 72 67 65 74 22 29 29 0a 09 20 20 20 "-target"))..
a5d0: 20 20 20 20 28 74 6f 70 70 61 74 68 20 20 20 28 (toppath (
a5e0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
a5f0: 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 66 6f oppath cmdinfo
a600: 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 ))).. (change-d
a610: 69 72 65 63 74 6f 72 79 20 74 6f 70 70 61 74 68 irectory toppath
a620: 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 74 61 ).. (if (not ta
a630: 72 67 65 74 29 0a 09 20 20 20 20 20 20 28 62 65 rget).. (be
a640: 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 gin...(debug:pri
a650: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 2d 74 61 nt 0 "ERROR: -ta
a660: 72 67 65 74 20 69 73 20 72 65 71 75 69 72 65 64 rget is required
a670: 2e 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 .")...(exit 1)))
a680: 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 .. (if (not (la
a690: 75 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d 72 unch:setup-for-r
a6a0: 75 6e 20 2a 61 72 65 61 2d 64 61 74 2a 29 29 0a un *area-dat*)).
a6b0: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
a6c0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
a6d0: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
a6e0: 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 2d 74 giving up on -t
a6f0: 65 73 74 2d 70 61 74 68 73 20 6f 72 20 2d 74 65 est-paths or -te
a700: 73 74 2d 66 69 6c 65 73 2c 20 65 78 69 74 69 6e st-files, exitin
a710: 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 g")...(exit 1)))
a720: 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 .. (let* ((keys
a730: 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 (rmt:get-ke
a740: 79 73 29 29 0a 09 09 20 3b 3b 20 64 62 3a 74 65 ys))... ;; db:te
a750: 73 74 2d 67 65 74 2d 70 61 74 68 73 20 6d 75 73 st-get-paths mus
a760: 74 20 6e 6f 74 20 62 65 20 72 75 6e 20 72 65 6d t not be run rem
a770: 6f 74 65 0a 09 09 20 28 70 61 74 68 73 20 20 20 ote... (paths
a780: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 67 65 74 (tests:test-get
a790: 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 -paths-matching
a7a0: 6b 65 79 73 20 74 61 72 67 65 74 20 28 61 72 67 keys target (arg
a7b0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
a7c0: 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 20 20 -files"))))..
a7d0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
a7e0: 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 28 hing* #t).. (
a7f0: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
a800: 20 28 70 61 74 68 29 0a 09 09 09 28 70 72 69 6e (path)....(prin
a810: 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 t path))...
a820: 20 70 61 74 68 73 29 29 29 0a 09 3b 3b 20 65 6c paths)))..;; el
a830: 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 6c 2d se do a general-
a840: 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 72 run-call..(gener
a850: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 22 al-run-call .. "
a860: 2d 74 65 73 74 2d 66 69 6c 65 73 22 0a 09 20 22 -test-files".. "
a870: 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 Get paths to tes
a880: 74 22 0a 09 20 28 6c 61 6d 62 64 61 20 28 74 61 t".. (lambda (ta
a890: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
a8a0: 73 20 6b 65 79 76 61 6c 73 29 0a 09 20 20 20 28 s keyvals).. (
a8b0: 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 let* ((db
a8c0: 23 66 29 0a 09 09 20 20 3b 3b 20 44 4f 20 4e 4f #f)... ;; DO NO
a8d0: 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 T run remote...
a8e0: 20 28 70 61 74 68 73 20 20 20 20 28 74 65 73 74 (paths (test
a8f0: 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 s:test-get-paths
a900: 2d 6d 61 74 63 68 69 6e 67 20 6b 65 79 73 20 74 -matching keys t
a910: 61 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d arget (args:get-
a920: 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 arg "-test-files
a930: 22 29 29 29 29 0a 09 20 20 20 20 20 28 66 6f 72 ")))).. (for
a940: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 -each (lambda (p
a950: 61 74 68 29 0a 09 09 09 20 28 70 72 69 6e 74 20 ath).... (print
a960: 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 20 path))...
a970: 70 61 74 68 73 29 29 29 0a 09 2a 61 72 65 61 2d paths)))..*area-
a980: 64 61 74 2a 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d dat*)))..;;=====
a990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a9a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a9b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a9c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a9d0: 3d 0a 3b 3b 20 41 72 63 68 69 76 65 20 74 65 73 =.;; Archive tes
a9e0: 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ts.;;===========
a9f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aa00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aa10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aa20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 ===========.;; A
aa30: 72 63 68 69 76 65 20 74 65 73 74 73 20 6d 61 74 rchive tests mat
aa40: 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 75 ching target, ru
aa50: 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 65 73 74 70 nname, and testp
aa60: 61 74 74 0a 28 69 66 20 28 61 72 67 73 3a 67 65 att.(if (args:ge
aa70: 74 2d 61 72 67 20 22 2d 61 72 63 68 69 76 65 22 t-arg "-archive"
aa80: 29 0a 20 20 20 20 3b 3b 20 65 6c 73 65 20 64 6f ). ;; else do
aa90: 20 61 20 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 a general-run-c
aaa0: 61 6c 6c 0a 20 20 20 20 28 67 65 6e 65 72 61 6c all. (general
aab0: 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 -run-call .
aac0: 22 2d 61 72 63 68 69 76 65 22 0a 20 20 20 20 20 "-archive".
aad0: 22 41 72 63 68 69 76 65 22 0a 20 20 20 20 20 28 "Archive". (
aae0: 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 lambda (target r
aaf0: 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 unname keys keyv
ab00: 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6f 70 65 als). (ope
ab10: 72 61 74 65 2d 6f 6e 20 27 61 72 63 68 69 76 65 rate-on 'archive
ab20: 29 29 0a 20 20 20 20 20 2a 61 72 65 61 2d 64 61 )). *area-da
ab30: 74 2a 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t*))..;;========
ab40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
ab80: 3b 20 45 78 74 72 61 63 74 20 61 20 73 70 72 65 ; Extract a spre
ab90: 61 64 73 68 65 65 74 20 66 72 6f 6d 20 74 68 65 adsheet from the
aba0: 20 72 75 6e 73 20 64 61 74 61 62 61 73 65 0a 3b runs database.;
abb0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
abc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
abd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
abe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
abf0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
ac00: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 74 gs:get-arg "-ext
ac10: 72 61 63 74 2d 6f 64 73 22 29 0a 20 20 20 20 28 ract-ods"). (
ac20: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
ac30: 0a 20 20 20 20 20 22 2d 65 78 74 72 61 63 74 2d . "-extract-
ac40: 6f 64 73 22 0a 20 20 20 20 20 22 4d 61 6b 65 20 ods". "Make
ac50: 6f 64 73 20 73 70 72 65 61 64 73 68 65 65 74 22 ods spreadsheet"
ac60: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 . (lambda (t
ac70: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
ac80: 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 ys keyvals).
ac90: 20 20 20 28 6c 65 74 20 28 28 64 62 73 74 72 75 (let ((dbstru
aca0: 63 74 20 20 20 28 6d 61 6b 65 2d 64 62 72 3a 64 ct (make-dbr:d
acb0: 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 28 6d bstruct path: (m
acc0: 65 67 61 74 65 73 74 3a 61 72 65 61 2d 70 61 74 egatest:area-pat
acd0: 68 20 2a 61 72 65 61 2d 64 61 74 2a 29 20 6c 6f h *area-dat*) lo
ace0: 63 61 6c 3a 20 23 74 29 29 0a 09 20 20 20 20 20 cal: #t))..
acf0: 28 6f 75 74 70 75 74 66 69 6c 65 20 28 61 72 67 (outputfile (arg
ad00: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 s:get-arg "-extr
ad10: 61 63 74 2d 6f 64 73 22 29 29 0a 09 20 20 20 20 act-ods"))..
ad20: 20 28 72 75 6e 73 70 61 74 74 20 20 20 28 6f 72 (runspatt (or
ad30: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
ad40: 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a -runname")(args:
ad50: 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d get-arg ":runnam
ad60: 65 22 29 29 29 0a 09 20 20 20 20 20 28 70 61 74 e"))).. (pat
ad70: 68 6d 6f 64 20 20 20 20 28 61 72 67 73 3a 67 65 hmod (args:ge
ad80: 74 2d 61 72 67 20 22 2d 70 61 74 68 6d 6f 64 22 t-arg "-pathmod"
ad90: 29 29 29 0a 09 20 20 20 20 20 3b 3b 20 28 6b 65 ))).. ;; (ke
ada0: 79 76 61 6c 61 6c 69 73 74 20 28 6b 65 79 73 2d yvalalist (keys-
adb0: 3e 61 6c 69 73 74 20 6b 65 79 73 20 22 25 22 29 >alist keys "%")
adc0: 29 29 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e )).. (debug:prin
add0: 74 20 32 20 22 45 78 74 72 61 63 74 20 6f 64 73 t 2 "Extract ods
ade0: 2c 20 6f 75 74 70 75 74 66 69 6c 65 3a 20 22 20 , outputfile: "
adf0: 6f 75 74 70 75 74 66 69 6c 65 20 22 20 72 75 6e outputfile " run
ae00: 73 70 61 74 74 3a 20 22 20 72 75 6e 73 70 61 74 spatt: " runspat
ae10: 74 20 22 20 6b 65 79 76 61 6c 73 3a 20 22 20 6b t " keyvals: " k
ae20: 65 79 76 61 6c 73 29 0a 09 20 28 64 62 3a 65 78 eyvals).. (db:ex
ae30: 74 72 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 tract-ods-file d
ae40: 62 73 74 72 75 63 74 20 6f 75 74 70 75 74 66 69 bstruct outputfi
ae50: 6c 65 20 6b 65 79 76 61 6c 73 20 28 69 66 20 72 le keyvals (if r
ae60: 75 6e 73 70 61 74 74 20 72 75 6e 73 70 61 74 74 unspatt runspatt
ae70: 20 22 25 22 29 20 70 61 74 68 6d 6f 64 29 0a 09 "%") pathmod)..
ae80: 20 28 64 62 3a 63 6c 6f 73 65 2d 61 6c 6c 20 64 (db:close-all d
ae90: 62 73 74 72 75 63 74 20 2a 61 72 65 61 2d 64 61 bstruct *area-da
aea0: 74 2a 29 0a 09 20 28 73 65 74 21 20 2a 64 69 64 t*).. (set! *did
aeb0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
aec0: 0a 20 20 20 20 20 2a 61 72 65 61 2d 64 61 74 2a . *area-dat*
aed0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
aee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
af00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
af10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
af20: 65 78 65 63 75 74 65 20 74 68 65 20 74 65 73 74 execute the test
af30: 0a 3b 3b 20 20 20 20 2d 20 67 65 74 73 20 63 61 .;; - gets ca
af40: 6c 6c 65 64 20 6f 6e 20 72 65 6d 6f 74 65 20 68 lled on remote h
af50: 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 72 65 63 65 ost.;; - rece
af60: 69 76 65 73 20 69 6e 66 6f 20 66 72 6f 6d 20 74 ives info from t
af70: 68 65 20 2d 65 78 65 63 75 74 65 20 70 61 72 61 he -execute para
af80: 6d 0a 3b 3b 20 20 20 20 2d 20 70 61 73 73 65 73 m.;; - passes
af90: 20 69 6e 66 6f 20 74 6f 20 73 74 65 70 73 20 76 info to steps v
afa0: 69 61 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e ia MT_CMDINFO en
afb0: 76 20 76 61 72 20 28 66 75 74 75 72 65 20 69 73 v var (future is
afc0: 20 74 6f 20 75 73 65 20 61 20 64 6f 74 20 66 69 to use a dot fi
afd0: 6c 65 29 0a 3b 3b 20 20 20 20 2d 20 67 61 74 68 le).;; - gath
afe0: 65 72 73 20 68 6f 73 74 20 69 6e 66 6f 20 61 6e ers host info an
aff0: 64 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d d .;;===========
b000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
b040: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
b050: 2d 65 78 65 63 75 74 65 22 29 0a 20 20 20 20 28 -execute"). (
b060: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 6c 61 75 begin. (lau
b070: 6e 63 68 3a 65 78 65 63 75 74 65 20 28 61 72 67 nch:execute (arg
b080: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 s:get-arg "-exec
b090: 75 74 65 22 29 29 0a 20 20 20 20 20 20 28 73 65 ute")). (se
b0a0: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
b0b0: 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d * #t)))..;;=====
b0c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b0d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b0e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b0f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b100: 3d 0a 3b 3b 20 54 65 73 74 20 63 6f 6d 6d 61 6e =.;; Test comman
b110: 64 73 20 28 69 2e 65 2e 20 66 6f 72 20 75 73 65 ds (i.e. for use
b120: 20 69 6e 73 69 64 65 20 74 65 73 74 73 29 0a 3b inside tests).;
b130: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
b140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b170: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
b180: 20 28 6d 65 67 61 74 65 73 74 3a 73 74 65 70 20 (megatest:step
b190: 73 74 65 70 20 73 74 61 74 65 20 73 74 61 74 75 step state statu
b1a0: 73 20 6c 6f 67 66 69 6c 65 20 6d 73 67 29 0a 20 s logfile msg).
b1b0: 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 65 6e (if (not (geten
b1c0: 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 v "MT_CMDINFO"))
b1d0: 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 . (begin..(
b1e0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
b1f0: 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f RROR: MT_CMDINFO
b200: 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 env var not set
b210: 2c 20 2d 73 74 65 70 20 6d 75 73 74 20 62 65 20 , -step must be
b220: 63 61 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 called *inside*
b230: 61 20 6d 65 67 61 74 65 73 74 20 69 6e 76 6f 6b a megatest invok
b240: 65 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 ed environment!"
b250: 29 0a 09 28 65 78 69 74 20 35 29 29 0a 20 20 20 )..(exit 5)).
b260: 20 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e (let* ((cmdin
b270: 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 fo (common:rea
b280: 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 d-encoded-string
b290: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
b2a0: 49 4e 46 4f 22 29 29 29 0a 09 20 20 20 20 20 28 INFO"))).. (
b2b0: 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 transport (assoc
b2c0: 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 /default 'transp
b2d0: 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ort cmdinfo))..
b2e0: 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 (testpath (
b2f0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
b300: 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
b310: 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 2d 6e )).. (test-n
b320: 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ame (assoc/defau
b330: 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d lt 'test-name cm
b340: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 dinfo)).. (r
b350: 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f unscript (assoc/
b360: 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 default 'runscri
b370: 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 pt cmdinfo))..
b380: 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 (db-host (a
b390: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 ssoc/default 'db
b3a0: 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 -host cmdinfo)
b3b0: 29 0a 09 20 20 20 20 20 28 72 75 6e 2d 69 64 20 ).. (run-id
b3c0: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
b3d0: 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 t 'run-id cmd
b3e0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 info)).. (te
b3f0: 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 st-id (assoc/d
b400: 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 efault 'test-id
b410: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
b420: 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
b430: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
b440: 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
b450: 0a 09 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 .. (work-are
b460: 61 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 a (assoc/default
b470: 20 27 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 'work-area cmdi
b480: 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 64 62 20 nfo)).. (db
b490: 20 20 20 20 20 20 20 23 66 29 29 0a 09 28 63 68 #f))..(ch
b4a0: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
b4b0: 65 73 74 70 61 74 68 29 0a 09 28 69 66 20 28 6e estpath)..(if (n
b4c0: 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 ot (launch:setup
b4d0: 2d 66 6f 72 2d 72 75 6e 20 2a 61 72 65 61 2d 64 -for-run *area-d
b4e0: 61 74 2a 29 29 0a 09 20 20 20 20 28 62 65 67 69 at*)).. (begi
b4f0: 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a n.. (debug:
b500: 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 print 0 "Failed
b510: 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
b520: 67 22 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 g").. (exit
b530: 20 31 29 29 29 0a 09 28 69 66 20 28 61 6e 64 20 1)))..(if (and
b540: 73 74 61 74 65 20 73 74 61 74 75 73 29 0a 09 20 state status)..
b550: 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 65 70 (rmt:teststep
b560: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
b570: 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 -id test-id step
b580: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 6d 73 state status ms
b590: 67 20 6c 6f 67 66 69 6c 65 29 0a 09 20 20 20 20 g logfile)..
b5a0: 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 (begin.. (d
b5b0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
b5c0: 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 20 73 70 ROR: You must sp
b5d0: 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 ecify :state and
b5e0: 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 65 76 :status with ev
b5f0: 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 73 74 65 ery call to -ste
b600: 70 22 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 p").. (exit
b610: 20 36 29 29 29 29 29 29 0a 0a 28 69 66 20 28 61 6))))))..(if (a
b620: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
b630: 65 70 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ep"). (begin.
b640: 20 20 20 20 20 20 28 6d 65 67 61 74 65 73 74 3a (megatest:
b650: 73 74 65 70 20 0a 20 20 20 20 20 20 20 28 61 72 step . (ar
b660: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 gs:get-arg "-ste
b670: 70 22 29 0a 20 20 20 20 20 20 20 28 6f 72 20 28 p"). (or (
b680: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
b690: 74 61 74 65 22 29 28 61 72 67 73 3a 67 65 74 2d tate")(args:get-
b6a0: 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a 20 arg ":state")).
b6b0: 20 20 20 20 20 20 28 6f 72 20 28 61 72 67 73 3a (or (args:
b6c0: 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 75 73 get-arg "-status
b6d0: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
b6e0: 22 3a 73 74 61 74 75 73 22 29 29 0a 20 20 20 20 ":status")).
b6f0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
b700: 20 22 2d 73 65 74 6c 6f 67 22 29 0a 20 20 20 20 "-setlog").
b710: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
b720: 20 22 2d 6d 22 29 29 0a 20 20 20 20 20 20 3b 3b "-m")). ;;
b730: 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 (if db (sqlite3
b740: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
b750: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
b760: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
b770: 0a 20 20 20 20 0a 28 69 66 20 28 6f 72 20 28 61 . .(if (or (a
b780: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
b790: 74 6c 6f 67 22 29 20 20 20 20 20 20 20 3b 3b 20 tlog") ;;
b7a0: 73 69 6e 63 65 20 73 65 74 74 69 6e 67 20 75 70 since setting up
b7b0: 20 69 73 20 73 6f 20 63 6f 73 74 6c 79 20 6c 65 is so costly le
b7c0: 74 73 20 70 69 67 67 79 62 61 63 6b 20 6f 6e 20 ts piggyback on
b7d0: 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 09 3b 3b -test-status..;;
b7e0: 20 20 20 20 20 28 6e 6f 74 20 28 61 72 67 73 3a (not (args:
b7f0: 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 get-arg "-step")
b800: 29 29 20 20 3b 3b 20 2d 73 65 74 6c 6f 67 20 6d )) ;; -setlog m
b810: 61 79 20 68 61 76 65 20 62 65 65 6e 20 70 72 6f ay have been pro
b820: 63 65 73 73 65 64 20 61 6c 72 65 61 64 79 20 69 cessed already i
b830: 6e 20 74 68 65 20 22 2d 73 74 65 70 22 20 70 72 n the "-step" pr
b840: 65 76 69 6f 75 73 0a 09 3b 3b 20 20 20 20 20 4e evious..;; N
b850: 45 57 20 50 4f 4c 49 43 59 20 2d 20 2d 73 65 74 EW POLICY - -set
b860: 6c 6f 67 20 73 65 74 73 20 74 65 73 74 20 6f 76 log sets test ov
b870: 65 72 61 6c 6c 20 6c 6f 67 20 6f 6e 20 65 76 65 erall log on eve
b880: 72 79 20 63 61 6c 6c 2e 0a 09 28 61 72 67 73 3a ry call...(args:
b890: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f get-arg "-set-to
b8a0: 70 6c 6f 67 22 29 0a 09 28 61 72 67 73 3a 67 65 plog")..(args:ge
b8b0: 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 t-arg "-test-sta
b8c0: 74 75 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 tus")..(args:get
b8d0: 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 -arg "-set-value
b8e0: 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 s")..(args:get-a
b8f0: 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 rg "-load-test-d
b900: 61 74 61 22 29 0a 09 28 61 72 67 73 3a 67 65 74 ata")..(args:get
b910: 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 -arg "-runstep")
b920: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
b930: 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d "-summarize-item
b940: 73 22 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f s")). (if (no
b950: 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d t (getenv "MT_CM
b960: 44 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e DINFO"))..(begin
b970: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
b980: 20 30 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 0 "ERROR: MT_CM
b990: 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f DINFO env var no
b9a0: 74 20 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 73 20 t set, commands
b9b0: 2d 74 65 73 74 2d 73 74 61 74 75 73 2c 20 2d 72 -test-status, -r
b9c0: 75 6e 73 74 65 70 20 61 6e 64 20 2d 73 65 74 6c unstep and -setl
b9d0: 6f 67 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 og must be calle
b9e0: 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 d *inside* a meg
b9f0: 61 74 65 73 74 20 65 6e 76 69 72 6f 6e 6d 65 6e atest environmen
ba00: 74 21 22 29 0a 09 20 20 28 65 78 69 74 20 35 29 t!").. (exit 5)
ba10: 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 )..(let* ((start
ba20: 69 6e 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d ingdir (current-
ba30: 64 69 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 directory))..
ba40: 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 (cmdinfo (
ba50: 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f common:read-enco
ba60: 64 65 64 2d 73 74 72 69 6e 67 20 28 67 65 74 65 ded-string (gete
ba70: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
ba80: 29 29 0a 09 20 20 20 20 20 20 20 28 74 72 61 6e )).. (tran
ba90: 73 70 6f 72 74 20 28 61 73 73 6f 63 2f 64 65 66 sport (assoc/def
baa0: 61 75 6c 74 20 27 74 72 61 6e 73 70 6f 72 74 20 ault 'transport
bab0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
bac0: 20 20 28 74 65 73 74 70 61 74 68 20 20 28 61 73 (testpath (as
bad0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
bae0: 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 tpath cmdinfo))
baf0: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e .. (test-n
bb00: 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ame (assoc/defau
bb10: 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d lt 'test-name cm
bb20: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
bb30: 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f (runscript (asso
bb40: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 c/default 'runsc
bb50: 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 ript cmdinfo))..
bb60: 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 74 20 (db-host
bb70: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
bb80: 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 'db-host cmdi
bb90: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 nfo)).. (r
bba0: 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f un-id (assoc/
bbb0: 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 default 'run-id
bbc0: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
bbd0: 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 20 20 (test-id
bbe0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
bbf0: 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 test-id cmdinf
bc00: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 o)).. (ite
bc10: 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 mdat (assoc/de
bc20: 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 fault 'itemdat
bc30: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
bc40: 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 28 61 (work-area (a
bc50: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 77 6f ssoc/default 'wo
bc60: 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 66 6f 29 rk-area cmdinfo)
bc70: 29 0a 09 20 20 20 20 20 20 20 28 64 62 20 20 20 ).. (db
bc80: 20 20 20 20 20 23 66 29 20 3b 3b 20 28 6f 70 65 #f) ;; (ope
bc90: 6e 2d 64 62 29 29 0a 09 20 20 20 20 20 20 20 28 n-db)).. (
bca0: 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 3a state (args:
bcb0: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 get-arg ":state"
bcc0: 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 )).. (stat
bcd0: 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d us (args:get-
bce0: 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 29 arg ":status")))
bcf0: 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 .. (if (not (la
bd00: 75 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d 72 unch:setup-for-r
bd10: 75 6e 20 2a 61 72 65 61 2d 64 61 74 2a 29 29 0a un *area-dat*)).
bd20: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
bd30: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
bd40: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
bd50: 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 exiting")...(ex
bd60: 69 74 20 31 29 29 29 0a 0a 09 20 20 28 69 66 20 it 1)))... (if
bd70: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
bd80: 72 75 6e 73 74 65 70 22 29 28 64 65 62 75 67 3a runstep")(debug:
bd90: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 22 52 75 print-info 1 "Ru
bda0: 6e 6e 69 6e 67 20 2d 72 75 6e 73 74 65 70 2c 20 nning -runstep,
bdb0: 66 69 72 73 74 20 63 68 61 6e 67 65 20 74 6f 20 first change to
bdc0: 64 69 72 65 63 74 6f 72 79 20 22 20 77 6f 72 6b directory " work
bdd0: 2d 61 72 65 61 29 29 0a 09 20 20 28 63 68 61 6e -area)).. (chan
bde0: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 ge-directory wor
bdf0: 6b 2d 61 72 65 61 29 0a 09 20 20 3b 3b 20 63 61 k-area).. ;; ca
be00: 6e 20 73 65 74 75 70 20 61 73 20 63 6c 69 65 6e n setup as clien
be10: 74 20 66 6f 72 20 73 65 72 76 65 72 20 6d 6f 64 t for server mod
be20: 65 20 6e 6f 77 0a 09 20 20 3b 3b 20 28 63 6c 69 e now.. ;; (cli
be30: 65 6e 74 3a 73 65 74 75 70 29 0a 0a 09 20 20 28 ent:setup)... (
be40: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
be50: 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 "-load-test-dat
be60: 61 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 68 61 a").. ;; ha
be70: 73 20 73 75 62 20 63 6f 6d 6d 61 6e 64 73 20 74 s sub commands t
be80: 68 61 74 20 61 72 65 20 72 64 62 3a 0a 09 20 20 hat are rdb:..
be90: 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 70 75 ;; DO NOT pu
bea0: 74 20 74 68 69 73 20 6f 6e 65 20 69 6e 74 6f 20 t this one into
beb0: 65 69 74 68 65 72 20 63 64 62 3a 72 65 6d 6f 74 either cdb:remot
bec0: 65 2d 72 75 6e 20 6f 72 20 6f 70 65 6e 2d 72 75 e-run or open-ru
bed0: 6e 2d 63 6c 6f 73 65 0a 09 20 20 20 20 20 20 28 n-close.. (
bee0: 74 64 62 3a 6c 6f 61 64 2d 74 65 73 74 2d 64 61 tdb:load-test-da
bef0: 74 61 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 ta run-id test-i
bf00: 64 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 d)).. (if (args
bf10: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f :get-arg "-setlo
bf20: 67 22 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 g").. (let
bf30: 28 28 6c 6f 67 66 6e 61 6d 65 20 28 61 72 67 73 ((logfname (args
bf40: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f :get-arg "-setlo
bf50: 67 22 29 29 29 0a 09 09 28 72 6d 74 3a 74 65 73 g")))...(rmt:tes
bf60: 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 t-set-log! run-i
bf70: 64 20 74 65 73 74 2d 69 64 20 6c 6f 67 66 6e 61 d test-id logfna
bf80: 6d 65 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 me))).. (if (ar
bf90: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
bfa0: 2d 74 6f 70 6c 6f 67 22 29 0a 09 20 20 20 20 20 -toplog")..
bfb0: 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 ;; DO NOT run r
bfc0: 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 28 74 65 emote.. (te
bfd0: 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 sts:test-set-top
bfe0: 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 73 74 log! run-id test
bff0: 2d 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d -name (args:get-
c000: 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 arg "-set-toplog
c010: 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 "))).. (if (arg
c020: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d 6d s:get-arg "-summ
c030: 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 0a 09 20 arize-items")..
c040: 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 ;; DO NOT r
c050: 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 20 20 un remote..
c060: 20 28 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a (tests:summariz
c070: 65 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 e-items run-id t
c080: 65 73 74 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 est-id test-name
c090: 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 6f 72 63 #t)) ;; do forc
c0a0: 65 20 68 65 72 65 0a 09 20 20 28 69 66 20 28 61 e here.. (if (a
c0b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
c0c0: 6e 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 28 nstep").. (
c0d0: 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 if (null? remarg
c0e0: 73 29 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 s)... (begin...
c0f0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
c100: 20 30 20 22 45 52 52 4f 52 3a 20 6e 6f 74 68 69 0 "ERROR: nothi
c110: 6e 67 20 73 70 65 63 69 66 69 65 64 20 74 6f 20 ng specified to
c120: 72 75 6e 21 22 29 0a 09 09 20 20 20 20 28 69 66 run!")... (if
c130: 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e db (sqlite3:fin
c140: 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 09 20 20 alize! db))...
c150: 20 20 28 65 78 69 74 20 36 29 29 0a 09 09 20 20 (exit 6))...
c160: 28 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 6d 65 (let* ((stepname
c170: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
c180: 20 22 2d 72 75 6e 73 74 65 70 22 29 29 0a 09 09 "-runstep"))...
c190: 09 20 28 6c 6f 67 70 72 6f 66 69 6c 65 20 28 61 . (logprofile (a
c1a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
c1b0: 67 70 72 6f 22 29 29 0a 09 09 09 20 28 6c 6f 67 gpro")).... (log
c1c0: 66 69 6c 65 20 20 20 20 28 63 6f 6e 63 20 73 74 file (conc st
c1d0: 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 29 0a epname ".log")).
c1e0: 09 09 09 20 28 63 6d 64 20 20 20 20 20 20 20 20 ... (cmd
c1f0: 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 (if (null? remar
c200: 67 73 29 20 23 66 20 28 63 61 72 20 72 65 6d 61 gs) #f (car rema
c210: 72 67 73 29 29 29 0a 09 09 09 20 28 70 61 72 61 rgs))).... (para
c220: 6d 73 20 20 20 20 20 28 69 66 20 63 6d 64 20 28 ms (if cmd (
c230: 63 64 72 20 72 65 6d 61 72 67 73 29 20 27 28 29 cdr remargs) '()
c240: 29 29 0a 09 09 09 20 28 65 78 69 74 73 74 61 74 )).... (exitstat
c250: 20 20 20 23 66 29 0a 09 09 09 20 28 73 68 65 6c #f).... (shel
c260: 6c 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 68 l (let ((sh
c270: 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e (get-environmen
c280: 74 2d 76 61 72 69 61 62 6c 65 20 22 53 48 45 4c t-variable "SHEL
c290: 4c 22 29 20 29 29 0a 09 09 09 09 20 20 20 20 20 L") )).....
c2a0: 20 20 28 69 66 20 73 68 20 0a 09 09 09 09 09 20 (if sh ......
c2b0: 20 20 28 6c 61 73 74 20 28 73 74 72 69 6e 67 2d (last (string-
c2c0: 73 70 6c 69 74 20 73 68 20 22 2f 22 29 29 0a 09 split sh "/"))..
c2d0: 09 09 09 09 20 20 20 22 62 61 73 68 22 29 29 29 .... "bash")))
c2e0: 0a 09 09 09 20 28 72 65 64 69 72 20 20 20 20 20 .... (redir
c2f0: 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e (case (string->
c300: 73 79 6d 62 6f 6c 20 73 68 65 6c 6c 29 0a 09 09 symbol shell)...
c310: 09 09 20 20 20 20 20 20 20 28 28 74 63 73 68 20 .. ((tcsh
c320: 63 73 68 20 6b 73 68 29 20 20 20 20 22 3e 26 22 csh ksh) ">&"
c330: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 7a )..... ((z
c340: 73 68 20 62 61 73 68 20 73 68 20 61 73 68 29 20 sh bash sh ash)
c350: 22 32 3e 26 31 20 3e 22 29 0a 09 09 09 09 20 20 "2>&1 >").....
c360: 20 20 20 20 20 28 65 6c 73 65 20 22 3e 26 22 29 (else ">&")
c370: 29 29 0a 09 09 09 20 28 66 75 6c 6c 63 6d 64 20 )).... (fullcmd
c380: 20 20 20 28 63 6f 6e 63 20 22 28 22 20 28 73 74 (conc "(" (st
c390: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
c3a0: 20 0a 09 09 09 09 09 09 28 63 6f 6e 73 20 63 6d .......(cons cm
c3b0: 64 20 70 61 72 61 6d 73 29 20 22 20 22 29 0a 09 d params) " ")..
c3c0: 09 09 09 09 20 20 20 22 29 20 22 20 72 65 64 69 .... ") " redi
c3d0: 72 20 22 20 22 20 6c 6f 67 66 69 6c 65 29 29 29 r " " logfile)))
c3e0: 0a 09 09 20 20 20 20 3b 3b 20 6d 61 72 6b 20 74 ... ;; mark t
c3f0: 68 65 20 73 74 61 72 74 20 6f 66 20 74 68 65 20 he start of the
c400: 74 65 73 74 0a 09 09 20 20 20 20 28 72 6d 74 3a test... (rmt:
c410: 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
c420: 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 tus! run-id test
c430: 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 73 74 -id stepname "st
c440: 61 72 74 22 20 22 6e 2f 61 22 20 28 61 72 67 73 art" "n/a" (args
c450: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 6c :get-arg "-m") l
c460: 6f 67 66 69 6c 65 29 0a 09 09 20 20 20 20 3b 3b ogfile)... ;;
c470: 20 72 75 6e 20 74 68 65 20 74 65 73 74 20 73 74 run the test st
c480: 65 70 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a ep... (debug:
c490: 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 52 75 print-info 2 "Ru
c4a0: 6e 6e 69 6e 67 20 5c 22 22 20 66 75 6c 6c 63 6d nning \"" fullcm
c4b0: 64 20 22 5c 22 20 69 6e 20 64 69 72 65 63 74 6f d "\" in directo
c4c0: 72 79 20 5c 22 22 20 73 74 61 72 74 69 6e 67 64 ry \"" startingd
c4d0: 69 72 29 0a 09 09 20 20 20 20 28 63 68 61 6e 67 ir)... (chang
c4e0: 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 e-directory star
c4f0: 74 69 6e 67 64 69 72 29 0a 09 09 20 20 20 20 28 tingdir)... (
c500: 73 65 74 21 20 65 78 69 74 73 74 61 74 20 28 73 set! exitstat (s
c510: 79 73 74 65 6d 20 66 75 6c 6c 63 6d 64 29 29 0a ystem fullcmd)).
c520: 09 09 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f .. (set! *glo
c530: 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 65 balexitstatus* e
c540: 78 69 74 73 74 61 74 29 0a 09 09 20 20 20 20 3b xitstat)... ;
c550: 3b 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 ; (change-direct
c560: 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 09 ory testpath)...
c570: 20 20 20 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 72 ;; run logpr
c580: 6f 20 69 66 20 61 70 70 6c 69 63 61 62 6c 65 20 o if applicable
c590: 3b 3b 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 ;; (process-run
c5a0: 22 6c 73 22 20 28 6c 69 73 74 20 22 2f 66 6f 6f "ls" (list "/foo
c5b0: 22 20 22 32 3e 26 31 22 20 22 62 6c 61 68 2e 6c " "2>&1" "blah.l
c5c0: 6f 67 22 29 29 0a 09 09 20 20 20 20 28 69 66 20 og"))... (if
c5d0: 6c 6f 67 70 72 6f 66 69 6c 65 0a 09 09 09 28 6c logprofile....(l
c5e0: 65 74 2a 20 28 28 68 74 6d 6c 6c 6f 67 66 69 6c et* ((htmllogfil
c5f0: 65 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 e (conc stepname
c600: 20 22 2e 68 74 6d 6c 22 29 29 0a 09 09 09 20 20 ".html"))....
c610: 20 20 20 20 20 28 6f 6c 64 65 78 69 74 73 74 61 (oldexitsta
c620: 74 20 65 78 69 74 73 74 61 74 29 0a 09 09 09 20 t exitstat)....
c630: 20 20 20 20 20 20 28 63 6d 64 20 20 20 20 20 20 (cmd
c640: 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 (string-inter
c650: 73 70 65 72 73 65 20 28 6c 69 73 74 20 22 6c 6f sperse (list "lo
c660: 67 70 72 6f 22 20 6c 6f 67 70 72 6f 66 69 6c 65 gpro" logprofile
c670: 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c 22 htmllogfile "<"
c680: 20 6c 6f 67 66 69 6c 65 20 22 3e 22 20 28 63 6f logfile ">" (co
c690: 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 5f 6c 6f nc stepname "_lo
c6a0: 67 70 72 6f 2e 6c 6f 67 22 29 29 20 22 20 22 29 gpro.log")) " ")
c6b0: 29 29 0a 09 09 09 20 20 28 64 65 62 75 67 3a 70 )).... (debug:p
c6c0: 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 72 75 6e rint-info 2 "run
c6d0: 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 ning \"" cmd "\"
c6e0: 22 29 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d ").... (change-
c6f0: 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 directory starti
c700: 6e 67 64 69 72 29 0a 09 09 09 20 20 28 73 65 74 ngdir).... (set
c710: 21 20 65 78 69 74 73 74 61 74 20 28 73 79 73 74 ! exitstat (syst
c720: 65 6d 20 63 6d 64 29 29 0a 09 09 09 20 20 28 73 em cmd)).... (s
c730: 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 et! *globalexits
c740: 74 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 tatus* exitstat)
c750: 20 3b 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 ;; no necessary
c760: 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 .... (change-di
c770: 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 rectory testpath
c780: 29 0a 09 09 09 20 20 28 72 6d 74 3a 74 65 73 74 ).... (rmt:test
c790: 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 -set-log! run-id
c7a0: 20 74 65 73 74 2d 69 64 20 68 74 6d 6c 6c 6f 67 test-id htmllog
c7b0: 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 28 6c file)))... (l
c7c0: 65 74 20 28 28 6d 73 67 20 28 61 72 67 73 3a 67 et ((msg (args:g
c7d0: 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 29 0a 09 et-arg "-m")))..
c7e0: 09 20 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 . (rmt:test
c7f0: 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
c800: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
c810: 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 stepname "end" e
c820: 78 69 74 73 74 61 74 20 6d 73 67 20 6c 6f 67 66 xitstat msg logf
c830: 69 6c 65 29 29 0a 09 09 20 20 20 20 29 29 29 0a ile))... ))).
c840: 09 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 . (if (or (args
c850: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d :get-arg "-test-
c860: 73 74 61 74 75 73 22 29 0a 09 09 20 20 28 61 72 status")... (ar
c870: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
c880: 2d 76 61 6c 75 65 73 22 29 29 0a 09 20 20 20 20 -values"))..
c890: 20 20 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 (let ((newstat
c8a0: 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e us (cond.....((n
c8b0: 75 6d 62 65 72 3f 20 73 74 61 74 75 73 29 20 20 umber? status)
c8c0: 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f (if (equal?
c8d0: 20 73 74 61 74 75 73 20 30 29 20 22 50 41 53 53 status 0) "PASS
c8e0: 22 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 " "FAIL")).....(
c8f0: 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 74 (and (string? st
c900: 61 74 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 atus).....
c910: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
c920: 73 74 61 74 75 73 29 29 28 69 66 20 28 65 71 75 status))(if (equ
c930: 61 6c 3f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d al? (string->num
c940: 62 65 72 20 73 74 61 74 75 73 29 20 30 29 20 22 ber status) 0) "
c950: 50 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 PASS" "FAIL"))..
c960: 09 09 09 28 65 6c 73 65 20 73 74 61 74 75 73 29 ...(else status)
c970: 29 29 0a 09 09 20 20 20 20 3b 3b 20 74 72 61 6e ))... ;; tran
c980: 73 66 65 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 sfer relevant ke
c990: 79 73 20 69 6e 74 6f 20 61 20 68 61 73 68 20 74 ys into a hash t
c9a0: 6f 20 62 65 20 70 61 73 73 65 64 20 74 6f 20 74 o be passed to t
c9b0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a est-set-status!.
c9c0: 09 09 20 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 .. ;; could u
c9d0: 73 65 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 se an assoc list
c9e0: 20 49 20 67 75 65 73 73 2e 20 0a 09 09 20 20 20 I guess. ...
c9f0: 20 28 6f 74 68 65 72 64 61 74 61 20 28 6c 65 74 (otherdata (let
ca00: 20 28 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 ((res (make-has
ca10: 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 09 20 h-table))).....
ca20: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
ca30: 61 20 28 6b 65 79 29 0a 09 09 09 09 09 20 20 20 a (key)......
ca40: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
ca50: 61 72 67 20 6b 65 79 29 0a 09 09 09 09 09 09 20 arg key).......
ca60: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
ca70: 20 72 65 73 20 6b 65 79 20 28 61 72 67 73 3a 67 res key (args:g
ca80: 65 74 2d 61 72 67 20 6b 65 79 29 29 29 29 0a 09 et-arg key))))..
ca90: 09 09 09 09 20 20 20 28 6c 69 73 74 20 22 3a 76 .... (list ":v
caa0: 61 6c 75 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 alue" ":tol" ":e
cab0: 78 70 65 63 74 65 64 22 20 22 3a 66 69 72 73 74 xpected" ":first
cac0: 5f 65 72 72 22 20 22 3a 66 69 72 73 74 5f 77 61 _err" ":first_wa
cad0: 72 6e 22 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 rn" ":units" ":c
cae0: 61 74 65 67 6f 72 79 22 20 22 3a 76 61 72 69 61 ategory" ":varia
caf0: 62 6c 65 22 29 29 0a 09 09 09 09 20 72 65 73 29 ble"))..... res)
cb00: 29 29 0a 09 09 28 69 66 20 28 61 6e 64 20 28 61 ))...(if (and (a
cb10: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
cb20: 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 09 20 st-status")....
cb30: 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 65 29 0a (or (not state).
cb40: 09 09 09 20 20 20 20 20 28 6e 6f 74 20 73 74 61 ... (not sta
cb50: 74 75 73 29 29 29 0a 09 09 20 20 20 20 28 62 65 tus)))... (be
cb60: 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 gin... (deb
cb70: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
cb80: 52 3a 20 59 6f 75 20 6d 75 73 74 20 73 70 65 63 R: You must spec
cb90: 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a ify :state and :
cba0: 73 74 61 74 75 73 20 77 69 74 68 20 65 76 65 72 status with ever
cbb0: 79 20 63 61 6c 6c 20 74 6f 20 2d 74 65 73 74 2d y call to -test-
cbc0: 73 74 61 74 75 73 5c 6e 22 20 68 65 6c 70 29 0a status\n" help).
cbd0: 09 09 20 20 20 20 20 20 28 69 66 20 28 73 71 6c .. (if (sql
cbe0: 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 64 ite3:database? d
cbf0: 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c b)(sqlite3:final
cc00: 69 7a 65 21 20 64 62 29 29 0a 09 09 20 20 20 20 ize! db))...
cc10: 20 20 28 65 78 69 74 20 36 29 29 29 0a 09 09 28 (exit 6)))...(
cc20: 6c 65 74 2a 20 28 28 6d 73 67 20 20 20 20 28 61 let* ((msg (a
cc30: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
cc40: 29 29 0a 09 09 20 20 20 20 20 20 20 28 6e 75 6d ))... (num
cc50: 6f 74 68 20 28 6c 65 6e 67 74 68 20 28 68 61 73 oth (length (has
cc60: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 6f 74 68 h-table-keys oth
cc70: 65 72 64 61 74 61 29 29 29 29 0a 09 09 20 20 3b erdata))))... ;
cc80: 3b 20 43 6f 6e 76 65 72 74 20 74 6f 20 72 70 63 ; Convert to rpc
cc90: 20 69 6e 73 69 64 65 20 74 68 65 20 74 65 73 74 inside the test
cca0: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
ccb0: 73 21 20 63 61 6c 6c 2c 20 6e 6f 74 20 68 65 72 s! call, not her
ccc0: 65 0a 09 09 20 20 28 74 65 73 74 73 3a 74 65 73 e... (tests:tes
ccd0: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 t-set-status! ru
cce0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 61 n-id test-id sta
ccf0: 74 65 20 6e 65 77 73 74 61 74 75 73 20 6d 73 67 te newstatus msg
cd00: 20 6f 74 68 65 72 64 61 74 61 20 77 6f 72 6b 2d otherdata work-
cd10: 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 61 29 area: work-area)
cd20: 29 29 29 0a 09 20 20 28 69 66 20 28 73 71 6c 69 ))).. (if (sqli
cd30: 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 64 62 te3:database? db
cd40: 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 )(sqlite3:finali
cd50: 7a 65 21 20 64 62 29 29 0a 09 20 20 28 73 65 74 ze! db)).. (set
cd60: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
cd70: 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d #t))))..;;=====
cd80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cd90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cda0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cdb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cdc0: 3d 0a 3b 3b 20 56 61 72 69 6f 75 73 20 68 65 6c =.;; Various hel
cdd0: 70 65 72 20 63 6f 6d 6d 61 6e 64 73 20 63 61 6e per commands can
cde0: 20 67 6f 20 62 65 6c 6f 77 20 68 65 72 65 0a 3b go below here.;
cdf0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
ce00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ce10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ce20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ce30: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 =======..(if (or
ce40: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
ce50: 2d 73 68 6f 77 6b 65 79 73 22 29 0a 20 20 20 20 -showkeys").
ce60: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
ce70: 67 20 22 2d 73 68 6f 77 2d 6b 65 79 73 22 29 29 g "-show-keys"))
ce80: 0a 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 23 . (let ((db #
ce90: 66 29 0a 09 20 20 28 6b 65 79 73 20 23 66 29 29 f).. (keys #f))
cea0: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
ceb0: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 66 6f (launch:setup-fo
cec0: 72 2d 72 75 6e 20 2a 61 72 65 61 2d 64 61 74 2a r-run *area-dat*
ced0: 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 )).. (begin..
cee0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
cef0: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
cf00: 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 p, exiting")..
cf10: 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 (exit 1))).
cf20: 20 20 20 28 73 65 74 21 20 6b 65 79 73 20 28 63 (set! keys (c
cf30: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 db:remote-run db
cf40: 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 20 :get-keys db)).
cf50: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
cf60: 74 20 31 20 22 4b 65 79 73 3a 20 22 20 28 73 74 t 1 "Keys: " (st
cf70: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
cf80: 20 6b 65 79 73 20 22 2c 20 22 29 29 0a 20 20 20 keys ", ")).
cf90: 20 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 3a (if (sqlite3:
cfa0: 64 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 71 database? db)(sq
cfb0: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
cfc0: 64 62 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 db)). (set!
cfd0: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
cfe0: 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 #t)))..(if (args
cff0: 3a 67 65 74 2d 61 72 67 20 22 2d 67 75 69 22 29 :get-arg "-gui")
d000: 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
d010: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
d020: 20 22 4c 6f 6f 6b 20 61 74 20 74 68 65 20 64 61 "Look at the da
d030: 73 68 62 6f 61 72 64 20 66 6f 72 20 6e 6f 77 22 shboard for now"
d040: 29 0a 20 20 20 20 20 20 3b 3b 20 28 6d 65 67 61 ). ;; (mega
d050: 74 65 73 74 2d 67 75 69 29 0a 20 20 20 20 20 20 test-gui).
d060: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
d070: 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
d080: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
d090: 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 gen-megatest-are
d0a0: 61 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 a"). (begin.
d0b0: 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 (genexample
d0c0: 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2e 63 6f 6e :mk-megatest.con
d0d0: 66 69 67 29 0a 20 20 20 20 20 20 28 73 65 74 21 fig). (set!
d0e0: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
d0f0: 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 #t)))..(if (args
d100: 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 6e 2d 6d :get-arg "-gen-m
d110: 65 67 61 74 65 73 74 2d 74 65 73 74 22 29 0a 20 egatest-test").
d120: 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 6e 61 (let ((testna
d130: 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 me (args:get-arg
d140: 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d "-gen-megatest-
d150: 74 65 73 74 22 29 29 29 0a 20 20 20 20 20 20 28 test"))). (
d160: 67 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 genexample:mk-me
d170: 67 61 74 65 73 74 2d 74 65 73 74 20 74 65 73 74 gatest-test test
d180: 6e 61 6d 65 29 0a 20 20 20 20 20 20 28 73 65 74 name). (set
d190: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
d1a0: 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d #t)))..;;======
d1b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d1c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d1d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d1e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d1f0: 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 64 .;; Update the d
d200: 61 74 61 62 61 73 65 20 73 63 68 65 6d 61 2c 20 atabase schema,
d210: 63 6c 65 61 6e 20 75 70 20 74 68 65 20 64 62 0a clean up the db.
d220: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
d230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d260: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
d270: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
d280: 62 75 69 6c 64 2d 64 62 22 29 0a 20 20 20 20 28 build-db"). (
d290: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 begin. (if
d2a0: 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 (not (launch:set
d2b0: 75 70 2d 66 6f 72 2d 72 75 6e 20 2a 61 72 65 61 up-for-run *area
d2c0: 2d 64 61 74 2a 29 29 0a 09 20 20 28 62 65 67 69 -dat*)).. (begi
d2d0: 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 n.. (debug:pr
d2e0: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f int 0 "Failed to
d2f0: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
d300: 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ) .. (exit 1)
d310: 29 29 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 )). ;; keep
d320: 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a this one local.
d330: 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d (open-run-
d340: 63 6c 6f 73 65 20 70 61 74 63 68 2d 64 62 20 23 close patch-db #
d350: 66 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a f). (set! *
d360: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
d370: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
d380: 65 74 2d 61 72 67 20 22 2d 63 6c 65 61 6e 75 70 et-arg "-cleanup
d390: 2d 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e -db"). (begin
d3a0: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
d3b0: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 66 6f (launch:setup-fo
d3c0: 72 2d 72 75 6e 20 2a 61 72 65 61 2d 64 61 74 2a r-run *area-dat*
d3d0: 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 )).. (begin..
d3e0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
d3f0: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
d400: 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 p, exiting") ..
d410: 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))).
d420: 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 ;; keep this
d430: 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 one local.
d440: 20 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c ;; (open-run-cl
d450: 6f 73 65 20 64 62 3a 63 6c 65 61 6e 2d 75 70 20 ose db:clean-up
d460: 23 66 29 0a 20 20 20 20 20 20 28 64 62 3a 6d 75 #f). (db:mu
d470: 6c 74 69 2d 64 62 2d 73 79 6e 63 20 0a 20 20 20 lti-db-sync .
d480: 20 20 20 20 23 66 20 3b 3b 20 64 6f 20 61 6c 6c #f ;; do all
d490: 20 72 75 6e 2d 69 64 73 0a 20 20 20 20 20 20 20 run-ids.
d4a0: 3b 3b 20 27 6e 65 77 32 6f 6c 64 0a 20 20 20 20 ;; 'new2old.
d4b0: 20 20 20 27 6b 69 6c 6c 73 65 72 76 65 72 73 0a 'killservers.
d4c0: 20 20 20 20 20 20 20 27 64 65 6a 75 6e 6b 0a 20 'dejunk.
d4d0: 20 20 20 20 20 20 3b 3b 20 27 61 64 6a 2d 74 65 ;; 'adj-te
d4e0: 73 74 69 64 73 0a 20 20 20 20 20 20 20 3b 3b 20 stids. ;;
d4f0: 27 6f 6c 64 32 6e 65 77 0a 20 20 20 20 20 20 20 'old2new.
d500: 27 6e 65 77 32 6f 6c 64 0a 20 20 20 20 20 20 20 'new2old.
d510: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
d520: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
d530: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
d540: 74 2d 61 72 67 20 22 2d 6d 61 72 6b 2d 69 6e 63 t-arg "-mark-inc
d550: 6f 6d 70 6c 65 74 65 73 22 29 0a 20 20 20 20 28 ompletes"). (
d560: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 begin. (if
d570: 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 (not (launch:set
d580: 75 70 2d 66 6f 72 2d 72 75 6e 20 2a 61 72 65 61 up-for-run *area
d590: 2d 64 61 74 2a 29 29 0a 09 20 20 28 62 65 67 69 -dat*)).. (begi
d5a0: 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 n.. (debug:pr
d5b0: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f int 0 "Failed to
d5c0: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
d5d0: 29 20 62 0a 09 20 20 20 20 28 65 78 69 74 20 31 ) b.. (exit 1
d5e0: 29 29 29 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d ))). (open-
d5f0: 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 66 69 6e run-close db:fin
d600: 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d d-and-mark-incom
d610: 70 6c 65 74 65 20 23 66 29 0a 20 20 20 20 20 20 plete #f).
d620: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
d630: 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d ing* #t)))..;;==
d640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d680: 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 ====.;; Update t
d690: 68 65 20 74 65 73 74 73 20 6d 65 74 61 20 64 61 he tests meta da
d6a0: 74 61 20 66 72 6f 6d 20 74 68 65 20 74 65 73 74 ta from the test
d6b0: 63 6f 6e 66 69 67 20 66 69 6c 65 73 0a 3b 3b 3d config files.;;=
d6c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d6d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d6e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d6f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d700: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
d710: 3a 67 65 74 2d 61 72 67 20 22 2d 75 70 64 61 74 :get-arg "-updat
d720: 65 2d 6d 65 74 61 22 29 0a 20 20 20 20 28 62 65 e-meta"). (be
d730: 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e gin. (if (n
d740: 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 ot (launch:setup
d750: 2d 66 6f 72 2d 72 75 6e 20 2a 61 72 65 61 2d 64 -for-run *area-d
d760: 61 74 2a 29 29 0a 09 20 20 28 62 65 67 69 6e 0a at*)).. (begin.
d770: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
d780: 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 t 0 "Failed to s
d790: 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 etup, exiting")
d7a0: 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 .. (exit 1)))
d7b0: 0a 20 20 20 20 20 20 3b 3b 20 6e 6f 77 20 63 61 . ;; now ca
d7c0: 6e 20 66 69 6e 64 20 6f 75 72 20 64 62 0a 20 20 n find our db.
d7d0: 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 ;; keep this
d7e0: 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 one local.
d7f0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
d800: 20 72 75 6e 73 3a 75 70 64 61 74 65 2d 61 6c 6c runs:update-all
d810: 2d 74 65 73 74 5f 6d 65 74 61 20 23 66 29 0a 20 -test_meta #f).
d820: 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
d830: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
d840: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
d850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 =========.;; Sta
d890: 72 74 20 61 20 72 65 70 6c 0a 3b 3b 3d 3d 3d 3d rt a repl.;;====
d8a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d8b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d8c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d8d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d8e0: 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 ==..(if (or (arg
d8f0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c s:get-arg "-repl
d900: 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
d910: 67 20 22 2d 6c 6f 61 64 22 29 29 0a 20 20 20 20 g "-load")).
d920: 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 (let* ((toppath
d930: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 66 6f (launch:setup-fo
d940: 72 2d 72 75 6e 20 2a 61 72 65 61 2d 64 61 74 2a r-run *area-dat*
d950: 29 29 0a 09 20 20 20 28 64 62 73 74 72 75 63 74 )).. (dbstruct
d960: 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 6d 61 (if toppath (ma
d970: 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 ke-dbr:dbstruct
d980: 70 61 74 68 3a 20 74 6f 70 70 61 74 68 20 6c 6f path: toppath lo
d990: 63 61 6c 3a 20 23 74 29 20 23 66 29 29 29 0a 20 cal: #t) #f))).
d9a0: 20 20 20 20 20 28 69 66 20 64 62 73 74 72 75 63 (if dbstruc
d9b0: 74 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 t.. (begin..
d9c0: 20 28 73 65 74 21 20 2a 64 62 2a 20 64 62 73 74 (set! *db* dbst
d9d0: 72 75 63 74 29 0a 09 20 20 20 20 28 73 65 74 21 ruct).. (set!
d9e0: 20 2a 63 6c 69 65 6e 74 2d 6e 6f 6e 2d 62 6c 6f *client-non-blo
d9f0: 63 6b 69 6e 67 2d 6d 6f 64 65 2a 20 23 74 29 0a cking-mode* #t).
da00: 09 20 20 20 20 28 69 6d 70 6f 72 74 20 65 78 74 . (import ext
da10: 72 61 73 29 20 3b 3b 20 6d 69 67 68 74 20 6e 6f ras) ;; might no
da20: 74 20 62 65 20 6e 65 65 64 65 64 0a 09 20 20 20 t be needed..
da30: 20 3b 3b 20 28 69 6d 70 6f 72 74 20 63 73 69 29 ;; (import csi)
da40: 0a 09 20 20 20 20 28 69 6d 70 6f 72 74 20 72 65 .. (import re
da50: 61 64 6c 69 6e 65 29 0a 20 20 20 20 20 20 20 20 adline).
da60: 20 20 20 20 28 75 73 65 2d 6c 65 67 61 63 79 2d (use-legacy-
da70: 62 69 6e 64 69 6e 67 73 29 0a 09 20 20 20 20 28 bindings).. (
da80: 69 6d 70 6f 72 74 20 61 70 72 6f 70 6f 73 29 0a import apropos).
da90: 09 20 20 20 20 3b 3b 20 28 69 6d 70 6f 72 74 20 . ;; (import
daa0: 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 (prefix sqlite3
dab0: 73 71 6c 69 74 65 33 3a 29 29 20 3b 3b 20 64 6f sqlite3:)) ;; do
dac0: 65 73 6e 27 74 20 77 6f 72 6b 20 2e 2e 2e 0a 09 esn't work .....
dad0: 20 20 20 20 28 67 6e 75 2d 68 69 73 74 6f 72 79 (gnu-history
dae0: 2d 69 6e 73 74 61 6c 6c 2d 66 69 6c 65 2d 6d 61 -install-file-ma
daf0: 6e 61 67 65 72 0a 09 20 20 20 20 20 28 6c 65 74 nager.. (let
db00: 20 28 28 64 20 28 73 74 72 69 6e 67 2d 61 70 70 ((d (string-app
db10: 65 6e 64 0a 09 09 20 20 20 20 20 20 20 28 6f 72 end... (or
db20: 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e (get-environmen
db30: 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 t-variable "HOME
db40: 22 29 20 22 2e 22 29 20 22 2f 2e 6d 65 67 61 74 ") ".") "/.megat
db50: 65 73 74 22 29 29 29 0a 09 20 20 20 20 20 20 20 est")))..
db60: 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 (if (not (file-e
db70: 78 69 73 74 73 3f 20 64 29 29 0a 09 09 20 20 20 xists? d))...
db80: 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
db90: 79 20 64 20 23 74 29 29 0a 09 20 20 20 20 20 20 y d #t))..
dba0: 20 64 29 29 0a 09 20 20 20 20 28 63 75 72 72 65 d)).. (curre
dbb0: 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 20 28 6d nt-input-port (m
dbc0: 61 6b 65 2d 67 6e 75 2d 72 65 61 64 6c 69 6e 65 ake-gnu-readline
dbd0: 2d 70 6f 72 74 20 22 6d 65 67 61 74 65 73 74 3e -port "megatest>
dbe0: 20 22 29 29 0a 09 20 20 20 20 28 69 66 20 28 61 ")).. (if (a
dbf0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
dc00: 70 6c 22 29 0a 09 09 28 72 65 70 6c 29 0a 09 09 pl")...(repl)...
dc10: 28 6c 6f 61 64 20 28 61 72 67 73 3a 67 65 74 2d (load (args:get-
dc20: 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 29 0a 09 arg "-load")))..
dc30: 20 20 20 20 28 64 62 3a 63 6c 6f 73 65 2d 61 6c (db:close-al
dc40: 6c 20 64 62 73 74 72 75 63 74 20 2a 61 72 65 61 l dbstruct *area
dc50: 2d 64 61 74 2a 29 29 0a 09 20 20 28 65 78 69 74 -dat*)).. (exit
dc60: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
dc70: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
dc80: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
dc90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dcb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dcc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
dcd0: 20 57 61 69 74 20 6f 6e 20 61 20 72 75 6e 20 74 Wait on a run t
dce0: 6f 20 63 6f 6d 70 6c 65 74 65 0a 3b 3b 3d 3d 3d o complete.;;===
dcf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dd00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dd10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dd20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dd30: 3d 3d 3d 0a 0a 28 69 66 20 28 61 6e 64 20 28 61 ===..(if (and (a
dd40: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
dd50: 6e 2d 77 61 69 74 22 29 0a 09 20 28 6e 6f 74 20 n-wait").. (not
dd60: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
dd70: 72 75 6e 74 65 73 74 73 22 29 29 29 20 3b 3b 20 runtests"))) ;;
dd80: 72 75 6e 2d 77 61 69 74 20 69 73 20 62 75 69 6c run-wait is buil
dd90: 74 20 69 6e 74 6f 20 72 75 6e 74 65 73 74 73 20 t into runtests
dda0: 6e 6f 77 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 now. (begin.
ddb0: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c (if (not (l
ddc0: 61 75 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d aunch:setup-for-
ddd0: 72 75 6e 20 2a 61 72 65 61 2d 64 61 74 2a 29 29 run *area-dat*))
dde0: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
ddf0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
de00: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
de10: 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 exiting") ..
de20: 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 (exit 1))).
de30: 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 72 (operate-on 'r
de40: 75 6e 2d 77 61 69 74 29 0a 20 20 20 20 20 20 28 un-wait). (
de50: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
de60: 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 3b 3b ng* #t)))..;; ;;
de70: 20 3b 3b 20 72 65 64 6f 20 6d 65 20 3b 3b 20 4e ;; redo me ;; N
de80: 6f 74 20 63 6f 6e 76 65 72 74 65 64 20 74 6f 20 ot converted to
de90: 75 73 65 20 64 62 73 74 72 75 63 74 20 79 65 74 use dbstruct yet
dea0: 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
deb0: 65 20 3b 3b 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 e ;;.;; ;; ;; re
dec0: 64 6f 20 6d 65 20 28 69 66 20 28 61 72 67 73 3a do me (if (args:
ded0: 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e 76 65 72 get-arg "-conver
dee0: 74 2d 74 6f 2d 6e 6f 72 6d 22 29 0a 3b 3b 20 3b t-to-norm").;; ;
def0: 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 ; ;; redo me
df00: 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 (let* ((toppath
df10: 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 (setup-for-run)
df20: 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
df30: 6d 65 20 09 20 20 20 28 64 62 73 74 72 75 63 74 me . (dbstruct
df40: 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 6d 61 (if toppath (ma
df50: 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 ke-dbr:dbstruct
df60: 70 61 74 68 3a 20 74 6f 70 70 61 74 68 20 6c 6f path: toppath lo
df70: 63 61 6c 3a 20 23 74 29 29 29 29 0a 3b 3b 20 3b cal: #t)))).;; ;
df80: 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 ; ;; redo me
df90: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 3b 3b (for-each .;;
dfa0: 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 ;; ;; redo me
dfb0: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 (lambda (f
dfc0: 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 ield).;; ;; ;; r
dfd0: 65 64 6f 20 6d 65 20 09 20 28 6c 65 74 20 28 28 edo me . (let ((
dfe0: 64 61 74 20 27 28 29 29 29 0a 3b 3b 20 3b 3b 20 dat '())).;; ;;
dff0: 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 ;; redo me . (
e000: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
e010: 20 30 20 22 47 65 74 74 69 6e 67 20 64 61 74 61 0 "Getting data
e020: 20 66 6f 72 20 66 69 65 6c 64 20 22 20 66 69 65 for field " fie
e030: 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ld).;; ;; ;; red
e040: 6f 20 6d 65 20 09 20 20 20 28 73 71 6c 69 74 65 o me . (sqlite
e050: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 3b 3:for-each-row.;
e060: 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
e070: 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 . (lambda (id
e080: 20 76 61 6c 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 val).;; ;; ;; r
e090: 65 64 6f 20 6d 65 20 09 20 20 20 20 20 20 28 73 edo me . (s
e0a0: 65 74 21 20 64 61 74 20 28 63 6f 6e 73 20 28 6c et! dat (cons (l
e0b0: 69 73 74 20 69 64 20 76 61 6c 29 20 64 61 74 29 ist id val) dat)
e0c0: 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f )).;; ;; ;; redo
e0d0: 20 6d 65 20 09 20 20 20 20 28 64 62 3a 67 65 74 me . (db:get
e0e0: 2d 64 62 20 64 62 20 72 75 6e 2d 69 64 29 0a 3b -db db run-id).;
e0f0: 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
e100: 09 20 20 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 . (conc "SELE
e110: 43 54 20 69 64 2c 22 20 66 69 65 6c 64 20 22 20 CT id," field "
e120: 46 52 4f 4d 20 74 65 73 74 73 3b 22 29 29 0a 3b FROM tests;")).;
e130: 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
e140: 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
e150: 2d 69 6e 66 6f 20 30 20 22 66 6f 75 6e 64 20 22 -info 0 "found "
e160: 20 28 6c 65 6e 67 74 68 20 64 61 74 29 20 22 20 (length dat) "
e170: 69 74 65 6d 73 20 66 6f 72 20 66 69 65 6c 64 20 items for field
e180: 22 20 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b " field).;; ;; ;
e190: 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 6c ; redo me . (l
e1a0: 65 74 20 28 28 71 72 79 20 28 73 71 6c 69 74 65 et ((qry (sqlite
e1b0: 33 3a 70 72 65 70 61 72 65 20 64 62 20 28 63 6f 3:prepare db (co
e1c0: 6e 63 20 22 55 50 44 41 54 45 20 74 65 73 74 73 nc "UPDATE tests
e1d0: 20 53 45 54 20 22 20 66 69 65 6c 64 20 22 3d 3f SET " field "=?
e1e0: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 29 29 WHERE id=?;")))
e1f0: 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
e200: 6d 65 20 09 20 20 20 20 20 28 66 6f 72 2d 65 61 me . (for-ea
e210: 63 68 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f ch.;; ;; ;; redo
e220: 20 6d 65 20 09 20 20 20 20 20 20 28 6c 61 6d 62 me . (lamb
e230: 64 61 20 28 69 74 65 6d 29 0a 3b 3b 20 3b 3b 20 da (item).;; ;;
e240: 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 28 6c 65 ;; redo me ..(le
e250: 74 20 28 28 6e 65 77 76 61 6c 20 3b 3b 20 28 73 t ((newval ;; (s
e260: 64 62 3a 71 72 79 20 27 67 65 74 69 64 20 0a 3b db:qry 'getid .;
e270: 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
e280: 09 09 20 20 20 20 20 20 20 28 63 61 64 72 20 69 .. (cadr i
e290: 74 65 6d 29 29 29 20 3b 3b 20 29 0a 3b 3b 20 3b tem))) ;; ).;; ;
e2a0: 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 20 ; ;; redo me ..
e2b0: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal
e2c0: 3f 20 6e 65 77 76 61 6c 20 28 63 61 64 72 20 69 ? newval (cadr i
e2d0: 74 65 6d 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 tem))).;; ;; ;;
e2e0: 72 65 64 6f 20 6d 65 20 09 09 20 20 20 20 20 20 redo me ..
e2f0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
e300: 6f 20 30 20 22 43 6f 6e 76 65 72 74 69 6e 67 20 o 0 "Converting
e310: 22 20 28 63 61 64 72 20 69 74 65 6d 29 20 22 20 " (cadr item) "
e320: 74 6f 20 22 20 6e 65 77 76 61 6c 20 22 20 66 6f to " newval " fo
e330: 72 20 74 65 73 74 20 23 22 20 28 63 61 72 20 69 r test #" (car i
e340: 74 65 6d 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 tem))).;; ;; ;;
e350: 72 65 64 6f 20 6d 65 20 09 09 20 20 28 73 71 6c redo me .. (sql
e360: 69 74 65 33 3a 65 78 65 63 75 74 65 20 71 72 79 ite3:execute qry
e370: 20 6e 65 77 76 61 6c 20 28 63 61 72 20 69 74 65 newval (car ite
e380: 6d 29 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 m)))).;; ;; ;; r
e390: 65 64 6f 20 6d 65 20 09 20 20 20 20 20 20 64 61 edo me . da
e3a0: 74 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f t).;; ;; ;; redo
e3b0: 20 6d 65 20 09 20 20 20 20 20 28 73 71 6c 69 74 me . (sqlit
e3c0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 71 72 79 e3:finalize! qry
e3d0: 29 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 )))).;; ;; ;; re
e3e0: 64 6f 20 6d 65 20 20 20 20 20 20 20 20 28 64 62 do me (db
e3f0: 3a 63 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 :close-all dbstr
e400: 75 63 74 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 uct).;; ;; ;; re
e410: 64 6f 20 6d 65 20 20 20 20 20 20 20 20 28 6c 69 do me (li
e420: 73 74 20 22 75 6e 61 6d 65 22 20 22 72 75 6e 64 st "uname" "rund
e430: 69 72 22 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 ir" "final_logf"
e440: 20 22 63 6f 6d 6d 65 6e 74 22 29 29 0a 3b 3b 20 "comment")).;;
e450: 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 ;; ;; redo me
e460: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
e470: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
e480: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
e490: 67 20 22 2d 69 6d 70 6f 72 74 2d 6d 65 67 61 74 g "-import-megat
e4a0: 65 73 74 2e 64 62 22 29 0a 20 20 20 20 28 62 65 est.db"). (be
e4b0: 67 69 6e 0a 20 20 20 20 20 20 28 64 62 3a 6d 75 gin. (db:mu
e4c0: 6c 74 69 2d 64 62 2d 73 79 6e 63 20 0a 20 20 20 lti-db-sync .
e4d0: 20 20 20 20 23 66 20 3b 3b 20 64 6f 20 61 6c 6c #f ;; do all
e4e0: 20 72 75 6e 2d 69 64 73 0a 20 20 20 20 20 20 20 run-ids.
e4f0: 27 6b 69 6c 6c 73 65 72 76 65 72 73 0a 20 20 20 'killservers.
e500: 20 20 20 20 27 64 65 6a 75 6e 6b 0a 20 20 20 20 'dejunk.
e510: 20 20 20 27 61 64 6a 2d 74 65 73 74 69 64 73 0a 'adj-testids.
e520: 20 20 20 20 20 20 20 27 6f 6c 64 32 6e 65 77 0a 'old2new.
e530: 20 20 20 20 20 20 20 3b 3b 20 27 6e 65 77 32 6f ;; 'new2o
e540: 6c 64 0a 20 20 20 20 20 20 20 29 0a 20 20 20 20 ld. ).
e550: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
e560: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
e570: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
e580: 22 2d 73 79 6e 63 2d 74 6f 2d 6d 65 67 61 74 65 "-sync-to-megate
e590: 73 74 2e 64 62 22 29 0a 20 20 20 20 28 62 65 67 st.db"). (beg
e5a0: 69 6e 0a 20 20 20 20 20 20 28 64 62 3a 6d 75 6c in. (db:mul
e5b0: 74 69 2d 64 62 2d 73 79 6e 63 20 0a 20 20 20 20 ti-db-sync .
e5c0: 20 20 20 23 66 20 3b 3b 20 64 6f 20 61 6c 6c 20 #f ;; do all
e5d0: 72 75 6e 2d 69 64 73 0a 20 20 20 20 20 20 20 27 run-ids. '
e5e0: 6e 65 77 32 6f 6c 64 0a 20 20 20 20 20 20 20 29 new2old. )
e5f0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
e600: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
e610: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
e620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 ===========.;; E
e660: 78 69 74 20 61 6e 64 20 63 6c 65 61 6e 20 75 70 xit and clean up
e670: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
e680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e6a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e6b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 69 66 =========..;; if
e6c0: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 69 73 20 *runremote* is
e6d0: 64 65 66 69 6e 65 64 2c 20 63 6c 6f 73 65 20 63 defined, close c
e6e0: 6f 6e 6e 65 63 74 69 6f 6e 73 2c 20 6f 74 68 65 onnections, othe
e6f0: 72 77 69 73 65 20 2d 20 74 72 75 73 74 20 74 68 rwise - trust th
e700: 61 74 20 69 74 20 77 61 73 0a 3b 3b 20 74 61 6b at it was.;; tak
e710: 65 6e 20 63 61 72 65 20 6f 66 2e 0a 3b 3b 0a 28 en care of..;;.(
e720: 69 66 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 72 if (common:get-r
e730: 65 6d 6f 74 65 20 28 6d 65 67 61 74 65 73 74 3a emote (megatest:
e740: 61 72 65 61 2d 72 65 6d 6f 74 65 20 2a 61 72 65 area-remote *are
e750: 61 2d 64 61 74 2a 29 20 23 66 29 0a 20 20 20 20 a-dat*) #f).
e760: 28 63 6c 6f 73 65 2d 61 6c 6c 2d 63 6f 6e 6e 65 (close-all-conne
e770: 63 74 69 6f 6e 73 21 29 29 0a 0a 28 69 66 20 28 ctions!))..(if (
e780: 6e 6f 74 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e not *didsomethin
e790: 67 2a 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 g*). (debug:p
e7a0: 72 69 6e 74 20 30 20 68 65 6c 70 29 29 0a 0a 28 rint 0 help))..(
e7b0: 73 65 74 21 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 set! *time-to-ex
e7c0: 69 74 2a 20 23 74 29 0a 28 74 68 72 65 61 64 2d it* #t).(thread-
e7d0: 6a 6f 69 6e 21 20 2a 77 61 74 63 68 64 6f 67 2a join! *watchdog*
e7e0: 29 0a 0a 28 69 66 20 28 6e 6f 74 20 28 65 71 3f )..(if (not (eq?
e7f0: 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 *globalexitstat
e800: 75 73 2a 20 30 29 29 0a 20 20 20 20 28 69 66 20 us* 0)). (if
e810: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
e820: 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 28 61 g "-runtests")(a
e830: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
e840: 6e 61 6c 6c 22 29 29 0a 20 20 20 20 20 20 20 20 nall")).
e850: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
e860: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
e870: 20 22 4e 4f 54 45 3a 20 53 75 62 70 72 6f 63 65 "NOTE: Subproce
e880: 73 73 65 73 20 77 69 74 68 20 6e 6f 6e 2d 7a 65 sses with non-ze
e890: 72 6f 20 65 78 69 74 20 63 6f 64 65 20 64 65 74 ro exit code det
e8a0: 65 63 74 65 64 3a 20 22 20 2a 67 6c 6f 62 61 6c ected: " *global
e8b0: 65 78 69 74 73 74 61 74 75 73 2a 29 0a 20 20 20 exitstatus*).
e8c0: 20 20 20 20 20 20 20 20 28 65 78 69 74 20 30 29 (exit 0)
e8d0: 29 0a 20 20 20 20 20 20 20 20 28 63 61 73 65 20 ). (case
e8e0: 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 *globalexitstatu
e8f0: 73 2a 0a 20 20 20 20 20 20 20 20 20 28 28 30 29 s*. ((0)
e900: 28 65 78 69 74 20 30 29 29 0a 20 20 20 20 20 20 (exit 0)).
e910: 20 20 20 28 28 31 29 28 65 78 69 74 20 31 29 29 ((1)(exit 1))
e920: 0a 20 20 20 20 20 20 20 20 20 28 28 32 29 28 65 . ((2)(e
e930: 78 69 74 20 32 29 29 0a 20 20 20 20 20 20 20 20 xit 2)).
e940: 20 28 65 6c 73 65 20 28 65 78 69 74 20 33 29 29 (else (exit 3))
e950: 29 29 29 0a ))).