0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 20 6-2012, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 made available
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 .;; greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 ng file COPYING
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 for details..;;
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 .;; This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c ven the.;; impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 ied warranty of
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 PARTICULAR.;;
0140: 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 20 28 69 6e PURPOSE...;; (in
0150: 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 2e 73 63 clude "common.sc
0160: 6d 22 29 0a 3b 3b 20 28 69 6e 63 6c 75 64 65 20 m").;; (include
0170: 22 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f "megatest-versio
0180: 6e 2e 73 63 6d 22 29 0a 0a 3b 3b 20 66 61 6b 65 n.scm")..;; fake
0190: 20 6f 75 74 20 72 65 61 64 6c 69 6e 65 20 75 73 out readline us
01a0: 61 67 65 20 6f 66 20 74 6f 70 6c 65 76 65 6c 2d age of toplevel-
01b0: 63 6f 6d 6d 61 6e 64 0a 28 64 65 66 69 6e 65 20 command.(define
01c0: 28 74 6f 70 6c 65 76 65 6c 2d 63 6f 6d 6d 61 6e (toplevel-comman
01d0: 64 20 2e 20 61 29 20 23 66 29 0a 0a 28 75 73 65 d . a) #f)..(use
01e0: 20 73 71 6c 69 74 65 33 20 73 72 66 69 2d 31 20 sqlite3 srfi-1
01f0: 70 6f 73 69 78 20 72 65 67 65 78 20 72 65 67 65 posix regex rege
0200: 78 2d 63 61 73 65 20 73 72 66 69 2d 36 39 20 62 x-case srfi-69 b
0210: 61 73 65 36 34 20 72 65 61 64 6c 69 6e 65 20 61 ase64 readline a
0220: 70 72 6f 70 6f 73 20 6a 73 6f 6e 20 68 74 74 70 propos json http
0230: 2d 63 6c 69 65 6e 74 20 64 69 72 65 63 74 6f 72 -client director
0240: 79 2d 75 74 69 6c 73 20 72 70 63 20 3b 3b 20 28 y-utils rpc ;; (
0250: 73 72 66 69 20 31 38 29 20 65 78 74 72 61 73 29 srfi 18) extras)
0260: 0a 20 20 20 20 20 68 74 74 70 2d 63 6c 69 65 6e . http-clien
0270: 74 20 73 72 66 69 2d 31 38 20 65 78 74 72 61 73 t srfi-18 extras
0280: 20 66 6f 72 6d 61 74 29 20 3b 3b 20 20 7a 6d 71 format) ;; zmq
0290: 20 65 78 74 72 61 73 29 0a 0a 3b 3b 20 41 64 64 extras)..;; Add
02a0: 65 64 20 66 6f 72 20 63 73 76 20 73 74 75 66 66 ed for csv stuff
02b0: 20 2d 20 77 69 6c 6c 20 62 65 20 72 65 6d 6f 76 - will be remov
02c0: 65 64 0a 3b 3b 0a 28 75 73 65 20 73 70 61 72 73 ed.;;.(use spars
02d0: 65 2d 76 65 63 74 6f 72 73 29 0a 0a 28 69 6d 70 e-vectors)..(imp
02e0: 6f 72 74 20 28 70 72 65 66 69 78 20 73 71 6c 69 ort (prefix sqli
02f0: 74 65 33 20 73 71 6c 69 74 65 33 3a 29 29 0a 28 te3 sqlite3:)).(
0300: 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 62 import (prefix b
0310: 61 73 65 36 34 20 62 61 73 65 36 34 3a 29 29 0a ase64 base64:)).
0320: 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 (import (prefix
0330: 72 70 63 20 72 70 63 3a 29 29 0a 28 72 65 71 75 rpc rpc:)).(requ
0340: 69 72 65 2d 6c 69 62 72 61 72 79 20 6d 75 74 69 ire-library muti
0350: 6c 73 29 0a 0a 3b 3b 20 28 75 73 65 20 7a 6d 71 ls)..;; (use zmq
0360: 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )..(declare (use
0370: 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c s common)).(decl
0380: 61 72 65 20 28 75 73 65 73 20 6d 65 67 61 74 65 are (uses megate
0390: 73 74 2d 76 65 72 73 69 6f 6e 29 29 0a 28 64 65 st-version)).(de
03a0: 63 6c 61 72 65 20 28 75 73 65 73 20 6d 61 72 67 clare (uses marg
03b0: 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 s)).(declare (us
03c0: 65 73 20 72 75 6e 73 29 29 0a 28 64 65 63 6c 61 es runs)).(decla
03d0: 72 65 20 28 75 73 65 73 20 6c 61 75 6e 63 68 29 re (uses launch)
03e0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
03f0: 20 73 65 72 76 65 72 29 29 0a 28 64 65 63 6c 61 server)).(decla
0400: 72 65 20 28 75 73 65 73 20 63 6c 69 65 6e 74 29 re (uses client)
0410: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0420: 20 74 65 73 74 73 29 29 0a 28 64 65 63 6c 61 72 tests)).(declar
0430: 65 20 28 75 73 65 73 20 67 65 6e 65 78 61 6d 70 e (uses genexamp
0440: 6c 65 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 le)).(declare (u
0450: 73 65 73 20 64 61 65 6d 6f 6e 29 29 0a 28 64 65 ses daemon)).(de
0460: 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 29 29 clare (uses db))
0470: 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 75 73 .;; (declare (us
0480: 65 73 20 64 63 6f 6d 6d 6f 6e 29 29 0a 0a 28 64 es dcommon))..(d
0490: 65 63 6c 61 72 65 20 28 75 73 65 73 20 74 64 62 eclare (uses tdb
04a0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
04b0: 73 20 6d 74 29 29 0a 28 64 65 63 6c 61 72 65 20 s mt)).(declare
04c0: 28 75 73 65 73 20 61 70 69 29 29 0a 28 64 65 63 (uses api)).(dec
04d0: 6c 61 72 65 20 28 75 73 65 73 20 74 61 73 6b 73 lare (uses tasks
04e0: 29 29 20 3b 3b 20 6f 6e 6c 79 20 75 73 65 64 20 )) ;; only used
04f0: 66 6f 72 20 64 65 62 75 67 67 69 6e 67 2e 0a 28 for debugging..(
0500: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 65 6e declare (uses en
0510: 76 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 62 v))..(define *db
0520: 2a 20 23 66 29 20 3b 3b 20 74 68 69 73 20 69 73 * #f) ;; this is
0530: 20 6f 6e 6c 79 20 66 6f 72 20 74 68 65 20 72 65 only for the re
0540: 70 6c 2c 20 64 6f 20 6e 6f 74 20 75 73 65 20 69 pl, do not use i
0550: 6e 20 67 65 6e 65 72 61 6c 21 21 21 21 0a 0a 28 n general!!!!..(
0560: 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f include "common_
0570: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 records.scm").(i
0580: 6e 63 6c 75 64 65 20 22 6b 65 79 5f 72 65 63 6f nclude "key_reco
0590: 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 rds.scm").(inclu
05a0: 64 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 de "db_records.s
05b0: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 cm").(include "r
05c0: 75 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 un_records.scm")
05d0: 0a 28 69 6e 63 6c 75 64 65 20 22 6d 65 67 61 74 .(include "megat
05e0: 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 2e est-fossil-hash.
05f0: 73 63 6d 22 29 0a 0a 28 6c 65 74 20 28 28 64 65 scm")..(let ((de
0600: 62 75 67 63 6f 6e 74 72 6f 6c 66 20 28 63 6f 6e bugcontrolf (con
0610: 63 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 c (get-environme
0620: 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f 4d nt-variable "HOM
0630: 45 22 29 20 22 2f 2e 6d 65 67 61 74 65 73 74 72 E") "/.megatestr
0640: 63 22 29 29 29 0a 20 20 28 69 66 20 28 66 69 6c c"))). (if (fil
0650: 65 2d 65 78 69 73 74 73 3f 20 64 65 62 75 67 63 e-exists? debugc
0660: 6f 6e 74 72 6f 6c 66 29 0a 20 20 20 20 20 20 28 ontrolf). (
0670: 6c 6f 61 64 20 64 65 62 75 67 63 6f 6e 74 72 6f load debugcontro
0680: 6c 66 29 29 29 0a 0a 3b 3b 20 44 69 73 61 62 6c lf)))..;; Disabl
0690: 65 64 20 68 65 6c 70 20 69 74 65 6d 73 0a 3b 3b ed help items.;;
06a0: 20 20 2d 72 6f 6c 6c 75 70 20 20 20 20 20 20 20 -rollup
06b0: 20 20 20 20 20 20 20 20 20 20 3a 20 28 63 75 72 : (cur
06c0: 72 65 6e 74 6c 79 20 64 69 73 61 62 6c 65 64 29 rently disabled)
06d0: 20 66 69 6c 6c 20 72 75 6e 20 28 73 65 74 20 62 fill run (set b
06e0: 79 20 3a 72 75 6e 6e 61 6d 65 29 20 20 77 69 74 y :runname) wit
06f0: 68 20 6c 61 74 65 73 74 20 74 65 73 74 28 73 29 h latest test(s)
0700: 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
0710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 f
0720: 72 6f 6d 20 70 72 69 6f 72 20 72 75 6e 73 20 77 rom prior runs w
0730: 69 74 68 20 73 61 6d 65 20 6b 65 79 73 0a 0a 28 ith same keys..(
0740: 64 65 66 69 6e 65 20 68 65 6c 70 20 28 63 6f 6e define help (con
0750: 63 20 22 0a 4d 65 67 61 74 65 73 74 2c 20 64 6f c ".Megatest, do
0760: 63 75 6d 65 6e 74 61 74 69 6f 6e 20 61 74 20 68 cumentation at h
0770: 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 ttp://www.kiatoa
0780: 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 .com/fossils/meg
0790: 61 74 65 73 74 0a 20 20 76 65 72 73 69 6f 6e 20 atest. version
07a0: 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 " megatest-versi
07b0: 6f 6e 20 22 0a 20 20 6c 69 63 65 6e 73 65 20 47 on ". license G
07c0: 50 4c 2c 20 43 6f 70 79 72 69 67 68 74 20 4d 61 PL, Copyright Ma
07d0: 74 74 20 57 65 6c 6c 61 6e 64 20 32 30 30 36 2d tt Welland 2006-
07e0: 32 30 31 35 0a 0a 55 73 61 67 65 3a 20 6d 65 67 2015..Usage: meg
07f0: 61 74 65 73 74 20 5b 6f 70 74 69 6f 6e 73 5d 0a atest [options].
0800: 20 20 2d 68 20 20 20 20 20 20 20 20 20 20 20 20 -h
0810: 20 20 20 20 20 20 20 20 20 20 3a 20 74 68 69 73 : this
0820: 20 68 65 6c 70 0a 20 20 2d 76 65 72 73 69 6f 6e help. -version
0830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0840: 3a 20 70 72 69 6e 74 20 6d 65 67 61 74 65 73 74 : print megatest
0850: 20 76 65 72 73 69 6f 6e 20 28 63 75 72 72 65 6e version (curren
0860: 74 6c 79 20 22 20 6d 65 67 61 74 65 73 74 2d 76 tly " megatest-v
0870: 65 72 73 69 6f 6e 20 22 29 0a 0a 4c 61 75 6e 63 ersion ")..Launc
0880: 68 69 6e 67 20 61 6e 64 20 6d 61 6e 61 67 69 6e hing and managin
0890: 67 20 72 75 6e 73 0a 20 20 2d 72 75 6e 61 6c 6c g runs. -runall
08a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
08b0: 20 3a 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 : run all tests
08c0: 20 6f 72 20 61 73 20 73 70 65 63 69 66 69 65 64 or as specified
08d0: 20 62 79 20 2d 74 65 73 74 70 61 74 74 0a 20 20 by -testpatt.
08e0: 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 20 20 20 20 -remove-runs
08f0: 20 20 20 20 20 20 20 20 3a 20 72 65 6d 6f 76 65 : remove
0900: 20 74 68 65 20 64 61 74 61 20 66 6f 72 20 61 20 the data for a
0910: 72 75 6e 2c 20 72 65 71 75 69 72 65 73 20 2d 72 run, requires -r
0920: 75 6e 6e 61 6d 65 20 61 6e 64 20 2d 74 65 73 74 unname and -test
0930: 70 61 74 74 0a 20 20 20 20 20 20 20 20 20 20 20 patt.
0940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0950: 20 4f 70 74 69 6f 6e 61 6c 6c 79 20 75 73 65 20 Optionally use
0960: 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 :state and :stat
0970: 75 73 0a 20 20 2d 73 65 74 2d 73 74 61 74 65 2d us. -set-state-
0980: 73 74 61 74 75 73 20 58 2c 59 20 20 20 3a 20 73 status X,Y : s
0990: 65 74 20 73 74 61 74 65 20 74 6f 20 58 20 61 6e et state to X an
09a0: 64 20 73 74 61 74 75 73 20 74 6f 20 59 2c 20 72 d status to Y, r
09b0: 65 71 75 69 72 65 73 20 63 6f 6e 74 72 6f 6c 73 equires controls
09c0: 20 70 65 72 20 2d 72 65 6d 6f 76 65 2d 72 75 6e per -remove-run
09d0: 73 0a 20 20 2d 72 65 72 75 6e 20 46 41 49 4c 2c s. -rerun FAIL,
09e0: 57 41 52 4e 2e 2e 2e 20 20 20 20 20 3a 20 66 6f WARN... : fo
09f0: 72 63 65 20 72 65 2d 72 75 6e 20 66 6f 72 20 74 rce re-run for t
0a00: 65 73 74 73 20 77 69 74 68 20 73 70 65 63 69 66 ests with specif
0a10: 69 63 65 64 20 73 74 61 74 75 73 28 73 29 0a 20 iced status(s).
0a20: 20 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 20 20 20 -rerun-clean
0a30: 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 61 : set a
0a40: 6c 6c 20 74 65 73 74 73 20 6e 6f 74 20 43 4f 4d ll tests not COM
0a50: 50 4c 45 54 45 44 2b 50 41 53 53 2c 57 41 52 4e PLETED+PASS,WARN
0a60: 2c 57 41 49 56 45 44 20 74 6f 20 4e 4f 54 5f 53 ,WAIVED to NOT_S
0a70: 54 41 52 54 45 44 2c 6e 2f 61 0a 20 20 20 20 20 TARTED,n/a.
0a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a90: 20 20 20 20 20 20 20 61 6e 64 20 74 68 65 6e 20 and then
0aa0: 72 75 6e 20 74 68 65 20 73 70 65 63 69 66 69 65 run the specifie
0ab0: 64 20 74 65 73 74 70 61 74 74 20 77 69 74 68 20 d testpatt with
0ac0: 2d 70 72 65 63 6c 65 61 6e 0a 20 20 2d 72 65 72 -preclean. -rer
0ad0: 75 6e 2d 61 6c 6c 20 20 20 20 20 20 20 20 20 20 un-all
0ae0: 20 20 20 20 3a 20 73 65 74 20 61 6c 6c 20 74 65 : set all te
0af0: 73 74 73 20 74 6f 20 4e 4f 54 5f 53 54 41 52 54 sts to NOT_START
0b00: 45 44 2c 6e 2f 61 20 61 6e 64 20 72 75 6e 20 77 ED,n/a and run w
0b10: 69 74 68 20 2d 70 72 65 63 6c 65 61 6e 0a 20 20 ith -preclean.
0b20: 2d 6c 6f 63 6b 20 20 20 20 20 20 20 20 20 20 20 -lock
0b30: 20 20 20 20 20 20 20 20 3a 20 6c 6f 63 6b 20 72 : lock r
0b40: 75 6e 20 73 70 65 63 69 66 69 65 64 20 62 79 20 un specified by
0b50: 74 61 72 67 65 74 20 61 6e 64 20 72 75 6e 6e 61 target and runna
0b60: 6d 65 0a 20 20 2d 75 6e 6c 6f 63 6b 20 20 20 20 me. -unlock
0b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 75 : u
0b80: 6e 6c 6f 63 6b 20 72 75 6e 20 73 70 65 63 69 66 nlock run specif
0b90: 69 65 64 20 62 79 20 74 61 72 67 65 74 20 61 6e ied by target an
0ba0: 64 20 72 75 6e 6e 61 6d 65 0a 20 20 2d 73 65 74 d runname. -set
0bb0: 2d 72 75 6e 2d 73 74 61 74 75 73 20 73 74 61 74 -run-status stat
0bc0: 75 73 20 20 3a 20 73 65 74 73 20 73 74 61 74 75 us : sets statu
0bd0: 73 20 66 6f 72 20 72 75 6e 20 74 6f 20 73 74 61 s for run to sta
0be0: 74 75 73 2c 20 72 65 71 75 69 72 65 73 20 2d 74 tus, requires -t
0bf0: 61 72 67 65 74 20 61 6e 64 20 2d 72 75 6e 6e 61 arget and -runna
0c00: 6d 65 0a 20 20 2d 67 65 74 2d 72 75 6e 2d 73 74 me. -get-run-st
0c10: 61 74 75 73 20 20 20 20 20 20 20 20 20 3a 20 67 atus : g
0c20: 65 74 73 20 73 74 61 74 75 73 20 66 6f 72 20 72 ets status for r
0c30: 75 6e 20 73 70 65 63 69 66 69 65 64 20 62 79 20 un specified by
0c40: 74 61 72 67 65 74 20 61 6e 64 20 72 75 6e 6e 61 target and runna
0c50: 6d 65 0a 20 20 2d 72 75 6e 2d 77 61 69 74 20 20 me. -run-wait
0c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 77 : w
0c70: 61 69 74 20 6f 6e 20 72 75 6e 20 73 70 65 63 69 ait on run speci
0c80: 66 69 65 64 20 62 79 20 74 61 72 67 65 74 20 61 fied by target a
0c90: 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 20 2d 70 72 nd runname. -pr
0ca0: 65 63 6c 65 61 6e 20 20 20 20 20 20 20 20 20 20 eclean
0cb0: 20 20 20 20 20 3a 20 72 65 6d 6f 76 65 20 74 68 : remove th
0cc0: 65 20 65 78 69 73 74 69 6e 67 20 74 65 73 74 20 e existing test
0cd0: 64 69 72 65 63 74 6f 72 79 20 62 65 66 6f 72 65 directory before
0ce0: 20 72 75 6e 6e 69 6e 67 20 74 68 65 20 74 65 73 running the tes
0cf0: 74 0a 20 20 2d 63 6c 65 61 6e 2d 63 61 63 68 65 t. -clean-cache
0d00: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 : re
0d10: 6d 6f 76 65 20 74 68 65 20 63 61 63 68 65 64 20 move the cached
0d20: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 megatest.config
0d30: 61 6e 64 20 72 75 6e 63 6f 6e 66 69 67 2e 63 6f and runconfig.co
0d40: 6e 66 69 67 20 66 69 6c 65 73 0a 0a 53 65 6c 65 nfig files..Sele
0d50: 63 74 6f 72 73 20 28 65 2e 67 2e 20 75 73 65 20 ctors (e.g. use
0d60: 66 6f 72 20 2d 72 75 6e 74 65 73 74 73 2c 20 2d for -runtests, -
0d70: 72 65 6d 6f 76 65 2d 72 75 6e 73 2c 20 2d 73 65 remove-runs, -se
0d80: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2c 20 t-state-status,
0d90: 2d 6c 69 73 74 2d 72 75 6e 73 20 65 74 63 2e 29 -list-runs etc.)
0da0: 0a 20 20 2d 74 61 72 67 65 74 20 6b 65 79 31 2f . -target key1/
0db0: 6b 65 79 32 2f 2e 2e 2e 20 20 20 3a 20 72 75 6e key2/... : run
0dc0: 20 66 6f 72 20 6b 65 79 31 2c 20 6b 65 79 32 2c for key1, key2,
0dd0: 20 65 74 63 2e 0a 20 20 2d 72 65 71 74 61 72 67 etc.. -reqtarg
0de0: 20 6b 65 79 31 2f 6b 65 79 32 2f 2e 2e 2e 20 20 key1/key2/...
0df0: 3a 20 72 75 6e 20 66 6f 72 20 6b 65 79 31 2c 20 : run for key1,
0e00: 6b 65 79 32 2c 20 65 74 63 2e 20 62 75 74 20 6b key2, etc. but k
0e10: 65 79 31 2f 6b 65 79 32 20 6d 75 73 74 20 62 65 ey1/key2 must be
0e20: 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 0a 20 20 in runconfig.
0e30: 2d 74 65 73 74 70 61 74 74 20 70 61 74 74 31 2f -testpatt patt1/
0e40: 70 61 74 74 32 2c 70 61 74 74 33 2f 2e 2e 2e 20 patt2,patt3/...
0e50: 20 3a 20 25 20 69 73 20 77 69 6c 64 63 61 72 64 : % is wildcard
0e60: 0a 20 20 2d 72 75 6e 6e 61 6d 65 20 20 20 20 20 . -runname
0e70: 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 71 : req
0e80: 75 69 72 65 64 2c 20 6e 61 6d 65 20 66 6f 72 20 uired, name for
0e90: 74 68 69 73 20 70 61 72 74 69 63 75 6c 61 72 20 this particular
0ea0: 74 65 73 74 20 72 75 6e 0a 20 20 2d 73 74 61 74 test run. -stat
0eb0: 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e
0ec0: 20 20 20 3a 20 41 70 70 6c 69 65 73 20 74 6f 20 : Applies to
0ed0: 72 75 6e 73 2c 20 74 65 73 74 73 20 6f 72 20 73 runs, tests or s
0ee0: 74 65 70 73 20 64 65 70 65 6e 64 69 6e 67 20 6f teps depending o
0ef0: 6e 20 63 6f 6e 74 65 78 74 0a 20 20 2d 73 74 61 n context. -sta
0f00: 74 75 73 20 20 20 20 20 20 20 20 20 20 20 20 20 tus
0f10: 20 20 20 20 3a 20 41 70 70 6c 69 65 73 20 74 6f : Applies to
0f20: 20 72 75 6e 73 2c 20 74 65 73 74 73 20 6f 72 20 runs, tests or
0f30: 73 74 65 70 73 20 64 65 70 65 6e 64 69 6e 67 20 steps depending
0f40: 6f 6e 20 63 6f 6e 74 65 78 74 0a 0a 54 65 73 74 on context..Test
0f50: 20 68 65 6c 70 65 72 73 20 28 66 6f 72 20 75 73 helpers (for us
0f60: 65 20 69 6e 73 69 64 65 20 74 65 73 74 73 29 0a e inside tests).
0f70: 20 20 2d 73 74 65 70 20 73 74 65 70 6e 61 6d 65 -step stepname
0f80: 0a 20 20 2d 74 65 73 74 2d 73 74 61 74 75 73 20 . -test-status
0f90: 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 : set
0fa0: 20 74 68 65 20 73 74 61 74 65 20 61 6e 64 20 73 the state and s
0fb0: 74 61 74 75 73 20 6f 66 20 61 20 74 65 73 74 20 tatus of a test
0fc0: 28 75 73 65 20 3a 73 74 61 74 65 20 61 6e 64 20 (use :state and
0fd0: 3a 73 74 61 74 75 73 29 0a 20 20 2d 73 65 74 6c :status). -setl
0fe0: 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 20 og logfname
0ff0: 20 20 20 3a 20 73 65 74 20 74 68 65 20 70 61 74 : set the pat
1000: 68 2f 66 69 6c 65 6e 61 6d 65 20 74 6f 20 74 68 h/filename to th
1010: 65 20 66 69 6e 61 6c 20 6c 6f 67 20 72 65 6c 61 e final log rela
1020: 74 69 76 65 20 74 6f 20 74 68 65 20 74 65 73 74 tive to the test
1030: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1040: 20 20 20 20 20 20 20 20 20 20 20 20 20 64 69 72 dir
1050: 65 63 74 6f 72 79 2e 20 6d 61 79 20 62 65 20 75 ectory. may be u
1060: 73 65 64 20 77 69 74 68 20 2d 74 65 73 74 2d 73 sed with -test-s
1070: 74 61 74 75 73 0a 20 20 2d 73 65 74 2d 74 6f 70 tatus. -set-top
1080: 6c 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 log logfname
1090: 3a 20 73 65 74 20 74 68 65 20 6f 76 65 72 61 6c : set the overal
10a0: 6c 20 6c 6f 67 20 66 6f 72 20 61 20 73 75 69 74 l log for a suit
10b0: 65 20 6f 66 20 73 75 62 2d 74 65 73 74 73 0a 20 e of sub-tests.
10c0: 20 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d -summarize-item
10d0: 73 20 20 20 20 20 20 20 20 3a 20 66 6f 72 20 61 s : for a
10e0: 6e 20 69 74 65 6d 69 7a 65 64 20 74 65 73 74 20 n itemized test
10f0: 63 72 65 61 74 65 20 61 20 73 75 6d 6d 61 72 79 create a summary
1100: 20 68 74 6d 6c 20 0a 20 20 2d 6d 20 63 6f 6d 6d html . -m comm
1110: 65 6e 74 20 20 20 20 20 20 20 20 20 20 20 20 20 ent
1120: 20 3a 20 69 6e 73 65 72 74 20 61 20 63 6f 6d 6d : insert a comm
1130: 65 6e 74 20 66 6f 72 20 74 68 69 73 20 74 65 73 ent for this tes
1140: 74 0a 0a 54 65 73 74 20 64 61 74 61 20 63 61 70 t..Test data cap
1150: 74 75 72 65 0a 20 20 2d 73 65 74 2d 76 61 6c 75 ture. -set-valu
1160: 65 73 20 20 20 20 20 20 20 20 20 20 20 20 20 3a es :
1170: 20 75 70 64 61 74 65 20 6f 72 20 73 65 74 20 76 update or set v
1180: 61 6c 75 65 73 20 69 6e 20 74 68 65 20 74 65 73 alues in the tes
1190: 74 64 61 74 61 20 74 61 62 6c 65 0a 20 20 3a 63 tdata table. :c
11a0: 61 74 65 67 6f 72 79 20 20 20 20 20 20 20 20 20 ategory
11b0: 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 : set the
11c0: 63 61 74 65 67 6f 72 79 20 66 69 65 6c 64 20 28 category field (
11d0: 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 72 optional). :var
11e0: 69 61 62 6c 65 20 20 20 20 20 20 20 20 20 20 20 iable
11f0: 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 76 61 : set the va
1200: 72 69 61 62 6c 65 20 6e 61 6d 65 20 28 6f 70 74 riable name (opt
1210: 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 6c 75 65 20 ional). :value
1220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1230: 20 3a 20 76 61 6c 75 65 20 6d 65 61 73 75 72 65 : value measure
1240: 64 20 28 72 65 71 75 69 72 65 64 29 0a 20 20 3a d (required). :
1250: 65 78 70 65 63 74 65 64 20 20 20 20 20 20 20 20 expected
1260: 20 20 20 20 20 20 20 3a 20 76 61 6c 75 65 20 65 : value e
1270: 78 70 65 63 74 65 64 20 28 72 65 71 75 69 72 65 xpected (require
1280: 64 29 0a 20 20 3a 74 6f 6c 20 20 20 20 20 20 20 d). :tol
1290: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 7c : |
12a0: 76 61 6c 75 65 2d 65 78 70 65 63 74 7c 20 3c 3d value-expect| <=
12b0: 20 74 6f 6c 20 28 72 65 71 75 69 72 65 64 2c 20 tol (required,
12c0: 63 61 6e 20 62 65 20 3c 2c 20 3e 2c 20 3e 3d 2c can be <, >, >=,
12d0: 20 3c 3d 20 6f 72 20 6e 75 6d 62 65 72 29 0a 20 <= or number).
12e0: 20 3a 75 6e 69 74 73 20 20 20 20 20 20 20 20 20 :units
12f0: 20 20 20 20 20 20 20 20 20 3a 20 6e 61 6d 65 20 : name
1300: 6f 66 20 74 68 65 20 75 6e 69 74 73 20 66 6f 72 of the units for
1310: 20 76 61 6c 75 65 2c 20 65 78 70 65 63 74 65 64 value, expected
1320: 5f 76 61 6c 75 65 20 65 74 63 2e 20 28 6f 70 74 _value etc. (opt
1330: 69 6f 6e 61 6c 29 0a 20 20 2d 6c 6f 61 64 2d 74 ional). -load-t
1340: 65 73 74 2d 64 61 74 61 20 20 20 20 20 20 20 20 est-data
1350: 20 3a 20 72 65 61 64 20 74 65 73 74 20 73 70 65 : read test spe
1360: 63 69 66 69 63 20 64 61 74 61 20 66 6f 72 20 73 cific data for s
1370: 74 6f 72 61 67 65 20 69 6e 20 74 68 65 20 74 65 torage in the te
1380: 73 74 5f 64 61 74 61 20 74 61 62 6c 65 0a 20 20 st_data table.
1390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13a0: 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d 20 73 from s
13b0: 74 61 6e 64 61 72 64 20 69 6e 2e 20 45 61 63 68 tandard in. Each
13c0: 20 6c 69 6e 65 20 69 73 20 63 6f 6d 6d 61 20 64 line is comma d
13d0: 65 6c 69 6d 69 74 65 64 20 77 69 74 68 20 66 6f elimited with fo
13e0: 75 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ur.
13f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 f
1400: 69 65 6c 64 73 20 63 61 74 65 67 6f 72 79 2c 76 ields category,v
1410: 61 72 69 61 62 6c 65 2c 76 61 6c 75 65 2c 63 6f ariable,value,co
1420: 6d 6d 65 6e 74 0a 0a 51 75 65 72 69 65 73 0a 20 mment..Queries.
1430: 20 2d 6c 69 73 74 2d 72 75 6e 73 20 70 61 74 74 -list-runs patt
1440: 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 : list
1450: 72 75 6e 73 20 6d 61 74 63 68 69 6e 67 20 70 61 runs matching pa
1460: 74 74 65 72 6e 20 5c 22 70 61 74 74 5c 22 2c 20 ttern \"patt\",
1470: 25 20 69 73 20 74 68 65 20 77 69 6c 64 63 61 72 % is the wildcar
1480: 64 0a 20 20 2d 73 68 6f 77 2d 6b 65 79 73 20 20 d. -show-keys
1490: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 68 : sh
14a0: 6f 77 20 74 68 65 20 6b 65 79 73 20 75 73 65 64 ow the keys used
14b0: 20 69 6e 20 74 68 69 73 20 6d 65 67 61 74 65 73 in this megates
14c0: 74 20 73 65 74 75 70 0a 20 20 2d 74 65 73 74 2d t setup. -test-
14d0: 66 69 6c 65 73 20 74 61 72 67 70 61 74 74 20 20 files targpatt
14e0: 20 20 3a 20 67 65 74 20 74 68 65 20 6d 6f 73 74 : get the most
14f0: 20 72 65 63 65 6e 74 20 74 65 73 74 20 70 61 74 recent test pat
1500: 68 2f 66 69 6c 65 20 6d 61 74 63 68 69 6e 67 20 h/file matching
1510: 74 61 72 67 70 61 74 74 20 65 2e 67 2e 20 25 2f targpatt e.g. %/
1520: 25 2e 2e 2e 20 0a 20 20 20 20 20 20 20 20 20 20 %... .
1530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1540: 20 20 72 65 74 75 72 6e 73 20 6c 69 73 74 20 73 returns list s
1550: 6f 72 74 65 64 20 62 79 20 61 67 65 20 61 73 63 orted by age asc
1560: 65 6e 64 69 6e 67 2c 20 73 65 65 20 65 78 61 6d ending, see exam
1570: 70 6c 65 73 20 62 65 6c 6f 77 0a 20 20 2d 74 65 ples below. -te
1580: 73 74 2d 70 61 74 68 73 20 20 20 20 20 20 20 20 st-paths
1590: 20 20 20 20 20 3a 20 67 65 74 20 74 68 65 20 74 : get the t
15a0: 65 73 74 20 70 61 74 68 73 20 6d 61 74 63 68 69 est paths matchi
15b0: 6e 67 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 ng target, runna
15c0: 6d 65 2c 20 69 74 65 6d 20 61 6e 64 20 74 65 73 me, item and tes
15d0: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
15e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 61 pa
15f0: 74 74 65 72 6e 73 2e 0a 20 20 2d 6c 69 73 74 2d tterns.. -list-
1600: 64 69 73 6b 73 20 20 20 20 20 20 20 20 20 20 20 disks
1610: 20 20 3a 20 6c 69 73 74 20 74 68 65 20 64 69 73 : list the dis
1620: 6b 73 20 61 76 61 69 6c 61 62 6c 65 20 66 6f 72 ks available for
1630: 20 73 74 6f 72 69 6e 67 20 72 75 6e 73 0a 20 20 storing runs.
1640: 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 20 20 20 -list-targets
1650: 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 : list t
1660: 68 65 20 74 61 72 67 65 74 73 20 69 6e 20 72 75 he targets in ru
1670: 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 0a nconfigs.config.
1680: 20 20 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 -list-db-targe
1690: 74 73 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 ts : list
16a0: 20 74 68 65 20 74 61 72 67 65 74 20 63 6f 6d 62 the target comb
16b0: 69 6e 61 74 69 6f 6e 73 20 75 73 65 64 20 69 6e inations used in
16c0: 20 74 68 65 20 64 62 0a 20 20 2d 73 68 6f 77 2d the db. -show-
16d0: 63 6f 6e 66 69 67 20 20 20 20 20 20 20 20 20 20 config
16e0: 20 20 3a 20 64 75 6d 70 20 74 68 65 20 69 6e 74 : dump the int
16f0: 65 72 6e 61 6c 20 72 65 70 72 65 73 65 6e 74 61 ernal representa
1700: 74 69 6f 6e 20 6f 66 20 74 68 65 20 6d 65 67 61 tion of the mega
1710: 74 65 73 74 2e 63 6f 6e 66 69 67 20 66 69 6c 65 test.config file
1720: 0a 20 20 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 . -show-runconf
1730: 69 67 20 20 20 20 20 20 20 20 20 3a 20 64 75 6d ig : dum
1740: 70 20 74 68 65 20 69 6e 74 65 72 6e 61 6c 20 72 p the internal r
1750: 65 70 72 65 73 65 6e 74 61 74 69 6f 6e 20 6f 66 epresentation of
1760: 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 73 2e the runconfigs.
1770: 63 6f 6e 66 69 67 20 66 69 6c 65 0a 20 20 2d 64 config file. -d
1780: 75 6d 70 6d 6f 64 65 20 4d 4f 44 45 20 20 20 20 umpmode MODE
1790: 20 20 20 20 20 20 3a 20 64 75 6d 70 20 69 6e 20 : dump in
17a0: 4d 4f 44 45 20 66 6f 72 6d 61 74 20 69 6e 73 74 MODE format inst
17b0: 65 61 64 20 6f 66 20 73 65 78 70 72 2c 20 4d 4f ead of sexpr, MO
17c0: 44 45 3d 6a 73 6f 6e 2c 69 6e 69 2c 73 65 78 70 DE=json,ini,sexp
17d0: 20 65 74 63 2e 0a 20 20 2d 73 68 6f 77 2d 63 6d etc.. -show-cm
17e0: 64 69 6e 66 6f 20 20 20 20 20 20 20 20 20 20 20 dinfo
17f0: 3a 20 64 75 6d 70 20 74 68 65 20 63 6f 6d 6d 61 : dump the comma
1800: 6e 64 20 69 6e 66 6f 20 66 6f 72 20 61 20 74 65 nd info for a te
1810: 73 74 20 28 72 75 6e 20 69 6e 20 74 65 73 74 20 st (run in test
1820: 65 6e 76 69 72 6f 6e 6d 65 6e 74 29 0a 20 20 2d environment). -
1830: 73 65 63 74 69 6f 6e 20 73 65 63 74 69 6f 6e 4e section sectionN
1840: 61 6d 65 0a 20 20 2d 76 61 72 20 76 61 72 4e 61 ame. -var varNa
1850: 6d 65 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 me :
1860: 66 6f 72 20 63 6f 6e 66 69 67 20 61 6e 64 20 72 for config and r
1870: 75 6e 63 6f 6e 66 69 67 20 6c 6f 6f 6b 75 70 20 unconfig lookup
1880: 76 61 6c 75 65 20 66 6f 72 20 73 65 63 74 69 6f value for sectio
1890: 6e 4e 61 6d 65 20 76 61 72 4e 61 6d 65 0a 20 20 nName varName.
18a0: 2d 73 69 6e 63 65 20 4e 20 20 20 20 20 20 20 20 -since N
18b0: 20 20 20 20 20 20 20 20 3a 20 67 65 74 20 6c 69 : get li
18c0: 73 74 20 6f 66 20 72 75 6e 73 20 63 68 61 6e 67 st of runs chang
18d0: 65 64 20 73 69 6e 63 65 20 74 69 6d 65 20 4e 20 ed since time N
18e0: 28 55 6e 69 78 20 73 65 63 6f 6e 64 73 29 0a 20 (Unix seconds).
18f0: 20 2d 66 69 65 6c 64 73 20 66 69 65 6c 64 73 70 -fields fieldsp
1900: 65 63 20 20 20 20 20 20 20 3a 20 66 69 65 6c 64 ec : field
1910: 73 20 74 6f 20 69 6e 63 6c 75 64 65 20 69 6e 20 s to include in
1920: 6a 73 6f 6e 20 64 75 6d 70 3b 20 72 75 6e 73 3a json dump; runs:
1930: 69 64 2c 72 75 6e 61 6d 65 2b 74 65 73 74 73 3a id,runame+tests:
1940: 74 65 73 74 6e 61 6d 65 2b 73 74 65 70 73 0a 20 testname+steps.
1950: 20 2d 73 6f 72 74 20 66 69 65 6c 64 6e 61 6d 65 -sort fieldname
1960: 20 20 20 20 20 20 20 20 20 3a 20 69 6e 20 2d 6c : in -l
1970: 69 73 74 2d 72 75 6e 73 20 73 6f 72 74 20 74 65 ist-runs sort te
1980: 73 74 73 20 62 79 20 74 68 69 73 20 66 69 65 6c sts by this fiel
1990: 64 0a 0a 4d 69 73 63 20 0a 20 20 2d 73 74 61 72 d..Misc . -star
19a0: 74 2d 64 69 72 20 70 61 74 68 20 20 20 20 20 20 t-dir path
19b0: 20 20 20 3a 20 73 77 69 74 63 68 20 74 6f 20 74 : switch to t
19c0: 68 69 73 20 64 69 72 65 63 74 6f 72 79 20 62 65 his directory be
19d0: 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 6d 65 67 fore running meg
19e0: 61 74 65 73 74 0a 20 20 2d 72 65 62 75 69 6c 64 atest. -rebuild
19f0: 2d 64 62 20 20 20 20 20 20 20 20 20 20 20 20 20 -db
1a00: 3a 20 62 72 69 6e 67 20 74 68 65 20 64 61 74 61 : bring the data
1a10: 62 61 73 65 20 73 63 68 65 6d 61 20 75 70 20 74 base schema up t
1a20: 6f 20 64 61 74 65 0a 20 20 2d 63 6c 65 61 6e 75 o date. -cleanu
1a30: 70 2d 64 62 20 20 20 20 20 20 20 20 20 20 20 20 p-db
1a40: 20 3a 20 72 65 6d 6f 76 65 20 61 6e 79 20 6f 72 : remove any or
1a50: 70 68 61 6e 20 72 65 63 6f 72 64 73 2c 20 76 61 phan records, va
1a60: 63 75 75 6d 20 74 68 65 20 64 62 0a 20 20 2d 69 cuum the db. -i
1a70: 6d 70 6f 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 mport-megatest.d
1a80: 62 20 20 20 20 20 3a 20 6d 69 67 72 61 74 65 20 b : migrate
1a90: 61 20 64 61 74 61 62 61 73 65 20 66 72 6f 6d 20 a database from
1aa0: 76 31 2e 35 35 20 73 65 72 69 65 73 20 74 6f 20 v1.55 series to
1ab0: 76 31 2e 36 30 20 73 65 72 69 65 73 0a 20 20 2d v1.60 series. -
1ac0: 73 79 6e 63 2d 74 6f 2d 6d 65 67 61 74 65 73 74 sync-to-megatest
1ad0: 2e 64 62 20 20 20 20 3a 20 6d 69 67 72 61 74 65 .db : migrate
1ae0: 20 64 61 74 61 20 62 61 63 6b 20 74 6f 20 6d 65 data back to me
1af0: 67 61 74 65 73 74 2e 64 62 0a 20 20 2d 75 70 64 gatest.db. -upd
1b00: 61 74 65 2d 6d 65 74 61 20 20 20 20 20 20 20 20 ate-meta
1b10: 20 20 20 20 3a 20 75 70 64 61 74 65 20 74 68 65 : update the
1b20: 20 74 65 73 74 73 20 6d 65 74 61 64 61 74 61 20 tests metadata
1b30: 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 0a 20 20 for all tests.
1b40: 2d 73 65 74 76 61 72 73 20 56 41 52 31 3d 76 61 -setvars VAR1=va
1b50: 6c 31 2c 56 41 52 32 3d 76 61 6c 32 20 3a 20 41 l1,VAR2=val2 : A
1b60: 64 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 dd environment v
1b70: 61 72 69 61 62 6c 65 73 20 74 6f 20 61 20 72 75 ariables to a ru
1b80: 6e 20 4e 42 2f 2f 20 74 68 65 73 65 20 61 72 65 n NB// these are
1b90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bb0: 20 20 6f 76 65 72 77 72 69 74 74 65 6e 20 62 79 overwritten by
1bc0: 20 76 61 6c 75 65 73 20 73 65 74 20 69 6e 20 63 values set in c
1bd0: 6f 6e 66 69 67 20 66 69 6c 65 73 2e 0a 20 20 2d onfig files.. -
1be0: 73 65 72 76 65 72 20 2d 7c 68 6f 73 74 6e 61 6d server -|hostnam
1bf0: 65 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 74 e : start t
1c00: 68 65 20 73 65 72 76 65 72 20 28 72 65 64 75 63 he server (reduc
1c10: 65 73 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 6f 6e es contention on
1c20: 20 6d 65 67 61 74 65 73 74 2e 64 62 29 2c 20 75 megatest.db), u
1c30: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
1c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d -
1c50: 20 74 6f 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c to automaticall
1c60: 79 20 66 69 67 75 72 65 20 6f 75 74 20 68 6f 73 y figure out hos
1c70: 74 6e 61 6d 65 0a 20 20 2d 74 72 61 6e 73 70 6f tname. -transpo
1c80: 72 74 20 68 74 74 70 7c 72 70 63 20 20 20 20 20 rt http|rpc
1c90: 3a 20 75 73 65 20 68 74 74 70 20 6f 72 20 72 70 : use http or rp
1ca0: 63 20 66 6f 72 20 74 72 61 6e 73 70 6f 72 74 20 c for transport
1cb0: 28 64 65 66 61 75 6c 74 20 69 73 20 68 74 74 70 (default is http
1cc0: 29 20 0a 20 20 2d 64 61 65 6d 6f 6e 69 7a 65 20 ) . -daemonize
1cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 66 : f
1ce0: 6f 72 6b 20 69 6e 74 6f 20 62 61 63 6b 67 72 6f ork into backgro
1cf0: 75 6e 64 20 61 6e 64 20 64 69 73 63 6f 6e 6e 65 und and disconne
1d00: 63 74 20 66 72 6f 6d 20 73 74 64 69 6e 2f 6f 75 ct from stdin/ou
1d10: 74 0a 20 20 2d 6c 6f 67 20 6c 6f 67 66 69 6c 65 t. -log logfile
1d20: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 : se
1d30: 6e 64 20 73 74 64 6f 75 74 20 61 6e 64 20 73 74 nd stdout and st
1d40: 64 65 72 72 20 74 6f 20 6c 6f 67 66 69 6c 65 0a derr to logfile.
1d50: 20 20 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 20 -list-servers
1d60: 20 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 : list
1d70: 20 74 68 65 20 73 65 72 76 65 72 73 20 0a 20 20 the servers .
1d80: 2d 73 74 6f 70 2d 73 65 72 76 65 72 20 69 64 20 -stop-server id
1d90: 20 20 20 20 20 20 20 20 3a 20 73 74 6f 70 20 73 : stop s
1da0: 65 72 76 65 72 20 73 70 65 63 69 66 69 65 64 20 erver specified
1db0: 62 79 20 69 64 20 28 73 65 65 20 6f 75 74 70 75 by id (see outpu
1dc0: 74 20 6f 66 20 2d 6c 69 73 74 2d 73 65 72 76 65 t of -list-serve
1dd0: 72 73 29 2c 20 75 73 65 0a 20 20 20 20 20 20 20 rs), use.
1de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1df0: 20 20 20 20 20 30 20 74 6f 20 6b 69 6c 6c 20 61 0 to kill a
1e00: 6c 6c 0a 20 20 2d 72 65 70 6c 20 20 20 20 20 20 ll. -repl
1e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 : s
1e20: 74 61 72 74 20 61 20 72 65 70 6c 20 28 75 73 65 tart a repl (use
1e30: 66 75 6c 20 66 6f 72 20 65 78 74 65 6e 64 69 6e ful for extendin
1e40: 67 20 6d 65 67 61 74 65 73 74 29 0a 20 20 2d 6c g megatest). -l
1e50: 6f 61 64 20 66 69 6c 65 2e 73 63 6d 20 20 20 20 oad file.scm
1e60: 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 61 6e 64 : load and
1e70: 20 72 75 6e 20 66 69 6c 65 2e 73 63 6d 0a 20 20 run file.scm.
1e80: 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 -mark-incomplete
1e90: 73 20 20 20 20 20 20 20 3a 20 66 69 6e 64 20 61 s : find a
1ea0: 6e 64 20 6d 61 72 6b 20 69 6e 63 6f 6d 70 6c 65 nd mark incomple
1eb0: 74 65 20 74 65 73 74 73 0a 20 20 2d 70 69 6e 67 te tests. -ping
1ec0: 20 72 75 6e 2d 69 64 7c 68 6f 73 74 3a 70 6f 72 run-id|host:por
1ed0: 74 20 20 3a 20 70 69 6e 67 20 73 65 72 76 65 72 t : ping server
1ee0: 2c 20 65 78 69 74 20 77 69 74 68 20 30 20 69 66 , exit with 0 if
1ef0: 20 66 6f 75 6e 64 0a 20 20 2d 64 65 62 75 67 20 found. -debug
1f00: 4e 7c 4e 2c 4d 2c 4f 2e 2e 2e 20 20 20 20 20 20 N|N,M,O...
1f10: 20 3a 20 65 6e 61 62 6c 65 20 64 65 62 75 67 20 : enable debug
1f20: 30 2d 4e 20 6f 72 20 4e 20 61 6e 64 20 4d 20 61 0-N or N and M a
1f30: 6e 64 20 4f 20 2e 2e 2e 0a 0a 55 74 69 6c 69 74 nd O .....Utilit
1f40: 69 65 73 0a 20 20 2d 65 6e 76 32 66 69 6c 65 20 ies. -env2file
1f50: 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 3a 20 fname :
1f60: 77 72 69 74 65 20 74 68 65 20 65 6e 76 69 72 6f write the enviro
1f70: 6e 6d 65 6e 74 20 74 6f 20 66 6e 61 6d 65 2e 63 nment to fname.c
1f80: 73 68 20 61 6e 64 20 66 6e 61 6d 65 2e 73 68 0a sh and fname.sh.
1f90: 20 20 2d 65 6e 76 63 61 70 20 66 6e 61 6d 65 3d -envcap fname=
1fa0: 63 6f 6e 74 65 78 74 20 20 20 3a 20 73 61 76 65 context : save
1fb0: 20 63 75 72 72 65 6e 74 20 76 61 72 69 61 62 6c current variabl
1fc0: 65 73 20 6c 61 62 65 6c 65 64 20 61 73 20 63 6f es labeled as co
1fd0: 6e 74 65 78 74 20 69 6e 20 66 69 6c 65 20 66 6e ntext in file fn
1fe0: 61 6d 65 0a 20 20 2d 72 65 66 64 62 32 64 61 74 ame. -refdb2dat
1ff0: 20 72 65 66 64 62 20 20 20 20 20 20 20 20 3a 20 refdb :
2000: 63 6f 6e 76 65 72 74 20 72 65 66 64 62 20 74 6f convert refdb to
2010: 20 73 65 78 70 20 6f 72 20 74 6f 20 66 6f 72 6d sexp or to form
2020: 61 74 20 73 70 65 63 69 66 69 65 64 20 62 79 20 at specified by
2030: 2d 64 75 6d 70 6d 6f 64 65 0a 20 20 20 20 20 20 -dumpmode.
2040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2050: 20 20 20 20 20 20 66 6f 72 6d 61 74 73 3a 20 70 formats: p
2060: 65 72 6c 2c 20 72 75 62 79 2c 20 73 71 6c 69 74 erl, ruby, sqlit
2070: 65 33 2c 20 63 73 76 20 28 66 6f 72 20 63 73 76 e3, csv (for csv
2080: 20 74 68 65 20 2d 6f 20 70 61 72 61 6d 0a 20 20 the -o param.
2090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20a0: 20 20 20 20 20 20 20 20 20 20 77 69 6c 6c 20 73 will s
20b0: 75 62 73 74 69 74 75 74 65 20 25 73 20 66 6f 72 ubstitute %s for
20c0: 20 74 68 65 20 73 68 65 65 74 20 6e 61 6d 65 20 the sheet name
20d0: 69 6e 20 67 65 6e 65 72 61 74 69 6e 67 20 0a 20 in generating .
20e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20f0: 20 20 20 20 20 20 20 20 20 20 20 6d 75 6c 74 69 multi
2100: 70 6c 65 20 73 68 65 65 74 73 29 0a 20 20 2d 6f ple sheets). -o
2110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2120: 20 20 20 20 20 20 3a 20 6f 75 74 70 75 74 20 66 : output f
2130: 69 6c 65 20 66 6f 72 20 72 65 66 64 62 32 64 61 ile for refdb2da
2140: 74 20 28 64 65 66 61 75 6c 74 73 20 74 6f 20 73 t (defaults to s
2150: 74 64 6f 75 74 29 0a 20 20 2d 61 72 63 68 69 76 tdout). -archiv
2160: 65 20 63 6d 64 20 20 20 20 20 20 20 20 20 20 20 e cmd
2170: 20 3a 20 61 72 63 68 69 76 65 20 72 75 6e 73 20 : archive runs
2180: 73 70 65 63 69 66 69 65 64 20 62 79 20 73 65 6c specified by sel
2190: 65 63 74 6f 72 73 20 74 6f 20 6f 6e 65 20 6f 66 ectors to one of
21a0: 20 64 69 73 6b 73 20 73 70 65 63 69 66 69 65 64 disks specified
21b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
21c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 6e 20 in
21d0: 74 68 65 20 5b 61 72 63 68 69 76 65 2d 64 69 73 the [archive-dis
21e0: 6b 73 5d 20 73 65 63 74 69 6f 6e 2e 0a 20 20 20 ks] section..
21f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2200: 20 20 20 20 20 20 20 20 20 63 6d 64 3a 20 6b 65 cmd: ke
2210: 65 70 2d 68 74 6d 6c 2c 20 72 65 73 74 6f 72 65 ep-html, restore
2220: 2c 20 73 61 76 65 2c 20 73 61 76 65 2d 72 65 6d , save, save-rem
2230: 6f 76 65 0a 20 20 2d 67 65 6e 65 72 61 74 65 2d ove. -generate-
2240: 68 74 6d 6c 20 20 20 20 20 20 20 20 20 20 3a 20 html :
2250: 63 72 65 61 74 65 20 61 20 73 69 6d 70 6c 65 20 create a simple
2260: 68 74 6d 6c 20 74 72 65 65 20 66 6f 72 20 62 72 html tree for br
2270: 6f 77 73 69 6e 67 20 79 6f 75 72 20 72 75 6e 73 owsing your runs
2280: 0a 0a 53 70 72 65 61 64 73 68 65 65 74 20 67 65 ..Spreadsheet ge
2290: 6e 65 72 61 74 69 6f 6e 0a 20 20 2d 65 78 74 72 neration. -extr
22a0: 61 63 74 2d 6f 64 73 20 66 6e 61 6d 65 2e 6f 64 act-ods fname.od
22b0: 73 20 20 3a 20 65 78 74 72 61 63 74 20 61 6e 20 s : extract an
22c0: 6f 70 65 6e 20 64 6f 63 75 6d 65 6e 74 20 73 70 open document sp
22d0: 72 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 74 readsheet from t
22e0: 68 65 20 64 61 74 61 62 61 73 65 0a 20 20 2d 70 he database. -p
22f0: 61 74 68 6d 6f 64 20 70 61 74 68 20 20 20 20 20 athmod path
2300: 20 20 20 20 20 20 3a 20 69 6e 73 65 72 74 20 70 : insert p
2310: 61 74 68 2c 20 69 2e 65 2e 20 70 61 74 68 2f 72 ath, i.e. path/r
2320: 75 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c uname/itempath/l
2330: 6f 67 66 69 6c 65 2e 68 74 6d 6c 0a 20 20 20 20 ogfile.html.
2340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2350: 20 20 20 20 20 20 20 20 77 69 6c 6c 20 63 6c 65 will cle
2360: 61 72 20 74 68 65 20 66 69 65 6c 64 20 69 66 20 ar the field if
2370: 6e 6f 20 72 75 6e 64 69 72 2f 74 65 73 74 6e 61 no rundir/testna
2380: 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 me/itempath/logf
2390: 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ile.
23a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23b0: 69 66 20 69 74 20 63 6f 6e 74 61 69 6e 73 20 66 if it contains f
23c0: 6f 72 77 61 72 64 20 73 6c 61 73 68 65 73 20 74 orward slashes t
23d0: 68 65 20 70 61 74 68 20 77 69 6c 6c 20 62 65 20 he path will be
23e0: 63 6f 6e 76 65 72 74 65 64 0a 20 20 20 20 20 20 converted.
23f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2400: 20 20 20 20 20 20 74 6f 20 77 69 6e 64 6f 77 73 to windows
2410: 20 73 74 79 6c 65 0a 47 65 74 74 69 6e 67 20 73 style.Getting s
2420: 74 61 72 74 65 64 0a 20 20 2d 63 72 65 61 74 65 tarted. -create
2430: 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 20 20 -megatest-area
2440: 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 61 20 : create a
2450: 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 skeleton megates
2460: 74 20 61 72 65 61 2e 20 59 6f 75 20 77 69 6c 6c t area. You will
2470: 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 be prompted for
2480: 20 70 61 74 68 73 0a 20 20 2d 63 72 65 61 74 65 paths. -create
2490: 2d 74 65 73 74 20 74 65 73 74 6e 61 6d 65 20 20 -test testname
24a0: 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 61 20 : create a
24b0: 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 skeleton megates
24c0: 74 20 74 65 73 74 2e 20 59 6f 75 20 77 69 6c 6c t test. You will
24d0: 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 be prompted for
24e0: 20 69 6e 66 6f 0a 0a 45 78 61 6d 70 6c 65 73 0a info..Examples.
24f0: 0a 23 20 47 65 74 20 74 65 73 74 20 70 61 74 68 .# Get test path
2500: 2c 20 75 73 65 20 27 2e 27 20 74 6f 20 67 65 74 , use '.' to get
2510: 20 61 20 73 69 6e 67 6c 65 20 70 61 74 68 20 6f a single path o
2520: 72 20 61 20 73 70 65 63 69 66 69 63 20 70 61 74 r a specific pat
2530: 68 2f 66 69 6c 65 20 70 61 74 74 65 72 6e 0a 6d h/file pattern.m
2540: 65 67 61 74 65 73 74 20 2d 74 65 73 74 2d 66 69 egatest -test-fi
2550: 6c 65 73 20 27 6c 6f 67 73 2f 2a 2e 6c 6f 67 27 les 'logs/*.log'
2560: 20 2d 74 61 72 67 65 74 20 75 62 75 6e 74 75 2f -target ubuntu/
2570: 6e 25 2f 6e 6f 25 20 2d 72 75 6e 6e 61 6d 65 20 n%/no% -runname
2580: 77 34 39 25 20 2d 74 65 73 74 70 61 74 74 20 74 w49% -testpatt t
2590: 65 73 74 5f 6d 74 25 0a 0a 43 61 6c 6c 65 64 20 est_mt%..Called
25a0: 61 73 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 as " (string-int
25b0: 65 72 73 70 65 72 73 65 20 28 61 72 67 76 29 20 ersperse (argv)
25c0: 22 20 22 29 20 22 0a 56 65 72 73 69 6f 6e 20 22 " ") ".Version "
25d0: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f megatest-versio
25e0: 6e 20 22 2c 20 62 75 69 6c 74 20 66 72 6f 6d 20 n ", built from
25f0: 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 " megatest-fossi
2600: 6c 2d 68 61 73 68 20 29 29 0a 0a 3b 3b 20 20 2d l-hash ))..;; -
2610: 67 75 69 20 20 20 20 20 20 20 20 20 20 20 20 20 gui
2620: 20 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 61 : start a
2630: 20 67 75 69 20 69 6e 74 65 72 66 61 63 65 0a 3b gui interface.;
2640: 3b 20 20 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 ; -config fname
2650: 20 20 20 20 20 20 20 20 20 20 20 3a 20 6f 76 65 : ove
2660: 72 72 69 64 65 20 74 68 65 20 72 75 6e 63 6f 6e rride the runcon
2670: 66 69 67 20 66 69 6c 65 20 77 69 74 68 20 66 6e fig file with fn
2680: 61 6d 65 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 20 ame..;; process
2690: 61 72 67 73 0a 28 64 65 66 69 6e 65 20 72 65 6d args.(define rem
26a0: 61 72 67 73 20 28 61 72 67 73 3a 67 65 74 2d 61 args (args:get-a
26b0: 72 67 73 20 0a 09 09 20 28 61 72 67 76 29 0a 09 rgs ... (argv)..
26c0: 09 20 28 6c 69 73 74 20 20 22 2d 72 75 6e 74 65 . (list "-runte
26d0: 73 74 73 22 20 20 3b 3b 20 72 75 6e 20 61 20 73 sts" ;; run a s
26e0: 70 65 63 69 66 69 63 20 74 65 73 74 0a 09 09 09 pecific test....
26f0: 22 2d 63 6f 6e 66 69 67 22 20 20 20 20 3b 3b 20 "-config" ;;
2700: 6f 76 65 72 72 69 64 65 20 74 68 65 20 63 6f 6e override the con
2710: 66 69 67 20 66 69 6c 65 20 6e 61 6d 65 0a 09 09 fig file name...
2720: 09 22 2d 65 78 65 63 75 74 65 22 20 20 20 3b 3b ."-execute" ;;
2730: 20 72 75 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 run the command
2740: 20 65 6e 63 6f 64 65 64 20 69 6e 20 74 68 65 20 encoded in the
2750: 62 61 73 65 36 34 20 70 61 72 61 6d 65 74 65 72 base64 parameter
2760: 0a 09 09 09 22 2d 73 74 65 70 22 0a 09 09 09 22 ...."-step"...."
2770: 2d 74 61 72 67 65 74 22 0a 09 09 09 22 2d 72 65 -target"...."-re
2780: 71 74 61 72 67 22 0a 09 09 09 22 3a 72 75 6e 6e qtarg"....":runn
2790: 61 6d 65 22 0a 09 09 09 22 2d 72 75 6e 6e 61 6d ame"...."-runnam
27a0: 65 22 0a 09 09 09 22 3a 73 74 61 74 65 22 20 20 e"....":state"
27b0: 0a 09 09 09 22 2d 73 74 61 74 65 22 0a 09 09 09 ...."-state"....
27c0: 22 3a 73 74 61 74 75 73 22 0a 09 09 09 22 2d 73 ":status"...."-s
27d0: 74 61 74 75 73 22 0a 09 09 09 22 2d 6c 69 73 74 tatus"...."-list
27e0: 2d 72 75 6e 73 22 0a 09 09 09 22 2d 74 65 73 74 -runs"...."-test
27f0: 70 61 74 74 22 20 0a 09 09 09 22 2d 69 74 65 6d patt" ...."-item
2800: 70 61 74 74 22 0a 09 09 09 22 2d 73 65 74 6c 6f patt"...."-setlo
2810: 67 22 0a 09 09 09 22 2d 73 65 74 2d 74 6f 70 6c g"...."-set-topl
2820: 6f 67 22 0a 09 09 09 22 2d 72 75 6e 73 74 65 70 og"...."-runstep
2830: 22 0a 09 09 09 22 2d 6c 6f 67 70 72 6f 22 0a 09 "...."-logpro"..
2840: 09 09 22 2d 6d 22 0a 09 09 09 22 2d 72 65 72 75 .."-m"...."-reru
2850: 6e 22 0a 09 09 09 22 2d 64 61 79 73 22 0a 09 09 n"...."-days"...
2860: 09 22 2d 72 65 6e 61 6d 65 2d 72 75 6e 22 0a 09 ."-rename-run"..
2870: 09 09 22 2d 74 6f 22 0a 09 09 09 3b 3b 20 76 61 .."-to"....;; va
2880: 6c 75 65 73 20 61 6e 64 20 6d 65 73 73 61 67 65 lues and message
2890: 73 0a 09 09 09 22 3a 63 61 74 65 67 6f 72 79 22 s....":category"
28a0: 0a 09 09 09 22 3a 76 61 72 69 61 62 6c 65 22 0a ....":variable".
28b0: 09 09 09 22 3a 76 61 6c 75 65 22 0a 09 09 09 22 ...":value"...."
28c0: 3a 65 78 70 65 63 74 65 64 22 0a 09 09 09 22 3a :expected"....":
28d0: 74 6f 6c 22 0a 09 09 09 22 3a 75 6e 69 74 73 22 tol"....":units"
28e0: 0a 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 09 22 ....;; misc...."
28f0: 2d 73 74 61 72 74 2d 64 69 72 22 0a 09 09 09 22 -start-dir"...."
2900: 2d 73 65 72 76 65 72 22 0a 09 09 09 22 2d 73 74 -server"...."-st
2910: 6f 70 2d 73 65 72 76 65 72 22 0a 09 09 09 22 2d op-server"...."-
2920: 74 72 61 6e 73 70 6f 72 74 22 0a 09 09 09 22 2d transport"...."-
2930: 6b 69 6c 6c 2d 73 65 72 76 65 72 22 0a 09 09 09 kill-server"....
2940: 22 2d 70 6f 72 74 22 0a 09 09 09 22 2d 65 78 74 "-port"...."-ext
2950: 72 61 63 74 2d 6f 64 73 22 0a 09 09 09 22 2d 70 ract-ods"...."-p
2960: 61 74 68 6d 6f 64 22 0a 09 09 09 22 2d 65 6e 76 athmod"...."-env
2970: 32 66 69 6c 65 22 0a 09 09 09 22 2d 65 6e 76 63 2file"...."-envc
2980: 61 70 22 0a 09 09 09 22 2d 65 6e 76 64 65 6c 74 ap"...."-envdelt
2990: 61 22 0a 09 09 09 22 2d 73 65 74 76 61 72 73 22 a"...."-setvars"
29a0: 0a 09 09 09 22 2d 73 65 74 2d 73 74 61 74 65 2d ...."-set-state-
29b0: 73 74 61 74 75 73 22 0a 09 09 09 22 2d 73 65 74 status"...."-set
29c0: 2d 72 75 6e 2d 73 74 61 74 75 73 22 0a 09 09 09 -run-status"....
29d0: 22 2d 64 65 62 75 67 22 20 3b 3b 20 66 6f 72 20 "-debug" ;; for
29e0: 2a 76 65 72 62 6f 73 69 74 79 2a 20 3e 20 32 0a *verbosity* > 2.
29f0: 09 09 09 22 2d 63 72 65 61 74 65 2d 74 65 73 74 ..."-create-test
2a00: 22 0a 09 09 09 22 2d 6f 76 65 72 72 69 64 65 2d "...."-override-
2a10: 74 69 6d 65 6f 75 74 22 0a 09 09 09 22 2d 74 65 timeout"...."-te
2a20: 73 74 2d 66 69 6c 65 73 22 20 20 3b 3b 20 2d 74 st-files" ;; -t
2a30: 65 73 74 2d 70 61 74 68 73 20 69 73 20 66 6f 72 est-paths is for
2a40: 20 6c 69 73 74 69 6e 67 20 61 6c 6c 0a 09 09 09 listing all....
2a50: 22 2d 6c 6f 61 64 22 20 20 20 20 20 20 20 20 3b "-load" ;
2a60: 3b 20 6c 6f 61 64 20 61 6e 64 20 65 78 65 63 74 ; load and exect
2a70: 75 74 65 20 61 20 73 63 68 65 6d 65 20 66 69 6c ute a scheme fil
2a80: 65 0a 09 09 09 22 2d 73 65 63 74 69 6f 6e 22 0a e...."-section".
2a90: 09 09 09 22 2d 76 61 72 22 0a 09 09 09 22 2d 64 ..."-var"...."-d
2aa0: 75 6d 70 6d 6f 64 65 22 0a 09 09 09 22 2d 72 75 umpmode"...."-ru
2ab0: 6e 2d 69 64 22 0a 09 09 09 22 2d 70 69 6e 67 22 n-id"...."-ping"
2ac0: 0a 09 09 09 22 2d 72 65 66 64 62 32 64 61 74 22 ...."-refdb2dat"
2ad0: 0a 09 09 09 22 2d 6f 22 0a 09 09 09 22 2d 6c 6f ...."-o"...."-lo
2ae0: 67 22 0a 09 09 09 22 2d 61 72 63 68 69 76 65 22 g"...."-archive"
2af0: 0a 09 09 09 22 2d 73 69 6e 63 65 22 0a 09 09 09 ...."-since"....
2b00: 22 2d 66 69 65 6c 64 73 22 0a 09 09 09 22 2d 72 "-fields"...."-r
2b10: 65 63 6f 76 65 72 2d 74 65 73 74 22 20 3b 3b 20 ecover-test" ;;
2b20: 72 75 6e 2d 69 64 2c 74 65 73 74 2d 69 64 20 2d run-id,test-id -
2b30: 20 75 73 65 64 20 69 6e 74 65 72 6e 61 6c 6c 79 used internally
2b40: 20 74 6f 20 72 65 63 6f 76 65 72 20 61 20 74 65 to recover a te
2b50: 73 74 20 73 74 75 63 6b 20 69 6e 20 52 55 4e 4e st stuck in RUNN
2b60: 49 4e 47 20 73 74 61 74 65 0a 09 09 09 22 2d 73 ING state...."-s
2b70: 6f 72 74 22 0a 09 09 09 29 20 0a 09 09 20 28 6c ort"....) ... (l
2b80: 69 73 74 20 20 22 2d 68 22 20 22 2d 68 65 6c 70 ist "-h" "-help
2b90: 22 20 22 2d 2d 68 65 6c 70 22 0a 09 09 09 22 2d " "--help"...."-
2ba0: 6d 61 6e 75 61 6c 22 0a 09 09 09 22 2d 76 65 72 manual"...."-ver
2bb0: 73 69 6f 6e 22 0a 09 09 20 20 20 20 20 20 20 20 sion"...
2bc0: 22 2d 66 6f 72 63 65 22 0a 09 09 20 20 20 20 20 "-force"...
2bd0: 20 20 20 22 2d 78 74 65 72 6d 22 0a 09 09 20 20 "-xterm"...
2be0: 20 20 20 20 20 20 22 2d 73 68 6f 77 6b 65 79 73 "-showkeys
2bf0: 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d 73 68 "... "-sh
2c00: 6f 77 2d 6b 65 79 73 22 0a 09 09 20 20 20 20 20 ow-keys"...
2c10: 20 20 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 "-test-status
2c20: 22 0a 09 09 09 22 2d 73 65 74 2d 76 61 6c 75 65 "...."-set-value
2c30: 73 22 0a 09 09 09 22 2d 6c 6f 61 64 2d 74 65 73 s"...."-load-tes
2c40: 74 2d 64 61 74 61 22 0a 09 09 09 22 2d 73 75 6d t-data"...."-sum
2c50: 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 0a 09 09 marize-items"...
2c60: 20 20 20 20 20 20 20 20 22 2d 67 75 69 22 0a 09 "-gui"..
2c70: 09 09 22 2d 64 61 65 6d 6f 6e 69 7a 65 22 0a 09 .."-daemonize"..
2c80: 09 09 22 2d 70 72 65 63 6c 65 61 6e 22 0a 09 09 .."-preclean"...
2c90: 09 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 22 0a ."-rerun-clean".
2ca0: 09 09 09 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 0a ..."-rerun-all".
2cb0: 09 09 09 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 ..."-clean-cache
2cc0: 22 0a 0a 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 ".....;; misc...
2cd0: 09 22 2d 72 65 70 6c 22 0a 09 09 09 22 2d 6c 6f ."-repl"...."-lo
2ce0: 63 6b 22 0a 09 09 09 22 2d 75 6e 6c 6f 63 6b 22 ck"...."-unlock"
2cf0: 0a 09 09 09 22 2d 6c 69 73 74 2d 73 65 72 76 65 ...."-list-serve
2d00: 72 73 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 rs".
2d10: 20 20 20 20 20 20 20 20 20 20 20 20 22 2d 72 75 "-ru
2d20: 6e 2d 77 61 69 74 22 20 20 20 20 20 20 3b 3b 20 n-wait" ;;
2d30: 77 61 69 74 20 6f 6e 20 61 20 72 75 6e 20 74 6f wait on a run to
2d40: 20 63 6f 6d 70 6c 65 74 65 20 28 69 2e 65 2e 20 complete (i.e.
2d50: 6e 6f 20 52 55 4e 4e 49 4e 47 29 0a 09 09 09 22 no RUNNING)...."
2d60: 2d 6c 6f 63 61 6c 22 20 20 20 20 20 20 20 20 20 -local"
2d70: 3b 3b 20 72 75 6e 20 73 6f 6d 65 20 63 6f 6d 6d ;; run some comm
2d80: 61 6e 64 73 20 75 73 69 6e 67 20 6c 6f 63 61 6c ands using local
2d90: 20 64 62 20 61 63 63 65 73 73 0a 20 20 20 20 20 db access.
2da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2db0: 20 20 20 22 2d 67 65 6e 65 72 61 74 65 2d 68 74 "-generate-ht
2dc0: 6d 6c 22 0a 0a 09 09 09 3b 3b 20 6d 69 73 63 20 ml".....;; misc
2dd0: 71 75 65 72 69 65 73 0a 09 09 09 22 2d 6c 69 73 queries...."-lis
2de0: 74 2d 64 69 73 6b 73 22 0a 09 09 09 22 2d 6c 69 t-disks"...."-li
2df0: 73 74 2d 74 61 72 67 65 74 73 22 0a 09 09 09 22 st-targets"...."
2e00: 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 -list-db-targets
2e10: 22 0a 09 09 09 22 2d 73 68 6f 77 2d 72 75 6e 63 "...."-show-runc
2e20: 6f 6e 66 69 67 22 0a 09 09 09 22 2d 73 68 6f 77 onfig"...."-show
2e30: 2d 63 6f 6e 66 69 67 22 0a 09 09 09 22 2d 73 68 -config"...."-sh
2e40: 6f 77 2d 63 6d 64 69 6e 66 6f 22 0a 09 09 09 22 ow-cmdinfo"...."
2e50: 2d 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 -get-run-status"
2e60: 0a 0a 09 09 09 3b 3b 20 71 75 65 72 69 65 73 0a .....;; queries.
2e70: 09 09 09 22 2d 74 65 73 74 2d 70 61 74 68 73 22 ..."-test-paths"
2e80: 20 3b 3b 20 67 65 74 20 70 61 74 68 28 73 29 20 ;; get path(s)
2e90: 74 6f 20 61 20 74 65 73 74 2c 20 6f 72 64 65 72 to a test, order
2ea0: 65 64 20 62 79 20 79 6f 75 6e 67 65 73 74 20 66 ed by youngest f
2eb0: 69 72 73 74 0a 0a 09 09 09 22 2d 72 75 6e 61 6c irst....."-runal
2ec0: 6c 22 20 20 20 20 3b 3b 20 72 75 6e 20 61 6c 6c l" ;; run all
2ed0: 20 74 65 73 74 73 2c 20 72 65 73 70 65 63 74 73 tests, respects
2ee0: 20 2d 74 65 73 74 70 61 74 74 2c 20 64 65 66 61 -testpatt, defa
2ef0: 75 6c 74 73 20 74 6f 20 25 0a 09 09 09 22 2d 72 ults to %...."-r
2f00: 75 6e 22 20 20 20 20 20 20 20 3b 3b 20 61 6c 69 un" ;; ali
2f10: 61 73 20 66 6f 72 20 2d 72 75 6e 61 6c 6c 0a 09 as for -runall..
2f20: 09 09 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 .."-remove-runs"
2f30: 0a 09 09 09 22 2d 72 65 62 75 69 6c 64 2d 64 62 ...."-rebuild-db
2f40: 22 0a 09 09 09 22 2d 63 6c 65 61 6e 75 70 2d 64 "...."-cleanup-d
2f50: 62 22 0a 09 09 09 22 2d 72 6f 6c 6c 75 70 22 0a b"...."-rollup".
2f60: 09 09 09 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 ..."-update-meta
2f70: 22 0a 09 09 09 22 2d 63 72 65 61 74 65 2d 6d 65 "...."-create-me
2f80: 67 61 74 65 73 74 2d 61 72 65 61 22 0a 09 09 09 gatest-area"....
2f90: 22 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 "-mark-incomplet
2fa0: 65 73 22 0a 0a 09 09 09 22 2d 63 6f 6e 76 65 72 es"....."-conver
2fb0: 74 2d 74 6f 2d 6e 6f 72 6d 22 0a 09 09 09 22 2d t-to-norm"...."-
2fc0: 63 6f 6e 76 65 72 74 2d 74 6f 2d 6f 6c 64 22 0a convert-to-old".
2fd0: 09 09 09 22 2d 69 6d 70 6f 72 74 2d 6d 65 67 61 ..."-import-mega
2fe0: 74 65 73 74 2e 64 62 22 0a 09 09 09 22 2d 73 79 test.db"...."-sy
2ff0: 6e 63 2d 74 6f 2d 6d 65 67 61 74 65 73 74 2e 64 nc-to-megatest.d
3000: 62 22 0a 0a 09 09 09 22 2d 6c 6f 67 67 69 6e 67 b"....."-logging
3010: 22 0a 09 09 09 22 2d 76 22 20 3b 3b 20 76 65 72 "...."-v" ;; ver
3020: 62 6f 73 65 20 32 2c 20 6d 6f 72 65 20 74 68 61 bose 2, more tha
3030: 6e 20 6e 6f 72 6d 61 6c 20 28 6e 6f 72 6d 61 6c n normal (normal
3040: 20 69 73 20 31 29 0a 09 09 09 22 2d 71 22 20 3b is 1)...."-q" ;
3050: 3b 20 71 75 69 65 74 20 30 2c 20 65 72 72 6f 72 ; quiet 0, error
3060: 73 2f 77 61 72 6e 69 6e 67 73 20 6f 6e 6c 79 0a s/warnings only.
3070: 09 09 20 20 20 20 20 20 20 29 0a 09 09 20 61 72 .. )... ar
3080: 67 73 3a 61 72 67 2d 68 61 73 68 0a 09 09 20 30 gs:arg-hash... 0
3090: 29 29 0a 0a 3b 3b 20 41 64 64 20 61 72 67 73 20 ))..;; Add args
30a0: 74 68 61 74 20 75 73 65 20 72 65 6d 61 72 67 73 that use remargs
30b0: 20 68 65 72 65 0a 3b 3b 0a 28 69 66 20 28 61 6e here.;;.(if (an
30c0: 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 d (not (null? re
30d0: 6d 61 72 67 73 29 29 0a 09 20 28 6e 6f 74 20 28 margs)).. (not (
30e0: 6f 72 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 or.. (args
30f0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 :get-arg "-runst
3100: 65 70 22 29 0a 09 20 20 20 20 20 20 20 28 61 72 ep").. (ar
3110: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 gs:get-arg "-env
3120: 63 61 70 22 29 0a 09 20 20 20 20 20 20 20 28 61 cap").. (a
3130: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e rgs:get-arg "-en
3140: 76 64 65 6c 74 61 22 29 0a 09 20 20 20 20 20 20 vdelta")..
3150: 20 29 0a 09 20 20 20 20 20 20 29 29 0a 20 20 20 ).. )).
3160: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
3170: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
3180: 6f 67 2d 70 6f 72 74 2a 20 22 55 6e 72 65 63 6f og-port* "Unreco
3190: 67 6e 69 73 65 64 20 61 72 67 75 6d 65 6e 74 73 gnised arguments
31a0: 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 : " (string-inte
31b0: 72 73 70 65 72 73 65 20 28 69 66 20 28 6c 69 73 rsperse (if (lis
31c0: 74 3f 20 72 65 6d 61 72 67 73 29 20 72 65 6d 61 t? remargs) rema
31d0: 72 67 73 20 28 61 72 67 76 29 29 20 20 22 20 22 rgs (argv)) " "
31e0: 29 29 29 0a 0a 3b 3b 20 69 6d 6d 65 64 69 61 74 )))..;; immediat
31f0: 65 6c 79 20 73 65 74 20 4d 54 5f 54 41 52 47 45 ely set MT_TARGE
3200: 54 20 69 66 20 2d 72 65 71 74 61 72 67 20 6f 72 T if -reqtarg or
3210: 20 2d 74 61 72 67 65 74 20 61 72 65 20 61 76 61 -target are ava
3220: 69 6c 61 62 6c 65 0a 3b 3b 0a 28 6c 65 74 20 28 ilable.;;.(let (
3230: 28 74 61 72 67 20 28 6f 72 20 28 61 72 67 73 3a (targ (or (args:
3240: 67 65 74 2d 61 72 67 20 22 2d 72 65 71 74 61 72 get-arg "-reqtar
3250: 67 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 g")(args:get-arg
3260: 20 22 2d 74 61 72 67 65 74 22 29 29 29 29 0a 20 "-target")))).
3270: 20 28 69 66 20 74 61 72 67 20 28 73 65 74 65 6e (if targ (seten
3280: 76 20 22 4d 54 5f 54 41 52 47 45 54 22 20 74 61 v "MT_TARGET" ta
3290: 72 67 29 29 29 0a 0a 3b 3b 20 54 68 65 20 77 61 rg)))..;; The wa
32a0: 74 63 68 64 6f 67 20 69 73 20 74 6f 20 6b 65 65 tchdog is to kee
32b0: 70 20 61 6e 20 65 79 65 20 6f 6e 20 74 68 69 6e p an eye on thin
32c0: 67 73 20 6c 69 6b 65 20 64 62 20 73 79 6e 63 20 gs like db sync
32d0: 65 74 63 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 etc..;;.(define
32e0: 2a 74 69 6d 65 2d 7a 65 72 6f 2a 20 28 63 75 72 *time-zero* (cur
32f0: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 28 rent-seconds)).(
3300: 64 65 66 69 6e 65 20 2a 77 61 74 63 68 64 6f 67 define *watchdog
3310: 2a 0a 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 *. (make-thread
3320: 20 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a . (lambda ().
3330: 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 (thread-sle
3340: 65 70 21 20 30 2e 30 35 29 20 3b 3b 20 64 65 6c ep! 0.05) ;; del
3350: 61 79 20 66 6f 72 20 73 74 61 72 74 75 70 0a 20 ay for startup.
3360: 20 20 20 20 28 6c 65 74 20 28 28 6c 65 67 61 63 (let ((legac
3370: 79 2d 73 79 6e 63 20 28 63 6f 6d 6d 6f 6e 3a 6c y-sync (common:l
3380: 65 67 61 63 79 2d 73 79 6e 63 2d 72 65 71 75 69 egacy-sync-requi
3390: 72 65 64 29 29 0a 09 20 20 20 28 64 65 62 75 67 red)).. (debug
33a0: 2d 6d 6f 64 65 20 20 28 64 65 62 75 67 3a 64 65 -mode (debug:de
33b0: 62 75 67 2d 6d 6f 64 65 20 31 29 29 0a 09 20 20 bug-mode 1))..
33c0: 20 28 6c 61 73 74 2d 74 69 6d 65 20 20 20 28 63 (last-time (c
33d0: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 urrent-seconds))
33e0: 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 63 6f ). (if (co
33f0: 6d 6d 6f 6e 3a 6c 65 67 61 63 79 2d 73 79 6e 63 mmon:legacy-sync
3400: 2d 72 65 63 6f 6d 6d 65 6e 64 65 64 29 0a 09 20 -recommended)..
3410: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 29 0a 09 (let loop ()..
3420: 20 20 20 20 20 3b 3b 20 73 79 6e 63 20 66 6f 72 ;; sync for
3430: 20 66 69 6c 65 73 79 73 74 65 6d 20 6c 6f 63 61 filesystem loca
3440: 6c 20 64 62 20 77 72 69 74 65 73 0a 09 20 20 20 l db writes..
3450: 20 20 3b 3b 0a 09 20 20 20 20 20 28 6c 65 74 20 ;;.. (let
3460: 28 28 73 74 61 72 74 2d 74 69 6d 65 20 20 20 20 ((start-time
3470: 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e (current-secon
3480: 64 73 29 29 0a 09 09 20 20 20 28 73 65 72 76 65 ds))... (serve
3490: 72 73 2d 73 74 61 72 74 65 64 20 28 6d 61 6b 65 rs-started (make
34a0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 -hash-table)))..
34b0: 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 (for-each
34c0: 20 0a 09 09 28 6c 61 6d 62 64 61 20 28 72 75 6e ...(lambda (run
34d0: 2d 69 64 29 0a 09 09 20 20 28 6d 75 74 65 78 2d -id)... (mutex-
34e0: 6c 6f 63 6b 21 20 2a 64 62 2d 6d 75 6c 74 69 2d lock! *db-multi-
34f0: 73 79 6e 63 2d 6d 75 74 65 78 2a 29 0a 09 09 20 sync-mutex*)...
3500: 20 28 69 66 20 28 61 6e 64 20 6c 65 67 61 63 79 (if (and legacy
3510: 2d 73 79 6e 63 20 0a 09 09 09 20 20 20 28 68 61 -sync .... (ha
3520: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
3530: 61 75 6c 74 20 2a 64 62 2d 6c 6f 63 61 6c 2d 73 ault *db-local-s
3540: 79 6e 63 2a 20 72 75 6e 2d 69 64 20 23 66 29 29 ync* run-id #f))
3550: 0a 09 09 20 20 20 20 20 20 3b 3b 20 28 69 66 20 ... ;; (if
3560: 28 3e 20 28 2d 20 73 74 61 72 74 2d 74 69 6d 65 (> (- start-time
3570: 20 6c 61 73 74 2d 77 72 69 74 65 29 20 35 29 20 last-write) 5)
3580: 3b 3b 20 65 76 65 72 79 20 66 69 76 65 20 73 65 ;; every five se
3590: 63 6f 6e 64 73 0a 09 09 20 20 20 20 20 20 28 62 conds... (b
35a0: 65 67 69 6e 20 3b 3b 20 6c 65 74 20 28 28 73 79 egin ;; let ((sy
35b0: 6e 63 2d 74 69 6d 65 20 28 2d 20 28 63 75 72 72 nc-time (- (curr
35c0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 73 74 61 ent-seconds) sta
35d0: 72 74 2d 74 69 6d 65 29 29 29 0a 09 09 09 28 64 rt-time)))....(d
35e0: 62 3a 6d 75 6c 74 69 2d 64 62 2d 73 79 6e 63 20 b:multi-db-sync
35f0: 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 20 27 6e (list run-id) 'n
3600: 65 77 32 6f 6c 64 29 0a 09 09 09 28 6c 65 74 20 ew2old)....(let
3610: 28 28 73 79 6e 63 2d 74 69 6d 65 20 28 2d 20 28 ((sync-time (- (
3620: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
3630: 20 73 74 61 72 74 2d 74 69 6d 65 29 29 29 0a 09 start-time)))..
3640: 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
3650: 2d 69 6e 66 6f 20 33 20 2a 64 65 66 61 75 6c 74 -info 3 *default
3660: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 79 6e 63 -log-port* "Sync
3670: 20 6f 66 20 6e 65 77 64 62 20 74 6f 20 6f 6c 64 of newdb to old
3680: 64 62 20 66 6f 72 20 72 75 6e 2d 69 64 20 22 20 db for run-id "
3690: 72 75 6e 2d 69 64 20 22 20 63 6f 6d 70 6c 65 74 run-id " complet
36a0: 65 64 20 69 6e 20 22 20 73 79 6e 63 2d 74 69 6d ed in " sync-tim
36b0: 65 20 22 20 73 65 63 6f 6e 64 73 22 29 0a 09 09 e " seconds")...
36c0: 09 20 20 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 6c . (if (common:l
36d0: 6f 77 2d 6e 6f 69 73 65 2d 70 72 69 6e 74 20 33 ow-noise-print 3
36e0: 30 20 22 73 79 6e 63 20 6e 65 77 20 74 6f 20 6f 0 "sync new to o
36f0: 6c 64 22 29 0a 09 09 09 20 20 20 20 20 20 28 64 ld").... (d
3700: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
3710: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
3720: 6f 72 74 2a 20 22 53 79 6e 63 20 6f 66 20 6e 65 ort* "Sync of ne
3730: 77 64 62 20 74 6f 20 6f 6c 64 64 62 20 66 6f 72 wdb to olddb for
3740: 20 72 75 6e 2d 69 64 20 22 20 72 75 6e 2d 69 64 run-id " run-id
3750: 20 22 20 63 6f 6d 70 6c 65 74 65 64 20 69 6e 20 " completed in
3760: 22 20 73 79 6e 63 2d 74 69 6d 65 20 22 20 73 65 " sync-time " se
3770: 63 6f 6e 64 73 22 29 29 29 0a 09 09 09 3b 3b 20 conds")))....;;
3780: 28 69 66 20 28 3e 20 73 79 6e 63 2d 74 69 6d 65 (if (> sync-time
3790: 20 31 30 29 20 3b 3b 20 74 6f 6f 6b 20 6d 6f 72 10) ;; took mor
37a0: 65 20 74 68 61 6e 20 74 65 6e 20 73 65 63 6f 6e e than ten secon
37b0: 64 73 2c 20 73 74 61 72 74 20 61 20 73 65 72 76 ds, start a serv
37c0: 65 72 20 66 6f 72 20 74 68 69 73 20 72 75 6e 0a er for this run.
37d0: 09 09 09 3b 3b 20 20 20 20 20 28 62 65 67 69 6e ...;; (begin
37e0: 0a 09 09 09 3b 3b 20 20 20 20 20 20 20 28 64 65 ....;; (de
37f0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
3800: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
3810: 72 74 2a 20 22 53 79 6e 63 20 69 73 20 74 61 6b rt* "Sync is tak
3820: 69 6e 67 20 61 20 6c 6f 6e 67 20 74 69 6d 65 2c ing a long time,
3830: 20 73 74 61 72 74 20 75 70 20 61 20 73 65 72 76 start up a serv
3840: 65 72 20 74 6f 20 61 73 73 69 73 74 20 66 6f 72 er to assist for
3850: 20 72 75 6e 20 22 20 72 75 6e 2d 69 64 29 0a 09 run " run-id)..
3860: 09 09 3b 3b 20 20 20 20 20 20 20 28 73 65 72 76 ..;; (serv
3870: 65 72 3a 6b 69 6e 64 2d 72 75 6e 20 72 75 6e 2d er:kind-run run-
3880: 69 64 29 29 29 29 29 0a 09 09 09 28 68 61 73 68 id)))))....(hash
3890: 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 2a -table-delete! *
38a0: 64 62 2d 6c 6f 63 61 6c 2d 73 79 6e 63 2a 20 72 db-local-sync* r
38b0: 75 6e 2d 69 64 29 29 29 0a 09 09 20 20 28 6d 75 un-id)))... (mu
38c0: 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 64 62 2d tex-unlock! *db-
38d0: 6d 75 6c 74 69 2d 73 79 6e 63 2d 6d 75 74 65 78 multi-sync-mutex
38e0: 2a 29 29 0a 09 09 28 68 61 73 68 2d 74 61 62 6c *))...(hash-tabl
38f0: 65 2d 6b 65 79 73 20 2a 64 62 2d 6c 6f 63 61 6c e-keys *db-local
3900: 2d 73 79 6e 63 2a 29 29 0a 09 20 20 20 20 20 20 -sync*))..
3910: 20 28 69 66 20 28 61 6e 64 20 64 65 62 75 67 2d (if (and debug-
3920: 6d 6f 64 65 0a 09 09 09 28 3e 20 28 2d 20 73 74 mode....(> (- st
3930: 61 72 74 2d 74 69 6d 65 20 6c 61 73 74 2d 74 69 art-time last-ti
3940: 6d 65 29 20 36 30 29 29 0a 09 09 20 20 20 28 62 me) 60))... (b
3950: 65 67 69 6e 0a 09 09 20 20 20 20 20 28 73 65 74 egin... (set
3960: 21 20 6c 61 73 74 2d 74 69 6d 65 20 73 74 61 72 ! last-time star
3970: 74 2d 74 69 6d 65 29 0a 09 09 20 20 20 20 20 28 t-time)... (
3980: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
3990: 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 4 *default-log-
39a0: 70 6f 72 74 2a 20 22 74 69 6d 65 73 74 61 6d 70 port* "timestamp
39b0: 20 2d 3e 20 22 20 28 73 65 63 6f 6e 64 73 2d 3e -> " (seconds->
39c0: 74 69 6d 65 2d 73 74 72 69 6e 67 20 28 63 75 72 time-string (cur
39d0: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 20 22 rent-seconds)) "
39e0: 2c 20 74 69 6d 65 20 73 69 6e 63 65 20 73 74 61 , time since sta
39f0: 72 74 20 2d 3e 20 22 20 28 73 65 63 6f 6e 64 73 rt -> " (seconds
3a00: 2d 3e 68 72 2d 6d 69 6e 2d 73 65 63 20 28 2d 20 ->hr-min-sec (-
3a10: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
3a20: 29 20 2a 74 69 6d 65 2d 7a 65 72 6f 2a 29 29 29 ) *time-zero*)))
3a30: 29 29 29 0a 09 20 20 20 20 20 0a 09 20 20 20 20 ))).. ..
3a40: 20 3b 3b 20 6b 65 65 70 20 67 6f 69 6e 67 20 75 ;; keep going u
3a50: 6e 6c 65 73 73 20 74 69 6d 65 20 74 6f 20 65 78 nless time to ex
3a60: 69 74 0a 09 20 20 20 20 20 3b 3b 0a 09 20 20 20 it.. ;;..
3a70: 20 20 28 69 66 20 28 6e 6f 74 20 2a 74 69 6d 65 (if (not *time
3a80: 2d 74 6f 2d 65 78 69 74 2a 29 0a 09 09 20 28 6c -to-exit*)... (l
3a90: 65 74 20 64 65 6c 61 79 2d 6c 6f 6f 70 20 28 28 et delay-loop ((
3aa0: 63 6f 75 6e 74 20 30 29 29 0a 09 09 20 20 20 28 count 0))... (
3ab0: 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 2a 74 69 if (and (not *ti
3ac0: 6d 65 2d 74 6f 2d 65 78 69 74 2a 29 0a 09 09 09 me-to-exit*)....
3ad0: 20 20 20 20 28 3c 20 63 6f 75 6e 74 20 31 31 29 (< count 11)
3ae0: 29 20 3b 3b 20 61 70 72 6f 78 20 35 2d 36 20 73 ) ;; aprox 5-6 s
3af0: 65 63 6f 6e 64 73 0a 09 09 20 20 20 20 20 20 20 econds...
3b00: 28 62 65 67 69 6e 0a 09 09 09 20 28 74 68 72 65 (begin.... (thre
3b10: 61 64 2d 73 6c 65 65 70 21 20 31 29 0a 09 09 09 ad-sleep! 1)....
3b20: 20 28 64 65 6c 61 79 2d 6c 6f 6f 70 20 28 2b 20 (delay-loop (+
3b30: 63 6f 75 6e 74 20 31 29 29 29 29 0a 09 09 20 20 count 1))))...
3b40: 20 28 6c 6f 6f 70 29 29 29 0a 09 20 20 20 20 20 (loop)))..
3b50: 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f 77 2d (if (common:low-
3b60: 6e 6f 69 73 65 2d 70 72 69 6e 74 20 33 30 29 0a noise-print 30).
3b70: 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d .. (debug:print-
3b80: 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
3b90: 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 78 69 74 69 log-port* "Exiti
3ba0: 6e 67 20 77 61 74 63 68 64 6f 67 20 74 69 6d 65 ng watchdog time
3bb0: 72 2c 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 r, *time-to-exit
3bc0: 2a 20 3d 20 22 20 2a 74 69 6d 65 2d 74 6f 2d 65 * = " *time-to-e
3bd0: 78 69 74 2a 29 29 29 29 29 0a 20 20 20 20 20 22 xit*))))). "
3be0: 57 61 74 63 68 64 6f 67 20 74 68 72 65 61 64 22 Watchdog thread"
3bf0: 29 29 29 0a 0a 28 74 68 72 65 61 64 2d 73 74 61 )))..(thread-sta
3c00: 72 74 21 20 2a 77 61 74 63 68 64 6f 67 2a 29 0a rt! *watchdog*).
3c10: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
3c20: 61 72 67 20 22 2d 6c 6f 67 22 29 0a 20 20 20 20 arg "-log").
3c30: 28 6c 65 74 20 28 28 6f 75 70 20 28 6f 70 65 6e (let ((oup (open
3c40: 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 28 61 72 -output-file (ar
3c50: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 gs:get-arg "-log
3c60: 22 29 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 ")))). (deb
3c70: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
3c80: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
3c90: 74 2a 20 22 53 65 6e 64 69 6e 67 20 6c 6f 67 20 t* "Sending log
3ca0: 6f 75 74 70 75 74 20 74 6f 20 22 20 28 61 72 67 output to " (arg
3cb0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 s:get-arg "-log"
3cc0: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
3cd0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
3ce0: 2a 20 6f 75 70 29 29 29 0a 0a 28 69 66 20 28 6f * oup)))..(if (o
3cf0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
3d00: 22 2d 68 22 29 0a 09 28 61 72 67 73 3a 67 65 74 "-h")..(args:get
3d10: 2d 61 72 67 20 22 2d 68 65 6c 70 22 29 0a 09 28 -arg "-help")..(
3d20: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 2d args:get-arg "--
3d30: 68 65 6c 70 22 29 29 0a 20 20 20 20 28 62 65 67 help")). (beg
3d40: 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 in. (print
3d50: 68 65 6c 70 29 0a 20 20 20 20 20 20 28 65 78 69 help). (exi
3d60: 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a t)))..(if (args:
3d70: 67 65 74 2d 61 72 67 20 22 2d 6d 61 6e 75 61 6c get-arg "-manual
3d80: 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 68 "). (let* ((h
3d90: 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 28 6f 72 tmlviewercmd (or
3da0: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
3db0: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
3dc0: 74 75 70 22 20 22 68 74 6d 6c 76 69 65 77 65 72 tup" "htmlviewer
3dd0: 63 6d 64 22 29 0a 09 09 09 20 20 20 20 20 20 28 cmd").... (
3de0: 63 6f 6d 6d 6f 6e 3a 77 68 69 63 68 20 27 28 22 common:which '("
3df0: 66 69 72 65 66 6f 78 22 20 22 61 72 6f 72 61 22 firefox" "arora"
3e00: 29 29 29 29 0a 09 20 20 20 28 69 6e 73 74 61 6c )))).. (instal
3e10: 6c 2d 68 6f 6d 65 20 20 28 63 6f 6d 6d 6f 6e 3a l-home (common:
3e20: 67 65 74 2d 69 6e 73 74 61 6c 6c 2d 61 72 65 61 get-install-area
3e30: 29 29 0a 09 20 20 20 28 6d 61 6e 75 61 6c 2d 68 )).. (manual-h
3e40: 74 6d 6c 20 20 20 28 63 6f 6e 63 20 69 6e 73 74 tml (conc inst
3e50: 61 6c 6c 2d 68 6f 6d 65 20 22 2f 73 68 61 72 65 all-home "/share
3e60: 2f 64 6f 63 73 2f 6d 65 67 61 74 65 73 74 5f 6d /docs/megatest_m
3e70: 61 6e 75 61 6c 2e 68 74 6d 6c 22 29 29 29 0a 20 anual.html"))).
3e80: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 69 6e (if (and in
3e90: 73 74 61 6c 6c 2d 68 6f 6d 65 0a 09 20 20 20 20 stall-home..
3ea0: 20 20 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f (file-exists?
3eb0: 20 6d 61 6e 75 61 6c 2d 68 74 6d 6c 29 29 0a 09 manual-html))..
3ec0: 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 (system (conc
3ed0: 22 28 22 20 68 74 6d 6c 76 69 65 77 65 72 63 6d "(" htmlviewercm
3ee0: 64 20 22 20 22 20 6d 61 6e 75 61 6c 2d 68 74 6d d " " manual-htm
3ef0: 6c 20 22 20 29 20 26 22 29 29 0a 09 20 20 28 73 l " ) &")).. (s
3f00: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 28 22 20 ystem (conc "("
3f10: 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 22 20 htmlviewercmd "
3f20: 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f http://www.kiato
3f30: 61 2e 63 6f 6d 2f 63 67 69 2d 62 69 6e 2f 66 6f a.com/cgi-bin/fo
3f40: 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 2f 64 ssils/megatest/d
3f50: 6f 63 2f 74 69 70 2f 64 6f 63 73 2f 6d 61 6e 75 oc/tip/docs/manu
3f60: 61 6c 2f 6d 65 67 61 74 65 73 74 5f 6d 61 6e 75 al/megatest_manu
3f70: 61 6c 2e 68 74 6d 6c 20 29 20 26 22 29 29 29 0a al.html ) &"))).
3f80: 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a (exit)))..
3f90: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
3fa0: 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 0a g "-start-dir").
3fb0: 20 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 (if (file-ex
3fc0: 69 73 74 73 3f 20 28 61 72 67 73 3a 67 65 74 2d ists? (args:get-
3fd0: 61 72 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 arg "-start-dir"
3fe0: 29 29 0a 09 28 63 68 61 6e 67 65 2d 64 69 72 65 ))..(change-dire
3ff0: 63 74 6f 72 79 20 28 61 72 67 73 3a 67 65 74 2d ctory (args:get-
4000: 61 72 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 arg "-start-dir"
4010: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
4020: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
4030: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
4040: 70 6f 72 74 2a 20 22 6e 6f 6e 2d 65 78 69 73 74 port* "non-exist
4050: 61 6e 74 20 73 74 61 72 74 20 64 69 72 20 22 20 ant start dir "
4060: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4070: 73 74 61 72 74 2d 64 69 72 22 29 20 22 20 73 70 start-dir") " sp
4080: 65 63 69 66 69 65 64 2c 20 65 78 69 74 69 6e 67 ecified, exiting
4090: 2e 22 29 0a 09 20 20 28 65 78 69 74 20 31 29 29 .").. (exit 1))
40a0: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
40b0: 74 2d 61 72 67 20 22 2d 76 65 72 73 69 6f 6e 22 t-arg "-version"
40c0: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
40d0: 20 20 20 28 70 72 69 6e 74 20 28 63 6f 6d 6d 6f (print (commo
40e0: 6e 3a 76 65 72 73 69 6f 6e 2d 73 69 67 6e 61 74 n:version-signat
40f0: 75 72 65 29 29 20 3b 3b 20 28 70 72 69 6e 74 20 ure)) ;; (print
4100: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
4110: 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 29 ). (exit)))
4120: 0a 0a 28 64 65 66 69 6e 65 20 2a 64 69 64 73 6f ..(define *didso
4130: 6d 65 74 68 69 6e 67 2a 20 23 66 29 0a 0a 3b 3b mething* #f)..;;
4140: 20 4f 76 65 72 61 6c 6c 20 65 78 69 74 20 68 61 Overall exit ha
4150: 6e 64 6c 69 6e 67 20 73 65 74 75 70 20 69 6d 6d ndling setup imm
4160: 65 64 69 61 74 65 6c 79 0a 3b 3b 0a 28 69 66 20 ediately.;;.(if
4170: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
4180: 67 20 22 2d 70 72 6f 63 65 73 73 2d 72 65 61 70 g "-process-reap
4190: 22 29 29 0a 20 20 20 20 20 20 20 20 3b 3b 20 28 ")). ;; (
41a0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
41b0: 75 6e 74 65 73 74 73 22 29 0a 09 3b 3b 20 28 61 untests")..;; (a
41c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 rgs:get-arg "-ex
41d0: 65 63 75 74 65 22 29 0a 09 3b 3b 20 28 61 72 67 ecute")..;; (arg
41e0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 6d 6f s:get-arg "-remo
41f0: 76 65 2d 72 75 6e 73 22 29 0a 09 3b 3b 20 28 61 ve-runs")..;; (a
4200: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
4210: 6e 73 74 65 70 22 29 29 0a 20 20 20 20 28 6c 65 nstep")). (le
4220: 74 20 28 28 6f 72 69 67 69 6e 61 6c 2d 65 78 69 t ((original-exi
4230: 74 20 28 65 78 69 74 2d 68 61 6e 64 6c 65 72 29 t (exit-handler)
4240: 29 29 0a 20 20 20 20 20 20 28 65 78 69 74 2d 68 )). (exit-h
4250: 61 6e 64 6c 65 72 20 28 6c 61 6d 62 64 61 20 28 andler (lambda (
4260: 23 21 6f 70 74 69 6f 6e 61 6c 20 28 65 78 69 74 #!optional (exit
4270: 2d 63 6f 64 65 20 30 29 29 0a 09 09 20 20 20 20 -code 0))...
4280: 20 20 28 70 72 69 6e 74 66 20 22 50 72 65 70 61 (printf "Prepa
4290: 72 69 6e 67 20 74 6f 20 65 78 69 74 20 77 69 74 ring to exit wit
42a0: 68 20 65 78 69 74 20 63 6f 64 65 20 7e 41 20 2e h exit code ~A .
42b0: 2e 2e 5c 6e 22 20 65 78 69 74 2d 63 6f 64 65 29 ..\n" exit-code)
42c0: 0a 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 ... (for-ea
42d0: 63 68 20 0a 09 09 20 20 20 20 20 20 20 28 6c 61 ch ... (la
42e0: 6d 62 64 61 20 28 70 69 64 29 0a 09 09 09 20 28 mbda (pid).... (
42f0: 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e handle-exception
4300: 73 0a 09 09 09 20 20 65 78 6e 0a 09 09 09 20 20 s.... exn....
4310: 23 74 0a 09 09 09 20 20 28 6c 65 74 2d 76 61 6c #t.... (let-val
4320: 75 65 73 20 28 28 28 70 69 64 2d 76 61 6c 20 65 ues (((pid-val e
4330: 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d xit-status exit-
4340: 63 6f 64 65 29 20 28 70 72 6f 63 65 73 73 2d 77 code) (process-w
4350: 61 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 09 ait pid #t)))...
4360: 09 09 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 .. (if (or
4370: 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 70 69 64 (eq? pid-val pid
4380: 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 65 71 )...... (eq
4390: 3f 20 70 69 64 2d 76 61 6c 20 30 29 29 0a 09 09 ? pid-val 0))...
43a0: 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 ... (begin.....
43b0: 09 20 20 20 20 28 70 72 69 6e 74 66 20 22 53 65 . (printf "Se
43c0: 6e 64 69 6e 67 20 73 69 67 6e 61 6c 2f 74 65 72 nding signal/ter
43d0: 6d 20 74 6f 20 7e 41 5c 6e 22 20 70 69 64 29 0a m to ~A\n" pid).
43e0: 09 09 09 09 09 20 20 20 20 28 70 72 6f 63 65 73 ..... (proces
43f0: 73 2d 73 69 67 6e 61 6c 20 70 69 64 20 73 69 67 s-signal pid sig
4400: 6e 61 6c 2f 74 65 72 6d 29 29 29 29 29 29 0a 09 nal/term))))))..
4410: 09 20 20 20 20 20 20 20 28 70 72 6f 63 65 73 73 . (process
4420: 3a 63 68 69 6c 64 72 65 6e 20 23 66 29 29 0a 09 :children #f))..
4430: 09 20 20 20 20 20 20 28 6f 72 69 67 69 6e 61 6c . (original
4440: 2d 65 78 69 74 20 65 78 69 74 2d 63 6f 64 65 29 -exit exit-code)
4450: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
4460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
44a0: 3b 20 4d 69 73 63 20 73 65 74 75 70 20 73 74 75 ; Misc setup stu
44b0: 66 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ff.;;===========
44c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 ===========..(de
4500: 62 75 67 3a 73 65 74 75 70 29 0a 0a 28 69 66 20 bug:setup)..(if
4510: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4520: 6c 6f 67 67 69 6e 67 22 29 28 73 65 74 21 20 2a logging")(set! *
4530: 6c 6f 67 67 69 6e 67 2a 20 23 74 29 29 0a 0a 28 logging* #t))..(
4540: 69 66 20 28 64 65 62 75 67 3a 64 65 62 75 67 2d if (debug:debug-
4550: 6d 6f 64 65 20 33 29 20 3b 3b 20 77 65 20 61 72 mode 3) ;; we ar
4560: 65 20 6f 62 76 69 6f 75 73 6c 79 20 64 65 62 75 e obviously debu
4570: 67 67 69 6e 67 0a 20 20 20 20 28 73 65 74 21 20 gging. (set!
4580: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 6f open-run-close o
4590: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f pen-run-close-no
45a0: 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c -exception-handl
45b0: 69 6e 67 29 29 0a 0a 28 69 66 20 28 61 72 67 73 ing))..(if (args
45c0: 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 :get-arg "-itemp
45d0: 61 74 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 att"). (let (
45e0: 28 6e 65 77 76 61 6c 20 28 63 6f 6e 63 20 28 61 (newval (conc (a
45f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
4600: 73 74 70 61 74 74 22 29 20 22 2f 22 20 28 61 72 stpatt") "/" (ar
4610: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 gs:get-arg "-ite
4620: 6d 70 61 74 74 22 29 29 29 29 0a 20 20 20 20 20 mpatt")))).
4630: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
4640: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
4650: 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 2d 69 74 t* "WARNING: -it
4660: 65 6d 70 61 74 74 20 68 61 73 20 62 65 65 6e 20 empatt has been
4670: 64 65 70 72 65 63 61 74 65 64 2c 20 70 6c 65 61 deprecated, plea
4680: 73 65 20 75 73 65 20 2d 74 65 73 74 70 61 74 74 se use -testpatt
4690: 20 74 65 73 74 70 61 74 74 2f 69 74 65 6d 70 61 testpatt/itempa
46a0: 74 74 20 6d 65 74 68 6f 64 2c 20 6e 65 77 20 74 tt method, new t
46b0: 65 73 74 70 61 74 74 20 69 73 20 22 6e 65 77 76 estpatt is "newv
46c0: 61 6c 29 0a 20 20 20 20 20 20 28 68 61 73 68 2d al). (hash-
46d0: 74 61 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a table-set! args:
46e0: 61 72 67 2d 68 61 73 68 20 22 2d 74 65 73 74 70 arg-hash "-testp
46f0: 61 74 74 22 20 6e 65 77 76 61 6c 29 0a 20 20 20 att" newval).
4700: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 (hash-table-d
4710: 65 6c 65 74 65 21 20 61 72 67 73 3a 61 72 67 2d elete! args:arg-
4720: 68 61 73 68 20 22 2d 69 74 65 6d 70 61 74 74 22 hash "-itempatt"
4730: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
4740: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
4750: 73 22 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 s"). (debug:p
4760: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
4770: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
4780: 4e 47 3a 20 5c 22 2d 72 75 6e 74 65 73 74 73 5c NG: \"-runtests\
4790: 22 20 69 73 20 64 65 70 72 65 63 61 74 65 64 2e " is deprecated.
47a0: 20 55 73 65 20 5c 22 2d 72 75 6e 5c 22 20 77 69 Use \"-run\" wi
47b0: 74 68 20 5c 22 2d 74 65 73 74 70 61 74 74 5c 22 th \"-testpatt\"
47c0: 20 69 6e 73 74 65 61 64 22 29 29 0a 0a 28 6f 6e instead"))..(on
47d0: 2d 65 78 69 74 20 73 74 64 2d 65 78 69 74 2d 70 -exit std-exit-p
47e0: 72 6f 63 65 64 75 72 65 29 0a 0a 3b 3b 3d 3d 3d rocedure)..;;===
47f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4830: 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 20 67 65 6e 65 ===.;; Misc gene
4840: 72 61 6c 20 63 61 6c 6c 73 0a 3b 3b 3d 3d 3d 3d ral calls.;;====
4850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4890: 3d 3d 0a 0a 3b 3b 20 68 61 6e 64 6c 65 20 61 20 ==..;; handle a
48a0: 63 6c 65 61 6e 2d 63 61 63 68 65 20 72 65 71 75 clean-cache requ
48b0: 65 73 74 20 61 73 20 65 61 72 6c 79 20 61 73 20 est as early as
48c0: 70 6f 73 73 69 62 6c 65 0a 3b 3b 0a 28 69 66 20 possible.;;.(if
48d0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
48e0: 63 6c 65 61 6e 2d 63 61 63 68 65 22 29 0a 20 20 clean-cache").
48f0: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
4900: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
4910: 6e 67 2a 20 23 74 29 20 3b 3b 20 73 75 70 70 72 ng* #t) ;; suppr
4920: 65 73 73 20 74 68 65 20 68 65 6c 70 20 6f 75 74 ess the help out
4930: 70 75 74 2e 0a 20 20 20 20 20 20 28 69 66 20 28 put.. (if (
4940: 67 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 getenv "MT_TARGE
4950: 54 22 29 20 3b 3b 20 6e 6f 20 70 6f 69 6e 74 20 T") ;; no point
4960: 69 6e 20 74 72 79 69 6e 67 20 69 66 20 6e 6f 20 in trying if no
4970: 74 61 72 67 65 74 0a 09 20 20 28 69 66 20 28 61 target.. (if (a
4980: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
4990: 6e 6e 61 6d 65 22 29 0a 09 20 20 20 20 20 20 28 nname").. (
49a0: 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 20 let* ((toppath
49b0: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
49c0: 09 09 20 20 20 20 20 28 6c 69 6e 6b 74 72 65 65 .. (linktree
49d0: 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 63 6f (if toppath (co
49e0: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f nfigf:lookup *co
49f0: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
4a00: 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 29 0a 09 "linktree")))..
4a10: 09 20 20 20 20 20 28 72 75 6e 74 6f 70 20 20 20 . (runtop
4a20: 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 22 (conc linktree "
4a30: 2f 22 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 /" (getenv "MT_T
4a40: 41 52 47 45 54 22 29 20 22 2f 22 20 28 61 72 67 ARGET") "/" (arg
4a50: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
4a60: 61 6d 65 22 29 29 29 0a 09 09 20 20 20 20 20 28 ame")))... (
4a70: 66 69 6c 65 73 20 20 20 20 28 69 66 20 28 66 69 files (if (fi
4a80: 6c 65 2d 65 78 69 73 74 73 3f 20 72 75 6e 74 6f le-exists? runto
4a90: 70 29 0a 09 09 09 09 20 20 20 28 61 70 70 65 6e p)..... (appen
4aa0: 64 20 28 67 6c 6f 62 20 28 63 6f 6e 63 20 72 75 d (glob (conc ru
4ab0: 6e 74 6f 70 20 22 2f 2e 6d 65 67 61 74 65 73 74 ntop "/.megatest
4ac0: 2a 22 29 29 0a 09 09 09 09 09 20 20 20 28 67 6c *"))...... (gl
4ad0: 6f 62 20 28 63 6f 6e 63 20 72 75 6e 74 6f 70 20 ob (conc runtop
4ae0: 22 2f 2e 72 75 6e 63 6f 6e 66 69 67 2a 22 29 29 "/.runconfig*"))
4af0: 29 0a 09 09 09 09 20 20 20 27 28 29 29 29 29 0a )..... '()))).
4b00: 09 09 28 69 66 20 28 6e 75 6c 6c 3f 20 66 69 6c ..(if (null? fil
4b10: 65 73 29 0a 09 09 20 20 20 20 28 64 65 62 75 67 es)... (debug
4b20: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 :print-info 0 *d
4b30: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
4b40: 20 22 4e 6f 20 63 61 63 68 65 64 20 6d 65 67 61 "No cached mega
4b50: 74 65 73 74 20 6f 72 20 72 75 6e 63 6f 6e 66 69 test or runconfi
4b60: 67 73 20 66 69 6c 65 73 20 66 6f 75 6e 64 2e 20 gs files found.
4b70: 4e 6f 6e 65 20 72 65 6d 6f 76 65 64 2e 22 29 0a None removed.").
4b80: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 .. (begin...
4b90: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
4ba0: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
4bb0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 65 6d t-log-port* "Rem
4bc0: 6f 76 69 6e 67 20 63 61 63 68 65 64 20 66 69 6c oving cached fil
4bd0: 65 73 3a 5c 6e 20 20 20 20 22 20 28 73 74 72 69 es:\n " (stri
4be0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 ng-intersperse f
4bf0: 69 6c 65 73 20 22 5c 6e 20 20 20 20 22 29 29 0a iles "\n ")).
4c00: 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 .. (for-eac
4c10: 68 20 0a 09 09 20 20 20 20 20 20 20 28 6c 61 6d h ... (lam
4c20: 62 64 61 20 28 66 29 0a 09 09 09 20 28 68 61 6e bda (f).... (han
4c30: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
4c40: 09 09 20 20 20 20 20 65 78 6e 0a 09 09 09 20 20 .. exn....
4c50: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
4c60: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
4c70: 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 46 ort* "WARNING: F
4c80: 61 69 6c 65 64 20 74 6f 20 72 65 6d 6f 76 65 20 ailed to remove
4c90: 66 69 6c 65 20 22 20 66 29 0a 09 09 09 20 20 20 file " f)....
4ca0: 28 64 65 6c 65 74 65 2d 66 69 6c 65 20 66 29 29 (delete-file f))
4cb0: 29 0a 09 09 20 20 20 20 20 20 20 66 69 6c 65 73 )... files
4cc0: 29 29 29 29 0a 09 20 20 20 20 20 20 28 64 65 62 )))).. (deb
4cd0: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
4ce0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
4cf0: 72 74 2a 20 22 2d 63 6c 65 61 6e 2d 63 61 63 68 rt* "-clean-cach
4d00: 65 20 72 65 71 75 69 72 65 73 20 2d 72 75 6e 6e e requires -runn
4d10: 61 6d 65 2e 22 29 29 0a 09 20 20 28 64 65 62 75 ame.")).. (debu
4d20: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
4d30: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
4d40: 74 2a 20 22 2d 63 6c 65 61 6e 2d 63 61 63 68 65 t* "-clean-cache
4d50: 20 72 65 71 75 69 72 65 73 20 2d 74 61 72 67 65 requires -targe
4d60: 74 20 6f 72 20 2d 72 65 71 74 61 72 67 22 29 29 t or -reqtarg"))
4d70: 29 29 0a 09 20 20 20 20 0a 09 20 20 0a 28 69 66 )).. .. .(if
4d80: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4d90: 2d 65 6e 76 32 66 69 6c 65 22 29 0a 20 20 20 20 -env2file").
4da0: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 73 61 (begin. (sa
4db0: 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 ve-environment-a
4dc0: 73 2d 66 69 6c 65 73 20 28 61 72 67 73 3a 67 65 s-files (args:ge
4dd0: 74 2d 61 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 t-arg "-env2file
4de0: 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ")). (set!
4df0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
4e00: 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a t)))..(if (args:
4e10: 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 get-arg "-list-d
4e20: 69 73 6b 73 22 29 0a 20 20 20 20 28 6c 65 74 20 isks"). (let
4e30: 28 28 74 6f 70 70 61 74 68 20 28 6c 61 75 6e 63 ((toppath (launc
4e40: 68 3a 73 65 74 75 70 29 29 29 0a 20 20 20 20 20 h:setup))).
4e50: 20 28 70 72 69 6e 74 20 0a 20 20 20 20 20 20 20 (print .
4e60: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
4e70: 72 73 65 20 0a 09 28 6d 61 70 20 28 6c 61 6d 62 rse ..(map (lamb
4e80: 64 61 20 28 78 29 0a 09 20 20 20 20 20 20 20 28 da (x).. (
4e90: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
4ea0: 73 65 20 0a 09 09 78 0a 09 09 22 20 3d 3e 20 22 se ...x..." => "
4eb0: 29 29 0a 09 20 20 20 20 20 28 63 6f 6d 6d 6f 6e )).. (common
4ec0: 3a 67 65 74 2d 64 69 73 6b 73 20 2a 63 6f 6e 66 :get-disks *conf
4ed0: 69 67 64 61 74 2a 29 29 0a 09 22 5c 6e 22 29 29 igdat*)).."\n"))
4ee0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
4ef0: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
4f00: 29 0a 0a 3b 3b 20 63 73 76 20 70 72 6f 63 65 73 )..;; csv proces
4f10: 73 69 6e 67 20 72 65 63 6f 72 64 0a 28 64 65 66 sing record.(def
4f20: 69 6e 65 20 28 6d 61 6b 65 2d 72 65 66 64 62 3a ine (make-refdb:
4f30: 63 73 76 29 0a 20 20 28 76 65 63 74 6f 72 20 0a csv). (vector .
4f40: 20 20 20 28 6d 61 6b 65 2d 73 70 61 72 73 65 2d (make-sparse-
4f50: 61 72 72 61 79 29 0a 20 20 20 28 6d 61 6b 65 2d array). (make-
4f60: 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 20 28 hash-table). (
4f70: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
4f80: 0a 20 20 20 30 0a 20 20 20 30 29 29 0a 28 64 65 . 0. 0)).(de
4f90: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 fine-inline (ref
4fa0: 64 62 3a 63 73 76 2d 67 65 74 2d 73 76 65 63 20 db:csv-get-svec
4fb0: 20 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 vec) (vec
4fc0: 74 6f 72 2d 72 65 66 20 20 76 65 63 20 30 29 29 tor-ref vec 0))
4fd0: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
4fe0: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 72 (refdb:csv-get-r
4ff0: 6f 77 73 20 20 20 20 20 76 65 63 29 20 20 20 20 ows vec)
5000: 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 (vector-ref vec
5010: 20 31 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 1)).(define-inl
5020: 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 2d 67 ine (refdb:csv-g
5030: 65 74 2d 63 6f 6c 73 20 20 20 20 20 76 65 63 29 et-cols vec)
5040: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
5050: 20 76 65 63 20 32 29 29 0a 28 64 65 66 69 6e 65 vec 2)).(define
5060: 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 -inline (refdb:c
5070: 73 76 2d 67 65 74 2d 6d 61 78 72 6f 77 20 20 20 sv-get-maxrow
5080: 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d vec) (vector-
5090: 72 65 66 20 20 76 65 63 20 33 29 29 0a 28 64 65 ref vec 3)).(de
50a0: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 fine-inline (ref
50b0: 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 63 6f db:csv-get-maxco
50c0: 6c 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 l vec) (vec
50d0: 74 6f 72 2d 72 65 66 20 20 76 65 63 20 34 29 29 tor-ref vec 4))
50e0: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
50f0: 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 73 (refdb:csv-set-s
5100: 76 65 63 21 20 20 20 20 76 65 63 20 76 61 6c 29 vec! vec val)
5110: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
5120: 20 30 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 0 val)).(define
5130: 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 -inline (refdb:c
5140: 73 76 2d 73 65 74 2d 72 6f 77 73 21 20 20 20 20 sv-set-rows!
5150: 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d vec val)(vector-
5160: 73 65 74 21 20 76 65 63 20 31 20 76 61 6c 29 29 set! vec 1 val))
5170: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
5180: 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 63 (refdb:csv-set-c
5190: 6f 6c 73 21 20 20 20 20 76 65 63 20 76 61 6c 29 ols! vec val)
51a0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
51b0: 20 32 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2 val)).(define
51c0: 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 -inline (refdb:c
51d0: 73 76 2d 73 65 74 2d 6d 61 78 72 6f 77 21 20 20 sv-set-maxrow!
51e0: 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d vec val)(vector-
51f0: 73 65 74 21 20 76 65 63 20 33 20 76 61 6c 29 29 set! vec 3 val))
5200: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 .(define-inline
5210: 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d (refdb:csv-set-m
5220: 61 78 63 6f 6c 21 20 20 76 65 63 20 76 61 6c 29 axcol! vec val)
5230: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
5240: 20 34 20 76 61 6c 29 29 0a 0a 28 64 65 66 69 6e 4 val))..(defin
5250: 65 20 28 67 65 74 2d 64 61 74 20 72 65 73 75 6c e (get-dat resul
5260: 74 73 20 73 68 65 65 74 6e 61 6d 65 29 0a 20 20 ts sheetname).
5270: 28 6f 72 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (or (hash-table-
5280: 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 75 ref/default resu
5290: 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 20 23 66 lts sheetname #f
52a0: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 ). (let ((t
52b0: 6d 70 2d 76 65 63 20 20 28 6d 61 6b 65 2d 72 65 mp-vec (make-re
52c0: 66 64 62 3a 63 73 76 29 29 29 0a 09 28 68 61 73 fdb:csv)))..(has
52d0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 h-table-set! res
52e0: 75 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 20 74 ults sheetname t
52f0: 6d 70 2d 76 65 63 29 0a 09 74 6d 70 2d 76 65 63 mp-vec)..tmp-vec
5300: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
5310: 65 74 2d 61 72 67 20 22 2d 72 65 66 64 62 32 64 et-arg "-refdb2d
5320: 61 74 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 at"). (let* (
5330: 28 69 6e 70 75 74 2d 64 62 20 28 61 72 67 73 3a (input-db (args:
5340: 67 65 74 2d 61 72 67 20 22 2d 72 65 66 64 62 32 get-arg "-refdb2
5350: 64 61 74 22 29 29 0a 09 20 20 20 28 6f 75 74 2d dat")).. (out-
5360: 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 file (args:get-a
5370: 72 67 20 22 2d 6f 22 29 29 0a 09 20 20 20 28 6f rg "-o")).. (o
5380: 75 74 2d 66 6d 74 20 20 28 6f 72 20 28 61 72 67 ut-fmt (or (arg
5390: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
53a0: 6d 6f 64 65 22 29 20 22 73 63 68 65 6d 65 22 29 mode") "scheme")
53b0: 29 0a 09 20 20 20 28 6f 75 74 2d 70 6f 72 74 20 ).. (out-port
53c0: 28 69 66 20 28 61 6e 64 20 6f 75 74 2d 66 69 6c (if (and out-fil
53d0: 65 20 0a 09 09 09 20 20 20 20 20 20 28 6e 6f 74 e .... (not
53e0: 20 28 6d 65 6d 62 65 72 20 6f 75 74 2d 66 6d 74 (member out-fmt
53f0: 20 27 28 22 73 71 6c 69 74 65 33 22 20 22 63 73 '("sqlite3" "cs
5400: 76 22 29 29 29 29 0a 09 09 09 20 28 6f 70 65 6e v")))).... (open
5410: 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 6f 75 74 -output-file out
5420: 2d 66 69 6c 65 29 0a 09 09 09 20 28 63 75 72 72 -file).... (curr
5430: 65 6e 74 2d 6f 75 74 70 75 74 2d 70 6f 72 74 29 ent-output-port)
5440: 29 29 0a 09 20 20 20 28 72 65 73 2d 64 61 74 61 )).. (res-data
5450: 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 72 (configf:read-r
5460: 65 66 64 62 20 69 6e 70 75 74 2d 64 62 29 29 0a efdb input-db)).
5470: 09 20 20 20 28 64 61 74 61 20 20 20 20 20 28 63 . (data (c
5480: 61 72 20 72 65 73 2d 64 61 74 61 29 29 0a 09 20 ar res-data))..
5490: 20 20 28 6d 73 67 20 20 20 20 20 20 28 63 61 64 (msg (cad
54a0: 72 20 72 65 73 2d 64 61 74 61 29 29 29 0a 20 20 r res-data))).
54b0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 64 61 74 (if (not dat
54c0: 61 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 a).. (debug:pri
54d0: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
54e0: 67 2d 70 6f 72 74 2a 20 22 42 61 64 20 69 6e 70 g-port* "Bad inp
54f0: 75 74 3f 20 64 61 74 61 3d 22 20 64 61 74 61 29 ut? data=" data)
5500: 20 3b 3b 20 73 6f 6d 65 20 65 72 72 6f 72 20 6f ;; some error o
5510: 63 63 75 72 72 65 64 0a 09 20 20 28 77 69 74 68 ccurred.. (with
5520: 2d 6f 75 74 70 75 74 2d 74 6f 2d 70 6f 72 74 20 -output-to-port
5530: 6f 75 74 2d 70 6f 72 74 0a 09 20 20 20 20 28 6c out-port.. (l
5540: 61 6d 62 64 61 20 28 29 0a 09 20 20 20 20 20 20 ambda ()..
5550: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
5560: 79 6d 62 6f 6c 20 6f 75 74 2d 66 6d 74 29 0a 09 ymbol out-fmt)..
5570: 09 28 28 73 63 68 65 6d 65 29 28 70 70 20 64 61 .((scheme)(pp da
5580: 74 61 29 29 0a 09 09 28 28 70 65 72 6c 29 0a 09 ta))...((perl)..
5590: 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 25 68 61 . ;; (print "%ha
55a0: 73 68 20 3d 20 28 22 29 0a 09 09 20 3b 3b 20 20 sh = (")... ;;
55b0: 20 20 20 20 20 20 6b 65 79 31 20 3d 3e 20 27 76 key1 => 'v
55c0: 61 6c 75 65 31 27 2c 0a 09 09 20 3b 3b 20 20 20 alue1',... ;;
55d0: 20 20 20 20 20 6b 65 79 32 20 3d 3e 20 27 76 61 key2 => 'va
55e0: 6c 75 65 32 27 2c 0a 09 09 20 3b 3b 20 20 20 20 lue2',... ;;
55f0: 20 20 20 20 6b 65 79 33 20 3d 3e 20 27 76 61 6c key3 => 'val
5600: 75 65 33 27 2c 0a 09 09 20 3b 3b 20 29 3b 0a 09 ue3',... ;; );..
5610: 09 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 . (configf:map-a
5620: 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 20 0a 09 ll-hier-alist ..
5630: 09 20 20 64 61 74 61 20 0a 09 09 20 20 28 6c 61 . data ... (la
5640: 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 mbda (sheetname
5650: 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e sectionname varn
5660: 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 28 ame val)... (
5670: 70 72 69 6e 74 20 22 24 64 61 74 61 7b 5c 22 22 print "$data{\""
5680: 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 7d 7b sheetname "\"}{
5690: 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 \"" sectionname
56a0: 22 5c 22 7d 7b 5c 22 22 20 76 61 72 6e 61 6d 65 "\"}{\"" varname
56b0: 20 22 5c 22 7d 20 3d 20 5c 22 22 20 76 61 6c 20 "\"} = \"" val
56c0: 22 5c 22 3b 22 29 29 29 29 0a 09 09 28 28 70 79 "\";"))))...((py
56d0: 74 68 6f 6e 20 72 75 62 79 29 0a 09 09 20 28 70 thon ruby)... (p
56e0: 72 69 6e 74 20 22 64 61 74 61 3d 7b 7d 22 29 0a rint "data={}").
56f0: 09 09 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d .. (configf:map-
5700: 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 0a 09 all-hier-alist..
5710: 09 20 20 64 61 74 61 0a 09 09 20 20 28 6c 61 6d . data... (lam
5720: 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 bda (sheetname s
5730: 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 ectionname varna
5740: 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 28 70 me val)... (p
5750: 72 69 6e 74 20 22 64 61 74 61 5b 5c 22 22 20 73 rint "data[\"" s
5760: 68 65 65 74 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 heetname "\"][\"
5770: 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 5c " sectionname "\
5780: 22 5d 5b 5c 22 22 20 76 61 72 6e 61 6d 65 20 22 "][\"" varname "
5790: 5c 22 5d 20 3d 20 5c 22 22 20 76 61 6c 20 22 5c \"] = \"" val "\
57a0: 22 22 29 29 0a 09 09 20 20 69 6e 69 74 70 72 6f ""))... initpro
57b0: 63 31 3a 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 c1:... (lambda
57c0: 28 73 68 65 65 74 6e 61 6d 65 29 0a 09 09 20 20 (sheetname)...
57d0: 20 20 28 70 72 69 6e 74 20 22 64 61 74 61 5b 5c (print "data[\
57e0: 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 "" sheetname "\"
57f0: 5d 20 3d 20 7b 7d 22 29 29 0a 09 09 20 20 69 6e ] = {}"))... in
5800: 69 74 70 72 6f 63 32 3a 0a 09 09 20 20 28 6c 61 itproc2:... (la
5810: 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 mbda (sheetname
5820: 73 65 63 74 69 6f 6e 6e 61 6d 65 29 0a 09 09 20 sectionname)...
5830: 20 20 20 28 70 72 69 6e 74 20 22 64 61 74 61 5b (print "data[
5840: 5c 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 5c \"" sheetname "\
5850: 22 5d 5b 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 "][\"" sectionna
5860: 6d 65 20 22 5c 22 5d 20 3d 20 7b 7d 22 29 29 29 me "\"] = {}")))
5870: 29 0a 09 09 28 28 63 73 76 29 0a 09 09 20 28 6c )...((csv)... (l
5880: 65 74 2a 20 28 28 72 65 73 75 6c 74 73 20 20 28 et* ((results (
5890: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
58a0: 29 20 3b 3b 20 28 6d 61 6b 65 2d 73 70 61 72 73 ) ;; (make-spars
58b0: 65 2d 61 72 72 61 79 29 29 29 0a 09 09 09 28 72 e-array)))....(r
58c0: 6f 77 2d 63 6f 6c 73 20 28 6d 61 6b 65 2d 68 61 ow-cols (make-ha
58d0: 73 68 2d 74 61 62 6c 65 29 29 29 20 3b 3b 20 68 sh-table))) ;; h
58e0: 61 73 68 20 6f 66 20 68 61 73 68 65 73 20 77 68 ash of hashes wh
58f0: 65 72 65 20 73 65 63 74 69 6f 6e 20 3d 3e 20 68 ere section => h
5900: 74 20 7b 20 72 6f 77 2d 3c 6e 61 6d 65 3e 20 3d t { row-<name> =
5910: 3e 20 6e 75 6d 20 6f 72 20 63 6f 6c 2d 3c 6e 61 > num or col-<na
5920: 6d 65 3e 20 3d 3e 20 6e 75 6d 0a 09 09 20 20 20 me> => num...
5930: 3b 3b 20 28 70 72 69 6e 74 20 22 64 61 74 61 3d ;; (print "data=
5940: 22 29 0a 09 09 20 20 20 3b 3b 20 28 70 70 20 64 ")... ;; (pp d
5950: 61 74 61 29 0a 09 09 20 20 20 28 63 6f 6e 66 69 ata)... (confi
5960: 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d gf:map-all-hier-
5970: 61 6c 69 73 74 0a 09 09 20 20 20 20 64 61 74 61 alist... data
5980: 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ... (lambda (
5990: 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f sheetname sectio
59a0: 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 nname varname va
59b0: 6c 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 28 70 l)... ;; (p
59c0: 72 69 6e 74 20 22 73 68 65 65 74 6e 61 6d 65 3a rint "sheetname:
59d0: 20 22 20 73 68 65 65 74 6e 61 6d 65 20 22 2c 20 " sheetname ",
59e0: 73 65 63 74 69 6f 6e 6e 61 6d 65 3a 20 22 20 73 sectionname: " s
59f0: 65 63 74 69 6f 6e 6e 61 6d 65 20 22 2c 20 76 61 ectionname ", va
5a00: 72 6e 61 6d 65 3a 20 22 20 76 61 72 6e 61 6d 65 rname: " varname
5a10: 20 22 2c 20 76 61 6c 3a 20 22 20 76 61 6c 29 0a ", val: " val).
5a20: 09 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 .. (let* ((
5a30: 64 61 74 20 20 20 20 20 20 28 67 65 74 2d 64 61 dat (get-da
5a40: 74 20 72 65 73 75 6c 74 73 20 73 68 65 65 74 6e t results sheetn
5a50: 61 6d 65 29 29 0a 09 09 09 20 20 20 20 20 28 76 ame)).... (v
5a60: 65 63 20 20 20 20 20 20 28 72 65 66 64 62 3a 63 ec (refdb:c
5a70: 73 76 2d 67 65 74 2d 73 76 65 63 20 64 61 74 29 sv-get-svec dat)
5a80: 29 0a 09 09 09 20 20 20 20 20 28 72 6f 77 6e 61 ).... (rowna
5a90: 6d 65 73 20 28 72 65 66 64 62 3a 63 73 76 2d 67 mes (refdb:csv-g
5aa0: 65 74 2d 72 6f 77 73 20 64 61 74 29 29 0a 09 09 et-rows dat))...
5ab0: 09 20 20 20 20 20 28 63 6f 6c 6e 61 6d 65 73 20 . (colnames
5ac0: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 63 (refdb:csv-get-c
5ad0: 6f 6c 73 20 64 61 74 29 29 0a 09 09 09 20 20 20 ols dat))....
5ae0: 20 20 28 63 75 72 72 72 6f 77 6e 20 28 68 61 73 (currrown (has
5af0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
5b00: 75 6c 74 20 72 6f 77 6e 61 6d 65 73 20 76 61 72 ult rownames var
5b10: 6e 61 6d 65 20 23 66 29 29 0a 09 09 09 20 20 20 name #f))....
5b20: 20 20 28 63 75 72 72 63 6f 6c 6e 20 28 68 61 73 (currcoln (has
5b30: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
5b40: 75 6c 74 20 63 6f 6c 6e 61 6d 65 73 20 73 65 63 ult colnames sec
5b50: 74 69 6f 6e 6e 61 6d 65 20 23 66 29 29 0a 09 09 tionname #f))...
5b60: 09 20 20 20 20 20 28 72 6f 77 6e 20 20 20 20 20 . (rown
5b70: 28 6f 72 20 63 75 72 72 72 6f 77 6e 20 0a 09 09 (or currrown ...
5b80: 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 6c 61 ... (let* ((la
5b90: 73 74 6e 20 20 20 28 72 65 66 64 62 3a 63 73 76 stn (refdb:csv
5ba0: 2d 67 65 74 2d 6d 61 78 72 6f 77 20 64 61 74 29 -get-maxrow dat)
5bb0: 29 0a 09 09 09 09 09 09 20 20 28 6e 65 77 72 6f )....... (newro
5bc0: 77 6e 20 28 2b 20 6c 61 73 74 6e 20 31 29 29 29 wn (+ lastn 1)))
5bd0: 0a 09 09 09 09 09 20 20 20 20 20 28 72 65 66 64 ...... (refd
5be0: 62 3a 63 73 76 2d 73 65 74 2d 6d 61 78 72 6f 77 b:csv-set-maxrow
5bf0: 21 20 64 61 74 20 6e 65 77 72 6f 77 6e 29 0a 09 ! dat newrown)..
5c00: 09 09 09 09 20 20 20 20 20 6e 65 77 72 6f 77 6e .... newrown
5c10: 29 29 29 0a 09 09 09 20 20 20 20 20 28 63 6f 6c ))).... (col
5c20: 6e 20 20 20 20 20 28 6f 72 20 63 75 72 72 63 6f n (or currco
5c30: 6c 6e 20 0a 09 09 09 09 09 20 20 20 28 6c 65 74 ln ...... (let
5c40: 2a 20 28 28 6c 61 73 74 6e 20 20 20 28 72 65 66 * ((lastn (ref
5c50: 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 63 6f db:csv-get-maxco
5c60: 6c 20 64 61 74 29 29 0a 09 09 09 09 09 09 20 20 l dat)).......
5c70: 28 6e 65 77 63 6f 6c 6e 20 28 2b 20 6c 61 73 74 (newcoln (+ last
5c80: 6e 20 31 29 29 29 0a 09 09 09 09 09 20 20 20 20 n 1)))......
5c90: 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 2d (refdb:csv-set-
5ca0: 6d 61 78 63 6f 6c 21 20 64 61 74 20 6e 65 77 63 maxcol! dat newc
5cb0: 6f 6c 6e 29 0a 09 09 09 09 09 20 20 20 20 20 6e oln)...... n
5cc0: 65 77 63 6f 6c 6e 29 29 29 29 0a 09 09 09 28 69 ewcoln))))....(i
5cd0: 66 20 28 6e 6f 74 20 28 73 70 61 72 73 65 2d 61 f (not (sparse-a
5ce0: 72 72 61 79 2d 72 65 66 20 76 65 63 20 30 20 63 rray-ref vec 0 c
5cf0: 6f 6c 6e 29 29 20 3b 3b 20 28 65 71 3f 20 72 6f oln)) ;; (eq? ro
5d00: 77 6e 20 30 29 0a 09 09 09 20 20 20 20 28 62 65 wn 0).... (be
5d10: 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 73 70 gin.... (sp
5d20: 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 21 20 arse-array-set!
5d30: 76 65 63 20 30 20 63 6f 6c 6e 20 73 65 63 74 69 vec 0 coln secti
5d40: 6f 6e 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 onname)....
5d50: 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 70 61 72 ;; (print "spar
5d60: 73 65 2d 61 72 72 61 79 2d 72 65 66 20 22 20 30 se-array-ref " 0
5d70: 20 22 2c 22 20 63 6f 6c 6e 20 22 3d 22 20 28 73 "," coln "=" (s
5d80: 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 parse-array-ref
5d90: 76 65 63 20 30 20 63 6f 6c 6e 29 29 0a 09 09 09 vec 0 coln))....
5da0: 20 20 20 20 20 20 29 29 0a 09 09 09 28 69 66 20 ))....(if
5db0: 28 6e 6f 74 20 28 73 70 61 72 73 65 2d 61 72 72 (not (sparse-arr
5dc0: 61 79 2d 72 65 66 20 76 65 63 20 72 6f 77 6e 20 ay-ref vec rown
5dd0: 30 29 29 20 3b 3b 20 28 65 71 3f 20 63 6f 6c 6e 0)) ;; (eq? coln
5de0: 20 30 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 0).... (begi
5df0: 6e 0a 09 09 09 20 20 20 20 20 20 28 73 70 61 72 n.... (spar
5e00: 73 65 2d 61 72 72 61 79 2d 73 65 74 21 20 76 65 se-array-set! ve
5e10: 63 20 72 6f 77 6e 20 30 20 76 61 72 6e 61 6d 65 c rown 0 varname
5e20: 29 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 28 70 ).... ;; (p
5e30: 72 69 6e 74 20 22 73 70 61 72 73 65 2d 61 72 72 rint "sparse-arr
5e40: 61 79 2d 72 65 66 20 22 20 72 6f 77 6e 20 22 2c ay-ref " rown ",
5e50: 22 20 30 20 22 3d 22 20 28 73 70 61 72 73 65 2d " 0 "=" (sparse-
5e60: 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 72 6f array-ref vec ro
5e70: 77 6e 20 30 29 29 0a 09 09 09 20 20 20 20 20 20 wn 0))....
5e80: 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 63 ))....(if (not c
5e90: 75 72 72 72 6f 77 6e 29 28 68 61 73 68 2d 74 61 urrrown)(hash-ta
5ea0: 62 6c 65 2d 73 65 74 21 20 72 6f 77 6e 61 6d 65 ble-set! rowname
5eb0: 73 20 76 61 72 6e 61 6d 65 20 72 6f 77 6e 29 29 s varname rown))
5ec0: 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 63 75 72 ....(if (not cur
5ed0: 72 63 6f 6c 6e 29 28 68 61 73 68 2d 74 61 62 6c rcoln)(hash-tabl
5ee0: 65 2d 73 65 74 21 20 63 6f 6c 6e 61 6d 65 73 20 e-set! colnames
5ef0: 73 65 63 74 69 6f 6e 6e 61 6d 65 20 63 6f 6c 6e sectionname coln
5f00: 29 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e 74 20 ))....;; (print
5f10: 22 64 61 74 3d 22 20 64 61 74 20 22 2c 20 72 6f "dat=" dat ", ro
5f20: 77 6e 3d 22 20 72 6f 77 6e 20 22 2c 20 63 6f 6c wn=" rown ", col
5f30: 6e 3d 22 20 63 6f 6c 6e 29 0a 09 09 09 28 73 70 n=" coln)....(sp
5f40: 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 21 20 arse-array-set!
5f50: 76 65 63 20 72 6f 77 6e 20 63 6f 6c 6e 20 76 61 vec rown coln va
5f60: 6c 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e 74 20 l)....;; (print
5f70: 22 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 "sparse-array-re
5f80: 66 20 22 20 72 6f 77 6e 20 22 2c 22 20 63 6f 6c f " rown "," col
5f90: 6e 20 22 3d 22 20 28 73 70 61 72 73 65 2d 61 72 n "=" (sparse-ar
5fa0: 72 61 79 2d 72 65 66 20 76 65 63 20 72 6f 77 6e ray-ref vec rown
5fb0: 20 63 6f 6c 6e 29 29 0a 09 09 09 29 29 29 0a 09 coln))....)))..
5fc0: 09 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 . (for-each...
5fd0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 (lambda (she
5fe0: 65 74 6e 61 6d 65 29 0a 09 09 20 20 20 20 20 20 etname)...
5ff0: 28 6c 65 74 2a 20 28 28 73 68 65 65 74 64 61 74 (let* ((sheetdat
6000: 20 28 67 65 74 2d 64 61 74 20 72 65 73 75 6c 74 (get-dat result
6010: 73 20 73 68 65 65 74 6e 61 6d 65 29 29 0a 09 09 s sheetname))...
6020: 09 20 20 20 20 20 28 73 76 65 63 20 20 20 20 20 . (svec
6030: 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 73 (refdb:csv-get-s
6040: 76 65 63 20 73 68 65 65 74 64 61 74 29 29 0a 09 vec sheetdat))..
6050: 09 09 20 20 20 20 20 28 6d 61 78 72 6f 77 20 20 .. (maxrow
6060: 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 2d (refdb:csv-get-
6070: 6d 61 78 72 6f 77 20 73 68 65 65 74 64 61 74 29 maxrow sheetdat)
6080: 29 0a 09 09 09 20 20 20 20 20 28 6d 61 78 63 6f ).... (maxco
6090: 6c 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 l (refdb:csv-g
60a0: 65 74 2d 6d 61 78 63 6f 6c 20 73 68 65 65 74 64 et-maxcol sheetd
60b0: 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 66 6e at)).... (fn
60c0: 61 6d 65 20 20 20 20 28 69 66 20 6f 75 74 2d 66 ame (if out-f
60d0: 69 6c 65 20 0a 09 09 09 09 09 20 20 20 28 73 74 ile ...... (st
60e0: 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 ring-substitute
60f0: 22 25 73 22 20 73 68 65 65 74 6e 61 6d 65 20 6f "%s" sheetname o
6100: 75 74 2d 66 69 6c 65 29 20 3b 3b 20 22 2f 66 6f ut-file) ;; "/fo
6110: 6f 2f 62 61 72 2f 25 73 2e 63 73 76 22 29 0a 09 o/bar/%s.csv")..
6120: 09 09 09 09 20 20 20 28 63 6f 6e 63 20 73 68 65 .... (conc she
6130: 65 74 6e 61 6d 65 20 22 2e 63 73 76 22 29 29 29 etname ".csv")))
6140: 29 0a 09 09 09 28 77 69 74 68 2d 6f 75 74 70 75 )....(with-outpu
6150: 74 2d 74 6f 2d 66 69 6c 65 20 66 6e 61 6d 65 0a t-to-file fname.
6160: 09 09 09 20 20 28 6c 61 6d 62 64 61 20 28 29 0a ... (lambda ().
6170: 09 09 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 ... ;; (print
6180: 20 22 53 68 65 65 74 6e 61 6d 65 3a 20 22 20 73 "Sheetname: " s
6190: 68 65 65 74 6e 61 6d 65 29 0a 09 09 09 20 20 20 heetname)....
61a0: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 6f 77 (let loop ((row
61b0: 20 20 20 20 20 20 20 30 29 0a 09 09 09 09 20 20 0).....
61c0: 20 20 20 20 20 28 63 6f 6c 20 20 20 20 20 20 20 (col
61d0: 30 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 63 0)..... (c
61e0: 75 72 72 2d 72 6f 77 20 27 28 29 29 0a 09 09 09 urr-row '())....
61f0: 09 20 20 20 20 20 20 20 28 72 65 73 75 6c 74 20 . (result
6200: 20 20 27 28 29 29 29 0a 09 09 09 20 20 20 20 20 '()))....
6210: 20 28 6c 65 74 2a 20 28 28 76 61 6c 20 28 73 70 (let* ((val (sp
6220: 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 73 arse-array-ref s
6230: 76 65 63 20 72 6f 77 20 63 6f 6c 29 29 0a 09 09 vec row col))...
6240: 09 09 20 20 20 20 20 28 64 69 73 70 2d 76 61 6c .. (disp-val
6250: 20 28 69 66 20 76 61 6c 0a 09 09 09 09 09 09 20 (if val.......
6260: 20 20 28 63 6f 6e 63 20 22 5c 22 22 20 76 61 6c (conc "\"" val
6270: 20 22 5c 22 22 29 0a 09 09 09 09 09 09 20 20 20 "\"").......
6280: 22 22 29 29 29 0a 09 09 09 09 28 69 66 20 28 3e ""))).....(if (>
6290: 20 63 6f 6c 20 30 29 28 64 69 73 70 6c 61 79 20 col 0)(display
62a0: 22 2c 22 29 29 0a 09 09 09 09 28 64 69 73 70 6c ",")).....(displ
62b0: 61 79 20 64 69 73 70 2d 76 61 6c 29 0a 09 09 09 ay disp-val)....
62c0: 09 28 63 6f 6e 64 0a 09 09 09 09 20 28 28 3e 20 .(cond..... ((>
62d0: 72 6f 77 20 6d 61 78 72 6f 77 29 28 64 69 73 70 row maxrow)(disp
62e0: 6c 61 79 20 22 5c 6e 22 29 20 72 65 73 75 6c 74 lay "\n") result
62f0: 29 0a 09 09 09 09 20 28 28 3e 3d 20 63 6f 6c 20 )..... ((>= col
6300: 6d 61 78 63 6f 6c 29 0a 09 09 09 09 20 20 28 64 maxcol)..... (d
6310: 69 73 70 6c 61 79 20 22 5c 6e 22 29 0a 09 09 09 isplay "\n")....
6320: 09 20 20 28 6c 6f 6f 70 20 28 2b 20 72 6f 77 20 . (loop (+ row
6330: 31 29 20 30 20 27 28 29 20 28 61 70 70 65 6e 64 1) 0 '() (append
6340: 20 72 65 73 75 6c 74 20 28 6c 69 73 74 20 63 75 result (list cu
6350: 72 72 2d 72 6f 77 29 29 29 29 0a 09 09 09 09 20 rr-row)))).....
6360: 28 65 6c 73 65 0a 09 09 09 09 20 20 28 6c 6f 6f (else..... (loo
6370: 70 20 72 6f 77 20 28 2b 20 63 6f 6c 20 31 29 20 p row (+ col 1)
6380: 28 61 70 70 65 6e 64 20 63 75 72 72 2d 72 6f 77 (append curr-row
6390: 20 28 6c 69 73 74 20 76 61 6c 29 29 20 72 65 73 (list val)) res
63a0: 75 6c 74 29 29 29 29 29 29 29 29 29 0a 09 09 20 ult)))))))))...
63b0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b (hash-table-k
63c0: 65 79 73 20 72 65 73 75 6c 74 73 29 29 29 29 0a eys results)))).
63d0: 09 09 28 28 73 71 6c 69 74 65 33 29 0a 09 09 20 ..((sqlite3)...
63e0: 28 6c 65 74 2a 20 28 28 64 62 2d 66 69 6c 65 20 (let* ((db-file
63f0: 20 20 28 6f 72 20 6f 75 74 2d 66 69 6c 65 20 28 (or out-file (
6400: 70 61 74 68 6e 61 6d 65 2d 66 69 6c 65 20 69 6e pathname-file in
6410: 70 75 74 2d 64 62 29 29 29 0a 09 09 09 28 64 62 put-db)))....(db
6420: 2d 65 78 69 73 74 73 20 28 66 69 6c 65 2d 65 78 -exists (file-ex
6430: 69 73 74 73 3f 20 64 62 2d 66 69 6c 65 29 29 0a ists? db-file)).
6440: 09 09 09 28 64 62 20 20 20 20 20 20 20 20 28 73 ...(db (s
6450: 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 74 61 qlite3:open-data
6460: 62 61 73 65 20 64 62 2d 66 69 6c 65 29 29 29 0a base db-file))).
6470: 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 64 62 .. (if (not db
6480: 2d 65 78 69 73 74 73 29 28 73 71 6c 69 74 65 33 -exists)(sqlite3
6490: 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 52 45 :execute db "CRE
64a0: 41 54 45 20 54 41 42 4c 45 20 64 61 74 61 20 28 ATE TABLE data (
64b0: 73 68 65 65 74 2c 73 65 63 74 69 6f 6e 2c 76 61 sheet,section,va
64c0: 72 2c 76 61 6c 29 3b 22 29 29 0a 09 09 20 20 20 r,val);"))...
64d0: 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c 6c (configf:map-all
64e0: 2d 68 69 65 72 2d 61 6c 69 73 74 0a 09 09 20 20 -hier-alist...
64f0: 20 20 64 61 74 61 0a 09 09 20 20 20 20 28 6c 61 data... (la
6500: 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 mbda (sheetname
6510: 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e sectionname varn
6520: 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 20 ame val)...
6530: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
6540: 65 20 64 62 0a 09 09 09 09 20 20 20 20 20 20 20 e db.....
6550: 22 49 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 "INSERT OR REPLA
6560: 43 45 20 49 4e 54 4f 20 64 61 74 61 20 28 73 68 CE INTO data (sh
6570: 65 65 74 2c 73 65 63 74 69 6f 6e 2c 76 61 72 2c eet,section,var,
6580: 76 61 6c 29 20 56 41 4c 55 45 53 20 28 3f 2c 3f val) VALUES (?,?
6590: 2c 3f 2c 3f 29 3b 22 0a 09 09 09 09 20 20 20 20 ,?,?);".....
65a0: 20 20 20 73 68 65 65 74 6e 61 6d 65 20 73 65 63 sheetname sec
65b0: 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 tionname varname
65c0: 20 76 61 6c 29 29 29 0a 09 09 20 20 20 28 73 71 val)))... (sq
65d0: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
65e0: 64 62 29 29 29 0a 09 09 28 65 6c 73 65 0a 09 09 db)))...(else...
65f0: 20 28 70 70 20 64 61 74 61 29 29 29 29 29 29 0a (pp data)))))).
6600: 20 20 20 20 20 20 28 69 66 20 6f 75 74 2d 66 69 (if out-fi
6610: 6c 65 20 28 63 6c 6f 73 65 2d 6f 75 74 70 75 74 le (close-output
6620: 2d 70 6f 72 74 20 6f 75 74 2d 70 6f 72 74 29 29 -port out-port))
6630: 0a 20 20 20 20 20 20 28 65 78 69 74 29 20 3b 3b . (exit) ;;
6640: 20 79 65 73 2c 20 62 65 6e 64 69 6e 67 20 74 68 yes, bending th
6650: 65 20 72 75 6c 65 73 20 68 65 72 65 20 2d 20 6e e rules here - n
6660: 65 65 64 20 74 6f 20 65 78 69 74 20 73 69 6e 63 eed to exit sinc
6670: 65 20 74 68 69 73 20 69 73 20 61 20 75 74 69 6c e this is a util
6680: 69 74 79 0a 20 20 20 20 20 20 29 29 0a 0a 28 69 ity. ))..(i
6690: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
66a0: 22 2d 70 69 6e 67 22 29 0a 20 20 20 20 28 6c 65 "-ping"). (le
66b0: 74 2a 20 28 28 72 75 6e 2d 69 64 20 20 20 20 20 t* ((run-id
66c0: 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 (string->numb
66d0: 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 er (args:get-arg
66e0: 20 22 2d 72 75 6e 2d 69 64 22 29 29 29 0a 09 20 "-run-id")))..
66f0: 20 20 28 68 6f 73 74 3a 70 6f 72 74 20 20 20 20 (host:port
6700: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6710: 2d 70 69 6e 67 22 29 29 29 0a 20 20 20 20 20 20 -ping"))).
6720: 28 73 65 72 76 65 72 3a 70 69 6e 67 20 72 75 6e (server:ping run
6730: 2d 69 64 20 68 6f 73 74 3a 70 6f 72 74 29 29 29 -id host:port)))
6740: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
6750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 61 ==========.;; Ca
6790: 70 74 75 72 65 2c 20 73 61 76 65 20 61 6e 64 20 pture, save and
67a0: 6d 61 6e 69 70 75 6c 61 74 65 20 65 6e 76 69 72 manipulate envir
67b0: 6f 6e 6d 65 6e 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d onments.;;======
67c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6800: 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 4b 65 65 70 20 ..;; NOTE: Keep
6810: 74 68 65 73 65 20 61 62 6f 76 65 20 74 68 65 20 these above the
6820: 73 65 63 74 69 6f 6e 20 77 68 65 72 65 20 74 68 section where th
6830: 65 20 73 65 72 76 65 72 20 6f 72 20 63 6c 69 65 e server or clie
6840: 6e 74 20 63 6f 64 65 20 69 73 20 73 65 74 75 70 nt code is setup
6850: 0a 0a 28 6c 65 74 20 28 28 65 6e 76 63 61 70 20 ..(let ((envcap
6860: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6870: 65 6e 76 63 61 70 22 29 29 29 0a 20 20 28 69 66 envcap"))). (if
6880: 20 65 6e 76 63 61 70 0a 20 20 20 20 20 20 28 6c envcap. (l
6890: 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 28 65 et* ((db (e
68a0: 6e 76 3a 6f 70 65 6e 2d 64 62 20 28 69 66 20 28 nv:open-db (if (
68b0: 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 22 null? remargs) "
68c0: 65 6e 76 64 61 74 2e 64 62 22 20 28 63 61 72 20 envdat.db" (car
68d0: 72 65 6d 61 72 67 73 29 29 29 29 29 0a 09 28 65 remargs)))))..(e
68e0: 6e 76 3a 73 61 76 65 2d 65 6e 76 2d 76 61 72 73 nv:save-env-vars
68f0: 20 64 62 20 65 6e 76 63 61 70 29 0a 09 28 65 6e db envcap)..(en
6900: 76 3a 63 6c 6f 73 65 2d 64 61 74 61 62 61 73 65 v:close-database
6910: 20 64 62 29 0a 09 28 73 65 74 21 20 2a 64 69 64 db)..(set! *did
6920: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
6930: 29 0a 0a 3b 3b 20 64 65 6c 74 61 20 22 6c 61 6e )..;; delta "lan
6940: 67 75 61 67 65 22 20 77 69 6c 6c 20 65 76 65 6e guage" will even
6950: 74 75 61 6c 6c 79 20 62 65 20 72 65 73 3d 61 2b tually be res=a+
6960: 62 2d 63 20 62 75 74 20 66 6f 72 20 6e 6f 77 20 b-c but for now
6970: 69 74 20 69 73 20 6a 75 73 74 20 72 65 73 3d 61 it is just res=a
6980: 2d 62 20 0a 3b 3b 0a 28 6c 65 74 20 28 28 65 6e -b .;;.(let ((en
6990: 76 64 65 6c 74 61 20 28 61 72 67 73 3a 67 65 74 vdelta (args:get
69a0: 2d 61 72 67 20 22 2d 65 6e 76 64 65 6c 74 61 22 -arg "-envdelta"
69b0: 29 29 29 0a 20 20 28 69 66 20 65 6e 76 64 65 6c ))). (if envdel
69c0: 74 61 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 ta. (let ((
69d0: 6d 61 74 63 68 20 28 73 74 72 69 6e 67 2d 73 70 match (string-sp
69e0: 6c 69 74 20 65 6e 76 64 65 6c 74 61 20 22 2d 22 lit envdelta "-"
69f0: 29 29 29 3b 3b 20 28 73 74 72 69 6e 67 2d 6d 61 )));; (string-ma
6a00: 74 63 68 20 22 28 5b 61 2d 7a 30 2d 39 5f 5d 2b tch "([a-z0-9_]+
6a10: 29 3d 28 5b 61 2d 7a 30 2d 39 5f 5c 5c 2d 2c 5d )=([a-z0-9_\\-,]
6a20: 2b 29 22 20 65 6e 76 64 65 6c 74 61 29 29 29 0a +)" envdelta))).
6a30: 09 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f .(if (not (null?
6a40: 20 6d 61 74 63 68 29 29 0a 09 20 20 20 20 28 6c match)).. (l
6a50: 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 20 et* ((db
6a60: 28 65 6e 76 3a 6f 70 65 6e 2d 64 62 20 28 69 66 (env:open-db (if
6a70: 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 (null? remargs)
6a80: 20 22 65 6e 76 64 61 74 2e 64 62 22 20 28 63 61 "envdat.db" (ca
6a90: 72 20 72 65 6d 61 72 67 73 29 29 29 29 0a 09 09 r remargs))))...
6aa0: 20 20 20 3b 3b 20 28 72 65 73 63 74 78 20 20 20 ;; (resctx
6ab0: 20 28 63 61 64 72 20 6d 61 74 63 68 29 29 0a 09 (cadr match))..
6ac0: 09 20 20 20 3b 3b 20 28 65 71 75 6e 20 20 20 20 . ;; (equn
6ad0: 20 20 28 63 61 64 64 72 20 6d 61 74 63 68 29 29 (caddr match))
6ae0: 0a 09 09 20 20 20 28 70 61 72 74 73 20 20 20 20 ... (parts
6af0: 20 6d 61 74 63 68 29 20 3b 3b 20 28 73 74 72 69 match) ;; (stri
6b00: 6e 67 2d 73 70 6c 69 74 20 65 71 75 6e 20 22 2d ng-split equn "-
6b10: 22 29 29 0a 09 09 20 20 20 28 6d 69 6e 75 65 6e "))... (minuen
6b20: 64 20 20 20 28 63 61 72 20 70 61 72 74 73 29 29 d (car parts))
6b30: 0a 09 09 20 20 20 28 73 75 62 74 72 61 65 6e 64 ... (subtraend
6b40: 20 28 63 61 64 72 20 70 61 72 74 73 29 29 0a 09 (cadr parts))..
6b50: 09 20 20 20 28 61 64 64 65 64 20 20 20 20 20 28 . (added (
6b60: 65 6e 76 3a 67 65 74 2d 61 64 64 65 64 20 20 20 env:get-added
6b70: 64 62 20 6d 69 6e 75 65 6e 64 20 73 75 62 74 72 db minuend subtr
6b80: 61 65 6e 64 29 29 0a 09 09 20 20 20 28 72 65 6d aend))... (rem
6b90: 6f 76 65 64 20 20 20 28 65 6e 76 3a 67 65 74 2d oved (env:get-
6ba0: 72 65 6d 6f 76 65 64 20 64 62 20 6d 69 6e 75 65 removed db minue
6bb0: 6e 64 20 73 75 62 74 72 61 65 6e 64 29 29 0a 09 nd subtraend))..
6bc0: 09 20 20 20 28 63 68 61 6e 67 65 64 20 20 20 28 . (changed (
6bd0: 65 6e 76 3a 67 65 74 2d 63 68 61 6e 67 65 64 20 env:get-changed
6be0: 64 62 20 6d 69 6e 75 65 6e 64 20 73 75 62 74 72 db minuend subtr
6bf0: 61 65 6e 64 29 29 29 0a 09 20 20 20 20 20 20 3b aend))).. ;
6c00: 3b 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c ; (pp (hash-tabl
6c10: 65 2d 3e 61 6c 69 73 74 20 61 64 64 65 64 29 29 e->alist added))
6c20: 0a 09 20 20 20 20 20 20 3b 3b 20 28 70 70 20 28 .. ;; (pp (
6c30: 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 hash-table->alis
6c40: 74 20 72 65 6d 6f 76 65 64 29 29 0a 09 20 20 20 t removed))..
6c50: 20 20 20 3b 3b 20 28 70 70 20 28 68 61 73 68 2d ;; (pp (hash-
6c60: 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 63 68 61 table->alist cha
6c70: 6e 67 65 64 29 29 0a 09 20 20 20 20 20 20 28 69 nged)).. (i
6c80: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
6c90: 22 2d 6f 22 29 0a 09 09 20 20 28 77 69 74 68 2d "-o")... (with-
6ca0: 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 0a 09 output-to-file..
6cb0: 09 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 . (args:get
6cc0: 2d 61 72 67 20 22 2d 6f 22 29 0a 09 09 20 20 20 -arg "-o")...
6cd0: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 20 (lambda ()...
6ce0: 20 20 20 20 28 65 6e 76 3a 70 72 69 6e 74 20 61 (env:print a
6cf0: 64 64 65 64 20 72 65 6d 6f 76 65 64 20 63 68 61 dded removed cha
6d00: 6e 67 65 64 29 29 29 0a 09 09 20 20 28 65 6e 76 nged)))... (env
6d10: 3a 70 72 69 6e 74 20 61 64 64 65 64 20 72 65 6d :print added rem
6d20: 6f 76 65 64 20 63 68 61 6e 67 65 64 29 29 0a 09 oved changed))..
6d30: 20 20 20 20 20 20 28 65 6e 76 3a 63 6c 6f 73 65 (env:close
6d40: 2d 64 61 74 61 62 61 73 65 20 64 62 29 0a 09 20 -database db)..
6d50: 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
6d60: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 0a 09 omething* #t))..
6d70: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6d80: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
6d90: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 50 61 72 t-log-port* "Par
6da0: 61 6d 65 74 65 72 20 74 6f 20 2d 65 6e 76 64 65 ameter to -envde
6db0: 6c 74 61 20 73 68 6f 75 6c 64 20 62 65 20 6e 65 lta should be ne
6dc0: 77 3d 73 74 61 72 2d 65 6e 64 22 29 29 29 29 29 w=star-end")))))
6dd0: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
6de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 ==========.;; St
6e20: 61 72 74 20 74 68 65 20 73 65 72 76 65 72 20 2d art the server -
6e30: 20 63 61 6e 20 62 65 20 64 6f 6e 65 20 69 6e 20 can be done in
6e40: 63 6f 6e 6a 75 6e 63 74 69 6f 6e 20 77 69 74 68 conjunction with
6e50: 20 2d 72 75 6e 61 6c 6c 20 6f 72 20 2d 72 75 6e -runall or -run
6e60: 74 65 73 74 73 20 28 6f 6e 65 20 64 61 79 2e 2e tests (one day..
6e70: 2e 29 0a 3b 3b 20 20 20 77 65 20 73 74 61 72 74 .).;; we start
6e80: 20 74 68 65 20 73 65 72 76 65 72 20 69 66 20 6e the server if n
6e90: 6f 74 20 72 75 6e 6e 69 6e 67 20 65 6c 73 65 20 ot running else
6ea0: 73 74 61 72 74 20 74 68 65 20 63 6c 69 65 6e 74 start the client
6eb0: 20 74 68 72 65 61 64 0a 3b 3b 3d 3d 3d 3d 3d 3d thread.;;======
6ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f00: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
6f10: 61 72 67 20 22 2d 73 65 72 76 65 72 22 29 0a 0a arg "-server")..
6f20: 20 20 20 20 3b 3b 20 53 65 72 76 65 72 3f 20 53 ;; Server? S
6f30: 74 61 72 74 20 75 70 20 68 65 72 65 2e 0a 20 20 tart up here..
6f40: 20 20 3b 3b 0a 20 20 20 20 28 6c 65 74 20 28 28 ;;. (let ((
6f50: 74 6c 20 20 20 20 20 20 20 20 28 6c 61 75 6e 63 tl (launc
6f60: 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 72 75 h:setup)).. (ru
6f70: 6e 2d 69 64 20 20 20 20 28 61 6e 64 20 28 61 72 n-id (and (ar
6f80: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
6f90: 2d 69 64 22 29 0a 09 09 09 20 20 28 73 74 72 69 -id").... (stri
6fa0: 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 ng->number (args
6fb0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 2d 69 :get-arg "-run-i
6fc0: 64 22 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 d")))).
6fd0: 20 28 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 (transport-type
6fe0: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
6ff0: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
7000: 72 67 20 22 2d 74 72 61 6e 73 70 6f 72 74 22 29 rg "-transport")
7010: 20 22 68 74 74 70 22 29 29 29 29 0a 20 20 20 20 "http")))).
7020: 20 20 28 69 66 20 72 75 6e 2d 69 64 0a 09 20 20 (if run-id..
7030: 28 62 65 67 69 6e 0a 09 20 20 20 20 28 73 65 72 (begin.. (ser
7040: 76 65 72 3a 6c 61 75 6e 63 68 20 72 75 6e 2d 69 ver:launch run-i
7050: 64 20 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 d transport-type
7060: 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 69 ).. (set! *di
7070: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
7080: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
7090: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
70a0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 73 65 72 t-log-port* "ser
70b0: 76 65 72 20 72 65 71 75 69 72 65 73 20 72 75 6e ver requires run
70c0: 2d 69 64 20 62 65 20 73 70 65 63 69 66 69 65 64 -id be specified
70d0: 20 77 69 74 68 20 2d 72 75 6e 2d 69 64 22 29 29 with -run-id"))
70e0: 29 0a 0a 20 20 20 20 3b 3b 20 4e 6f 74 20 61 20 ).. ;; Not a
70f0: 73 65 72 76 65 72 3f 20 54 68 69 73 20 73 65 63 server? This sec
7100: 74 69 6f 6e 20 77 69 6c 6c 20 64 65 63 69 64 65 tion will decide
7110: 20 68 6f 77 20 74 6f 20 63 6f 6d 6d 75 6e 69 63 how to communic
7120: 61 74 65 0a 20 20 20 20 3b 3b 0a 20 20 20 20 3b ate. ;;. ;
7130: 3b 20 20 53 65 74 75 70 20 63 6c 69 65 6e 74 20 ; Setup client
7140: 66 6f 72 20 61 6c 6c 20 65 78 70 65 63 74 20 6c for all expect l
7150: 69 73 74 65 64 20 68 65 72 65 0a 20 20 20 20 28 isted here. (
7160: 69 66 20 28 6e 75 6c 6c 3f 20 28 6c 73 65 74 2d if (null? (lset-
7170: 69 6e 74 65 72 73 65 63 74 69 6f 6e 20 0a 09 09 intersection ...
7180: 65 71 75 61 6c 3f 0a 09 09 28 68 61 73 68 2d 74 equal?...(hash-t
7190: 61 62 6c 65 2d 6b 65 79 73 20 61 72 67 73 3a 61 able-keys args:a
71a0: 72 67 2d 68 61 73 68 29 0a 09 09 27 28 22 2d 6c rg-hash)...'("-l
71b0: 69 73 74 2d 73 65 72 76 65 72 73 22 0a 09 09 20 ist-servers"...
71c0: 20 22 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 0a "-stop-server".
71d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
71e0: 20 20 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 "-kill-server"
71f0: 0a 09 09 20 20 22 2d 73 68 6f 77 2d 63 6d 64 69 ... "-show-cmdi
7200: 6e 66 6f 22 0a 09 09 20 20 22 2d 6c 69 73 74 2d nfo"... "-list-
7210: 72 75 6e 73 22 0a 09 09 20 20 22 2d 70 69 6e 67 runs"... "-ping
7220: 22 29 29 29 0a 09 28 69 66 20 28 6c 61 75 6e 63 ")))..(if (launc
7230: 68 3a 73 65 74 75 70 29 0a 09 20 20 20 20 28 6c h:setup).. (l
7240: 65 74 20 28 28 72 75 6e 2d 69 64 20 20 20 20 28 et ((run-id (
7250: 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 and (args:get-ar
7260: 67 20 22 2d 72 75 6e 2d 69 64 22 29 0a 09 09 09 g "-run-id")....
7270: 09 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 . (string->numb
7280: 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 er (args:get-arg
7290: 20 22 2d 72 75 6e 2d 69 64 22 29 29 29 29 29 0a "-run-id"))))).
72a0: 09 20 20 20 20 20 20 3b 3b 20 28 73 65 74 21 20 . ;; (set!
72b0: 2a 66 64 62 2a 20 20 20 28 66 69 6c 65 64 62 3a *fdb* (filedb:
72c0: 6f 70 65 6e 2d 64 62 20 28 63 6f 6e 63 20 2a 74 open-db (conc *t
72d0: 6f 70 70 61 74 68 2a 20 22 2f 64 62 2f 70 61 74 oppath* "/db/pat
72e0: 68 73 2e 64 62 22 29 29 29 0a 09 20 20 20 20 20 hs.db")))..
72f0: 20 3b 3b 20 69 66 20 6e 6f 74 20 6c 69 73 74 20 ;; if not list
7300: 6f 72 20 6b 69 6c 6c 20 74 68 65 6e 20 73 74 61 or kill then sta
7310: 72 74 20 61 20 63 6c 69 65 6e 74 20 28 69 66 20 rt a client (if
7320: 61 70 70 72 6f 70 72 69 61 74 65 29 0a 09 20 20 appropriate)..
7330: 20 20 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 (if (or (arg
7340: 73 2d 64 65 66 69 6e 65 64 3f 20 22 2d 68 22 20 s-defined? "-h"
7350: 22 2d 76 65 72 73 69 6f 6e 22 20 22 2d 63 72 65 "-version" "-cre
7360: 61 74 65 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 ate-megatest-are
7370: 61 22 20 22 2d 63 72 65 61 74 65 2d 74 65 73 74 a" "-create-test
7380: 22 29 0a 09 09 20 20 20 20 20 20 28 65 71 3f 20 ")... (eq?
7390: 28 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 (length (hash-ta
73a0: 62 6c 65 2d 6b 65 79 73 20 61 72 67 73 3a 61 72 ble-keys args:ar
73b0: 67 2d 68 61 73 68 29 29 20 30 29 29 0a 09 09 20 g-hash)) 0))...
73c0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
73d0: 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 1 *default-lo
73e0: 67 2d 70 6f 72 74 2a 20 22 53 65 72 76 65 72 20 g-port* "Server
73f0: 63 6f 6e 6e 65 63 74 69 6f 6e 20 6e 6f 74 20 6e connection not n
7400: 65 65 64 65 64 22 29 0a 09 09 20 20 28 62 65 67 eeded")... (beg
7410: 69 6e 0a 09 09 20 20 20 20 3b 3b 20 28 69 66 20 in... ;; (if
7420: 72 75 6e 2d 69 64 20 0a 09 09 20 20 20 20 3b 3b run-id ... ;;
7430: 20 20 20 20 20 28 63 6c 69 65 6e 74 3a 6c 61 75 (client:lau
7440: 6e 63 68 20 72 75 6e 2d 69 64 29 20 0a 09 09 20 nch run-id) ...
7450: 20 20 20 3b 3b 20 20 20 20 20 28 63 6c 69 65 6e ;; (clien
7460: 74 3a 6c 61 75 6e 63 68 20 30 29 20 20 20 20 20 t:launch 0)
7470: 20 3b 3b 20 77 69 74 68 6f 75 74 20 72 75 6e 2d ;; without run-
7480: 69 64 20 77 65 27 6c 6c 20 73 74 61 72 74 20 61 id we'll start a
7490: 20 73 65 72 76 65 72 20 66 6f 72 20 22 30 22 0a server for "0".
74a0: 09 09 20 20 20 20 23 74 0a 09 09 20 20 20 20 29 .. #t... )
74b0: 29 29 29 29 29 0a 0a 3b 3b 20 4d 41 59 20 53 54 )))))..;; MAY ST
74c0: 49 4c 4c 20 4e 45 45 44 20 54 48 49 53 0a 3b 3b ILL NEED THIS.;;
74d0: 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 2a .. (set! *
74e0: 6d 65 67 61 74 65 73 74 2d 64 62 2a 20 28 6d 61 megatest-db* (ma
74f0: 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 ke-dbr:dbstruct
7500: 70 61 74 68 3a 20 2a 74 6f 70 70 61 74 68 2a 20 path: *toppath*
7510: 6c 6f 63 61 6c 3a 20 23 74 29 29 29 29 29 29 29 local: #t)))))))
7520: 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 )))..(if (or (ar
7530: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 gs:get-arg "-lis
7540: 74 2d 73 65 72 76 65 72 73 22 29 0a 09 28 61 72 t-servers")..(ar
7550: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 6f gs:get-arg "-sto
7560: 70 2d 73 65 72 76 65 72 22 29 0a 20 20 20 20 20 p-server").
7570: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
7580: 20 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 29 "-kill-server")
7590: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 ). (let ((tl
75a0: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 (launch:setup)))
75b0: 0a 20 20 20 20 20 20 28 69 66 20 74 6c 20 0a 09 . (if tl ..
75c0: 20 20 28 6c 65 74 2a 20 28 28 74 64 62 64 61 74 (let* ((tdbdat
75d0: 20 20 28 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 (tasks:open-db
75e0: 29 29 0a 09 09 20 28 73 65 72 76 65 72 73 20 28 ))... (servers (
75f0: 74 61 73 6b 73 3a 67 65 74 2d 61 6c 6c 2d 73 65 tasks:get-all-se
7600: 72 76 65 72 73 20 28 64 62 3a 64 65 6c 61 79 2d rvers (db:delay-
7610: 69 66 2d 62 75 73 79 20 74 64 62 64 61 74 29 29 if-busy tdbdat))
7620: 29 0a 09 09 20 28 66 6d 74 73 74 72 20 20 22 7e )... (fmtstr "~
7630: 35 61 7e 31 32 61 7e 38 61 7e 32 30 61 7e 32 34 5a~12a~8a~20a~24
7640: 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 30 a~10a~10a~10a~10
7650: 61 5c 6e 22 29 0a 09 09 20 28 73 65 72 76 65 72 a\n")... (server
7660: 73 2d 74 6f 2d 6b 69 6c 6c 20 27 28 29 29 0a 20 s-to-kill '()).
7670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7680: 28 6b 69 6c 6c 2d 73 77 69 74 63 68 20 20 28 69 (kill-switch (i
7690: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
76a0: 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 29 20 "-kill-server")
76b0: 22 2d 39 22 20 22 22 29 29 0a 20 20 20 20 20 20 "-9" "")).
76c0: 20 20 20 20 20 20 20 20 20 20 20 28 6b 69 6c 6c (kill
76d0: 69 6e 66 6f 20 20 20 28 6f 72 20 28 61 72 67 73 info (or (args
76e0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 6f 70 2d :get-arg "-stop-
76f0: 73 65 72 76 65 72 22 29 20 28 61 72 67 73 3a 67 server") (args:g
7700: 65 74 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 et-arg "-kill-se
7710: 72 76 65 72 22 29 20 29 29 0a 09 09 20 28 6b 68 rver") ))... (kh
7720: 6f 73 74 2d 70 6f 72 74 20 28 69 66 20 6b 69 6c ost-port (if kil
7730: 6c 69 6e 66 6f 20 28 69 66 20 28 73 75 62 73 74 linfo (if (subst
7740: 72 69 6e 67 2d 69 6e 64 65 78 20 22 3a 22 20 6b ring-index ":" k
7750: 69 6c 6c 69 6e 66 6f 29 28 73 74 72 69 6e 67 2d illinfo)(string-
7760: 73 70 6c 69 74 20 22 3a 22 29 20 23 66 29 20 23 split ":") #f) #
7770: 66 29 29 0a 09 09 20 28 73 69 64 20 20 20 20 20 f))... (sid
7780: 20 20 20 28 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 (if killinfo
7790: 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d 69 (if (substring-i
77a0: 6e 64 65 78 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 ndex ":" killinf
77b0: 6f 29 20 23 66 20 28 73 74 72 69 6e 67 2d 3e 6e o) #f (string->n
77c0: 75 6d 62 65 72 20 6b 69 6c 6c 69 6e 66 6f 29 29 umber killinfo))
77d0: 20 23 66 29 29 29 0a 09 20 20 20 20 28 66 6f 72 #f))).. (for
77e0: 6d 61 74 20 23 74 20 66 6d 74 73 74 72 20 22 49 mat #t fmtstr "I
77f0: 64 22 20 22 4d 54 76 65 72 22 20 22 50 69 64 22 d" "MTver" "Pid"
7800: 20 22 48 6f 73 74 22 20 22 49 6e 74 65 72 66 61 "Host" "Interfa
7810: 63 65 3a 4f 75 74 50 6f 72 74 22 20 22 49 6e 50 ce:OutPort" "InP
7820: 6f 72 74 22 20 22 4c 61 73 74 42 65 61 74 22 20 ort" "LastBeat"
7830: 22 53 74 61 74 65 22 20 22 54 72 61 6e 73 70 6f "State" "Transpo
7840: 72 74 22 29 0a 09 20 20 20 20 28 66 6f 72 6d 61 rt").. (forma
7850: 74 20 23 74 20 66 6d 74 73 74 72 20 22 3d 3d 22 t #t fmtstr "=="
7860: 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 20 22 "=====" "===" "
7870: 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d ====" "=========
7880: 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d ========" "=====
7890: 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d =" "========" "=
78a0: 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d ====" "=========
78b0: 22 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 ").. (for-eac
78c0: 68 20 0a 09 20 20 20 20 20 28 6c 61 6d 62 64 61 h .. (lambda
78d0: 20 28 73 65 72 76 65 72 29 0a 09 20 20 20 20 20 (server)..
78e0: 20 20 28 6c 65 74 2a 20 28 28 69 64 20 20 20 20 (let* ((id
78f0: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref
7900: 20 73 65 72 76 65 72 20 30 29 29 0a 09 09 20 20 server 0))...
7910: 20 20 20 20 28 70 69 64 20 20 20 20 20 20 20 20 (pid
7920: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 (vector-ref serv
7930: 65 72 20 31 29 29 0a 09 09 20 20 20 20 20 20 28 er 1))... (
7940: 68 6f 73 74 6e 61 6d 65 20 20 20 28 76 65 63 74 hostname (vect
7950: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 32 29 or-ref server 2)
7960: 29 0a 09 09 20 20 20 20 20 20 28 69 6e 74 65 72 )... (inter
7970: 66 61 63 65 20 20 28 76 65 63 74 6f 72 2d 72 65 face (vector-re
7980: 66 20 73 65 72 76 65 72 20 33 29 29 20 0a 09 09 f server 3)) ...
7990: 20 20 20 20 20 20 28 70 75 6c 6c 70 6f 72 74 20 (pullport
79a0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
79b0: 72 76 65 72 20 34 29 29 0a 09 09 20 20 20 20 20 rver 4))...
79c0: 20 28 70 75 62 70 6f 72 74 20 20 20 20 28 76 65 (pubport (ve
79d0: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
79e0: 35 29 29 0a 09 09 20 20 20 20 20 20 28 73 74 61 5))... (sta
79f0: 72 74 2d 74 69 6d 65 20 28 76 65 63 74 6f 72 2d rt-time (vector-
7a00: 72 65 66 20 73 65 72 76 65 72 20 36 29 29 0a 09 ref server 6))..
7a10: 09 20 20 20 20 20 20 28 70 72 69 6f 72 69 74 79 . (priority
7a20: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
7a30: 65 72 76 65 72 20 37 29 29 0a 09 09 20 20 20 20 erver 7))...
7a40: 20 20 28 73 74 61 74 65 20 20 20 20 20 20 28 76 (state (v
7a50: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
7a60: 20 38 29 29 0a 09 09 20 20 20 20 20 20 28 6d 74 8))... (mt
7a70: 2d 76 65 72 20 20 20 20 20 28 76 65 63 74 6f 72 -ver (vector
7a80: 2d 72 65 66 20 73 65 72 76 65 72 20 39 29 29 0a -ref server 9)).
7a90: 09 09 20 20 20 20 20 20 28 6c 61 73 74 2d 75 70 .. (last-up
7aa0: 64 61 74 65 20 28 76 65 63 74 6f 72 2d 72 65 66 date (vector-ref
7ab0: 20 73 65 72 76 65 72 20 31 30 29 29 20 0a 09 09 server 10)) ...
7ac0: 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 (transport
7ad0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
7ae0: 72 76 65 72 20 31 31 29 29 0a 09 09 20 20 20 20 rver 11))...
7af0: 20 20 28 6b 69 6c 6c 65 64 20 20 20 20 20 23 66 (killed #f
7b00: 29 0a 09 09 20 20 20 20 20 20 28 73 74 61 74 75 )... (statu
7b10: 73 20 20 20 20 20 28 3c 20 6c 61 73 74 2d 75 70 s (< last-up
7b20: 64 61 74 65 20 32 30 29 29 29 0a 09 09 20 3b 3b date 20)))... ;;
7b30: 20 20 20 28 7a 6d 71 2d 73 6f 63 6b 65 74 73 20 (zmq-sockets
7b40: 28 69 66 20 73 74 61 74 75 73 20 28 73 65 72 76 (if status (serv
7b50: 65 72 3a 63 6c 69 65 6e 74 2d 63 6f 6e 6e 65 63 er:client-connec
7b60: 74 20 68 6f 73 74 6e 61 6d 65 20 70 6f 72 74 29 t hostname port)
7b70: 20 23 66 29 29 29 0a 09 09 20 3b 3b 20 6e 6f 20 #f)))... ;; no
7b80: 6e 65 65 64 20 74 6f 20 6c 6f 67 69 6e 20 61 73 need to login as
7b90: 20 73 74 61 74 75 73 20 6f 66 20 23 74 20 69 6e status of #t in
7ba0: 64 69 63 61 74 65 73 20 77 65 20 61 72 65 20 63 dicates we are c
7bb0: 6f 6e 6e 65 63 74 69 6e 67 20 74 6f 20 63 6f 72 onnecting to cor
7bc0: 72 65 63 74 20 0a 09 09 20 3b 3b 20 73 65 72 76 rect ... ;; serv
7bd0: 65 72 0a 09 09 20 28 69 66 20 28 65 71 75 61 6c er... (if (equal
7be0: 3f 20 73 74 61 74 65 20 22 64 65 61 64 22 29 0a ? state "dead").
7bf0: 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 6c 61 .. (if (> la
7c00: 73 74 2d 75 70 64 61 74 65 20 28 2a 20 32 35 20 st-update (* 25
7c10: 36 30 20 36 30 29 29 20 3b 3b 20 6b 65 65 70 20 60 60)) ;; keep
7c20: 72 65 63 6f 72 64 73 20 61 72 6f 75 6e 64 20 66 records around f
7c30: 6f 72 20 73 6c 69 67 68 6c 79 20 6f 76 65 72 20 or slighly over
7c40: 61 20 64 61 79 2e 0a 09 09 09 20 28 74 61 73 6b a day..... (task
7c50: 73 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 s:server-deregis
7c60: 74 65 72 20 28 64 62 3a 64 65 6c 61 79 2d 69 66 ter (db:delay-if
7c70: 2d 62 75 73 79 20 74 64 62 64 61 74 29 20 68 6f -busy tdbdat) ho
7c80: 73 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 74 3a stname pullport:
7c90: 20 70 75 6c 6c 70 6f 72 74 20 70 69 64 3a 20 70 pullport pid: p
7ca0: 69 64 20 61 63 74 69 6f 6e 3a 20 27 64 65 6c 65 id action: 'dele
7cb0: 74 65 29 29 0a 09 09 20 20 20 20 20 28 69 66 20 te))... (if
7cc0: 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 32 (> last-update 2
7cd0: 30 29 20 20 20 20 20 20 20 20 3b 3b 20 4d 61 72 0) ;; Mar
7ce0: 6b 20 61 73 20 64 65 61 64 20 69 66 20 6e 6f 74 k as dead if not
7cf0: 20 75 70 64 61 74 65 64 20 69 6e 20 6c 61 73 74 updated in last
7d00: 20 32 30 20 73 65 63 6f 6e 64 73 0a 09 09 09 20 20 seconds....
7d10: 28 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 65 (tasks:server-de
7d20: 72 65 67 69 73 74 65 72 20 28 64 62 3a 64 65 6c register (db:del
7d30: 61 79 2d 69 66 2d 62 75 73 79 20 74 64 62 64 61 ay-if-busy tdbda
7d40: 74 29 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c 6c t) hostname pull
7d50: 70 6f 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 70 port: pullport p
7d60: 69 64 3a 20 70 69 64 29 29 29 0a 09 09 20 28 66 id: pid)))... (f
7d70: 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 74 72 20 ormat #t fmtstr
7d80: 69 64 20 6d 74 2d 76 65 72 20 70 69 64 20 68 6f id mt-ver pid ho
7d90: 73 74 6e 61 6d 65 20 28 63 6f 6e 63 20 69 6e 74 stname (conc int
7da0: 65 72 66 61 63 65 20 22 3a 22 20 70 75 6c 6c 70 erface ":" pullp
7db0: 6f 72 74 29 20 70 75 62 70 6f 72 74 20 6c 61 73 ort) pubport las
7dc0: 74 2d 75 70 64 61 74 65 0a 09 09 09 20 28 69 66 t-update.... (if
7dd0: 20 73 74 61 74 75 73 20 22 61 6c 69 76 65 22 20 status "alive"
7de0: 22 64 65 61 64 22 29 20 74 72 61 6e 73 70 6f 72 "dead") transpor
7df0: 74 29 0a 09 09 20 28 69 66 20 28 6f 72 20 28 65 t)... (if (or (e
7e00: 71 75 61 6c 3f 20 69 64 20 73 69 64 29 0a 09 09 qual? id sid)...
7e10: 09 20 28 65 71 75 61 6c 3f 20 73 69 64 20 30 29 . (equal? sid 0)
7e20: 29 20 3b 3b 20 6b 69 6c 6c 20 61 6c 6c 2f 61 6e ) ;; kill all/an
7e30: 79 0a 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a y... (begin.
7e40: 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a .. (debug:
7e50: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
7e60: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
7e70: 22 41 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 6b "Attempting to k
7e80: 69 6c 6c 20 22 6b 69 6c 6c 2d 73 77 69 74 63 68 ill "kill-switch
7e90: 22 20 73 65 72 76 65 72 20 77 69 74 68 20 70 69 " server with pi
7ea0: 64 20 22 20 70 69 64 29 0a 09 09 20 20 20 20 20 d " pid)...
7eb0: 20 20 28 74 61 73 6b 73 3a 6b 69 6c 6c 2d 73 65 (tasks:kill-se
7ec0: 72 76 65 72 20 68 6f 73 74 6e 61 6d 65 20 70 69 rver hostname pi
7ed0: 64 20 6b 69 6c 6c 2d 73 77 69 74 63 68 3a 20 6b d kill-switch: k
7ee0: 69 6c 6c 2d 73 77 69 74 63 68 29 29 29 29 29 0a ill-switch))))).
7ef0: 09 20 20 20 20 20 73 65 72 76 65 72 73 29 0a 09 . servers)..
7f00: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
7f10: 2d 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 -info 1 *default
7f20: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 44 6f 6e 65 -log-port* "Done
7f30: 20 77 69 74 68 20 6c 69 73 74 73 65 72 76 65 72 with listserver
7f40: 73 22 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a s").. (set! *
7f50: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
7f60: 29 0a 09 20 20 20 20 28 65 78 69 74 29 29 20 3b ).. (exit)) ;
7f70: 3b 20 6d 75 73 74 20 64 6f 2c 20 77 6f 75 6c 64 ; must do, would
7f80: 20 68 61 76 65 20 74 6f 20 61 64 64 20 63 68 65 have to add che
7f90: 63 6b 73 20 74 6f 20 6d 61 6e 79 2f 61 6c 6c 20 cks to many/all
7fa0: 63 61 6c 6c 73 20 62 65 6c 6f 77 0a 09 20 20 28 calls below.. (
7fb0: 65 78 69 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d exit))))..;;====
7fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8000: 3d 3d 0a 3b 3b 20 57 65 69 72 64 20 73 70 65 63 ==.;; Weird spec
8010: 69 61 6c 20 63 61 6c 6c 73 20 74 68 61 74 20 6e ial calls that n
8020: 65 65 64 20 74 6f 20 72 75 6e 20 2a 61 66 74 65 eed to run *afte
8030: 72 2a 20 74 68 65 20 73 65 72 76 65 72 20 68 61 r* the server ha
8040: 73 20 73 74 61 72 74 65 64 3f 0a 3b 3b 3d 3d 3d s started?.;;===
8050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8090: 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
80a0: 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 74 61 et-arg "-list-ta
80b0: 72 67 65 74 73 22 29 0a 20 20 20 20 28 6c 65 74 rgets"). (let
80c0: 20 28 28 74 61 72 67 65 74 73 20 28 63 6f 6d 6d ((targets (comm
80d0: 6f 6e 3a 67 65 74 2d 72 75 6e 63 6f 6e 66 69 67 on:get-runconfig
80e0: 2d 74 61 72 67 65 74 73 29 29 29 0a 20 20 20 20 -targets))).
80f0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 (debug:print 1
8100: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
8110: 72 74 2a 20 22 46 6f 75 6e 64 20 22 28 6c 65 6e rt* "Found "(len
8120: 67 74 68 20 74 61 72 67 65 74 73 29 20 22 20 74 gth targets) " t
8130: 61 72 67 65 74 73 22 29 0a 20 20 20 20 20 20 28 argets"). (
8140: 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy
8150: 6d 62 6f 6c 20 28 6f 72 20 28 61 72 67 73 3a 67 mbol (or (args:g
8160: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
8170: 65 22 29 20 22 61 6c 69 73 74 22 29 29 0a 09 28 e") "alist"))..(
8180: 28 61 6c 69 73 74 29 0a 09 20 28 66 6f 72 2d 65 (alist).. (for-e
8190: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 78 29 0a ach (lambda (x).
81a0: 09 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 .. ;; (print
81b0: 20 22 5b 22 20 78 20 22 5d 22 29 29 0a 09 09 20 "[" x "]"))...
81c0: 20 20 20 20 28 70 72 69 6e 74 20 78 29 29 0a 09 (print x))..
81d0: 09 20 20 20 74 61 72 67 65 74 73 29 29 0a 09 28 . targets))..(
81e0: 28 6a 73 6f 6e 29 0a 09 20 28 6a 73 6f 6e 2d 77 (json).. (json-w
81f0: 72 69 74 65 20 74 61 72 67 65 74 73 29 29 0a 09 rite targets))..
8200: 28 65 6c 73 65 0a 09 20 28 64 65 62 75 67 3a 70 (else.. (debug:p
8210: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
8220: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
8230: 22 64 75 6d 70 20 6f 75 74 70 75 74 20 66 6f 72 "dump output for
8240: 6d 61 74 20 22 20 28 61 72 67 73 3a 67 65 74 2d mat " (args:get-
8250: 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 arg "-dumpmode")
8260: 20 22 20 6e 6f 74 20 73 75 70 70 6f 72 74 65 64 " not supported
8270: 20 66 6f 72 20 2d 6c 69 73 74 2d 74 61 72 67 65 for -list-targe
8280: 74 73 22 29 29 29 0a 20 20 20 20 20 20 28 73 65 ts"))). (se
8290: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
82a0: 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 63 61 63 68 * #t)))..;; cach
82b0: 65 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 73 e the runconfigs
82c0: 20 69 6e 20 24 4d 54 5f 4c 49 4e 4b 54 52 45 45 in $MT_LINKTREE
82d0: 2f 24 4d 54 5f 54 41 52 47 45 54 2f 24 4d 54 5f /$MT_TARGET/$MT_
82e0: 52 55 4e 4e 41 4d 45 2f 2e 72 75 6e 63 6f 6e 66 RUNNAME/.runconf
82f0: 69 67 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 66 ig.;;.(define (f
8300: 75 6c 6c 2d 72 75 6e 63 6f 6e 66 69 67 73 2d 72 ull-runconfigs-r
8310: 65 61 64 29 0a 3b 3b 20 69 6e 20 74 68 65 20 65 ead).;; in the e
8320: 6e 76 70 72 6f 63 65 73 73 69 6e 67 20 62 72 61 nvprocessing bra
8330: 6e 63 68 20 74 68 65 20 62 65 6c 6f 77 20 63 6f nch the below co
8340: 64 65 20 72 65 70 6c 61 63 65 73 20 74 68 65 20 de replaces the
8350: 66 75 72 74 68 65 72 20 62 65 6c 6f 77 20 63 6f further below co
8360: 64 65 0a 3b 3b 20 20 28 69 66 20 28 65 71 3f 20 de.;; (if (eq?
8370: 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 2a 20 27 *configstatus* '
8380: 66 75 6c 6c 64 61 74 61 29 0a 3b 3b 20 20 20 20 fulldata).;;
8390: 20 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a *runconfigdat*
83a0: 0a 3b 3b 20 20 20 20 20 20 28 62 65 67 69 6e 0a .;; (begin.
83b0: 3b 3b 09 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 ;;.(launch:setup
83c0: 29 0a 3b 3b 09 2a 72 75 6e 63 6f 6e 66 69 67 64 ).;;.*runconfigd
83d0: 61 74 2a 29 29 29 0a 0a 20 20 28 6c 65 74 2a 20 at*))).. (let*
83e0: 28 28 72 75 6e 64 69 72 20 28 69 66 20 28 61 6e ((rundir (if (an
83f0: 64 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 4c 49 d (getenv "MT_LI
8400: 4e 4b 54 52 45 45 22 29 28 67 65 74 65 6e 76 20 NKTREE")(getenv
8410: 22 4d 54 5f 54 41 52 47 45 54 22 29 28 67 65 74 "MT_TARGET")(get
8420: 65 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 env "MT_RUNNAME"
8430: 29 29 0a 09 09 20 20 20 20 20 28 63 6f 6e 63 20 ))... (conc
8440: 28 67 65 74 65 6e 76 20 22 4d 54 5f 4c 49 4e 4b (getenv "MT_LINK
8450: 54 52 45 45 22 29 20 22 2f 22 20 28 67 65 74 65 TREE") "/" (gete
8460: 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 20 nv "MT_TARGET")
8470: 22 2f 22 20 28 67 65 74 65 6e 76 20 22 4d 54 5f "/" (getenv "MT_
8480: 52 55 4e 4e 41 4d 45 22 29 29 0a 09 09 20 20 20 RUNNAME"))...
8490: 20 20 23 66 29 29 0a 09 20 28 63 66 67 66 20 20 #f)).. (cfgf
84a0: 20 28 69 66 20 72 75 6e 64 69 72 20 28 63 6f 6e (if rundir (con
84b0: 63 20 72 75 6e 64 69 72 20 22 2f 2e 72 75 6e 63 c rundir "/.runc
84c0: 6f 6e 66 69 67 2e 22 20 6d 65 67 61 74 65 73 74 onfig." megatest
84d0: 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 -version "-" meg
84e0: 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 atest-fossil-has
84f0: 68 29 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 h) #f))). (if
8500: 20 28 61 6e 64 20 63 66 67 66 0a 09 20 20 20 20 (and cfgf..
8510: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 63 (file-exists? c
8520: 66 67 66 29 0a 09 20 20 20 20 20 28 66 69 6c 65 fgf).. (file
8530: 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 63 -write-access? c
8540: 66 67 66 29 29 0a 09 28 63 6f 6e 66 69 67 66 3a fgf))..(configf:
8550: 72 65 61 64 2d 61 6c 69 73 74 20 63 66 67 66 29 read-alist cfgf)
8560: 0a 09 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 ..(let* ((keys
8570: 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 (rmt:get-keys))
8580: 0a 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 .. (target
8590: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
85a0: 74 2d 74 61 72 67 65 74 29 29 0a 09 20 20 20 20 t-target))..
85b0: 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 28 69 66 (key-vals (if
85c0: 20 74 61 72 67 65 74 20 28 6b 65 79 73 3a 74 61 target (keys:ta
85d0: 72 67 65 74 2d 3e 6b 65 79 76 61 6c 20 6b 65 79 rget->keyval key
85e0: 73 20 74 61 72 67 65 74 29 20 23 66 29 29 0a 09 s target) #f))..
85f0: 20 20 20 20 20 20 20 28 73 65 63 74 69 6f 6e 73 (sections
8600: 20 28 69 66 20 74 61 72 67 65 74 20 28 6c 69 73 (if target (lis
8610: 74 20 22 64 65 66 61 75 6c 74 22 20 74 61 72 67 t "default" targ
8620: 65 74 29 20 23 66 29 29 0a 09 20 20 20 20 20 20 et) #f))..
8630: 20 28 64 61 74 61 20 20 20 20 20 28 62 65 67 69 (data (begi
8640: 6e 0a 09 09 09 20 20 20 28 73 65 74 65 6e 76 20 n.... (setenv
8650: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
8660: 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 09 E" *toppath*)...
8670: 09 20 20 20 28 69 66 20 6b 65 79 2d 76 61 6c 73 . (if key-vals
8680: 0a 09 09 09 20 20 20 20 20 20 20 28 66 6f 72 2d .... (for-
8690: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 74 each (lambda (kt
86a0: 29 0a 09 09 09 09 09 20 20 20 28 73 65 74 65 6e )...... (seten
86b0: 76 20 28 63 61 72 20 6b 74 29 20 28 63 61 64 72 v (car kt) (cadr
86c0: 20 6b 74 29 29 29 0a 09 09 09 09 09 20 6b 65 79 kt)))...... key
86d0: 2d 76 61 6c 73 29 29 0a 09 09 09 20 20 20 28 72 -vals)).... (r
86e0: 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 6f 6e 63 ead-config (conc
86f0: 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e *toppath* "/run
8700: 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 configs.config")
8710: 20 23 66 20 23 74 20 73 65 63 74 69 6f 6e 73 3a #f #t sections:
8720: 20 73 65 63 74 69 6f 6e 73 29 29 29 29 0a 09 20 sections))))..
8730: 20 28 69 66 20 28 61 6e 64 20 72 75 6e 64 69 72 (if (and rundir
8740: 20 3b 3b 20 68 61 76 65 20 61 6c 6c 20 6e 65 65 ;; have all nee
8750: 64 65 64 20 76 61 72 69 61 62 6c 65 73 73 0a 09 ded variabless..
8760: 09 20 20 20 28 64 69 72 65 63 74 6f 72 79 2d 65 . (directory-e
8770: 78 69 73 74 73 3f 20 72 75 6e 64 69 72 29 0a 09 xists? rundir)..
8780: 09 20 20 20 28 66 69 6c 65 2d 77 72 69 74 65 2d . (file-write-
8790: 61 63 63 65 73 73 3f 20 72 75 6e 64 69 72 29 29 access? rundir))
87a0: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
87b0: 09 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d .(configf:write-
87c0: 61 6c 69 73 74 20 64 61 74 61 20 63 66 67 66 29 alist data cfgf)
87d0: 0a 09 09 3b 3b 20 66 6f 72 63 65 20 72 65 2d 72 ...;; force re-r
87e0: 65 61 64 20 6f 66 20 6d 65 67 61 74 65 73 74 2e ead of megatest.
87f0: 63 6f 6e 66 69 67 20 2d 20 74 68 69 73 20 72 65 config - this re
8800: 73 6f 6c 76 65 73 20 63 69 72 63 75 6c 61 72 20 solves circular
8810: 72 65 66 65 72 65 6e 63 65 73 20 62 65 74 77 65 references betwe
8820: 65 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 en megatest.conf
8830: 69 67 0a 09 09 28 6c 61 75 6e 63 68 3a 73 65 74 ig...(launch:set
8840: 75 70 20 66 6f 72 63 65 3a 20 23 74 29 0a 09 09 up force: #t)...
8850: 28 6c 61 75 6e 63 68 3a 63 61 63 68 65 2d 63 6f (launch:cache-co
8860: 6e 66 69 67 29 29 29 20 3b 3b 20 77 65 20 63 61 nfig))) ;; we ca
8870: 6e 20 73 61 66 65 6c 79 20 63 61 63 68 65 20 6d n safely cache m
8880: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 73 egatest.config s
8890: 69 6e 63 65 20 77 65 20 68 61 76 65 20 61 20 76 ince we have a v
88a0: 61 6c 69 64 20 72 75 6e 63 6f 6e 66 69 67 0a 09 alid runconfig..
88b0: 20 20 64 61 74 61 29 29 29 29 0a 0a 28 69 66 20 data))))..(if
88c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
88d0: 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 22 29 show-runconfig")
88e0: 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 28 . (let ((tl (
88f0: 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 0a launch:setup))).
8900: 20 20 20 20 20 20 28 70 75 73 68 2d 64 69 72 65 (push-dire
8910: 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 ctory *toppath*)
8920: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 61 . (let ((da
8930: 74 61 20 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e 66 ta (full-runconf
8940: 69 67 73 2d 72 65 61 64 29 29 29 0a 09 3b 3b 20 igs-read)))..;;
8950: 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c 6f keep this one lo
8960: 63 61 6c 0a 09 28 63 6f 6e 64 0a 09 20 28 28 61 cal..(cond.. ((a
8970: 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 nd (args:get-arg
8980: 20 22 2d 73 65 63 74 69 6f 6e 22 29 0a 09 20 20 "-section")..
8990: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
89a0: 72 67 20 22 2d 76 61 72 22 29 29 0a 09 20 20 28 rg "-var")).. (
89b0: 6c 65 74 20 28 28 76 61 6c 20 28 6f 72 20 28 63 let ((val (or (c
89c0: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 onfigf:lookup da
89d0: 74 61 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ta (args:get-arg
89e0: 20 22 2d 73 65 63 74 69 6f 6e 22 29 28 61 72 67 "-section")(arg
89f0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 s:get-arg "-var"
8a00: 29 29 0a 09 09 09 20 28 63 6f 6e 66 69 67 66 3a )).... (configf:
8a10: 6c 6f 6f 6b 75 70 20 64 61 74 61 20 22 64 65 66 lookup data "def
8a20: 61 75 6c 74 22 20 28 61 72 67 73 3a 67 65 74 2d ault" (args:get-
8a30: 61 72 67 20 22 2d 76 61 72 22 29 29 29 29 29 0a arg "-var"))))).
8a40: 09 20 20 20 20 28 69 66 20 76 61 6c 20 28 70 72 . (if val (pr
8a50: 69 6e 74 20 76 61 6c 29 29 29 29 0a 09 20 28 28 int val)))).. ((
8a60: 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 not (args:get-ar
8a70: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 29 0a g "-dumpmode")).
8a80: 09 20 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 . (pp (hash-tab
8a90: 6c 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 29 29 le->alist data))
8aa0: 29 0a 09 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 ).. ((string=? (
8ab0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
8ac0: 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 umpmode") "json"
8ad0: 29 0a 09 20 20 28 6a 73 6f 6e 2d 77 72 69 74 65 ).. (json-write
8ae0: 20 64 61 74 61 29 29 0a 09 20 28 28 73 74 72 69 data)).. ((stri
8af0: 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 ng=? (args:get-a
8b00: 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 rg "-dumpmode")
8b10: 22 69 6e 69 22 29 0a 09 20 20 28 63 6f 6e 66 69 "ini").. (confi
8b20: 67 66 3a 63 6f 6e 66 69 67 2d 3e 69 6e 69 20 64 gf:config->ini d
8b30: 61 74 61 29 29 0a 09 20 28 65 6c 73 65 0a 09 20 ata)).. (else..
8b40: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
8b50: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
8b60: 6f 67 2d 70 6f 72 74 2a 20 22 2d 64 75 6d 70 6d og-port* "-dumpm
8b70: 6f 64 65 20 6f 66 20 22 20 28 61 72 67 73 3a 67 ode of " (args:g
8b80: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
8b90: 65 22 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 6e e") " not recogn
8ba0: 69 73 65 64 22 29 29 29 0a 09 28 73 65 74 21 20 ised")))..(set!
8bb0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
8bc0: 74 29 29 0a 20 20 20 20 20 20 28 70 6f 70 2d 64 t)). (pop-d
8bd0: 69 72 65 63 74 6f 72 79 29 29 29 0a 0a 28 69 66 irectory)))..(if
8be0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8bf0: 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 22 29 0a 20 -show-config").
8c00: 20 20 20 28 6c 65 74 20 28 28 74 6c 20 20 20 28 (let ((tl (
8c10: 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 launch:setup))..
8c20: 20 20 28 64 61 74 61 20 2a 63 6f 6e 66 69 67 64 (data *configd
8c30: 61 74 2a 29 29 20 3b 3b 20 28 72 65 61 64 2d 63 at*)) ;; (read-c
8c40: 6f 6e 66 69 67 20 22 6d 65 67 61 74 65 73 74 2e onfig "megatest.
8c50: 63 6f 6e 66 69 67 22 20 23 66 20 23 74 29 29 29 config" #f #t)))
8c60: 0a 20 20 20 20 20 20 28 70 75 73 68 2d 64 69 72 . (push-dir
8c70: 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a ectory *toppath*
8c80: 29 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 ). ;; keep
8c90: 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 this one local.
8ca0: 20 20 20 20 20 28 63 6f 6e 64 20 0a 20 20 20 20 (cond .
8cb0: 20 20 20 28 28 61 6e 64 20 28 61 72 67 73 3a 67 ((and (args:g
8cc0: 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e et-arg "-section
8cd0: 22 29 0a 09 20 20 20 20 20 28 61 72 67 73 3a 67 ").. (args:g
8ce0: 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 0a et-arg "-var")).
8cf0: 09 28 6c 65 74 20 28 28 76 61 6c 20 28 63 6f 6e .(let ((val (con
8d00: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 61 figf:lookup data
8d10: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8d20: 2d 73 65 63 74 69 6f 6e 22 29 28 61 72 67 73 3a -section")(args:
8d30: 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 get-arg "-var"))
8d40: 29 29 0a 09 20 20 28 69 66 20 76 61 6c 20 28 70 )).. (if val (p
8d50: 72 69 6e 74 20 76 61 6c 29 29 29 29 0a 0a 20 20 rint val))))..
8d60: 20 20 20 20 20 3b 3b 20 70 72 69 6e 74 20 6a 75 ;; print ju
8d70: 73 74 20 61 20 73 65 63 74 69 6f 6e 20 69 66 20 st a section if
8d80: 6f 6e 6c 79 20 2d 73 65 63 74 69 6f 6e 0a 0a 20 only -section..
8d90: 20 20 20 20 20 20 28 28 6e 6f 74 20 28 61 72 67 ((not (arg
8da0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
8db0: 6d 6f 64 65 22 29 29 0a 09 28 70 70 20 28 68 61 mode"))..(pp (ha
8dc0: 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 sh-table->alist
8dd0: 64 61 74 61 29 29 29 0a 20 20 20 20 20 20 20 28 data))). (
8de0: 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a (string=? (args:
8df0: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
8e00: 64 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 28 6a de") "json")..(j
8e10: 73 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 29 29 son-write data))
8e20: 0a 20 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 . ((string
8e30: 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 =? (args:get-arg
8e40: 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 69 "-dumpmode") "i
8e50: 6e 69 22 29 0a 09 28 63 6f 6e 66 69 67 66 3a 63 ni")..(configf:c
8e60: 6f 6e 66 69 67 2d 3e 69 6e 69 20 64 61 74 61 29 onfig->ini data)
8e70: 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 ). (else..
8e80: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
8e90: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
8ea0: 67 2d 70 6f 72 74 2a 20 22 2d 64 75 6d 70 6d 6f g-port* "-dumpmo
8eb0: 64 65 20 6f 66 20 22 20 28 61 72 67 73 3a 67 65 de of " (args:ge
8ec0: 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 t-arg "-dumpmode
8ed0: 22 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 6e 69 ") " not recogni
8ee0: 73 65 64 22 29 29 29 0a 20 20 20 20 20 20 28 73 sed"))). (s
8ef0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
8f00: 67 2a 20 23 74 29 0a 20 20 20 20 20 20 28 70 6f g* #t). (po
8f10: 70 2d 64 69 72 65 63 74 6f 72 79 29 29 29 0a 0a p-directory)))..
8f20: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
8f30: 67 20 22 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 6f g "-show-cmdinfo
8f40: 22 29 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 "). (if (or (
8f50: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 76 args:get-arg ":v
8f60: 61 6c 75 65 22 29 28 67 65 74 65 6e 76 20 22 4d alue")(getenv "M
8f70: 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 28 6c T_CMDINFO"))..(l
8f80: 65 74 20 28 28 64 61 74 61 20 28 63 6f 6d 6d 6f et ((data (commo
8f90: 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 n:read-encoded-s
8fa0: 74 72 69 6e 67 20 28 6f 72 20 28 61 72 67 73 3a tring (or (args:
8fb0: 67 65 74 2d 61 72 67 20 22 3a 76 61 6c 75 65 22 get-arg ":value"
8fc0: 29 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 )(getenv "MT_CMD
8fd0: 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 28 69 INFO"))))).. (i
8fe0: 66 20 28 65 71 75 61 6c 3f 20 28 61 72 67 73 3a f (equal? (args:
8ff0: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
9000: 64 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 20 20 de") "json")..
9010: 20 20 20 20 28 6a 73 6f 6e 2d 77 72 69 74 65 20 (json-write
9020: 64 61 74 61 29 0a 09 20 20 20 20 20 20 28 70 70 data).. (pp
9030: 20 64 61 74 61 29 29 0a 09 20 20 28 73 65 74 21 data)).. (set!
9040: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
9050: 23 74 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 #t))..(debug:pri
9060: 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
9070: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 65 6e lt-log-port* "en
9080: 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 vironment variab
9090: 6c 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 69 73 le MT_CMDINFO is
90a0: 20 6e 6f 74 20 73 65 74 22 29 29 29 0a 0a 3b 3b not set")))..;;
90b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90f0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 65 6d 6f 76 65 ======.;; Remove
9100: 20 6f 6c 64 20 72 75 6e 28 73 29 0a 3b 3b 3d 3d old run(s).;;==
9110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9150: 3d 3d 3d 3d 0a 0a 3b 3b 20 73 69 6e 63 65 20 73 ====..;; since s
9160: 65 76 65 72 61 6c 20 61 63 74 69 6f 6e 73 20 63 everal actions c
9170: 61 6e 20 62 65 20 73 70 65 63 69 66 69 65 64 20 an be specified
9180: 6f 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 6c on the command l
9190: 69 6e 65 20 74 68 65 20 72 65 6d 6f 76 61 6c 0a ine the removal.
91a0: 3b 3b 20 69 73 20 64 6f 6e 65 20 66 69 72 73 74 ;; is done first
91b0: 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 72 61 74 .(define (operat
91c0: 65 2d 6f 6e 20 61 63 74 69 6f 6e 29 0a 20 20 28 e-on action). (
91d0: 6c 65 74 2a 20 28 28 72 75 6e 72 65 63 20 28 72 let* ((runrec (r
91e0: 75 6e 73 3a 72 75 6e 72 65 63 2d 6d 61 6b 65 2d uns:runrec-make-
91f0: 72 65 63 6f 72 64 29 29 0a 09 20 28 74 61 72 67 record)).. (targ
9200: 65 74 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d et (common:args-
9210: 67 65 74 2d 74 61 72 67 65 74 29 29 29 0a 20 20 get-target))).
9220: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 6e (cond. ((n
9230: 6f 74 20 74 61 72 67 65 74 29 0a 20 20 20 20 20 ot target).
9240: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
9250: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
9260: 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 69 6e og-port* "Missin
9270: 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d g required param
9280: 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f eter for " actio
9290: 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 n ", you must sp
92a0: 65 63 69 66 79 20 2d 74 61 72 67 65 74 20 6f 72 ecify -target or
92b0: 20 2d 72 65 71 74 61 72 67 22 29 0a 20 20 20 20 -reqtarg").
92c0: 20 20 28 65 78 69 74 20 31 29 29 0a 20 20 20 20 (exit 1)).
92d0: 20 28 28 6e 6f 74 20 28 6f 72 20 28 61 72 67 73 ((not (or (args
92e0: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
92f0: 6d 65 22 29 0a 09 20 20 20 20 20 20 20 28 61 72 me").. (ar
9300: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
9310: 6e 61 6d 65 22 29 29 29 0a 20 20 20 20 20 20 28 name"))). (
9320: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
9330: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
9340: 2d 70 6f 72 74 2a 20 22 4d 69 73 73 69 6e 67 20 -port* "Missing
9350: 72 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 74 required paramet
9360: 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f 6e 20 er for " action
9370: 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 ", you must spec
9380: 69 66 79 20 74 68 65 20 72 75 6e 20 6e 61 6d 65 ify the run name
9390: 20 70 61 74 74 65 72 6e 20 77 69 74 68 20 2d 72 pattern with -r
93a0: 75 6e 6e 61 6d 65 20 70 61 74 74 22 29 0a 20 20 unname patt").
93b0: 20 20 20 20 28 65 78 69 74 20 32 29 29 0a 20 20 (exit 2)).
93c0: 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 ((not (args:g
93d0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
93e0: 74 22 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 t")). (debu
93f0: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
9400: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
9410: 74 2a 20 22 4d 69 73 73 69 6e 67 20 72 65 71 75 t* "Missing requ
9420: 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 ired parameter f
9430: 6f 72 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 or " action ", y
9440: 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 ou must specify
9450: 74 68 65 20 74 65 73 74 20 70 61 74 74 65 72 6e the test pattern
9460: 20 77 69 74 68 20 2d 74 65 73 74 70 61 74 74 22 with -testpatt"
9470: 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 33 29 ). (exit 3)
9480: 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 ). (else.
9490: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 63 61 72 (if (not (car
94a0: 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 29 0a *configinfo*)).
94b0: 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
94c0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
94d0: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
94e0: 2d 70 6f 72 74 2a 20 22 41 74 74 65 6d 70 74 65 -port* "Attempte
94f0: 64 20 22 20 61 63 74 69 6f 6e 20 22 6f 6e 20 74 d " action "on t
9500: 65 73 74 28 73 29 20 62 75 74 20 72 75 6e 20 61 est(s) but run a
9510: 72 65 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 rea config file
9520: 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 09 20 20 20 not found")..
9530: 20 28 65 78 69 74 20 31 29 29 0a 09 20 20 3b 3b (exit 1)).. ;;
9540: 20 70 75 74 20 74 65 73 74 20 70 61 72 61 6d 65 put test parame
9550: 74 65 72 73 20 69 6e 74 6f 20 63 6f 6e 76 65 6e ters into conven
9560: 69 65 6e 74 20 76 61 72 69 61 62 6c 65 73 0a 09 ient variables..
9570: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 3b 3b (begin.. ;;
9580: 20 63 68 65 63 6b 20 66 6f 72 20 63 6f 72 72 65 check for corre
9590: 63 74 20 76 65 72 73 69 6f 6e 2c 20 65 78 69 74 ct version, exit
95a0: 20 77 69 74 68 20 6d 65 73 73 61 67 65 20 69 66 with message if
95b0: 20 6e 6f 74 20 63 6f 72 72 65 63 74 0a 09 20 20 not correct..
95c0: 20 20 28 63 6f 6d 6d 6f 6e 3a 65 78 69 74 2d 6f (common:exit-o
95d0: 6e 2d 76 65 72 73 69 6f 6e 2d 63 68 61 6e 67 65 n-version-change
95e0: 64 29 0a 09 20 20 20 20 28 72 75 6e 73 3a 6f 70 d).. (runs:op
95f0: 65 72 61 74 65 2d 6f 6e 20 20 61 63 74 69 6f 6e erate-on action
9600: 0a 09 09 09 20 20 20 20 20 20 74 61 72 67 65 74 .... target
9610: 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f .... (commo
9620: 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 n:args-get-runna
9630: 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 me) ;; (or (arg
9640: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
9650: 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 ame")(args:get-a
9660: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a rg ":runname")).
9670: 09 09 09 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e ... (common
9680: 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 61 :args-get-testpa
9690: 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 3a tt #f) ;; (args:
96a0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
96b0: 74 74 22 29 0a 09 09 09 20 20 20 20 20 20 73 74 tt").... st
96c0: 61 74 65 3a 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 ate: (common:arg
96d0: 73 2d 67 65 74 2d 73 74 61 74 65 29 0a 09 09 09 s-get-state)....
96e0: 20 20 20 20 20 20 73 74 61 74 75 73 3a 20 28 63 status: (c
96f0: 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 73 ommon:args-get-s
9700: 74 61 74 75 73 29 0a 09 09 09 20 20 20 20 20 20 tatus)....
9710: 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 new-state-status
9720: 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 : (args:get-arg
9730: 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 "-set-state-stat
9740: 75 73 22 29 29 29 29 0a 20 20 20 20 20 20 28 73 us")))). (s
9750: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
9760: 67 2a 20 23 74 29 29 29 29 29 0a 0a 28 69 66 20 g* #t)))))..(if
9770: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
9780: 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a 20 20 remove-runs").
9790: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
97a0: 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 65 6d 6f all . "-remo
97b0: 76 65 2d 72 75 6e 73 22 0a 20 20 20 20 20 22 72 ve-runs". "r
97c0: 65 6d 6f 76 65 20 72 75 6e 73 22 0a 20 20 20 20 emove runs".
97d0: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
97e0: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
97f0: 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6f yvals). (o
9800: 70 65 72 61 74 65 2d 6f 6e 20 27 72 65 6d 6f 76 perate-on 'remov
9810: 65 2d 72 75 6e 73 29 29 29 29 0a 0a 28 69 66 20 e-runs))))..(if
9820: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
9830: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
9840: 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d "). (general-
9850: 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 run-call . "
9860: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
9870: 73 22 0a 20 20 20 20 20 22 73 65 74 20 73 74 61 s". "set sta
9880: 74 65 20 61 6e 64 20 73 74 61 74 75 73 22 0a 20 te and status".
9890: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
98a0: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
98b0: 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 keyvals).
98c0: 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 (operate-on 'se
98d0: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 29 t-state-status))
98e0: 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 ))..(if (or (arg
98f0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
9900: 72 75 6e 2d 73 74 61 74 75 73 22 29 0a 09 28 61 run-status")..(a
9910: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 rgs:get-arg "-ge
9920: 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 29 29 0a t-run-status")).
9930: 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e (general-run
9940: 2d 63 61 6c 6c 0a 20 20 20 20 20 22 2d 73 65 74 -call. "-set
9950: 2d 72 75 6e 2d 73 74 61 74 75 73 22 0a 20 20 20 -run-status".
9960: 20 20 22 73 65 74 20 72 75 6e 20 73 74 61 74 75 "set run statu
9970: 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 s". (lambda
9980: 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 (target runname
9990: 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 keys keyvals).
99a0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e (let* ((run
99b0: 73 64 61 74 20 20 28 72 6d 74 3a 67 65 74 2d 72 sdat (rmt:get-r
99c0: 75 6e 73 2d 62 79 2d 70 61 74 74 20 6b 65 79 73 uns-by-patt keys
99d0: 20 72 75 6e 6e 61 6d 65 20 0a 09 09 09 09 09 28 runname ......(
99e0: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
99f0: 74 61 72 67 65 74 29 0a 09 09 09 09 09 23 66 20 target)......#f
9a00: 23 66 20 23 66 20 23 66 29 29 0a 09 20 20 20 20 #f #f #f))..
9a10: 20 20 28 68 65 61 64 65 72 20 20 20 28 76 65 63 (header (vec
9a20: 74 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 tor-ref runsdat
9a30: 30 29 29 0a 09 20 20 20 20 20 20 28 72 6f 77 73 0)).. (rows
9a40: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref
9a50: 20 72 75 6e 73 64 61 74 20 31 29 29 29 0a 09 20 runsdat 1)))..
9a60: 28 69 66 20 28 6e 75 6c 6c 3f 20 72 6f 77 73 29 (if (null? rows)
9a70: 0a 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 20 .. (begin..
9a80: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
9a90: 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
9aa0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f lt-log-port* "No
9ab0: 20 6d 61 74 63 68 69 6e 67 20 72 75 6e 20 66 6f matching run fo
9ac0: 75 6e 64 2e 22 29 0a 09 20 20 20 20 20 20 20 28 und.").. (
9ad0: 65 78 69 74 20 31 29 29 0a 09 20 20 20 20 20 28 exit 1)).. (
9ae0: 6c 65 74 2a 20 28 28 72 6f 77 20 20 20 20 20 20 let* ((row
9af0: 28 63 61 72 20 28 76 65 63 74 6f 72 2d 72 65 66 (car (vector-ref
9b00: 20 72 75 6e 73 64 61 74 20 31 29 29 29 0a 09 09 runsdat 1)))...
9b10: 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 28 64 (run-id (d
9b20: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
9b30: 65 61 64 65 72 20 72 6f 77 20 68 65 61 64 65 72 eader row header
9b40: 20 22 69 64 22 29 29 29 0a 09 20 20 20 20 20 20 "id")))..
9b50: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
9b60: 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 rg "-set-run-sta
9b70: 74 75 73 22 29 0a 09 09 20 20 20 28 72 6d 74 3a tus")... (rmt:
9b80: 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 72 set-run-status r
9b90: 75 6e 2d 69 64 20 28 61 72 67 73 3a 67 65 74 2d un-id (args:get-
9ba0: 61 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 arg "-set-run-st
9bb0: 61 74 75 73 22 29 20 6d 73 67 3a 20 28 61 72 67 atus") msg: (arg
9bc0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 s:get-arg "-m"))
9bd0: 0a 09 09 20 20 20 28 70 72 69 6e 74 20 28 72 6d ... (print (rm
9be0: 74 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 t:get-run-status
9bf0: 20 72 75 6e 2d 69 64 29 29 0a 09 09 20 20 20 29 run-id))... )
9c00: 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ))))))..;;======
9c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c50: 0a 3b 3b 20 51 75 65 72 79 20 72 75 6e 73 0a 3b .;; Query runs.;
9c60: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
9c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ca0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 2d 66 69 65 =======..;; -fie
9cb0: 6c 64 73 20 72 75 6e 73 3a 69 64 2c 74 61 72 67 lds runs:id,targ
9cc0: 65 74 2c 72 75 6e 6e 61 6d 65 2c 63 6f 6d 6d 65 et,runname,comme
9cd0: 6e 74 2b 74 65 73 74 73 3a 69 64 2c 74 65 73 74 nt+tests:id,test
9ce0: 6e 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2b 73 name,item_path+s
9cf0: 74 65 70 73 0a 3b 3b 0a 3b 3b 20 63 73 69 3e 20 teps.;;.;; csi>
9d00: 28 65 78 74 72 61 63 74 2d 66 69 65 6c 64 73 2d (extract-fields-
9d10: 63 6f 6e 73 74 72 61 69 6e 74 73 20 22 72 75 6e constraints "run
9d20: 73 3a 69 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e s:id,target,runn
9d30: 61 6d 65 2c 63 6f 6d 6d 65 6e 74 2b 74 65 73 74 ame,comment+test
9d40: 73 3a 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 74 s:id,testname,it
9d50: 65 6d 5f 70 61 74 68 2b 73 74 65 70 73 22 29 0a em_path+steps").
9d60: 3b 3b 20 20 20 20 20 20 20 20 20 3d 3e 20 28 28 ;; => ((
9d70: 22 72 75 6e 73 22 20 22 69 64 22 20 22 74 61 72 "runs" "id" "tar
9d80: 67 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 get" "runname" "
9d90: 63 6f 6d 6d 65 6e 74 22 29 20 28 22 74 65 73 74 comment") ("test
9da0: 73 22 20 22 69 64 22 20 22 74 65 73 74 6e 61 6d s" "id" "testnam
9db0: 65 22 20 22 69 74 65 6d 5f 70 61 74 68 22 29 20 e" "item_path")
9dc0: 28 22 73 74 65 70 73 22 29 29 0a 3b 3b 0a 3b 3b ("steps")).;;.;;
9dd0: 20 20 20 4e 4f 54 45 3a 20 72 65 6d 65 6d 62 65 NOTE: remembe
9de0: 72 20 74 68 61 74 20 74 68 65 20 63 64 72 20 77 r that the cdr w
9df0: 69 6c 6c 20 62 65 20 74 68 65 20 6c 69 73 74 20 ill be the list
9e00: 79 6f 75 20 65 78 70 65 63 74 20 28 63 64 72 20 you expect (cdr
9e10: 28 22 72 75 6e 73 22 20 22 69 64 22 20 22 74 61 ("runs" "id" "ta
9e20: 72 67 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 20 rget" "runname"
9e30: 22 63 6f 6d 6d 65 6e 74 22 29 29 20 3d 3e 20 28 "comment")) => (
9e40: 22 69 64 22 20 22 74 61 72 67 65 74 22 20 22 72 "id" "target" "r
9e50: 75 6e 6e 61 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 unname" "comment
9e60: 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 61 6e ").;; an
9e70: 64 20 73 6f 20 61 6c 69 73 74 2d 72 65 66 20 77 d so alist-ref w
9e80: 69 6c 6c 20 79 69 65 6c 64 20 77 68 61 74 20 79 ill yield what y
9e90: 6f 75 20 65 78 70 65 63 74 0a 3b 3b 0a 28 64 65 ou expect.;;.(de
9ea0: 66 69 6e 65 20 28 65 78 74 72 61 63 74 2d 66 69 fine (extract-fi
9eb0: 65 6c 64 73 2d 63 6f 6e 73 74 72 61 69 6e 74 73 elds-constraints
9ec0: 20 66 69 65 6c 64 73 2d 73 70 65 63 29 0a 20 20 fields-spec).
9ed0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 74 61 (map (lambda (ta
9ee0: 62 6c 65 2d 73 70 65 63 29 20 3b 3b 20 72 75 6e ble-spec) ;; run
9ef0: 73 3a 69 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e s:id,target,runn
9f00: 61 6d 65 0a 09 20 28 6c 65 74 20 28 28 64 61 74 ame.. (let ((dat
9f10: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 74 (string-split t
9f20: 61 62 6c 65 2d 73 70 65 63 20 22 3a 22 29 29 29 able-spec ":")))
9f30: 20 3b 3b 20 28 22 72 75 6e 73 22 20 22 69 64 2c ;; ("runs" "id,
9f40: 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 22 29 target,runname")
9f50: 0a 09 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e .. (if (> (len
9f60: 67 74 68 20 64 61 74 29 20 31 29 0a 09 20 20 20 gth dat) 1)..
9f70: 20 20 20 20 28 63 6f 6e 73 20 28 63 61 72 20 64 (cons (car d
9f80: 61 74 29 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 at)(string-split
9f90: 20 28 63 61 64 72 20 64 61 74 29 20 22 2c 22 29 (cadr dat) ",")
9fa0: 29 20 3b 3b 20 22 69 64 2c 74 61 72 67 65 74 2c ) ;; "id,target,
9fb0: 72 75 6e 6e 61 6d 65 22 0a 09 20 20 20 20 20 20 runname"..
9fc0: 20 64 61 74 29 29 29 0a 20 20 20 20 20 20 20 28 dat))). (
9fd0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 66 69 65 string-split fie
9fe0: 6c 64 73 2d 73 70 65 63 20 22 2b 22 29 29 29 0a lds-spec "+"))).
9ff0: 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d 76 61 .(define (get-va
a000: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
a010: 20 64 61 74 61 76 65 63 20 74 65 73 74 2d 66 69 datavec test-fi
a020: 65 6c 64 2d 69 6e 64 65 78 20 66 69 65 6c 64 6e eld-index fieldn
a030: 61 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 69 6e ame). (let ((in
a040: 64 78 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 dx (hash-table-r
a050: 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 2d ef/default test-
a060: 66 69 65 6c 64 2d 69 6e 64 65 78 20 66 69 65 6c field-index fiel
a070: 64 6e 61 6d 65 20 23 66 29 29 29 0a 20 20 20 20 dname #f))).
a080: 28 69 66 20 69 6e 64 78 0a 09 28 69 66 20 28 3e (if indx..(if (>
a090: 3d 20 69 6e 64 78 20 28 76 65 63 74 6f 72 2d 6c = indx (vector-l
a0a0: 65 6e 67 74 68 20 64 61 74 61 76 65 63 29 29 0a ength datavec)).
a0b0: 09 20 20 20 20 23 66 20 3b 3b 20 69 6e 64 65 78 . #f ;; index
a0c0: 20 74 6f 20 68 69 67 68 2c 20 73 68 6f 75 6c 64 to high, should
a0d0: 20 72 61 69 73 65 20 61 6e 20 65 72 72 6f 72 20 raise an error
a0e0: 49 20 73 75 70 70 6f 73 65 0a 09 20 20 20 20 28 I suppose.. (
a0f0: 76 65 63 74 6f 72 2d 72 65 66 20 64 61 74 61 76 vector-ref datav
a100: 65 63 20 69 6e 64 78 29 29 0a 09 23 66 29 29 29 ec indx))..#f)))
a110: 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 6c 69 73 74 2d ..;; NOTE: list-
a120: 72 75 6e 73 20 61 6e 64 20 6c 69 73 74 2d 64 62 runs and list-db
a130: 2d 74 61 72 67 65 74 73 20 6f 70 65 72 61 74 65 -targets operate
a140: 20 6f 6e 20 6c 6f 63 61 6c 20 64 62 21 21 21 0a on local db!!!.
a150: 3b 3b 0a 3b 3b 20 49 44 45 41 3a 20 6d 65 67 61 ;;.;; IDEA: mega
a160: 74 65 73 74 20 6c 69 73 74 20 2d 72 75 6e 6e 61 test list -runna
a170: 6d 65 20 62 6c 61 68 25 20 2e 2e 2e 0a 3b 3b 0a me blah% ....;;.
a180: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
a190: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e t-arg "-list-run
a1a0: 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 s")..(args:get-a
a1b0: 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 rg "-list-db-tar
a1c0: 67 65 74 73 22 29 29 0a 20 20 20 20 28 69 66 20 gets")). (if
a1d0: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 0a 09 (launch:setup)..
a1e0: 28 6c 65 74 2a 20 28 3b 3b 20 28 64 62 73 74 72 (let* (;; (dbstr
a1f0: 75 63 74 20 20 20 20 28 6d 61 6b 65 2d 64 62 72 uct (make-dbr
a200: 3a 64 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 :dbstruct path:
a210: 2a 74 6f 70 70 61 74 68 2a 20 6c 6f 63 61 6c 3a *toppath* local:
a220: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
a230: 2d 6c 6f 63 61 6c 22 29 29 29 0a 09 20 20 20 20 -local")))..
a240: 20 20 20 28 72 75 6e 70 61 74 74 20 20 20 20 20 (runpatt
a250: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
a260: 6c 69 73 74 2d 72 75 6e 73 22 29 29 0a 09 20 20 list-runs"))..
a270: 20 20 20 20 20 28 74 65 73 74 70 61 74 74 20 20 (testpatt
a280: 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 (common:args-g
a290: 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 29 et-testpatt #f))
a2a0: 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 69 66 20 .. ;; (if
a2b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
a2c0: 74 65 73 74 70 61 74 74 22 29 20 0a 09 20 20 20 testpatt") ..
a2d0: 20 20 20 20 3b 3b 20 20 09 20 20 20 20 20 20 20 ;; .
a2e0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
a2f0: 2d 74 65 73 74 70 61 74 74 22 29 20 0a 09 20 20 -testpatt") ..
a300: 20 20 20 20 20 3b 3b 20 20 09 20 20 20 20 20 20 ;; .
a310: 20 20 22 25 22 29 29 0a 09 20 20 20 20 20 20 20 "%"))..
a320: 28 6b 65 79 73 20 20 20 20 20 20 20 20 28 72 6d (keys (rm
a330: 74 3a 67 65 74 2d 6b 65 79 73 29 29 20 3b 3b 20 t:get-keys)) ;;
a340: 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 73 (db:get-keys dbs
a350: 74 72 75 63 74 29 29 0a 09 20 20 20 20 20 20 20 truct))..
a360: 3b 3b 20 28 72 75 6e 73 64 61 20 20 20 74 20 20 ;; (runsda t
a370: 28 64 62 3a 67 65 74 2d 72 75 6e 73 20 64 62 73 (db:get-runs dbs
a380: 74 72 75 63 74 20 72 75 6e 70 61 74 74 20 23 66 truct runpatt #f
a390: 20 23 66 20 27 28 29 29 29 0a 09 20 20 20 20 20 #f '()))..
a3a0: 20 20 28 72 75 6e 73 64 61 74 20 20 20 20 20 28 (runsdat (
a3b0: 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d rmt:get-runs-by-
a3c0: 70 61 74 74 20 6b 65 79 73 20 28 6f 72 20 72 75 patt keys (or ru
a3d0: 6e 70 61 74 74 20 22 25 22 29 20 28 63 6f 6d 6d npatt "%") (comm
a3e0: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 on:args-get-targ
a3f0: 65 74 29 20 3b 3b 20 28 64 62 3a 67 65 74 2d 72 et) ;; (db:get-r
a400: 75 6e 73 2d 62 79 2d 70 61 74 74 20 64 62 73 74 uns-by-patt dbst
a410: 72 75 63 74 20 6b 65 79 73 20 28 6f 72 20 72 75 ruct keys (or ru
a420: 6e 70 61 74 74 20 22 25 22 29 20 28 63 6f 6d 6d npatt "%") (comm
a430: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 on:args-get-targ
a440: 65 74 29 0a 09 09 09 20 20 20 20 20 20 20 20 20 et)....
a450: 20 20 09 20 23 66 20 23 66 20 27 28 22 69 64 22 . #f #f '("id"
a460: 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 "runname" "stat
a470: 65 22 20 22 73 74 61 74 75 73 22 20 22 6f 77 6e e" "status" "own
a480: 65 72 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 er" "event_time"
a490: 20 22 63 6f 6d 6d 65 6e 74 22 29 20 30 29 29 0a "comment") 0)).
a4a0: 09 20 20 20 20 20 20 20 28 72 75 6e 73 74 6d 70 . (runstmp
a4b0: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 (db:get-row
a4c0: 73 20 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 s runsdat))..
a4d0: 20 20 20 20 28 68 65 61 64 65 72 20 20 20 20 20 (header
a4e0: 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 (db:get-header
a4f0: 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 runsdat))..
a500: 20 20 3b 3b 20 74 68 69 73 20 69 73 20 22 2d 73 ;; this is "-s
a510: 69 6e 63 65 22 20 73 75 70 70 6f 72 74 2e 20 54 ince" support. T
a520: 68 69 73 20 6c 6f 6f 6b 73 20 61 74 20 6c 61 73 his looks at las
a530: 74 20 6d 6f 64 20 74 69 6d 65 73 20 6f 66 20 3c t mod times of <
a540: 72 75 6e 2d 69 64 3e 2e 64 62 20 66 69 6c 65 73 run-id>.db files
a550: 0a 09 20 20 20 20 20 20 20 3b 3b 20 61 6e 64 20 .. ;; and
a560: 63 6f 6c 6c 65 63 74 73 20 74 68 6f 73 65 20 6d collects those m
a570: 6f 64 69 66 69 65 64 20 73 69 6e 63 65 20 74 68 odified since th
a580: 65 20 2d 73 69 6e 63 65 20 74 69 6d 65 2e 0a 09 e -since time...
a590: 20 20 20 20 20 20 20 28 72 75 6e 73 20 20 20 20 (runs
a5a0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f (if (and (no
a5b0: 74 20 28 6e 75 6c 6c 3f 20 72 75 6e 73 74 6d 70 t (null? runstmp
a5c0: 29 29 0a 09 09 09 09 20 20 20 20 20 28 61 72 67 ))..... (arg
a5d0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 s:get-arg "-sinc
a5e0: 65 22 29 29 0a 09 09 09 09 28 6c 65 74 20 28 28 e")).....(let ((
a5f0: 63 68 61 6e 67 65 64 2d 69 64 73 20 28 64 62 3a changed-ids (db:
a600: 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 75 6e 2d get-changed-run-
a610: 69 64 73 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d ids (string->num
a620: 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ber (args:get-ar
a630: 67 20 22 2d 73 69 6e 63 65 22 29 29 29 29 29 0a g "-since"))))).
a640: 09 09 09 09 20 20 28 6c 65 74 20 6c 6f 6f 70 20 .... (let loop
a650: 28 28 68 65 64 20 28 63 61 72 20 72 75 6e 73 74 ((hed (car runst
a660: 6d 70 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 mp))...... (
a670: 74 61 6c 20 28 63 64 72 20 72 75 6e 73 74 6d 70 tal (cdr runstmp
a680: 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 72 65 ))...... (re
a690: 73 20 27 28 29 29 29 0a 09 09 09 09 20 20 20 20 s '())).....
a6a0: 28 6c 65 74 20 28 28 6e 65 77 2d 72 65 73 20 28 (let ((new-res (
a6b0: 69 66 20 28 6d 65 6d 62 65 72 20 28 64 62 3a 67 if (member (db:g
a6c0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
a6d0: 65 72 20 68 65 64 20 68 65 61 64 65 72 20 22 69 er hed header "i
a6e0: 64 22 29 20 63 68 61 6e 67 65 64 2d 69 64 73 29 d") changed-ids)
a6f0: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 ....... (c
a700: 6f 6e 73 20 68 65 64 20 72 65 73 29 0a 09 09 09 ons hed res)....
a710: 09 09 09 20 20 20 20 20 20 20 72 65 73 29 29 29 ... res)))
a720: 0a 09 09 09 09 20 20 20 20 20 20 28 69 66 20 28 ..... (if (
a730: 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 09 09 09 null? tal)......
a740: 20 20 28 72 65 76 65 72 73 65 20 6e 65 77 2d 72 (reverse new-r
a750: 65 73 29 0a 09 09 09 09 09 20 20 28 6c 6f 6f 70 es)...... (loop
a760: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
a770: 61 6c 29 20 6e 65 77 2d 72 65 73 29 29 29 29 29 al) new-res)))))
a780: 0a 09 09 09 09 72 75 6e 73 74 6d 70 29 29 0a 09 .....runstmp))..
a790: 20 20 20 20 20 20 20 28 64 62 2d 74 61 72 67 65 (db-targe
a7a0: 74 73 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ts (args:get-ar
a7b0: 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 g "-list-db-targ
a7c0: 65 74 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 ets")).. (
a7d0: 73 65 65 6e 20 20 20 20 20 20 20 20 28 6d 61 6b seen (mak
a7e0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 e-hash-table))..
a7f0: 20 20 20 20 20 20 20 28 64 6d 6f 64 65 20 20 20 (dmode
a800: 20 20 20 20 28 6c 65 74 20 28 28 64 20 28 61 72 (let ((d (ar
a810: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d gs:get-arg "-dum
a820: 70 6d 6f 64 65 22 29 29 29 0a 09 09 09 20 20 20 pmode")))....
a830: 20 20 20 28 69 66 20 64 20 28 73 74 72 69 6e 67 (if d (string
a840: 2d 3e 73 79 6d 62 6f 6c 20 64 29 20 23 66 29 29 ->symbol d) #f))
a850: 29 0a 09 20 20 20 20 20 20 20 28 64 61 74 61 20 ).. (data
a860: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 (make-has
a870: 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 20 20 20 h-table))..
a880: 20 20 28 66 69 65 6c 64 73 2d 73 70 65 63 20 28 (fields-spec (
a890: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
a8a0: 20 22 2d 66 69 65 6c 64 73 22 29 0a 09 09 09 09 "-fields").....
a8b0: 28 65 78 74 72 61 63 74 2d 66 69 65 6c 64 73 2d (extract-fields-
a8c0: 63 6f 6e 73 74 72 61 69 6e 74 73 20 28 61 72 67 constraints (arg
a8d0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 66 69 65 6c s:get-arg "-fiel
a8e0: 64 73 22 29 29 0a 09 09 09 09 28 6c 69 73 74 20 ds")).....(list
a8f0: 28 63 6f 6e 73 20 22 72 75 6e 73 22 20 28 61 70 (cons "runs" (ap
a900: 70 65 6e 64 20 6b 65 79 73 20 28 6c 69 73 74 20 pend keys (list
a910: 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 "id" "runname" "
a920: 73 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 state" "status"
a930: 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 "owner" "event_t
a940: 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 20 22 ime" "comment" "
a950: 66 61 69 6c 5f 63 6f 75 6e 74 22 20 22 70 61 73 fail_count" "pas
a960: 73 5f 63 6f 75 6e 74 22 29 29 29 0a 09 09 09 09 s_count"))).....
a970: 20 20 20 20 20 20 28 63 6f 6e 73 20 22 74 65 73 (cons "tes
a980: 74 73 22 20 20 64 62 3a 74 65 73 74 2d 72 65 63 ts" db:test-rec
a990: 6f 72 64 2d 66 69 65 6c 64 73 29 20 3b 3b 20 22 ord-fields) ;; "
a9a0: 69 64 22 20 22 74 65 73 74 6e 61 6d 65 22 20 22 id" "testname" "
a9b0: 74 65 73 74 5f 70 61 74 68 22 29 0a 09 09 09 09 test_path").....
a9c0: 20 20 20 20 20 20 28 6c 69 73 74 20 22 73 74 65 (list "ste
a9d0: 70 73 22 20 22 69 64 22 20 22 73 74 65 70 6e 61 ps" "id" "stepna
a9e0: 6d 65 22 29 29 29 29 0a 09 20 20 20 20 20 20 20 me"))))..
a9f0: 28 72 75 6e 73 2d 73 70 65 63 20 20 20 28 6c 65 (runs-spec (le
aa00: 74 20 28 28 72 20 28 61 6c 69 73 74 2d 72 65 66 t ((r (alist-ref
aa10: 20 22 72 75 6e 73 22 20 20 66 69 65 6c 64 73 2d "runs" fields-
aa20: 73 70 65 63 20 65 71 75 61 6c 3f 29 29 29 20 3b spec equal?))) ;
aa30: 3b 20 74 68 65 20 63 68 65 63 6b 20 69 73 20 6e ; the check is n
aa40: 6f 77 20 75 6e 6e 65 63 65 73 73 61 72 79 0a 09 ow unnecessary..
aa50: 09 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 .. (if (and
aa60: 20 72 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 r (not (null? r
aa70: 29 29 29 20 72 20 28 6c 69 73 74 20 22 69 64 22 ))) r (list "id"
aa80: 20 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 )))).. (t
aa90: 65 73 74 73 2d 73 70 65 63 20 20 28 6c 65 74 20 ests-spec (let
aaa0: 28 28 74 20 28 61 6c 69 73 74 2d 72 65 66 20 22 ((t (alist-ref "
aab0: 74 65 73 74 73 22 20 66 69 65 6c 64 73 2d 73 70 tests" fields-sp
aac0: 65 63 20 65 71 75 61 6c 3f 29 29 29 0a 09 09 09 ec equal?)))....
aad0: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 (if (and t
aae0: 20 28 6e 75 6c 6c 3f 20 74 29 29 20 3b 3b 20 61 (null? t)) ;; a
aaf0: 6c 6c 20 66 69 65 6c 64 73 0a 09 09 09 09 20 20 ll fields.....
ab00: 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 db:test-record-f
ab10: 69 65 6c 64 73 0a 09 09 09 09 20 20 74 29 29 29 ields..... t)))
ab20: 0a 09 20 20 20 20 20 20 20 28 61 64 6a 2d 74 65 .. (adj-te
ab30: 73 74 73 2d 73 70 65 63 20 28 64 65 6c 65 74 65 sts-spec (delete
ab40: 2d 64 75 70 6c 69 63 61 74 65 73 20 28 69 66 20 -duplicates (if
ab50: 74 65 73 74 73 2d 73 70 65 63 20 28 63 6f 6e 73 tests-spec (cons
ab60: 20 22 69 64 22 20 74 65 73 74 73 2d 73 70 65 63 "id" tests-spec
ab70: 29 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 ) db:test-record
ab80: 2d 66 69 65 6c 64 73 29 29 29 20 3b 3b 20 27 28 -fields))) ;; '(
ab90: 22 69 64 22 29 29 29 29 0a 09 20 20 20 20 20 20 "id"))))..
aba0: 20 28 73 74 65 70 73 2d 73 70 65 63 20 20 28 61 (steps-spec (a
abb0: 6c 69 73 74 2d 72 65 66 20 22 73 74 65 70 73 22 list-ref "steps"
abc0: 20 66 69 65 6c 64 73 2d 73 70 65 63 20 65 71 75 fields-spec equ
abd0: 61 6c 3f 29 29 0a 09 20 20 20 20 20 20 20 28 74 al?)).. (t
abe0: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
abf0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
ac00: 29 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 ))).. (if (and
ac10: 74 65 73 74 73 2d 73 70 65 63 20 28 6e 6f 74 20 tests-spec (not
ac20: 28 6e 75 6c 6c 3f 20 74 65 73 74 73 2d 73 70 65 (null? tests-spe
ac30: 63 29 29 29 20 3b 3b 20 64 6f 20 73 6f 6d 65 20 c))) ;; do some
ac40: 76 61 6c 69 64 61 74 69 6f 6e 20 61 6e 64 20 70 validation and p
ac50: 72 6f 63 65 73 73 69 6e 67 20 6f 66 20 74 68 65 rocessing of the
ac60: 20 74 65 73 74 2d 73 70 65 63 0a 09 20 20 20 20 test-spec..
ac70: 20 20 28 6c 65 74 20 28 28 69 6e 76 61 6c 69 64 (let ((invalid
ac80: 2d 74 65 73 74 73 2d 73 70 65 63 20 28 66 69 6c -tests-spec (fil
ac90: 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 ter (lambda (x)(
aca0: 6e 6f 74 20 28 6d 65 6d 62 65 72 20 78 20 64 62 not (member x db
acb0: 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 :test-record-fie
acc0: 6c 64 73 29 29 29 20 74 65 73 74 73 2d 73 70 65 lds))) tests-spe
acd0: 63 29 29 29 0a 09 09 28 69 66 20 28 6e 75 6c 6c c)))...(if (null
ace0: 3f 20 69 6e 76 61 6c 69 64 2d 74 65 73 74 73 2d ? invalid-tests-
acf0: 73 70 65 63 29 0a 09 09 20 20 20 20 3b 3b 20 67 spec)... ;; g
ad00: 65 6e 65 72 61 74 65 20 74 68 65 20 6c 6f 6f 6b enerate the look
ad10: 75 70 20 6d 61 70 20 74 65 73 74 2d 66 69 65 6c up map test-fiel
ad20: 64 2d 6e 61 6d 65 20 3d 3e 20 69 6e 64 65 78 2d d-name => index-
ad30: 6e 75 6d 62 65 72 0a 09 09 20 20 20 20 28 6c 65 number... (le
ad40: 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 t loop ((hed (ca
ad50: 72 20 61 64 6a 2d 74 65 73 74 73 2d 73 70 65 63 r adj-tests-spec
ad60: 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 74 61 )).... (ta
ad70: 6c 20 28 63 64 72 20 61 64 6a 2d 74 65 73 74 73 l (cdr adj-tests
ad80: 2d 73 70 65 63 29 29 0a 09 09 09 20 20 20 20 20 -spec))....
ad90: 20 20 28 69 64 78 20 30 29 29 0a 09 09 20 20 20 (idx 0))...
ada0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
adb0: 65 74 21 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 et! test-field-i
adc0: 6e 64 65 78 20 68 65 64 20 69 64 78 29 0a 09 09 ndex hed idx)...
add0: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
ade0: 6e 75 6c 6c 3f 20 74 61 6c 29 29 28 6c 6f 6f 70 null? tal))(loop
adf0: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
ae00: 61 6c 29 28 2b 20 69 64 78 20 31 29 29 29 29 0a al)(+ idx 1)))).
ae10: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 .. (begin...
ae20: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
ae30: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
ae40: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 6e lt-log-port* "In
ae50: 76 61 6c 69 64 20 74 65 73 74 20 66 69 65 6c 64 valid test field
ae60: 73 20 73 70 65 63 69 66 69 65 64 3a 20 22 20 28 s specified: " (
ae70: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
ae80: 73 65 20 69 6e 76 61 6c 69 64 2d 74 65 73 74 73 se invalid-tests
ae90: 2d 73 70 65 63 20 22 2c 20 22 29 29 0a 09 09 20 -spec ", "))...
aea0: 20 20 20 20 20 28 65 78 69 74 29 29 29 29 29 0a (exit))))).
aeb0: 0a 09 20 20 3b 3b 20 45 61 63 68 20 72 75 6e 0a .. ;; Each run.
aec0: 09 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 . (for-each ..
aed0: 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a (lambda (run).
aee0: 09 20 20 20 20 20 28 6c 65 74 20 28 28 74 61 72 . (let ((tar
aef0: 67 65 74 73 74 72 20 28 73 74 72 69 6e 67 2d 69 getstr (string-i
af00: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
af10: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 (lambda (x).....
af20: 09 09 09 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 ... (db:get-valu
af30: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
af40: 68 65 61 64 65 72 20 78 29 29 0a 09 09 09 09 09 header x))......
af50: 09 20 20 20 20 20 20 20 6b 65 79 73 29 20 22 2f . keys) "/
af60: 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 69 66 "))).. (if
af70: 20 64 62 2d 74 61 72 67 65 74 73 0a 09 09 20 20 db-targets...
af80: 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d (if (not (hash-
af90: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
afa0: 74 20 73 65 65 6e 20 74 61 72 67 65 74 73 74 72 t seen targetstr
afb0: 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 20 28 #f))... (
afc0: 62 65 67 69 6e 0a 09 09 09 20 28 68 61 73 68 2d begin.... (hash-
afd0: 74 61 62 6c 65 2d 73 65 74 21 20 73 65 65 6e 20 table-set! seen
afe0: 74 61 72 67 65 74 73 74 72 20 23 74 29 0a 09 09 targetstr #t)...
aff0: 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 5b 22 20 . ;; (print "["
b000: 74 61 72 67 65 74 73 74 72 20 22 5d 22 29 29 29 targetstr "]")))
b010: 29 0a 09 09 09 20 28 69 66 20 28 6e 6f 74 20 64 ).... (if (not d
b020: 6d 6f 64 65 29 0a 09 09 09 20 20 20 20 20 28 70 mode).... (p
b030: 72 69 6e 74 20 74 61 72 67 65 74 73 74 72 29 0a rint targetstr).
b040: 09 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 ... (hash-ta
b050: 62 6c 65 2d 73 65 74 21 20 64 61 74 61 20 22 74 ble-set! data "t
b060: 61 72 67 65 74 73 22 20 28 63 6f 6e 73 20 74 61 argets" (cons ta
b070: 72 67 65 74 73 74 72 20 28 68 61 73 68 2d 74 61 rgetstr (hash-ta
b080: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
b090: 64 61 74 61 20 22 74 61 72 67 65 74 73 22 20 27 data "targets" '
b0a0: 28 29 29 29 29 0a 09 09 09 20 20 20 20 20 29 29 ()))).... ))
b0b0: 29 0a 09 09 20 20 20 28 6c 65 74 2a 20 28 28 72 )... (let* ((r
b0c0: 75 6e 2d 69 64 20 20 28 64 62 3a 67 65 74 2d 76 un-id (db:get-v
b0d0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
b0e0: 75 6e 20 68 65 61 64 65 72 20 22 69 64 22 29 29 un header "id"))
b0f0: 0a 09 09 09 20 20 28 72 75 6e 6e 61 6d 65 20 28 .... (runname (
b100: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
b110: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
b120: 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 20 0a 09 r "runname")) ..
b130: 09 09 20 20 28 73 74 61 74 65 73 20 20 28 73 74 .. (states (st
b140: 72 69 6e 67 2d 73 70 6c 69 74 20 28 6f 72 20 28 ring-split (or (
b150: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
b160: 74 61 74 65 22 29 20 22 22 29 20 22 2c 22 29 29 tate") "") ","))
b170: 0a 09 09 09 20 20 28 73 74 61 74 75 73 65 73 20 .... (statuses
b180: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 6f (string-split (o
b190: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
b1a0: 22 2d 73 74 61 74 75 73 22 29 20 22 22 29 20 22 "-status") "") "
b1b0: 2c 22 29 29 0a 09 09 09 20 20 28 74 65 73 74 73 ,")).... (tests
b1c0: 20 20 20 28 69 66 20 74 65 73 74 73 2d 73 70 65 (if tests-spe
b1d0: 63 0a 09 09 09 09 20 20 20 20 20 20 20 28 72 6d c..... (rm
b1e0: 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d t:get-tests-for-
b1f0: 72 75 6e 20 72 75 6e 2d 69 64 20 74 65 73 74 70 run run-id testp
b200: 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 75 att states statu
b210: 73 65 73 20 23 66 20 23 66 20 23 66 20 27 74 65 ses #f #f #f 'te
b220: 73 74 6e 61 6d 65 20 27 61 73 63 20 3b 3b 20 28 stname 'asc ;; (
b230: 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 db:get-tests-for
b240: 2d 72 75 6e 20 64 62 73 74 72 75 63 74 20 72 75 -run dbstruct ru
b250: 6e 2d 69 64 20 74 65 73 74 70 61 74 74 20 27 28 n-id testpatt '(
b260: 29 20 27 28 29 20 23 66 20 23 66 20 23 66 20 27 ) '() #f #f #f '
b270: 74 65 73 74 6e 61 6d 65 20 27 61 73 63 20 0a 09 testname 'asc ..
b280: 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 75 73 ...... ;; us
b290: 65 20 71 72 79 76 61 6c 73 20 69 66 20 74 65 73 e qryvals if tes
b2a0: 74 2d 73 70 65 63 20 70 72 6f 76 69 64 65 64 0a t-spec provided.
b2b0: 09 09 09 09 09 09 09 20 20 20 20 20 28 69 66 20 ....... (if
b2c0: 74 65 73 74 73 2d 73 70 65 63 0a 09 09 09 09 09 tests-spec......
b2d0: 09 09 09 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 ... (string-inte
b2e0: 72 73 70 65 72 73 65 20 61 64 6a 2d 74 65 73 74 rsperse adj-test
b2f0: 73 2d 73 70 65 63 20 22 2c 22 29 0a 09 09 09 09 s-spec ",").....
b300: 09 09 09 09 20 3b 3b 20 64 62 3a 74 65 73 74 2d .... ;; db:test-
b310: 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 0a 09 09 record-fields...
b320: 09 09 09 09 09 09 20 23 66 29 0a 09 09 09 09 09 ...... #f)......
b330: 09 09 20 20 20 20 20 23 66 0a 09 09 09 09 09 09 .. #f.......
b340: 09 20 20 20 20 20 27 6e 6f 72 6d 61 6c 29 0a 09 . 'normal)..
b350: 09 09 09 20 20 20 20 20 20 20 27 28 29 29 29 29 ... '())))
b360: 0a 09 09 20 20 20 20 20 28 63 61 73 65 20 64 6d ... (case dm
b370: 6f 64 65 0a 09 09 20 20 20 20 20 20 20 28 28 6a ode... ((j
b380: 73 6f 6e 20 6f 64 73 29 0a 09 09 09 28 69 66 20 son ods)....(if
b390: 72 75 6e 73 2d 73 70 65 63 0a 09 09 09 20 20 20 runs-spec....
b3a0: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 (for-each ....
b3b0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 69 65 (lambda (fie
b3c0: 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 ld-name)....
b3d0: 20 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 (mutils:hierh
b3e0: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 63 ash-set! data (c
b3f0: 6f 6e 63 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 onc (db:get-valu
b400: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
b410: 68 65 61 64 65 72 20 66 69 65 6c 64 2d 6e 61 6d header field-nam
b420: 65 29 29 20 74 61 72 67 65 74 73 74 72 20 72 75 e)) targetstr ru
b430: 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 66 69 65 nname "meta" fie
b440: 6c 64 2d 6e 61 6d 65 29 29 0a 09 09 09 20 20 20 ld-name))....
b450: 20 20 72 75 6e 73 2d 73 70 65 63 29 29 29 0a 09 runs-spec)))..
b460: 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 ..;; (mutils:hie
b470: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
b480: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
b490: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
b4a0: 65 72 20 22 73 74 61 74 75 73 22 29 20 20 20 20 er "status")
b4b0: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
b4c0: 6d 65 20 22 6d 65 74 61 22 20 22 73 74 61 74 75 me "meta" "statu
b4d0: 73 22 20 20 20 20 20 29 0a 09 09 09 3b 3b 20 28 s" )....;; (
b4e0: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
b4f0: 73 65 74 21 20 64 61 74 61 20 28 64 62 3a 67 65 set! data (db:ge
b500: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
b510: 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 73 74 r run header "st
b520: 61 74 65 22 29 20 20 20 20 20 20 74 61 72 67 65 ate") targe
b530: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 tstr runname "me
b540: 74 61 22 20 22 73 74 61 74 65 22 20 20 20 20 20 ta" "state"
b550: 20 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 )....;; (mutils
b560: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
b570: 61 74 61 20 28 63 6f 6e 63 20 28 64 62 3a 67 65 ata (conc (db:ge
b580: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
b590: 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 64 r run header "id
b5a0: 22 29 29 20 20 74 61 72 67 65 74 73 74 72 20 72 ")) targetstr r
b5b0: 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 69 unname "meta" "i
b5c0: 64 22 20 20 20 20 20 20 20 20 20 29 0a 09 09 09 d" )....
b5d0: 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ;; (mutils:hierh
b5e0: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 64 ash-set! data (d
b5f0: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
b600: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
b610: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 20 74 "event_time") t
b620: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
b630: 20 22 6d 65 74 61 22 20 22 65 76 65 6e 74 5f 74 "meta" "event_t
b640: 69 6d 65 22 20 29 0a 09 09 09 3b 3b 20 28 6d 75 ime" )....;; (mu
b650: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
b660: 74 21 20 64 61 74 61 20 28 64 62 3a 67 65 74 2d t! data (db:get-
b670: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
b680: 72 75 6e 20 68 65 61 64 65 72 20 22 63 6f 6d 6d run header "comm
b690: 65 6e 74 22 29 20 20 20 20 74 61 72 67 65 74 73 ent") targets
b6a0: 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 tr runname "meta
b6b0: 22 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 29 " "comment" )
b6c0: 0a 09 09 09 3b 3b 20 3b 3b 20 61 64 64 20 6c 61 ....;; ;; add la
b6d0: 73 74 20 65 6e 74 72 79 20 74 77 69 63 65 20 2d st entry twice -
b6e0: 20 73 65 65 6d 73 20 74 6f 20 62 65 20 61 20 62 seems to be a b
b6f0: 75 67 20 69 6e 20 68 69 65 72 68 61 73 68 3f 0a ug in hierhash?.
b700: 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 ...;; (mutils:hi
b710: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
b720: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
b730: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
b740: 64 65 72 20 22 63 6f 6d 6d 65 6e 74 22 29 20 20 der "comment")
b750: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
b760: 61 6d 65 20 22 6d 65 74 61 22 20 22 63 6f 6d 6d ame "meta" "comm
b770: 65 6e 74 22 20 20 20 20 29 0a 09 09 20 20 20 20 ent" )...
b780: 20 20 20 28 65 6c 73 65 0a 09 09 09 28 69 66 20 (else....(if
b790: 28 6e 75 6c 6c 3f 20 72 75 6e 73 2d 73 70 65 63 (null? runs-spec
b7a0: 29 0a 09 09 09 20 20 20 20 28 70 72 69 6e 74 20 ).... (print
b7b0: 22 52 75 6e 3a 20 22 20 74 61 72 67 65 74 73 74 "Run: " targetst
b7c0: 72 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 0a 09 r "/" runname ..
b7d0: 09 09 09 20 20 20 22 20 73 74 61 74 75 73 3a 20 ... " status:
b7e0: 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d " (db:get-value-
b7f0: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
b800: 61 64 65 72 20 22 73 74 61 74 65 22 29 0a 09 09 ader "state")...
b810: 09 09 20 20 20 22 20 72 75 6e 2d 69 64 3a 20 22 .. " run-id: "
b820: 20 72 75 6e 2d 69 64 20 22 2c 20 6e 75 6d 62 65 run-id ", numbe
b830: 72 20 74 65 73 74 73 3a 20 22 20 28 6c 65 6e 67 r tests: " (leng
b840: 74 68 20 74 65 73 74 73 29 0a 09 09 09 09 20 20 th tests).....
b850: 20 22 20 65 76 65 6e 74 5f 74 69 6d 65 3a 20 22 " event_time: "
b860: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
b870: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
b880: 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 der "event_time"
b890: 29 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e )).... (begin
b8a0: 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 6e .... (if (n
b8b0: 6f 74 20 28 6d 65 6d 62 65 72 20 22 74 61 72 67 ot (member "targ
b8c0: 65 74 22 20 72 75 6e 73 2d 73 70 65 63 29 29 0a et" runs-spec)).
b8d0: 09 09 09 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ... ;;
b8e0: 28 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 22 (display (conc "
b8f0: 54 61 72 67 65 74 3a 20 22 20 74 61 72 67 65 74 Target: " target
b900: 73 74 72 29 29 0a 09 09 09 20 20 20 20 20 20 20 str))....
b910: 20 20 20 28 64 69 73 70 6c 61 79 20 28 63 6f 6e (display (con
b920: 63 20 22 52 75 6e 3a 20 22 20 74 61 72 67 65 74 c "Run: " target
b930: 73 74 72 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 str "/" runname
b940: 22 20 22 29 29 29 0a 09 09 09 20 20 20 20 20 20 " ")))....
b950: 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 20 20 20 (for-each....
b960: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 69 65 (lambda (fie
b970: 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 09 20 28 69 ld-name)..... (i
b980: 66 20 28 65 71 75 61 6c 3f 20 66 69 65 6c 64 2d f (equal? field-
b990: 6e 61 6d 65 20 22 74 61 72 67 65 74 22 29 0a 09 name "target")..
b9a0: 09 09 09 20 20 20 20 20 28 64 69 73 70 6c 61 79 ... (display
b9b0: 20 28 63 6f 6e 63 20 22 74 61 72 67 65 74 3a 20 (conc "target:
b9c0: 22 20 74 61 72 67 65 74 73 74 72 20 22 20 22 29 " targetstr " ")
b9d0: 29 0a 09 09 09 09 20 20 20 20 20 28 64 69 73 70 )..... (disp
b9e0: 6c 61 79 20 28 63 6f 6e 63 20 66 69 65 6c 64 2d lay (conc field-
b9f0: 6e 61 6d 65 20 22 3a 20 22 20 28 64 62 3a 67 65 name ": " (db:ge
ba00: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
ba10: 72 20 72 75 6e 20 68 65 61 64 65 72 20 28 63 6f r run header (co
ba20: 6e 63 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 20 nc field-name))
ba30: 22 20 22 29 29 29 29 0a 09 09 09 20 20 20 20 20 " "))))....
ba40: 20 20 72 75 6e 73 2d 73 70 65 63 29 0a 09 09 09 runs-spec)....
ba50: 20 20 20 20 20 20 28 6e 65 77 6c 69 6e 65 29 29 (newline))
ba60: 29 29 29 0a 09 09 20 20 20 20 20 20 20 0a 09 09 )))... ...
ba70: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
ba80: 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
ba90: 28 74 65 73 74 29 0a 09 09 20 20 20 20 20 20 09 (test)... .
baa0: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
bab0: 6e 73 0a 09 09 09 20 65 78 6e 0a 09 09 09 20 28 ns.... exn.... (
bac0: 62 65 67 69 6e 0a 09 09 09 20 20 20 28 64 65 62 begin.... (deb
bad0: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
bae0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
baf0: 72 74 2a 20 22 42 61 64 20 64 61 74 61 20 69 6e rt* "Bad data in
bb00: 20 74 65 73 74 20 72 65 63 6f 72 64 3f 20 22 20 test record? "
bb10: 74 65 73 74 29 0a 09 09 09 20 20 20 28 70 72 69 test).... (pri
bb20: 6e 74 20 22 65 78 6e 3d 22 20 28 63 6f 6e 64 69 nt "exn=" (condi
bb30: 74 69 6f 6e 2d 3e 6c 69 73 74 20 65 78 6e 29 29 tion->list exn))
bb40: 0a 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 .... (debug:pr
bb50: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
bb60: 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 73 61 og-port* " messa
bb70: 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 6f ge: " ((conditio
bb80: 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 n-property-acces
bb90: 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 sor 'exn 'messag
bba0: 65 29 20 65 78 6e 29 29 0a 09 09 09 20 20 20 28 e) exn)).... (
bbb0: 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e print-call-chain
bbc0: 20 28 63 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d (current-error-
bbd0: 70 6f 72 74 29 29 29 0a 09 09 09 20 28 6c 65 74 port))).... (let
bbe0: 2a 20 28 28 74 65 73 74 2d 69 64 20 20 20 20 20 * ((test-id
bbf0: 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 69 64 (if (member "id
bc00: 22 20 20 20 20 20 20 20 20 20 20 20 74 65 73 74 " test
bc10: 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 s-spec)(get-valu
bc20: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
bc30: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
bc40: 6e 64 65 78 20 22 69 64 22 20 20 20 20 20 20 20 ndex "id"
bc50: 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 ) #f)) ;; (db
bc60: 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 20 20 20 :test-get-id
bc70: 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 test)).....
bc80: 28 74 65 73 74 6e 61 6d 65 20 20 20 20 20 28 69 (testname (i
bc90: 66 20 28 6d 65 6d 62 65 72 20 22 74 65 73 74 6e f (member "testn
bca0: 61 6d 65 22 20 20 20 20 20 74 65 73 74 73 2d 73 ame" tests-s
bcb0: 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 pec)(get-value-b
bcc0: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
bcd0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
bce0: 78 20 22 74 65 73 74 6e 61 6d 65 22 20 20 20 20 x "testname"
bcf0: 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 ) #f)) ;; (db:te
bd00: 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 st-get-testname
bd10: 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 69 74 test)).....(it
bd20: 65 6d 70 61 74 68 20 20 20 20 20 28 69 66 20 28 empath (if (
bd30: 6d 65 6d 62 65 72 20 22 69 74 65 6d 5f 70 61 74 member "item_pat
bd40: 68 22 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 h" tests-spec
bd50: 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 )(get-value-by-f
bd60: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
bd70: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
bd80: 69 74 65 6d 5f 70 61 74 68 22 20 20 20 29 20 23 item_path" ) #
bd90: 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d f)) ;; (db:test-
bda0: 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 20 74 get-item-path t
bdb0: 65 73 74 29 29 0a 09 09 09 09 28 63 6f 6d 6d 65 est)).....(comme
bdc0: 6e 74 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d nt (if (mem
bdd0: 62 65 72 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 ber "comment"
bde0: 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 tests-spec)(g
bdf0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
be00: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
be10: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 63 6f 6d field-index "com
be20: 6d 65 6e 74 22 20 20 20 20 20 29 20 23 66 29 29 ment" ) #f))
be30: 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ;; (db:test-get
be40: 2d 63 6f 6d 6d 65 6e 74 20 20 20 20 74 65 73 74 -comment test
be50: 29 29 0a 09 09 09 09 28 74 73 74 61 74 65 20 20 )).....(tstate
be60: 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 (if (member
be70: 20 22 73 74 61 74 65 22 20 20 20 20 20 20 20 20 "state"
be80: 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d tests-spec)(get-
be90: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
bea0: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
beb0: 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 65 22 ld-index "state"
bec0: 20 20 20 20 20 20 20 29 20 23 66 29 29 20 3b 3b ) #f)) ;;
bed0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st
bee0: 61 74 65 20 20 20 20 20 20 74 65 73 74 29 29 0a ate test)).
bef0: 09 09 09 09 28 74 73 74 61 74 75 73 20 20 20 20 ....(tstatus
bf00: 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 73 (if (member "s
bf10: 74 61 74 75 73 22 20 20 20 20 20 20 20 74 65 73 tatus" tes
bf20: 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c ts-spec)(get-val
bf30: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
bf40: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
bf50: 69 6e 64 65 78 20 22 73 74 61 74 75 73 22 20 20 index "status"
bf60: 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 ) #f)) ;; (d
bf70: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 b:test-get-statu
bf80: 73 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 s test))....
bf90: 09 28 65 76 65 6e 74 2d 74 69 6d 65 20 20 20 28 .(event-time (
bfa0: 69 66 20 28 6d 65 6d 62 65 72 20 22 65 76 65 6e if (member "even
bfb0: 74 5f 74 69 6d 65 22 20 20 20 74 65 73 74 73 2d t_time" tests-
bfc0: 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d spec)(get-value-
bfd0: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
bfe0: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
bff0: 65 78 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 ex "event_time"
c000: 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 ) #f)) ;; (db:t
c010: 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 est-get-event_ti
c020: 6d 65 20 74 65 73 74 29 29 0a 09 09 09 09 28 72 me test)).....(r
c030: 75 6e 64 69 72 20 20 20 20 20 20 20 28 69 66 20 undir (if
c040: 28 6d 65 6d 62 65 72 20 22 72 75 6e 64 69 72 22 (member "rundir"
c050: 20 20 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 tests-spe
c060: 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d c)(get-value-by-
c070: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
c080: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
c090: 22 72 75 6e 64 69 72 22 20 20 20 20 20 20 29 20 "rundir" )
c0a0: 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 #f)) ;; (db:test
c0b0: 2d 67 65 74 2d 72 75 6e 64 69 72 20 20 20 20 20 -get-rundir
c0c0: 74 65 73 74 29 29 0a 09 09 09 09 28 66 69 6e 61 test)).....(fina
c0d0: 6c 5f 6c 6f 67 66 20 20 20 28 69 66 20 28 6d 65 l_logf (if (me
c0e0: 6d 62 65 72 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 mber "final_logf
c0f0: 22 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 " tests-spec)(
c100: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
c110: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
c120: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 66 69 -field-index "fi
c130: 6e 61 6c 5f 6c 6f 67 66 22 20 20 29 20 23 66 29 nal_logf" ) #f)
c140: 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 ) ;; (db:test-ge
c150: 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 t-final_logf tes
c160: 74 29 29 0a 09 09 09 09 28 72 75 6e 5f 64 75 72 t)).....(run_dur
c170: 61 74 69 6f 6e 20 28 69 66 20 28 6d 65 6d 62 65 ation (if (membe
c180: 72 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 r "run_duration"
c190: 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 tests-spec)(get
c1a0: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
c1b0: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
c1c0: 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 5f 64 eld-index "run_d
c1d0: 75 72 61 74 69 6f 6e 22 29 20 23 66 29 29 20 3b uration") #f)) ;
c1e0: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 ; (db:test-get-r
c1f0: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 un_duration test
c200: 29 29 0a 09 09 09 09 28 66 75 6c 6c 6e 61 6d 65 )).....(fullname
c210: 20 20 20 20 20 28 63 6f 6e 63 20 74 65 73 74 6e (conc testn
c220: 61 6d 65 0a 09 09 09 09 09 09 20 20 20 20 28 69 ame....... (i
c230: 66 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 70 61 f (equal? itempa
c240: 74 68 20 22 22 29 0a 09 09 09 09 09 09 09 22 22 th "")........""
c250: 20 0a 09 09 09 09 09 09 09 28 63 6f 6e 63 20 22 ........(conc "
c260: 28 22 20 69 74 65 6d 70 61 74 68 20 22 29 22 29 (" itempath ")")
c270: 29 29 29 29 0a 09 09 09 20 20 20 28 63 61 73 65 )))).... (case
c280: 20 64 6d 6f 64 65 0a 09 09 09 20 20 20 20 20 28 dmode.... (
c290: 28 6a 73 6f 6e 20 6f 64 73 29 0a 09 09 09 20 20 (json ods)....
c2a0: 20 20 20 20 28 69 66 20 74 65 73 74 73 2d 73 70 (if tests-sp
c2b0: 65 63 0a 09 09 09 09 20 20 28 66 6f 72 2d 65 61 ec..... (for-ea
c2c0: 63 68 0a 09 09 09 09 20 20 20 28 6c 61 6d 62 64 ch..... (lambd
c2d0: 61 20 28 66 69 65 6c 64 2d 6e 61 6d 65 29 0a 09 a (field-name)..
c2e0: 09 09 09 20 20 20 20 20 28 6d 75 74 69 6c 73 3a ... (mutils:
c2f0: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
c300: 74 61 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 ta (get-value-b
c310: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
c320: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
c330: 78 20 66 69 65 6c 64 2d 6e 61 6d 65 29 20 74 61 x field-name) ta
c340: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
c350: 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 "data" (conc tes
c360: 74 2d 69 64 29 20 66 69 65 6c 64 2d 6e 61 6d 65 t-id) field-name
c370: 29 29 0a 09 09 09 09 20 20 20 74 65 73 74 73 2d ))..... tests-
c380: 73 70 65 63 29 29 29 0a 09 09 09 20 20 20 20 20 spec)))....
c390: 3b 3b 20 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 ;; ;; (mutils:hi
c3a0: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
c3b0: 20 20 66 75 6c 6c 6e 61 6d 65 20 20 20 74 61 72 fullname tar
c3c0: 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 getstr runname "
c3d0: 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 data" (conc test
c3e0: 2d 69 64 29 20 22 74 6e 61 6d 65 22 20 20 20 20 -id) "tname"
c3f0: 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 ).... ;; (
c400: 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d mutils:hierhash-
c410: 73 65 74 21 20 64 61 74 61 20 20 74 65 73 74 6e set! data testn
c420: 61 6d 65 20 20 20 74 61 72 67 65 74 73 74 72 20 ame targetstr
c430: 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 runname "data" (
c440: 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 74 conc test-id) "t
c450: 65 73 74 6e 61 6d 65 22 20 20 29 0a 09 09 09 20 estname" )....
c460: 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a ;; (mutils:
c470: 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 hierhash-set! da
c480: 74 61 20 20 69 74 65 6d 70 61 74 68 20 20 20 74 ta itempath t
c490: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
c4a0: 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 "data" (conc te
c4b0: 73 74 2d 69 64 29 20 22 69 74 65 6d 70 61 74 68 st-id) "itempath
c4c0: 22 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 " ).... ;;
c4d0: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
c4e0: 68 2d 73 65 74 21 20 64 61 74 61 20 20 63 6f 6d h-set! data com
c4f0: 6d 65 6e 74 20 20 20 20 74 61 72 67 65 74 73 74 ment targetst
c500: 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 r runname "data"
c510: 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 (conc test-id)
c520: 22 63 6f 6d 6d 65 6e 74 22 20 20 20 29 0a 09 09 "comment" )...
c530: 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c . ;; (mutil
c540: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
c550: 64 61 74 61 20 20 74 73 74 61 74 65 20 20 20 20 data tstate
c560: 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 targetstr runna
c570: 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 me "data" (conc
c580: 74 65 73 74 2d 69 64 29 20 22 73 74 61 74 65 22 test-id) "state"
c590: 20 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b ).... ;
c5a0: 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ; (mutils:hierh
c5b0: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 74 ash-set! data t
c5c0: 73 74 61 74 75 73 20 20 20 20 74 61 72 67 65 74 status target
c5d0: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 str runname "dat
c5e0: 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 a" (conc test-id
c5f0: 29 20 22 73 74 61 74 75 73 22 20 20 20 20 29 0a ) "status" ).
c600: 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 ... ;; (mut
c610: 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 ils:hierhash-set
c620: 21 20 64 61 74 61 20 20 72 75 6e 64 69 72 20 20 ! data rundir
c630: 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e targetstr run
c640: 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e name "data" (con
c650: 63 20 74 65 73 74 2d 69 64 29 20 22 72 75 6e 64 c test-id) "rund
c660: 69 72 22 20 20 20 20 29 0a 09 09 09 20 20 20 20 ir" )....
c670: 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 ;; (mutils:hie
c680: 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 rhash-set! data
c690: 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 61 72 67 final_logf targ
c6a0: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 etstr runname "d
c6b0: 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d ata" (conc test-
c6c0: 69 64 29 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 id) "final_logf"
c6d0: 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d ).... ;; (m
c6e0: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
c6f0: 65 74 21 20 64 61 74 61 20 20 72 75 6e 5f 64 75 et! data run_du
c700: 72 61 74 69 6f 6e 20 74 61 72 67 65 74 73 74 72 ration targetstr
c710: 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 runname "data"
c720: 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 (conc test-id) "
c730: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 0a 09 run_duration")..
c740: 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 .. ;; (muti
c750: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
c760: 20 64 61 74 61 20 20 65 76 65 6e 74 2d 74 69 6d data event-tim
c770: 65 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e e targetstr runn
c780: 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 ame "data" (conc
c790: 20 74 65 73 74 2d 69 64 29 20 22 65 76 65 6e 74 test-id) "event
c7a0: 5f 74 69 6d 65 22 29 0a 09 09 09 20 20 20 20 20 _time")....
c7b0: 3b 3b 20 20 3b 3b 20 61 64 64 20 6c 61 73 74 20 ;; ;; add last
c7c0: 65 6e 74 72 79 20 74 77 69 63 65 20 2d 20 73 65 entry twice - se
c7d0: 65 6d 73 20 74 6f 20 62 65 20 61 20 62 75 67 20 ems to be a bug
c7e0: 69 6e 20 68 69 65 72 68 61 73 68 3f 0a 09 09 09 in hierhash?....
c7f0: 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 ;; (mutils
c800: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
c810: 61 74 61 20 20 65 76 65 6e 74 2d 74 69 6d 65 20 ata event-time
c820: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
c830: 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 e "data" (conc t
c840: 65 73 74 2d 69 64 29 20 22 65 76 65 6e 74 5f 74 est-id) "event_t
c850: 69 6d 65 22 29 0a 09 09 09 20 20 20 20 20 3b 3b ime").... ;;
c860: 20 20 29 0a 09 09 09 20 20 20 20 20 28 65 6c 73 ).... (els
c870: 65 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 e.... (if (
c880: 61 6e 64 20 74 73 74 61 74 65 20 74 73 74 61 74 and tstate tstat
c890: 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 29 0a 09 us event-time)..
c8a0: 09 09 09 20 20 28 66 6f 72 6d 61 74 20 23 74 0a ... (format #t.
c8b0: 09 09 09 09 09 20 20 22 20 20 54 65 73 74 3a 20 ..... " Test:
c8c0: 7e 32 35 61 20 53 74 61 74 65 3a 20 7e 31 35 61 ~25a State: ~15a
c8d0: 20 53 74 61 74 75 73 3a 20 7e 31 35 61 20 52 75 Status: ~15a Ru
c8e0: 6e 74 69 6d 65 3a 20 7e 35 40 61 73 20 54 69 6d ntime: ~5@as Tim
c8f0: 65 3a 20 7e 32 32 61 20 48 6f 73 74 3a 20 7e 31 e: ~22a Host: ~1
c900: 30 61 5c 6e 22 0a 09 09 09 09 09 20 20 28 69 66 0a\n"...... (if
c910: 20 66 75 6c 6c 6e 61 6d 65 20 66 75 6c 6c 6e 61 fullname fullna
c920: 6d 65 20 22 22 29 0a 09 09 09 09 09 20 20 28 69 me "")...... (i
c930: 66 20 74 73 74 61 74 65 20 20 20 74 73 74 61 74 f tstate tstat
c940: 65 20 20 20 22 22 29 0a 09 09 09 09 09 20 20 28 e "")...... (
c950: 69 66 20 74 73 74 61 74 75 73 20 20 74 73 74 61 if tstatus tsta
c960: 74 75 73 20 20 22 22 29 0a 09 09 09 09 09 20 20 tus "")......
c970: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
c980: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
c990: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 t-field-index "r
c9a0: 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 3b 3b 28 un_duration");;(
c9b0: 69 66 20 74 65 73 74 20 20 20 20 20 28 64 62 3a if test (db:
c9c0: 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 test-get-run_dur
c9d0: 61 74 69 6f 6e 20 74 65 73 74 29 20 22 22 29 0a ation test) "").
c9e0: 09 09 09 09 09 20 20 28 69 66 20 65 76 65 6e 74 ..... (if event
c9f0: 2d 74 69 6d 65 20 65 76 65 6e 74 2d 74 69 6d 65 -time event-time
ca00: 20 22 22 29 0a 09 09 09 09 09 20 20 28 67 65 74 "")...... (get
ca10: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
ca20: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
ca30: 65 6c 64 2d 69 6e 64 65 78 20 22 68 6f 73 74 22 eld-index "host"
ca40: 29 29 20 3b 3b 28 69 66 20 74 65 73 74 20 28 64 )) ;;(if test (d
ca50: 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 20 b:test-get-host
ca60: 74 65 73 74 29 29 20 22 22 29 0a 09 09 09 09 20 test)) "").....
ca70: 20 28 70 72 69 6e 74 20 22 20 20 54 65 73 74 3a (print " Test:
ca80: 20 22 20 66 75 6c 6c 6e 61 6d 65 0a 09 09 09 09 " fullname.....
ca90: 09 20 28 69 66 20 74 73 74 61 74 65 20 20 28 63 . (if tstate (c
caa0: 6f 6e 63 20 22 20 53 74 61 74 65 3a 20 22 20 20 onc " State: "
cab0: 74 73 74 61 74 65 29 20 20 22 22 29 0a 09 09 09 tstate) "")....
cac0: 09 09 20 28 69 66 20 74 73 74 61 74 75 73 20 28 .. (if tstatus (
cad0: 63 6f 6e 63 20 22 20 53 74 61 74 75 73 3a 20 22 conc " Status: "
cae0: 20 74 73 74 61 74 75 73 29 20 22 22 29 0a 09 09 tstatus) "")...
caf0: 09 09 09 20 28 69 66 20 28 67 65 74 2d 76 61 6c ... (if (get-val
cb00: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
cb10: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
cb20: 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 61 74 index "run_durat
cb30: 69 6f 6e 22 29 0a 09 09 09 09 09 20 20 20 20 20 ion")......
cb40: 28 63 6f 6e 63 20 22 20 52 75 6e 74 69 6d 65 3a (conc " Runtime:
cb50: 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 " (get-value-by
cb60: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
cb70: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
cb80: 20 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 "run_duration")
cb90: 29 0a 09 09 09 09 09 20 20 20 20 20 22 22 29 0a )...... "").
cba0: 09 09 09 09 09 20 28 69 66 20 65 76 65 6e 74 2d ..... (if event-
cbb0: 74 69 6d 65 20 28 63 6f 6e 63 20 22 20 54 69 6d time (conc " Tim
cbc0: 65 3a 20 22 20 65 76 65 6e 74 2d 74 69 6d 65 29 e: " event-time)
cbd0: 20 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 28 "")...... (if (
cbe0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
cbf0: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
cc00: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 68 6f -field-index "ho
cc10: 73 74 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 st")...... (
cc20: 63 6f 6e 63 20 22 20 48 6f 73 74 3a 20 22 20 28 conc " Host: " (
cc30: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
cc40: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
cc50: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 68 6f -field-index "ho
cc60: 73 74 22 29 29 0a 09 09 09 09 09 20 20 20 20 20 st"))......
cc70: 22 22 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 ""))).... (
cc80: 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 65 71 75 if (not (or (equ
cc90: 61 6c 3f 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 al? (get-value-b
cca0: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
ccb0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
ccc0: 78 20 22 73 74 61 74 75 73 22 29 20 22 50 41 53 x "status") "PAS
ccd0: 53 22 29 0a 09 09 09 09 09 20 20 20 28 65 71 75 S")...... (equ
cce0: 61 6c 3f 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 al? (get-value-b
ccf0: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
cd00: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
cd10: 78 20 22 73 74 61 74 75 73 22 29 20 22 57 41 52 x "status") "WAR
cd20: 4e 22 29 0a 09 09 09 09 09 20 20 20 28 65 71 75 N")...... (equ
cd30: 61 6c 3f 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 al? (get-value-b
cd40: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
cd50: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
cd60: 78 20 22 73 74 61 74 65 22 29 20 20 22 4e 4f 54 x "state") "NOT
cd70: 5f 53 54 41 52 54 45 44 22 29 29 29 0a 09 09 09 _STARTED")))....
cd80: 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 . (begin.....
cd90: 20 20 28 70 72 69 6e 74 20 20 20 28 69 66 20 28 (print (if (
cda0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
cdb0: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
cdc0: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 63 70 -field-index "cp
cdd0: 75 6c 6f 61 64 22 29 0a 09 09 09 09 09 09 20 28 uload")....... (
cde0: 63 6f 6e 63 20 22 20 20 20 20 20 20 20 20 20 63 conc " c
cdf0: 70 75 6c 6f 61 64 3a 20 20 22 20 20 20 28 67 65 puload: " (ge
ce00: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
ce10: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
ce20: 69 65 6c 64 2d 69 6e 64 65 78 20 22 63 70 75 6c ield-index "cpul
ce30: 6f 61 64 22 29 29 0a 09 09 09 09 09 09 20 22 22 oad"))....... ""
ce40: 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 ) ;; (db:test-ge
ce50: 74 2d 63 70 75 6c 6f 61 64 20 74 65 73 74 29 0a t-cpuload test).
ce60: 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 67 ..... (if (g
ce70: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
ce80: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
ce90: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 64 69 73 field-index "dis
cea0: 6b 66 72 65 65 22 29 0a 09 09 09 09 09 09 20 28 kfree")....... (
ceb0: 63 6f 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 20 conc "\n
cec0: 20 64 69 73 6b 66 72 65 65 3a 20 22 20 28 67 65 diskfree: " (ge
ced0: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
cee0: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
cef0: 69 65 6c 64 2d 69 6e 64 65 78 20 22 64 69 73 6b ield-index "disk
cf00: 66 72 65 65 22 29 29 20 3b 3b 20 28 64 62 3a 74 free")) ;; (db:t
cf10: 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 65 est-get-diskfree
cf20: 20 74 65 73 74 29 0a 09 09 09 09 09 09 20 22 22 test)....... ""
cf30: 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 )...... (if
cf40: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
cf50: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
cf60: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 75 t-field-index "u
cf70: 6e 61 6d 65 22 29 0a 09 09 09 09 09 09 20 28 63 name")....... (c
cf80: 6f 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 20 20 onc "\n
cf90: 75 6e 61 6d 65 3a 20 20 20 20 22 20 28 67 65 74 uname: " (get
cfa0: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
cfb0: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
cfc0: 65 6c 64 2d 69 6e 64 65 78 20 22 75 6e 61 6d 65 eld-index "uname
cfd0: 22 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d ")) ;; (db:test-
cfe0: 67 65 74 2d 75 6e 61 6d 65 20 74 65 73 74 29 0a get-uname test).
cff0: 09 09 09 09 09 09 20 22 22 29 0a 09 09 09 09 09 ...... "")......
d000: 20 20 20 20 20 28 69 66 20 28 67 65 74 2d 76 61 (if (get-va
d010: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
d020: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
d030: 2d 69 6e 64 65 78 20 22 72 75 6e 64 69 72 22 29 -index "rundir")
d040: 0a 09 09 09 09 09 09 20 28 63 6f 6e 63 20 22 5c ....... (conc "\
d050: 6e 20 20 20 20 20 20 20 20 20 72 75 6e 64 69 72 n rundir
d060: 3a 20 20 20 22 20 28 67 65 74 2d 76 61 6c 75 65 : " (get-value
d070: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
d080: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
d090: 64 65 78 20 22 72 75 6e 64 69 72 22 29 29 20 3b dex "rundir")) ;
d0a0: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 ; (db:test-get-r
d0b0: 75 6e 64 69 72 20 74 65 73 74 29 0a 09 09 09 09 undir test).....
d0c0: 09 09 20 22 22 29 0a 3b 3b 09 09 09 09 09 20 20 .. "").;;.....
d0d0: 20 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 72 "\n r
d0e0: 75 6e 64 69 72 3a 20 20 20 22 20 28 67 65 74 2d undir: " (get-
d0f0: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
d100: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
d110: 6c 64 2d 69 6e 64 65 78 20 22 22 29 20 3b 3b 20 ld-index "") ;;
d120: 28 73 64 62 3a 71 72 79 20 27 67 65 74 73 74 72 (sdb:qry 'getstr
d130: 20 3b 3b 20 28 66 69 6c 65 64 62 3a 67 65 74 2d ;; (filedb:get-
d140: 70 61 74 68 20 2a 66 64 62 2a 20 0a 3b 3b 20 09 path *fdb* .;; .
d150: 09 09 09 09 20 20 20 20 20 28 64 62 3a 74 65 73 .... (db:tes
d160: 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 t-get-rundir tes
d170: 74 29 20 3b 3b 20 29 0a 09 09 09 09 09 20 20 20 t) ;; )......
d180: 20 20 29 0a 09 09 09 09 20 20 20 20 3b 3b 20 45 )..... ;; E
d190: 61 63 68 20 74 65 73 74 0a 09 09 09 09 20 20 20 ach test.....
d1a0: 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 65 6d 6f 74 ;; DO NOT remot
d1b0: 65 20 72 75 6e 0a 09 09 09 09 20 20 20 20 28 6c e run..... (l
d1c0: 65 74 20 28 28 73 74 65 70 73 20 28 72 6d 74 3a et ((steps (rmt:
d1d0: 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 get-steps-for-te
d1e0: 73 74 20 72 75 6e 2d 69 64 20 28 64 62 3a 74 65 st run-id (db:te
d1f0: 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 29 29 st-get-id test))
d200: 29 29 20 3b 3b 20 28 64 62 3a 67 65 74 2d 73 74 )) ;; (db:get-st
d210: 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 73 eps-for-test dbs
d220: 74 72 75 63 74 20 72 75 6e 2d 69 64 20 28 64 62 truct run-id (db
d230: 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 :test-get-id tes
d240: 74 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 t)))).....
d250: 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 20 (for-each .....
d260: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 (lambda (s
d270: 74 65 70 29 0a 09 09 09 09 09 20 28 66 6f 72 6d tep)...... (form
d280: 61 74 20 23 74 20 0a 09 09 09 09 09 09 20 22 20 at #t ....... "
d290: 20 20 20 53 74 65 70 3a 20 7e 32 30 61 20 53 74 Step: ~20a St
d2a0: 61 74 65 3a 20 7e 31 30 61 20 53 74 61 74 75 73 ate: ~10a Status
d2b0: 3a 20 7e 31 30 61 20 54 69 6d 65 20 7e 32 32 61 : ~10a Time ~22a
d2c0: 5c 6e 22 0a 09 09 09 09 09 09 20 28 74 64 62 3a \n"....... (tdb:
d2d0: 73 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d step-get-stepnam
d2e0: 65 20 73 74 65 70 29 0a 09 09 09 09 09 09 20 28 e step)....... (
d2f0: 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 tdb:step-get-sta
d300: 74 65 20 73 74 65 70 29 0a 09 09 09 09 09 09 20 te step).......
d310: 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 (tdb:step-get-st
d320: 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 09 09 atus step)......
d330: 09 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d . (tdb:step-get-
d340: 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 event_time step)
d350: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 73 74 ))..... st
d360: 65 70 73 29 29 29 29 29 29 29 29 29 0a 09 09 20 eps)))))))))...
d370: 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 (if (args:g
d380: 65 74 2d 61 72 67 20 22 2d 73 6f 72 74 22 29 0a et-arg "-sort").
d390: 09 09 09 20 20 28 73 6f 72 74 20 74 65 73 74 73 ... (sort tests
d3a0: 0a 09 09 09 09 28 6c 61 6d 62 64 61 20 28 61 2d .....(lambda (a-
d3b0: 74 65 73 74 20 62 2d 74 65 73 74 29 0a 09 09 09 test b-test)....
d3c0: 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 20 20 . (let* ((key
d3d0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
d3e0: 22 2d 73 6f 72 74 22 29 29 0a 09 09 09 09 09 20 "-sort"))......
d3f0: 28 66 69 72 73 74 20 20 28 67 65 74 2d 76 61 6c (first (get-val
d400: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
d410: 61 2d 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c a-test test-fiel
d420: 64 2d 69 6e 64 65 78 20 6b 65 79 29 29 0a 09 09 d-index key))...
d430: 09 09 09 20 28 73 65 63 6f 6e 64 20 28 67 65 74 ... (second (get
d440: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
d450: 61 6d 65 20 62 2d 74 65 73 74 20 74 65 73 74 2d ame b-test test-
d460: 66 69 65 6c 64 2d 69 6e 64 65 78 20 6b 65 79 29 field-index key)
d470: 29 29 0a 09 09 09 09 20 20 20 20 28 28 63 6f 6e ))..... ((con
d480: 64 20 0a 09 09 09 09 20 20 20 20 20 20 28 28 61 d ..... ((a
d490: 6e 64 20 28 6e 75 6d 62 65 72 3f 20 66 69 72 73 nd (number? firs
d4a0: 74 29 28 6e 75 6d 62 65 72 3f 20 73 65 63 6f 6e t)(number? secon
d4b0: 64 29 29 20 3c 29 0a 09 09 09 09 20 20 20 20 20 d)) <).....
d4c0: 20 28 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 ((and (string?
d4d0: 66 69 72 73 74 29 28 73 74 72 69 6e 67 3f 20 73 first)(string? s
d4e0: 65 63 6f 6e 64 29 29 20 73 74 72 69 6e 67 3c 3d econd)) string<=
d4f0: 3f 29 0a 09 09 09 09 20 20 20 20 20 20 28 65 6c ?)..... (el
d500: 73 65 20 65 71 75 61 6c 3f 29 29 0a 09 09 09 09 se equal?)).....
d510: 20 20 20 20 20 66 69 72 73 74 20 73 65 63 6f 6e first secon
d520: 64 29 29 29 29 0a 09 09 09 20 20 74 65 73 74 73 d)))).... tests
d530: 29 29 29 29 29 29 0a 09 20 20 20 72 75 6e 73 29 )))))).. runs)
d540: 0a 09 20 20 28 69 66 20 28 65 71 3f 20 64 6d 6f .. (if (eq? dmo
d550: 64 65 20 27 6a 73 6f 6e 29 28 6a 73 6f 6e 2d 77 de 'json)(json-w
d560: 72 69 74 65 20 64 61 74 61 29 29 0a 09 20 20 28 rite data)).. (
d570: 6c 65 74 2a 20 28 28 6d 65 74 61 64 61 74 2d 66 let* ((metadat-f
d580: 69 65 6c 64 73 20 28 64 65 6c 65 74 65 2d 64 75 ields (delete-du
d590: 70 6c 69 63 61 74 65 73 0a 09 09 09 09 20 20 28 plicates..... (
d5a0: 61 70 70 65 6e 64 20 6b 65 79 73 20 27 28 20 22 append keys '( "
d5b0: 72 75 6e 6e 61 6d 65 22 20 22 74 69 6d 65 22 20 runname" "time"
d5c0: 22 6f 77 6e 65 72 22 20 22 70 61 73 73 5f 63 6f "owner" "pass_co
d5d0: 75 6e 74 22 20 22 66 61 69 6c 5f 63 6f 75 6e 74 unt" "fail_count
d5e0: 22 20 22 73 74 61 74 65 22 20 22 73 74 61 74 75 " "state" "statu
d5f0: 73 22 20 22 63 6f 6d 6d 65 6e 74 22 20 22 69 64 s" "comment" "id
d600: 22 29 29 29 29 0a 09 09 20 28 72 75 6e 2d 66 69 "))))... (run-fi
d610: 65 6c 64 73 20 20 20 20 27 28 0a 09 09 09 09 20 elds '(.....
d620: 20 22 74 65 73 74 6e 61 6d 65 22 0a 09 09 09 09 "testname".....
d630: 20 20 22 69 74 65 6d 5f 70 61 74 68 22 0a 09 09 "item_path"...
d640: 09 09 20 20 22 73 74 61 74 65 22 0a 09 09 09 09 .. "state".....
d650: 20 20 22 73 74 61 74 75 73 22 0a 09 09 09 09 20 "status".....
d660: 20 22 63 6f 6d 6d 65 6e 74 22 0a 09 09 09 09 20 "comment".....
d670: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 0a 09 09 "event_time"...
d680: 09 09 20 20 22 68 6f 73 74 22 0a 09 09 09 09 20 .. "host".....
d690: 20 22 72 75 6e 5f 69 64 22 0a 09 09 09 09 20 20 "run_id".....
d6a0: 22 72 75 6e 5f 64 75 72 61 74 69 6f 6e 22 0a 09 "run_duration"..
d6b0: 09 09 09 20 20 22 61 74 74 65 6d 70 74 6e 75 6d ... "attemptnum
d6c0: 22 0a 09 09 09 09 20 20 22 69 64 22 0a 09 09 09 "..... "id"....
d6d0: 09 20 20 22 61 72 63 68 69 76 65 64 22 0a 09 09 . "archived"...
d6e0: 09 09 20 20 22 64 69 73 6b 66 72 65 65 22 0a 09 .. "diskfree"..
d6f0: 09 09 09 20 20 22 63 70 75 6c 6f 61 64 22 0a 09 ... "cpuload"..
d700: 09 09 09 20 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 ... "final_logf
d710: 22 0a 09 09 09 09 20 20 22 73 68 6f 72 74 64 69 "..... "shortdi
d720: 72 22 0a 09 09 09 09 20 20 22 72 75 6e 64 69 72 r"..... "rundir
d730: 22 0a 09 09 09 09 20 20 22 75 6e 61 6d 65 22 0a "..... "uname".
d740: 09 09 09 09 20 20 29 0a 09 09 09 09 29 0a 09 09 .... ).....)...
d750: 20 28 6e 65 77 64 61 74 20 20 20 20 20 20 20 20 (newdat
d760: 20 20 28 63 6f 6d 6d 6f 6e 3a 74 6f 2d 61 6c 69 (common:to-ali
d770: 73 74 20 64 61 74 61 29 29 0a 09 09 20 28 61 6c st data))... (al
d780: 6c 72 75 6e 64 61 74 20 20 20 20 20 20 20 28 69 lrundat (i
d790: 66 20 28 6e 75 6c 6c 3f 20 6e 65 77 64 61 74 29 f (null? newdat)
d7a0: 0a 09 09 09 09 20 20 20 20 20 20 27 28 29 0a 09 ..... '()..
d7b0: 09 09 09 20 20 20 20 20 20 28 63 61 72 20 28 6d ... (car (m
d7c0: 61 70 20 63 64 72 20 6e 65 77 64 61 74 29 29 29 ap cdr newdat)))
d7d0: 29 20 3b 3b 20 28 63 61 72 20 28 6d 61 70 20 63 ) ;; (car (map c
d7e0: 64 72 20 28 63 61 72 20 28 6d 61 70 20 63 64 72 dr (car (map cdr
d7f0: 20 6e 65 77 64 61 74 29 29 29 29 29 0a 09 09 20 newdat)))))...
d800: 28 72 75 6e 73 20 20 20 20 20 20 20 20 20 20 20 (runs
d810: 20 28 61 70 70 65 6e 64 0a 09 09 09 09 20 20 20 (append.....
d820: 28 6c 69 73 74 20 22 72 75 6e 73 22 20 3b 3b 20 (list "runs" ;;
d830: 73 68 65 65 74 6e 61 6d 65 0a 09 09 09 09 09 20 sheetname......
d840: 6d 65 74 61 64 61 74 2d 66 69 65 6c 64 73 29 0a metadat-fields).
d850: 09 09 09 09 20 20 20 28 6d 61 70 20 28 6c 61 6d .... (map (lam
d860: 62 64 61 20 28 72 75 6e 29 0a 09 09 09 09 09 20 bda (run)......
d870: 20 3b 3b 20 28 70 72 69 6e 74 20 22 72 75 6e 3a ;; (print "run:
d880: 20 22 20 72 75 6e 29 0a 09 09 09 09 09 20 20 28 " run)...... (
d890: 6c 65 74 2a 20 28 28 72 75 6e 6e 61 6d 65 20 28 let* ((runname (
d8a0: 63 61 72 20 72 75 6e 29 29 0a 09 09 09 09 09 09 car run)).......
d8b0: 20 28 72 75 6e 64 61 74 20 20 28 63 64 72 20 72 (rundat (cdr r
d8c0: 75 6e 29 29 0a 09 09 09 09 09 09 20 28 6d 65 74 un))....... (met
d8d0: 61 64 61 74 20 28 6c 65 74 20 28 28 74 6d 70 20 adat (let ((tmp
d8e0: 28 61 73 73 6f 63 20 22 6d 65 74 61 22 20 72 75 (assoc "meta" ru
d8f0: 6e 64 61 74 29 29 29 0a 09 09 09 09 09 09 09 20 ndat)))........
d900: 20 20 20 28 69 66 20 74 6d 70 20 28 63 64 72 20 (if tmp (cdr
d910: 74 6d 70 29 20 23 66 29 29 29 29 0a 09 09 09 09 tmp) #f)))).....
d920: 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 . ;; (print "
d930: 72 75 6e 6e 61 6d 65 3a 20 22 20 72 75 6e 6e 61 runname: " runna
d940: 6d 65 20 22 5c 6e 5c 6e 72 75 6e 64 61 74 3a 20 me "\n\nrundat:
d950: 22 20 29 28 70 70 20 72 75 6e 64 61 74 29 28 70 " )(pp rundat)(p
d960: 72 69 6e 74 20 22 5c 6e 5c 6e 6d 65 74 61 64 61 rint "\n\nmetada
d970: 74 3a 20 22 29 28 70 70 20 6d 65 74 61 64 61 74 t: ")(pp metadat
d980: 29 0a 09 09 09 09 09 20 20 20 20 28 69 66 20 6d )...... (if m
d990: 65 74 61 64 61 74 0a 09 09 09 09 09 09 28 6d 61 etadat.......(ma
d9a0: 70 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 p (lambda (field
d9b0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 )....... (
d9c0: 6c 65 74 20 28 28 74 6d 70 20 28 61 73 73 6f 63 let ((tmp (assoc
d9d0: 20 66 69 65 6c 64 20 6d 65 74 61 64 61 74 29 29 field metadat))
d9e0: 29 0a 09 09 09 09 09 09 09 20 28 69 66 20 74 6d )........ (if tm
d9f0: 70 20 28 63 64 72 20 74 6d 70 29 20 22 22 29 29 p (cdr tmp) ""))
da00: 29 0a 09 09 09 09 09 09 20 20 20 20 20 6d 65 74 )....... met
da10: 61 64 61 74 2d 66 69 65 6c 64 73 29 0a 09 09 09 adat-fields)....
da20: 09 09 09 28 62 65 67 69 6e 0a 09 09 09 09 09 09 ...(begin.......
da30: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
da40: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
da50: 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 6d 65 rt* "WARNING: me
da60: 74 61 20 64 61 74 61 20 66 6f 72 20 72 75 6e 20 ta data for run
da70: 22 20 72 75 6e 6e 61 6d 65 20 22 20 6e 6f 74 20 " runname " not
da80: 66 6f 75 6e 64 22 29 0a 09 09 09 09 09 09 20 20 found").......
da90: 27 28 29 29 29 29 29 0a 09 09 09 09 09 61 6c 6c '()))))......all
daa0: 72 75 6e 64 61 74 29 29 29 0a 09 09 20 3b 3b 20 rundat)))... ;;
dab0: 27 28 20 28 20 22 74 61 72 67 65 74 22 20 28 20 '( ( "target" (
dac0: 22 72 75 6e 6e 61 6d 65 22 20 28 20 22 64 61 74 "runname" ( "dat
dad0: 61 22 20 28 20 22 72 75 6e 69 64 22 20 28 20 22 a" ( "runid" ( "
dae0: 69 64 20 2e 20 22 33 37 22 20 29 20 28 20 2e 2e id . "37" ) ( ..
daf0: 2e 20 29 29 29 29 0a 09 09 20 28 72 75 6e 2d 70 . ))))... (run-p
db00: 61 67 65 73 20 20 20 20 20 20 28 6d 61 70 20 28 ages (map (
db10: 6c 61 6d 62 64 61 20 28 74 61 72 67 64 61 74 29 lambda (targdat)
db20: 0a 09 09 09 09 09 28 6c 65 74 2a 20 28 28 74 61 ......(let* ((ta
db30: 72 67 65 74 20 20 28 63 61 72 20 74 61 72 67 64 rget (car targd
db40: 61 74 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 at))......
db50: 20 28 72 75 6e 73 64 61 74 20 28 63 64 72 20 74 (runsdat (cdr t
db60: 61 72 67 64 61 74 29 29 29 0a 09 09 09 09 09 20 argdat)))......
db70: 20 28 69 66 20 72 75 6e 73 64 61 74 0a 09 09 09 (if runsdat....
db80: 09 09 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 .. (map (la
db90: 6d 62 64 61 20 28 72 75 6e 64 61 74 29 0a 09 09 mbda (rundat)...
dba0: 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 .... (let* (
dbb0: 28 72 75 6e 6e 61 6d 65 20 20 28 63 61 72 20 72 (runname (car r
dbc0: 75 6e 64 61 74 29 29 0a 09 09 09 09 09 09 09 20 undat))........
dbd0: 20 20 20 28 72 75 6e 64 61 74 20 20 20 28 63 64 (rundat (cd
dbe0: 72 20 72 75 6e 64 61 74 29 29 0a 09 09 09 09 09 r rundat))......
dbf0: 09 09 20 20 20 20 28 74 65 73 74 73 64 61 74 20 .. (testsdat
dc00: 28 6c 65 74 20 28 28 74 6d 70 20 28 61 73 73 6f (let ((tmp (asso
dc10: 63 20 22 64 61 74 61 22 20 72 75 6e 64 61 74 29 c "data" rundat)
dc20: 29 29 0a 09 09 09 09 09 09 09 09 09 28 69 66 20 ))..........(if
dc30: 74 6d 70 20 28 63 64 72 20 74 6d 70 29 20 23 66 tmp (cdr tmp) #f
dc40: 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 )))).......
dc50: 20 20 28 69 66 20 74 65 73 74 73 64 61 74 0a 09 (if testsdat..
dc60: 09 09 09 09 09 09 20 20 20 28 6c 65 74 20 28 28 ...... (let ((
dc70: 74 65 73 74 73 20 28 6d 61 70 20 28 6c 61 6d 62 tests (map (lamb
dc80: 64 61 20 28 74 65 73 74 29 0a 09 09 09 09 09 09 da (test).......
dc90: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 ... (let*
dca0: 28 28 74 65 73 74 2d 69 64 20 20 28 63 61 72 20 ((test-id (car
dcb0: 74 65 73 74 29 29 0a 09 09 09 09 09 09 09 09 09 test))..........
dcc0: 09 20 20 20 20 20 20 28 74 65 73 74 2d 64 61 74 . (test-dat
dcd0: 20 28 63 64 72 20 74 65 73 74 29 29 29 0a 09 09 (cdr test)))...
dce0: 09 09 09 09 09 09 09 09 20 28 6d 61 70 20 28 6c ........ (map (l
dcf0: 61 6d 62 64 61 20 28 66 69 65 6c 64 29 0a 09 09 ambda (field)...
dd00: 09 09 09 09 09 09 09 09 09 28 6c 65 74 20 28 28 .........(let ((
dd10: 74 6d 70 20 28 61 73 73 6f 63 20 66 69 65 6c 64 tmp (assoc field
dd20: 20 74 65 73 74 2d 64 61 74 29 29 29 0a 09 09 09 test-dat)))....
dd30: 09 09 09 09 09 09 09 09 20 20 28 69 66 20 74 6d ........ (if tm
dd40: 70 20 28 63 64 72 20 74 6d 70 29 20 22 22 29 29 p (cdr tmp) ""))
dd50: 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 20 )...........
dd60: 20 20 72 75 6e 2d 66 69 65 6c 64 73 29 29 29 0a run-fields))).
dd70: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 74 65 ......... te
dd80: 73 74 73 64 61 74 29 29 29 0a 09 09 09 09 09 09 stsdat))).......
dd90: 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 . ;; (print
dda0: 22 54 61 72 67 65 74 3a 20 22 20 74 61 72 67 65 "Target: " targe
ddb0: 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 20 t "/" runname "
ddc0: 74 65 73 74 73 3a 22 29 0a 09 09 09 09 09 09 09 tests:")........
ddd0: 20 20 20 20 20 3b 3b 20 28 70 70 20 74 65 73 74 ;; (pp test
dde0: 73 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 s)........ (
ddf0: 63 6f 6e 73 20 28 63 6f 6e 63 20 74 61 72 67 65 cons (conc targe
de00: 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 0a 09 t "/" runname)..
de10: 09 09 09 09 09 09 09 20 20 20 28 63 6f 6e 73 20 ....... (cons
de20: 28 6c 69 73 74 20 28 63 6f 6e 63 20 74 61 72 67 (list (conc targ
de30: 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 29 et "/" runname))
de40: 0a 09 09 09 09 09 09 09 09 09 20 28 63 6f 6e 73 .......... (cons
de50: 20 27 28 29 0a 09 09 09 09 09 09 09 09 09 20 20 '()..........
de60: 20 20 20 20 20 28 63 6f 6e 73 20 72 75 6e 2d 66 (cons run-f
de70: 69 65 6c 64 73 20 74 65 73 74 73 29 29 29 29 29 ields tests)))))
de80: 0a 09 09 09 09 09 09 09 20 20 20 28 62 65 67 69 ........ (begi
de90: 6e 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 64 n........ (d
dea0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
deb0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
dec0: 22 57 41 52 4e 49 4e 47 3a 20 72 75 6e 20 22 20 "WARNING: run "
ded0: 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 target "/" runna
dee0: 6d 65 20 22 20 61 70 70 65 61 72 73 20 74 6f 20 me " appears to
def0: 68 61 76 65 20 6e 6f 20 64 61 74 61 22 29 0a 09 have no data")..
df00: 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 28 70 ...... ;; (p
df10: 70 20 72 75 6e 64 61 74 29 0a 09 09 09 09 09 09 p rundat).......
df20: 09 20 20 20 20 20 27 28 29 29 29 29 29 0a 09 09 . '()))))...
df30: 09 09 09 09 20 20 20 72 75 6e 73 64 61 74 29 0a .... runsdat).
df40: 09 09 09 09 09 20 20 20 20 20 20 27 28 29 29 29 ..... '()))
df50: 29 0a 09 09 09 09 20 20 20 20 20 20 6e 65 77 64 )..... newd
df60: 61 74 29 29 20 3b 3b 20 77 65 20 75 73 65 20 6e at)) ;; we use n
df70: 65 77 64 61 74 20 74 6f 20 67 65 74 20 74 61 72 ewdat to get tar
df80: 67 65 74 0a 09 09 20 28 73 68 65 65 74 73 20 20 get... (sheets
df90: 20 20 20 20 20 20 20 28 66 69 6c 74 65 72 20 28 (filter (
dfa0: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 lambda (x)......
dfb0: 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 78 (not (null? x
dfc0: 29 29 29 0a 09 09 09 09 09 20 28 63 6f 6e 73 20 )))...... (cons
dfd0: 72 75 6e 73 20 28 6d 61 70 20 63 61 72 20 72 75 runs (map car ru
dfe0: 6e 2d 70 61 67 65 73 29 29 29 29 29 0a 09 20 20 n-pages)))))..
dff0: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 61 6c 6c ;; (print "all
e000: 72 75 6e 64 61 74 3a 22 29 0a 09 20 20 20 20 3b rundat:").. ;
e010: 3b 20 28 70 70 20 61 6c 6c 72 75 6e 64 61 74 29 ; (pp allrundat)
e020: 0a 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 .. ;; (print
e030: 22 72 75 6e 73 3a 22 29 0a 09 20 20 20 20 3b 3b "runs:").. ;;
e040: 20 28 70 70 20 72 75 6e 73 29 0a 09 20 20 20 20 (pp runs)..
e050: 3b 28 70 72 69 6e 74 20 22 73 68 65 65 74 73 3a ;(print "sheets:
e060: 20 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 70 20 ").. ;; (pp
e070: 73 68 65 65 74 73 29 0a 09 20 20 20 20 28 69 66 sheets).. (if
e080: 20 28 65 71 3f 20 64 6d 6f 64 65 20 27 6f 64 73 (eq? dmode 'ods
e090: 29 0a 09 09 28 6c 65 74 2a 20 28 28 74 65 6d 70 )...(let* ((temp
e0a0: 64 69 72 20 20 20 20 28 63 6f 6e 63 20 22 2f 74 dir (conc "/t
e0b0: 6d 70 2f 22 20 28 63 75 72 72 65 6e 74 2d 75 73 mp/" (current-us
e0c0: 65 72 2d 6e 61 6d 65 29 20 22 2f 22 20 28 72 61 er-name) "/" (ra
e0d0: 6e 64 6f 6d 20 31 30 30 30 30 29 20 22 5f 22 20 ndom 10000) "_"
e0e0: 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 (current-process
e0f0: 2d 69 64 29 29 29 0a 09 09 20 20 20 20 20 20 20 -id)))...
e100: 28 6f 75 74 70 75 74 66 69 6c 65 20 28 6f 72 20 (outputfile (or
e110: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
e120: 6f 22 29 20 22 6f 75 74 2e 6f 64 73 22 29 29 0a o") "out.ods")).
e130: 09 09 20 20 20 20 20 20 20 28 6f 75 66 20 20 20 .. (ouf
e140: 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 (if (string
e150: 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 22 -match (regexp "
e160: 5e 5b 2f 7e 5d 2b 2e 2a 22 29 20 6f 75 74 70 75 ^[/~]+.*") outpu
e170: 74 66 69 6c 65 29 20 3b 3b 20 66 75 6c 6c 20 70 tfile) ;; full p
e180: 61 74 68 3f 0a 09 09 09 09 20 20 20 20 20 20 20 ath?.....
e190: 6f 75 74 70 75 74 66 69 6c 65 0a 09 09 09 09 20 outputfile.....
e1a0: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 (begin....
e1b0: 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 .. (debug:print
e1c0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
e1d0: 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 70 ort* "WARNING: p
e1e0: 61 74 68 20 67 69 76 65 6e 2c 20 22 20 6f 75 74 ath given, " out
e1f0: 70 75 74 66 69 6c 65 20 22 20 69 73 20 72 65 6c putfile " is rel
e200: 61 74 69 76 65 2c 20 70 72 65 66 69 78 69 6e 67 ative, prefixing
e210: 20 77 69 74 68 20 63 75 72 72 65 6e 74 20 64 69 with current di
e220: 72 65 63 74 6f 72 79 22 29 0a 09 09 09 09 09 20 rectory")......
e230: 28 63 6f 6e 63 20 28 63 75 72 72 65 6e 74 2d 64 (conc (current-d
e240: 69 72 65 63 74 6f 72 79 29 20 22 2f 22 20 6f 75 irectory) "/" ou
e250: 74 70 75 74 66 69 6c 65 29 29 29 29 29 0a 09 09 tputfile)))))...
e260: 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 (create-direct
e270: 6f 72 79 20 74 65 6d 70 64 69 72 20 23 74 29 0a ory tempdir #t).
e280: 09 09 20 20 28 6f 64 73 3a 6c 69 73 74 2d 3e 6f .. (ods:list->o
e290: 64 73 20 74 65 6d 70 64 69 72 20 6f 75 66 20 73 ds tempdir ouf s
e2a0: 68 65 65 74 73 29 29 29 29 0a 09 20 20 3b 3b 20 heets)))).. ;;
e2b0: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 72 (system (conc "r
e2c0: 6d 20 2d 72 66 20 22 20 74 65 6d 70 64 69 72 29 m -rf " tempdir)
e2d0: 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 ).. (set! *dids
e2e0: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 omething* #t))))
e2f0: 0a 0a 3b 3b 20 44 6f 6e 27 74 20 74 68 69 6e 6b ..;; Don't think
e300: 20 49 20 6e 65 65 64 20 74 68 69 73 2e 20 49 6e I need this. In
e310: 63 6f 72 70 6f 72 61 74 65 64 20 69 6e 74 6f 20 corporated into
e320: 2d 6c 69 73 74 2d 72 75 6e 73 20 69 6e 73 74 65 -list-runs inste
e330: 61 64 0a 3b 3b 0a 3b 3b 20 28 69 66 20 28 61 6e ad.;;.;; (if (an
e340: 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
e350: 22 2d 73 69 6e 63 65 22 29 0a 3b 3b 20 09 20 28 "-since").;; . (
e360: 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 3b launch:setup)).;
e370: 3b 20 20 20 20 20 28 6c 65 74 2a 20 28 28 73 69 ; (let* ((si
e380: 6e 63 65 2d 74 69 6d 65 20 28 73 74 72 69 6e 67 nce-time (string
e390: 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 ->number (args:g
e3a0: 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 22 29 et-arg "-since")
e3b0: 29 29 0a 3b 3b 20 09 20 20 20 28 72 75 6e 2d 69 )).;; . (run-i
e3c0: 64 73 20 20 20 20 28 64 62 3a 67 65 74 2d 63 68 ds (db:get-ch
e3d0: 61 6e 67 65 64 2d 72 75 6e 2d 69 64 73 20 73 69 anged-run-ids si
e3e0: 6e 63 65 2d 74 69 6d 65 29 29 29 0a 3b 3b 20 20 nce-time))).;;
e3f0: 20 20 20 20 20 3b 3b 20 28 72 6d 74 3a 67 65 74 ;; (rmt:get
e400: 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 73 2d -tests-for-runs-
e410: 6d 69 6e 64 61 74 61 20 72 75 6e 2d 69 64 73 20 mindata run-ids
e420: 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 testpatt states
e430: 73 74 61 74 75 73 20 6e 6f 74 2d 69 6e 29 0a 3b status not-in).;
e440: 3b 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 28 ; (print (
e450: 73 6f 72 74 20 72 75 6e 2d 69 64 73 20 3c 29 29 sort run-ids <))
e460: 0a 3b 3b 20 20 20 20 20 20 20 28 73 65 74 21 20 .;; (set!
e470: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
e480: 74 29 29 29 0a 20 20 20 20 20 20 0a 20 20 20 20 t))). .
e490: 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;===========
e4a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 66 ===========.;; f
e4e0: 75 6c 6c 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d ull run.;;======
e4f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e530: 0a 0a 3b 3b 20 67 65 74 20 6c 6f 63 6b 20 69 6e ..;; get lock in
e540: 20 64 62 20 66 6f 72 20 66 75 6c 6c 20 72 75 6e db for full run
e550: 20 66 6f 72 20 74 68 69 73 20 64 69 72 65 63 74 for this direct
e560: 6f 72 79 0a 3b 3b 20 66 6f 72 20 61 6c 6c 20 74 ory.;; for all t
e570: 65 73 74 73 20 77 69 74 68 20 64 65 70 73 0a 3b ests with deps.;
e580: 3b 20 20 20 77 61 6c 6b 20 74 72 65 65 20 6f 66 ; walk tree of
e590: 20 74 65 73 74 73 20 74 6f 20 66 69 6e 64 20 68 tests to find h
e5a0: 65 61 64 20 74 61 73 6b 73 0a 3b 3b 20 20 20 61 ead tasks.;; a
e5b0: 64 64 20 68 65 61 64 20 74 61 73 6b 73 20 74 6f dd head tasks to
e5c0: 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 20 task queue.;;
e5d0: 20 61 64 64 20 64 65 70 65 6e 64 61 6e 74 20 74 add dependant t
e5e0: 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 asks to task que
e5f0: 75 65 20 0a 3b 3b 20 20 20 61 64 64 20 72 65 6d ue .;; add rem
e600: 61 69 6e 69 6e 67 20 74 61 73 6b 73 20 74 6f 20 aining tasks to
e610: 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 66 6f task queue.;; fo
e620: 72 20 65 61 63 68 20 74 61 73 6b 20 69 6e 20 74 r each task in t
e630: 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 20 20 69 ask queue.;; i
e640: 66 20 68 61 76 65 20 61 64 65 71 75 61 74 65 20 f have adequate
e650: 72 65 73 6f 75 72 63 65 73 0a 3b 3b 20 20 20 20 resources.;;
e660: 20 6c 61 75 6e 63 68 20 74 61 73 6b 0a 3b 3b 20 launch task.;;
e670: 20 20 65 6c 73 65 0a 3b 3b 20 20 20 20 20 70 75 else.;; pu
e680: 74 20 74 61 73 6b 20 69 6e 20 64 65 66 65 72 72 t task in deferr
e690: 65 64 20 71 75 65 75 65 0a 3b 3b 20 69 66 20 73 ed queue.;; if s
e6a0: 74 69 6c 6c 20 6f 6b 20 74 6f 20 72 75 6e 20 74 till ok to run t
e6b0: 61 73 6b 73 0a 3b 3b 20 20 20 70 72 6f 63 65 73 asks.;; proces
e6c0: 73 20 64 65 66 65 72 72 65 64 20 74 61 73 6b 73 s deferred tasks
e6d0: 20 70 65 72 20 61 62 6f 76 65 20 73 74 65 70 73 per above steps
e6e0: 0a 0a 3b 3b 20 72 75 6e 20 61 6c 6c 20 74 65 73 ..;; run all tes
e6f0: 74 73 20 61 72 65 20 61 72 65 20 4e 6f 74 20 43 ts are are Not C
e700: 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 50 41 53 OMPLETED and PAS
e710: 53 20 6f 72 20 43 48 45 43 4b 0a 28 69 66 20 28 S or CHECK.(if (
e720: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
e730: 20 22 2d 72 75 6e 61 6c 6c 22 29 0a 09 28 61 72 "-runall")..(ar
e740: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
e750: 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
e760: 67 20 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 22 g "-rerun-clean"
e770: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
e780: 20 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 29 0a 09 "-rerun-all")..
e790: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
e7a0: 72 75 6e 74 65 73 74 73 22 29 29 0a 20 20 20 20 runtests")).
e7b0: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
e7c0: 6c 20 0a 20 20 20 20 20 22 2d 72 75 6e 61 6c 6c l . "-runall
e7d0: 22 0a 20 20 20 20 20 22 72 75 6e 20 61 6c 6c 20 ". "run all
e7e0: 74 65 73 74 73 22 0a 20 20 20 20 20 28 6c 61 6d tests". (lam
e7f0: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
e800: 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 ame keys keyvals
e810: 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 61 72 ). (if (ar
e820: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 72 gs:get-arg "-rer
e830: 75 6e 2d 63 6c 65 61 6e 22 29 20 3b 3b 20 66 69 un-clean") ;; fi
e840: 72 73 74 20 73 65 74 20 73 74 61 74 65 73 2f 73 rst set states/s
e850: 74 61 74 75 73 65 73 20 63 6f 72 72 65 63 74 0a tatuses correct.
e860: 09 20 20 20 28 6c 65 74 20 28 28 73 74 61 74 65 . (let ((state
e870: 73 20 20 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 s (or (configf
e880: 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 :lookup *configd
e890: 61 74 2a 20 22 76 61 6c 69 64 76 61 6c 75 65 73 at* "validvalues
e8a0: 22 20 22 63 6c 65 61 6e 72 65 72 75 6e 2d 73 74 " "cleanrerun-st
e8b0: 61 74 65 73 22 29 0a 09 09 09 20 20 20 20 20 20 ates")....
e8c0: 20 22 4b 49 4c 4c 52 45 51 2c 4b 49 4c 4c 45 44 "KILLREQ,KILLED
e8d0: 2c 55 4e 4b 4e 4f 57 4e 2c 49 4e 43 4f 4d 50 4c ,UNKNOWN,INCOMPL
e8e0: 45 54 45 2c 53 54 55 43 4b 2c 4e 4f 54 5f 53 54 ETE,STUCK,NOT_ST
e8f0: 41 52 54 45 44 22 29 29 0a 09 09 20 28 73 74 61 ARTED"))... (sta
e900: 74 75 73 65 73 20 28 6f 72 20 28 63 6f 6e 66 69 tuses (or (confi
e910: 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 gf:lookup *confi
e920: 67 64 61 74 2a 20 22 76 61 6c 69 64 76 61 6c 75 gdat* "validvalu
e930: 65 73 22 20 22 63 6c 65 61 6e 72 65 72 75 6e 2d es" "cleanrerun-
e940: 73 74 61 74 75 73 65 73 22 29 0a 09 09 09 20 20 statuses")....
e950: 20 20 20 20 20 22 46 41 49 4c 2c 49 4e 43 4f 4d "FAIL,INCOM
e960: 50 4c 45 54 45 2c 41 42 4f 52 54 2c 43 48 45 43 PLETE,ABORT,CHEC
e970: 4b 22 29 29 29 0a 09 20 20 20 20 20 28 68 61 73 K"))).. (has
e980: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 72 67 h-table-set! arg
e990: 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 70 72 65 s:arg-hash "-pre
e9a0: 63 6c 65 61 6e 22 20 23 74 29 0a 09 20 20 20 20 clean" #t)..
e9b0: 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f (runs:operate-o
e9c0: 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 61 n 'set-state-sta
e9d0: 74 75 73 0a 09 09 09 20 20 20 20 20 20 74 61 72 tus.... tar
e9e0: 67 65 74 0a 09 09 09 20 20 20 20 20 20 28 63 6f get.... (co
e9f0: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 mmon:args-get-ru
ea00: 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 nname) ;; (or (
ea10: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
ea20: 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 unname")(args:ge
ea30: 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 t-arg ":runname"
ea40: 29 29 0a 09 09 09 20 20 20 20 20 20 22 25 22 20 )).... "%"
ea50: 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d ;; (common:args-
ea60: 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 get-testpatt #f)
ea70: 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ;; (args:get-ar
ea80: 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 g "-testpatt")..
ea90: 09 09 20 20 20 20 20 20 73 74 61 74 65 3a 20 20 .. state:
eaa0: 73 74 61 74 65 73 0a 09 09 09 20 20 20 20 20 20 states....
eab0: 3b 3b 20 73 74 61 74 75 73 3a 20 73 74 61 74 75 ;; status: statu
eac0: 73 65 73 0a 09 09 09 20 20 20 20 20 20 6e 65 77 ses.... new
ead0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a 20 22 -state-status: "
eae0: 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 22 NOT_STARTED,n/a"
eaf0: 29 0a 09 20 20 20 20 20 28 72 75 6e 73 3a 6f 70 ).. (runs:op
eb00: 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 erate-on 'set-st
eb10: 61 74 65 2d 73 74 61 74 75 73 0a 09 09 09 20 20 ate-status....
eb20: 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 target....
eb30: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 (common:args
eb40: 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 20 3b -get-runname) ;
eb50: 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d ; (or (args:get-
eb60: 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 arg "-runname")(
eb70: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 args:get-arg ":r
eb80: 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 20 20 20 unname"))....
eb90: 20 20 20 22 25 22 20 3b 3b 20 28 63 6f 6d 6d 6f "%" ;; (commo
eba0: 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 n:args-get-testp
ebb0: 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 att #f) ;; (args
ebc0: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 :get-arg "-testp
ebd0: 61 74 74 22 29 0a 09 09 09 20 20 20 20 20 20 3b att").... ;
ebe0: 3b 20 73 74 61 74 65 3a 20 20 73 74 61 74 65 73 ; state: states
ebf0: 0a 09 09 09 20 20 20 20 20 20 73 74 61 74 75 73 .... status
ec00: 3a 20 73 74 61 74 75 73 65 73 0a 09 09 09 20 20 : statuses....
ec10: 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 new-state-st
ec20: 61 74 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 atus: "NOT_START
ec30: 45 44 2c 6e 2f 61 22 29 29 29 0a 20 20 20 20 20 ED,n/a"))).
ec40: 20 20 3b 3b 20 52 45 52 55 4e 20 41 4c 4c 0a 20 ;; RERUN ALL.
ec50: 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a (if (args:
ec60: 67 65 74 2d 61 72 67 20 22 2d 72 65 72 75 6e 2d get-arg "-rerun-
ec70: 61 6c 6c 22 29 20 3b 3b 20 66 69 72 73 74 20 73 all") ;; first s
ec80: 65 74 20 73 74 61 74 65 73 2f 73 74 61 74 75 73 et states/status
ec90: 65 73 20 63 6f 72 72 65 63 74 0a 09 20 20 20 28 es correct.. (
eca0: 62 65 67 69 6e 0a 09 20 20 20 20 20 28 68 61 73 begin.. (has
ecb0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 72 67 h-table-set! arg
ecc0: 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 70 72 65 s:arg-hash "-pre
ecd0: 63 6c 65 61 6e 22 20 23 74 29 0a 09 20 20 20 20 clean" #t)..
ece0: 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f (runs:operate-o
ecf0: 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 61 n 'set-state-sta
ed00: 74 75 73 0a 09 09 09 20 20 20 20 20 20 74 61 72 tus.... tar
ed10: 67 65 74 0a 09 09 09 20 20 20 20 20 20 28 63 6f get.... (co
ed20: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 mmon:args-get-ru
ed30: 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f 72 20 28 nname) ;; (or (
ed40: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
ed50: 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 unname")(args:ge
ed60: 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 t-arg ":runname"
ed70: 29 29 0a 09 09 09 20 20 20 20 20 20 22 25 22 20 )).... "%"
ed80: 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d ;; (common:args-
ed90: 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 get-testpatt #f)
eda0: 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ;; (args:get-ar
edb0: 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 g "-testpatt")..
edc0: 09 09 20 20 20 20 20 20 73 74 61 74 65 3a 20 20 .. state:
edd0: 23 66 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 73 #f.... ;; s
ede0: 74 61 74 75 73 3a 20 73 74 61 74 75 73 65 73 0a tatus: statuses.
edf0: 09 09 09 20 20 20 20 20 20 6e 65 77 2d 73 74 61 ... new-sta
ee00: 74 65 2d 73 74 61 74 75 73 3a 20 22 4e 4f 54 5f te-status: "NOT_
ee10: 53 54 41 52 54 45 44 2c 6e 2f 61 22 29 0a 09 20 STARTED,n/a")..
ee20: 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 72 61 74 (runs:operat
ee30: 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d e-on 'set-state-
ee40: 73 74 61 74 75 73 0a 09 09 09 20 20 20 20 20 20 status....
ee50: 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 20 20 target....
ee60: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
ee70: 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 6f -runname) ;; (o
ee80: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
ee90: 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 "-runname")(args
eea0: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
eeb0: 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 20 22 me")).... "
eec0: 25 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 %" ;; (common:ar
eed0: 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 gs-get-testpatt
eee0: 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 #f) ;; (args:get
eef0: 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 -arg "-testpatt"
ef00: 29 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 73 74 ).... ;; st
ef10: 61 74 65 3a 20 20 73 74 61 74 65 73 0a 09 09 09 ate: states....
ef20: 20 20 20 20 20 20 73 74 61 74 75 73 3a 20 23 66 status: #f
ef30: 0a 09 09 09 20 20 20 20 20 20 6e 65 77 2d 73 74 .... new-st
ef40: 61 74 65 2d 73 74 61 74 75 73 3a 20 22 4e 4f 54 ate-status: "NOT
ef50: 5f 53 54 41 52 54 45 44 2c 6e 2f 61 22 29 29 29 _STARTED,n/a")))
ef60: 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a 72 75 . (runs:ru
ef70: 6e 2d 74 65 73 74 73 20 74 61 72 67 65 74 0a 09 n-tests target..
ef80: 09 20 20 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a . runname.
ef90: 09 09 20 20 20 20 20 20 20 23 66 20 3b 3b 20 28 .. #f ;; (
efa0: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
efb0: 74 65 73 74 70 61 74 74 20 23 66 29 0a 09 09 20 testpatt #f)...
efc0: 20 20 20 20 20 20 3b 3b 20 28 6f 72 20 28 61 72 ;; (or (ar
efd0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
efe0: 74 70 61 74 74 22 29 0a 09 09 20 20 20 20 20 20 tpatt")...
eff0: 20 3b 3b 20 20 20 20 20 22 25 22 29 0a 09 09 20 ;; "%")...
f000: 20 20 20 20 20 20 75 73 65 72 0a 09 09 20 20 20 user...
f010: 20 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 73 args:arg-has
f020: 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d h))))..;;=======
f030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
f070: 3b 3b 20 72 75 6e 20 6f 6e 65 20 74 65 73 74 0a ;; run one test.
f080: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
f090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f0a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f0b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f0c0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e 20 ========..;; 1.
f0d0: 66 69 6e 64 20 74 68 65 20 63 6f 6e 66 69 67 20 find the config
f0e0: 66 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 61 6e 67 file.;; 2. chang
f0f0: 65 20 74 6f 20 74 68 65 20 74 65 73 74 20 64 69 e to the test di
f100: 72 65 63 74 6f 72 79 0a 3b 3b 20 33 2e 20 75 70 rectory.;; 3. up
f110: 64 61 74 65 20 74 68 65 20 64 62 20 77 69 74 68 date the db with
f120: 20 22 74 65 73 74 20 73 74 61 72 74 65 64 22 20 "test started"
f130: 73 74 61 74 75 73 2c 20 73 65 74 20 72 75 6e 6e status, set runn
f140: 69 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 2e 20 70 ing host.;; 4. p
f150: 72 6f 63 65 73 73 20 6c 61 75 6e 63 68 20 74 68 rocess launch th
f160: 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 6d e test.;; - m
f170: 6f 6e 69 74 6f 72 20 74 68 65 20 70 72 6f 63 65 onitor the proce
f180: 73 73 2c 20 75 70 64 61 74 65 20 73 74 61 74 73 ss, update stats
f190: 20 69 6e 20 74 68 65 20 64 62 20 65 76 65 72 79 in the db every
f1a0: 20 32 5e 6e 20 6d 69 6e 75 74 65 73 0a 3b 3b 20 2^n minutes.;;
f1b0: 35 2e 20 61 73 20 74 68 65 20 74 65 73 74 20 70 5. as the test p
f1c0: 72 6f 63 65 65 64 73 20 69 6e 74 65 72 6e 61 6c roceeds internal
f1d0: 6c 79 20 69 74 20 63 61 6c 6c 73 20 6d 65 67 61 ly it calls mega
f1e0: 74 65 73 74 20 61 73 20 65 61 63 68 20 73 74 65 test as each ste
f1f0: 70 20 69 73 0a 3b 3b 20 20 20 20 73 74 61 72 74 p is.;; start
f200: 65 64 20 61 6e 64 20 63 6f 6d 70 6c 65 74 65 64 ed and completed
f210: 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 73 74 .;; - step st
f220: 61 72 74 65 64 2c 20 74 69 6d 65 73 74 61 6d 70 arted, timestamp
f230: 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 63 6f .;; - step co
f240: 6d 70 6c 65 74 65 64 2c 20 65 78 69 74 20 73 74 mpleted, exit st
f250: 61 74 75 73 2c 20 74 69 6d 65 73 74 61 6d 70 0a atus, timestamp.
f260: 3b 3b 20 36 2e 20 74 65 73 74 20 70 68 6f 6e 65 ;; 6. test phone
f270: 20 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d 20 69 66 home.;; - if
f280: 20 74 65 73 74 20 72 75 6e 20 74 69 6d 65 20 3e test run time >
f290: 20 61 6c 6c 6f 77 65 64 20 72 75 6e 20 74 69 6d allowed run tim
f2a0: 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a e then kill job.
f2b0: 3b 3b 20 20 20 20 2d 20 69 66 20 63 61 6e 6e 6f ;; - if canno
f2c0: 74 20 61 63 63 65 73 73 20 64 62 20 3e 20 61 6c t access db > al
f2d0: 6c 6f 77 65 64 20 64 69 73 63 6f 6e 6e 65 63 74 lowed disconnect
f2e0: 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 time then kill
f2f0: 6a 6f 62 0a 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 job..;; == dupli
f300: 63 61 74 65 64 20 3d 3d 20 28 69 66 20 28 6f 72 cated == (if (or
f310: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
f320: 2d 72 75 6e 22 29 28 61 72 67 73 3a 67 65 74 2d -run")(args:get-
f330: 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
f340: 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 ).;; == duplicat
f350: 65 64 20 3d 3d 20 20 20 28 67 65 6e 65 72 61 6c ed == (general
f360: 2d 72 75 6e 2d 63 61 6c 6c 20 0a 3b 3b 20 3d 3d -run-call .;; ==
f370: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
f380: 20 20 22 2d 72 75 6e 74 65 73 74 73 22 20 0a 3b "-runtests" .;
f390: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
f3a0: 3d 3d 20 20 20 20 22 72 75 6e 20 61 20 74 65 73 == "run a tes
f3b0: 74 22 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 t" .;; == duplic
f3c0: 61 74 65 64 20 3d 3d 20 20 20 20 28 6c 61 6d 62 ated == (lamb
f3d0: 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 da (target runna
f3e0: 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 me keys keyvals)
f3f0: 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 .;; == duplicate
f400: 64 20 3d 3d 20 20 20 20 20 20 3b 3b 0a 3b 3b 20 d == ;;.;;
f410: 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
f420: 20 20 20 20 20 20 3b 3b 20 4d 61 79 20 6f 72 20 ;; May or
f430: 6d 61 79 20 6e 6f 74 20 69 6d 70 6c 65 6d 65 6e may not implemen
f440: 74 20 69 74 20 74 68 69 73 20 77 61 79 20 2e 2e t it this way ..
f450: 2e 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 ..;; == duplicat
f460: 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 0a 3b 3b ed == ;;.;;
f470: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
f480: 3d 20 20 20 20 20 20 3b 3b 20 49 6e 73 65 72 74 = ;; Insert
f490: 20 74 68 69 73 20 72 75 6e 20 69 6e 74 6f 20 74 this run into t
f4a0: 68 65 20 74 61 73 6b 73 20 71 75 65 75 65 0a 3b he tasks queue.;
f4b0: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
f4c0: 3d 3d 20 20 20 20 20 20 3b 3b 20 28 6f 70 65 6e == ;; (open
f4d0: 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 -run-close tasks
f4e0: 3a 61 64 64 20 74 61 73 6b 73 3a 6f 70 65 6e 2d :add tasks:open-
f4f0: 64 62 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 db .;; == duplic
f500: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 ated == ;;
f510: 20 20 20 09 20 20 20 20 20 22 72 75 6e 74 65 73 . "runtes
f520: 74 73 22 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 ts" .;; == dupli
f530: 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b cated == ;;
f540: 20 20 20 20 09 20 20 20 20 20 75 73 65 72 0a 3b . user.;
f550: 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
f560: 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 == ;; .
f570: 20 20 20 20 74 61 72 67 65 74 0a 3b 3b 20 3d 3d target.;; ==
f580: 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 duplicated ==
f590: 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 ;; .
f5a0: 72 75 6e 6e 61 6d 65 0a 3b 3b 20 3d 3d 20 64 75 runname.;; == du
f5b0: 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 plicated ==
f5c0: 20 3b 3b 20 20 20 20 09 20 20 20 20 20 28 61 72 ;; . (ar
f5d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
f5e0: 74 65 73 74 73 22 29 0a 3b 3b 20 3d 3d 20 64 75 tests").;; == du
f5f0: 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 plicated ==
f600: 20 3b 3b 20 20 20 20 09 20 20 20 20 20 23 66 29 ;; . #f)
f610: 29 29 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 ))).;; == duplic
f620: 61 74 65 64 20 3d 3d 20 20 20 20 20 20 28 72 75 ated == (ru
f630: 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 72 ns:run-tests tar
f640: 67 65 74 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 get.;; == duplic
f650: 61 74 65 64 20 3d 3d 20 09 09 20 20 20 20 20 72 ated == .. r
f660: 75 6e 6e 61 6d 65 0a 3b 3b 20 3d 3d 20 64 75 70 unname.;; == dup
f670: 6c 69 63 61 74 65 64 20 3d 3d 20 09 09 20 20 20 licated == ..
f680: 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 (common:args-g
f690: 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 20 et-testpatt #f)
f6a0: 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ;; (args:get-arg
f6b0: 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 3b 3b "-runtests").;;
f6c0: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
f6d0: 3d 20 09 09 20 20 20 20 20 75 73 65 72 0a 3b 3b = .. user.;;
f6e0: 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d == duplicated =
f6f0: 3d 20 09 09 20 20 20 20 20 61 72 67 73 3a 61 72 = .. args:ar
f700: 67 2d 68 61 73 68 29 29 29 29 0a 0a 3b 3b 3d 3d g-hash))))..;;==
f710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f750: 3d 3d 3d 3d 0a 3b 3b 20 52 6f 6c 6c 75 70 20 69 ====.;; Rollup i
f760: 6e 74 6f 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d nto a run.;;====
f770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f7a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f7b0: 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ==..(if (args:ge
f7c0: 74 2d 61 72 67 20 22 2d 72 6f 6c 6c 75 70 22 29 t-arg "-rollup")
f7d0: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
f7e0: 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 n-call . "-r
f7f0: 6f 6c 6c 75 70 22 20 0a 20 20 20 20 20 22 72 6f ollup" . "ro
f800: 6c 6c 75 70 20 74 65 73 74 73 22 20 0a 20 20 20 llup tests" .
f810: 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 (lambda (targe
f820: 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
f830: 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 eyvals). (
f840: 72 75 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 runs:rollup-run
f850: 6b 65 79 73 0a 09 09 09 6b 65 79 76 61 6c 73 0a keys....keyvals.
f860: 09 09 09 28 6f 72 20 28 61 72 67 73 3a 67 65 74 ...(or (args:get
f870: 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 -arg "-runname")
f880: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
f890: 72 75 6e 6e 61 6d 65 22 29 20 29 0a 09 09 09 75 runname") )....u
f8a0: 73 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d ser))))..;;=====
f8b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8f0: 3d 0a 3b 3b 20 4c 6f 63 6b 20 6f 72 20 75 6e 6c =.;; Lock or unl
f900: 6f 63 6b 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d ock a run.;;====
f910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f950: 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 ==..(if (or (arg
f960: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 6b s:get-arg "-lock
f970: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
f980: 22 2d 75 6e 6c 6f 63 6b 22 29 29 0a 20 20 20 20 "-unlock")).
f990: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
f9a0: 6c 20 0a 20 20 20 20 20 28 69 66 20 28 61 72 67 l . (if (arg
f9b0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 6b s:get-arg "-lock
f9c0: 22 29 20 22 2d 6c 6f 63 6b 22 20 22 2d 75 6e 6c ") "-lock" "-unl
f9d0: 6f 63 6b 22 29 0a 20 20 20 20 20 22 6c 6f 63 6b ock"). "lock
f9e0: 2f 75 6e 6c 6f 63 6b 20 74 65 73 74 73 22 20 0a /unlock tests" .
f9f0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 (lambda (ta
fa00: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
fa10: 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 s keyvals).
fa20: 20 20 28 72 75 6e 73 3a 68 61 6e 64 6c 65 2d 6c (runs:handle-l
fa30: 6f 63 6b 69 6e 67 20 0a 09 09 20 20 74 61 72 67 ocking ... targ
fa40: 65 74 0a 09 09 20 20 6b 65 79 73 0a 09 09 20 20 et... keys...
fa50: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
fa60: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 g "-runname")(ar
fa70: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
fa80: 6e 61 6d 65 22 29 20 29 0a 09 09 20 20 28 61 72 name") )... (ar
fa90: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 gs:get-arg "-loc
faa0: 6b 22 29 0a 09 09 20 20 28 61 72 67 73 3a 67 65 k")... (args:ge
fab0: 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b 22 29 t-arg "-unlock")
fac0: 0a 09 09 20 20 75 73 65 72 29 29 29 29 0a 0a 3b ... user))))..;
fad0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
fae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
faf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb10: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 65 74 20 70 =======.;; Get p
fb20: 61 74 68 73 20 74 6f 20 74 65 73 74 73 0a 3b 3b aths to tests.;;
fb30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fb70: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 65 74 20 74 65 ======.;; Get te
fb80: 73 74 20 70 61 74 68 73 20 6d 61 74 63 68 69 6e st paths matchin
fb90: 67 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d g target, runnam
fba0: 65 2c 20 61 6e 64 20 74 65 73 74 70 61 74 74 0a e, and testpatt.
fbb0: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
fbc0: 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c t-arg "-test-fil
fbd0: 65 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 es")(args:get-ar
fbe0: 67 20 22 2d 74 65 73 74 2d 70 61 74 68 73 22 29 g "-test-paths")
fbf0: 29 0a 20 20 20 20 3b 3b 20 69 66 20 77 65 20 61 ). ;; if we a
fc00: 72 65 20 69 6e 20 61 20 74 65 73 74 20 75 73 65 re in a test use
fc10: 20 74 68 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 the MT_CMDINFO
fc20: 64 61 74 61 0a 20 20 20 20 28 69 66 20 28 67 65 data. (if (ge
fc30: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
fc40: 22 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 72 ")..(let* ((star
fc50: 74 69 6e 67 64 69 72 20 28 63 75 72 72 65 6e 74 tingdir (current
fc60: 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 20 20 -directory))..
fc70: 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 (cmdinfo
fc80: 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 (common:read-enc
fc90: 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 67 65 74 oded-string (get
fca0: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
fcb0: 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 72 61 ))).. (tra
fcc0: 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f 64 65 nsport (assoc/de
fcd0: 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f 72 74 fault 'transport
fce0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
fcf0: 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 61 (testpath (a
fd00: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
fd10: 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 stpath cmdinfo)
fd20: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d ).. (test-
fd30: 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 name (assoc/defa
fd40: 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 ult 'test-name c
fd50: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
fd60: 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 73 (runscript (ass
fd70: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 73 oc/default 'runs
fd80: 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a cript cmdinfo)).
fd90: 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 74 . (db-host
fda0: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
fdb0: 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 t 'db-host cmd
fdc0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
fdd0: 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 run-id (assoc
fde0: 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 /default 'run-id
fdf0: 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 cmdinfo))..
fe00: 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 (itemdat
fe10: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
fe20: 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 'itemdat cmdin
fe30: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 fo)).. (st
fe40: 61 74 65 20 20 20 20 20 28 61 72 67 73 3a 67 65 ate (args:ge
fe50: 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 t-arg ":state"))
fe60: 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 .. (status
fe70: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
fe80: 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a 09 20 g ":status"))..
fe90: 20 20 20 20 20 20 28 74 61 72 67 65 74 20 20 20 (target
fea0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
feb0: 2d 74 61 72 67 65 74 22 29 29 0a 09 20 20 20 20 -target"))..
fec0: 20 20 20 28 74 6f 70 70 61 74 68 20 20 20 28 61 (toppath (a
fed0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 6f ssoc/default 'to
fee0: 70 70 61 74 68 20 20 20 63 6d 64 69 6e 66 6f 29 ppath cmdinfo)
fef0: 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 )).. (change-di
ff00: 72 65 63 74 6f 72 79 20 74 6f 70 70 61 74 68 29 rectory toppath)
ff10: 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 74 61 72 .. (if (not tar
ff20: 67 65 74 29 0a 09 20 20 20 20 20 20 28 62 65 67 get).. (beg
ff30: 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e in...(debug:prin
ff40: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
ff50: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 74 lt-log-port* "-t
ff60: 61 72 67 65 74 20 69 73 20 72 65 71 75 69 72 65 arget is require
ff70: 64 2e 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 d.")...(exit 1))
ff80: 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 6c ).. (if (not (l
ff90: 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 aunch:setup))..
ffa0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 (begin...(d
ffb0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
ffc0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
ffd0: 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 "Failed to setup
ffe0: 2c 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 2d , giving up on -
fff0: 74 65 73 74 2d 70 61 74 68 73 20 6f 72 20 2d 74 test-paths or -t
10000 65 73 74 2d 66 69 6c 65 73 2c 20 65 78 69 74 69 est-files, exiti
10010 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 ng")...(exit 1))
10020 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 ).. (let* ((key
10030 73 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b s (rmt:get-k
10040 65 79 73 29 29 0a 09 09 20 3b 3b 20 64 62 3a 74 eys))... ;; db:t
10050 65 73 74 2d 67 65 74 2d 70 61 74 68 73 20 6d 75 est-get-paths mu
10060 73 74 20 6e 6f 74 20 62 65 20 72 75 6e 20 72 65 st not be run re
10070 6d 6f 74 65 0a 09 09 20 28 70 61 74 68 73 20 20 mote... (paths
10080 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 67 65 (tests:test-ge
10090 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 t-paths-matching
100a0 20 6b 65 79 73 20 74 61 72 67 65 74 20 28 61 72 keys target (ar
100b0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
100c0 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 20 t-files"))))..
100d0 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
100e0 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 thing* #t)..
100f0 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
10100 61 20 28 70 61 74 68 29 0a 09 09 09 28 70 72 69 a (path)....(pri
10110 6e 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 nt path))...
10120 20 20 70 61 74 68 73 29 29 29 0a 09 3b 3b 20 65 paths)))..;; e
10130 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 6c lse do a general
10140 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 -run-call..(gene
10150 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 ral-run-call ..
10160 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 0a 09 20 "-test-files"..
10170 22 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 "Get paths to te
10180 73 74 22 0a 09 20 28 6c 61 6d 62 64 61 20 28 74 st".. (lambda (t
10190 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
101a0 79 73 20 6b 65 79 76 61 6c 73 29 0a 09 20 20 20 ys keyvals)..
101b0 28 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 (let* ((db
101c0 20 23 66 29 0a 09 09 20 20 3b 3b 20 44 4f 20 4e #f)... ;; DO N
101d0 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 OT run remote...
101e0 20 20 28 70 61 74 68 73 20 20 20 20 28 74 65 73 (paths (tes
101f0 74 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 ts:test-get-path
10200 73 2d 6d 61 74 63 68 69 6e 67 20 6b 65 79 73 20 s-matching keys
10210 74 61 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 target (args:get
10220 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 -arg "-test-file
10230 73 22 29 29 29 29 0a 09 20 20 20 20 20 28 66 6f s")))).. (fo
10240 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
10250 70 61 74 68 29 0a 09 09 09 20 28 70 72 69 6e 74 path).... (print
10260 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 path))...
10270 20 70 61 74 68 73 29 29 29 29 29 29 0a 0a 3b 3b paths))))))..;;
10280 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10290 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
102a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
102b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
102c0 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 ======.;; Archiv
102d0 65 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d e tests.;;======
102e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
102f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10300 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10310 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10320 0a 3b 3b 20 41 72 63 68 69 76 65 20 74 65 73 74 .;; Archive test
10330 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 s matching targe
10340 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 t, runname, and
10350 74 65 73 74 70 61 74 74 0a 28 69 66 20 28 61 72 testpatt.(if (ar
10360 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 61 72 63 gs:get-arg "-arc
10370 68 69 76 65 22 29 0a 20 20 20 20 3b 3b 20 65 6c hive"). ;; el
10380 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 6c 2d se do a general-
10390 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 20 28 67 65 run-call. (ge
103a0 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
103b0 20 20 20 20 20 22 2d 61 72 63 68 69 76 65 22 0a "-archive".
103c0 20 20 20 20 20 22 41 72 63 68 69 76 65 22 0a 20 "Archive".
103d0 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
103e0 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
103f0 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 keyvals).
10400 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 61 72 (operate-on 'ar
10410 63 68 69 76 65 29 29 29 29 0a 0a 3b 3b 3d 3d 3d chive))))..;;===
10420 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10430 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10440 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10450 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10460 3d 3d 3d 0a 3b 3b 20 45 78 74 72 61 63 74 20 61 ===.;; Extract a
10470 20 73 70 72 65 61 64 73 68 65 65 74 20 66 72 6f spreadsheet fro
10480 6d 20 74 68 65 20 72 75 6e 73 20 64 61 74 61 62 m the runs datab
10490 61 73 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ase.;;==========
104a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
104d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
104e0 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
104f0 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 0a "-extract-ods").
10500 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e (general-run
10510 2d 63 61 6c 6c 0a 20 20 20 20 20 22 2d 65 78 74 -call. "-ext
10520 72 61 63 74 2d 6f 64 73 22 0a 20 20 20 20 20 22 ract-ods". "
10530 4d 61 6b 65 20 6f 64 73 20 73 70 72 65 61 64 73 Make ods spreads
10540 68 65 65 74 22 0a 20 20 20 20 20 28 6c 61 6d 62 heet". (lamb
10550 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 da (target runna
10560 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 me keys keyvals)
10570 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 . (let ((d
10580 62 73 74 72 75 63 74 20 20 20 28 6d 61 6b 65 2d bstruct (make-
10590 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 dbr:dbstruct pat
105a0 68 3a 20 2a 74 6f 70 70 61 74 68 2a 20 6c 6f 63 h: *toppath* loc
105b0 61 6c 3a 20 23 74 29 29 0a 09 20 20 20 20 20 28 al: #t)).. (
105c0 6f 75 74 70 75 74 66 69 6c 65 20 28 61 72 67 73 outputfile (args
105d0 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 61 :get-arg "-extra
105e0 63 74 2d 6f 64 73 22 29 29 0a 09 20 20 20 20 20 ct-ods"))..
105f0 28 72 75 6e 73 70 61 74 74 20 20 20 28 6f 72 20 (runspatt (or
10600 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
10610 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 runname")(args:g
10620 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
10630 22 29 29 29 0a 09 20 20 20 20 20 28 70 61 74 68 "))).. (path
10640 6d 6f 64 20 20 20 20 28 61 72 67 73 3a 67 65 74 mod (args:get
10650 2d 61 72 67 20 22 2d 70 61 74 68 6d 6f 64 22 29 -arg "-pathmod")
10660 29 29 0a 09 20 20 20 20 20 3b 3b 20 28 6b 65 79 )).. ;; (key
10670 76 61 6c 61 6c 69 73 74 20 28 6b 65 79 73 2d 3e valalist (keys->
10680 61 6c 69 73 74 20 6b 65 79 73 20 22 25 22 29 29 alist keys "%"))
10690 29 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ).. (debug:print
106a0 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 2 *default-log-
106b0 70 6f 72 74 2a 20 22 45 78 74 72 61 63 74 20 6f port* "Extract o
106c0 64 73 2c 20 6f 75 74 70 75 74 66 69 6c 65 3a 20 ds, outputfile:
106d0 22 20 6f 75 74 70 75 74 66 69 6c 65 20 22 20 72 " outputfile " r
106e0 75 6e 73 70 61 74 74 3a 20 22 20 72 75 6e 73 70 unspatt: " runsp
106f0 61 74 74 20 22 20 6b 65 79 76 61 6c 73 3a 20 22 att " keyvals: "
10700 20 6b 65 79 76 61 6c 73 29 0a 09 20 28 64 62 3a keyvals).. (db:
10710 65 78 74 72 61 63 74 2d 6f 64 73 2d 66 69 6c 65 extract-ods-file
10720 20 64 62 73 74 72 75 63 74 20 6f 75 74 70 75 74 dbstruct output
10730 66 69 6c 65 20 6b 65 79 76 61 6c 73 20 28 69 66 file keyvals (if
10740 20 72 75 6e 73 70 61 74 74 20 72 75 6e 73 70 61 runspatt runspa
10750 74 74 20 22 25 22 29 20 70 61 74 68 6d 6f 64 29 tt "%") pathmod)
10760 0a 09 20 28 64 62 3a 63 6c 6f 73 65 2d 61 6c 6c .. (db:close-all
10770 20 64 62 73 74 72 75 63 74 29 0a 09 20 28 73 65 dbstruct).. (se
10780 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
10790 2a 20 23 74 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d * #t)))))..;;===
107a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
107e0 3d 3d 3d 0a 3b 3b 20 65 78 65 63 75 74 65 20 74 ===.;; execute t
107f0 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 he test.;; -
10800 67 65 74 73 20 63 61 6c 6c 65 64 20 6f 6e 20 72 gets called on r
10810 65 6d 6f 74 65 20 68 6f 73 74 0a 3b 3b 20 20 20 emote host.;;
10820 20 2d 20 72 65 63 65 69 76 65 73 20 69 6e 66 6f - receives info
10830 20 66 72 6f 6d 20 74 68 65 20 2d 65 78 65 63 75 from the -execu
10840 74 65 20 70 61 72 61 6d 0a 3b 3b 20 20 20 20 2d te param.;; -
10850 20 70 61 73 73 65 73 20 69 6e 66 6f 20 74 6f 20 passes info to
10860 73 74 65 70 73 20 76 69 61 20 4d 54 5f 43 4d 44 steps via MT_CMD
10870 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 28 66 75 INFO env var (fu
10880 74 75 72 65 20 69 73 20 74 6f 20 75 73 65 20 61 ture is to use a
10890 20 64 6f 74 20 66 69 6c 65 29 0a 3b 3b 20 20 20 dot file).;;
108a0 20 2d 20 67 61 74 68 65 72 73 20 68 6f 73 74 20 - gathers host
108b0 69 6e 66 6f 20 61 6e 64 20 0a 3b 3b 3d 3d 3d 3d info and .;;====
108c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
108f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10900 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ==..(if (args:ge
10910 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 t-arg "-execute"
10920 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
10930 20 20 20 28 6c 61 75 6e 63 68 3a 65 78 65 63 75 (launch:execu
10940 74 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 te (args:get-arg
10950 20 22 2d 65 78 65 63 75 74 65 22 29 29 0a 20 20 "-execute")).
10960 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
10970 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
10980 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
10990 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109c0 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 65 63 6f ========.;; reco
109d0 76 65 72 20 66 72 6f 6d 20 61 20 74 65 73 74 20 ver from a test
109e0 77 68 65 72 65 20 74 68 65 20 6d 61 6e 61 67 69 where the managi
109f0 6e 67 20 6d 74 65 73 74 20 77 61 73 20 6b 69 6c ng mtest was kil
10a00 6c 65 64 20 62 75 74 20 74 68 65 20 75 6e 64 65 led but the unde
10a10 72 6c 79 69 6e 67 0a 3b 3b 20 70 72 6f 63 65 73 rlying.;; proces
10a20 73 20 6d 69 67 68 74 20 73 74 69 6c 6c 20 62 65 s might still be
10a30 20 73 61 6c 76 61 67 65 61 62 6c 65 0a 3b 3b 3d salvageable.;;=
10a40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a80 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
10a90 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 63 6f 76 :get-arg "-recov
10aa0 65 72 2d 74 65 73 74 22 29 0a 20 20 20 20 28 6c er-test"). (l
10ab0 65 74 2a 20 28 28 70 61 72 61 6d 73 20 28 73 74 et* ((params (st
10ac0 72 69 6e 67 2d 73 70 6c 69 74 20 28 61 72 67 73 ring-split (args
10ad0 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 63 6f 76 :get-arg "-recov
10ae0 65 72 2d 74 65 73 74 22 29 20 22 2c 22 29 29 29 er-test") ",")))
10af0 0a 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c . (if (> (l
10b00 65 6e 67 74 68 20 70 61 72 61 6d 73 29 20 31 29 ength params) 1)
10b10 20 3b 3b 20 72 75 6e 2d 69 64 20 61 6e 64 20 74 ;; run-id and t
10b20 65 73 74 2d 69 64 0a 09 20 20 28 6c 65 74 20 28 est-id.. (let (
10b30 28 72 75 6e 2d 69 64 20 28 73 74 72 69 6e 67 2d (run-id (string-
10b40 3e 6e 75 6d 62 65 72 20 28 63 61 72 20 70 61 72 >number (car par
10b50 61 6d 73 29 29 29 0a 09 09 28 74 65 73 74 2d 69 ams)))...(test-i
10b60 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 d (string->numbe
10b70 72 20 28 63 61 64 72 20 70 61 72 61 6d 73 29 29 r (cadr params))
10b80 29 29 0a 09 20 20 20 20 28 69 66 20 28 61 6e 64 )).. (if (and
10b90 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
10ba0 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 6c ...(begin... (l
10bb0 61 75 6e 63 68 3a 72 65 63 6f 76 65 72 2d 74 65 aunch:recover-te
10bc0 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
10bd0 64 29 0a 09 09 20 20 28 73 65 74 21 20 2a 64 69 d)... (set! *di
10be0 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
10bf0 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 64 ...(begin... (d
10c00 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
10c10 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
10c20 70 6f 72 74 2a 20 22 62 61 64 20 72 75 6e 2d 69 port* "bad run-i
10c30 64 20 6f 72 20 74 65 73 74 2d 69 64 2c 20 6d 75 d or test-id, mu
10c40 73 74 20 62 65 20 69 6e 74 65 67 65 72 73 22 29 st be integers")
10c50 0a 09 09 20 20 28 65 78 69 74 20 31 29 29 29 29 ... (exit 1))))
10c60 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
10c70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10ca0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
10cb0 20 54 65 73 74 20 63 6f 6d 6d 61 6e 64 73 20 28 Test commands (
10cc0 69 2e 65 2e 20 66 6f 72 20 75 73 65 20 69 6e 73 i.e. for use ins
10cd0 69 64 65 20 74 65 73 74 73 29 0a 3b 3b 3d 3d 3d ide tests).;;===
10ce0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10cf0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d20 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 6d 65 ===..(define (me
10d30 67 61 74 65 73 74 3a 73 74 65 70 20 73 74 65 70 gatest:step step
10d40 20 73 74 61 74 65 20 73 74 61 74 75 73 20 6c 6f state status lo
10d50 67 66 69 6c 65 20 6d 73 67 29 0a 20 20 28 69 66 gfile msg). (if
10d60 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 4d (not (getenv "M
10d70 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 20 20 20 T_CMDINFO")).
10d80 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 62 75 (begin..(debu
10d90 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
10da0 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
10db0 74 2a 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 t* "MT_CMDINFO e
10dc0 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 nv var not set,
10dd0 2d 73 74 65 70 20 6d 75 73 74 20 62 65 20 63 61 -step must be ca
10de0 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 lled *inside* a
10df0 6d 65 67 61 74 65 73 74 20 69 6e 76 6f 6b 65 64 megatest invoked
10e00 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a environment!").
10e10 09 28 65 78 69 74 20 35 29 29 0a 20 20 20 20 20 .(exit 5)).
10e20 20 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e 66 6f (let* ((cmdinfo
10e30 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d (common:read-
10e40 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 28 encoded-string (
10e50 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e getenv "MT_CMDIN
10e60 46 4f 22 29 29 29 0a 09 20 20 20 20 20 28 74 72 FO"))).. (tr
10e70 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f 64 ansport (assoc/d
10e80 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f 72 efault 'transpor
10e90 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
10ea0 20 20 28 74 65 73 74 70 61 74 68 20 20 28 61 73 (testpath (as
10eb0 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
10ec0 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 tpath cmdinfo))
10ed0 0a 09 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d .. (test-nam
10ee0 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 e (assoc/default
10ef0 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 'test-name cmdi
10f00 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 75 6e nfo)).. (run
10f10 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 script (assoc/de
10f20 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 fault 'runscript
10f30 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
10f40 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 (db-host (ass
10f50 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 oc/default 'db-h
10f60 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a ost cmdinfo)).
10f70 09 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 . (run-id
10f80 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
10f90 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 'run-id cmdin
10fa0 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 fo)).. (test
10fb0 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 65 66 -id (assoc/def
10fc0 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 20 20 ault 'test-id
10fd0 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
10fe0 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f (itemdat (asso
10ff0 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 c/default 'itemd
11000 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 at cmdinfo))..
11010 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 (work-area
11020 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
11030 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 66 work-area cmdinf
11040 6f 29 29 0a 09 20 20 20 20 20 28 64 62 20 20 20 o)).. (db
11050 20 20 20 20 20 23 66 29 29 0a 09 28 63 68 61 6e #f))..(chan
11060 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 ge-directory tes
11070 74 70 61 74 68 29 0a 09 28 69 66 20 28 6e 6f 74 tpath)..(if (not
11080 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 (launch:setup))
11090 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 .. (begin..
110a0 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
110b0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
110c0 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f port* "Failed to
110d0 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
110e0 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 20 31 ).. (exit 1
110f0 29 29 29 0a 09 28 69 66 20 28 61 6e 64 20 73 74 )))..(if (and st
11100 61 74 65 20 73 74 61 74 75 73 29 0a 09 20 20 20 ate status)..
11110 20 28 6c 65 74 20 28 28 63 6f 6d 6d 65 6e 74 20 (let ((comment
11120 28 6c 61 75 6e 63 68 3a 6c 6f 61 64 2d 6c 6f 67 (launch:load-log
11130 70 72 6f 2d 64 61 74 20 72 75 6e 2d 69 64 20 74 pro-dat run-id t
11140 65 73 74 2d 69 64 20 73 74 65 70 29 29 29 0a 09 est-id step)))..
11150 20 20 20 20 20 20 3b 3b 20 28 72 6d 74 3a 74 65 ;; (rmt:te
11160 73 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e 2d st-set-log! run-
11170 69 64 20 74 65 73 74 2d 69 64 20 28 63 6f 6e 63 id test-id (conc
11180 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c stepname ".html
11190 22 29 29 29 29 0a 09 20 20 20 20 20 20 28 72 6d ")))).. (rm
111a0 74 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 t:teststep-set-s
111b0 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 tatus! run-id te
111c0 73 74 2d 69 64 20 73 74 65 70 20 73 74 61 74 65 st-id step state
111d0 20 73 74 61 74 75 73 20 28 6f 72 20 63 6f 6d 6d status (or comm
111e0 65 6e 74 20 6d 73 67 29 20 6c 6f 67 66 69 6c 65 ent msg) logfile
111f0 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 )).. (begin..
11200 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
11210 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
11220 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 59 ult-log-port* "Y
11230 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 ou must specify
11240 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 :state and :stat
11250 75 73 20 77 69 74 68 20 65 76 65 72 79 20 63 61 us with every ca
11260 6c 6c 20 74 6f 20 2d 73 74 65 70 22 29 0a 09 20 ll to -step")..
11270 20 20 20 20 20 28 65 78 69 74 20 36 29 29 29 29 (exit 6))))
11280 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
11290 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a 20 t-arg "-step").
112a0 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
112b0 28 6d 65 67 61 74 65 73 74 3a 73 74 65 70 20 0a (megatest:step .
112c0 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 (args:get
112d0 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a 20 20 -arg "-step").
112e0 20 20 20 20 20 28 6f 72 20 28 61 72 67 73 3a 67 (or (args:g
112f0 65 74 2d 61 72 67 20 22 2d 73 74 61 74 65 22 29 et-arg "-state")
11300 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
11310 73 74 61 74 65 22 29 29 0a 20 20 20 20 20 20 20 state")).
11320 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
11330 67 20 22 2d 73 74 61 74 75 73 22 29 28 61 72 67 g "-status")(arg
11340 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
11350 75 73 22 29 29 0a 20 20 20 20 20 20 20 28 61 72 us")). (ar
11360 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
11370 6c 6f 67 22 29 0a 20 20 20 20 20 20 20 28 61 72 log"). (ar
11380 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
11390 29 0a 20 20 20 20 20 20 3b 3b 20 28 69 66 20 64 ). ;; (if d
113a0 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c b (sqlite3:final
113b0 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 20 20 ize! db)).
113c0 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
113d0 69 6e 67 2a 20 23 74 29 29 29 0a 20 20 20 20 0a ing* #t))). .
113e0 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
113f0 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 t-arg "-setlog")
11400 20 20 20 20 20 20 20 3b 3b 20 73 69 6e 63 65 20 ;; since
11410 73 65 74 74 69 6e 67 20 75 70 20 69 73 20 73 6f setting up is so
11420 20 63 6f 73 74 6c 79 20 6c 65 74 73 20 70 69 67 costly lets pig
11430 67 79 62 61 63 6b 20 6f 6e 20 2d 74 65 73 74 2d gyback on -test-
11440 73 74 61 74 75 73 0a 09 3b 3b 20 20 20 20 20 28 status..;; (
11450 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 not (args:get-ar
11460 67 20 22 2d 73 74 65 70 22 29 29 29 20 20 3b 3b g "-step"))) ;;
11470 20 2d 73 65 74 6c 6f 67 20 6d 61 79 20 68 61 76 -setlog may hav
11480 65 20 62 65 65 6e 20 70 72 6f 63 65 73 73 65 64 e been processed
11490 20 61 6c 72 65 61 64 79 20 69 6e 20 74 68 65 20 already in the
114a0 22 2d 73 74 65 70 22 20 70 72 65 76 69 6f 75 73 "-step" previous
114b0 0a 09 3b 3b 20 20 20 20 20 4e 45 57 20 50 4f 4c ..;; NEW POL
114c0 49 43 59 20 2d 20 2d 73 65 74 6c 6f 67 20 73 65 ICY - -setlog se
114d0 74 73 20 74 65 73 74 20 6f 76 65 72 61 6c 6c 20 ts test overall
114e0 6c 6f 67 20 6f 6e 20 65 76 65 72 79 20 63 61 6c log on every cal
114f0 6c 2e 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 l...(args:get-ar
11500 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 g "-set-toplog")
11510 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
11520 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a "-test-status").
11530 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
11540 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 0a 09 28 -set-values")..(
11550 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
11560 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a oad-test-data").
11570 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
11580 2d 72 75 6e 73 74 65 70 22 29 0a 09 28 61 72 67 -runstep")..(arg
11590 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d 6d s:get-arg "-summ
115a0 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 29 0a 20 arize-items")).
115b0 20 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 (if (not (get
115c0 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
115d0 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
115e0 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
115f0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
11600 70 6f 72 74 2a 20 22 4d 54 5f 43 4d 44 49 4e 46 port* "MT_CMDINF
11610 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 O env var not se
11620 74 2c 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 65 73 t, commands -tes
11630 74 2d 73 74 61 74 75 73 2c 20 2d 72 75 6e 73 74 t-status, -runst
11640 65 70 20 61 6e 64 20 2d 73 65 74 6c 6f 67 20 6d ep and -setlog m
11650 75 73 74 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 ust be called *i
11660 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 74 65 73 nside* a megates
11670 74 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 t environment!")
11680 0a 09 20 20 28 65 78 69 74 20 35 29 29 0a 09 28 .. (exit 5))..(
11690 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e 67 64 let* ((startingd
116a0 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 ir (current-dire
116b0 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 20 20 ctory))..
116c0 28 63 6d 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d (cmdinfo (comm
116d0 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d on:read-encoded-
116e0 73 74 72 69 6e 67 20 28 67 65 74 65 6e 76 20 22 string (getenv "
116f0 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 MT_CMDINFO")))..
11700 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 (transpor
11710 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
11720 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 'transport cmdi
11730 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
11740 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f estpath (assoc/
11750 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 default 'testpat
11760 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 h cmdinfo))..
11770 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 (test-name
11780 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
11790 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 test-name cmdinf
117a0 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
117b0 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 script (assoc/de
117c0 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 fault 'runscript
117d0 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
117e0 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 (db-host (a
117f0 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 ssoc/default 'db
11800 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 -host cmdinfo)
11810 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 ).. (run-i
11820 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 d (assoc/defa
11830 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 ult 'run-id c
11840 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
11850 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 73 73 (test-id (ass
11860 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
11870 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a -id cmdinfo)).
11880 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 . (itemdat
11890 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
118a0 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 t 'itemdat cmd
118b0 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
118c0 77 6f 72 6b 2d 61 72 65 61 20 28 61 73 73 6f 63 work-area (assoc
118d0 2f 64 65 66 61 75 6c 74 20 27 77 6f 72 6b 2d 61 /default 'work-a
118e0 72 65 61 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 rea cmdinfo))..
118f0 20 20 20 20 20 20 28 64 62 20 20 20 20 20 20 20 (db
11900 20 23 66 29 20 3b 3b 20 28 6f 70 65 6e 2d 64 62 #f) ;; (open-db
11910 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 )).. (stat
11920 65 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d e (args:get-
11930 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 arg ":state"))..
11940 20 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 (status
11950 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
11960 22 3a 73 74 61 74 75 73 22 29 29 0a 09 20 20 20 ":status"))..
11970 20 20 20 20 28 73 74 65 70 6e 61 6d 65 20 20 28 (stepname (
11980 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
11990 74 65 70 22 29 29 29 0a 09 20 20 28 69 66 20 28 tep"))).. (if (
119a0 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 not (launch:setu
119b0 70 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 p)).. (begi
119c0 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 n...(debug:print
119d0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
119e0 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f port* "Failed to
119f0 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
11a00 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 0a )...(exit 1)))..
11a10 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 . (if (args:get
11a20 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 -arg "-runstep")
11a30 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
11a40 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 1 *default-log
11a50 2d 70 6f 72 74 2a 20 22 52 75 6e 6e 69 6e 67 20 -port* "Running
11a60 2d 72 75 6e 73 74 65 70 2c 20 66 69 72 73 74 20 -runstep, first
11a70 63 68 61 6e 67 65 20 74 6f 20 64 69 72 65 63 74 change to direct
11a80 6f 72 79 20 22 20 77 6f 72 6b 2d 61 72 65 61 29 ory " work-area)
11a90 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 ).. (change-dir
11aa0 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 ectory work-area
11ab0 29 0a 09 20 20 3b 3b 20 63 61 6e 20 73 65 74 75 ).. ;; can setu
11ac0 70 20 61 73 20 63 6c 69 65 6e 74 20 66 6f 72 20 p as client for
11ad0 73 65 72 76 65 72 20 6d 6f 64 65 20 6e 6f 77 0a server mode now.
11ae0 09 20 20 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 65 . ;; (client:se
11af0 74 75 70 29 0a 0a 09 20 20 28 69 66 20 28 61 72 tup)... (if (ar
11b00 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 61 gs:get-arg "-loa
11b10 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a 09 20 d-test-data")..
11b20 20 20 20 20 20 3b 3b 20 68 61 73 20 73 75 62 20 ;; has sub
11b30 63 6f 6d 6d 61 6e 64 73 20 74 68 61 74 20 61 72 commands that ar
11b40 65 20 72 64 62 3a 0a 09 20 20 20 20 20 20 3b 3b e rdb:.. ;;
11b50 20 44 4f 20 4e 4f 54 20 70 75 74 20 74 68 69 73 DO NOT put this
11b60 20 6f 6e 65 20 69 6e 74 6f 20 65 69 74 68 65 72 one into either
11b70 20 72 6d 74 3a 20 6f 72 20 6f 70 65 6e 2d 72 75 rmt: or open-ru
11b80 6e 2d 63 6c 6f 73 65 0a 09 20 20 20 20 20 20 28 n-close.. (
11b90 74 64 62 3a 6c 6f 61 64 2d 74 65 73 74 2d 64 61 tdb:load-test-da
11ba0 74 61 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 ta run-id test-i
11bb0 64 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 d)).. (if (args
11bc0 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f :get-arg "-setlo
11bd0 67 22 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 g").. (let
11be0 28 28 6c 6f 67 66 6e 61 6d 65 20 28 61 72 67 73 ((logfname (args
11bf0 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f :get-arg "-setlo
11c00 67 22 29 29 29 0a 09 09 28 72 6d 74 3a 74 65 73 g")))...(rmt:tes
11c10 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 t-set-log! run-i
11c20 64 20 74 65 73 74 2d 69 64 20 6c 6f 67 66 6e 61 d test-id logfna
11c30 6d 65 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 me))).. (if (ar
11c40 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
11c50 2d 74 6f 70 6c 6f 67 22 29 0a 09 20 20 20 20 20 -toplog")..
11c60 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 ;; DO NOT run r
11c70 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 28 74 65 emote.. (te
11c80 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 sts:test-set-top
11c90 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 73 74 log! run-id test
11ca0 2d 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d -name (args:get-
11cb0 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 arg "-set-toplog
11cc0 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 "))).. (if (arg
11cd0 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d 6d s:get-arg "-summ
11ce0 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 0a 09 20 arize-items")..
11cf0 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 ;; DO NOT r
11d00 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 20 20 un remote..
11d10 20 28 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a (tests:summariz
11d20 65 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 e-items run-id t
11d30 65 73 74 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 est-id test-name
11d40 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 6f 72 63 #t)) ;; do forc
11d50 65 20 68 65 72 65 0a 09 20 20 28 69 66 20 28 61 e here.. (if (a
11d60 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
11d70 6e 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 28 nstep").. (
11d80 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 if (null? remarg
11d90 73 29 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 s)... (begin...
11da0 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
11db0 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
11dc0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6e 6f 74 t-log-port* "not
11dd0 68 69 6e 67 20 73 70 65 63 69 66 69 65 64 20 74 hing specified t
11de0 6f 20 72 75 6e 21 22 29 0a 09 09 20 20 20 20 28 o run!")... (
11df0 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 if db (sqlite3:f
11e00 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 09 inalize! db))...
11e10 20 20 20 20 28 65 78 69 74 20 36 29 29 0a 09 09 (exit 6))...
11e20 20 20 28 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 (let* ((stepna
11e30 6d 65 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 me (args:get-a
11e40 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 29 0a rg "-runstep")).
11e50 09 09 09 20 28 6c 6f 67 70 72 6f 66 69 6c 65 20 ... (logprofile
11e60 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11e70 6c 6f 67 70 72 6f 22 29 29 0a 09 09 09 20 28 6c logpro")).... (l
11e80 6f 67 66 69 6c 65 20 20 20 20 28 63 6f 6e 63 20 ogfile (conc
11e90 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 stepname ".log")
11ea0 29 0a 09 09 09 20 28 63 6d 64 20 20 20 20 20 20 ).... (cmd
11eb0 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d (if (null? rem
11ec0 61 72 67 73 29 20 23 66 20 28 63 61 72 20 72 65 args) #f (car re
11ed0 6d 61 72 67 73 29 29 29 0a 09 09 09 20 28 70 61 margs))).... (pa
11ee0 72 61 6d 73 20 20 20 20 20 28 69 66 20 63 6d 64 rams (if cmd
11ef0 20 28 63 64 72 20 72 65 6d 61 72 67 73 29 20 27 (cdr remargs) '
11f00 28 29 29 29 0a 09 09 09 20 28 65 78 69 74 73 74 ())).... (exitst
11f10 61 74 20 20 20 23 66 29 0a 09 09 09 20 28 73 68 at #f).... (sh
11f20 65 6c 6c 20 20 20 20 20 20 28 6c 65 74 20 28 28 ell (let ((
11f30 73 68 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d sh (get-environm
11f40 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 53 48 ent-variable "SH
11f50 45 4c 4c 22 29 20 29 29 0a 09 09 09 09 20 20 20 ELL") )).....
11f60 20 20 20 20 28 69 66 20 73 68 20 0a 09 09 09 09 (if sh .....
11f70 09 20 20 20 28 6c 61 73 74 20 28 73 74 72 69 6e . (last (strin
11f80 67 2d 73 70 6c 69 74 20 73 68 20 22 2f 22 29 29 g-split sh "/"))
11f90 0a 09 09 09 09 09 20 20 20 22 62 61 73 68 22 29 ...... "bash")
11fa0 29 29 0a 09 09 09 20 28 72 65 64 69 72 20 20 20 )).... (redir
11fb0 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 (case (string
11fc0 2d 3e 73 79 6d 62 6f 6c 20 73 68 65 6c 6c 29 0a ->symbol shell).
11fd0 09 09 09 09 20 20 20 20 20 20 20 28 28 74 63 73 .... ((tcs
11fe0 68 20 63 73 68 20 6b 73 68 29 20 20 20 20 22 3e h csh ksh) ">
11ff0 26 22 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 &")..... (
12000 28 7a 73 68 20 62 61 73 68 20 73 68 20 61 73 68 (zsh bash sh ash
12010 29 20 22 32 3e 26 31 20 3e 22 29 0a 09 09 09 09 ) "2>&1 >").....
12020 20 20 20 20 20 20 20 28 65 6c 73 65 20 22 3e 26 (else ">&
12030 22 29 29 29 0a 09 09 09 20 28 66 75 6c 6c 63 6d "))).... (fullcm
12040 64 20 20 20 20 28 63 6f 6e 63 20 22 28 22 20 28 d (conc "(" (
12050 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
12060 73 65 20 0a 09 09 09 09 09 09 28 63 6f 6e 73 20 se .......(cons
12070 63 6d 64 20 70 61 72 61 6d 73 29 20 22 20 22 29 cmd params) " ")
12080 0a 09 09 09 09 09 20 20 20 22 29 20 22 20 72 65 ...... ") " re
12090 64 69 72 20 22 20 22 20 6c 6f 67 66 69 6c 65 29 dir " " logfile)
120a0 29 29 0a 09 09 20 20 20 20 3b 3b 20 6d 61 72 6b ))... ;; mark
120b0 20 74 68 65 20 73 74 61 72 74 20 6f 66 20 74 68 the start of th
120c0 65 20 74 65 73 74 0a 09 09 20 20 20 20 28 72 6d e test... (rm
120d0 74 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 t:teststep-set-s
120e0 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 tatus! run-id te
120f0 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 st-id stepname "
12100 73 74 61 72 74 22 20 22 6e 2f 61 22 20 28 61 72 start" "n/a" (ar
12110 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
12120 20 6c 6f 67 66 69 6c 65 29 0a 09 09 20 20 20 20 logfile)...
12130 3b 3b 20 72 75 6e 20 74 68 65 20 74 65 73 74 20 ;; run the test
12140 73 74 65 70 0a 09 09 20 20 20 20 28 64 65 62 75 step... (debu
12150 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 2a g:print-info 2 *
12160 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
12170 2a 20 22 52 75 6e 6e 69 6e 67 20 5c 22 22 20 66 * "Running \"" f
12180 75 6c 6c 63 6d 64 20 22 5c 22 20 69 6e 20 64 69 ullcmd "\" in di
12190 72 65 63 74 6f 72 79 20 5c 22 22 20 73 74 61 72 rectory \"" star
121a0 74 69 6e 67 64 69 72 29 0a 09 09 20 20 20 20 28 tingdir)... (
121b0 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
121c0 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 09 startingdir)...
121d0 20 20 20 20 28 73 65 74 21 20 65 78 69 74 73 74 (set! exitst
121e0 61 74 20 28 73 79 73 74 65 6d 20 66 75 6c 6c 63 at (system fullc
121f0 6d 64 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 md))... (set!
12200 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 *globalexitstat
12210 75 73 2a 20 65 78 69 74 73 74 61 74 29 0a 09 09 us* exitstat)...
12220 20 20 20 20 3b 3b 20 28 63 68 61 6e 67 65 2d 64 ;; (change-d
12230 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
12240 68 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 h)... ;; run
12250 6c 6f 67 70 72 6f 20 69 66 20 61 70 70 6c 69 63 logpro if applic
12260 61 62 6c 65 20 3b 3b 20 28 70 72 6f 63 65 73 73 able ;; (process
12270 2d 72 75 6e 20 22 6c 73 22 20 28 6c 69 73 74 20 -run "ls" (list
12280 22 2f 66 6f 6f 22 20 22 32 3e 26 31 22 20 22 62 "/foo" "2>&1" "b
12290 6c 61 68 2e 6c 6f 67 22 29 29 0a 09 09 20 20 20 lah.log"))...
122a0 20 28 69 66 20 6c 6f 67 70 72 6f 66 69 6c 65 0a (if logprofile.
122b0 09 09 09 28 6c 65 74 2a 20 28 28 68 74 6d 6c 6c ...(let* ((htmll
122c0 6f 67 66 69 6c 65 20 28 63 6f 6e 63 20 73 74 65 ogfile (conc ste
122d0 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 0a pname ".html")).
122e0 09 09 09 20 20 20 20 20 20 20 28 6f 6c 64 65 78 ... (oldex
122f0 69 74 73 74 61 74 20 65 78 69 74 73 74 61 74 29 itstat exitstat)
12300 0a 09 09 09 20 20 20 20 20 20 20 28 63 6d 64 20 .... (cmd
12310 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d (string-
12320 69 6e 74 65 72 73 70 65 72 73 65 20 28 6c 69 73 intersperse (lis
12330 74 20 22 6c 6f 67 70 72 6f 22 20 6c 6f 67 70 72 t "logpro" logpr
12340 6f 66 69 6c 65 20 68 74 6d 6c 6c 6f 67 66 69 6c ofile htmllogfil
12350 65 20 22 3c 22 20 6c 6f 67 66 69 6c 65 20 22 3e e "<" logfile ">
12360 22 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 " (conc stepname
12370 20 22 5f 6c 6f 67 70 72 6f 2e 6c 6f 67 22 29 29 "_logpro.log"))
12380 20 22 20 22 29 29 29 0a 09 09 09 20 20 28 64 65 " "))).... (de
12390 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 bug:print-info 2
123a0 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
123b0 72 74 2a 20 22 72 75 6e 6e 69 6e 67 20 5c 22 22 rt* "running \""
123c0 20 63 6d 64 20 22 5c 22 22 29 0a 09 09 09 20 20 cmd "\"")....
123d0 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
123e0 79 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 y startingdir)..
123f0 09 09 20 20 28 73 65 74 21 20 65 78 69 74 73 74 .. (set! exitst
12400 61 74 20 28 73 79 73 74 65 6d 20 63 6d 64 29 29 at (system cmd))
12410 0a 09 09 09 20 20 28 73 65 74 21 20 2a 67 6c 6f .... (set! *glo
12420 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 65 balexitstatus* e
12430 78 69 74 73 74 61 74 29 20 3b 3b 20 6e 6f 20 6e xitstat) ;; no n
12440 65 63 65 73 73 61 72 79 0a 09 09 09 20 20 28 63 ecessary.... (c
12450 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
12460 74 65 73 74 70 61 74 68 29 0a 09 09 09 20 20 28 testpath).... (
12470 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 rmt:test-set-log
12480 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
12490 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 29 29 29 0a htmllogfile))).
124a0 09 09 20 20 20 20 28 6c 65 74 20 28 28 6d 73 67 .. (let ((msg
124b0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
124c0 2d 6d 22 29 29 29 0a 09 09 20 20 20 20 20 20 28 -m")))... (
124d0 72 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 74 rmt:teststep-set
124e0 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 -status! run-id
124f0 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 test-id stepname
12500 20 22 65 6e 64 22 20 65 78 69 74 73 74 61 74 20 "end" exitstat
12510 6d 73 67 20 6c 6f 67 66 69 6c 65 29 29 0a 09 09 msg logfile))...
12520 20 20 20 20 29 29 29 0a 09 20 20 28 69 66 20 28 ))).. (if (
12530 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
12540 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 "-test-status")
12550 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ... (args:get-a
12560 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 rg "-set-values"
12570 29 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 )).. (let (
12580 28 6e 65 77 73 74 61 74 75 73 20 28 63 6f 6e 64 (newstatus (cond
12590 0a 09 09 09 09 28 28 6e 75 6d 62 65 72 3f 20 73 .....((number? s
125a0 74 61 74 75 73 29 20 20 20 20 20 20 20 28 69 66 tatus) (if
125b0 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 20 (equal? status
125c0 30 29 20 22 50 41 53 53 22 20 22 46 41 49 4c 22 0) "PASS" "FAIL"
125d0 29 29 0a 09 09 09 09 28 28 61 6e 64 20 28 73 74 )).....((and (st
125e0 72 69 6e 67 3f 20 73 74 61 74 75 73 29 0a 09 09 ring? status)...
125f0 09 09 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d .. (string-
12600 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 73 29 29 >number status))
12610 28 69 66 20 28 65 71 75 61 6c 3f 20 28 73 74 72 (if (equal? (str
12620 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 61 74 ing->number stat
12630 75 73 29 20 30 29 20 22 50 41 53 53 22 20 22 46 us) 0) "PASS" "F
12640 41 49 4c 22 29 29 0a 09 09 09 09 28 65 6c 73 65 AIL")).....(else
12650 20 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 20 status)))...
12660 20 3b 3b 20 74 72 61 6e 73 66 65 72 20 72 65 6c ;; transfer rel
12670 65 76 61 6e 74 20 6b 65 79 73 20 69 6e 74 6f 20 evant keys into
12680 61 20 68 61 73 68 20 74 6f 20 62 65 20 70 61 73 a hash to be pas
12690 73 65 64 20 74 6f 20 74 65 73 74 2d 73 65 74 2d sed to test-set-
126a0 73 74 61 74 75 73 21 0a 09 09 20 20 20 20 3b 3b status!... ;;
126b0 20 63 6f 75 6c 64 20 75 73 65 20 61 6e 20 61 73 could use an as
126c0 73 6f 63 20 6c 69 73 74 20 49 20 67 75 65 73 73 soc list I guess
126d0 2e 20 0a 09 09 20 20 20 20 28 6f 74 68 65 72 64 . ... (otherd
126e0 61 74 61 20 28 6c 65 74 20 28 28 72 65 73 20 28 ata (let ((res (
126f0 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
12700 29 29 0a 09 09 09 09 20 28 66 6f 72 2d 65 61 63 ))..... (for-eac
12710 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a h (lambda (key).
12720 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 61 ..... (if (a
12730 72 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 79 29 rgs:get-arg key)
12740 0a 09 09 09 09 09 09 20 28 68 61 73 68 2d 74 61 ....... (hash-ta
12750 62 6c 65 2d 73 65 74 21 20 72 65 73 20 6b 65 79 ble-set! res key
12760 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 6b (args:get-arg k
12770 65 79 29 29 29 29 0a 09 09 09 09 09 20 20 20 28 ey))))...... (
12780 6c 69 73 74 20 22 3a 76 61 6c 75 65 22 20 22 3a list ":value" ":
12790 74 6f 6c 22 20 22 3a 65 78 70 65 63 74 65 64 22 tol" ":expected"
127a0 20 22 3a 66 69 72 73 74 5f 65 72 72 22 20 22 3a ":first_err" ":
127b0 66 69 72 73 74 5f 77 61 72 6e 22 20 22 3a 75 6e first_warn" ":un
127c0 69 74 73 22 20 22 3a 63 61 74 65 67 6f 72 79 22 its" ":category"
127d0 20 22 3a 76 61 72 69 61 62 6c 65 22 29 29 0a 09 ":variable"))..
127e0 09 09 09 20 72 65 73 29 29 29 0a 09 09 28 69 66 ... res)))...(if
127f0 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d (and (args:get-
12800 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 arg "-test-statu
12810 73 22 29 0a 09 09 09 20 28 6f 72 20 28 6e 6f 74 s").... (or (not
12820 20 73 74 61 74 65 29 0a 09 09 09 20 20 20 20 20 state)....
12830 28 6e 6f 74 20 73 74 61 74 75 73 29 29 29 0a 09 (not status)))..
12840 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 . (begin...
12850 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
12860 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
12870 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 59 6f 75 t-log-port* "You
12880 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 3a 73 must specify :s
12890 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 tate and :status
128a0 20 77 69 74 68 20 65 76 65 72 79 20 63 61 6c 6c with every call
128b0 20 74 6f 20 2d 74 65 73 74 2d 73 74 61 74 75 73 to -test-status
128c0 5c 6e 22 20 68 65 6c 70 29 0a 09 09 20 20 20 20 \n" help)...
128d0 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 3a 64 (if (sqlite3:d
128e0 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 71 6c atabase? db)(sql
128f0 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
12900 62 29 29 0a 09 09 20 20 20 20 20 20 28 65 78 69 b))... (exi
12910 74 20 36 29 29 29 0a 09 09 28 6c 65 74 2a 20 28 t 6)))...(let* (
12920 28 6d 73 67 20 20 20 20 28 61 72 67 73 3a 67 65 (msg (args:ge
12930 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 20 t-arg "-m"))...
12940 20 20 20 20 20 20 28 6e 75 6d 6f 74 68 20 28 6c (numoth (l
12950 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 6c ength (hash-tabl
12960 65 2d 6b 65 79 73 20 6f 74 68 65 72 64 61 74 61 e-keys otherdata
12970 29 29 29 29 0a 09 09 20 20 3b 3b 20 43 6f 6e 76 ))))... ;; Conv
12980 65 72 74 20 74 6f 20 72 70 63 20 69 6e 73 69 64 ert to rpc insid
12990 65 20 74 68 65 20 74 65 73 74 73 3a 74 65 73 74 e the tests:test
129a0 2d 73 65 74 2d 73 74 61 74 75 73 21 20 63 61 6c -set-status! cal
129b0 6c 2c 20 6e 6f 74 20 68 65 72 65 0a 09 09 20 20 l, not here...
129c0 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d (tests:test-set-
129d0 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
129e0 65 73 74 2d 69 64 20 73 74 61 74 65 20 6e 65 77 est-id state new
129f0 73 74 61 74 75 73 20 6d 73 67 20 6f 74 68 65 72 status msg other
12a00 64 61 74 61 20 77 6f 72 6b 2d 61 72 65 61 3a 20 data work-area:
12a10 77 6f 72 6b 2d 61 72 65 61 29 29 29 29 0a 09 20 work-area))))..
12a20 20 28 69 66 20 28 73 71 6c 69 74 65 33 3a 64 61 (if (sqlite3:da
12a30 74 61 62 61 73 65 3f 20 64 62 29 28 73 71 6c 69 tabase? db)(sqli
12a40 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
12a50 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 )).. (set! *did
12a60 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
12a70 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
12a80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12aa0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ab0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 56 ===========.;; V
12ac0 61 72 69 6f 75 73 20 68 65 6c 70 65 72 20 63 6f arious helper co
12ad0 6d 6d 61 6e 64 73 20 63 61 6e 20 67 6f 20 62 65 mmands can go be
12ae0 6c 6f 77 20 68 65 72 65 0a 3b 3b 3d 3d 3d 3d 3d low here.;;=====
12af0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b30 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 =..(if (or (args
12b40 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 6b :get-arg "-showk
12b50 65 79 73 22 29 0a 20 20 20 20 20 20 20 20 28 61 eys"). (a
12b60 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 rgs:get-arg "-sh
12b70 6f 77 2d 6b 65 79 73 22 29 29 0a 20 20 20 20 28 ow-keys")). (
12b80 6c 65 74 20 28 28 64 62 20 23 66 29 0a 09 20 20 let ((db #f)..
12b90 28 6b 65 79 73 20 23 66 29 29 0a 20 20 20 20 20 (keys #f)).
12ba0 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 (if (not (launc
12bb0 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 65 h:setup)).. (be
12bc0 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a gin.. (debug:
12bd0 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
12be0 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c -log-port* "Fail
12bf0 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
12c00 74 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 69 ting").. (exi
12c10 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 73 65 t 1))). (se
12c20 74 21 20 6b 65 79 73 20 28 72 6d 74 3a 67 65 74 t! keys (rmt:get
12c30 2d 6b 65 79 73 29 29 20 3b 3b 20 20 64 62 29 29 -keys)) ;; db))
12c40 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
12c50 69 6e 74 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c int 1 *default-l
12c60 6f 67 2d 70 6f 72 74 2a 20 22 4b 65 79 73 3a 20 og-port* "Keys:
12c70 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 " (string-inters
12c80 70 65 72 73 65 20 6b 65 79 73 20 22 2c 20 22 29 perse keys ", ")
12c90 29 0a 20 20 20 20 20 20 28 69 66 20 28 73 71 6c ). (if (sql
12ca0 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 64 ite3:database? d
12cb0 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c b)(sqlite3:final
12cc0 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 20 20 ize! db)).
12cd0 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
12ce0 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
12cf0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
12d00 67 75 69 22 29 0a 20 20 20 20 28 62 65 67 69 6e gui"). (begin
12d10 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
12d20 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
12d30 6f 67 2d 70 6f 72 74 2a 20 22 4c 6f 6f 6b 20 61 og-port* "Look a
12d40 74 20 74 68 65 20 64 61 73 68 62 6f 61 72 64 20 t the dashboard
12d50 66 6f 72 20 6e 6f 77 22 29 0a 20 20 20 20 20 20 for now").
12d60 3b 3b 20 28 6d 65 67 61 74 65 73 74 2d 67 75 69 ;; (megatest-gui
12d70 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
12d80 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
12d90 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
12da0 74 2d 61 72 67 20 22 2d 63 72 65 61 74 65 2d 6d t-arg "-create-m
12db0 65 67 61 74 65 73 74 2d 61 72 65 61 22 29 0a 20 egatest-area").
12dc0 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
12dd0 28 67 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d (genexample:mk-m
12de0 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 29 0a egatest.config).
12df0 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
12e00 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
12e10 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
12e20 61 72 67 20 22 2d 63 72 65 61 74 65 2d 74 65 73 arg "-create-tes
12e30 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 t"). (let ((t
12e40 65 73 74 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 estname (args:ge
12e50 74 2d 61 72 67 20 22 2d 63 72 65 61 74 65 2d 74 t-arg "-create-t
12e60 65 73 74 22 29 29 29 0a 20 20 20 20 20 20 28 67 est"))). (g
12e70 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 enexample:mk-meg
12e80 61 74 65 73 74 2d 74 65 73 74 20 74 65 73 74 6e atest-test testn
12e90 61 6d 65 29 0a 20 20 20 20 20 20 28 73 65 74 21 ame). (set!
12ea0 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
12eb0 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d #t)))..;;=======
12ec0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ed0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ee0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ef0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
12f00 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 64 61 ;; Update the da
12f10 74 61 62 61 73 65 20 73 63 68 65 6d 61 2c 20 63 tabase schema, c
12f20 6c 65 61 6e 20 75 70 20 74 68 65 20 64 62 0a 3b lean up the db.;
12f30 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
12f40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f70 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
12f80 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 62 gs:get-arg "-reb
12f90 75 69 6c 64 2d 64 62 22 29 0a 20 20 20 20 28 62 uild-db"). (b
12fa0 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 egin. (if (
12fb0 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 not (launch:setu
12fc0 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 p)).. (begin..
12fd0 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
12fe0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
12ff0 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 ort* "Failed to
13000 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 setup, exiting")
13010 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 .. (exit 1))
13020 29 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 ). ;; keep
13030 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 this one local.
13040 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
13050 6c 6f 73 65 20 70 61 74 63 68 2d 64 62 20 23 66 lose patch-db #f
13060 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
13070 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
13080 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
13090 74 2d 61 72 67 20 22 2d 63 6c 65 61 6e 75 70 2d t-arg "-cleanup-
130a0 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a db"). (begin.
130b0 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
130c0 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 launch:setup))..
130d0 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 (begin.. (d
130e0 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
130f0 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
13100 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 "Failed to setup
13110 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 , exiting") ..
13120 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 (exit 1))).
13130 20 20 20 28 63 6f 6d 6d 6f 6e 3a 63 6c 65 61 6e (common:clean
13140 75 70 2d 64 62 29 0a 20 20 20 20 20 20 28 73 65 up-db). (se
13150 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
13160 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 * #t)))..(if (ar
13170 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 61 72 gs:get-arg "-mar
13180 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 22 29 0a k-incompletes").
13190 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
131a0 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 (if (not (launc
131b0 68 3a 73 65 74 75 70 29 29 0a 09 20 20 28 62 65 h:setup)).. (be
131c0 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a gin.. (debug:
131d0 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
131e0 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c -log-port* "Fail
131f0 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
13200 74 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 69 ting").. (exi
13210 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 6f 70 t 1))). (op
13220 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a en-run-close db:
13230 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e find-and-mark-in
13240 63 6f 6d 70 6c 65 74 65 20 23 66 29 0a 20 20 20 complete #f).
13250 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
13260 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b ething* #t)))..;
13270 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
13280 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13290 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
132a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
132b0 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 =======.;; Updat
132c0 65 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 61 e the tests meta
132d0 20 64 61 74 61 20 66 72 6f 6d 20 74 68 65 20 74 data from the t
132e0 65 73 74 63 6f 6e 66 69 67 20 66 69 6c 65 73 0a estconfig files.
132f0 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
13300 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13310 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13320 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13330 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
13340 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 70 rgs:get-arg "-up
13350 64 61 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 20 date-meta").
13360 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 (begin. (if
13370 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
13380 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a tup)).. (begin.
13390 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
133a0 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
133b0 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 -port* "Failed t
133c0 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
133d0 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 ") .. (exit 1
133e0 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6e 6f 77 ))). ;; now
133f0 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 64 62 can find our db
13400 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 . ;; keep t
13410 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 his one local.
13420 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c (open-run-cl
13430 6f 73 65 20 72 75 6e 73 3a 75 70 64 61 74 65 2d ose runs:update-
13440 61 6c 6c 2d 74 65 73 74 5f 6d 65 74 61 20 23 66 all-test_meta #f
13450 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
13460 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
13470 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
13480 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13490 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
134a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
134b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
134c0 53 74 61 72 74 20 61 20 72 65 70 6c 0a 3b 3b 3d Start a repl.;;=
134d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
134e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
134f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13500 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13510 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 66 61 6b 65 6f 75 =====..;; fakeou
13520 74 20 72 65 61 64 6c 69 6e 65 0a 28 69 6e 63 6c t readline.(incl
13530 75 64 65 20 22 72 65 61 64 6c 69 6e 65 2d 66 69 ude "readline-fi
13540 78 2e 73 63 6d 22 29 0a 0a 28 69 66 20 28 6f 72 x.scm")..(if (or
13550 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e (getenv "MT_RUN
13560 53 43 52 49 50 54 22 29 0a 09 28 61 72 67 73 3a SCRIPT")..(args:
13570 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 29 get-arg "-repl")
13580 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
13590 22 2d 6c 6f 61 64 22 29 29 0a 20 20 20 20 28 6c "-load")). (l
135a0 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 6c et* ((toppath (l
135b0 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 aunch:setup))..
135c0 20 20 28 64 62 73 74 72 75 63 74 20 28 69 66 20 (dbstruct (if
135d0 74 6f 70 70 61 74 68 20 28 6d 61 6b 65 2d 64 62 toppath (make-db
135e0 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 68 3a r:dbstruct path:
135f0 20 74 6f 70 70 61 74 68 20 6c 6f 63 61 6c 3a 20 toppath local:
13600 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
13610 6c 6f 63 61 6c 22 29 29 20 23 66 29 29 29 0a 20 local")) #f))).
13620 20 20 20 20 20 28 69 66 20 64 62 73 74 72 75 63 (if dbstruc
13630 74 0a 09 20 20 28 63 6f 6e 64 0a 09 20 20 20 28 t.. (cond.. (
13640 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 53 (getenv "MT_RUNS
13650 43 52 49 50 54 22 29 0a 09 20 20 20 20 3b 3b 20 CRIPT").. ;;
13660 48 6f 77 20 74 6f 20 72 75 6e 20 6d 65 67 61 74 How to run megat
13670 65 73 74 20 73 63 72 69 70 74 73 0a 09 20 20 20 est scripts..
13680 20 3b 3b 0a 09 20 20 20 20 3b 3b 20 23 21 2f 62 ;;.. ;; #!/b
13690 69 6e 2f 62 61 73 68 0a 09 20 20 20 20 3b 3b 0a in/bash.. ;;.
136a0 09 20 20 20 20 3b 3b 20 65 78 70 6f 72 74 20 4d . ;; export M
136b0 54 5f 52 55 4e 53 43 52 49 50 54 3d 79 65 73 0a T_RUNSCRIPT=yes.
136c0 09 20 20 20 20 3b 3b 20 6d 65 67 61 74 65 73 74 . ;; megatest
136d0 20 3c 3c 20 45 4f 46 0a 09 20 20 20 20 3b 3b 20 << EOF.. ;;
136e0 28 70 72 69 6e 74 20 22 48 65 6c 6c 6f 20 77 6f (print "Hello wo
136f0 72 6c 64 22 29 0a 09 20 20 20 20 3b 3b 20 28 65 rld").. ;; (e
13700 78 69 74 29 0a 09 20 20 20 20 3b 3b 20 45 4f 46 xit).. ;; EOF
13710 0a 0a 09 20 20 20 20 28 72 65 70 6c 29 29 0a 09 ... (repl))..
13720 20 20 20 28 65 6c 73 65 0a 09 20 20 20 20 28 62 (else.. (b
13730 65 67 69 6e 0a 09 20 20 20 20 20 20 28 73 65 74 egin.. (set
13740 21 20 2a 64 62 2a 20 64 62 73 74 72 75 63 74 29 ! *db* dbstruct)
13750 0a 09 20 20 20 20 20 20 28 73 65 74 21 20 2a 63 .. (set! *c
13760 6c 69 65 6e 74 2d 6e 6f 6e 2d 62 6c 6f 63 6b 69 lient-non-blocki
13770 6e 67 2d 6d 6f 64 65 2a 20 23 74 29 0a 09 20 20 ng-mode* #t)..
13780 20 20 20 20 28 69 6d 70 6f 72 74 20 65 78 74 72 (import extr
13790 61 73 29 20 3b 3b 20 6d 69 67 68 74 20 6e 6f 74 as) ;; might not
137a0 20 62 65 20 6e 65 65 64 65 64 0a 09 20 20 20 20 be needed..
137b0 20 20 3b 3b 20 28 69 6d 70 6f 72 74 20 63 73 69 ;; (import csi
137c0 29 0a 09 20 20 20 20 20 20 28 69 6d 70 6f 72 74 ).. (import
137d0 20 72 65 61 64 6c 69 6e 65 29 0a 09 20 20 20 20 readline)..
137e0 20 20 28 69 6d 70 6f 72 74 20 61 70 72 6f 70 6f (import apropo
137f0 73 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 69 6d s).. ;; (im
13800 70 6f 72 74 20 28 70 72 65 66 69 78 20 73 71 6c port (prefix sql
13810 69 74 65 33 20 73 71 6c 69 74 65 33 3a 29 29 20 ite3 sqlite3:))
13820 3b 3b 20 64 6f 65 73 6e 27 74 20 77 6f 72 6b 20 ;; doesn't work
13830 2e 2e 2e 0a 0a 09 20 20 20 20 20 20 28 69 66 20 ...... (if
13840 2a 75 73 65 2d 6e 65 77 2d 72 65 61 64 6c 69 6e *use-new-readlin
13850 65 2a 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 e*... (begin...
13860 20 20 20 20 28 69 6e 73 74 61 6c 6c 2d 68 69 73 (install-his
13870 74 6f 72 79 2d 66 69 6c 65 20 28 67 65 74 2d 65 tory-file (get-e
13880 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
13890 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2e 6d 65 ble "HOME") ".me
138a0 67 61 74 65 73 74 5f 68 69 73 74 6f 72 79 22 29 gatest_history")
138b0 20 3b 3b 20 20 5b 68 6f 6d 65 64 69 72 5d 20 5b ;; [homedir] [
138c0 66 69 6c 65 6e 61 6d 65 5d 20 5b 6e 6c 69 6e 65 filename] [nline
138d0 73 5d 29 0a 09 09 20 20 20 20 28 63 75 72 72 65 s])... (curre
138e0 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 20 28 6d nt-input-port (m
138f0 61 6b 65 2d 72 65 61 64 6c 69 6e 65 2d 70 6f 72 ake-readline-por
13900 74 20 22 6d 65 67 61 74 65 73 74 3e 20 22 29 29 t "megatest> "))
13910 29 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 )... (begin...
13920 20 20 20 28 67 6e 75 2d 68 69 73 74 6f 72 79 2d (gnu-history-
13930 69 6e 73 74 61 6c 6c 2d 66 69 6c 65 2d 6d 61 6e install-file-man
13940 61 67 65 72 0a 09 09 20 20 20 20 20 28 73 74 72 ager... (str
13950 69 6e 67 2d 61 70 70 65 6e 64 0a 09 09 20 20 20 ing-append...
13960 20 20 20 28 6f 72 20 28 67 65 74 2d 65 6e 76 69 (or (get-envi
13970 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
13980 20 22 48 4f 4d 45 22 29 20 22 2e 22 29 20 22 2f "HOME") ".") "/
13990 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 74 6f 72 .megatest_histor
139a0 79 22 29 29 0a 09 09 20 20 20 20 28 63 75 72 72 y"))... (curr
139b0 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 20 28 ent-input-port (
139c0 6d 61 6b 65 2d 67 6e 75 2d 72 65 61 64 6c 69 6e make-gnu-readlin
139d0 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 65 73 74 e-port "megatest
139e0 3e 20 22 29 29 29 29 0a 09 20 20 20 20 20 20 28 > ")))).. (
139f0 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
13a00 20 22 2d 72 65 70 6c 22 29 0a 09 09 20 20 28 72 "-repl")... (r
13a10 65 70 6c 29 0a 09 09 20 20 28 6c 6f 61 64 20 28 epl)... (load (
13a20 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
13a30 6f 61 64 22 29 29 29 0a 09 20 20 20 20 20 20 28 oad"))).. (
13a40 64 62 3a 63 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 db:close-all dbs
13a50 74 72 75 63 74 29 29 0a 09 20 20 20 20 28 65 78 truct)).. (ex
13a60 69 74 29 29 29 0a 09 20 20 28 73 65 74 21 20 2a it))).. (set! *
13a70 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
13a80 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
13a90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13aa0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ab0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ac0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
13ad0 3b 20 57 61 69 74 20 6f 6e 20 61 20 72 75 6e 20 ; Wait on a run
13ae0 74 6f 20 63 6f 6d 70 6c 65 74 65 0a 3b 3b 3d 3d to complete.;;==
13af0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b30 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 6e 64 20 28 ====..(if (and (
13b40 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
13b50 75 6e 2d 77 61 69 74 22 29 0a 09 20 28 6e 6f 74 un-wait").. (not
13b60 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
13b70 72 67 20 22 2d 72 75 6e 22 29 0a 09 09 20 20 28 rg "-run")... (
13b80 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
13b90 75 6e 74 65 73 74 73 22 29 29 29 29 20 3b 3b 20 untests")))) ;;
13ba0 72 75 6e 2d 77 61 69 74 20 69 73 20 62 75 69 6c run-wait is buil
13bb0 74 20 69 6e 74 6f 20 72 75 6e 74 65 73 74 73 20 t into runtests
13bc0 6e 6f 77 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 now. (begin.
13bd0 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c (if (not (l
13be0 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 aunch:setup))..
13bf0 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 (begin.. (de
13c00 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
13c10 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
13c20 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
13c30 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 exiting") ..
13c40 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 (exit 1))).
13c50 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 72 (operate-on 'r
13c60 75 6e 2d 77 61 69 74 29 0a 20 20 20 20 20 20 28 un-wait). (
13c70 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
13c80 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 3b 3b ng* #t)))..;; ;;
13c90 20 3b 3b 20 72 65 64 6f 20 6d 65 20 3b 3b 20 4e ;; redo me ;; N
13ca0 6f 74 20 63 6f 6e 76 65 72 74 65 64 20 74 6f 20 ot converted to
13cb0 75 73 65 20 64 62 73 74 72 75 63 74 20 79 65 74 use dbstruct yet
13cc0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
13cd0 65 20 3b 3b 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 e ;;.;; ;; ;; re
13ce0 64 6f 20 6d 65 20 28 69 66 20 28 61 72 67 73 3a do me (if (args:
13cf0 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e 76 65 72 get-arg "-conver
13d00 74 2d 74 6f 2d 6e 6f 72 6d 22 29 0a 3b 3b 20 3b t-to-norm").;; ;
13d10 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 ; ;; redo me
13d20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 (let* ((toppath
13d30 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 (setup-for-run)
13d40 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
13d50 6d 65 20 09 20 20 20 28 64 62 73 74 72 75 63 74 me . (dbstruct
13d60 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 6d 61 (if toppath (ma
13d70 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 ke-dbr:dbstruct
13d80 70 61 74 68 3a 20 74 6f 70 70 61 74 68 20 6c 6f path: toppath lo
13d90 63 61 6c 3a 20 23 74 29 29 29 29 0a 3b 3b 20 3b cal: #t)))).;; ;
13da0 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 ; ;; redo me
13db0 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 3b 3b (for-each .;;
13dc0 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 ;; ;; redo me
13dd0 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 (lambda (f
13de0 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 ield).;; ;; ;; r
13df0 65 64 6f 20 6d 65 20 09 20 28 6c 65 74 20 28 28 edo me . (let ((
13e00 64 61 74 20 27 28 29 29 29 0a 3b 3b 20 3b 3b 20 dat '())).;; ;;
13e10 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 ;; redo me . (
13e20 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
13e30 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
13e40 70 6f 72 74 2a 20 22 47 65 74 74 69 6e 67 20 64 port* "Getting d
13e50 61 74 61 20 66 6f 72 20 66 69 65 6c 64 20 22 20 ata for field "
13e60 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 field).;; ;; ;;
13e70 72 65 64 6f 20 6d 65 20 09 20 20 20 28 73 71 6c redo me . (sql
13e80 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
13e90 77 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 w.;; ;; ;; redo
13ea0 6d 65 20 09 20 20 20 20 28 6c 61 6d 62 64 61 20 me . (lambda
13eb0 28 69 64 20 76 61 6c 29 0a 3b 3b 20 3b 3b 20 3b (id val).;; ;; ;
13ec0 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 ; redo me .
13ed0 20 28 73 65 74 21 20 64 61 74 20 28 63 6f 6e 73 (set! dat (cons
13ee0 20 28 6c 69 73 74 20 69 64 20 76 61 6c 29 20 64 (list id val) d
13ef0 61 74 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 at))).;; ;; ;; r
13f00 65 64 6f 20 6d 65 20 09 20 20 20 20 28 64 62 3a edo me . (db:
13f10 67 65 74 2d 64 62 20 64 62 20 72 75 6e 2d 69 64 get-db db run-id
13f20 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
13f30 6d 65 20 09 20 20 20 20 28 63 6f 6e 63 20 22 53 me . (conc "S
13f40 45 4c 45 43 54 20 69 64 2c 22 20 66 69 65 6c 64 ELECT id," field
13f50 20 22 20 46 52 4f 4d 20 74 65 73 74 73 3b 22 29 " FROM tests;")
13f60 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
13f70 6d 65 20 09 20 20 20 28 64 65 62 75 67 3a 70 72 me . (debug:pr
13f80 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
13f90 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 ult-log-port* "f
13fa0 6f 75 6e 64 20 22 20 28 6c 65 6e 67 74 68 20 64 ound " (length d
13fb0 61 74 29 20 22 20 69 74 65 6d 73 20 66 6f 72 20 at) " items for
13fc0 66 69 65 6c 64 20 22 20 66 69 65 6c 64 29 0a 3b field " field).;
13fd0 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
13fe0 09 20 20 20 28 6c 65 74 20 28 28 71 72 79 20 28 . (let ((qry (
13ff0 73 71 6c 69 74 65 33 3a 70 72 65 70 61 72 65 20 sqlite3:prepare
14000 64 62 20 28 63 6f 6e 63 20 22 55 50 44 41 54 45 db (conc "UPDATE
14010 20 74 65 73 74 73 20 53 45 54 20 22 20 66 69 65 tests SET " fie
14020 6c 64 20 22 3d 3f 20 57 48 45 52 45 20 69 64 3d ld "=? WHERE id=
14030 3f 3b 22 29 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b ?;")))).;; ;; ;;
14040 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 28 redo me . (
14050 66 6f 72 2d 65 61 63 68 0a 3b 3b 20 3b 3b 20 3b for-each.;; ;; ;
14060 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 20 20 ; redo me .
14070 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a (lambda (item).
14080 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
14090 20 09 09 28 6c 65 74 20 28 28 6e 65 77 76 61 6c ..(let ((newval
140a0 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 67 65 ;; (sdb:qry 'ge
140b0 74 69 64 20 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 tid .;; ;; ;; re
140c0 64 6f 20 6d 65 20 09 09 20 20 20 20 20 20 20 28 do me .. (
140d0 63 61 64 72 20 69 74 65 6d 29 29 29 20 3b 3b 20 cadr item))) ;;
140e0 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
140f0 6d 65 20 09 09 20 20 28 69 66 20 28 6e 6f 74 20 me .. (if (not
14100 28 65 71 75 61 6c 3f 20 6e 65 77 76 61 6c 20 28 (equal? newval (
14110 63 61 64 72 20 69 74 65 6d 29 29 29 0a 3b 3b 20 cadr item))).;;
14120 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 ;; ;; redo me ..
14130 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
14140 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
14150 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 6f lt-log-port* "Co
14160 6e 76 65 72 74 69 6e 67 20 22 20 28 63 61 64 72 nverting " (cadr
14170 20 69 74 65 6d 29 20 22 20 74 6f 20 22 20 6e 65 item) " to " ne
14180 77 76 61 6c 20 22 20 66 6f 72 20 74 65 73 74 20 wval " for test
14190 23 22 20 28 63 61 72 20 69 74 65 6d 29 29 29 0a #" (car item))).
141a0 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
141b0 20 09 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 .. (sqlite3:ex
141c0 65 63 75 74 65 20 71 72 79 20 6e 65 77 76 61 6c ecute qry newval
141d0 20 28 63 61 72 20 69 74 65 6d 29 29 29 29 0a 3b (car item)))).;
141e0 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
141f0 09 20 20 20 20 20 20 64 61 74 29 0a 3b 3b 20 3b . dat).;; ;
14200 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 ; ;; redo me .
14210 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 (sqlite3:fina
14220 6c 69 7a 65 21 20 71 72 79 29 29 29 29 0a 3b 3b lize! qry)))).;;
14230 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 ;; ;; redo me
14240 20 20 20 20 20 20 28 64 62 3a 63 6c 6f 73 65 2d (db:close-
14250 61 6c 6c 20 64 62 73 74 72 75 63 74 29 0a 3b 3b all dbstruct).;;
14260 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 ;; ;; redo me
14270 20 20 20 20 20 20 28 6c 69 73 74 20 22 75 6e 61 (list "una
14280 6d 65 22 20 22 72 75 6e 64 69 72 22 20 22 66 69 me" "rundir" "fi
14290 6e 61 6c 5f 6c 6f 67 66 22 20 22 63 6f 6d 6d 65 nal_logf" "comme
142a0 6e 74 22 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 nt")).;; ;; ;; r
142b0 65 64 6f 20 6d 65 20 20 20 20 20 20 20 28 73 65 edo me (se
142c0 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
142d0 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 * #t)))..(if (ar
142e0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 6d 70 gs:get-arg "-imp
142f0 6f 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 ort-megatest.db"
14300 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
14310 20 20 20 28 64 62 3a 6d 75 6c 74 69 2d 64 62 2d (db:multi-db-
14320 73 79 6e 63 20 0a 20 20 20 20 20 20 20 23 66 20 sync . #f
14330 3b 3b 20 64 6f 20 61 6c 6c 20 72 75 6e 2d 69 64 ;; do all run-id
14340 73 0a 20 20 20 20 20 20 20 27 6b 69 6c 6c 73 65 s. 'killse
14350 72 76 65 72 73 0a 20 20 20 20 20 20 20 27 64 65 rvers. 'de
14360 6a 75 6e 6b 0a 20 20 20 20 20 20 20 27 61 64 6a junk. 'adj
14370 2d 74 65 73 74 69 64 73 0a 20 20 20 20 20 20 20 -testids.
14380 27 6f 6c 64 32 6e 65 77 0a 20 20 20 20 20 20 20 'old2new.
14390 3b 3b 20 27 6e 65 77 32 6f 6c 64 0a 20 20 20 20 ;; 'new2old.
143a0 20 20 20 29 0a 20 20 20 20 20 20 28 73 65 74 21 ). (set!
143b0 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
143c0 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 #t)))..(if (args
143d0 3a 67 65 74 2d 61 72 67 20 22 2d 73 79 6e 63 2d :get-arg "-sync-
143e0 74 6f 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 29 to-megatest.db")
143f0 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
14400 20 20 28 64 62 3a 6d 75 6c 74 69 2d 64 62 2d 73 (db:multi-db-s
14410 79 6e 63 20 0a 20 20 20 20 20 20 20 23 66 20 3b ync . #f ;
14420 3b 20 64 6f 20 61 6c 6c 20 72 75 6e 2d 69 64 73 ; do all run-ids
14430 0a 20 20 20 20 20 20 20 27 6e 65 77 32 6f 6c 64 . 'new2old
14440 0a 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 20 . ).
14450 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
14460 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
14470 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
14480 67 65 6e 65 72 61 74 65 2d 68 74 6d 6c 22 29 0a generate-html").
14490 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 (let* ((topp
144a0 61 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 ath (launch:setu
144b0 70 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 p))). (if (
144c0 74 65 73 74 73 3a 63 72 65 61 74 65 2d 68 74 6d tests:create-htm
144d0 6c 2d 74 72 65 65 20 23 66 29 0a 20 20 20 20 20 l-tree #f).
144e0 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
144f0 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
14500 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 48 54 4d t-log-port* "HTM
14510 4c 20 6f 75 74 70 75 74 20 63 72 65 61 74 65 64 L output created
14520 20 69 6e 20 22 20 74 6f 70 70 61 74 68 20 22 2f in " toppath "/
14530 6c 74 2f 72 75 6e 73 2d 69 6e 64 65 78 2e 68 74 lt/runs-index.ht
14540 6d 6c 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 ml"). (
14550 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
14560 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
14570 20 22 46 61 69 6c 65 64 20 74 6f 20 63 72 65 61 "Failed to crea
14580 74 65 20 48 54 4d 4c 20 6f 75 74 70 75 74 20 69 te HTML output i
14590 6e 20 22 20 74 6f 70 70 61 74 68 20 22 2f 6c 74 n " toppath "/lt
145a0 2f 72 75 6e 73 2d 69 6e 64 65 78 2e 68 74 6d 6c /runs-index.html
145b0 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ")). (set!
145c0 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
145d0 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
145e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
145f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14600 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14610 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
14620 3b 20 45 78 69 74 20 61 6e 64 20 63 6c 65 61 6e ; Exit and clean
14630 20 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d up.;;==========
14640 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14650 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14660 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14670 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
14680 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 28 63 f *runremote* (c
14690 6c 6f 73 65 2d 61 6c 6c 2d 63 6f 6e 6e 65 63 74 lose-all-connect
146a0 69 6f 6e 73 21 29 29 0a 0a 28 69 66 20 28 6e 6f ions!))..(if (no
146b0 74 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a t *didsomething*
146c0 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
146d0 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
146e0 67 2d 70 6f 72 74 2a 20 68 65 6c 70 29 29 0a 0a g-port* help))..
146f0 28 73 65 74 21 20 2a 74 69 6d 65 2d 74 6f 2d 65 (set! *time-to-e
14700 78 69 74 2a 20 23 74 29 0a 28 74 68 72 65 61 64 xit* #t).(thread
14710 2d 6a 6f 69 6e 21 20 2a 77 61 74 63 68 64 6f 67 -join! *watchdog
14720 2a 29 0a 0a 28 69 66 20 28 6e 6f 74 20 28 65 71 *)..(if (not (eq
14730 3f 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 ? *globalexitsta
14740 74 75 73 2a 20 30 29 29 0a 20 20 20 20 28 69 66 tus* 0)). (if
14750 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
14760 72 67 20 22 2d 72 75 6e 22 29 28 61 72 67 73 3a rg "-run")(args:
14770 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 get-arg "-runtes
14780 74 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 ts")(args:get-ar
14790 67 20 22 2d 72 75 6e 61 6c 6c 22 29 29 0a 20 20 g "-runall")).
147a0 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 (begin.
147b0 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 (debug:p
147c0 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
147d0 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 4f 54 45 3a log-port* "NOTE:
147e0 20 53 75 62 70 72 6f 63 65 73 73 65 73 20 77 69 Subprocesses wi
147f0 74 68 20 6e 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 th non-zero exit
14800 20 63 6f 64 65 20 64 65 74 65 63 74 65 64 3a 20 code detected:
14810 22 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 " *globalexitsta
14820 74 75 73 2a 29 0a 20 20 20 20 20 20 20 20 20 20 tus*).
14830 20 28 65 78 69 74 20 30 29 29 0a 20 20 20 20 20 (exit 0)).
14840 20 20 20 28 63 61 73 65 20 2a 67 6c 6f 62 61 6c (case *global
14850 65 78 69 74 73 74 61 74 75 73 2a 0a 20 20 20 20 exitstatus*.
14860 20 20 20 20 20 28 28 30 29 28 65 78 69 74 20 30 ((0)(exit 0
14870 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 31 29 )). ((1)
14880 28 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 20 (exit 1)).
14890 20 20 20 28 28 32 29 28 65 78 69 74 20 32 29 29 ((2)(exit 2))
148a0 0a 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 . (else
148b0 28 65 78 69 74 20 33 29 29 29 29 29 0a (exit 3))))).