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 28 75 73 65 20 73 71 n.scm")..(use sq
0190: 6c 69 74 65 33 20 73 72 66 69 2d 31 20 70 6f 73 lite3 srfi-1 pos
01a0: 69 78 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 ix regex regex-c
01b0: 61 73 65 20 73 72 66 69 2d 36 39 20 62 61 73 65 ase srfi-69 base
01c0: 36 34 20 66 6f 72 6d 61 74 20 72 65 61 64 6c 69 64 format readli
01d0: 6e 65 20 61 70 72 6f 70 6f 73 20 29 20 3b 3b 20 ne apropos ) ;;
01e0: 28 73 72 66 69 20 31 38 29 20 65 78 74 72 61 73 (srfi 18) extras
01f0: 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 ).(import (prefi
0200: 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 x sqlite3 sqlite
0210: 33 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 3:)).(import (pr
0220: 65 66 69 78 20 62 61 73 65 36 34 20 62 61 73 65 efix base64 base
0230: 36 34 3a 29 29 0a 0a 28 75 73 65 20 7a 6d 71 29 64:))..(use zmq)
0240: 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ..(declare (uses
0250: 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 common)).(decla
0260: 72 65 20 28 75 73 65 73 20 6d 65 67 61 74 65 73 re (uses megates
0270: 74 2d 76 65 72 73 69 6f 6e 29 29 0a 28 64 65 63 t-version)).(dec
0280: 6c 61 72 65 20 28 75 73 65 73 20 6d 61 72 67 73 lare (uses margs
0290: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
02a0: 73 20 72 75 6e 73 29 29 0a 28 64 65 63 6c 61 72 s runs)).(declar
02b0: 65 20 28 75 73 65 73 20 6c 61 75 6e 63 68 29 29 e (uses launch))
02c0: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
02d0: 73 65 72 76 65 72 29 29 0a 28 64 65 63 6c 61 72 server)).(declar
02e0: 65 20 28 75 73 65 73 20 74 65 73 74 73 29 29 0a e (uses tests)).
02f0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 67 (declare (uses g
0300: 65 6e 65 78 61 6d 70 6c 65 29 29 0a 0a 28 64 65 enexample))..(de
0310: 66 69 6e 65 20 2a 64 62 2a 20 23 66 29 20 3b 3b fine *db* #f) ;;
0320: 20 74 68 69 73 20 69 73 20 6f 6e 6c 79 20 66 6f this is only fo
0330: 72 20 74 68 65 20 72 65 70 6c 2c 20 64 6f 20 6e r the repl, do n
0340: 6f 74 20 75 73 65 20 69 6e 20 67 65 6e 65 72 61 ot use in genera
0350: 6c 21 21 21 21 0a 0a 28 69 6e 63 6c 75 64 65 20 l!!!!..(include
0360: 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e "common_records.
0370: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
0380: 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 key_records.scm"
0390: 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 ).(include "db_r
03a0: 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e ecords.scm").(in
03b0: 63 6c 75 64 65 20 22 6d 65 67 61 74 65 73 74 2d clude "megatest-
03c0: 66 6f 73 73 69 6c 2d 68 61 73 68 2e 73 63 6d 22 fossil-hash.scm"
03d0: 29 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 )..(define help
03e0: 28 63 6f 6e 63 20 22 0a 4d 65 67 61 74 65 73 74 (conc ".Megatest
03f0: 2c 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20 , documentation
0400: 61 74 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 at http://www.ki
0410: 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 atoa.com/fossils
0420: 2f 6d 65 67 61 74 65 73 74 0a 20 20 76 65 72 73 /megatest. vers
0430: 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 2d 76 ion " megatest-v
0440: 65 72 73 69 6f 6e 20 22 0a 20 20 6c 69 63 65 6e ersion ". licen
0450: 73 65 20 47 50 4c 2c 20 43 6f 70 79 72 69 67 68 se GPL, Copyrigh
0460: 74 20 4d 61 74 74 20 57 65 6c 6c 61 6e 64 20 32 t Matt Welland 2
0470: 30 30 36 2d 32 30 31 32 0a 0a 55 73 61 67 65 3a 006-2012..Usage:
0480: 20 6d 65 67 61 74 65 73 74 20 5b 6f 70 74 69 6f megatest [optio
0490: 6e 73 5d 0a 20 20 2d 68 20 20 20 20 20 20 20 20 ns]. -h
04a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
04b0: 74 68 69 73 20 68 65 6c 70 0a 20 20 2d 76 65 72 this help. -ver
04c0: 73 69 6f 6e 20 20 20 20 20 20 20 20 20 20 20 20 sion
04d0: 20 20 20 20 3a 20 70 72 69 6e 74 20 6d 65 67 61 : print mega
04e0: 74 65 73 74 20 76 65 72 73 69 6f 6e 20 28 63 75 test version (cu
04f0: 72 72 65 6e 74 6c 79 20 22 20 6d 65 67 61 74 65 rrently " megate
0500: 73 74 2d 76 65 72 73 69 6f 6e 20 22 29 0a 0a 4c st-version ")..L
0510: 61 75 6e 63 68 69 6e 67 20 61 6e 64 20 6d 61 6e aunching and man
0520: 61 67 69 6e 67 20 72 75 6e 73 0a 20 20 2d 72 75 aging runs. -ru
0530: 6e 20 74 65 73 74 70 61 74 74 5b 2f 69 74 65 6d n testpatt[/item
0540: 70 61 74 74 5d 20 3a 20 72 75 6e 20 61 6c 6c 20 patt] : run all
0550: 74 65 73 74 73 20 74 68 61 74 20 61 72 65 20 6e tests that are n
0560: 6f 74 20 73 74 61 74 65 20 43 4f 4d 50 4c 45 54 ot state COMPLET
0570: 45 44 20 61 6e 64 20 73 74 61 74 75 73 20 50 41 ED and status PA
0580: 53 53 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 SS, .
0590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05a0: 20 43 48 45 43 4b 20 6f 72 20 4b 49 4c 4c 45 44 CHECK or KILLED
05b0: 2c 20 6d 61 74 63 68 69 6e 67 20 70 61 74 74 65 , matching patte
05c0: 72 6e 20 74 65 73 74 70 61 74 74 2e 2e 2e 0a 20 rn testpatt....
05d0: 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 20 20 20 -remove-runs
05e0: 20 20 20 20 20 20 20 20 20 3a 20 72 65 6d 6f 76 : remov
05f0: 65 20 74 68 65 20 64 61 74 61 20 66 6f 72 20 61 e the data for a
0600: 20 72 75 6e 2c 20 72 65 71 75 69 72 65 73 20 3a run, requires :
0610: 72 75 6e 6e 61 6d 65 20 61 6e 64 20 2d 74 65 73 runname and -tes
0620: 74 70 61 74 74 0a 20 20 20 20 20 20 20 20 20 20 tpatt.
0630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0640: 20 20 4f 70 74 69 6f 6e 61 6c 6c 79 20 75 73 65 Optionally use
0650: 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 :state and :sta
0660: 74 75 73 0a 20 20 2d 73 65 74 2d 73 74 61 74 65 tus. -set-state
0670: 2d 73 74 61 74 75 73 20 58 2c 59 20 20 20 3a 20 -status X,Y :
0680: 73 65 74 20 73 74 61 74 65 20 74 6f 20 58 20 61 set state to X a
0690: 6e 64 20 73 74 61 74 75 73 20 74 6f 20 59 2c 20 nd status to Y,
06a0: 72 65 71 75 69 72 65 73 20 63 6f 6e 74 72 6f 6c requires control
06b0: 73 20 70 65 72 20 2d 72 65 6d 6f 76 65 2d 72 75 s per -remove-ru
06c0: 6e 73 0a 20 20 2d 72 65 72 75 6e 20 46 41 49 4c ns. -rerun FAIL
06d0: 2c 57 41 52 4e 2e 2e 2e 20 20 20 20 20 3a 20 66 ,WARN... : f
06e0: 6f 72 63 65 20 72 65 2d 72 75 6e 20 66 6f 72 20 orce re-run for
06f0: 74 65 73 74 73 20 77 69 74 68 20 73 70 65 63 69 tests with speci
0700: 66 69 63 65 64 20 73 74 61 74 75 73 28 73 29 0a ficed status(s).
0710: 20 20 2d 72 6f 6c 6c 75 70 20 20 20 20 20 20 20 -rollup
0720: 20 20 20 20 20 20 20 20 20 20 3a 20 28 63 75 72 : (cur
0730: 72 65 6e 74 6c 79 20 64 69 73 61 62 6c 65 64 29 rently disabled)
0740: 20 66 69 6c 6c 20 72 75 6e 20 28 73 65 74 20 62 fill run (set b
0750: 79 20 3a 72 75 6e 6e 61 6d 65 29 20 20 77 69 74 y :runname) wit
0760: 68 20 6c 61 74 65 73 74 20 74 65 73 74 28 73 29 h latest test(s)
0770: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0780: 20 20 20 20 20 20 20 20 20 20 20 20 20 66 72 6f fro
0790: 6d 20 70 72 69 6f 72 20 72 75 6e 73 20 77 69 74 m prior runs wit
07a0: 68 20 73 61 6d 65 20 6b 65 79 73 0a 20 20 2d 6c h same keys. -l
07b0: 6f 63 6b 20 20 20 20 20 20 20 20 20 20 20 20 20 ock
07c0: 20 20 20 20 20 20 3a 20 6c 6f 63 6b 20 72 75 6e : lock run
07d0: 20 73 70 65 63 69 66 69 65 64 20 62 79 20 74 61 specified by ta
07e0: 72 67 65 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 rget and runname
07f0: 0a 20 20 2d 75 6e 6c 6f 63 6b 20 20 20 20 20 20 . -unlock
0800: 20 20 20 20 20 20 20 20 20 20 20 3a 20 75 6e 6c : unl
0810: 6f 63 6b 20 72 75 6e 20 73 70 65 63 69 66 69 65 ock run specifie
0820: 64 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 d by target and
0830: 72 75 6e 6e 61 6d 65 0a 0a 53 65 6c 65 63 74 6f runname..Selecto
0840: 72 73 20 28 65 2e 67 2e 20 75 73 65 20 66 6f 72 rs (e.g. use for
0850: 20 2d 72 75 6e 74 65 73 74 73 2c 20 2d 72 65 6d -runtests, -rem
0860: 6f 76 65 2d 72 75 6e 73 2c 20 2d 73 65 74 2d 73 ove-runs, -set-s
0870: 74 61 74 65 2d 73 74 61 74 75 73 2c 20 2d 6c 69 tate-status, -li
0880: 73 74 2d 72 75 6e 73 20 65 74 63 2e 29 0a 20 20 st-runs etc.).
0890: 2d 74 61 72 67 65 74 20 6b 65 79 31 2f 6b 65 79 -target key1/key
08a0: 32 2f 2e 2e 2e 20 20 20 3a 20 72 75 6e 20 66 6f 2/... : run fo
08b0: 72 20 6b 65 79 31 2c 20 6b 65 79 32 2c 20 65 74 r key1, key2, et
08c0: 63 2e 0a 20 20 2d 72 65 71 74 61 72 67 20 6b 65 c.. -reqtarg ke
08d0: 79 31 2f 6b 65 79 32 2f 2e 2e 2e 20 20 3a 20 72 y1/key2/... : r
08e0: 75 6e 20 66 6f 72 20 6b 65 79 31 2c 20 6b 65 79 un for key1, key
08f0: 32 2c 20 65 74 63 2e 20 62 75 74 20 6b 65 79 31 2, etc. but key1
0900: 2f 6b 65 79 32 20 6d 75 73 74 20 62 65 20 69 6e /key2 must be in
0910: 20 72 75 6e 63 6f 6e 66 69 67 0a 20 20 2d 74 65 runconfig. -te
0920: 73 74 70 61 74 74 20 70 61 74 74 31 2f 70 61 74 stpatt patt1/pat
0930: 74 32 2c 70 61 74 74 33 2f 2e 2e 2e 20 20 3a 20 t2,patt3/... :
0940: 25 20 69 73 20 77 69 6c 64 63 61 72 64 0a 20 20 % is wildcard.
0950: 3a 72 75 6e 6e 61 6d 65 20 20 20 20 20 20 20 20 :runname
0960: 20 20 20 20 20 20 20 20 3a 20 72 65 71 75 69 72 : requir
0970: 65 64 2c 20 6e 61 6d 65 20 66 6f 72 20 74 68 69 ed, name for thi
0980: 73 20 70 61 72 74 69 63 75 6c 61 72 20 74 65 73 s particular tes
0990: 74 20 72 75 6e 0a 20 20 3a 73 74 61 74 65 20 20 t run. :state
09a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09b0: 3a 20 41 70 70 6c 69 65 73 20 74 6f 20 72 75 6e : Applies to run
09c0: 73 2c 20 74 65 73 74 73 20 6f 72 20 73 74 65 70 s, tests or step
09d0: 73 20 64 65 70 65 6e 64 69 6e 67 20 6f 6e 20 63 s depending on c
09e0: 6f 6e 74 65 78 74 0a 20 20 3a 73 74 61 74 75 73 ontext. :status
09f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a00: 20 3a 20 41 70 70 6c 69 65 73 20 74 6f 20 72 75 : Applies to ru
0a10: 6e 73 2c 20 74 65 73 74 73 20 6f 72 20 73 74 65 ns, tests or ste
0a20: 70 73 20 64 65 70 65 6e 64 69 6e 67 20 6f 6e 20 ps depending on
0a30: 63 6f 6e 74 65 78 74 0a 0a 54 65 73 74 20 68 65 context..Test he
0a40: 6c 70 65 72 73 20 28 66 6f 72 20 75 73 65 20 69 lpers (for use i
0a50: 6e 73 69 64 65 20 74 65 73 74 73 29 0a 20 20 2d nside tests). -
0a60: 73 74 65 70 20 73 74 65 70 6e 61 6d 65 0a 20 20 step stepname.
0a70: 2d 74 65 73 74 2d 73 74 61 74 75 73 20 20 20 20 -test-status
0a80: 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 : set th
0a90: 65 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 e state and stat
0aa0: 75 73 20 6f 66 20 61 20 74 65 73 74 20 28 75 73 us of a test (us
0ab0: 65 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 e :state and :st
0ac0: 61 74 75 73 29 0a 20 20 2d 73 65 74 6c 6f 67 20 atus). -setlog
0ad0: 6c 6f 67 66 6e 61 6d 65 20 20 20 20 20 20 20 20 logfname
0ae0: 3a 20 73 65 74 20 74 68 65 20 70 61 74 68 2f 66 : set the path/f
0af0: 69 6c 65 6e 61 6d 65 20 74 6f 20 74 68 65 20 66 ilename to the f
0b00: 69 6e 61 6c 20 6c 6f 67 20 72 65 6c 61 74 69 76 inal log relativ
0b10: 65 20 74 6f 20 74 68 65 20 74 65 73 74 0a 20 20 e to the test.
0b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b30: 20 20 20 20 20 20 20 20 20 20 64 69 72 65 63 74 direct
0b40: 6f 72 79 2e 20 6d 61 79 20 62 65 20 75 73 65 64 ory. may be used
0b50: 20 77 69 74 68 20 2d 74 65 73 74 2d 73 74 61 74 with -test-stat
0b60: 75 73 0a 20 20 2d 73 65 74 2d 74 6f 70 6c 6f 67 us. -set-toplog
0b70: 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 3a 20 73 logfname : s
0b80: 65 74 20 74 68 65 20 6f 76 65 72 61 6c 6c 20 6c et the overall l
0b90: 6f 67 20 66 6f 72 20 61 20 73 75 69 74 65 20 6f og for a suite o
0ba0: 66 20 73 75 62 2d 74 65 73 74 73 0a 20 20 2d 73 f sub-tests. -s
0bb0: 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 20 ummarize-items
0bc0: 20 20 20 20 20 20 3a 20 66 6f 72 20 61 6e 20 69 : for an i
0bd0: 74 65 6d 69 7a 65 64 20 74 65 73 74 20 63 72 65 temized test cre
0be0: 61 74 65 20 61 20 73 75 6d 6d 61 72 79 20 68 74 ate a summary ht
0bf0: 6d 6c 20 0a 20 20 2d 6d 20 63 6f 6d 6d 65 6e 74 ml . -m comment
0c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
0c10: 69 6e 73 65 72 74 20 61 20 63 6f 6d 6d 65 6e 74 insert a comment
0c20: 20 66 6f 72 20 74 68 69 73 20 74 65 73 74 0a 0a for this test..
0c30: 54 65 73 74 20 64 61 74 61 20 63 61 70 74 75 72 Test data captur
0c40: 65 0a 20 20 2d 73 65 74 2d 76 61 6c 75 65 73 20 e. -set-values
0c50: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 75 70 : up
0c60: 64 61 74 65 20 6f 72 20 73 65 74 20 76 61 6c 75 date or set valu
0c70: 65 73 20 69 6e 20 74 68 65 20 74 65 73 74 64 61 es in the testda
0c80: 74 61 20 74 61 62 6c 65 0a 20 20 3a 63 61 74 65 ta table. :cate
0c90: 67 6f 72 79 20 20 20 20 20 20 20 20 20 20 20 20 gory
0ca0: 20 20 20 3a 20 73 65 74 20 74 68 65 20 63 61 74 : set the cat
0cb0: 65 67 6f 72 79 20 66 69 65 6c 64 20 28 6f 70 74 egory field (opt
0cc0: 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 72 69 61 62 ional). :variab
0cd0: 6c 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 le
0ce0: 20 3a 20 73 65 74 20 74 68 65 20 76 61 72 69 61 : set the varia
0cf0: 62 6c 65 20 6e 61 6d 65 20 28 6f 70 74 69 6f 6e ble name (option
0d00: 61 6c 29 0a 20 20 3a 76 61 6c 75 65 20 20 20 20 al). :value
0d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
0d20: 76 61 6c 75 65 20 6d 65 61 73 75 72 65 64 20 28 value measured (
0d30: 72 65 71 75 69 72 65 64 29 0a 20 20 3a 65 78 70 required). :exp
0d40: 65 63 74 65 64 20 20 20 20 20 20 20 20 20 20 20 ected
0d50: 20 20 20 20 3a 20 76 61 6c 75 65 20 65 78 70 65 : value expe
0d60: 63 74 65 64 20 28 72 65 71 75 69 72 65 64 29 0a cted (required).
0d70: 20 20 3a 74 6f 6c 20 20 20 20 20 20 20 20 20 20 :tol
0d80: 20 20 20 20 20 20 20 20 20 20 3a 20 7c 76 61 6c : |val
0d90: 75 65 2d 65 78 70 65 63 74 7c 20 3c 3d 20 74 6f ue-expect| <= to
0da0: 6c 20 28 72 65 71 75 69 72 65 64 2c 20 63 61 6e l (required, can
0db0: 20 62 65 20 3c 2c 20 3e 2c 20 3e 3d 2c 20 3c 3d be <, >, >=, <=
0dc0: 20 6f 72 20 6e 75 6d 62 65 72 29 0a 20 20 3a 75 or number). :u
0dd0: 6e 69 74 73 20 20 20 20 20 20 20 20 20 20 20 20 nits
0de0: 20 20 20 20 20 20 3a 20 6e 61 6d 65 20 6f 66 20 : name of
0df0: 74 68 65 20 75 6e 69 74 73 20 66 6f 72 20 76 61 the units for va
0e00: 6c 75 65 2c 20 65 78 70 65 63 74 65 64 5f 76 61 lue, expected_va
0e10: 6c 75 65 20 65 74 63 2e 20 28 6f 70 74 69 6f 6e lue etc. (option
0e20: 61 6c 29 0a 20 20 2d 6c 6f 61 64 2d 74 65 73 74 al). -load-test
0e30: 2d 64 61 74 61 20 20 20 20 20 20 20 20 20 3a 20 -data :
0e40: 72 65 61 64 20 74 65 73 74 20 73 70 65 63 69 66 read test specif
0e50: 69 63 20 64 61 74 61 20 66 6f 72 20 73 74 6f 72 ic data for stor
0e60: 61 67 65 20 69 6e 20 74 68 65 20 74 65 73 74 5f age in the test_
0e70: 64 61 74 61 20 74 61 62 6c 65 0a 20 20 20 20 20 data table.
0e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e90: 20 20 20 20 20 20 20 66 72 6f 6d 20 73 74 61 6e from stan
0ea0: 64 61 72 64 20 69 6e 2e 20 45 61 63 68 20 6c 69 dard in. Each li
0eb0: 6e 65 20 69 73 20 63 6f 6d 6d 61 20 64 65 6c 69 ne is comma deli
0ec0: 6d 69 74 65 64 20 77 69 74 68 20 66 6f 75 72 0a mited with four.
0ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ee0: 20 20 20 20 20 20 20 20 20 20 20 20 66 69 65 6c fiel
0ef0: 64 73 20 63 61 74 65 67 6f 72 79 2c 76 61 72 69 ds category,vari
0f00: 61 62 6c 65 2c 76 61 6c 75 65 2c 63 6f 6d 6d 65 able,value,comme
0f10: 6e 74 0a 0a 51 75 65 72 69 65 73 0a 20 20 2d 6c nt..Queries. -l
0f20: 69 73 74 2d 72 75 6e 73 20 70 61 74 74 20 20 20 ist-runs patt
0f30: 20 20 20 20 20 20 3a 20 6c 69 73 74 20 72 75 6e : list run
0f40: 73 20 6d 61 74 63 68 69 6e 67 20 70 61 74 74 65 s matching patte
0f50: 72 6e 20 5c 22 70 61 74 74 5c 22 2c 20 25 20 69 rn \"patt\", % i
0f60: 73 20 74 68 65 20 77 69 6c 64 63 61 72 64 0a 20 s the wildcard.
0f70: 20 2d 73 68 6f 77 6b 65 79 73 20 20 20 20 20 20 -showkeys
0f80: 20 20 20 20 20 20 20 20 20 3a 20 73 68 6f 77 20 : show
0f90: 74 68 65 20 6b 65 79 73 20 75 73 65 64 20 69 6e the keys used in
0fa0: 20 74 68 69 73 20 6d 65 67 61 74 65 73 74 20 73 this megatest s
0fb0: 65 74 75 70 0a 20 20 2d 74 65 73 74 2d 66 69 6c etup. -test-fil
0fc0: 65 73 20 74 61 72 67 70 61 74 74 20 20 20 20 20 es targpatt
0fd0: 3a 20 67 65 74 20 74 68 65 20 6d 6f 73 74 20 72 : get the most r
0fe0: 65 63 65 6e 74 20 74 65 73 74 20 70 61 74 68 2f ecent test path/
0ff0: 66 69 6c 65 20 6d 61 74 63 68 69 6e 67 20 74 61 file matching ta
1000: 72 67 70 61 74 74 20 65 2e 67 2e 20 25 2f 25 2e rgpatt e.g. %/%.
1010: 2e 2e 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 .. .
1020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1030: 72 65 74 75 72 6e 73 20 6c 69 73 74 20 73 6f 72 returns list sor
1040: 74 65 64 20 62 79 20 61 67 65 20 61 73 63 65 6e ted by age ascen
1050: 64 69 6e 67 2c 20 73 65 65 20 65 78 61 6d 70 6c ding, see exampl
1060: 65 73 20 62 65 6c 6f 77 0a 20 20 2d 74 65 73 74 es below. -test
1070: 2d 70 61 74 68 73 20 20 20 20 20 20 20 20 20 20 -paths
1080: 20 20 20 3a 20 67 65 74 20 74 68 65 20 74 65 73 : get the tes
1090: 74 20 70 61 74 68 73 20 6d 61 74 63 68 69 6e 67 t paths matching
10a0: 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 target, runname
10b0: 2c 20 69 74 65 6d 20 61 6e 64 20 74 65 73 74 0a , item and test.
10c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10d0: 20 20 20 20 20 20 20 20 20 20 20 20 70 61 74 74 patt
10e0: 65 72 6e 73 2e 0a 0a 4d 69 73 63 20 0a 20 20 2d erns...Misc . -
10f0: 72 65 62 75 69 6c 64 2d 64 62 20 20 20 20 20 20 rebuild-db
1100: 20 20 20 20 20 20 20 3a 20 62 72 69 6e 67 20 74 : bring t
1110: 68 65 20 64 61 74 61 62 61 73 65 20 73 63 68 65 he database sche
1120: 6d 61 20 75 70 20 74 6f 20 64 61 74 65 0a 20 20 ma up to date.
1130: 2d 75 70 64 61 74 65 2d 6d 65 74 61 20 20 20 20 -update-meta
1140: 20 20 20 20 20 20 20 20 3a 20 75 70 64 61 74 65 : update
1150: 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 61 64 the tests metad
1160: 61 74 61 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 ata for all test
1170: 73 0a 20 20 2d 65 6e 76 32 66 69 6c 65 20 66 6e s. -env2file fn
1180: 61 6d 65 20 20 20 20 20 20 20 20 20 3a 20 77 72 ame : wr
1190: 69 74 65 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d ite the environm
11a0: 65 6e 74 20 74 6f 20 66 6e 61 6d 65 2e 63 73 68 ent to fname.csh
11b0: 20 61 6e 64 20 66 6e 61 6d 65 2e 73 68 0a 20 20 and fname.sh.
11c0: 2d 73 65 74 76 61 72 73 20 56 41 52 31 3d 76 61 -setvars VAR1=va
11d0: 6c 31 2c 56 41 52 32 3d 76 61 6c 32 20 3a 20 41 l1,VAR2=val2 : A
11e0: 64 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 dd environment v
11f0: 61 72 69 61 62 6c 65 73 20 74 6f 20 61 20 72 75 ariables to a ru
1200: 6e 20 4e 42 2f 2f 20 74 68 65 73 65 20 61 72 65 n NB// these are
1210: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1230: 20 20 6f 76 65 72 77 72 69 74 74 65 6e 20 62 79 overwritten by
1240: 20 76 61 6c 75 65 73 20 73 65 74 20 69 6e 20 63 values set in c
1250: 6f 6e 66 69 67 20 66 69 6c 65 73 2e 0a 20 20 2d onfig files.. -
1260: 73 65 72 76 65 72 20 2d 7c 68 6f 73 74 6e 61 6d server -|hostnam
1270: 65 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 74 e : start t
1280: 68 65 20 73 65 72 76 65 72 20 28 72 65 64 75 63 he server (reduc
1290: 65 73 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 6f 6e es contention on
12a0: 20 6d 65 67 61 74 65 73 74 2e 64 62 29 2c 20 75 megatest.db), u
12b0: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
12c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d -
12d0: 20 74 6f 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c to automaticall
12e0: 79 20 66 69 67 75 72 65 20 6f 75 74 20 68 6f 73 y figure out hos
12f0: 74 6e 61 6d 65 0a 20 20 2d 6c 69 73 74 2d 73 65 tname. -list-se
1300: 72 76 65 72 73 20 20 20 20 20 20 20 20 20 20 20 rvers
1310: 20 3a 20 6c 69 73 74 20 74 68 65 20 73 65 72 76 : list the serv
1320: 65 72 73 20 0a 20 20 2d 72 65 70 6c 20 20 20 20 ers . -repl
1330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
1340: 20 73 74 61 72 74 20 61 20 72 65 70 6c 20 28 75 start a repl (u
1350: 73 65 66 75 6c 20 66 6f 72 20 65 78 74 65 6e 64 seful for extend
1360: 69 6e 67 20 6d 65 67 61 74 65 73 74 29 0a 0a 53 ing megatest)..S
1370: 70 72 65 61 64 73 68 65 65 74 20 67 65 6e 65 72 preadsheet gener
1380: 61 74 69 6f 6e 0a 20 20 2d 65 78 74 72 61 63 74 ation. -extract
1390: 2d 6f 64 73 20 66 6e 61 6d 65 2e 6f 64 73 20 20 -ods fname.ods
13a0: 3a 20 65 78 74 72 61 63 74 20 61 6e 20 6f 70 65 : extract an ope
13b0: 6e 20 64 6f 63 75 6d 65 6e 74 20 73 70 72 65 61 n document sprea
13c0: 64 73 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 dsheet from the
13d0: 64 61 74 61 62 61 73 65 0a 20 20 2d 70 61 74 68 database. -path
13e0: 6d 6f 64 20 70 61 74 68 20 20 20 20 20 20 20 20 mod path
13f0: 20 20 20 3a 20 69 6e 73 65 72 74 20 70 61 74 68 : insert path
1400: 2c 20 69 2e 65 2e 20 70 61 74 68 2f 72 75 6e 61 , i.e. path/runa
1410: 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 me/itempath/logf
1420: 69 6c 65 2e 68 74 6d 6c 0a 20 20 20 20 20 20 20 ile.html.
1430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1440: 20 20 20 20 20 77 69 6c 6c 20 63 6c 65 61 72 20 will clear
1450: 74 68 65 20 66 69 65 6c 64 20 69 66 20 6e 6f 20 the field if no
1460: 72 75 6e 64 69 72 2f 74 65 73 74 6e 61 6d 65 2f rundir/testname/
1470: 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 69 6c 65 itempath/logfile
1480: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1490: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 if
14a0: 69 74 20 63 6f 6e 74 61 69 6e 73 20 66 6f 72 77 it contains forw
14b0: 61 72 64 20 73 6c 61 73 68 65 73 20 74 68 65 20 ard slashes the
14c0: 70 61 74 68 20 77 69 6c 6c 20 62 65 20 63 6f 6e path will be con
14d0: 76 65 72 74 65 64 0a 20 20 20 20 20 20 20 20 20 verted.
14e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14f0: 20 20 20 74 6f 20 77 69 6e 64 6f 77 73 20 73 74 to windows st
1500: 79 6c 65 0a 47 65 74 74 69 6e 67 20 73 74 61 72 yle.Getting star
1510: 74 65 64 0a 20 20 2d 67 65 6e 2d 6d 65 67 61 74 ted. -gen-megat
1520: 65 73 74 2d 61 72 65 61 20 20 20 20 20 20 3a 20 est-area :
1530: 63 72 65 61 74 65 20 61 20 73 6b 65 6c 65 74 6f create a skeleto
1540: 6e 20 6d 65 67 61 74 65 73 74 20 61 72 65 61 2e n megatest area.
1550: 20 59 6f 75 20 77 69 6c 6c 20 62 65 20 70 72 6f You will be pro
1560: 6d 70 74 65 64 20 66 6f 72 20 70 61 74 68 73 0a mpted for paths.
1570: 20 20 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d -gen-megatest-
1580: 74 65 73 74 20 20 20 20 20 20 3a 20 63 72 65 61 test : crea
1590: 74 65 20 61 20 73 6b 65 6c 65 74 6f 6e 20 6d 65 te a skeleton me
15a0: 67 61 74 65 73 74 20 74 65 73 74 2e 20 59 6f 75 gatest test. You
15b0: 20 77 69 6c 6c 20 62 65 20 70 72 6f 6d 70 74 65 will be prompte
15c0: 64 20 66 6f 72 20 69 6e 66 6f 0a 0a 45 78 61 6d d for info..Exam
15d0: 70 6c 65 73 0a 0a 23 20 47 65 74 20 74 65 73 74 ples..# Get test
15e0: 20 70 61 74 68 2c 20 75 73 65 20 27 2e 27 20 74 path, use '.' t
15f0: 6f 20 67 65 74 20 61 20 73 69 6e 67 6c 65 20 70 o get a single p
1600: 61 74 68 20 6f 72 20 61 20 73 70 65 63 69 66 69 ath or a specifi
1610: 63 20 70 61 74 68 2f 66 69 6c 65 20 70 61 74 74 c path/file patt
1620: 65 72 6e 0a 6d 65 67 61 74 65 73 74 20 2d 74 65 ern.megatest -te
1630: 73 74 2d 66 69 6c 65 73 20 27 6c 6f 67 73 2f 2a st-files 'logs/*
1640: 2e 6c 6f 67 27 20 2d 74 61 72 67 65 74 20 75 62 .log' -target ub
1650: 75 6e 74 75 2f 6e 25 2f 6e 6f 25 20 3a 72 75 6e untu/n%/no% :run
1660: 6e 61 6d 65 20 77 34 39 25 20 2d 74 65 73 74 70 name w49% -testp
1670: 61 74 74 20 74 65 73 74 5f 6d 74 25 0a 0a 43 61 att test_mt%..Ca
1680: 6c 6c 65 64 20 61 73 20 22 20 28 73 74 72 69 6e lled as " (strin
1690: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 61 g-intersperse (a
16a0: 72 67 76 29 20 22 20 22 29 20 22 0a 56 65 72 73 rgv) " ") ".Vers
16b0: 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 2d 76 ion " megatest-v
16c0: 65 72 73 69 6f 6e 20 22 2c 20 62 75 69 6c 74 20 ersion ", built
16d0: 66 72 6f 6d 20 22 20 6d 65 67 61 74 65 73 74 2d from " megatest-
16e0: 66 6f 73 73 69 6c 2d 68 61 73 68 20 29 29 0a 0a fossil-hash ))..
16f0: 3b 3b 20 20 2d 67 75 69 20 20 20 20 20 20 20 20 ;; -gui
1700: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 74 : st
1710: 61 72 74 20 61 20 67 75 69 20 69 6e 74 65 72 66 art a gui interf
1720: 61 63 65 0a 3b 3b 20 20 2d 63 6f 6e 66 69 67 20 ace.;; -config
1730: 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 fname
1740: 3a 20 6f 76 65 72 72 69 64 65 20 74 68 65 20 72 : override the r
1750: 75 6e 63 6f 6e 66 69 67 20 66 69 6c 65 20 77 69 unconfig file wi
1760: 74 68 20 66 6e 61 6d 65 0a 3b 3b 20 20 2d 6b 69 th fname.;; -ki
1770: 6c 6c 2d 73 65 72 76 65 72 20 68 6f 73 74 3a 70 ll-server host:p
1780: 6f 72 74 7c 70 69 64 20 3a 20 6b 69 6c 6c 20 73 ort|pid : kill s
1790: 65 72 76 65 72 20 73 70 65 63 69 66 69 65 64 20 erver specified
17a0: 62 79 20 68 6f 73 74 3a 70 6f 72 74 20 6f 72 20 by host:port or
17b0: 70 69 64 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 20 pid..;; process
17c0: 61 72 67 73 0a 28 64 65 66 69 6e 65 20 72 65 6d args.(define rem
17d0: 61 72 67 73 20 28 61 72 67 73 3a 67 65 74 2d 61 args (args:get-a
17e0: 72 67 73 20 0a 09 09 20 28 61 72 67 76 29 0a 09 rgs ... (argv)..
17f0: 09 20 28 6c 69 73 74 20 20 22 2d 72 75 6e 74 65 . (list "-runte
1800: 73 74 73 22 20 20 3b 3b 20 72 75 6e 20 61 20 73 sts" ;; run a s
1810: 70 65 63 69 66 69 63 20 74 65 73 74 0a 09 09 09 pecific test....
1820: 22 2d 63 6f 6e 66 69 67 22 20 20 20 20 3b 3b 20 "-config" ;;
1830: 6f 76 65 72 72 69 64 65 20 74 68 65 20 63 6f 6e override the con
1840: 66 69 67 20 66 69 6c 65 20 6e 61 6d 65 0a 09 09 fig file name...
1850: 09 22 2d 65 78 65 63 75 74 65 22 20 20 20 3b 3b ."-execute" ;;
1860: 20 72 75 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 run the command
1870: 20 65 6e 63 6f 64 65 64 20 69 6e 20 74 68 65 20 encoded in the
1880: 62 61 73 65 36 34 20 70 61 72 61 6d 65 74 65 72 base64 parameter
1890: 0a 09 09 09 22 2d 73 74 65 70 22 0a 09 09 09 22 ...."-step"...."
18a0: 3a 72 75 6e 6e 61 6d 65 22 20 20 20 0a 09 09 09 :runname" ....
18b0: 22 2d 74 61 72 67 65 74 22 0a 09 09 09 22 2d 72 "-target"...."-r
18c0: 65 71 74 61 72 67 22 0a 09 09 09 22 3a 69 74 65 eqtarg"....":ite
18d0: 6d 22 0a 09 09 09 22 3a 72 75 6e 6e 61 6d 65 22 m"....":runname"
18e0: 20 20 20 0a 09 09 09 22 3a 73 74 61 74 65 22 20 ....":state"
18f0: 20 0a 09 09 09 22 3a 73 74 61 74 75 73 22 0a 09 ....":status"..
1900: 09 09 22 2d 6c 69 73 74 2d 72 75 6e 73 22 0a 09 .."-list-runs"..
1910: 09 09 22 2d 74 65 73 74 70 61 74 74 22 20 0a 09 .."-testpatt" ..
1920: 09 09 22 2d 69 74 65 6d 70 61 74 74 22 0a 09 09 .."-itempatt"...
1930: 09 22 2d 73 65 74 6c 6f 67 22 0a 09 09 09 22 2d ."-setlog"...."-
1940: 73 65 74 2d 74 6f 70 6c 6f 67 22 0a 09 09 09 22 set-toplog"...."
1950: 2d 72 75 6e 73 74 65 70 22 0a 09 09 09 22 2d 6c -runstep"...."-l
1960: 6f 67 70 72 6f 22 0a 09 09 09 22 2d 6d 22 0a 09 ogpro"...."-m"..
1970: 09 09 22 2d 72 65 72 75 6e 22 0a 09 09 09 22 2d .."-rerun"...."-
1980: 64 61 79 73 22 0a 09 09 09 22 2d 72 65 6e 61 6d days"...."-renam
1990: 65 2d 72 75 6e 22 0a 09 09 09 22 2d 74 6f 22 0a e-run"...."-to".
19a0: 09 09 09 3b 3b 20 76 61 6c 75 65 73 20 61 6e 64 ...;; values and
19b0: 20 6d 65 73 73 61 67 65 73 0a 09 09 09 22 3a 63 messages....":c
19c0: 61 74 65 67 6f 72 79 22 0a 09 09 09 22 3a 76 61 ategory"....":va
19d0: 72 69 61 62 6c 65 22 0a 09 09 09 22 3a 76 61 6c riable"....":val
19e0: 75 65 22 0a 09 09 09 22 3a 65 78 70 65 63 74 65 ue"....":expecte
19f0: 64 22 0a 09 09 09 22 3a 74 6f 6c 22 0a 09 09 09 d"....":tol"....
1a00: 22 3a 75 6e 69 74 73 22 0a 09 09 09 3b 3b 20 6d ":units"....;; m
1a10: 69 73 63 0a 09 09 09 22 2d 73 65 72 76 65 72 22 isc...."-server"
1a20: 0a 09 09 09 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 ...."-kill-serve
1a30: 72 22 0a 09 09 09 22 2d 70 6f 72 74 22 0a 09 09 r"...."-port"...
1a40: 09 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 0a ."-extract-ods".
1a50: 09 09 09 22 2d 70 61 74 68 6d 6f 64 22 0a 09 09 ..."-pathmod"...
1a60: 09 22 2d 65 6e 76 32 66 69 6c 65 22 0a 09 09 09 ."-env2file"....
1a70: 22 2d 73 65 74 76 61 72 73 22 0a 09 09 09 22 2d "-setvars"...."-
1a80: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
1a90: 22 0a 09 09 09 22 2d 64 65 62 75 67 22 20 3b 3b "...."-debug" ;;
1aa0: 20 66 6f 72 20 2a 76 65 72 62 6f 73 69 74 79 2a for *verbosity*
1ab0: 20 3e 20 32 0a 09 09 09 22 2d 67 65 6e 2d 6d 65 > 2...."-gen-me
1ac0: 67 61 74 65 73 74 2d 74 65 73 74 22 0a 09 09 09 gatest-test"....
1ad0: 22 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f "-override-timeo
1ae0: 75 74 22 0a 09 09 09 22 2d 74 65 73 74 2d 66 69 ut"...."-test-fi
1af0: 6c 65 73 22 20 20 3b 3b 20 2d 74 65 73 74 2d 70 les" ;; -test-p
1b00: 61 74 68 73 20 69 73 20 66 6f 72 20 6c 69 73 74 aths is for list
1b10: 69 6e 67 20 61 6c 6c 0a 09 09 09 22 2d 72 75 6e ing all...."-run
1b20: 22 0a 09 09 09 29 20 0a 09 09 20 28 6c 69 73 74 "....) ... (list
1b30: 20 20 22 2d 68 22 0a 09 09 09 22 2d 76 65 72 73 "-h"...."-vers
1b40: 69 6f 6e 22 0a 09 09 20 20 20 20 20 20 20 20 22 ion"... "
1b50: 2d 66 6f 72 63 65 22 0a 09 09 20 20 20 20 20 20 -force"...
1b60: 20 20 22 2d 78 74 65 72 6d 22 0a 09 09 20 20 20 "-xterm"...
1b70: 20 20 20 20 20 22 2d 73 68 6f 77 6b 65 79 73 22 "-showkeys"
1b80: 0a 09 09 20 20 20 20 20 20 20 20 22 2d 74 65 73 ... "-tes
1b90: 74 2d 73 74 61 74 75 73 22 0a 09 09 09 22 2d 73 t-status"...."-s
1ba0: 65 74 2d 76 61 6c 75 65 73 22 0a 09 09 09 22 2d et-values"...."-
1bb0: 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 0a load-test-data".
1bc0: 09 09 09 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 ..."-summarize-i
1bd0: 74 65 6d 73 22 0a 09 09 20 20 20 20 20 20 20 20 tems"...
1be0: 22 2d 67 75 69 22 0a 09 09 09 3b 3b 20 6d 69 73 "-gui"....;; mis
1bf0: 63 0a 09 09 09 22 2d 61 72 63 68 69 76 65 22 0a c...."-archive".
1c00: 09 09 09 22 2d 72 65 70 6c 22 0a 09 09 09 22 2d ..."-repl"...."-
1c10: 6c 6f 63 6b 22 0a 09 09 09 22 2d 75 6e 6c 6f 63 lock"...."-unloc
1c20: 6b 22 0a 09 09 09 22 2d 6c 69 73 74 2d 73 65 72 k"...."-list-ser
1c30: 76 65 72 73 22 0a 09 09 09 3b 3b 20 6d 69 73 74 vers"....;; mist
1c40: 20 71 75 65 72 69 65 73 0a 09 09 09 22 2d 6c 69 queries...."-li
1c50: 73 74 2d 64 69 73 6b 73 22 0a 09 09 09 22 2d 6c st-disks"...."-l
1c60: 69 73 74 2d 74 61 72 67 65 74 73 22 0a 09 09 09 ist-targets"....
1c70: 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 "-list-db-target
1c80: 73 22 0a 09 09 09 3b 3b 20 71 75 65 72 69 65 73 s"....;; queries
1c90: 0a 09 09 09 22 2d 74 65 73 74 2d 70 61 74 68 73 ...."-test-paths
1ca0: 22 20 3b 3b 20 67 65 74 20 70 61 74 68 28 73 29 " ;; get path(s)
1cb0: 20 74 6f 20 61 20 74 65 73 74 2c 20 6f 72 64 65 to a test, orde
1cc0: 72 65 64 20 62 79 20 79 6f 75 6e 67 65 73 74 20 red by youngest
1cd0: 66 69 72 73 74 0a 0a 09 09 09 22 2d 72 75 6e 61 first....."-runa
1ce0: 6c 6c 22 20 20 20 20 3b 3b 20 72 75 6e 20 61 6c ll" ;; run al
1cf0: 6c 20 74 65 73 74 73 0a 09 09 09 22 2d 72 65 6d l tests...."-rem
1d00: 6f 76 65 2d 72 75 6e 73 22 0a 09 09 09 22 2d 75 ove-runs"...."-u
1d10: 73 65 71 75 65 75 65 22 0a 09 09 09 22 2d 72 65 sequeue"...."-re
1d20: 62 75 69 6c 64 2d 64 62 22 0a 09 09 09 22 2d 72 build-db"...."-r
1d30: 6f 6c 6c 75 70 22 0a 09 09 09 22 2d 75 70 64 61 ollup"...."-upda
1d40: 74 65 2d 6d 65 74 61 22 0a 09 09 09 22 2d 67 65 te-meta"...."-ge
1d50: 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 22 n-megatest-area"
1d60: 0a 0a 09 09 09 22 2d 6c 6f 67 67 69 6e 67 22 0a ....."-logging".
1d70: 09 09 09 22 2d 76 22 20 3b 3b 20 76 65 72 62 6f ..."-v" ;; verbo
1d80: 73 65 20 32 2c 20 6d 6f 72 65 20 74 68 61 6e 20 se 2, more than
1d90: 6e 6f 72 6d 61 6c 20 28 6e 6f 72 6d 61 6c 20 69 normal (normal i
1da0: 73 20 31 29 0a 09 09 09 22 2d 71 22 20 3b 3b 20 s 1)...."-q" ;;
1db0: 71 75 69 65 74 20 30 2c 20 65 72 72 6f 72 73 2f quiet 0, errors/
1dc0: 77 61 72 6e 69 6e 67 73 20 6f 6e 6c 79 0a 09 09 warnings only...
1dd0: 20 20 20 20 20 20 20 29 0a 09 09 20 61 72 67 73 )... args
1de0: 3a 61 72 67 2d 68 61 73 68 0a 09 09 20 30 29 29 :arg-hash... 0))
1df0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
1e00: 61 72 67 20 22 2d 68 22 29 0a 20 20 20 20 28 62 arg "-h"). (b
1e10: 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e egin. (prin
1e20: 74 20 68 65 6c 70 29 0a 20 20 20 20 20 20 28 65 t help). (e
1e30: 78 69 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 xit)))..(if (arg
1e40: 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 65 72 73 s:get-arg "-vers
1e50: 69 6f 6e 22 29 0a 20 20 20 20 28 62 65 67 69 6e ion"). (begin
1e60: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 6d 65 . (print me
1e70: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a gatest-version).
1e80: 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a (exit)))..
1e90: 28 64 65 66 69 6e 65 20 2a 64 69 64 73 6f 6d 65 (define *didsome
1ea0: 74 68 69 6e 67 2a 20 23 66 29 0a 0a 3b 3b 3d 3d thing* #f)..;;==
1eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ef0: 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 20 73 65 74 ====.;; Misc set
1f00: 75 70 20 73 74 75 66 66 0a 3b 3b 3d 3d 3d 3d 3d up stuff.;;=====
1f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f50: 3d 0a 0a 28 64 65 62 75 67 3a 73 65 74 75 70 29 =..(debug:setup)
1f60: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
1f70: 61 72 67 20 22 2d 6c 6f 67 67 69 6e 67 22 29 28 arg "-logging")(
1f80: 73 65 74 21 20 2a 6c 6f 67 67 69 6e 67 2a 20 23 set! *logging* #
1f90: 74 29 29 0a 0a 28 69 66 20 28 64 65 62 75 67 3a t))..(if (debug:
1fa0: 64 65 62 75 67 2d 6d 6f 64 65 20 33 29 20 3b 3b debug-mode 3) ;;
1fb0: 20 77 65 20 61 72 65 20 6f 62 76 69 6f 75 73 6c we are obviousl
1fc0: 79 20 64 65 62 75 67 67 69 6e 67 0a 20 20 20 20 y debugging.
1fd0: 28 73 65 74 21 20 6f 70 65 6e 2d 72 75 6e 2d 63 (set! open-run-c
1fe0: 6c 6f 73 65 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c lose open-run-cl
1ff0: 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e ose-no-exception
2000: 2d 68 61 6e 64 6c 69 6e 67 29 29 0a 0a 3b 3b 20 -handling))..;;
2010: 61 2c 62 2c 63 20 25 20 3d 3e 20 61 2f 25 2c 62 a,b,c % => a/%,b
2020: 2f 25 2c 63 2f 25 0a 28 64 65 66 69 6e 65 20 28 /%,c/%.(define (
2030: 74 61 63 6b 2d 6f 6e 2d 70 61 74 74 20 73 72 63 tack-on-patt src
2040: 73 74 72 20 70 61 74 74 29 0a 20 20 28 6c 65 74 str patt). (let
2050: 20 28 28 73 74 72 6c 73 74 20 28 73 74 72 69 6e ((strlst (strin
2060: 67 2d 73 70 6c 69 74 20 73 72 63 73 74 72 20 22 g-split srcstr "
2070: 2c 22 29 29 29 0a 20 20 20 20 28 73 74 72 69 6e ,"))). (strin
2080: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a 20 g-intersperse .
2090: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda
20a0: 20 28 73 74 72 29 0a 09 20 20 20 20 28 69 66 20 (str).. (if
20b0: 28 6e 6f 74 20 28 73 75 62 73 74 72 69 6e 67 2d (not (substring-
20c0: 69 6e 64 65 78 20 22 2f 22 20 73 74 72 29 29 0a index "/" str)).
20d0: 09 09 28 63 6f 6e 63 20 73 74 72 20 22 2f 22 20 ..(conc str "/"
20e0: 70 61 74 74 29 0a 09 09 73 74 72 29 29 0a 09 20 patt)...str))..
20f0: 20 73 74 72 6c 73 74 29 0a 09 20 20 20 22 2c 22 strlst).. ","
2100: 29 29 29 0a 0a 3b 3b 20 74 6f 20 74 72 79 20 61 )))..;; to try a
2110: 6e 64 20 6e 6f 74 20 62 75 72 64 65 6e 20 4b 69 nd not burden Ki
2120: 6d 20 74 6f 6f 20 6d 75 63 68 2e 2e 2e 0a 28 69 m too much....(i
2130: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
2140: 22 2d 69 74 65 6d 70 61 74 74 22 29 0a 20 20 20 "-itempatt").
2150: 20 28 6c 65 74 20 28 28 6f 6c 64 2d 74 65 73 74 (let ((old-test
2160: 70 61 74 74 20 28 61 72 67 73 3a 67 65 74 2d 61 patt (args:get-a
2170: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 29 rg "-testpatt"))
2180: 29 0a 20 20 20 20 20 20 3b 3b 20 28 64 65 62 75 ). ;; (debu
2190: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
21a0: 3a 20 70 61 72 61 6d 65 74 65 72 20 5c 22 2d 69 : parameter \"-i
21b0: 74 65 6d 70 61 74 74 5c 22 20 68 61 73 20 62 65 tempatt\" has be
21c0: 65 6e 20 64 65 70 72 65 63 61 74 65 64 2e 20 46 en deprecated. F
21d0: 6f 72 20 6e 6f 77 20 49 20 77 69 6c 6c 20 74 77 or now I will tw
21e0: 65 61 6b 20 79 6f 75 72 20 2d 74 65 73 74 70 61 eak your -testpa
21f0: 74 74 20 66 6f 72 20 79 6f 75 22 29 0a 20 20 20 tt for you").
2200: 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 (if (args:get
2210: 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 -arg "-testpatt"
2220: 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ).. (hash-table
2230: 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 2d 68 -set! args:arg-h
2240: 61 73 68 20 22 2d 74 65 73 74 70 61 74 74 22 20 ash "-testpatt"
2250: 28 74 61 63 6b 2d 6f 6e 2d 70 61 74 74 20 6f 6c (tack-on-patt ol
2260: 64 2d 74 65 73 74 70 61 74 74 20 28 61 72 67 73 d-testpatt (args
2270: 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 :get-arg "-itemp
2280: 61 74 74 22 29 29 29 29 0a 20 20 20 20 20 20 3b att")))). ;
2290: 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ; (debug:print 0
22a0: 20 22 20 20 20 20 6f 6c 64 3a 20 22 20 6f 6c 64 " old: " old
22b0: 2d 74 65 73 74 70 61 74 74 20 22 2c 20 6e 65 77 -testpatt ", new
22c0: 3a 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 : " (args:get-ar
22d0: 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 29 0a g "-testpatt")).
22e0: 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a (if (args:
22f0: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 get-arg "-runtes
2300: 74 73 22 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 ts").. (begin..
2310: 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 ;; (debug:pr
2320: 69 6e 74 20 30 20 22 4e 4f 54 45 3a 20 41 6c 73 int 0 "NOTE: Als
2330: 6f 20 6d 6f 64 69 66 79 69 6e 67 20 2d 72 75 6e o modifying -run
2340: 74 65 73 74 73 22 29 0a 09 20 20 20 20 28 68 61 tests").. (ha
2350: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 72 sh-table-set! ar
2360: 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 72 75 gs:arg-hash "-ru
2370: 6e 74 65 73 74 73 22 20 28 74 61 63 6b 2d 6f 6e ntests" (tack-on
2380: 2d 70 61 74 74 20 28 61 72 67 73 3a 67 65 74 2d -patt (args:get-
2390: 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
23a0: 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 28 61 ......... (a
23b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 rgs:get-arg "-it
23c0: 65 6d 70 61 74 74 22 29 29 29 29 29 0a 20 20 20 empatt"))))).
23d0: 20 20 20 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d ))..;;=======
23e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
2420: 3b 3b 20 4d 69 73 63 20 67 65 6e 65 72 61 6c 20 ;; Misc general
2430: 63 61 6c 6c 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d calls.;;========
2440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
2480: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
2490: 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 29 0a 20 g "-env2file").
24a0: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
24b0: 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e (save-environmen
24c0: 74 2d 61 73 2d 66 69 6c 65 73 20 28 61 72 67 73 t-as-files (args
24d0: 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 32 66 :get-arg "-env2f
24e0: 69 6c 65 22 29 29 0a 20 20 20 20 20 20 28 73 65 ile")). (se
24f0: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
2500: 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 * #t)))..(if (ar
2510: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 gs:get-arg "-lis
2520: 74 2d 74 61 72 67 65 74 73 22 29 0a 20 20 20 20 t-targets").
2530: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 (begin. (pr
2540: 69 6e 74 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 int (string-inte
2550: 72 73 70 65 72 73 65 0a 09 20 20 20 20 20 20 28 rsperse.. (
2560: 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 72 75 6e 63 6f common:get-runco
2570: 6e 66 69 67 2d 74 61 72 67 65 74 73 29 0a 09 20 nfig-targets)..
2580: 20 20 20 20 20 22 5c 6e 22 29 29 0a 20 20 20 20 "\n")).
2590: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
25a0: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
25b0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
25c0: 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 rg "-list-db-tar
25d0: 67 65 74 73 22 29 0a 3b 3b 20 20 20 20 20 28 69 gets").;; (i
25e0: 66 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e f (setup-for-run
25f0: 29 0a 3b 3b 20 09 28 6c 65 74 2a 20 28 28 64 62 ).;; .(let* ((db
2600: 20 20 20 20 20 20 20 28 6f 70 65 6e 2d 64 62 29 (open-db)
2610: 29 20 3b 3b 20 41 3d 25 2c 42 3d 66 6f 6f 20 3d ) ;; A=%,B=foo =
2620: 3e 20 28 22 41 3d 25 22 20 22 42 3d 66 6f 6f 22 > ("A=%" "B=foo"
2630: 29 0a 3b 3b 20 09 20 20 20 20 20 20 20 28 6b 65 ).;; . (ke
2640: 79 70 61 74 74 73 20 28 6c 65 74 20 28 28 70 61 ypatts (let ((pa
2650: 74 74 73 74 72 20 20 28 61 72 67 73 3a 67 65 74 ttstr (args:get
2660: 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 -arg "-list-db-t
2670: 61 72 67 65 74 73 22 29 29 29 0a 3b 3b 20 09 09 argets"))).;; ..
2680: 09 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 . (if (equal?
2690: 70 61 74 74 73 74 72 20 22 2d 22 29 20 0a 3b 3b pattstr "-") .;;
26a0: 20 09 09 09 20 20 20 20 20 20 20 23 66 0a 3b 3b ... #f.;;
26b0: 20 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 ... (let
26c0: 28 28 61 6c 6c 20 28 73 74 72 69 6e 67 2d 73 70 ((all (string-sp
26d0: 6c 69 74 20 70 61 74 74 73 74 72 20 22 2c 22 29 lit pattstr ",")
26e0: 29 29 0a 3b 3b 20 09 09 09 09 20 28 6d 61 70 20 )).;; .... (map
26f0: 28 6c 61 6d 62 64 61 20 28 78 29 20 3b 3b 20 41 (lambda (x) ;; A
2700: 3d 25 20 3d 3e 20 28 41 20 22 25 22 29 0a 3b 3b =% => (A "%").;;
2710: 20 09 09 09 09 09 28 73 74 72 69 6e 67 2d 73 70 .....(string-sp
2720: 6c 69 74 20 78 20 22 3d 22 29 29 0a 3b 3b 20 09 lit x "=")).;; .
2730: 09 09 09 20 20 20 20 20 20 61 6c 6c 29 29 29 29 ... all))))
2740: 29 0a 3b 3b 20 09 20 20 20 20 20 20 20 28 72 75 ).;; . (ru
2750: 6e 73 64 61 74 20 20 28 64 62 3a 67 65 74 2d 72 nsdat (db:get-r
2760: 75 6e 73 20 64 62 20 22 25 22 20 23 66 20 23 66 uns db "%" #f #f
2770: 20 6b 65 79 70 61 74 74 73 29 29 0a 3b 3b 20 09 keypatts)).;; .
2780: 20 20 20 20 20 20 20 28 72 75 6e 73 20 20 20 20 (runs
2790: 20 28 63 61 64 72 20 72 75 6e 73 64 61 74 29 29 (cadr runsdat))
27a0: 0a 3b 3b 20 09 20 20 20 20 20 20 20 28 68 65 61 .;; . (hea
27b0: 64 65 72 20 20 20 28 63 61 72 20 20 72 75 6e 73 der (car runs
27c0: 64 61 74 29 29 0a 3b 3b 20 09 20 20 20 20 20 20 dat)).;; .
27d0: 20 28 73 65 65 6e 20 20 20 20 20 28 6d 61 6b 65 (seen (make
27e0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 3b 3b -hash-table)).;;
27f0: 20 09 20 20 20 20 20 20 20 28 6b 65 79 73 64 61 . (keysda
2800: 74 20 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 t (db:get-keys
2810: 64 62 29 29 0a 3b 3b 20 09 20 20 20 20 20 20 20 db)).;; .
2820: 28 6b 65 79 73 20 20 20 20 20 28 6d 61 70 20 28 (keys (map (
2830: 6c 61 6d 62 64 61 20 28 78 29 28 76 65 63 74 6f lambda (x)(vecto
2840: 72 2d 72 65 66 20 78 20 30 29 29 20 6b 65 79 73 r-ref x 0)) keys
2850: 64 61 74 29 29 29 0a 3b 3b 20 0a 3b 3b 20 09 20 dat))).;; .;; .
2860: 20 28 66 6f 72 2d 65 61 63 68 20 0a 3b 3b 20 09 (for-each .;; .
2870: 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 (lambda (run)
2880: 0a 3b 3b 20 09 20 20 20 20 20 28 70 72 69 6e 74 .;; . (print
2890: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
28a0: 65 72 73 65 20 0a 3b 3b 20 09 09 20 20 20 20 20 erse .;; ..
28b0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6b 65 79 20 (let loop ((key
28c0: 28 63 61 72 20 6b 65 79 73 29 29 0a 3b 3b 20 09 (car keys)).;; .
28d0: 09 09 09 28 74 61 6c 20 28 63 64 72 20 6b 65 79 ...(tal (cdr key
28e0: 73 29 29 0a 3b 3b 20 09 09 09 09 28 72 65 73 20 s)).;; ....(res
28f0: 27 28 29 29 29 0a 3b 3b 20 09 09 20 20 20 20 20 '())).;; ..
2900: 20 20 28 6c 65 74 20 28 28 76 61 6c 20 28 64 62 (let ((val (db
2910: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
2920: 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 ader run header
2930: 6b 65 79 29 29 29 0a 3b 3b 20 09 09 09 20 28 69 key))).;; ... (i
2940: 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 3b 3b f (null? tal).;;
2950: 20 09 09 09 20 20 20 20 20 28 61 70 70 65 6e 64 ... (append
2960: 20 72 65 73 20 28 6c 69 73 74 20 76 61 6c 29 29 res (list val))
2970: 0a 3b 3b 20 09 09 09 20 20 20 20 20 28 6c 6f 6f .;; ... (loo
2980: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
2990: 74 61 6c 29 28 61 70 70 65 6e 64 20 72 65 73 20 tal)(append res
29a0: 28 6c 69 73 74 20 76 61 6c 29 29 29 29 29 29 0a (list val)))))).
29b0: 3b 3b 20 09 09 20 20 20 20 20 22 2f 22 29 29 29 ;; .. "/")))
29c0: 0a 3b 3b 20 09 20 20 20 72 75 6e 73 29 29 29 29 .;; . runs))))
29d0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
29e0: 61 72 67 20 22 2d 6c 69 73 74 2d 64 69 73 6b 73 arg "-list-disks
29f0: 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
2a00: 20 20 20 20 28 70 72 69 6e 74 20 0a 20 20 20 20 (print .
2a10: 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 (string-inter
2a20: 73 70 65 72 73 65 20 0a 09 28 6d 61 70 20 28 6c sperse ..(map (l
2a30: 61 6d 62 64 61 20 28 78 29 0a 09 20 20 20 20 20 ambda (x)..
2a40: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
2a50: 70 65 72 73 65 20 0a 09 09 78 0a 09 09 22 20 3d perse ...x..." =
2a60: 3e 20 22 29 29 0a 09 20 20 20 20 20 28 63 6f 6d > ")).. (com
2a70: 6d 6f 6e 3a 67 65 74 2d 64 69 73 6b 73 29 20 29 mon:get-disks) )
2a80: 0a 09 22 5c 6e 22 29 29 0a 20 20 20 20 20 20 28 .."\n")). (
2a90: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
2aa0: 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d ng* #t)))..;;===
2ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2af0: 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 74 68 65 ===.;; Start the
2b00: 20 73 65 72 76 65 72 20 2d 20 63 61 6e 20 62 65 server - can be
2b10: 20 64 6f 6e 65 20 69 6e 20 63 6f 6e 6a 75 6e 63 done in conjunc
2b20: 74 69 6f 6e 20 77 69 74 68 20 2d 72 75 6e 61 6c tion with -runal
2b30: 6c 20 6f 72 20 2d 72 75 6e 74 65 73 74 73 20 28 l or -runtests (
2b40: 6f 6e 65 20 64 61 79 2e 2e 2e 29 0a 3b 3b 20 20 one day...).;;
2b50: 20 77 65 20 73 74 61 72 74 20 74 68 65 20 73 65 we start the se
2b60: 72 76 65 72 20 69 66 20 6e 6f 74 20 72 75 6e 6e rver if not runn
2b70: 69 6e 67 20 65 6c 73 65 20 73 74 61 72 74 20 74 ing else start t
2b80: 68 65 20 63 6c 69 65 6e 74 20 74 68 72 65 61 64 he client thread
2b90: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
2ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
2be0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
2bf0: 65 72 76 65 72 22 29 0a 20 20 20 20 28 62 65 67 erver"). (beg
2c00: 69 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a in. (debug:
2c10: 70 72 69 6e 74 20 32 20 22 4c 61 75 6e 63 68 69 print 2 "Launchi
2c20: 6e 67 20 73 65 72 76 65 72 2e 2e 2e 22 29 0a 20 ng server...").
2c30: 20 20 20 20 20 28 73 65 72 76 65 72 3a 6c 61 75 (server:lau
2c40: 6e 63 68 29 29 29 0a 0a 28 69 66 20 28 61 72 67 nch)))..(if (arg
2c50: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
2c60: 2d 73 65 72 76 65 72 73 22 29 0a 09 3b 3b 20 28 -servers")..;; (
2c70: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6b args:get-arg "-k
2c80: 69 6c 6c 2d 73 65 72 76 65 72 22 29 29 0a 20 20 ill-server")).
2c90: 20 20 28 6c 65 74 20 28 28 74 6c 20 28 73 65 74 (let ((tl (set
2ca0: 75 70 2d 66 6f 72 2d 72 75 6e 29 29 29 0a 20 20 up-for-run))).
2cb0: 20 20 20 20 28 69 66 20 74 6c 20 0a 09 20 20 28 (if tl .. (
2cc0: 6c 65 74 20 28 28 73 65 72 76 65 72 73 20 28 6f let ((servers (o
2cd0: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 pen-run-close ta
2ce0: 73 6b 73 3a 67 65 74 2d 61 6c 6c 2d 73 65 72 76 sks:get-all-serv
2cf0: 65 72 73 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 ers tasks:open-d
2d00: 62 29 29 0a 09 09 28 66 6d 74 73 74 72 20 20 22 b))...(fmtstr "
2d10: 7e 35 61 7e 38 61 7e 38 61 7e 32 30 61 7e 32 30 ~5a~8a~8a~20a~20
2d20: 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 30 a~10a~10a~10a~10
2d30: 61 5c 6e 22 29 0a 09 09 28 73 65 72 76 65 72 73 a\n")...(servers
2d40: 2d 74 6f 2d 6b 69 6c 6c 20 27 28 29 29 29 0a 09 -to-kill '()))..
2d50: 20 20 20 20 28 66 6f 72 6d 61 74 20 23 74 20 66 (format #t f
2d60: 6d 74 73 74 72 20 22 49 64 22 20 22 4d 54 76 65 mtstr "Id" "MTve
2d70: 72 22 20 22 50 69 64 22 20 22 48 6f 73 74 22 20 r" "Pid" "Host"
2d80: 22 49 6e 74 65 72 66 61 63 65 22 20 22 4f 75 74 "Interface" "Out
2d90: 50 6f 72 74 22 20 22 49 6e 50 6f 72 74 22 20 22 Port" "InPort" "
2da0: 4c 61 73 74 42 65 61 74 22 20 22 53 74 61 74 65 LastBeat" "State
2db0: 22 29 0a 09 20 20 20 20 28 66 6f 72 6d 61 74 20 ").. (format
2dc0: 23 74 20 66 6d 74 73 74 72 20 22 3d 3d 22 20 22 #t fmtstr "==" "
2dd0: 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 20 22 3d 3d =====" "===" "==
2de0: 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 20 ==" "========="
2df0: 22 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d "=======" "=====
2e00: 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d =" "========" "=
2e10: 3d 3d 3d 3d 22 29 0a 09 20 20 20 20 28 66 6f 72 ====").. (for
2e20: 2d 65 61 63 68 20 0a 09 20 20 20 20 20 28 6c 61 -each .. (la
2e30: 6d 62 64 61 20 28 73 65 72 76 65 72 29 0a 09 20 mbda (server)..
2e40: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 3b 3b 20 (let* (;;
2e50: 28 6b 69 6c 6c 69 6e 66 6f 20 20 20 28 61 72 67 (killinfo (arg
2e60: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6b 69 6c 6c s:get-arg "-kill
2e70: 2d 73 65 72 76 65 72 22 29 29 0a 09 09 20 20 20 -server"))...
2e80: 20 20 20 3b 3b 20 28 6b 68 6f 73 74 2d 70 6f 72 ;; (khost-por
2e90: 74 20 28 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 t (if killinfo (
2ea0: 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e if (substring-in
2eb0: 64 65 78 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f dex ":" killinfo
2ec0: 29 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 22 )(string-split "
2ed0: 3a 22 29 20 23 66 29 20 23 66 29 29 0a 09 09 20 :") #f) #f))...
2ee0: 20 20 20 20 20 3b 3b 20 28 6b 70 69 64 20 20 20 ;; (kpid
2ef0: 20 20 20 20 28 69 66 20 6b 69 6c 6c 69 6e 66 6f (if killinfo
2f00: 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d (if (substring-
2f10: 69 6e 64 65 78 20 22 3a 22 20 6b 69 6c 6c 69 6e index ":" killin
2f20: 66 6f 29 20 23 66 20 28 73 74 72 69 6e 67 2d 3e fo) #f (string->
2f30: 6e 75 6d 62 65 72 20 6b 69 6c 6c 69 6e 66 6f 29 number killinfo)
2f40: 29 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 28 ) #f))... (
2f50: 69 64 20 20 20 20 20 20 20 20 20 28 76 65 63 74 id (vect
2f60: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 30 29 or-ref server 0)
2f70: 29 0a 09 09 20 20 20 20 20 20 28 70 69 64 20 20 )... (pid
2f80: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re
2f90: 66 20 73 65 72 76 65 72 20 31 29 29 0a 09 09 20 f server 1))...
2fa0: 20 20 20 20 20 28 68 6f 73 74 6e 61 6d 65 20 20 (hostname
2fb0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
2fc0: 76 65 72 20 32 29 29 0a 09 09 20 20 20 20 20 20 ver 2))...
2fd0: 28 69 6e 74 65 72 66 61 63 65 20 20 28 76 65 63 (interface (vec
2fe0: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 33 tor-ref server 3
2ff0: 29 29 0a 09 09 20 20 20 20 20 20 28 70 75 6c 6c ))... (pull
3000: 70 6f 72 74 20 20 20 28 76 65 63 74 6f 72 2d 72 port (vector-r
3010: 65 66 20 73 65 72 76 65 72 20 34 29 29 0a 09 09 ef server 4))...
3020: 20 20 20 20 20 20 28 70 75 62 70 6f 72 74 20 20 (pubport
3030: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
3040: 72 76 65 72 20 35 29 29 0a 09 09 20 20 20 20 20 rver 5))...
3050: 20 28 73 74 61 72 74 2d 74 69 6d 65 20 28 76 65 (start-time (ve
3060: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
3070: 36 29 29 0a 09 09 20 20 20 20 20 20 28 70 72 69 6))... (pri
3080: 6f 72 69 74 79 20 20 20 28 76 65 63 74 6f 72 2d ority (vector-
3090: 72 65 66 20 73 65 72 76 65 72 20 37 29 29 0a 09 ref server 7))..
30a0: 09 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 . (state
30b0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
30c0: 65 72 76 65 72 20 38 29 29 0a 09 09 20 20 20 20 erver 8))...
30d0: 20 20 28 6d 74 2d 76 65 72 20 20 20 20 20 28 76 (mt-ver (v
30e0: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
30f0: 20 39 29 29 0a 09 09 20 20 20 20 20 20 28 6c 61 9))... (la
3100: 73 74 2d 75 70 64 61 74 65 20 28 76 65 63 74 6f st-update (vecto
3110: 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 30 29 r-ref server 10)
3120: 29 20 3b 3b 20 20 20 28 6f 70 65 6e 2d 72 75 6e ) ;; (open-run
3130: 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 73 65 72 -close tasks:ser
3140: 76 65 72 2d 61 6c 69 76 65 3f 20 74 61 73 6b 73 ver-alive? tasks
3150: 3a 6f 70 65 6e 2d 64 62 20 23 66 20 68 6f 73 74 :open-db #f host
3160: 6e 61 6d 65 3a 20 68 6f 73 74 6e 61 6d 65 20 70 name: hostname p
3170: 6f 72 74 3a 20 70 6f 72 74 29 29 0a 09 09 20 20 ort: port))...
3180: 20 20 20 20 28 6b 69 6c 6c 65 64 20 20 20 20 20 (killed
3190: 23 66 29 0a 09 09 20 20 20 20 20 20 28 73 74 61 #f)... (sta
31a0: 74 75 73 20 20 20 20 20 28 3c 20 6c 61 73 74 2d tus (< last-
31b0: 75 70 64 61 74 65 20 32 30 29 29 29 0a 09 09 20 update 20)))...
31c0: 3b 3b 20 20 20 28 7a 6d 71 2d 73 6f 63 6b 65 74 ;; (zmq-socket
31d0: 73 20 28 69 66 20 73 74 61 74 75 73 20 28 73 65 s (if status (se
31e0: 72 76 65 72 3a 63 6c 69 65 6e 74 2d 63 6f 6e 6e rver:client-conn
31f0: 65 63 74 20 68 6f 73 74 6e 61 6d 65 20 70 6f 72 ect hostname por
3200: 74 29 20 23 66 29 29 29 0a 09 09 20 3b 3b 20 6e t) #f)))... ;; n
3210: 6f 20 6e 65 65 64 20 74 6f 20 6c 6f 67 69 6e 20 o need to login
3220: 61 73 20 73 74 61 74 75 73 20 6f 66 20 23 74 20 as status of #t
3230: 69 6e 64 69 63 61 74 65 73 20 77 65 20 61 72 65 indicates we are
3240: 20 63 6f 6e 6e 65 63 74 69 6e 67 20 74 6f 20 63 connecting to c
3250: 6f 72 72 65 63 74 20 0a 09 09 20 3b 3b 20 73 65 orrect ... ;; se
3260: 72 76 65 72 0a 09 09 20 28 69 66 20 28 65 71 75 rver... (if (equ
3270: 61 6c 3f 20 73 74 61 74 65 20 22 64 65 61 64 22 al? state "dead"
3280: 29 0a 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 )... (if (>
3290: 6c 61 73 74 2d 75 70 64 61 74 65 20 28 2a 20 32 last-update (* 2
32a0: 35 20 36 30 20 36 30 29 29 20 3b 3b 20 6b 65 65 5 60 60)) ;; kee
32b0: 70 20 72 65 63 6f 72 64 73 20 61 72 6f 75 6e 64 p records around
32c0: 20 66 6f 72 20 73 6c 69 67 68 6c 79 20 6f 76 65 for slighly ove
32d0: 72 20 61 20 64 61 79 2e 0a 09 09 09 20 28 6f 70 r a day..... (op
32e0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 en-run-close tas
32f0: 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 ks:server-deregi
3300: 73 74 65 72 20 74 61 73 6b 73 3a 6f 70 65 6e 2d ster tasks:open-
3310: 64 62 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c 6c db hostname pull
3320: 70 6f 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 70 port: pullport p
3330: 69 64 3a 20 70 69 64 20 61 63 74 69 6f 6e 3a 20 id: pid action:
3340: 27 64 65 6c 65 74 65 29 29 0a 09 09 20 20 20 20 'delete))...
3350: 20 28 69 66 20 28 3e 20 6c 61 73 74 2d 75 70 64 (if (> last-upd
3360: 61 74 65 20 32 30 29 20 20 20 20 20 20 20 20 3b ate 20) ;
3370: 3b 20 4d 61 72 6b 20 61 73 20 64 65 61 64 20 69 ; Mark as dead i
3380: 66 20 6e 6f 74 20 75 70 64 61 74 65 64 20 69 6e f not updated in
3390: 20 6c 61 73 74 20 32 30 20 73 65 63 6f 6e 64 73 last 20 seconds
33a0: 0a 09 09 09 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 .... (open-run-c
33b0: 6c 6f 73 65 20 74 61 73 6b 73 3a 73 65 72 76 65 lose tasks:serve
33c0: 72 2d 64 65 72 65 67 69 73 74 65 72 20 74 61 73 r-deregister tas
33d0: 6b 73 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 74 6e ks:open-db hostn
33e0: 61 6d 65 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 ame pullport: pu
33f0: 6c 6c 70 6f 72 74 20 70 69 64 3a 20 70 69 64 29 llport pid: pid)
3400: 29 29 0a 0a 09 09 20 28 66 6f 72 6d 61 74 20 23 )).... (format #
3410: 74 20 66 6d 74 73 74 72 20 69 64 20 6d 74 2d 76 t fmtstr id mt-v
3420: 65 72 20 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 er pid hostname
3430: 69 6e 74 65 72 66 61 63 65 20 70 75 6c 6c 70 6f interface pullpo
3440: 72 74 20 70 75 62 70 6f 72 74 20 6c 61 73 74 2d rt pubport last-
3450: 75 70 64 61 74 65 0a 09 09 09 20 28 69 66 20 73 update.... (if s
3460: 74 61 74 75 73 20 22 61 6c 69 76 65 22 20 22 64 tatus "alive" "d
3470: 65 61 64 22 29 29 29 29 0a 09 20 20 20 20 20 73 ead")))).. s
3480: 65 72 76 65 72 73 29 0a 09 20 20 20 20 28 64 65 ervers).. (de
3490: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 bug:print-info 1
34a0: 20 22 44 6f 6e 65 20 77 69 74 68 20 6c 69 73 74 "Done with list
34b0: 73 65 72 76 65 72 73 22 29 0a 09 20 20 20 20 28 servers").. (
34c0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
34d0: 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 28 65 78 ng* #t).. (ex
34e0: 69 74 29 20 3b 3b 20 6d 75 73 74 20 64 6f 2c 20 it) ;; must do,
34f0: 77 6f 75 6c 64 20 68 61 76 65 20 74 6f 20 61 64 would have to ad
3500: 64 20 63 68 65 63 6b 73 20 74 6f 20 6d 61 6e 79 d checks to many
3510: 2f 61 6c 6c 20 63 61 6c 6c 73 20 62 65 6c 6f 77 /all calls below
3520: 0a 09 20 20 20 20 29 0a 09 20 20 28 65 78 69 74 .. ).. (exit
3530: 29 29 29 0a 20 20 20 20 3b 3b 20 69 66 20 6e 6f ))). ;; if no
3540: 74 20 6c 69 73 74 20 6f 72 20 6b 69 6c 6c 20 74 t list or kill t
3550: 68 65 6e 20 73 74 61 72 74 20 61 20 63 6c 69 65 hen start a clie
3560: 6e 74 20 28 69 66 20 61 70 70 72 6f 70 72 69 61 nt (if appropria
3570: 74 65 29 0a 20 20 20 20 28 69 66 20 28 6f 72 20 te). (if (or
3580: 28 61 72 67 73 2d 64 65 66 69 6e 65 64 3f 20 22 (args-defined? "
3590: 2d 68 22 20 22 2d 76 65 72 73 69 6f 6e 22 20 22 -h" "-version" "
35a0: 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 -gen-megatest-ar
35b0: 65 61 22 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 ea" "-gen-megate
35c0: 73 74 2d 74 65 73 74 22 29 0a 09 20 20 20 20 28 st-test").. (
35d0: 65 71 3f 20 28 6c 65 6e 67 74 68 20 28 68 61 73 eq? (length (has
35e0: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 61 72 67 h-table-keys arg
35f0: 73 3a 61 72 67 2d 68 61 73 68 29 29 20 30 29 29 s:arg-hash)) 0))
3600: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ..(debug:print-i
3610: 6e 66 6f 20 31 20 22 53 65 72 76 65 72 20 63 6f nfo 1 "Server co
3620: 6e 6e 65 63 74 69 6f 6e 20 6e 6f 74 20 6e 65 65 nnection not nee
3630: 64 65 64 22 29 0a 09 0a 09 28 73 65 72 76 65 72 ded")....(server
3640: 3a 63 6c 69 65 6e 74 2d 6c 61 75 6e 63 68 29 29 :client-launch))
3650: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
3660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 ===========.;; R
36a0: 65 6d 6f 76 65 20 6f 6c 64 20 72 75 6e 28 73 29 emove old run(s)
36b0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
36c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 69 =========..;; si
3700: 6e 63 65 20 73 65 76 65 72 61 6c 20 61 63 74 69 nce several acti
3710: 6f 6e 73 20 63 61 6e 20 62 65 20 73 70 65 63 69 ons can be speci
3720: 66 69 65 64 20 6f 6e 20 74 68 65 20 63 6f 6d 6d fied on the comm
3730: 61 6e 64 20 6c 69 6e 65 20 74 68 65 20 72 65 6d and line the rem
3740: 6f 76 61 6c 0a 3b 3b 20 69 73 20 64 6f 6e 65 20 oval.;; is done
3750: 66 69 72 73 74 0a 28 64 65 66 69 6e 65 20 28 6f first.(define (o
3760: 70 65 72 61 74 65 2d 6f 6e 20 61 63 74 69 6f 6e perate-on action
3770: 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 28 6e ). (cond. ((n
3780: 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
3790: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 20 20 ":runname")).
37a0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
37b0: 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 "ERROR: Missing
37c0: 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 required parame
37d0: 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f 6e ter for " action
37e0: 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 ", you must spe
37f0: 63 69 66 79 20 74 68 65 20 72 75 6e 20 6e 61 6d cify the run nam
3800: 65 20 70 61 74 74 65 72 6e 20 77 69 74 68 20 3a e pattern with :
3810: 72 75 6e 6e 61 6d 65 20 70 61 74 74 22 29 0a 20 runname patt").
3820: 20 20 20 28 65 78 69 74 20 32 29 29 0a 20 20 20 (exit 2)).
3830: 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d ((not (args:get-
3840: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
3850: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
3860: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4d 69 73 nt 0 "ERROR: Mis
3870: 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 sing required pa
3880: 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 rameter for " ac
3890: 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 tion ", you must
38a0: 20 73 70 65 63 69 66 79 20 74 68 65 20 74 65 73 specify the tes
38b0: 74 20 70 61 74 74 65 72 6e 20 77 69 74 68 20 2d t pattern with -
38c0: 74 65 73 74 70 61 74 74 22 29 0a 20 20 20 20 28 testpatt"). (
38d0: 65 78 69 74 20 33 29 29 0a 20 20 20 28 65 6c 73 exit 3)). (els
38e0: 65 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 e. (if (not (
38f0: 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a car *configinfo*
3900: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
3910: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
3920: 52 4f 52 3a 20 41 74 74 65 6d 70 74 65 64 20 22 ROR: Attempted "
3930: 20 61 63 74 69 6f 6e 20 22 6f 6e 20 74 65 73 74 action "on test
3940: 28 73 29 20 62 75 74 20 72 75 6e 20 61 72 65 61 (s) but run area
3950: 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e 6f 74 config file not
3960: 20 66 6f 75 6e 64 22 29 0a 09 20 20 28 65 78 69 found").. (exi
3970: 74 20 31 29 29 0a 09 3b 3b 20 70 75 74 20 74 65 t 1))..;; put te
3980: 73 74 20 70 61 72 61 6d 65 74 65 72 73 20 69 6e st parameters in
3990: 74 6f 20 63 6f 6e 76 65 6e 69 65 6e 74 20 76 61 to convenient va
39a0: 72 69 61 62 6c 65 73 0a 09 28 72 75 6e 73 3a 6f riables..(runs:o
39b0: 70 65 72 61 74 65 2d 6f 6e 20 20 61 63 74 69 6f perate-on actio
39c0: 6e 0a 09 09 09 20 20 28 61 72 67 73 3a 67 65 74 n.... (args:get
39d0: 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 -arg ":runname")
39e0: 0a 09 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d .... (args:get-
39f0: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
3a00: 0a 09 09 09 20 20 73 74 61 74 65 3a 20 28 61 72 .... state: (ar
3a10: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
3a20: 74 65 22 29 20 0a 09 09 09 20 20 73 74 61 74 75 te") .... statu
3a30: 73 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 s: (args:get-arg
3a40: 20 22 3a 73 74 61 74 75 73 22 29 0a 09 09 09 20 ":status")....
3a50: 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 new-state-statu
3a60: 73 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 s: (args:get-arg
3a70: 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 "-set-state-sta
3a80: 74 75 73 22 29 29 29 0a 20 20 20 20 28 73 65 74 tus"))). (set
3a90: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
3aa0: 20 23 74 29 29 29 29 0a 09 20 20 0a 28 69 66 20 #t)))).. .(if
3ab0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3ac0: 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a 20 20 remove-runs").
3ad0: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
3ae0: 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 65 6d 6f all . "-remo
3af0: 76 65 2d 72 75 6e 73 22 0a 20 20 20 20 20 22 72 ve-runs". "r
3b00: 65 6d 6f 76 65 20 72 75 6e 73 22 0a 20 20 20 20 emove runs".
3b10: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
3b20: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
3b30: 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 ynames keyvallst
3b40: 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 ). (operat
3b50: 65 2d 6f 6e 20 27 72 65 6d 6f 76 65 2d 72 75 6e e-on 'remove-run
3b60: 73 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 s))))..(if (args
3b70: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 :get-arg "-set-s
3b80: 74 61 74 65 2d 73 74 61 74 75 73 22 29 0a 20 20 tate-status").
3b90: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
3ba0: 61 6c 6c 20 0a 20 20 20 20 20 22 2d 73 65 74 2d all . "-set-
3bb0: 73 74 61 74 65 2d 73 74 61 74 75 73 22 0a 20 20 state-status".
3bc0: 20 20 20 22 73 65 74 20 73 74 61 74 65 20 61 6e "set state an
3bd0: 64 20 73 74 61 74 75 73 22 0a 20 20 20 20 20 28 d status". (
3be0: 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 lambda (target r
3bf0: 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e unname keys keyn
3c00: 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a ames keyvallst).
3c10: 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d (operate-
3c20: 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 on 'set-state-st
3c30: 61 74 75 73 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d atus))))..;;====
3c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c80: 3d 3d 0a 3b 3b 20 51 75 65 72 79 20 72 75 6e 73 ==.;; Query runs
3c90: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
3ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
3ce0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
3cf0: 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 0a 09 "-list-runs")..
3d00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3d10: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 list-db-targets"
3d20: 29 29 0a 20 20 20 20 28 69 66 20 28 73 65 74 75 )). (if (setu
3d30: 70 2d 66 6f 72 2d 72 75 6e 29 0a 09 28 6c 65 74 p-for-run)..(let
3d40: 2a 20 28 28 64 62 20 20 20 20 20 20 20 23 66 29 * ((db #f)
3d50: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 70 61 74 .. (runpat
3d60: 74 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 t (args:get-arg
3d70: 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 29 0a "-list-runs")).
3d80: 09 20 20 20 20 20 20 20 28 74 65 73 74 70 61 74 . (testpat
3d90: 74 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d t (if (args:get-
3da0: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
3db0: 20 0a 09 09 09 20 20 20 20 20 28 61 72 67 73 3a .... (args:
3dc0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
3dd0: 74 74 22 29 20 0a 09 09 09 20 20 20 20 20 22 41 tt") .... "A
3de0: 20 6c 6f 6e 67 20 61 6e 64 20 72 65 64 69 63 75 long and redicu
3df0: 6c 6f 75 73 20 74 65 73 74 20 6e 61 6d 65 20 74 lous test name t
3e00: 68 61 74 20 68 6f 70 65 66 75 6c 6c 79 20 77 69 hat hopefully wi
3e10: 6c 6c 20 6e 65 76 65 72 20 6d 61 74 63 68 22 29 ll never match")
3e20: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 64 ).. (runsd
3e30: 61 74 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c at (open-run-cl
3e40: 6f 73 65 20 64 62 3a 67 65 74 2d 72 75 6e 73 20 ose db:get-runs
3e50: 64 62 20 72 75 6e 70 61 74 74 20 23 66 20 23 66 db runpatt #f #f
3e60: 20 27 28 29 29 29 0a 09 20 20 20 20 20 20 20 28 '())).. (
3e70: 72 75 6e 73 20 20 20 20 20 28 64 62 3a 67 65 74 runs (db:get
3e80: 2d 72 6f 77 73 20 72 75 6e 73 64 61 74 29 29 0a -rows runsdat)).
3e90: 09 20 20 20 20 20 20 20 28 68 65 61 64 65 72 20 . (header
3ea0: 20 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 (db:get-header
3eb0: 20 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 20 runsdat))..
3ec0: 20 20 20 28 6b 65 79 73 20 20 20 20 20 28 6f 70 (keys (op
3ed0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a en-run-close db:
3ee0: 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 get-keys db))..
3ef0: 20 20 20 20 20 20 28 6b 65 79 6e 61 6d 65 73 20 (keynames
3f00: 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 (map key:get-fie
3f10: 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 0a 09 20 ldname keys))..
3f20: 20 20 20 20 20 20 28 64 62 2d 74 61 72 67 65 74 (db-target
3f30: 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 s (args:get-arg
3f40: 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 "-list-db-target
3f50: 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 65 s")).. (se
3f60: 65 6e 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 en (make-has
3f70: 68 2d 74 61 62 6c 65 29 29 29 0a 09 20 20 3b 3b h-table))).. ;;
3f80: 20 45 61 63 68 20 72 75 6e 0a 09 20 20 28 66 6f Each run.. (fo
3f90: 72 2d 65 61 63 68 20 0a 09 20 20 20 28 6c 61 6d r-each .. (lam
3fa0: 62 64 61 20 28 72 75 6e 29 0a 09 20 20 20 20 20 bda (run)..
3fb0: 28 6c 65 74 20 28 28 74 61 72 67 65 74 73 74 72 (let ((targetstr
3fc0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
3fd0: 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 erse (map (lambd
3fe0: 61 20 28 78 29 0a 09 09 09 09 09 09 09 20 28 64 a (x)........ (d
3ff0: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
4000: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
4010: 20 78 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 x)).......
4020: 20 20 6b 65 79 6e 61 6d 65 73 29 20 22 2f 22 29 keynames) "/")
4030: 29 29 0a 09 20 20 20 20 20 20 20 28 69 66 20 64 )).. (if d
4040: 62 2d 74 61 72 67 65 74 73 0a 09 09 20 20 20 28 b-targets... (
4050: 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 if (not (hash-ta
4060: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
4070: 73 65 65 6e 20 74 61 72 67 65 74 73 74 72 20 23 seen targetstr #
4080: 66 29 29 0a 09 09 20 20 20 20 20 20 20 28 62 65 f))... (be
4090: 67 69 6e 0a 09 09 09 20 28 68 61 73 68 2d 74 61 gin.... (hash-ta
40a0: 62 6c 65 2d 73 65 74 21 20 73 65 65 6e 20 74 61 ble-set! seen ta
40b0: 72 67 65 74 73 74 72 20 23 74 29 0a 09 09 09 20 rgetstr #t)....
40c0: 28 70 72 69 6e 74 20 74 61 72 67 65 74 73 74 72 (print targetstr
40d0: 29 29 29 0a 09 09 20 20 20 28 64 65 62 75 67 3a )))... (debug:
40e0: 70 72 69 6e 74 20 31 20 0a 09 09 09 09 28 69 66 print 1 .....(if
40f0: 20 64 62 2d 74 61 72 67 65 74 73 20 22 22 20 22 db-targets "" "
4100: 52 75 6e 3a 20 22 29 0a 09 09 09 09 74 61 72 67 Run: ").....targ
4110: 65 74 73 74 72 20 0a 09 09 09 09 28 69 66 20 64 etstr .....(if d
4120: 62 2d 74 61 72 67 65 74 73 20 22 22 20 28 63 6f b-targets "" (co
4130: 6e 63 20 22 20 73 74 61 74 75 73 3a 20 22 20 28 nc " status: " (
4140: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
4150: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
4160: 72 20 22 73 74 61 74 65 22 29 29 29 29 0a 09 09 r "state"))))...
4170: 20 20 20 29 29 0a 09 20 20 20 20 20 28 6c 65 74 )).. (let
4180: 20 28 28 72 75 6e 2d 69 64 20 28 6f 70 65 6e 2d ((run-id (open-
4190: 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 run-close db:get
41a0: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
41b0: 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 64 22 run header "id"
41c0: 29 29 29 0a 09 20 20 20 20 20 20 20 28 6c 65 74 ))).. (let
41d0: 20 28 28 74 65 73 74 73 20 28 6f 70 65 6e 2d 72 ((tests (open-r
41e0: 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 2d un-close db:get-
41f0: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 tests-for-run db
4200: 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 74 74 run-id testpatt
4210: 20 27 28 29 20 27 28 29 29 29 29 0a 09 09 20 3b '() '())))... ;
4220: 3b 20 45 61 63 68 20 74 65 73 74 0a 09 09 20 28 ; Each test... (
4230: 66 6f 72 2d 65 61 63 68 20 0a 09 09 20 20 28 6c for-each ... (l
4240: 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 20 ambda (test)...
4250: 20 20 20 28 66 6f 72 6d 61 74 20 23 74 0a 09 09 (format #t...
4260: 09 20 20 20 20 22 20 20 54 65 73 74 3a 20 7e 32 . " Test: ~2
4270: 35 61 20 53 74 61 74 65 3a 20 7e 31 35 61 20 53 5a State: ~15a S
4280: 74 61 74 75 73 3a 20 7e 31 35 61 20 52 75 6e 74 tatus: ~15a Runt
4290: 69 6d 65 3a 20 7e 35 40 61 73 20 54 69 6d 65 3a ime: ~5@as Time:
42a0: 20 7e 32 32 61 20 48 6f 73 74 3a 20 7e 31 30 61 ~22a Host: ~10a
42b0: 5c 6e 22 0a 09 09 09 20 20 20 20 28 63 6f 6e 63 \n".... (conc
42c0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 (db:test-get-te
42d0: 73 74 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 09 stname test)....
42e0: 09 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 . (if (equal? (
42f0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d db:test-get-item
4300: 2d 70 61 74 68 20 74 65 73 74 29 20 22 22 29 0a -path test) "").
4310: 09 09 09 09 20 20 20 20 20 20 22 22 20 0a 09 09 .... "" ...
4320: 09 09 20 20 20 20 20 20 28 63 6f 6e 63 20 22 28 .. (conc "(
4330: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 " (db:test-get-i
4340: 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 20 22 tem-path test) "
4350: 29 22 29 29 29 0a 09 09 09 20 20 20 20 28 64 62 )"))).... (db
4360: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
4370: 74 65 73 74 29 0a 09 09 09 20 20 20 20 28 64 62 test).... (db
4380: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
4390: 20 74 65 73 74 29 0a 09 09 09 20 20 20 20 28 64 test).... (d
43a0: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 b:test-get-run_d
43b0: 75 72 61 74 69 6f 6e 20 74 65 73 74 29 0a 09 09 uration test)...
43c0: 09 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 . (db:test-ge
43d0: 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 t-event_time tes
43e0: 74 29 0a 09 09 09 20 20 20 20 28 64 62 3a 74 65 t).... (db:te
43f0: 73 74 2d 67 65 74 2d 68 6f 73 74 20 74 65 73 74 st-get-host test
4400: 29 29 0a 09 09 20 20 20 20 28 69 66 20 28 6e 6f ))... (if (no
4410: 74 20 28 6f 72 20 28 65 71 75 61 6c 3f 20 28 64 t (or (equal? (d
4420: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 b:test-get-statu
4430: 73 20 74 65 73 74 29 20 22 50 41 53 53 22 29 0a s test) "PASS").
4440: 09 09 09 09 20 28 65 71 75 61 6c 3f 20 28 64 62 .... (equal? (db
4450: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
4460: 20 74 65 73 74 29 20 22 57 41 52 4e 22 29 0a 09 test) "WARN")..
4470: 09 09 09 20 28 65 71 75 61 6c 3f 20 28 64 62 3a ... (equal? (db:
4480: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
4490: 65 73 74 29 20 20 22 4e 4f 54 5f 53 54 41 52 54 est) "NOT_START
44a0: 45 44 22 29 29 29 0a 09 09 09 28 62 65 67 69 6e ED")))....(begin
44b0: 0a 09 09 09 20 20 28 70 72 69 6e 74 20 22 20 20 .... (print "
44c0: 20 20 20 20 20 20 20 63 70 75 6c 6f 61 64 3a 20 cpuload:
44d0: 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d " (db:test-get-
44e0: 63 70 75 6c 6f 61 64 20 74 65 73 74 29 0a 09 09 cpuload test)...
44f0: 09 09 20 22 5c 6e 20 20 20 20 20 20 20 20 20 64 .. "\n d
4500: 69 73 6b 66 72 65 65 3a 20 22 20 28 64 62 3a 74 iskfree: " (db:t
4510: 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 65 est-get-diskfree
4520: 20 74 65 73 74 29 0a 09 09 09 09 20 22 5c 6e 20 test)..... "\n
4530: 20 20 20 20 20 20 20 20 75 6e 61 6d 65 3a 20 20 uname:
4540: 20 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 " (db:test-get
4550: 2d 75 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 09 -uname test)....
4560: 09 20 22 5c 6e 20 20 20 20 20 20 20 20 20 72 75 . "\n ru
4570: 6e 64 69 72 3a 20 20 20 22 20 28 64 62 3a 74 65 ndir: " (db:te
4580: 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 st-get-rundir te
4590: 73 74 29 0a 09 09 09 09 20 29 0a 09 09 09 20 20 st)..... )....
45a0: 3b 3b 20 45 61 63 68 20 74 65 73 74 0a 09 09 09 ;; Each test....
45b0: 20 20 28 6c 65 74 20 28 28 73 74 65 70 73 20 28 (let ((steps (
45c0: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 open-run-close d
45d0: 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d b:get-steps-for-
45e0: 74 65 73 74 20 64 62 20 28 64 62 3a 74 65 73 74 test db (db:test
45f0: 2d 67 65 74 2d 69 64 20 74 65 73 74 29 29 29 29 -get-id test))))
4600: 0a 09 09 09 20 20 20 20 28 66 6f 72 2d 65 61 63 .... (for-eac
4610: 68 20 0a 09 09 09 20 20 20 20 20 28 6c 61 6d 62 h .... (lamb
4620: 64 61 20 28 73 74 65 70 29 0a 09 09 09 20 20 20 da (step)....
4630: 20 20 20 20 28 66 6f 72 6d 61 74 20 23 74 20 0a (format #t .
4640: 09 09 09 09 20 20 20 20 20 20 20 22 20 20 20 20 .... "
4650: 53 74 65 70 3a 20 7e 32 30 61 20 53 74 61 74 65 Step: ~20a State
4660: 3a 20 7e 31 30 61 20 53 74 61 74 75 73 3a 20 7e : ~10a Status: ~
4670: 31 30 61 20 54 69 6d 65 20 7e 32 32 61 5c 6e 22 10a Time ~22a\n"
4680: 0a 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a ..... (db:
4690: 73 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d step-get-stepnam
46a0: 65 20 73 74 65 70 29 0a 09 09 09 09 20 20 20 20 e step).....
46b0: 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d (db:step-get-
46c0: 73 74 61 74 65 20 73 74 65 70 29 0a 09 09 09 09 state step).....
46d0: 20 20 20 20 20 20 20 28 64 62 3a 73 74 65 70 2d (db:step-
46e0: 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 70 29 get-status step)
46f0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a ..... (db:
4700: 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
4710: 69 6d 65 20 73 74 65 70 29 29 29 0a 09 09 09 20 ime step)))....
4720: 20 20 20 20 73 74 65 70 73 29 29 29 29 29 0a 09 steps)))))..
4730: 09 20 20 74 65 73 74 73 29 29 29 29 0a 09 20 20 . tests))))..
4740: 20 72 75 6e 73 29 0a 09 20 20 28 73 65 74 21 20 runs).. (set!
4750: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
4760: 74 29 29 0a 09 28 65 78 69 74 29 29 29 0a 0a 3b t))..(exit)))..;
4770: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
4780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
47a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
47b0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 =======.;; full
47c0: 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;==========
47d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
47e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 3b 3b ============..;;
4810: 20 67 65 74 20 6c 6f 63 6b 20 69 6e 20 64 62 20 get lock in db
4820: 66 6f 72 20 66 75 6c 6c 20 72 75 6e 20 66 6f 72 for full run for
4830: 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 0a this directory.
4840: 3b 3b 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 ;; for all tests
4850: 20 77 69 74 68 20 64 65 70 73 0a 3b 3b 20 20 20 with deps.;;
4860: 77 61 6c 6b 20 74 72 65 65 20 6f 66 20 74 65 73 walk tree of tes
4870: 74 73 20 74 6f 20 66 69 6e 64 20 68 65 61 64 20 ts to find head
4880: 74 61 73 6b 73 0a 3b 3b 20 20 20 61 64 64 20 68 tasks.;; add h
4890: 65 61 64 20 74 61 73 6b 73 20 74 6f 20 74 61 73 ead tasks to tas
48a0: 6b 20 71 75 65 75 65 0a 3b 3b 20 20 20 61 64 64 k queue.;; add
48b0: 20 64 65 70 65 6e 64 61 6e 74 20 74 61 73 6b 73 dependant tasks
48c0: 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 20 0a to task queue .
48d0: 3b 3b 20 20 20 61 64 64 20 72 65 6d 61 69 6e 69 ;; add remaini
48e0: 6e 67 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b ng tasks to task
48f0: 20 71 75 65 75 65 0a 3b 3b 20 66 6f 72 20 65 61 queue.;; for ea
4900: 63 68 20 74 61 73 6b 20 69 6e 20 74 61 73 6b 20 ch task in task
4910: 71 75 65 75 65 0a 3b 3b 20 20 20 69 66 20 68 61 queue.;; if ha
4920: 76 65 20 61 64 65 71 75 61 74 65 20 72 65 73 6f ve adequate reso
4930: 75 72 63 65 73 0a 3b 3b 20 20 20 20 20 6c 61 75 urces.;; lau
4940: 6e 63 68 20 74 61 73 6b 0a 3b 3b 20 20 20 65 6c nch task.;; el
4950: 73 65 0a 3b 3b 20 20 20 20 20 70 75 74 20 74 61 se.;; put ta
4960: 73 6b 20 69 6e 20 64 65 66 65 72 72 65 64 20 71 sk in deferred q
4970: 75 65 75 65 0a 3b 3b 20 69 66 20 73 74 69 6c 6c ueue.;; if still
4980: 20 6f 6b 20 74 6f 20 72 75 6e 20 74 61 73 6b 73 ok to run tasks
4990: 0a 3b 3b 20 20 20 70 72 6f 63 65 73 73 20 64 65 .;; process de
49a0: 66 65 72 72 65 64 20 74 61 73 6b 73 20 70 65 72 ferred tasks per
49b0: 20 61 62 6f 76 65 20 73 74 65 70 73 0a 0a 3b 3b above steps..;;
49c0: 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 61 run all tests a
49d0: 72 65 20 61 72 65 20 4e 6f 74 20 43 4f 4d 50 4c re are Not COMPL
49e0: 45 54 45 44 20 61 6e 64 20 50 41 53 53 20 6f 72 ETED and PASS or
49f0: 20 43 48 45 43 4b 0a 28 69 66 20 28 6f 72 20 28 CHECK.(if (or (
4a00: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
4a10: 75 6e 61 6c 6c 22 29 20 3b 3b 20 64 65 70 72 65 unall") ;; depre
4a20: 63 61 74 65 64 0a 09 28 61 72 67 73 3a 67 65 74 cated..(args:get
4a30: 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a 09 28 61 -arg "-run")..(a
4a40: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
4a50: 6e 74 65 73 74 73 22 29 29 0a 20 20 20 20 28 62 ntests")). (b
4a60: 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 egin. (if (
4a70: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
4a80: 65 73 74 70 61 74 74 22 29 0a 09 20 20 28 62 65 estpatt").. (be
4a90: 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a gin.. (debug:
4aa0: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 2d print 0 "ERROR:-
4ab0: 74 65 73 74 70 61 74 74 20 69 73 20 64 65 70 72 testpatt is depr
4ac0: 65 63 61 74 65 64 2c 20 75 73 65 20 2d 72 75 6e ecated, use -run
4ad0: 20 70 61 74 74 31 2c 70 61 74 74 32 2e 2e 2e 20 patt1,patt2...
4ae0: 69 6e 73 74 65 61 64 2c 20 79 6f 75 72 20 70 61 instead, your pa
4af0: 74 74 65 72 6e 20 22 20 28 61 72 67 73 3a 67 65 ttern " (args:ge
4b00: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
4b10: 22 29 20 22 20 77 69 6c 6c 20 62 65 20 69 67 6e ") " will be ign
4b20: 6f 72 65 64 22 29 0a 09 20 20 20 20 28 73 6c 65 ored").. (sle
4b30: 65 70 20 33 29 29 29 0a 20 20 20 20 20 20 28 69 ep 3))). (i
4b40: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
4b50: 22 2d 69 74 65 6d 70 61 74 74 22 29 0a 09 20 20 "-itempatt")..
4b60: 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 (begin.. (deb
4b70: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
4b80: 52 3a 20 2d 69 74 65 6d 70 61 74 74 20 69 73 20 R: -itempatt is
4b90: 6e 6f 74 20 75 73 65 64 20 77 69 74 68 20 2d 72 not used with -r
4ba0: 75 6e 2c 20 79 6f 75 72 20 70 61 74 74 65 72 6e un, your pattern
4bb0: 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 " (args:get-arg
4bc0: 20 22 2d 69 74 65 6d 70 61 74 74 22 29 20 22 20 "-itempatt") "
4bd0: 77 69 6c 6c 20 62 65 20 69 67 6e 6f 72 65 64 22 will be ignored"
4be0: 29 0a 09 20 20 20 20 28 73 6c 65 65 70 20 33 29 ).. (sleep 3)
4bf0: 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 61 72 )). (if (ar
4c00: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
4c10: 61 6c 6c 22 29 0a 09 20 20 28 62 65 67 69 6e 0a all").. (begin.
4c20: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
4c30: 74 20 30 20 22 45 52 52 4f 52 3a 20 2d 72 75 6e t 0 "ERROR: -run
4c40: 61 6c 6c 20 69 73 20 64 65 70 72 65 63 61 74 65 all is deprecate
4c50: 64 2c 20 75 73 65 20 2d 72 75 6e 20 70 61 74 74 d, use -run patt
4c60: 31 2c 70 61 74 74 32 20 2e 2e 2e 20 69 6e 73 74 1,patt2 ... inst
4c70: 65 61 64 22 29 0a 09 20 20 20 20 28 73 6c 65 65 ead").. (slee
4c80: 70 20 33 29 29 29 0a 20 20 20 20 20 20 28 69 66 p 3))). (if
4c90: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4ca0: 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 20 20 28 -runtests").. (
4cb0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 debug:print 0 "W
4cc0: 41 52 4e 49 4e 47 3a 20 2d 72 75 6e 74 65 73 74 ARNING: -runtest
4cd0: 73 20 69 73 20 64 65 70 72 65 63 61 74 65 64 2c s is deprecated,
4ce0: 20 75 73 65 20 2d 72 75 6e 20 70 61 74 74 31 2c use -run patt1,
4cf0: 70 61 74 74 32 20 2e 2e 2e 20 69 6e 73 74 65 61 patt2 ... instea
4d00: 64 22 29 29 0a 20 20 20 20 20 20 28 67 65 6e 65 d")). (gene
4d10: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 ral-run-call .
4d20: 20 20 20 20 20 22 2d 72 75 6e 22 0a 20 20 20 20 "-run".
4d30: 20 20 20 22 72 75 6e 20 74 65 73 74 73 22 0a 20 "run tests".
4d40: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 (lambda (t
4d50: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
4d60: 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 ys keynames keyv
4d70: 61 6c 6c 73 74 29 0a 09 20 28 72 75 6e 73 3a 72 allst).. (runs:r
4d80: 75 6e 2d 74 65 73 74 73 20 74 61 72 67 65 74 0a un-tests target.
4d90: 09 09 09 20 72 75 6e 6e 61 6d 65 0a 09 09 09 20 ... runname....
4da0: 27 28 29 0a 09 09 09 20 28 6f 72 20 28 61 72 67 '().... (or (arg
4db0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 s:get-arg "-run"
4dc0: 29 0a 09 09 09 20 20 20 20 20 28 61 72 67 73 3a ).... (args:
4dd0: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 get-arg "-runtes
4de0: 74 73 22 29 0a 09 09 09 20 20 20 20 20 28 61 72 ts").... (ar
4df0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
4e00: 74 70 61 74 74 22 29 29 0a 09 09 09 20 75 73 65 tpatt")).... use
4e10: 72 0a 09 09 09 20 61 72 67 73 3a 61 72 67 2d 68 r.... args:arg-h
4e20: 61 73 68 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d ash)))))..;;====
4e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e70: 3d 3d 0a 3b 3b 20 72 75 6e 20 6f 6e 65 20 74 65 ==.;; run one te
4e80: 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d st.;;===========
4e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
4ed0: 31 2e 20 66 69 6e 64 20 74 68 65 20 63 6f 6e 66 1. find the conf
4ee0: 69 67 20 66 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 ig file.;; 2. ch
4ef0: 61 6e 67 65 20 74 6f 20 74 68 65 20 74 65 73 74 ange to the test
4f00: 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 33 2e directory.;; 3.
4f10: 20 75 70 64 61 74 65 20 74 68 65 20 64 62 20 77 update the db w
4f20: 69 74 68 20 22 74 65 73 74 20 73 74 61 72 74 65 ith "test starte
4f30: 64 22 20 73 74 61 74 75 73 2c 20 73 65 74 20 72 d" status, set r
4f40: 75 6e 6e 69 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 unning host.;; 4
4f50: 2e 20 70 72 6f 63 65 73 73 20 6c 61 75 6e 63 68 . process launch
4f60: 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 the test.;;
4f70: 2d 20 6d 6f 6e 69 74 6f 72 20 74 68 65 20 70 72 - monitor the pr
4f80: 6f 63 65 73 73 2c 20 75 70 64 61 74 65 20 73 74 ocess, update st
4f90: 61 74 73 20 69 6e 20 74 68 65 20 64 62 20 65 76 ats in the db ev
4fa0: 65 72 79 20 32 5e 6e 20 6d 69 6e 75 74 65 73 0a ery 2^n minutes.
4fb0: 3b 3b 20 35 2e 20 61 73 20 74 68 65 20 74 65 73 ;; 5. as the tes
4fc0: 74 20 70 72 6f 63 65 65 64 73 20 69 6e 74 65 72 t proceeds inter
4fd0: 6e 61 6c 6c 79 20 69 74 20 63 61 6c 6c 73 20 6d nally it calls m
4fe0: 65 67 61 74 65 73 74 20 61 73 20 65 61 63 68 20 egatest as each
4ff0: 73 74 65 70 20 69 73 0a 3b 3b 20 20 20 20 73 74 step is.;; st
5000: 61 72 74 65 64 20 61 6e 64 20 63 6f 6d 70 6c 65 arted and comple
5010: 74 65 64 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 ted.;; - step
5020: 20 73 74 61 72 74 65 64 2c 20 74 69 6d 65 73 74 started, timest
5030: 61 6d 70 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 amp.;; - step
5040: 20 63 6f 6d 70 6c 65 74 65 64 2c 20 65 78 69 74 completed, exit
5050: 20 73 74 61 74 75 73 2c 20 74 69 6d 65 73 74 61 status, timesta
5060: 6d 70 0a 3b 3b 20 36 2e 20 74 65 73 74 20 70 68 mp.;; 6. test ph
5070: 6f 6e 65 20 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d one home.;; -
5080: 20 69 66 20 74 65 73 74 20 72 75 6e 20 74 69 6d if test run tim
5090: 65 20 3e 20 61 6c 6c 6f 77 65 64 20 72 75 6e 20 e > allowed run
50a0: 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a time then kill j
50b0: 6f 62 0a 3b 3b 20 20 20 20 2d 20 69 66 20 63 61 ob.;; - if ca
50c0: 6e 6e 6f 74 20 61 63 63 65 73 73 20 64 62 20 3e nnot access db >
50d0: 20 61 6c 6c 6f 77 65 64 20 64 69 73 63 6f 6e 6e allowed disconn
50e0: 65 63 74 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 ect time then ki
50f0: 6c 6c 20 6a 6f 62 0a 0a 3b 3b 20 28 69 66 20 28 ll job..;; (if (
5100: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
5110: 75 6e 74 65 73 74 73 22 29 0a 3b 3b 20 20 20 28 untests").;; (
5120: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
5130: 20 0a 3b 3b 20 20 20 20 22 2d 72 75 6e 74 65 73 .;; "-runtes
5140: 74 73 22 20 0a 3b 3b 20 20 20 20 22 72 75 6e 20 ts" .;; "run
5150: 61 20 74 65 73 74 22 20 0a 3b 3b 20 20 20 20 28 a test" .;; (
5160: 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 lambda (target r
5170: 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e unname keys keyn
5180: 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a ames keyvallst).
5190: 3b 3b 20 20 20 20 20 20 28 72 75 6e 73 3a 72 75 ;; (runs:ru
51a0: 6e 2d 74 65 73 74 73 20 74 61 72 67 65 74 0a 3b n-tests target.;
51b0: 3b 20 09 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 ; .. runname
51c0: 0a 3b 3b 20 09 09 20 20 20 20 20 28 61 72 67 73 .;; .. (args
51d0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
51e0: 73 74 73 22 29 0a 3b 3b 20 09 09 20 20 20 20 20 sts").;; ..
51f0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5200: 74 65 73 74 70 61 74 74 22 29 0a 3b 3b 20 09 09 testpatt").;; ..
5210: 20 20 20 20 20 75 73 65 72 0a 3b 3b 20 09 09 20 user.;; ..
5220: 20 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 73 args:arg-has
5230: 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d h))))..;;=======
5240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
5280: 3b 3b 20 52 6f 6c 6c 75 70 20 69 6e 74 6f 20 61 ;; Rollup into a
5290: 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;=========
52a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
52e0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
52f0: 20 22 2d 72 6f 6c 6c 75 70 22 29 0a 20 20 20 20 "-rollup").
5300: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 64 65 (begin. (de
5310: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
5320: 4f 52 3a 20 52 6f 6c 6c 75 70 20 69 73 20 63 75 OR: Rollup is cu
5330: 72 72 65 6e 74 6c 79 20 6e 6f 74 20 77 6f 72 6b rrently not work
5340: 69 6e 67 2e 20 49 66 20 79 6f 75 20 6e 65 65 64 ing. If you need
5350: 20 69 74 20 70 6c 65 61 73 65 20 73 75 62 6d 69 it please submi
5360: 74 20 61 20 74 69 63 6b 65 74 20 61 74 20 68 74 t a ticket at ht
5370: 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e tp://www.kiatoa.
5380: 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 61 com/fossils/mega
5390: 74 65 73 74 22 29 0a 20 20 20 20 20 20 28 65 78 test"). (ex
53a0: 69 74 20 34 29 29 29 0a 3b 3b 20 20 20 20 20 28 it 4))).;; (
53b0: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
53c0: 20 0a 3b 3b 20 20 20 20 20 20 22 2d 72 6f 6c 6c .;; "-roll
53d0: 75 70 22 20 0a 3b 3b 20 20 20 20 20 20 22 72 6f up" .;; "ro
53e0: 6c 6c 75 70 20 74 65 73 74 73 22 20 0a 3b 3b 20 llup tests" .;;
53f0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 (lambda (ta
5400: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
5410: 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 s keynames keyva
5420: 6c 6c 73 74 29 0a 3b 3b 20 20 20 20 20 20 20 20 llst).;;
5430: 28 72 75 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e (runs:rollup-run
5440: 20 6b 65 79 73 0a 3b 3b 20 09 09 09 28 6b 65 79 keys.;; ...(key
5450: 73 2d 3e 61 6c 69 73 74 20 6b 65 79 73 20 22 6e s->alist keys "n
5460: 61 22 29 0a 3b 3b 20 09 09 09 28 61 72 67 73 3a a").;; ...(args:
5470: 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d get-arg ":runnam
5480: 65 22 29 20 0a 3b 3b 20 09 09 09 75 73 65 72 29 e") .;; ...user)
5490: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
54a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
54b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
54c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
54d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
54e0: 20 4c 6f 63 6b 20 6f 72 20 75 6e 6c 6f 63 6b 20 Lock or unlock
54f0: 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d a run.;;========
5500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
5540: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
5550: 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 28 61 t-arg "-lock")(a
5560: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e rgs:get-arg "-un
5570: 6c 6f 63 6b 22 29 29 0a 20 20 20 20 28 67 65 6e lock")). (gen
5580: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 eral-run-call .
5590: 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 (if (args:ge
55a0: 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 20 22 t-arg "-lock") "
55b0: 2d 6c 6f 63 6b 22 20 22 2d 75 6e 6c 6f 63 6b 22 -lock" "-unlock"
55c0: 29 0a 20 20 20 20 20 22 6c 6f 63 6b 2f 75 6e 6c ). "lock/unl
55d0: 6f 63 6b 20 74 65 73 74 73 22 20 0a 20 20 20 20 ock tests" .
55e0: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
55f0: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
5600: 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 ynames keyvallst
5610: 29 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a 68 ). (runs:h
5620: 61 6e 64 6c 65 2d 6c 6f 63 6b 69 6e 67 20 0a 09 andle-locking ..
5630: 09 20 20 74 61 72 67 65 74 0a 09 09 20 20 6b 65 . target... ke
5640: 79 73 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 ys... (args:get
5650: 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 -arg ":runname")
5660: 20 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d ... (args:get-
5670: 61 72 67 20 22 2d 6c 6f 63 6b 22 29 0a 09 09 20 arg "-lock")...
5680: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5690: 2d 75 6e 6c 6f 63 6b 22 29 0a 09 09 20 20 75 73 -unlock")... us
56a0: 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d er))))..;;======
56b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
56c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
56d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
56e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
56f0: 0a 3b 3b 20 47 65 74 20 70 61 74 68 73 20 74 6f .;; Get paths to
5700: 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d tests.;;=======
5710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
5750: 3b 3b 20 47 65 74 20 74 65 73 74 20 70 61 74 68 ;; Get test path
5760: 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 s matching targe
5770: 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 74 65 73 74 t, runname, test
5780: 70 61 74 74 2c 20 61 6e 64 20 69 74 65 6d 70 61 patt, and itempa
5790: 74 74 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 tt.(if (or (args
57a0: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d :get-arg "-test-
57b0: 66 69 6c 65 73 22 29 28 61 72 67 73 3a 67 65 74 files")(args:get
57c0: 2d 61 72 67 20 22 2d 74 65 73 74 2d 70 61 74 68 -arg "-test-path
57d0: 73 22 29 29 0a 20 20 20 20 3b 3b 20 69 66 20 77 s")). ;; if w
57e0: 65 20 61 72 65 20 69 6e 20 61 20 74 65 73 74 20 e are in a test
57f0: 75 73 65 20 74 68 65 20 4d 54 5f 43 4d 44 49 4e use the MT_CMDIN
5800: 46 4f 20 64 61 74 61 0a 20 20 20 20 28 69 66 20 FO data. (if
5810: 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (getenv "MT_CMDI
5820: 4e 46 4f 22 29 0a 09 28 6c 65 74 2a 20 28 28 73 NFO")..(let* ((s
5830: 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 tartingdir (curr
5840: 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a ent-directory)).
5850: 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f . (cmdinfo
5860: 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 (read (open-i
5870: 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 nput-string (bas
5880: 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 e64:base64-decod
5890: 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d e (getenv "MT_CM
58a0: 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 20 DINFO")))))..
58b0: 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 (testpath (
58c0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
58d0: 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
58e0: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
58f0: 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 -name (assoc/def
5900: 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 ault 'test-name
5910: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
5920: 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 (runscript (as
5930: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
5940: 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 script cmdinfo))
5950: 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 .. (db-hos
5960: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
5970: 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d lt 'db-host cm
5980: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
5990: 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f (run-id (asso
59a0: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 c/default 'run-i
59b0: 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 d cmdinfo))..
59c0: 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 (itemdat
59d0: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
59e0: 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 'itemdat cmdi
59f0: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 nfo)).. (d
5a00: 62 20 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 b #f)..
5a10: 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 20 (state
5a20: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
5a30: 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 state"))..
5a40: 20 28 73 74 61 74 75 73 20 20 20 20 28 61 72 67 (status (arg
5a50: 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
5a60: 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 us")).. (t
5a70: 61 72 67 65 74 20 20 20 20 28 61 72 67 73 3a 67 arget (args:g
5a80: 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 et-arg "-target"
5a90: 29 29 0a 09 20 20 20 20 20 20 20 28 74 6f 70 70 )).. (topp
5aa0: 61 74 68 20 20 20 28 61 73 73 6f 63 2f 64 65 66 ath (assoc/def
5ab0: 61 75 6c 74 20 27 74 6f 70 70 61 74 68 20 20 20 ault 'toppath
5ac0: 63 6d 64 69 6e 66 6f 29 29 29 0a 09 20 20 28 63 cmdinfo))).. (c
5ad0: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
5ae0: 74 6f 70 70 61 74 68 29 0a 09 20 20 28 69 66 20 toppath).. (if
5af0: 28 6e 6f 74 20 74 61 72 67 65 74 29 0a 09 20 20 (not target)..
5b00: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 (begin...(de
5b10: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
5b20: 4f 52 3a 20 2d 74 61 72 67 65 74 20 69 73 20 72 OR: -target is r
5b30: 65 71 75 69 72 65 64 2e 22 29 0a 09 09 28 65 78 equired.")...(ex
5b40: 69 74 20 31 29 29 29 0a 09 20 20 28 69 66 20 28 it 1))).. (if (
5b50: 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 not (setup-for-r
5b60: 75 6e 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 un)).. (beg
5b70: 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e in...(debug:prin
5b80: 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 t 0 "Failed to s
5b90: 65 74 75 70 2c 20 67 69 76 69 6e 67 20 75 70 20 etup, giving up
5ba0: 6f 6e 20 2d 74 65 73 74 2d 70 61 74 68 73 20 6f on -test-paths o
5bb0: 72 20 2d 74 65 73 74 2d 66 69 6c 65 73 2c 20 65 r -test-files, e
5bc0: 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 xiting")...(exit
5bd0: 20 31 29 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 1))).. (let* (
5be0: 28 6b 65 79 73 20 20 20 20 20 28 6f 70 65 6e 2d (keys (open-
5bf0: 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 run-close db:get
5c00: 2d 6b 65 79 73 20 64 62 29 29 0a 09 09 20 28 6b -keys db))... (k
5c10: 65 79 6e 61 6d 65 73 20 28 6d 61 70 20 6b 65 79 eynames (map key
5c20: 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b :get-fieldname k
5c30: 65 79 73 29 29 0a 09 09 20 28 70 61 74 68 73 20 eys))... (paths
5c40: 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f (open-run-clo
5c50: 73 65 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 se db:test-get-p
5c60: 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 64 62 aths-matching db
5c70: 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 keynames target
5c80: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5c90: 2d 74 65 73 74 2d 66 69 6c 65 73 22 29 29 29 29 -test-files"))))
5ca0: 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 .. (set! *did
5cb0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 something* #t)..
5cc0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
5cd0: 61 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 ambda (path)....
5ce0: 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 (print path))...
5cf0: 20 20 20 20 20 20 70 61 74 68 73 29 29 29 0a 09 paths)))..
5d00: 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 67 65 6e ;; else do a gen
5d10: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 eral-run-call..(
5d20: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
5d30: 20 0a 09 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 .. "-test-files
5d40: 22 0a 09 20 22 47 65 74 20 70 61 74 68 73 20 74 ".. "Get paths t
5d50: 6f 20 74 65 73 74 22 0a 09 20 28 6c 61 6d 62 64 o test".. (lambd
5d60: 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
5d70: 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 e keys keynames
5d80: 6b 65 79 76 61 6c 6c 73 74 29 0a 09 20 20 20 28 keyvallst).. (
5d90: 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 let* ((db
5da0: 23 66 29 0a 09 09 20 20 28 69 74 65 6d 70 61 74 #f)... (itempat
5db0: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
5dc0: 22 2d 69 74 65 6d 70 61 74 74 22 29 29 0a 09 09 "-itempatt"))...
5dd0: 20 20 28 70 61 74 68 73 20 20 20 20 28 6f 70 65 (paths (ope
5de0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 74 n-run-close db:t
5df0: 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 est-get-paths-ma
5e00: 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d tching db keynam
5e10: 65 73 20 74 61 72 67 65 74 20 28 61 72 67 73 3a es target (args:
5e20: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 get-arg "-test-f
5e30: 69 6c 65 73 22 29 29 29 29 0a 09 20 20 20 20 20 iles"))))..
5e40: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
5e50: 61 20 28 70 61 74 68 29 0a 09 09 09 20 28 70 72 a (path).... (pr
5e60: 69 6e 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 int path))...
5e70: 20 20 20 20 70 61 74 68 73 29 29 29 29 29 29 0a paths)))))).
5e80: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
5e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 =========.;; Arc
5ed0: 68 69 76 65 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d hive tests.;;===
5ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f20: 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 20 74 ===.;; Archive t
5f30: 65 73 74 73 20 6d 61 74 63 68 69 6e 67 20 74 61 ests matching ta
5f40: 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 74 rget, runname, t
5f50: 65 73 74 70 61 74 74 2c 20 61 6e 64 20 69 74 65 estpatt, and ite
5f60: 6d 70 61 74 74 0a 28 69 66 20 28 61 72 67 73 3a mpatt.(if (args:
5f70: 67 65 74 2d 61 72 67 20 22 2d 61 72 63 68 69 76 get-arg "-archiv
5f80: 65 22 29 0a 20 20 20 20 3b 3b 20 69 66 20 77 65 e"). ;; if we
5f90: 20 61 72 65 20 69 6e 20 61 20 74 65 73 74 20 75 are in a test u
5fa0: 73 65 20 74 68 65 20 4d 54 5f 43 4d 44 49 4e 46 se the MT_CMDINF
5fb0: 4f 20 64 61 74 61 0a 20 20 20 20 28 69 66 20 28 O data. (if (
5fc0: 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e getenv "MT_CMDIN
5fd0: 46 4f 22 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 FO")..(let* ((st
5fe0: 61 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 65 artingdir (curre
5ff0: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 nt-directory))..
6000: 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 (cmdinfo
6010: 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e (read (open-in
6020: 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 put-string (base
6030: 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 64:base64-decode
6040: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
6050: 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 20 20 INFO")))))..
6060: 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 61 (testpath (a
6070: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
6080: 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 stpath cmdinfo)
6090: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d ).. (test-
60a0: 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 name (assoc/defa
60b0: 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 ult 'test-name c
60c0: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
60d0: 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 73 (runscript (ass
60e0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 73 oc/default 'runs
60f0: 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a cript cmdinfo)).
6100: 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 74 . (db-host
6110: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
6120: 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 t 'db-host cmd
6130: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
6140: 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 run-id (assoc
6150: 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 /default 'run-id
6160: 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 cmdinfo))..
6170: 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 (itemdat
6180: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
6190: 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 'itemdat cmdin
61a0: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 fo)).. (db
61b0: 20 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 #f)..
61c0: 20 20 20 20 28 73 74 61 74 65 20 20 20 20 20 28 (state (
61d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 args:get-arg ":s
61e0: 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 tate"))..
61f0: 28 73 74 61 74 75 73 20 20 20 20 28 61 72 67 73 (status (args
6200: 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 :get-arg ":statu
6210: 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 61 s")).. (ta
6220: 72 67 65 74 20 20 20 20 28 61 72 67 73 3a 67 65 rget (args:ge
6230: 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 t-arg "-target")
6240: 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 )).. (change-di
6250: 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 rectory testpath
6260: 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 74 61 ).. (if (not ta
6270: 72 67 65 74 29 0a 09 20 20 20 20 20 20 28 62 65 rget).. (be
6280: 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 gin...(debug:pri
6290: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 2d 74 61 nt 0 "ERROR: -ta
62a0: 72 67 65 74 20 69 73 20 72 65 71 75 69 72 65 64 rget is required
62b0: 2e 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 .")...(exit 1)))
62c0: 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 .. (if (not (se
62d0: 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 tup-for-run))..
62e0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 (begin...(d
62f0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 ebug:print 0 "Fa
6300: 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 67 iled to setup, g
6310: 69 76 69 6e 67 20 75 70 20 6f 6e 20 2d 61 72 63 iving up on -arc
6320: 68 69 76 65 2c 20 65 78 69 74 69 6e 67 22 29 0a hive, exiting").
6330: 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 ..(exit 1)))..
6340: 28 6c 65 74 2a 20 28 28 69 74 65 6d 70 61 74 74 (let* ((itempatt
6350: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6360: 2d 69 74 65 6d 70 61 74 74 22 29 29 0a 09 09 20 -itempatt"))...
6370: 28 6b 65 79 73 20 20 20 20 20 28 6f 70 65 6e 2d (keys (open-
6380: 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 run-close db:get
6390: 2d 6b 65 79 73 20 64 62 29 29 0a 09 09 20 28 6b -keys db))... (k
63a0: 65 79 6e 61 6d 65 73 20 28 6d 61 70 20 6b 65 79 eynames (map key
63b0: 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b :get-fieldname k
63c0: 65 79 73 29 29 0a 09 09 20 28 70 61 74 68 73 20 eys))... (paths
63d0: 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f (open-run-clo
63e0: 73 65 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 se db:test-get-p
63f0: 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 64 62 aths-matching db
6400: 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 keynames target
6410: 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a ))).. (set! *
6420: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
6430: 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 ).. (for-each
6440: 20 28 6c 61 6d 62 64 61 20 28 70 61 74 68 29 0a (lambda (path).
6450: 09 09 09 28 70 72 69 6e 74 20 70 61 74 68 29 29 ...(print path))
6460: 0a 09 09 20 20 20 20 20 20 70 61 74 68 73 29 29 ... paths))
6470: 29 0a 09 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 )..;; else do a
6480: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
6490: 0a 09 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 ..(general-run-c
64a0: 61 6c 6c 20 0a 09 20 22 2d 74 65 73 74 2d 70 61 all .. "-test-pa
64b0: 74 68 73 22 0a 09 20 22 47 65 74 20 70 61 74 68 ths".. "Get path
64c0: 73 20 74 6f 20 74 65 73 74 73 22 0a 09 20 28 6c s to tests".. (l
64d0: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
64e0: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 nname keys keyna
64f0: 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 09 mes keyvallst)..
6500: 20 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 (let* ((db
6510: 20 20 20 20 23 66 29 0a 09 09 20 20 28 69 74 65 #f)... (ite
6520: 6d 70 61 74 74 20 28 61 72 67 73 3a 67 65 74 2d mpatt (args:get-
6530: 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 29 arg "-itempatt")
6540: 29 0a 09 09 20 20 28 70 61 74 68 73 20 20 20 20 )... (paths
6550: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
6560: 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 db:test-get-path
6570: 73 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 s-matching db ke
6580: 79 6e 61 6d 65 73 20 74 61 72 67 65 74 29 29 29 ynames target)))
6590: 0a 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 .. (for-each
65a0: 20 28 6c 61 6d 62 64 61 20 28 70 61 74 68 29 0a (lambda (path).
65b0: 09 09 09 20 28 70 72 69 6e 74 20 70 61 74 68 29 ... (print path)
65c0: 29 0a 09 09 20 20 20 20 20 20 20 70 61 74 68 73 )... paths
65d0: 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ))))))..;;======
65e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
65f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6620: 0a 3b 3b 20 45 78 74 72 61 63 74 20 61 20 73 70 .;; Extract a sp
6630: 72 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 74 readsheet from t
6640: 68 65 20 72 75 6e 73 20 64 61 74 61 62 61 73 65 he runs database
6650: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
6660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
66a0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
66b0: 78 74 72 61 63 74 2d 6f 64 73 22 29 0a 20 20 20 xtract-ods").
66c0: 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 (general-run-ca
66d0: 6c 6c 0a 20 20 20 20 20 22 2d 65 78 74 72 61 63 ll. "-extrac
66e0: 74 2d 6f 64 73 22 0a 20 20 20 20 20 22 4d 61 6b t-ods". "Mak
66f0: 65 20 6f 64 73 20 73 70 72 65 61 64 73 68 65 65 e ods spreadshee
6700: 74 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 t". (lambda
6710: 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 (target runname
6720: 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 keys keynames ke
6730: 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 20 20 20 yvallst).
6740: 28 6c 65 74 20 28 28 64 62 20 20 20 20 20 20 20 (let ((db
6750: 20 20 23 66 29 0a 09 20 20 20 20 20 28 6f 75 74 #f).. (out
6760: 70 75 74 66 69 6c 65 20 28 61 72 67 73 3a 67 65 putfile (args:ge
6770: 74 2d 61 72 67 20 22 2d 65 78 74 72 61 63 74 2d t-arg "-extract-
6780: 6f 64 73 22 29 29 0a 09 20 20 20 20 20 28 72 75 ods")).. (ru
6790: 6e 73 70 61 74 74 20 20 20 28 61 72 67 73 3a 67 nspatt (args:g
67a0: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
67b0: 22 29 29 0a 09 20 20 20 20 20 28 70 61 74 68 6d ")).. (pathm
67c0: 6f 64 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d od (args:get-
67d0: 61 72 67 20 22 2d 70 61 74 68 6d 6f 64 22 29 29 arg "-pathmod"))
67e0: 0a 09 20 20 20 20 20 28 6b 65 79 76 61 6c 61 6c .. (keyvalal
67f0: 69 73 74 20 28 6b 65 79 73 2d 3e 61 6c 69 73 74 ist (keys->alist
6800: 20 6b 65 79 73 20 22 25 22 29 29 29 0a 09 20 28 keys "%"))).. (
6810: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 45 debug:print 2 "E
6820: 78 74 72 61 63 74 20 6f 64 73 2c 20 6f 75 74 70 xtract ods, outp
6830: 75 74 66 69 6c 65 3a 20 22 20 6f 75 74 70 75 74 utfile: " output
6840: 66 69 6c 65 20 22 20 72 75 6e 73 70 61 74 74 3a file " runspatt:
6850: 20 22 20 72 75 6e 73 70 61 74 74 20 22 20 6b 65 " runspatt " ke
6860: 79 76 61 6c 61 6c 69 73 74 3a 20 22 20 6b 65 79 yvalalist: " key
6870: 76 61 6c 61 6c 69 73 74 29 0a 09 20 28 6f 70 65 valalist).. (ope
6880: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 65 n-run-close db:e
6890: 78 74 72 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 xtract-ods-file
68a0: 64 62 20 6f 75 74 70 75 74 66 69 6c 65 20 6b 65 db outputfile ke
68b0: 79 76 61 6c 61 6c 69 73 74 20 28 69 66 20 72 75 yvalalist (if ru
68c0: 6e 73 70 61 74 74 20 72 75 6e 73 70 61 74 74 20 nspatt runspatt
68d0: 22 25 22 29 20 70 61 74 68 6d 6f 64 29 29 29 29 "%") pathmod))))
68e0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
68f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 ===========.;; e
6930: 78 65 63 75 74 65 20 74 68 65 20 74 65 73 74 0a xecute the test.
6940: 3b 3b 20 20 20 20 2d 20 67 65 74 73 20 63 61 6c ;; - gets cal
6950: 6c 65 64 20 6f 6e 20 72 65 6d 6f 74 65 20 68 6f led on remote ho
6960: 73 74 0a 3b 3b 20 20 20 20 2d 20 72 65 63 65 69 st.;; - recei
6970: 76 65 73 20 69 6e 66 6f 20 66 72 6f 6d 20 74 68 ves info from th
6980: 65 20 2d 65 78 65 63 75 74 65 20 70 61 72 61 6d e -execute param
6990: 0a 3b 3b 20 20 20 20 2d 20 70 61 73 73 65 73 20 .;; - passes
69a0: 69 6e 66 6f 20 74 6f 20 73 74 65 70 73 20 76 69 info to steps vi
69b0: 61 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 a MT_CMDINFO env
69c0: 20 76 61 72 20 28 66 75 74 75 72 65 20 69 73 20 var (future is
69d0: 74 6f 20 75 73 65 20 61 20 64 6f 74 20 66 69 6c to use a dot fil
69e0: 65 29 0a 3b 3b 20 20 20 20 2d 20 67 61 74 68 65 e).;; - gathe
69f0: 72 73 20 68 6f 73 74 20 69 6e 66 6f 20 61 6e 64 rs host info and
6a00: 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;============
6a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
6a50: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6a60: 65 78 65 63 75 74 65 22 29 0a 20 20 20 20 28 62 execute"). (b
6a70: 65 67 69 6e 0a 20 20 20 20 20 20 28 6c 61 75 6e egin. (laun
6a80: 63 68 3a 65 78 65 63 75 74 65 20 28 61 72 67 73 ch:execute (args
6a90: 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 :get-arg "-execu
6aa0: 74 65 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 te")). (set
6ab0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
6ac0: 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d #t)))..;;======
6ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6b10: 0a 3b 3b 20 54 65 73 74 20 63 6f 6d 6d 61 6e 64 .;; Test command
6b20: 73 20 28 69 2e 65 2e 20 66 6f 72 20 75 73 65 20 s (i.e. for use
6b30: 69 6e 73 69 64 65 20 74 65 73 74 73 29 0a 3b 3b inside tests).;;
6b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6b80: 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 ======..(if (arg
6b90: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 s:get-arg "-step
6ba0: 22 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 "). (if (not
6bb0: 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (getenv "MT_CMDI
6bc0: 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 NFO"))..(begin..
6bd0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
6be0: 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 "ERROR: MT_CMDI
6bf0: 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 NFO env var not
6c00: 73 65 74 2c 20 2d 73 74 65 70 20 6d 75 73 74 20 set, -step must
6c10: 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 64 be called *insid
6c20: 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 69 6e e* a megatest in
6c30: 76 6f 6b 65 64 20 65 6e 76 69 72 6f 6e 6d 65 6e voked environmen
6c40: 74 21 22 29 0a 09 20 20 28 65 78 69 74 20 35 29 t!").. (exit 5)
6c50: 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 65 70 20 )..(let* ((step
6c60: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
6c70: 72 67 20 22 2d 73 74 65 70 22 29 29 0a 09 20 20 rg "-step"))..
6c80: 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 (cmdinfo
6c90: 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 (read (open-inpu
6ca0: 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 34 t-string (base64
6cb0: 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 28 :base64-decode (
6cc0: 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e getenv "MT_CMDIN
6cd0: 46 4f 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 FO")))))..
6ce0: 20 28 74 65 73 74 70 61 74 68 20 20 28 61 73 73 (testpath (ass
6cf0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
6d00: 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a path cmdinfo)).
6d10: 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 . (test-na
6d20: 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c me (assoc/defaul
6d30: 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 t 'test-name cmd
6d40: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
6d50: 72 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 runscript (assoc
6d60: 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 /default 'runscr
6d70: 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ipt cmdinfo))..
6d80: 20 20 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 (db-host
6d90: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
6da0: 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 'db-host cmdin
6db0: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
6dc0: 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 n-id (assoc/d
6dd0: 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 efault 'run-id
6de0: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
6df0: 20 20 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 (test-id (
6e00: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
6e10: 65 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f est-id cmdinfo
6e20: 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d )).. (item
6e30: 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 dat (assoc/def
6e40: 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 ault 'itemdat
6e50: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
6e60: 20 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 (db #f)
6e70: 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 65 20 .. (state
6e80: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
6e90: 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 ":state"))..
6ea0: 20 20 20 20 28 73 74 61 74 75 73 20 20 20 28 61 (status (a
6eb0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
6ec0: 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 atus"))..
6ed0: 28 6c 6f 67 66 69 6c 65 20 20 28 61 72 67 73 3a (logfile (args:
6ee0: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 get-arg "-setlog
6ef0: 22 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d "))).. (change-
6f00: 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 directory testpa
6f10: 74 68 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 th).. (if (not
6f20: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
6f30: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
6f40: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
6f50: 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 "Failed to setup
6f60: 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 , exiting")...(e
6f70: 78 69 74 20 31 29 29 29 0a 09 20 20 28 69 66 20 xit 1))).. (if
6f80: 28 61 6e 64 20 73 74 61 74 65 20 73 74 61 74 75 (and state statu
6f90: 73 29 0a 09 20 20 20 20 20 20 28 6f 70 65 6e 2d s).. (open-
6fa0: 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 74 65 73 run-close db:tes
6fb0: 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 tstep-set-status
6fc0: 21 20 64 62 20 74 65 73 74 2d 69 64 20 73 74 65 ! db test-id ste
6fd0: 70 20 73 74 61 74 65 20 73 74 61 74 75 73 20 28 p state status (
6fe0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
6ff0: 22 29 20 6c 6f 67 66 69 6c 65 29 0a 09 20 20 20 ") logfile)..
7000: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 (begin...(deb
7010: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
7020: 52 3a 20 59 6f 75 20 6d 75 73 74 20 73 70 65 63 R: You must spec
7030: 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a ify :state and :
7040: 73 74 61 74 75 73 20 77 69 74 68 20 65 76 65 72 status with ever
7050: 79 20 63 61 6c 6c 20 74 6f 20 2d 73 74 65 70 22 y call to -step"
7060: 29 0a 09 09 28 65 78 69 74 20 36 29 29 29 0a 09 )...(exit 6)))..
7070: 20 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 65 (if db (sqlite
7080: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 3:finalize! db))
7090: 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f .. (set! *didso
70a0: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a mething* #t)))).
70b0: 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 .(if (or (args:g
70c0: 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 et-arg "-setlog"
70d0: 29 20 20 20 20 20 20 20 3b 3b 20 73 69 6e 63 65 ) ;; since
70e0: 20 73 65 74 74 69 6e 67 20 75 70 20 69 73 20 73 setting up is s
70f0: 6f 20 63 6f 73 74 6c 79 20 6c 65 74 73 20 70 69 o costly lets pi
7100: 67 67 79 62 61 63 6b 20 6f 6e 20 2d 74 65 73 74 ggyback on -test
7110: 2d 73 74 61 74 75 73 0a 09 28 61 72 67 73 3a 67 -status..(args:g
7120: 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 et-arg "-set-top
7130: 6c 6f 67 22 29 0a 09 28 61 72 67 73 3a 67 65 74 log")..(args:get
7140: 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 -arg "-test-stat
7150: 75 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d us")..(args:get-
7160: 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 73 arg "-set-values
7170: 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
7180: 67 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 g "-load-test-da
7190: 74 61 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d ta")..(args:get-
71a0: 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a arg "-runstep").
71b0: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
71c0: 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 -summarize-items
71d0: 22 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 ")). (if (not
71e0: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
71f0: 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e 0a INFO"))..(begin.
7200: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
7210: 30 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 0 "ERROR: MT_CMD
7220: 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 INFO env var not
7230: 20 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 73 20 2d set, commands -
7240: 74 65 73 74 2d 73 74 61 74 75 73 2c 20 2d 72 75 test-status, -ru
7250: 6e 73 74 65 70 20 61 6e 64 20 2d 73 65 74 6c 6f nstep and -setlo
7260: 67 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 g must be called
7270: 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 *inside* a mega
7280: 74 65 73 74 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 test environment
7290: 21 22 29 0a 09 20 20 28 65 78 69 74 20 35 29 29 !").. (exit 5))
72a0: 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 ..(let* ((starti
72b0: 6e 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 ngdir (current-d
72c0: 69 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 irectory))..
72d0: 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 (cmdinfo (r
72e0: 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d ead (open-input-
72f0: 73 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 string (base64:b
7300: 61 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 ase64-decode (ge
7310: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
7320: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 "))))).. (
7330: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
7340: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
7350: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
7360: 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
7370: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
7380: 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
7390: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
73a0: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
73b0: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
73c0: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
73d0: 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 (db-host (
73e0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 assoc/default 'd
73f0: 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f b-host cmdinfo
7400: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
7410: 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 id (assoc/def
7420: 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 ault 'run-id
7430: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
7440: 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 73 (test-id (as
7450: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
7460: 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 t-id cmdinfo))
7470: 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 .. (itemda
7480: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
7490: 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d lt 'itemdat cm
74a0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
74b0: 28 64 62 20 20 20 20 20 20 20 20 23 66 29 0a 09 (db #f)..
74c0: 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 (state
74d0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
74e0: 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 ":state"))..
74f0: 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 61 (status (a
7500: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
7510: 61 74 75 73 22 29 29 29 0a 09 20 20 28 63 68 61 atus"))).. (cha
7520: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 nge-directory te
7530: 73 74 70 61 74 68 29 0a 09 20 20 28 69 66 20 28 stpath).. (if (
7540: 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 not (setup-for-r
7550: 75 6e 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 un)).. (beg
7560: 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e in...(debug:prin
7570: 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 t 0 "Failed to s
7580: 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a etup, exiting").
7590: 09 09 28 65 78 69 74 20 31 29 29 29 0a 0a 09 20 ..(exit 1)))...
75a0: 20 3b 3b 20 63 61 6e 20 73 65 74 75 70 20 61 73 ;; can setup as
75b0: 20 63 6c 69 65 6e 74 20 66 6f 72 20 73 65 72 76 client for serv
75c0: 65 72 20 6d 6f 64 65 20 6e 6f 77 0a 09 20 20 28 er mode now.. (
75d0: 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d 73 65 server:client-se
75e0: 74 75 70 29 0a 0a 09 20 20 28 69 66 20 28 61 72 tup)... (if (ar
75f0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 61 gs:get-arg "-loa
7600: 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a 09 20 d-test-data")..
7610: 20 20 20 20 20 3b 3b 20 68 61 73 20 73 75 62 20 ;; has sub
7620: 63 6f 6d 6d 61 6e 64 73 20 74 68 61 74 20 61 72 commands that ar
7630: 65 20 72 64 62 3a 0a 09 20 20 20 20 20 20 28 6f e rdb:.. (o
7640: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 pen-run-close db
7650: 3a 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 20 :load-test-data
7660: 64 62 20 74 65 73 74 2d 69 64 29 29 0a 09 20 20 db test-id))..
7670: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
7680: 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a 09 20 20 g "-setlog")..
7690: 20 20 20 20 28 6c 65 74 20 28 28 6c 6f 67 66 6e (let ((logfn
76a0: 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ame (args:get-ar
76b0: 67 20 22 2d 73 65 74 6c 6f 67 22 29 29 29 0a 09 g "-setlog")))..
76c0: 09 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 6c .(cdb:test-set-l
76d0: 6f 67 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 og! *runremote*
76e0: 74 65 73 74 2d 69 64 20 6c 6f 67 66 6e 61 6d 65 test-id logfname
76f0: 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 ))).. (if (args
7700: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 :get-arg "-set-t
7710: 6f 70 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 28 oplog").. (
7720: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 open-run-close t
7730: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 74 6f ests:test-set-to
7740: 70 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 plog! db run-id
7750: 74 65 73 74 2d 6e 61 6d 65 20 28 61 72 67 73 3a test-name (args:
7760: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f get-arg "-set-to
7770: 70 6c 6f 67 22 29 29 29 0a 09 20 20 28 69 66 20 plog"))).. (if
7780: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7790: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 summarize-items"
77a0: 29 0a 09 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 ).. (open-r
77b0: 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 73 3a 73 un-close tests:s
77c0: 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 64 ummarize-items d
77d0: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
77e0: 6d 65 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 6f me #t)) ;; do fo
77f0: 72 63 65 20 68 65 72 65 0a 09 20 20 28 69 66 20 rce here.. (if
7800: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7810: 72 75 6e 73 74 65 70 22 29 0a 09 20 20 20 20 20 runstep")..
7820: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 (if (null? rema
7830: 72 67 73 29 0a 09 09 20 20 28 62 65 67 69 6e 0a rgs)... (begin.
7840: 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
7850: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 6e 6f 74 nt 0 "ERROR: not
7860: 68 69 6e 67 20 73 70 65 63 69 66 69 65 64 20 74 hing specified t
7870: 6f 20 72 75 6e 21 22 29 0a 09 09 20 20 20 20 28 o run!")... (
7880: 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 if db (sqlite3:f
7890: 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 09 inalize! db))...
78a0: 20 20 20 20 28 65 78 69 74 20 36 29 29 0a 09 09 (exit 6))...
78b0: 20 20 28 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 (let* ((stepna
78c0: 6d 65 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 me (args:get-a
78d0: 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 29 0a rg "-runstep")).
78e0: 09 09 09 20 28 6c 6f 67 70 72 6f 66 69 6c 65 20 ... (logprofile
78f0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7900: 6c 6f 67 70 72 6f 22 29 29 0a 09 09 09 20 28 6c logpro")).... (l
7910: 6f 67 66 69 6c 65 20 20 20 20 28 63 6f 6e 63 20 ogfile (conc
7920: 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 stepname ".log")
7930: 29 0a 09 09 09 20 28 63 6d 64 20 20 20 20 20 20 ).... (cmd
7940: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d (if (null? rem
7950: 61 72 67 73 29 20 23 66 20 28 63 61 72 20 72 65 args) #f (car re
7960: 6d 61 72 67 73 29 29 29 0a 09 09 09 20 28 70 61 margs))).... (pa
7970: 72 61 6d 73 20 20 20 20 20 28 69 66 20 63 6d 64 rams (if cmd
7980: 20 28 63 64 72 20 72 65 6d 61 72 67 73 29 20 27 (cdr remargs) '
7990: 28 29 29 29 0a 09 09 09 20 28 65 78 69 74 73 74 ())).... (exitst
79a0: 61 74 20 20 20 23 66 29 0a 09 09 09 20 28 73 68 at #f).... (sh
79b0: 65 6c 6c 20 20 20 20 20 20 28 6c 61 73 74 20 28 ell (last (
79c0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 67 65 string-split (ge
79d0: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
79e0: 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 20 riable "SHELL")
79f0: 22 2f 22 29 29 29 0a 09 09 09 20 28 72 65 64 69 "/"))).... (redi
7a00: 72 20 20 20 20 20 20 28 63 61 73 65 20 28 73 74 r (case (st
7a10: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 68 65 ring->symbol she
7a20: 6c 6c 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 ll)..... (
7a30: 28 74 63 73 68 20 63 73 68 20 6b 73 68 29 20 20 (tcsh csh ksh)
7a40: 20 20 22 3e 26 22 29 0a 09 09 09 09 20 20 20 20 ">&").....
7a50: 20 20 20 28 28 7a 73 68 20 62 61 73 68 20 73 68 ((zsh bash sh
7a60: 20 61 73 68 29 20 22 32 3e 26 31 20 3e 22 29 0a ash) "2>&1 >").
7a70: 09 09 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 .... (else
7a80: 20 22 3e 26 22 29 29 29 0a 09 09 09 20 28 66 75 ">&"))).... (fu
7a90: 6c 6c 63 6d 64 20 20 20 20 28 63 6f 6e 63 20 22 llcmd (conc "
7aa0: 28 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 (" (string-inter
7ab0: 73 70 65 72 73 65 20 0a 09 09 09 09 09 09 28 63 sperse .......(c
7ac0: 6f 6e 73 20 63 6d 64 20 70 61 72 61 6d 73 29 20 ons cmd params)
7ad0: 22 20 22 29 0a 09 09 09 09 09 20 20 20 22 29 20 " ")...... ")
7ae0: 22 20 72 65 64 69 72 20 22 20 22 20 6c 6f 67 66 " redir " " logf
7af0: 69 6c 65 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 ile)))... ;;
7b00: 6d 61 72 6b 20 74 68 65 20 73 74 61 72 74 20 6f mark the start o
7b10: 66 20 74 68 65 20 74 65 73 74 0a 09 09 20 20 20 f the test...
7b20: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
7b30: 20 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 db:teststep-set
7b40: 2d 73 74 61 74 75 73 21 20 64 62 20 74 65 73 74 -status! db test
7b50: 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 73 74 -id stepname "st
7b60: 61 72 74 22 20 22 6e 2f 61 22 20 28 61 72 67 73 art" "n/a" (args
7b70: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 6c :get-arg "-m") l
7b80: 6f 67 66 69 6c 65 29 0a 09 09 20 20 20 20 3b 3b ogfile)... ;;
7b90: 20 72 75 6e 20 74 68 65 20 74 65 73 74 20 73 74 run the test st
7ba0: 65 70 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a ep... (debug:
7bb0: 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 52 75 print-info 2 "Ru
7bc0: 6e 6e 69 6e 67 20 5c 22 22 20 66 75 6c 6c 63 6d nning \"" fullcm
7bd0: 64 20 22 5c 22 22 29 0a 09 09 20 20 20 20 28 63 d "\"")... (c
7be0: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
7bf0: 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 09 20 startingdir)...
7c00: 20 20 20 28 73 65 74 21 20 65 78 69 74 73 74 61 (set! exitsta
7c10: 74 20 28 73 79 73 74 65 6d 20 66 75 6c 6c 63 6d t (system fullcm
7c20: 64 29 29 20 3b 3b 20 63 6d 64 20 70 61 72 61 6d d)) ;; cmd param
7c30: 73 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 s))... (set!
7c40: 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 *globalexitstatu
7c50: 73 2a 20 65 78 69 74 73 74 61 74 29 0a 09 09 20 s* exitstat)...
7c60: 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 (change-direc
7c70: 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
7c80: 09 20 20 20 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 . ;; run logp
7c90: 72 6f 20 69 66 20 61 70 70 6c 69 63 61 62 6c 65 ro if applicable
7ca0: 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d 72 75 6e ;; (process-run
7cb0: 20 22 6c 73 22 20 28 6c 69 73 74 20 22 2f 66 6f "ls" (list "/fo
7cc0: 6f 22 20 22 32 3e 26 31 22 20 22 62 6c 61 68 2e o" "2>&1" "blah.
7cd0: 6c 6f 67 22 29 29 0a 09 09 20 20 20 20 28 69 66 log"))... (if
7ce0: 20 6c 6f 67 70 72 6f 66 69 6c 65 0a 09 09 09 28 logprofile....(
7cf0: 6c 65 74 2a 20 28 28 68 74 6d 6c 6c 6f 67 66 69 let* ((htmllogfi
7d00: 6c 65 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d le (conc stepnam
7d10: 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 09 09 20 e ".html"))....
7d20: 20 20 20 20 20 20 28 6f 6c 64 65 78 69 74 73 74 (oldexitst
7d30: 61 74 20 65 78 69 74 73 74 61 74 29 0a 09 09 09 at exitstat)....
7d40: 20 20 20 20 20 20 20 28 63 6d 64 20 20 20 20 20 (cmd
7d50: 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 (string-inte
7d60: 72 73 70 65 72 73 65 20 28 6c 69 73 74 20 22 6c rsperse (list "l
7d70: 6f 67 70 72 6f 22 20 6c 6f 67 70 72 6f 66 69 6c ogpro" logprofil
7d80: 65 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c e htmllogfile "<
7d90: 22 20 6c 6f 67 66 69 6c 65 20 22 3e 22 20 28 63 " logfile ">" (c
7da0: 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 5f 6c onc stepname "_l
7db0: 6f 67 70 72 6f 2e 6c 6f 67 22 29 29 20 22 20 22 ogpro.log")) " "
7dc0: 29 29 29 0a 09 09 09 20 20 28 64 65 62 75 67 3a ))).... (debug:
7dd0: 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 72 75 print-info 2 "ru
7de0: 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c nning \"" cmd "\
7df0: 22 22 29 0a 09 09 09 20 20 28 63 68 61 6e 67 65 "").... (change
7e00: 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 -directory start
7e10: 69 6e 67 64 69 72 29 0a 09 09 09 20 20 28 73 65 ingdir).... (se
7e20: 74 21 20 65 78 69 74 73 74 61 74 20 28 73 79 73 t! exitstat (sys
7e30: 74 65 6d 20 63 6d 64 29 29 0a 09 09 09 20 20 28 tem cmd)).... (
7e40: 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 set! *globalexit
7e50: 73 74 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 status* exitstat
7e60: 29 20 3b 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 ) ;; no necessar
7e70: 79 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 y.... (change-d
7e80: 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
7e90: 68 29 0a 09 09 09 20 20 28 63 64 62 3a 74 65 73 h).... (cdb:tes
7ea0: 74 2d 73 65 74 2d 6c 6f 67 21 20 2a 72 75 6e 72 t-set-log! *runr
7eb0: 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 20 68 emote* test-id h
7ec0: 74 6d 6c 6c 6f 67 66 69 6c 65 29 29 29 0a 09 09 tmllogfile)))...
7ed0: 20 20 20 20 28 6c 65 74 20 28 28 6d 73 67 20 28 (let ((msg (
7ee0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
7ef0: 22 29 29 29 0a 09 09 20 20 20 20 20 20 28 6f 70 ")))... (op
7f00: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a en-run-close db:
7f10: 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
7f20: 74 75 73 21 20 64 62 20 74 65 73 74 2d 69 64 20 tus! db test-id
7f30: 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 stepname "end" e
7f40: 78 69 74 73 74 61 74 20 6d 73 67 20 6c 6f 67 66 xitstat msg logf
7f50: 69 6c 65 29 29 0a 09 09 20 20 20 20 29 29 29 0a ile))... ))).
7f60: 09 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 . (if (or (args
7f70: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d :get-arg "-test-
7f80: 73 74 61 74 75 73 22 29 0a 09 09 20 20 28 61 72 status")... (ar
7f90: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
7fa0: 2d 76 61 6c 75 65 73 22 29 29 0a 09 20 20 20 20 -values"))..
7fb0: 20 20 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 (let ((newstat
7fc0: 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e us (cond.....((n
7fd0: 75 6d 62 65 72 3f 20 73 74 61 74 75 73 29 20 20 umber? status)
7fe0: 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f (if (equal?
7ff0: 20 73 74 61 74 75 73 20 30 29 20 22 50 41 53 53 status 0) "PASS
8000: 22 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 " "FAIL")).....(
8010: 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 74 (and (string? st
8020: 61 74 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 atus).....
8030: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
8040: 73 74 61 74 75 73 29 29 28 69 66 20 28 65 71 75 status))(if (equ
8050: 61 6c 3f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d al? (string->num
8060: 62 65 72 20 73 74 61 74 75 73 29 20 30 29 20 22 ber status) 0) "
8070: 50 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 PASS" "FAIL"))..
8080: 09 09 09 28 65 6c 73 65 20 73 74 61 74 75 73 29 ...(else status)
8090: 29 29 0a 09 09 20 20 20 20 3b 3b 20 74 72 61 6e ))... ;; tran
80a0: 73 66 65 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 sfer relevant ke
80b0: 79 73 20 69 6e 74 6f 20 61 20 68 61 73 68 20 74 ys into a hash t
80c0: 6f 20 62 65 20 70 61 73 73 65 64 20 74 6f 20 74 o be passed to t
80d0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a est-set-status!.
80e0: 09 09 20 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 .. ;; could u
80f0: 73 65 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 se an assoc list
8100: 20 49 20 67 75 65 73 73 2e 20 0a 09 09 20 20 20 I guess. ...
8110: 20 28 6f 74 68 65 72 64 61 74 61 20 28 6c 65 74 (otherdata (let
8120: 20 28 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 ((res (make-has
8130: 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 09 20 h-table))).....
8140: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
8150: 61 20 28 6b 65 79 29 0a 09 09 09 09 09 20 20 20 a (key)......
8160: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
8170: 61 72 67 20 6b 65 79 29 0a 09 09 09 09 09 09 20 arg key).......
8180: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
8190: 20 72 65 73 20 6b 65 79 20 28 61 72 67 73 3a 67 res key (args:g
81a0: 65 74 2d 61 72 67 20 6b 65 79 29 29 29 29 0a 09 et-arg key))))..
81b0: 09 09 09 09 20 20 20 28 6c 69 73 74 20 22 3a 76 .... (list ":v
81c0: 61 6c 75 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 alue" ":tol" ":e
81d0: 78 70 65 63 74 65 64 22 20 22 3a 66 69 72 73 74 xpected" ":first
81e0: 5f 65 72 72 22 20 22 3a 66 69 72 73 74 5f 77 61 _err" ":first_wa
81f0: 72 6e 22 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 rn" ":units" ":c
8200: 61 74 65 67 6f 72 79 22 20 22 3a 76 61 72 69 61 ategory" ":varia
8210: 62 6c 65 22 29 29 0a 09 09 09 09 20 72 65 73 29 ble"))..... res)
8220: 29 29 0a 09 09 28 69 66 20 28 61 6e 64 20 28 61 ))...(if (and (a
8230: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
8240: 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 09 20 st-status")....
8250: 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 65 29 0a (or (not state).
8260: 09 09 09 20 20 20 20 20 28 6e 6f 74 20 73 74 61 ... (not sta
8270: 74 75 73 29 29 29 0a 09 09 20 20 20 20 28 62 65 tus)))... (be
8280: 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 gin... (deb
8290: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
82a0: 52 3a 20 59 6f 75 20 6d 75 73 74 20 73 70 65 63 R: You must spec
82b0: 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a ify :state and :
82c0: 73 74 61 74 75 73 20 77 69 74 68 20 65 76 65 72 status with ever
82d0: 79 20 63 61 6c 6c 20 74 6f 20 2d 74 65 73 74 2d y call to -test-
82e0: 73 74 61 74 75 73 5c 6e 22 20 68 65 6c 70 29 0a status\n" help).
82f0: 09 09 20 20 20 20 20 20 3b 3b 20 28 73 71 6c 69 .. ;; (sqli
8300: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
8310: 29 0a 09 09 20 20 20 20 20 20 28 65 78 69 74 20 )... (exit
8320: 36 29 29 29 0a 09 09 28 6c 65 74 2a 20 28 28 6d 6)))...(let* ((m
8330: 73 67 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d sg (args:get-
8340: 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 20 20 20 arg "-m"))...
8350: 20 20 20 20 28 6e 75 6d 6f 74 68 20 28 6c 65 6e (numoth (len
8360: 67 74 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d gth (hash-table-
8370: 6b 65 79 73 20 6f 74 68 65 72 64 61 74 61 29 29 keys otherdata))
8380: 29 29 0a 09 09 20 20 3b 3b 20 43 6f 6e 76 65 72 ))... ;; Conver
8390: 74 20 74 6f 20 72 70 63 20 69 6e 73 69 64 65 20 t to rpc inside
83a0: 74 68 65 20 74 65 73 74 73 3a 74 65 73 74 2d 73 the tests:test-s
83b0: 65 74 2d 73 74 61 74 75 73 21 20 63 61 6c 6c 2c et-status! call,
83c0: 20 6e 6f 74 20 68 65 72 65 0a 09 09 20 20 28 74 not here... (t
83d0: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 ests:test-set-st
83e0: 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 73 74 atus! test-id st
83f0: 61 74 65 20 6e 65 77 73 74 61 74 75 73 20 6d 73 ate newstatus ms
8400: 67 20 6f 74 68 65 72 64 61 74 61 29 29 29 29 0a g otherdata)))).
8410: 09 20 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 . (if db (sqlit
8420: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
8430: 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 ).. (set! *dids
8440: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 omething* #t))))
8450: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
8460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 56 61 ==========.;; Va
84a0: 72 69 6f 75 73 20 68 65 6c 70 65 72 20 63 6f 6d rious helper com
84b0: 6d 61 6e 64 73 20 63 61 6e 20 67 6f 20 62 65 6c mands can go bel
84c0: 6f 77 20 68 65 72 65 0a 3b 3b 3d 3d 3d 3d 3d 3d ow here.;;======
84d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
84e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
84f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8510: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
8520: 61 72 67 20 22 2d 73 68 6f 77 6b 65 79 73 22 29 arg "-showkeys")
8530: 0a 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 23 . (let ((db #
8540: 66 29 0a 09 20 20 28 6b 65 79 73 20 23 66 29 29 f).. (keys #f))
8550: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
8560: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
8570: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
8580: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
8590: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
85a0: 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 exiting")..
85b0: 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 (exit 1))).
85c0: 20 28 73 65 74 21 20 6b 65 79 73 20 28 6f 70 65 (set! keys (ope
85d0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 n-run-close db:g
85e0: 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 20 20 20 et-keys db)).
85f0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
8600: 31 20 22 4b 65 79 73 3a 20 22 20 28 73 74 72 69 1 "Keys: " (stri
8610: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
8620: 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c map key:get-fiel
8630: 64 6e 61 6d 65 20 6b 65 79 73 29 20 22 2c 20 22 dname keys) ", "
8640: 29 29 0a 20 20 20 20 20 20 28 69 66 20 64 62 20 )). (if db
8650: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
8660: 65 21 20 64 62 29 29 0a 20 20 20 20 20 20 28 73 e! db)). (s
8670: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
8680: 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
8690: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 75 rgs:get-arg "-gu
86a0: 69 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 i"). (begin.
86b0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
86c0: 74 20 30 20 22 4c 6f 6f 6b 20 61 74 20 74 68 65 t 0 "Look at the
86d0: 20 64 61 73 68 62 6f 61 72 64 20 66 6f 72 20 6e dashboard for n
86e0: 6f 77 22 29 0a 20 20 20 20 20 20 3b 3b 20 28 6d ow"). ;; (m
86f0: 65 67 61 74 65 73 74 2d 67 75 69 29 0a 20 20 20 egatest-gui).
8700: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
8710: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 ething* #t)))..(
8720: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
8730: 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d "-gen-megatest-
8740: 61 72 65 61 22 29 0a 20 20 20 20 28 62 65 67 69 area"). (begi
8750: 6e 0a 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d n. (genexam
8760: 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2e ple:mk-megatest.
8770: 63 6f 6e 66 69 67 29 0a 20 20 20 20 20 20 28 73 config). (s
8780: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
8790: 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
87a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 rgs:get-arg "-ge
87b0: 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 22 n-megatest-test"
87c0: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 65 73 ). (let ((tes
87d0: 74 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d tname (args:get-
87e0: 61 72 67 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 arg "-gen-megate
87f0: 73 74 2d 74 65 73 74 22 29 29 29 0a 20 20 20 20 st-test"))).
8800: 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b (genexample:mk
8810: 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 20 74 -megatest-test t
8820: 65 73 74 6e 61 6d 65 29 0a 20 20 20 20 20 20 28 estname). (
8830: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
8840: 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d ng* #t)))..;;===
8850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8890: 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 ===.;; Update th
88a0: 65 20 64 61 74 61 62 61 73 65 20 73 63 68 65 6d e database schem
88b0: 61 20 6f 6e 20 72 65 71 75 65 73 74 0a 3b 3b 3d a on request.;;=
88c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
88d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
88e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
88f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8900: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
8910: 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 62 75 69 :get-arg "-rebui
8920: 6c 64 2d 64 62 22 29 0a 20 20 20 20 28 62 65 67 ld-db"). (beg
8930: 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f in. (if (no
8940: 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e t (setup-for-run
8950: 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 )).. (begin..
8960: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
8970: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
8980: 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 p, exiting") ..
8990: 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))).
89a0: 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c (open-run-cl
89b0: 6f 73 65 20 70 61 74 63 68 2d 64 62 20 23 66 29 ose patch-db #f)
89c0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
89d0: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
89e0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
89f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 ===========.;; U
8a30: 70 64 61 74 65 20 74 68 65 20 74 65 73 74 73 20 pdate the tests
8a40: 6d 65 74 61 20 64 61 74 61 20 66 72 6f 6d 20 74 meta data from t
8a50: 68 65 20 74 65 73 74 63 6f 6e 66 69 67 20 66 69 he testconfig fi
8a60: 6c 65 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d les.;;==========
8a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
8ab0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
8ac0: 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 22 29 0a "-update-meta").
8ad0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
8ae0: 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 (if (not (setup
8af0: 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 62 -for-run)).. (b
8b00: 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 egin.. (debug
8b10: 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 :print 0 "Failed
8b20: 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 to setup, exiti
8b30: 6e 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 ng") .. (exit
8b40: 20 31 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6e 1))). ;; n
8b50: 6f 77 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 ow can find our
8b60: 64 62 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 db. (open-r
8b70: 75 6e 2d 63 6c 6f 73 65 20 72 75 6e 73 3a 75 70 un-close runs:up
8b80: 64 61 74 65 2d 61 6c 6c 2d 74 65 73 74 5f 6d 65 date-all-test_me
8b90: 74 61 20 64 62 29 0a 20 20 20 20 20 20 28 73 65 ta db). (se
8ba0: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
8bb0: 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d * #t)))..;;=====
8bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c00: 3d 0a 3b 3b 20 53 74 61 72 74 20 61 20 72 65 70 =.;; Start a rep
8c10: 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d l.;;============
8c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
8c60: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8c70: 72 65 70 6c 22 29 0a 20 20 20 20 28 6c 65 74 2a repl"). (let*
8c80: 20 28 28 74 6f 70 70 61 74 68 20 28 73 65 74 75 ((toppath (setu
8c90: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 p-for-run))..
8ca0: 28 64 62 20 20 20 20 20 20 28 69 66 20 74 6f 70 (db (if top
8cb0: 70 61 74 68 20 28 6f 70 65 6e 2d 64 62 29 20 23 path (open-db) #
8cc0: 66 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 64 f))). (if d
8cd0: 62 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 b.. (begin..
8ce0: 20 28 73 65 74 21 20 2a 64 62 2a 20 64 62 29 0a (set! *db* db).
8cf0: 09 20 20 20 20 28 73 65 74 21 20 2a 63 6c 69 65 . (set! *clie
8d00: 6e 74 2d 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 2d nt-non-blocking-
8d10: 6d 6f 64 65 2a 20 23 74 29 0a 09 20 20 20 20 3b mode* #t).. ;
8d20: 3b 20 28 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 ; (server:client
8d30: 2d 73 65 74 75 70 29 0a 09 20 20 20 20 28 69 6d -setup).. (im
8d40: 70 6f 72 74 20 72 65 61 64 6c 69 6e 65 29 0a 09 port readline)..
8d50: 20 20 20 20 28 69 6d 70 6f 72 74 20 61 70 72 6f (import apro
8d60: 70 6f 73 29 0a 09 20 20 20 20 28 67 6e 75 2d 68 pos).. (gnu-h
8d70: 69 73 74 6f 72 79 2d 69 6e 73 74 61 6c 6c 2d 66 istory-install-f
8d80: 69 6c 65 2d 6d 61 6e 61 67 65 72 0a 09 20 20 20 ile-manager..
8d90: 20 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 (string-append
8da0: 0a 09 20 20 20 20 20 20 28 6f 72 20 28 67 65 74 .. (or (get
8db0: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
8dc0: 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2e iable "HOME") ".
8dd0: 22 29 20 22 2f 2e 6d 65 67 61 74 65 73 74 5f 68 ") "/.megatest_h
8de0: 69 73 74 6f 72 79 22 29 29 0a 09 20 20 20 20 28 istory")).. (
8df0: 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f current-input-po
8e00: 72 74 20 28 6d 61 6b 65 2d 67 6e 75 2d 72 65 61 rt (make-gnu-rea
8e10: 64 6c 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 61 dline-port "mega
8e20: 74 65 73 74 3e 20 22 29 29 0a 09 20 20 20 20 28 test> ")).. (
8e30: 72 65 70 6c 29 29 0a 09 20 20 28 65 78 69 74 29 repl)).. (exit)
8e40: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
8e50: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
8e60: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
8e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
8eb0: 45 78 69 74 20 61 6e 64 20 63 6c 65 61 6e 20 75 Exit and clean u
8ec0: 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d p.;;============
8ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 74 ==========..;; t
8f10: 68 69 73 20 69 73 20 74 68 65 20 73 6f 63 6b 65 his is the socke
8f20: 74 20 69 66 20 77 65 20 61 72 65 20 61 20 63 6c t if we are a cl
8f30: 69 65 6e 74 0a 3b 3b 20 28 69 66 20 28 61 6e 64 ient.;; (if (and
8f40: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 0a 3b 3b 20 *runremote*.;;
8f50: 09 20 28 73 6f 63 6b 65 74 3f 20 2a 72 75 6e 72 . (socket? *runr
8f60: 65 6d 6f 74 65 2a 29 29 0a 3b 3b 20 20 20 20 20 emote*)).;;
8f70: 28 63 6c 6f 73 65 2d 73 6f 63 6b 65 74 20 2a 72 (close-socket *r
8f80: 75 6e 72 65 6d 6f 74 65 2a 29 29 0a 0a 28 69 66 unremote*))..(if
8f90: 20 28 6e 6f 74 20 2a 64 69 64 73 6f 6d 65 74 68 (not *didsometh
8fa0: 69 6e 67 2a 29 0a 20 20 20 20 28 64 65 62 75 67 ing*). (debug
8fb0: 3a 70 72 69 6e 74 20 30 20 68 65 6c 70 29 29 0a :print 0 help)).
8fc0: 0a 3b 3b 20 28 69 66 20 2a 72 75 6e 72 65 6d 6f .;; (if *runremo
8fd0: 74 65 2a 20 28 72 70 63 3a 63 6c 6f 73 65 2d 61 te* (rpc:close-a
8fe0: 6c 6c 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 21 29 ll-connections!)
8ff0: 29 0a 20 20 20 20 0a 28 69 66 20 28 6e 6f 74 20 ). .(if (not
9000: 28 65 71 3f 20 2a 67 6c 6f 62 61 6c 65 78 69 74 (eq? *globalexit
9010: 73 74 61 74 75 73 2a 20 30 29 29 0a 20 20 20 20 status* 0)).
9020: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
9030: 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 t-arg "-runtests
9040: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
9050: 22 2d 72 75 6e 61 6c 6c 22 29 29 0a 20 20 20 20 "-runall")).
9060: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
9070: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
9080: 6e 74 20 30 20 22 4e 4f 54 45 3a 20 53 75 62 70 nt 0 "NOTE: Subp
9090: 72 6f 63 65 73 73 65 73 20 77 69 74 68 20 6e 6f rocesses with no
90a0: 6e 2d 7a 65 72 6f 20 65 78 69 74 20 63 6f 64 65 n-zero exit code
90b0: 20 64 65 74 65 63 74 65 64 3a 20 22 20 2a 67 6c detected: " *gl
90c0: 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 29 obalexitstatus*)
90d0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 78 69 . (exi
90e0: 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 28 63 t 0)). (c
90f0: 61 73 65 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 ase *globalexits
9100: 74 61 74 75 73 2a 0a 20 20 20 20 20 20 20 20 20 tatus*.
9110: 28 28 30 29 28 65 78 69 74 20 30 29 29 0a 20 20 ((0)(exit 0)).
9120: 20 20 20 20 20 20 20 28 28 31 29 28 65 78 69 74 ((1)(exit
9130: 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 1)). ((
9140: 32 29 28 65 78 69 74 20 32 29 29 0a 20 20 20 20 2)(exit 2)).
9150: 20 20 20 20 20 28 65 6c 73 65 20 28 65 78 69 74 (else (exit
9160: 20 33 29 29 29 29 29 0a 3))))).