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 6a 73 6f 6e 29 ne apropos json)
01e0: 20 3b 3b 20 28 73 72 66 69 20 31 38 29 20 65 78 ;; (srfi 18) ex
01f0: 74 72 61 73 29 0a 28 69 6d 70 6f 72 74 20 28 70 tras).(import (p
0200: 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 refix sqlite3 sq
0210: 6c 69 74 65 33 3a 29 29 0a 28 69 6d 70 6f 72 74 lite3:)).(import
0220: 20 28 70 72 65 66 69 78 20 62 61 73 65 36 34 20 (prefix base64
0230: 62 61 73 65 36 34 3a 29 29 0a 0a 3b 3b 20 28 75 base64:))..;; (u
0240: 73 65 20 7a 6d 71 29 0a 0a 28 64 65 63 6c 61 72 se zmq)..(declar
0250: 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 e (uses common))
0260: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0270: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
0280: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
0290: 73 20 6d 61 72 67 73 29 29 0a 28 64 65 63 6c 61 s margs)).(decla
02a0: 72 65 20 28 75 73 65 73 20 72 75 6e 73 29 29 0a re (uses runs)).
02b0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6c (declare (uses l
02c0: 61 75 6e 63 68 29 29 0a 28 64 65 63 6c 61 72 65 aunch)).(declare
02d0: 20 28 75 73 65 73 20 73 65 72 76 65 72 29 29 0a (uses server)).
02e0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 (declare (uses c
02f0: 6c 69 65 6e 74 29 29 0a 28 64 65 63 6c 61 72 65 lient)).(declare
0300: 20 28 75 73 65 73 20 74 65 73 74 73 29 29 0a 28 (uses tests)).(
0310: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 67 65 declare (uses ge
0320: 6e 65 78 61 6d 70 6c 65 29 29 0a 0a 28 64 65 66 nexample))..(def
0330: 69 6e 65 20 2a 64 62 2a 20 23 66 29 20 3b 3b 20 ine *db* #f) ;;
0340: 74 68 69 73 20 69 73 20 6f 6e 6c 79 20 66 6f 72 this is only for
0350: 20 74 68 65 20 72 65 70 6c 2c 20 64 6f 20 6e 6f the repl, do no
0360: 74 20 75 73 65 20 69 6e 20 67 65 6e 65 72 61 6c t use in general
0370: 21 21 21 21 0a 0a 28 69 6e 63 6c 75 64 65 20 22 !!!!..(include "
0380: 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 common_records.s
0390: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 6b cm").(include "k
03a0: 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 ey_records.scm")
03b0: 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 65 .(include "db_re
03c0: 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 cords.scm").(inc
03d0: 6c 75 64 65 20 22 6d 65 67 61 74 65 73 74 2d 66 lude "megatest-f
03e0: 6f 73 73 69 6c 2d 68 61 73 68 2e 73 63 6d 22 29 ossil-hash.scm")
03f0: 0a 0a 3b 3b 20 28 75 73 65 20 74 72 61 63 65 20 ..;; (use trace
0400: 64 6f 74 2d 6c 6f 63 6b 69 6e 67 29 0a 3b 3b 20 dot-locking).;;
0410: 28 74 72 61 63 65 0a 3b 3b 20 20 63 64 62 3a 63 (trace.;; cdb:c
0420: 6c 69 65 6e 74 2d 63 61 6c 6c 0a 3b 3b 20 20 63 lient-call.;; c
0430: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 0a 3b 3b db:remote-run.;;
0440: 20 20 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 cdb:test-set-s
0450: 74 61 74 75 73 2d 73 74 61 74 65 0a 3b 3b 20 20 tatus-state.;;
0460: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
0470: 0a 3b 3b 20 20 64 62 3a 70 72 6f 63 65 73 73 2d .;; db:process-
0480: 71 75 65 75 65 2d 69 74 65 6d 0a 3b 3b 20 20 64 queue-item.;; d
0490: 62 3a 74 65 73 74 2d 67 65 74 2d 6c 6f 67 66 69 b:test-get-logfi
04a0: 6c 65 2d 69 6e 66 6f 0a 3b 3b 20 20 64 62 3a 74 le-info.;; db:t
04b0: 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 eststep-set-stat
04c0: 75 73 21 0a 3b 3b 20 20 6e 69 63 65 2d 70 61 74 us!.;; nice-pat
04d0: 68 0a 3b 3b 20 20 6f 62 74 61 69 6e 2d 64 6f 74 h.;; obtain-dot
04e0: 2d 6c 6f 63 6b 0a 3b 3b 20 20 6f 70 65 6e 2d 72 -lock.;; open-r
04f0: 75 6e 2d 63 6c 6f 73 65 0a 3b 3b 20 20 72 65 61 un-close.;; rea
0500: 64 2d 63 6f 6e 66 69 67 0a 3b 3b 20 20 72 75 6e d-config.;; run
0510: 73 3a 63 61 6e 2d 72 75 6e 2d 6d 6f 72 65 2d 74 s:can-run-more-t
0520: 65 73 74 73 0a 3b 3b 20 20 73 71 6c 69 74 65 33 ests.;; sqlite3
0530: 3a 65 78 65 63 75 74 65 0a 3b 3b 20 20 73 71 6c :execute.;; sql
0540: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
0550: 77 0a 3b 3b 20 20 74 65 73 74 73 3a 63 68 65 63 w.;; tests:chec
0560: 6b 2d 77 61 69 76 65 72 2d 65 6c 69 67 69 62 69 k-waiver-eligibi
0570: 6c 69 74 79 0a 3b 3b 20 20 74 65 73 74 73 3a 73 lity.;; tests:s
0580: 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 0a 3b ummarize-items.;
0590: 3b 20 20 74 65 73 74 73 3a 74 65 73 74 2d 73 65 ; tests:test-se
05a0: 74 2d 73 74 61 74 75 73 21 0a 3b 3b 20 20 74 68 t-status!.;; th
05b0: 72 65 61 64 2d 73 6c 65 65 70 21 0a 3b 3b 29 0a read-sleep!.;;).
05c0: 20 20 20 20 20 20 20 0a 0a 28 64 65 66 69 6e 65 ..(define
05d0: 20 68 65 6c 70 20 28 63 6f 6e 63 20 22 0a 4d 65 help (conc ".Me
05e0: 67 61 74 65 73 74 2c 20 64 6f 63 75 6d 65 6e 74 gatest, document
05f0: 61 74 69 6f 6e 20 61 74 20 68 74 74 70 3a 2f 2f ation at http://
0600: 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 www.kiatoa.com/f
0610: 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 0a ossils/megatest.
0620: 20 20 76 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 version " mega
0630: 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 0a 20 test-version ".
0640: 20 6c 69 63 65 6e 73 65 20 47 50 4c 2c 20 43 6f license GPL, Co
0650: 70 79 72 69 67 68 74 20 4d 61 74 74 20 57 65 6c pyright Matt Wel
0660: 6c 61 6e 64 20 32 30 30 36 2d 32 30 31 32 0a 0a land 2006-2012..
0670: 55 73 61 67 65 3a 20 6d 65 67 61 74 65 73 74 20 Usage: megatest
0680: 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 2d 68 20 20 [options]. -h
0690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
06a0: 20 20 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a : this help.
06b0: 20 20 2d 76 65 72 73 69 6f 6e 20 20 20 20 20 20 -version
06c0: 20 20 20 20 20 20 20 20 20 20 3a 20 70 72 69 6e : prin
06d0: 74 20 6d 65 67 61 74 65 73 74 20 76 65 72 73 69 t megatest versi
06e0: 6f 6e 20 28 63 75 72 72 65 6e 74 6c 79 20 22 20 on (currently "
06f0: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
0700: 20 22 29 0a 0a 4c 61 75 6e 63 68 69 6e 67 20 61 ")..Launching a
0710: 6e 64 20 6d 61 6e 61 67 69 6e 67 20 72 75 6e 73 nd managing runs
0720: 0a 20 20 2d 72 75 6e 61 6c 6c 20 20 20 20 20 20 . -runall
0730: 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 75 6e : run
0740: 20 61 6c 6c 20 74 65 73 74 73 20 74 68 61 74 20 all tests that
0750: 61 72 65 20 6e 6f 74 20 73 74 61 74 65 20 43 4f are not state CO
0760: 4d 50 4c 45 54 45 44 20 61 6e 64 20 73 74 61 74 MPLETED and stat
0770: 75 73 20 50 41 53 53 2c 20 0a 20 20 20 20 20 20 us PASS, .
0780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0790: 20 20 20 20 20 20 43 48 45 43 4b 20 6f 72 20 4b CHECK or K
07a0: 49 4c 4c 45 44 0a 20 20 2d 72 75 6e 74 65 73 74 ILLED. -runtest
07b0: 73 20 74 73 74 31 2c 74 73 74 32 20 2e 2e 2e 20 s tst1,tst2 ...
07c0: 3a 20 72 75 6e 20 74 65 73 74 73 0a 20 20 2d 72 : run tests. -r
07d0: 65 6d 6f 76 65 2d 72 75 6e 73 20 20 20 20 20 20 emove-runs
07e0: 20 20 20 20 20 20 3a 20 72 65 6d 6f 76 65 20 74 : remove t
07f0: 68 65 20 64 61 74 61 20 66 6f 72 20 61 20 72 75 he data for a ru
0800: 6e 2c 20 72 65 71 75 69 72 65 73 20 3a 72 75 6e n, requires :run
0810: 6e 61 6d 65 20 61 6e 64 20 2d 74 65 73 74 70 61 name and -testpa
0820: 74 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 tt.
0830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 4f O
0840: 70 74 69 6f 6e 61 6c 6c 79 20 75 73 65 20 3a 73 ptionally use :s
0850: 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 tate and :status
0860: 0a 20 20 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 . -set-state-st
0870: 61 74 75 73 20 58 2c 59 20 20 20 3a 20 73 65 74 atus X,Y : set
0880: 20 73 74 61 74 65 20 74 6f 20 58 20 61 6e 64 20 state to X and
0890: 73 74 61 74 75 73 20 74 6f 20 59 2c 20 72 65 71 status to Y, req
08a0: 75 69 72 65 73 20 63 6f 6e 74 72 6f 6c 73 20 70 uires controls p
08b0: 65 72 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 0a er -remove-runs.
08c0: 20 20 2d 72 65 72 75 6e 20 46 41 49 4c 2c 57 41 -rerun FAIL,WA
08d0: 52 4e 2e 2e 2e 20 20 20 20 20 3a 20 66 6f 72 63 RN... : forc
08e0: 65 20 72 65 2d 72 75 6e 20 66 6f 72 20 74 65 73 e re-run for tes
08f0: 74 73 20 77 69 74 68 20 73 70 65 63 69 66 69 63 ts with specific
0900: 65 64 20 73 74 61 74 75 73 28 73 29 0a 20 20 2d ed status(s). -
0910: 72 6f 6c 6c 75 70 20 20 20 20 20 20 20 20 20 20 rollup
0920: 20 20 20 20 20 20 20 3a 20 28 63 75 72 72 65 6e : (curren
0930: 74 6c 79 20 64 69 73 61 62 6c 65 64 29 20 66 69 tly disabled) fi
0940: 6c 6c 20 72 75 6e 20 28 73 65 74 20 62 79 20 3a ll run (set by :
0950: 72 75 6e 6e 61 6d 65 29 20 20 77 69 74 68 20 6c runname) with l
0960: 61 74 65 73 74 20 74 65 73 74 28 73 29 0a 20 20 atest test(s).
0970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0980: 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d 20 70 from p
0990: 72 69 6f 72 20 72 75 6e 73 20 77 69 74 68 20 73 rior runs with s
09a0: 61 6d 65 20 6b 65 79 73 0a 20 20 2d 6c 6f 63 6b ame keys. -lock
09b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09c0: 20 20 20 3a 20 6c 6f 63 6b 20 72 75 6e 20 73 70 : lock run sp
09d0: 65 63 69 66 69 65 64 20 62 79 20 74 61 72 67 65 ecified by targe
09e0: 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 20 t and runname.
09f0: 2d 75 6e 6c 6f 63 6b 20 20 20 20 20 20 20 20 20 -unlock
0a00: 20 20 20 20 20 20 20 20 3a 20 75 6e 6c 6f 63 6b : unlock
0a10: 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 20 62 run specified b
0a20: 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 75 6e y target and run
0a30: 6e 61 6d 65 0a 0a 53 65 6c 65 63 74 6f 72 73 20 name..Selectors
0a40: 28 65 2e 67 2e 20 75 73 65 20 66 6f 72 20 2d 72 (e.g. use for -r
0a50: 75 6e 74 65 73 74 73 2c 20 2d 72 65 6d 6f 76 65 untests, -remove
0a60: 2d 72 75 6e 73 2c 20 2d 73 65 74 2d 73 74 61 74 -runs, -set-stat
0a70: 65 2d 73 74 61 74 75 73 2c 20 2d 6c 69 73 74 2d e-status, -list-
0a80: 72 75 6e 73 20 65 74 63 2e 29 0a 20 20 2d 74 61 runs etc.). -ta
0a90: 72 67 65 74 20 6b 65 79 31 2f 6b 65 79 32 2f 2e rget key1/key2/.
0aa0: 2e 2e 20 20 20 3a 20 72 75 6e 20 66 6f 72 20 6b .. : run for k
0ab0: 65 79 31 2c 20 6b 65 79 32 2c 20 65 74 63 2e 0a ey1, key2, etc..
0ac0: 20 20 2d 72 65 71 74 61 72 67 20 6b 65 79 31 2f -reqtarg key1/
0ad0: 6b 65 79 32 2f 2e 2e 2e 20 20 3a 20 72 75 6e 20 key2/... : run
0ae0: 66 6f 72 20 6b 65 79 31 2c 20 6b 65 79 32 2c 20 for key1, key2,
0af0: 65 74 63 2e 20 62 75 74 20 6b 65 79 31 2f 6b 65 etc. but key1/ke
0b00: 79 32 20 6d 75 73 74 20 62 65 20 69 6e 20 72 75 y2 must be in ru
0b10: 6e 63 6f 6e 66 69 67 0a 20 20 2d 74 65 73 74 70 nconfig. -testp
0b20: 61 74 74 20 70 61 74 74 31 2f 70 61 74 74 32 2c att patt1/patt2,
0b30: 70 61 74 74 33 2f 2e 2e 2e 20 20 3a 20 25 20 69 patt3/... : % i
0b40: 73 20 77 69 6c 64 63 61 72 64 0a 20 20 3a 72 75 s wildcard. :ru
0b50: 6e 6e 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 nname
0b60: 20 20 20 20 20 3a 20 72 65 71 75 69 72 65 64 2c : required,
0b70: 20 6e 61 6d 65 20 66 6f 72 20 74 68 69 73 20 70 name for this p
0b80: 61 72 74 69 63 75 6c 61 72 20 74 65 73 74 20 72 articular test r
0b90: 75 6e 0a 20 20 3a 73 74 61 74 65 20 20 20 20 20 un. :state
0ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 41 : A
0bb0: 70 70 6c 69 65 73 20 74 6f 20 72 75 6e 73 2c 20 pplies to runs,
0bc0: 74 65 73 74 73 20 6f 72 20 73 74 65 70 73 20 64 tests or steps d
0bd0: 65 70 65 6e 64 69 6e 67 20 6f 6e 20 63 6f 6e 74 epending on cont
0be0: 65 78 74 0a 20 20 3a 73 74 61 74 75 73 20 20 20 ext. :status
0bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
0c00: 41 70 70 6c 69 65 73 20 74 6f 20 72 75 6e 73 2c Applies to runs,
0c10: 20 74 65 73 74 73 20 6f 72 20 73 74 65 70 73 20 tests or steps
0c20: 64 65 70 65 6e 64 69 6e 67 20 6f 6e 20 63 6f 6e depending on con
0c30: 74 65 78 74 0a 0a 54 65 73 74 20 68 65 6c 70 65 text..Test helpe
0c40: 72 73 20 28 66 6f 72 20 75 73 65 20 69 6e 73 69 rs (for use insi
0c50: 64 65 20 74 65 73 74 73 29 0a 20 20 2d 73 74 65 de tests). -ste
0c60: 70 20 73 74 65 70 6e 61 6d 65 0a 20 20 2d 74 65 p stepname. -te
0c70: 73 74 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 st-status
0c80: 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 73 : set the s
0c90: 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 73 20 tate and status
0ca0: 6f 66 20 61 20 74 65 73 74 20 28 75 73 65 20 3a of a test (use :
0cb0: 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 state and :statu
0cc0: 73 29 0a 20 20 2d 73 65 74 6c 6f 67 20 6c 6f 67 s). -setlog log
0cd0: 66 6e 61 6d 65 20 20 20 20 20 20 20 20 3a 20 73 fname : s
0ce0: 65 74 20 74 68 65 20 70 61 74 68 2f 66 69 6c 65 et the path/file
0cf0: 6e 61 6d 65 20 74 6f 20 74 68 65 20 66 69 6e 61 name to the fina
0d00: 6c 20 6c 6f 67 20 72 65 6c 61 74 69 76 65 20 74 l log relative t
0d10: 6f 20 74 68 65 20 74 65 73 74 0a 20 20 20 20 20 o the test.
0d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d30: 20 20 20 20 20 20 20 64 69 72 65 63 74 6f 72 79 directory
0d40: 2e 20 6d 61 79 20 62 65 20 75 73 65 64 20 77 69 . may be used wi
0d50: 74 68 20 2d 74 65 73 74 2d 73 74 61 74 75 73 0a th -test-status.
0d60: 20 20 2d 73 65 74 2d 74 6f 70 6c 6f 67 20 6c 6f -set-toplog lo
0d70: 67 66 6e 61 6d 65 20 20 20 20 3a 20 73 65 74 20 gfname : set
0d80: 74 68 65 20 6f 76 65 72 61 6c 6c 20 6c 6f 67 20 the overall log
0d90: 66 6f 72 20 61 20 73 75 69 74 65 20 6f 66 20 73 for a suite of s
0da0: 75 62 2d 74 65 73 74 73 0a 20 20 2d 73 75 6d 6d ub-tests. -summ
0db0: 61 72 69 7a 65 2d 69 74 65 6d 73 20 20 20 20 20 arize-items
0dc0: 20 20 20 3a 20 66 6f 72 20 61 6e 20 69 74 65 6d : for an item
0dd0: 69 7a 65 64 20 74 65 73 74 20 63 72 65 61 74 65 ized test create
0de0: 20 61 20 73 75 6d 6d 61 72 79 20 68 74 6d 6c 20 a summary html
0df0: 0a 20 20 2d 6d 20 63 6f 6d 6d 65 6e 74 20 20 20 . -m comment
0e00: 20 20 20 20 20 20 20 20 20 20 20 3a 20 69 6e 73 : ins
0e10: 65 72 74 20 61 20 63 6f 6d 6d 65 6e 74 20 66 6f ert a comment fo
0e20: 72 20 74 68 69 73 20 74 65 73 74 0a 0a 54 65 73 r this test..Tes
0e30: 74 20 64 61 74 61 20 63 61 70 74 75 72 65 0a 20 t data capture.
0e40: 20 2d 73 65 74 2d 76 61 6c 75 65 73 20 20 20 20 -set-values
0e50: 20 20 20 20 20 20 20 20 20 3a 20 75 70 64 61 74 : updat
0e60: 65 20 6f 72 20 73 65 74 20 76 61 6c 75 65 73 20 e or set values
0e70: 69 6e 20 74 68 65 20 74 65 73 74 64 61 74 61 20 in the testdata
0e80: 74 61 62 6c 65 0a 20 20 3a 63 61 74 65 67 6f 72 table. :categor
0e90: 79 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 y
0ea0: 3a 20 73 65 74 20 74 68 65 20 63 61 74 65 67 6f : set the catego
0eb0: 72 79 20 66 69 65 6c 64 20 28 6f 70 74 69 6f 6e ry field (option
0ec0: 61 6c 29 0a 20 20 3a 76 61 72 69 61 62 6c 65 20 al). :variable
0ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
0ee0: 73 65 74 20 74 68 65 20 76 61 72 69 61 62 6c 65 set the variable
0ef0: 20 6e 61 6d 65 20 28 6f 70 74 69 6f 6e 61 6c 29 name (optional)
0f00: 0a 20 20 3a 76 61 6c 75 65 20 20 20 20 20 20 20 . :value
0f10: 20 20 20 20 20 20 20 20 20 20 20 3a 20 76 61 6c : val
0f20: 75 65 20 6d 65 61 73 75 72 65 64 20 28 72 65 71 ue measured (req
0f30: 75 69 72 65 64 29 0a 20 20 3a 65 78 70 65 63 74 uired). :expect
0f40: 65 64 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ed
0f50: 20 3a 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 : value expecte
0f60: 64 20 28 72 65 71 75 69 72 65 64 29 0a 20 20 3a d (required). :
0f70: 74 6f 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 tol
0f80: 20 20 20 20 20 20 20 3a 20 7c 76 61 6c 75 65 2d : |value-
0f90: 65 78 70 65 63 74 7c 20 3c 3d 20 74 6f 6c 20 28 expect| <= tol (
0fa0: 72 65 71 75 69 72 65 64 2c 20 63 61 6e 20 62 65 required, can be
0fb0: 20 3c 2c 20 3e 2c 20 3e 3d 2c 20 3c 3d 20 6f 72 <, >, >=, <= or
0fc0: 20 6e 75 6d 62 65 72 29 0a 20 20 3a 75 6e 69 74 number). :unit
0fd0: 73 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s
0fe0: 20 20 20 3a 20 6e 61 6d 65 20 6f 66 20 74 68 65 : name of the
0ff0: 20 75 6e 69 74 73 20 66 6f 72 20 76 61 6c 75 65 units for value
1000: 2c 20 65 78 70 65 63 74 65 64 5f 76 61 6c 75 65 , expected_value
1010: 20 65 74 63 2e 20 28 6f 70 74 69 6f 6e 61 6c 29 etc. (optional)
1020: 0a 20 20 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 . -load-test-da
1030: 74 61 20 20 20 20 20 20 20 20 20 3a 20 72 65 61 ta : rea
1040: 64 20 74 65 73 74 20 73 70 65 63 69 66 69 63 20 d test specific
1050: 64 61 74 61 20 66 6f 72 20 73 74 6f 72 61 67 65 data for storage
1060: 20 69 6e 20 74 68 65 20 74 65 73 74 5f 64 61 74 in the test_dat
1070: 61 20 74 61 62 6c 65 0a 20 20 20 20 20 20 20 20 a table.
1080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1090: 20 20 20 20 66 72 6f 6d 20 73 74 61 6e 64 61 72 from standar
10a0: 64 20 69 6e 2e 20 45 61 63 68 20 6c 69 6e 65 20 d in. Each line
10b0: 69 73 20 63 6f 6d 6d 61 20 64 65 6c 69 6d 69 74 is comma delimit
10c0: 65 64 20 77 69 74 68 20 66 6f 75 72 0a 20 20 20 ed with four.
10d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10e0: 20 20 20 20 20 20 20 20 20 66 69 65 6c 64 73 20 fields
10f0: 63 61 74 65 67 6f 72 79 2c 76 61 72 69 61 62 6c category,variabl
1100: 65 2c 76 61 6c 75 65 2c 63 6f 6d 6d 65 6e 74 0a e,value,comment.
1110: 0a 51 75 65 72 69 65 73 0a 20 20 2d 6c 69 73 74 .Queries. -list
1120: 2d 72 75 6e 73 20 70 61 74 74 20 20 20 20 20 20 -runs patt
1130: 20 20 20 3a 20 6c 69 73 74 20 72 75 6e 73 20 6d : list runs m
1140: 61 74 63 68 69 6e 67 20 70 61 74 74 65 72 6e 20 atching pattern
1150: 5c 22 70 61 74 74 5c 22 2c 20 25 20 69 73 20 74 \"patt\", % is t
1160: 68 65 20 77 69 6c 64 63 61 72 64 0a 20 20 2d 73 he wildcard. -s
1170: 68 6f 77 6b 65 79 73 20 20 20 20 20 20 20 20 20 howkeys
1180: 20 20 20 20 20 20 3a 20 73 68 6f 77 20 74 68 65 : show the
1190: 20 6b 65 79 73 20 75 73 65 64 20 69 6e 20 74 68 keys used in th
11a0: 69 73 20 6d 65 67 61 74 65 73 74 20 73 65 74 75 is megatest setu
11b0: 70 0a 20 20 2d 74 65 73 74 2d 66 69 6c 65 73 20 p. -test-files
11c0: 74 61 72 67 70 61 74 74 20 20 20 20 20 3a 20 67 targpatt : g
11d0: 65 74 20 74 68 65 20 6d 6f 73 74 20 72 65 63 65 et the most rece
11e0: 6e 74 20 74 65 73 74 20 70 61 74 68 2f 66 69 6c nt test path/fil
11f0: 65 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 70 e matching targp
1200: 61 74 74 20 65 2e 67 2e 20 25 2f 25 2e 2e 2e 20 att e.g. %/%...
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 72 65 74 ret
1230: 75 72 6e 73 20 6c 69 73 74 20 73 6f 72 74 65 64 urns list sorted
1240: 20 62 79 20 61 67 65 20 61 73 63 65 6e 64 69 6e by age ascendin
1250: 67 2c 20 73 65 65 20 65 78 61 6d 70 6c 65 73 20 g, see examples
1260: 62 65 6c 6f 77 0a 20 20 2d 74 65 73 74 2d 70 61 below. -test-pa
1270: 74 68 73 20 20 20 20 20 20 20 20 20 20 20 20 20 ths
1280: 3a 20 67 65 74 20 74 68 65 20 74 65 73 74 20 70 : get the test p
1290: 61 74 68 73 20 6d 61 74 63 68 69 6e 67 20 74 61 aths matching ta
12a0: 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 69 rget, runname, i
12b0: 74 65 6d 20 61 6e 64 20 74 65 73 74 0a 20 20 20 tem and test.
12c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12d0: 20 20 20 20 20 20 20 20 20 70 61 74 74 65 72 6e pattern
12e0: 73 2e 0a 20 20 2d 6c 69 73 74 2d 64 69 73 6b 73 s.. -list-disks
12f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c : l
1300: 69 73 74 20 74 68 65 20 64 69 73 6b 73 20 61 76 ist the disks av
1310: 61 69 6c 61 62 6c 65 20 66 6f 72 20 73 74 6f 72 ailable for stor
1320: 69 6e 67 20 72 75 6e 73 0a 20 20 2d 6c 69 73 74 ing runs. -list
1330: 2d 74 61 72 67 65 74 73 20 20 20 20 20 20 20 20 -targets
1340: 20 20 20 3a 20 6c 69 73 74 20 74 68 65 20 74 61 : list the ta
1350: 72 67 65 74 73 20 69 6e 20 72 75 6e 63 6f 6e 66 rgets in runconf
1360: 69 67 73 2e 63 6f 6e 66 69 67 0a 20 20 2d 6c 69 igs.config. -li
1370: 73 74 2d 64 62 2d 74 61 72 67 65 74 73 20 20 20 st-db-targets
1380: 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 65 20 : list the
1390: 74 61 72 67 65 74 20 63 6f 6d 62 69 6e 61 74 69 target combinati
13a0: 6f 6e 73 20 75 73 65 64 20 69 6e 20 74 68 65 20 ons used in the
13b0: 64 62 0a 20 20 2d 73 68 6f 77 2d 63 6f 6e 66 69 db. -show-confi
13c0: 67 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 64 g : d
13d0: 75 6d 70 20 74 68 65 20 69 6e 74 65 72 6e 61 6c ump the internal
13e0: 20 72 65 70 72 65 73 65 6e 74 61 74 69 6f 6e 20 representation
13f0: 6f 66 20 74 68 65 20 6d 65 67 61 74 65 73 74 2e of the megatest.
1400: 63 6f 6e 66 69 67 20 66 69 6c 65 0a 20 20 2d 73 config file. -s
1410: 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 20 20 20 how-runconfig
1420: 20 20 20 20 20 20 3a 20 64 75 6d 70 20 74 68 65 : dump the
1430: 20 69 6e 74 65 72 6e 61 6c 20 72 65 70 72 65 73 internal repres
1440: 65 6e 74 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 entation of the
1450: 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 runconfigs.confi
1460: 67 20 66 69 6c 65 0a 20 20 2d 64 75 6d 70 6d 6f g file. -dumpmo
1470: 64 65 20 6a 73 6f 6e 20 20 20 20 20 20 20 20 20 de json
1480: 20 3a 20 64 75 6d 70 20 69 6e 20 6a 73 6f 6e 20 : dump in json
1490: 66 6f 72 6d 61 74 20 69 6e 73 74 65 61 64 20 6f format instead o
14a0: 66 20 73 65 78 70 72 0a 0a 4d 69 73 63 20 0a 20 f sexpr..Misc .
14b0: 20 2d 72 65 62 75 69 6c 64 2d 64 62 20 20 20 20 -rebuild-db
14c0: 20 20 20 20 20 20 20 20 20 3a 20 62 72 69 6e 67 : bring
14d0: 20 74 68 65 20 64 61 74 61 62 61 73 65 20 73 63 the database sc
14e0: 68 65 6d 61 20 75 70 20 74 6f 20 64 61 74 65 0a hema up to date.
14f0: 20 20 2d 75 70 64 61 74 65 2d 6d 65 74 61 20 20 -update-meta
1500: 20 20 20 20 20 20 20 20 20 20 3a 20 75 70 64 61 : upda
1510: 74 65 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 te the tests met
1520: 61 64 61 74 61 20 66 6f 72 20 61 6c 6c 20 74 65 adata for all te
1530: 73 74 73 0a 20 20 2d 65 6e 76 32 66 69 6c 65 20 sts. -env2file
1540: 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 3a 20 fname :
1550: 77 72 69 74 65 20 74 68 65 20 65 6e 76 69 72 6f write the enviro
1560: 6e 6d 65 6e 74 20 74 6f 20 66 6e 61 6d 65 2e 63 nment to fname.c
1570: 73 68 20 61 6e 64 20 66 6e 61 6d 65 2e 73 68 0a sh and fname.sh.
1580: 20 20 2d 73 65 74 76 61 72 73 20 56 41 52 31 3d -setvars VAR1=
1590: 76 61 6c 31 2c 56 41 52 32 3d 76 61 6c 32 20 3a val1,VAR2=val2 :
15a0: 20 41 64 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 Add environment
15b0: 20 76 61 72 69 61 62 6c 65 73 20 74 6f 20 61 20 variables to a
15c0: 72 75 6e 20 4e 42 2f 2f 20 74 68 65 73 65 20 61 run NB// these a
15d0: 72 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 re.
15e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15f0: 20 20 20 20 6f 76 65 72 77 72 69 74 74 65 6e 20 overwritten
1600: 62 79 20 76 61 6c 75 65 73 20 73 65 74 20 69 6e by values set in
1610: 20 63 6f 6e 66 69 67 20 66 69 6c 65 73 2e 0a 20 config files..
1620: 20 2d 73 65 72 76 65 72 20 2d 7c 68 6f 73 74 6e -server -|hostn
1630: 61 6d 65 20 20 20 20 20 20 3a 20 73 74 61 72 74 ame : start
1640: 20 74 68 65 20 73 65 72 76 65 72 20 28 72 65 64 the server (red
1650: 75 63 65 73 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 uces contention
1660: 6f 6e 20 6d 65 67 61 74 65 73 74 2e 64 62 29 2c on megatest.db),
1670: 20 75 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 use.
1680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1690: 20 2d 20 74 6f 20 61 75 74 6f 6d 61 74 69 63 61 - to automatica
16a0: 6c 6c 79 20 66 69 67 75 72 65 20 6f 75 74 20 68 lly figure out h
16b0: 6f 73 74 6e 61 6d 65 0a 20 20 2d 74 72 61 6e 73 ostname. -trans
16c0: 70 6f 72 74 20 68 74 74 70 7c 66 73 20 20 20 20 port http|fs
16d0: 20 20 3a 20 75 73 65 20 68 74 74 70 20 6f 72 20 : use http or
16e0: 64 69 72 65 63 74 20 61 63 63 65 73 73 20 66 6f direct access fo
16f0: 72 20 74 72 61 6e 73 70 6f 72 74 20 28 64 65 66 r transport (def
1700: 61 75 6c 74 20 69 73 20 68 74 74 70 29 20 0a 20 ault is http) .
1710: 20 2d 64 61 65 6d 6f 6e 69 7a 65 20 20 20 20 20 -daemonize
1720: 20 20 20 20 20 20 20 20 20 3a 20 66 6f 72 6b 20 : fork
1730: 69 6e 74 6f 20 62 61 63 6b 67 72 6f 75 6e 64 20 into background
1740: 61 6e 64 20 64 69 73 63 6f 6e 6e 65 63 74 20 66 and disconnect f
1750: 72 6f 6d 20 73 74 64 69 6e 2f 6f 75 74 0a 20 20 rom stdin/out.
1760: 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 20 20 20 -list-servers
1770: 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 : list t
1780: 68 65 20 73 65 72 76 65 72 73 20 0a 20 20 2d 73 he servers . -s
1790: 74 6f 70 2d 73 65 72 76 65 72 20 69 64 20 20 20 top-server id
17a0: 20 20 20 20 20 20 3a 20 73 74 6f 70 20 73 65 72 : stop ser
17b0: 76 65 72 20 73 70 65 63 69 66 69 65 64 20 62 79 ver specified by
17c0: 20 69 64 20 28 73 65 65 20 6f 75 74 70 75 74 20 id (see output
17d0: 6f 66 20 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 of -list-servers
17e0: 29 0a 20 20 2d 72 65 70 6c 20 20 20 20 20 20 20 ). -repl
17f0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 74 : st
1800: 61 72 74 20 61 20 72 65 70 6c 20 28 75 73 65 66 art a repl (usef
1810: 75 6c 20 66 6f 72 20 65 78 74 65 6e 64 69 6e 67 ul for extending
1820: 20 6d 65 67 61 74 65 73 74 29 0a 20 20 2d 6c 6f megatest). -lo
1830: 61 64 20 66 69 6c 65 2e 73 63 6d 20 20 20 20 20 ad file.scm
1840: 20 20 20 20 20 3a 20 6c 6f 61 64 20 61 6e 64 20 : load and
1850: 72 75 6e 20 66 69 6c 65 2e 73 63 6d 0a 0a 53 70 run file.scm..Sp
1860: 72 65 61 64 73 68 65 65 74 20 67 65 6e 65 72 61 readsheet genera
1870: 74 69 6f 6e 0a 20 20 2d 65 78 74 72 61 63 74 2d tion. -extract-
1880: 6f 64 73 20 66 6e 61 6d 65 2e 6f 64 73 20 20 3a ods fname.ods :
1890: 20 65 78 74 72 61 63 74 20 61 6e 20 6f 70 65 6e extract an open
18a0: 20 64 6f 63 75 6d 65 6e 74 20 73 70 72 65 61 64 document spread
18b0: 73 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 64 sheet from the d
18c0: 61 74 61 62 61 73 65 0a 20 20 2d 70 61 74 68 6d atabase. -pathm
18d0: 6f 64 20 70 61 74 68 20 20 20 20 20 20 20 20 20 od path
18e0: 20 20 3a 20 69 6e 73 65 72 74 20 70 61 74 68 2c : insert path,
18f0: 20 69 2e 65 2e 20 70 61 74 68 2f 72 75 6e 61 6d i.e. path/runam
1900: 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 69 e/itempath/logfi
1910: 6c 65 2e 68 74 6d 6c 0a 20 20 20 20 20 20 20 20 le.html.
1920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1930: 20 20 20 20 77 69 6c 6c 20 63 6c 65 61 72 20 74 will clear t
1940: 68 65 20 66 69 65 6c 64 20 69 66 20 6e 6f 20 72 he field if no r
1950: 75 6e 64 69 72 2f 74 65 73 74 6e 61 6d 65 2f 69 undir/testname/i
1960: 74 65 6d 70 61 74 68 2f 6c 6f 67 66 69 6c 65 0a tempath/logfile.
1970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1980: 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 69 if i
1990: 74 20 63 6f 6e 74 61 69 6e 73 20 66 6f 72 77 61 t contains forwa
19a0: 72 64 20 73 6c 61 73 68 65 73 20 74 68 65 20 70 rd slashes the p
19b0: 61 74 68 20 77 69 6c 6c 20 62 65 20 63 6f 6e 76 ath will be conv
19c0: 65 72 74 65 64 0a 20 20 20 20 20 20 20 20 20 20 erted.
19d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19e0: 20 20 74 6f 20 77 69 6e 64 6f 77 73 20 73 74 79 to windows sty
19f0: 6c 65 0a 47 65 74 74 69 6e 67 20 73 74 61 72 74 le.Getting start
1a00: 65 64 0a 20 20 2d 67 65 6e 2d 6d 65 67 61 74 65 ed. -gen-megate
1a10: 73 74 2d 61 72 65 61 20 20 20 20 20 20 20 3a 20 st-area :
1a20: 63 72 65 61 74 65 20 61 20 73 6b 65 6c 65 74 6f create a skeleto
1a30: 6e 20 6d 65 67 61 74 65 73 74 20 61 72 65 61 2e n megatest area.
1a40: 20 59 6f 75 20 77 69 6c 6c 20 62 65 20 70 72 6f You will be pro
1a50: 6d 70 74 65 64 20 66 6f 72 20 70 61 74 68 73 0a mpted for paths.
1a60: 20 20 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d -gen-megatest-
1a70: 74 65 73 74 20 74 6e 61 6d 65 20 3a 20 63 72 65 test tname : cre
1a80: 61 74 65 20 61 20 73 6b 65 6c 65 74 6f 6e 20 6d ate a skeleton m
1a90: 65 67 61 74 65 73 74 20 74 65 73 74 2e 20 59 6f egatest test. Yo
1aa0: 75 20 77 69 6c 6c 20 62 65 20 70 72 6f 6d 70 74 u will be prompt
1ab0: 65 64 20 66 6f 72 20 69 6e 66 6f 0a 0a 45 78 61 ed for info..Exa
1ac0: 6d 70 6c 65 73 0a 0a 23 20 47 65 74 20 74 65 73 mples..# Get tes
1ad0: 74 20 70 61 74 68 2c 20 75 73 65 20 27 2e 27 20 t path, use '.'
1ae0: 74 6f 20 67 65 74 20 61 20 73 69 6e 67 6c 65 20 to get a single
1af0: 70 61 74 68 20 6f 72 20 61 20 73 70 65 63 69 66 path or a specif
1b00: 69 63 20 70 61 74 68 2f 66 69 6c 65 20 70 61 74 ic path/file pat
1b10: 74 65 72 6e 0a 6d 65 67 61 74 65 73 74 20 2d 74 tern.megatest -t
1b20: 65 73 74 2d 66 69 6c 65 73 20 27 6c 6f 67 73 2f est-files 'logs/
1b30: 2a 2e 6c 6f 67 27 20 2d 74 61 72 67 65 74 20 75 *.log' -target u
1b40: 62 75 6e 74 75 2f 6e 25 2f 6e 6f 25 20 3a 72 75 buntu/n%/no% :ru
1b50: 6e 6e 61 6d 65 20 77 34 39 25 20 2d 74 65 73 74 nname w49% -test
1b60: 70 61 74 74 20 74 65 73 74 5f 6d 74 25 0a 0a 43 patt test_mt%..C
1b70: 61 6c 6c 65 64 20 61 73 20 22 20 28 73 74 72 69 alled as " (stri
1b80: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
1b90: 61 72 67 76 29 20 22 20 22 29 20 22 0a 56 65 72 argv) " ") ".Ver
1ba0: 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 2d sion " megatest-
1bb0: 76 65 72 73 69 6f 6e 20 22 2c 20 62 75 69 6c 74 version ", built
1bc0: 20 66 72 6f 6d 20 22 20 6d 65 67 61 74 65 73 74 from " megatest
1bd0: 2d 66 6f 73 73 69 6c 2d 68 61 73 68 20 29 29 0a -fossil-hash )).
1be0: 0a 3b 3b 20 20 2d 67 75 69 20 20 20 20 20 20 20 .;; -gui
1bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 : s
1c00: 74 61 72 74 20 61 20 67 75 69 20 69 6e 74 65 72 tart a gui inter
1c10: 66 61 63 65 0a 3b 3b 20 20 2d 63 6f 6e 66 69 67 face.;; -config
1c20: 20 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 20 fname
1c30: 20 3a 20 6f 76 65 72 72 69 64 65 20 74 68 65 20 : override the
1c40: 72 75 6e 63 6f 6e 66 69 67 20 66 69 6c 65 20 77 runconfig file w
1c50: 69 74 68 20 66 6e 61 6d 65 0a 0a 3b 3b 20 70 72 ith fname..;; pr
1c60: 6f 63 65 73 73 20 61 72 67 73 0a 28 64 65 66 69 ocess args.(defi
1c70: 6e 65 20 72 65 6d 61 72 67 73 20 28 61 72 67 73 ne remargs (args
1c80: 3a 67 65 74 2d 61 72 67 73 20 0a 09 09 20 28 61 :get-args ... (a
1c90: 72 67 76 29 0a 09 09 20 28 6c 69 73 74 20 20 22 rgv)... (list "
1ca0: 2d 72 75 6e 74 65 73 74 73 22 20 20 3b 3b 20 72 -runtests" ;; r
1cb0: 75 6e 20 61 20 73 70 65 63 69 66 69 63 20 74 65 un a specific te
1cc0: 73 74 0a 09 09 09 22 2d 63 6f 6e 66 69 67 22 20 st...."-config"
1cd0: 20 20 20 3b 3b 20 6f 76 65 72 72 69 64 65 20 74 ;; override t
1ce0: 68 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e he config file n
1cf0: 61 6d 65 0a 09 09 09 22 2d 65 78 65 63 75 74 65 ame...."-execute
1d00: 22 20 20 20 3b 3b 20 72 75 6e 20 74 68 65 20 63 " ;; run the c
1d10: 6f 6d 6d 61 6e 64 20 65 6e 63 6f 64 65 64 20 69 ommand encoded i
1d20: 6e 20 74 68 65 20 62 61 73 65 36 34 20 70 61 72 n the base64 par
1d30: 61 6d 65 74 65 72 0a 09 09 09 22 2d 73 74 65 70 ameter...."-step
1d40: 22 0a 09 09 09 22 3a 72 75 6e 6e 61 6d 65 22 20 "....":runname"
1d50: 20 20 0a 09 09 09 22 2d 74 61 72 67 65 74 22 0a ...."-target".
1d60: 09 09 09 22 2d 72 65 71 74 61 72 67 22 0a 09 09 ..."-reqtarg"...
1d70: 09 22 3a 72 75 6e 6e 61 6d 65 22 0a 09 09 09 22 .":runname"...."
1d80: 2d 72 75 6e 6e 61 6d 65 22 0a 09 09 09 22 3a 73 -runname"....":s
1d90: 74 61 74 65 22 20 20 0a 09 09 09 22 2d 73 74 61 tate" ...."-sta
1da0: 74 65 22 0a 09 09 09 22 3a 73 74 61 74 75 73 22 te"....":status"
1db0: 0a 09 09 09 22 2d 73 74 61 74 75 73 22 0a 09 09 ...."-status"...
1dc0: 09 22 2d 6c 69 73 74 2d 72 75 6e 73 22 0a 09 09 ."-list-runs"...
1dd0: 09 22 2d 74 65 73 74 70 61 74 74 22 20 0a 09 09 ."-testpatt" ...
1de0: 09 22 2d 69 74 65 6d 70 61 74 74 22 0a 09 09 09 ."-itempatt"....
1df0: 22 2d 73 65 74 6c 6f 67 22 0a 09 09 09 22 2d 73 "-setlog"...."-s
1e00: 65 74 2d 74 6f 70 6c 6f 67 22 0a 09 09 09 22 2d et-toplog"...."-
1e10: 72 75 6e 73 74 65 70 22 0a 09 09 09 22 2d 6c 6f runstep"...."-lo
1e20: 67 70 72 6f 22 0a 09 09 09 22 2d 6d 22 0a 09 09 gpro"...."-m"...
1e30: 09 22 2d 72 65 72 75 6e 22 0a 09 09 09 22 2d 64 ."-rerun"...."-d
1e40: 61 79 73 22 0a 09 09 09 22 2d 72 65 6e 61 6d 65 ays"...."-rename
1e50: 2d 72 75 6e 22 0a 09 09 09 22 2d 74 6f 22 0a 09 -run"...."-to"..
1e60: 09 09 3b 3b 20 76 61 6c 75 65 73 20 61 6e 64 20 ..;; values and
1e70: 6d 65 73 73 61 67 65 73 0a 09 09 09 22 3a 63 61 messages....":ca
1e80: 74 65 67 6f 72 79 22 0a 09 09 09 22 3a 76 61 72 tegory"....":var
1e90: 69 61 62 6c 65 22 0a 09 09 09 22 3a 76 61 6c 75 iable"....":valu
1ea0: 65 22 0a 09 09 09 22 3a 65 78 70 65 63 74 65 64 e"....":expected
1eb0: 22 0a 09 09 09 22 3a 74 6f 6c 22 0a 09 09 09 22 "....":tol"...."
1ec0: 3a 75 6e 69 74 73 22 0a 09 09 09 3b 3b 20 6d 69 :units"....;; mi
1ed0: 73 63 0a 09 09 09 22 2d 73 65 72 76 65 72 22 0a sc...."-server".
1ee0: 09 09 09 22 2d 74 72 61 6e 73 70 6f 72 74 22 0a ..."-transport".
1ef0: 09 09 09 22 2d 73 74 6f 70 2d 73 65 72 76 65 72 ..."-stop-server
1f00: 22 0a 09 09 09 22 2d 70 6f 72 74 22 0a 09 09 09 "...."-port"....
1f10: 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 0a 09 "-extract-ods"..
1f20: 09 09 22 2d 70 61 74 68 6d 6f 64 22 0a 09 09 09 .."-pathmod"....
1f30: 22 2d 65 6e 76 32 66 69 6c 65 22 0a 09 09 09 22 "-env2file"...."
1f40: 2d 73 65 74 76 61 72 73 22 0a 09 09 09 22 2d 73 -setvars"...."-s
1f50: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 et-state-status"
1f60: 0a 09 09 09 22 2d 64 65 62 75 67 22 20 3b 3b 20 ...."-debug" ;;
1f70: 66 6f 72 20 2a 76 65 72 62 6f 73 69 74 79 2a 20 for *verbosity*
1f80: 3e 20 32 0a 09 09 09 22 2d 67 65 6e 2d 6d 65 67 > 2...."-gen-meg
1f90: 61 74 65 73 74 2d 74 65 73 74 22 0a 09 09 09 22 atest-test"...."
1fa0: 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 -override-timeou
1fb0: 74 22 0a 09 09 09 22 2d 74 65 73 74 2d 66 69 6c t"...."-test-fil
1fc0: 65 73 22 20 20 3b 3b 20 2d 74 65 73 74 2d 70 61 es" ;; -test-pa
1fd0: 74 68 73 20 69 73 20 66 6f 72 20 6c 69 73 74 69 ths is for listi
1fe0: 6e 67 20 61 6c 6c 0a 09 09 09 22 2d 6c 6f 61 64 ng all...."-load
1ff0: 22 20 20 20 20 20 20 20 20 3b 3b 20 6c 6f 61 64 " ;; load
2000: 20 61 6e 64 20 65 78 65 63 74 75 74 65 20 61 20 and exectute a
2010: 73 63 68 65 6d 65 20 66 69 6c 65 0a 09 09 09 22 scheme file...."
2020: 2d 64 75 6d 70 6d 6f 64 65 22 0a 09 09 09 29 20 -dumpmode"....)
2030: 0a 09 09 20 28 6c 69 73 74 20 20 22 2d 68 22 0a ... (list "-h".
2040: 09 09 09 22 2d 76 65 72 73 69 6f 6e 22 0a 09 09 ..."-version"...
2050: 20 20 20 20 20 20 20 20 22 2d 66 6f 72 63 65 22 "-force"
2060: 0a 09 09 20 20 20 20 20 20 20 20 22 2d 78 74 65 ... "-xte
2070: 72 6d 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d rm"... "-
2080: 73 68 6f 77 6b 65 79 73 22 0a 09 09 20 20 20 20 showkeys"...
2090: 20 20 20 20 22 2d 74 65 73 74 2d 73 74 61 74 75 "-test-statu
20a0: 73 22 0a 09 09 09 22 2d 73 65 74 2d 76 61 6c 75 s"...."-set-valu
20b0: 65 73 22 0a 09 09 09 22 2d 6c 6f 61 64 2d 74 65 es"...."-load-te
20c0: 73 74 2d 64 61 74 61 22 0a 09 09 09 22 2d 73 75 st-data"...."-su
20d0: 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 0a 09 mmarize-items"..
20e0: 09 20 20 20 20 20 20 20 20 22 2d 67 75 69 22 0a . "-gui".
20f0: 09 09 09 22 2d 64 61 65 6d 6f 6e 69 7a 65 22 0a ..."-daemonize".
2100: 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 09 22 2d ...;; misc...."-
2110: 61 72 63 68 69 76 65 22 0a 09 09 09 22 2d 72 65 archive"...."-re
2120: 70 6c 22 0a 09 09 09 22 2d 6c 6f 63 6b 22 0a 09 pl"...."-lock"..
2130: 09 09 22 2d 75 6e 6c 6f 63 6b 22 0a 09 09 09 22 .."-unlock"...."
2140: 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 0a 09 -list-servers"..
2150: 09 09 3b 3b 20 6d 69 73 74 20 71 75 65 72 69 65 ..;; mist querie
2160: 73 0a 09 09 09 22 2d 6c 69 73 74 2d 64 69 73 6b s...."-list-disk
2170: 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d 74 61 72 s"...."-list-tar
2180: 67 65 74 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d gets"...."-list-
2190: 64 62 2d 74 61 72 67 65 74 73 22 0a 09 09 09 22 db-targets"...."
21a0: 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 22 -show-runconfig"
21b0: 0a 09 09 09 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 ...."-show-confi
21c0: 67 22 0a 09 09 09 3b 3b 20 71 75 65 72 69 65 73 g"....;; queries
21d0: 0a 09 09 09 22 2d 74 65 73 74 2d 70 61 74 68 73 ...."-test-paths
21e0: 22 20 3b 3b 20 67 65 74 20 70 61 74 68 28 73 29 " ;; get path(s)
21f0: 20 74 6f 20 61 20 74 65 73 74 2c 20 6f 72 64 65 to a test, orde
2200: 72 65 64 20 62 79 20 79 6f 75 6e 67 65 73 74 20 red by youngest
2210: 66 69 72 73 74 0a 0a 09 09 09 22 2d 72 75 6e 61 first....."-runa
2220: 6c 6c 22 20 20 20 20 3b 3b 20 72 75 6e 20 61 6c ll" ;; run al
2230: 6c 20 74 65 73 74 73 0a 09 09 09 22 2d 72 65 6d l tests...."-rem
2240: 6f 76 65 2d 72 75 6e 73 22 0a 09 09 09 22 2d 72 ove-runs"...."-r
2250: 65 62 75 69 6c 64 2d 64 62 22 0a 09 09 09 22 2d ebuild-db"...."-
2260: 72 6f 6c 6c 75 70 22 0a 09 09 09 22 2d 75 70 64 rollup"...."-upd
2270: 61 74 65 2d 6d 65 74 61 22 0a 09 09 09 22 2d 67 ate-meta"...."-g
2280: 65 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 en-megatest-area
2290: 22 0a 0a 09 09 09 22 2d 6c 6f 67 67 69 6e 67 22 "....."-logging"
22a0: 0a 09 09 09 22 2d 76 22 20 3b 3b 20 76 65 72 62 ...."-v" ;; verb
22b0: 6f 73 65 20 32 2c 20 6d 6f 72 65 20 74 68 61 6e ose 2, more than
22c0: 20 6e 6f 72 6d 61 6c 20 28 6e 6f 72 6d 61 6c 20 normal (normal
22d0: 69 73 20 31 29 0a 09 09 09 22 2d 71 22 20 3b 3b is 1)...."-q" ;;
22e0: 20 71 75 69 65 74 20 30 2c 20 65 72 72 6f 72 73 quiet 0, errors
22f0: 2f 77 61 72 6e 69 6e 67 73 20 6f 6e 6c 79 0a 09 /warnings only..
2300: 09 20 20 20 20 20 20 20 29 0a 09 09 20 61 72 67 . )... arg
2310: 73 3a 61 72 67 2d 68 61 73 68 0a 09 09 20 30 29 s:arg-hash... 0)
2320: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
2330: 2d 61 72 67 20 22 2d 68 22 29 0a 20 20 20 20 28 -arg "-h"). (
2340: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 69 begin. (pri
2350: 6e 74 20 68 65 6c 70 29 0a 20 20 20 20 20 20 28 nt help). (
2360: 65 78 69 74 29 29 29 0a 0a 28 69 66 20 28 61 72 exit)))..(if (ar
2370: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 65 72 gs:get-arg "-ver
2380: 73 69 6f 6e 22 29 0a 20 20 20 20 28 62 65 67 69 sion"). (begi
2390: 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 6d n. (print m
23a0: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 egatest-version)
23b0: 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a . (exit))).
23c0: 0a 28 64 65 66 69 6e 65 20 2a 64 69 64 73 6f 6d .(define *didsom
23d0: 65 74 68 69 6e 67 2a 20 23 66 29 0a 0a 3b 3b 3d ething* #f)..;;=
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 3d ================
2420: 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 20 73 65 =====.;; Misc se
2430: 74 75 70 20 73 74 75 66 66 0a 3b 3b 3d 3d 3d 3d tup stuff.;;====
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 3d 3d ================
2480: 3d 3d 0a 0a 28 64 65 62 75 67 3a 73 65 74 75 70 ==..(debug:setup
2490: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
24a0: 2d 61 72 67 20 22 2d 6c 6f 67 67 69 6e 67 22 29 -arg "-logging")
24b0: 28 73 65 74 21 20 2a 6c 6f 67 67 69 6e 67 2a 20 (set! *logging*
24c0: 23 74 29 29 0a 0a 28 69 66 20 28 64 65 62 75 67 #t))..(if (debug
24d0: 3a 64 65 62 75 67 2d 6d 6f 64 65 20 33 29 20 3b :debug-mode 3) ;
24e0: 3b 20 77 65 20 61 72 65 20 6f 62 76 69 6f 75 73 ; we are obvious
24f0: 6c 79 20 64 65 62 75 67 67 69 6e 67 0a 20 20 20 ly debugging.
2500: 20 28 73 65 74 21 20 6f 70 65 6e 2d 72 75 6e 2d (set! open-run-
2510: 63 6c 6f 73 65 20 6f 70 65 6e 2d 72 75 6e 2d 63 close open-run-c
2520: 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f lose-no-exceptio
2530: 6e 2d 68 61 6e 64 6c 69 6e 67 29 29 0a 0a 28 69 n-handling))..(i
2540: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
2550: 22 2d 69 74 65 6d 70 61 74 74 22 29 0a 20 20 20 "-itempatt").
2560: 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 28 (let ((newval (
2570: 63 6f 6e 63 20 28 61 72 67 73 3a 67 65 74 2d 61 conc (args:get-a
2580: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 20 rg "-testpatt")
2590: 22 2f 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 "/" (args:get-ar
25a0: 67 20 22 2d 69 74 65 6d 70 61 74 74 22 29 29 29 g "-itempatt")))
25b0: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
25c0: 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a rint 0 "WARNING:
25d0: 20 2d 69 74 65 6d 70 61 74 74 20 68 61 73 20 62 -itempatt has b
25e0: 65 65 6e 20 64 65 70 72 65 63 61 74 65 64 2c 20 een deprecated,
25f0: 70 6c 65 61 73 65 20 75 73 65 20 2d 74 65 73 74 please use -test
2600: 70 61 74 74 20 74 65 73 74 70 61 74 74 2f 69 74 patt testpatt/it
2610: 65 6d 70 61 74 74 20 6d 65 74 68 6f 64 2c 20 6e empatt method, n
2620: 65 77 20 74 65 73 74 70 61 74 74 20 69 73 20 22 ew testpatt is "
2630: 6e 65 77 76 61 6c 29 0a 20 20 20 20 20 20 28 68 newval). (h
2640: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 ash-table-set! a
2650: 72 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 74 rgs:arg-hash "-t
2660: 65 73 74 70 61 74 74 22 20 6e 65 77 76 61 6c 29 estpatt" newval)
2670: 0a 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 . (hash-tab
2680: 6c 65 2d 64 65 6c 65 74 65 21 20 61 72 67 73 3a le-delete! args:
2690: 61 72 67 2d 68 61 73 68 20 22 2d 69 74 65 6d 70 arg-hash "-itemp
26a0: 61 74 74 22 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d att")))..;;=====
26b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26f0: 3d 0a 3b 3b 20 4d 69 73 63 20 67 65 6e 65 72 61 =.;; Misc genera
2700: 6c 20 63 61 6c 6c 73 0a 3b 3b 3d 3d 3d 3d 3d 3d l calls.;;======
2710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2750: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
2760: 61 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 29 arg "-env2file")
2770: 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
2780: 20 20 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d (save-environm
2790: 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 28 61 72 ent-as-files (ar
27a0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 gs:get-arg "-env
27b0: 32 66 69 6c 65 22 29 29 0a 20 20 20 20 20 20 28 2file")). (
27c0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
27d0: 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 ng* #t)))..(if (
27e0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
27f0: 69 73 74 2d 64 69 73 6b 73 22 29 0a 20 20 20 20 ist-disks").
2800: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 (begin. (pr
2810: 69 6e 74 20 0a 20 20 20 20 20 20 20 28 73 74 72 int . (str
2820: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
2830: 0a 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 ..(map (lambda (
2840: 78 29 0a 09 20 20 20 20 20 20 20 28 73 74 72 69 x).. (stri
2850: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a ng-intersperse .
2860: 09 09 78 0a 09 09 22 20 3d 3e 20 22 29 29 0a 09 ..x..." => "))..
2870: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 (common:get
2880: 2d 64 69 73 6b 73 29 20 29 0a 09 22 5c 6e 22 29 -disks) ).."\n")
2890: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
28a0: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
28b0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
28c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
28d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
28e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
28f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
2900: 53 74 61 72 74 20 74 68 65 20 73 65 72 76 65 72 Start the server
2910: 20 2d 20 63 61 6e 20 62 65 20 64 6f 6e 65 20 69 - can be done i
2920: 6e 20 63 6f 6e 6a 75 6e 63 74 69 6f 6e 20 77 69 n conjunction wi
2930: 74 68 20 2d 72 75 6e 61 6c 6c 20 6f 72 20 2d 72 th -runall or -r
2940: 75 6e 74 65 73 74 73 20 28 6f 6e 65 20 64 61 79 untests (one day
2950: 2e 2e 2e 29 0a 3b 3b 20 20 20 77 65 20 73 74 61 ...).;; we sta
2960: 72 74 20 74 68 65 20 73 65 72 76 65 72 20 69 66 rt the server if
2970: 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 65 6c 73 not running els
2980: 65 20 73 74 61 72 74 20 74 68 65 20 63 6c 69 65 e start the clie
2990: 6e 74 20 74 68 72 65 61 64 0a 3b 3b 3d 3d 3d 3d nt thread.;;====
29a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29e0: 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ==..(if (args:ge
29f0: 74 2d 61 72 67 20 22 2d 73 65 72 76 65 72 22 29 t-arg "-server")
2a00: 0a 20 20 20 20 28 6c 65 74 20 28 28 74 72 61 6e . (let ((tran
2a10: 73 70 6f 72 74 20 28 61 72 67 73 3a 67 65 74 2d sport (args:get-
2a20: 61 72 67 20 22 2d 74 72 61 6e 73 70 6f 72 74 22 arg "-transport"
2a30: 20 22 68 74 74 70 22 29 29 29 0a 20 20 20 20 20 "http"))).
2a40: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
2a50: 22 4c 61 75 6e 63 68 69 6e 67 20 73 65 72 76 65 "Launching serve
2a60: 72 20 75 73 69 6e 67 20 74 72 61 6e 73 70 6f 72 r using transpor
2a70: 74 20 22 20 74 72 61 6e 73 70 6f 72 74 29 0a 20 t " transport).
2a80: 20 20 20 20 20 28 73 65 72 76 65 72 3a 6c 61 75 (server:lau
2a90: 6e 63 68 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d nch (string->sym
2aa0: 62 6f 6c 20 74 72 61 6e 73 70 6f 72 74 29 29 29 bol transport)))
2ab0: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e . (if (not (n
2ac0: 75 6c 6c 3f 20 28 6c 73 65 74 2d 69 6e 74 65 72 ull? (lset-inter
2ad0: 73 65 63 74 69 6f 6e 20 0a 09 09 20 20 20 20 20 section ...
2ae0: 65 71 75 61 6c 3f 0a 09 09 20 20 20 20 20 28 68 equal?... (h
2af0: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 61 ash-table-keys a
2b00: 72 67 73 3a 61 72 67 2d 68 61 73 68 29 0a 09 09 rgs:arg-hash)...
2b10: 20 20 20 20 20 27 28 22 2d 72 75 6e 74 65 73 74 '("-runtest
2b20: 73 22 20 20 20 20 22 2d 6c 69 73 74 2d 72 75 6e s" "-list-run
2b30: 73 22 20 20 20 22 2d 72 6f 6c 6c 75 70 22 0a 09 s" "-rollup"..
2b40: 09 20 20 20 20 20 20 20 22 2d 72 65 6d 6f 76 65 . "-remove
2b50: 2d 72 75 6e 73 22 20 22 2d 6c 6f 63 6b 22 20 20 -runs" "-lock"
2b60: 20 20 20 20 20 20 22 2d 75 6e 6c 6f 63 6b 22 0a "-unlock".
2b70: 09 09 20 20 20 20 20 20 20 22 2d 75 70 64 61 74 .. "-updat
2b80: 65 2d 6d 65 74 61 22 20 22 2d 65 78 74 72 61 63 e-meta" "-extrac
2b90: 74 2d 6f 64 73 22 29 29 29 29 0a 09 28 69 66 20 t-ods"))))..(if
2ba0: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 0a (setup-for-run).
2bb0: 09 20 20 20 20 28 6c 65 74 20 28 28 73 65 72 76 . (let ((serv
2bc0: 65 72 73 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c ers (open-run-cl
2bd0: 6f 73 65 20 74 61 73 6b 73 3a 67 65 74 2d 62 65 ose tasks:get-be
2be0: 73 74 2d 73 65 72 76 65 72 20 74 61 73 6b 73 3a st-server tasks:
2bf0: 6f 70 65 6e 2d 64 62 29 29 29 0a 09 20 20 20 20 open-db)))..
2c00: 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 (if (or (not s
2c10: 65 72 76 65 72 73 29 0a 09 09 20 20 20 20 20 20 ervers)...
2c20: 28 6e 75 6c 6c 3f 20 73 65 72 76 65 72 73 29 29 (null? servers))
2c30: 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 20 ... (begin...
2c40: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
2c50: 20 22 49 4e 46 4f 3a 20 53 74 61 72 74 69 6e 67 "INFO: Starting
2c60: 20 73 65 72 76 65 72 20 61 73 20 6e 6f 6e 65 20 server as none
2c70: 72 75 6e 6e 69 6e 67 20 2e 2e 2e 22 29 0a 09 09 running ...")...
2c80: 20 20 20 20 3b 3b 20 28 73 65 72 76 65 72 3a 6c ;; (server:l
2c90: 61 75 6e 63 68 20 28 73 74 72 69 6e 67 2d 3e 73 aunch (string->s
2ca0: 79 6d 62 6f 6c 20 28 61 72 67 73 3a 67 65 74 2d ymbol (args:get-
2cb0: 61 72 67 20 22 2d 74 72 61 6e 73 70 6f 72 74 22 arg "-transport"
2cc0: 20 22 68 74 74 70 22 29 29 29 29 0a 09 09 20 20 "http"))))...
2cd0: 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 (system (conc
2ce0: 28 63 61 72 20 28 61 72 67 76 29 29 20 22 20 2d (car (argv)) " -
2cf0: 73 65 72 76 65 72 20 2d 20 2d 64 61 65 6d 6f 6e server - -daemon
2d00: 69 7a 65 20 2d 74 72 61 6e 73 70 6f 72 74 20 22 ize -transport "
2d10: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
2d20: 2d 74 72 61 6e 73 70 6f 72 74 22 20 22 68 74 74 -transport" "htt
2d30: 70 22 29 29 29 0a 09 09 20 20 20 20 28 74 68 72 p")))... (thr
2d40: 65 61 64 2d 73 6c 65 65 70 21 20 33 29 29 20 3b ead-sleep! 3)) ;
2d50: 3b 20 67 69 76 65 20 74 68 65 20 73 65 72 76 65 ; give the serve
2d60: 72 20 61 20 66 65 77 20 73 65 63 6f 6e 64 73 20 r a few seconds
2d70: 74 6f 20 73 74 61 72 74 0a 09 09 20 20 28 64 65 to start... (de
2d80: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 49 4e 46 bug:print 0 "INF
2d90: 4f 3a 20 53 65 72 76 65 72 73 20 61 6c 72 65 61 O: Servers alrea
2da0: 64 79 20 72 75 6e 6e 69 6e 67 20 22 20 73 65 72 dy running " ser
2db0: 76 65 72 73 29 0a 09 09 20 20 29 29 29 29 29 0a vers)... ))))).
2dc0: 09 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 ...(if (or (args
2dd0: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d :get-arg "-list-
2de0: 73 65 72 76 65 72 73 22 29 0a 09 28 61 72 67 73 servers")..(args
2df0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 6f 70 2d :get-arg "-stop-
2e00: 73 65 72 76 65 72 22 29 29 0a 20 20 20 20 28 6c server")). (l
2e10: 65 74 20 28 28 74 6c 20 28 73 65 74 75 70 2d 66 et ((tl (setup-f
2e20: 6f 72 2d 72 75 6e 29 29 29 0a 20 20 20 20 20 20 or-run))).
2e30: 28 69 66 20 74 6c 20 0a 09 20 20 28 6c 65 74 2a (if tl .. (let*
2e40: 20 28 28 73 65 72 76 65 72 73 20 28 6f 70 65 6e ((servers (open
2e50: 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 -run-close tasks
2e60: 3a 67 65 74 2d 61 6c 6c 2d 73 65 72 76 65 72 73 :get-all-servers
2e70: 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 29 tasks:open-db))
2e80: 0a 09 09 20 28 66 6d 74 73 74 72 20 20 22 7e 35 ... (fmtstr "~5
2e90: 61 7e 38 61 7e 38 61 7e 32 30 61 7e 32 30 61 7e a~8a~8a~20a~20a~
2ea0: 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 7e 10a~10a~10a~10a~
2eb0: 31 30 61 5c 6e 22 29 0a 09 09 20 28 73 65 72 76 10a\n")... (serv
2ec0: 65 72 73 2d 74 6f 2d 6b 69 6c 6c 20 27 28 29 29 ers-to-kill '())
2ed0: 0a 09 09 20 28 6b 69 6c 6c 69 6e 66 6f 20 20 20 ... (killinfo
2ee0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
2ef0: 73 74 6f 70 2d 73 65 72 76 65 72 22 29 29 0a 09 stop-server"))..
2f00: 09 20 28 6b 68 6f 73 74 2d 70 6f 72 74 20 28 69 . (khost-port (i
2f10: 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 69 66 20 28 f killinfo (if (
2f20: 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 substring-index
2f30: 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f 29 28 73 74 ":" killinfo)(st
2f40: 72 69 6e 67 2d 73 70 6c 69 74 20 22 3a 22 29 20 ring-split ":")
2f50: 23 66 29 20 23 66 29 29 0a 09 09 20 28 73 69 64 #f) #f))... (sid
2f60: 20 20 20 20 20 20 20 20 28 69 66 20 6b 69 6c 6c (if kill
2f70: 69 6e 66 6f 20 28 69 66 20 28 73 75 62 73 74 72 info (if (substr
2f80: 69 6e 67 2d 69 6e 64 65 78 20 22 3a 22 20 6b 69 ing-index ":" ki
2f90: 6c 6c 69 6e 66 6f 29 20 23 66 20 28 73 74 72 69 llinfo) #f (stri
2fa0: 6e 67 2d 3e 6e 75 6d 62 65 72 20 6b 69 6c 6c 69 ng->number killi
2fb0: 6e 66 6f 29 29 20 23 66 29 29 29 0a 09 20 20 20 nfo)) #f)))..
2fc0: 20 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 (format #t fmts
2fd0: 74 72 20 22 49 64 22 20 22 4d 54 76 65 72 22 20 tr "Id" "MTver"
2fe0: 22 50 69 64 22 20 22 48 6f 73 74 22 20 22 49 6e "Pid" "Host" "In
2ff0: 74 65 72 66 61 63 65 22 20 22 4f 75 74 50 6f 72 terface" "OutPor
3000: 74 22 20 22 49 6e 50 6f 72 74 22 20 22 4c 61 73 t" "InPort" "Las
3010: 74 42 65 61 74 22 20 22 53 74 61 74 65 22 20 22 tBeat" "State" "
3020: 54 72 61 6e 73 70 6f 72 74 22 29 0a 09 20 20 20 Transport")..
3030: 20 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 (format #t fmts
3040: 74 72 20 22 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 tr "==" "====="
3050: 22 3d 3d 3d 22 20 22 3d 3d 3d 3d 22 20 22 3d 3d "===" "====" "==
3060: 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d =======" "======
3070: 3d 22 20 22 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d =" "======" "===
3080: 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 =====" "=====" "
3090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 29 0a 09 20 20 20 =========")..
30a0: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 (for-each ..
30b0: 20 20 28 6c 61 6d 62 64 61 20 28 73 65 72 76 65 (lambda (serve
30c0: 72 29 0a 09 20 20 20 20 20 20 20 28 6c 65 74 2a r).. (let*
30d0: 20 28 28 69 64 20 20 20 20 20 20 20 20 20 28 76 ((id (v
30e0: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
30f0: 20 30 29 29 0a 09 09 20 20 20 20 20 20 28 70 69 0))... (pi
3100: 64 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 d (vector
3110: 2d 72 65 66 20 73 65 72 76 65 72 20 31 29 29 0a -ref server 1)).
3120: 09 09 20 20 20 20 20 20 28 68 6f 73 74 6e 61 6d .. (hostnam
3130: 65 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 e (vector-ref
3140: 73 65 72 76 65 72 20 32 29 29 0a 09 09 20 20 20 server 2))...
3150: 20 20 20 28 69 6e 74 65 72 66 61 63 65 20 20 28 (interface (
3160: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
3170: 72 20 33 29 29 0a 09 09 20 20 20 20 20 20 28 70 r 3))... (p
3180: 75 6c 6c 70 6f 72 74 20 20 20 28 76 65 63 74 6f ullport (vecto
3190: 72 2d 72 65 66 20 73 65 72 76 65 72 20 34 29 29 r-ref server 4))
31a0: 0a 09 09 20 20 20 20 20 20 28 70 75 62 70 6f 72 ... (pubpor
31b0: 74 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 t (vector-ref
31c0: 20 73 65 72 76 65 72 20 35 29 29 0a 09 09 20 20 server 5))...
31d0: 20 20 20 20 28 73 74 61 72 74 2d 74 69 6d 65 20 (start-time
31e0: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 (vector-ref serv
31f0: 65 72 20 36 29 29 0a 09 09 20 20 20 20 20 20 28 er 6))... (
3200: 70 72 69 6f 72 69 74 79 20 20 20 28 76 65 63 74 priority (vect
3210: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 37 29 or-ref server 7)
3220: 29 0a 09 09 20 20 20 20 20 20 28 73 74 61 74 65 )... (state
3230: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re
3240: 66 20 73 65 72 76 65 72 20 38 29 29 0a 09 09 20 f server 8))...
3250: 20 20 20 20 20 28 6d 74 2d 76 65 72 20 20 20 20 (mt-ver
3260: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
3270: 76 65 72 20 39 29 29 0a 09 09 20 20 20 20 20 20 ver 9))...
3280: 28 6c 61 73 74 2d 75 70 64 61 74 65 20 28 76 65 (last-update (ve
3290: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
32a0: 31 30 29 29 20 3b 3b 20 20 20 28 6f 70 65 6e 2d 10)) ;; (open-
32b0: 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a run-close tasks:
32c0: 73 65 72 76 65 72 2d 61 6c 69 76 65 3f 20 74 61 server-alive? ta
32d0: 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 23 66 20 68 sks:open-db #f h
32e0: 6f 73 74 6e 61 6d 65 3a 20 68 6f 73 74 6e 61 6d ostname: hostnam
32f0: 65 20 70 6f 72 74 3a 20 70 6f 72 74 29 29 0a 09 e port: port))..
3300: 09 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 . (transpor
3310: 74 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 t (vector-ref s
3320: 65 72 76 65 72 20 31 31 29 29 0a 09 09 20 20 20 erver 11))...
3330: 20 20 20 28 6b 69 6c 6c 65 64 20 20 20 20 20 23 (killed #
3340: 66 29 0a 09 09 20 20 20 20 20 20 28 73 74 61 74 f)... (stat
3350: 75 73 20 20 20 20 20 28 3c 20 6c 61 73 74 2d 75 us (< last-u
3360: 70 64 61 74 65 20 32 30 29 29 29 0a 09 09 20 3b pdate 20)))... ;
3370: 3b 20 20 20 28 7a 6d 71 2d 73 6f 63 6b 65 74 73 ; (zmq-sockets
3380: 20 28 69 66 20 73 74 61 74 75 73 20 28 73 65 72 (if status (ser
3390: 76 65 72 3a 63 6c 69 65 6e 74 2d 63 6f 6e 6e 65 ver:client-conne
33a0: 63 74 20 68 6f 73 74 6e 61 6d 65 20 70 6f 72 74 ct hostname port
33b0: 29 20 23 66 29 29 29 0a 09 09 20 3b 3b 20 6e 6f ) #f)))... ;; no
33c0: 20 6e 65 65 64 20 74 6f 20 6c 6f 67 69 6e 20 61 need to login a
33d0: 73 20 73 74 61 74 75 73 20 6f 66 20 23 74 20 69 s status of #t i
33e0: 6e 64 69 63 61 74 65 73 20 77 65 20 61 72 65 20 ndicates we are
33f0: 63 6f 6e 6e 65 63 74 69 6e 67 20 74 6f 20 63 6f connecting to co
3400: 72 72 65 63 74 20 0a 09 09 20 3b 3b 20 73 65 72 rrect ... ;; ser
3410: 76 65 72 0a 09 09 20 28 69 66 20 28 65 71 75 61 ver... (if (equa
3420: 6c 3f 20 73 74 61 74 65 20 22 64 65 61 64 22 29 l? state "dead")
3430: 0a 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 6c ... (if (> l
3440: 61 73 74 2d 75 70 64 61 74 65 20 28 2a 20 32 35 ast-update (* 25
3450: 20 36 30 20 36 30 29 29 20 3b 3b 20 6b 65 65 70 60 60)) ;; keep
3460: 20 72 65 63 6f 72 64 73 20 61 72 6f 75 6e 64 20 records around
3470: 66 6f 72 20 73 6c 69 67 68 6c 79 20 6f 76 65 72 for slighly over
3480: 20 61 20 64 61 79 2e 0a 09 09 09 20 28 6f 70 65 a day..... (ope
3490: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b n-run-close task
34a0: 73 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 s:server-deregis
34b0: 74 65 72 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 ter tasks:open-d
34c0: 62 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 b hostname pullp
34d0: 6f 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 70 69 ort: pullport pi
34e0: 64 3a 20 70 69 64 20 61 63 74 69 6f 6e 3a 20 27 d: pid action: '
34f0: 64 65 6c 65 74 65 29 29 0a 09 09 20 20 20 20 20 delete))...
3500: 28 69 66 20 28 3e 20 6c 61 73 74 2d 75 70 64 61 (if (> last-upda
3510: 74 65 20 32 30 29 20 20 20 20 20 20 20 20 3b 3b te 20) ;;
3520: 20 4d 61 72 6b 20 61 73 20 64 65 61 64 20 69 66 Mark as dead if
3530: 20 6e 6f 74 20 75 70 64 61 74 65 64 20 69 6e 20 not updated in
3540: 6c 61 73 74 20 32 30 20 73 65 63 6f 6e 64 73 0a last 20 seconds.
3550: 09 09 09 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c ... (open-run-cl
3560: 6f 73 65 20 74 61 73 6b 73 3a 73 65 72 76 65 72 ose tasks:server
3570: 2d 64 65 72 65 67 69 73 74 65 72 20 74 61 73 6b -deregister task
3580: 73 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 74 6e 61 s:open-db hostna
3590: 6d 65 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 6c me pullport: pul
35a0: 6c 70 6f 72 74 20 70 69 64 3a 20 70 69 64 29 29 lport pid: pid))
35b0: 29 0a 09 09 20 28 66 6f 72 6d 61 74 20 23 74 20 )... (format #t
35c0: 66 6d 74 73 74 72 20 69 64 20 6d 74 2d 76 65 72 fmtstr id mt-ver
35d0: 20 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 69 6e pid hostname in
35e0: 74 65 72 66 61 63 65 20 70 75 6c 6c 70 6f 72 74 terface pullport
35f0: 20 70 75 62 70 6f 72 74 20 6c 61 73 74 2d 75 70 pubport last-up
3600: 64 61 74 65 0a 09 09 09 20 28 69 66 20 73 74 61 date.... (if sta
3610: 74 75 73 20 22 61 6c 69 76 65 22 20 22 64 65 61 tus "alive" "dea
3620: 64 22 29 20 74 72 61 6e 73 70 6f 72 74 29 0a 09 d") transport)..
3630: 09 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 64 . (if (equal? id
3640: 20 73 69 64 29 0a 09 09 20 20 20 20 20 28 62 65 sid)... (be
3650: 67 69 6e 0a 09 09 20 20 20 20 20 20 20 28 64 65 gin... (de
3660: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
3670: 20 22 41 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 "Attempting to
3680: 73 74 6f 70 20 73 65 72 76 65 72 20 77 69 74 68 stop server with
3690: 20 70 69 64 20 22 20 70 69 64 29 0a 09 09 20 20 pid " pid)...
36a0: 20 20 20 20 20 28 74 61 73 6b 73 3a 6b 69 6c 6c (tasks:kill
36b0: 2d 73 65 72 76 65 72 20 73 74 61 74 75 73 20 68 -server status h
36c0: 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 74 ostname pullport
36d0: 20 70 69 64 20 74 72 61 6e 73 70 6f 72 74 29 29 pid transport))
36e0: 29 29 29 0a 09 20 20 20 20 20 73 65 72 76 65 72 ))).. server
36f0: 73 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 s).. (debug:p
3700: 72 69 6e 74 2d 69 6e 66 6f 20 31 20 22 44 6f 6e rint-info 1 "Don
3710: 65 20 77 69 74 68 20 6c 69 73 74 73 65 72 76 65 e with listserve
3720: 72 73 22 29 0a 09 20 20 20 20 28 73 65 74 21 20 rs").. (set!
3730: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
3740: 74 29 0a 09 20 20 20 20 28 65 78 69 74 29 20 3b t).. (exit) ;
3750: 3b 20 6d 75 73 74 20 64 6f 2c 20 77 6f 75 6c 64 ; must do, would
3760: 20 68 61 76 65 20 74 6f 20 61 64 64 20 63 68 65 have to add che
3770: 63 6b 73 20 74 6f 20 6d 61 6e 79 2f 61 6c 6c 20 cks to many/all
3780: 63 61 6c 6c 73 20 62 65 6c 6f 77 0a 09 20 20 20 calls below..
3790: 20 29 0a 09 20 20 28 65 78 69 74 29 29 29 0a 20 ).. (exit))).
37a0: 20 20 20 3b 3b 20 69 66 20 6e 6f 74 20 6c 69 73 ;; if not lis
37b0: 74 20 6f 72 20 6b 69 6c 6c 20 74 68 65 6e 20 73 t or kill then s
37c0: 74 61 72 74 20 61 20 63 6c 69 65 6e 74 20 28 69 tart a client (i
37d0: 66 20 61 70 70 72 6f 70 72 69 61 74 65 29 0a 20 f appropriate).
37e0: 20 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 (if (or (args
37f0: 2d 64 65 66 69 6e 65 64 3f 20 22 2d 68 22 20 22 -defined? "-h" "
3800: 2d 76 65 72 73 69 6f 6e 22 20 22 2d 67 65 6e 2d -version" "-gen-
3810: 6d 65 67 61 74 65 73 74 2d 61 72 65 61 22 20 22 megatest-area" "
3820: 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 -gen-megatest-te
3830: 73 74 22 29 0a 09 20 20 20 20 28 65 71 3f 20 28 st").. (eq? (
3840: 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 length (hash-tab
3850: 6c 65 2d 6b 65 79 73 20 61 72 67 73 3a 61 72 67 le-keys args:arg
3860: 2d 68 61 73 68 29 29 20 30 29 29 0a 09 28 64 65 -hash)) 0))..(de
3870: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 bug:print-info 1
3880: 20 22 53 65 72 76 65 72 20 63 6f 6e 6e 65 63 74 "Server connect
3890: 69 6f 6e 20 6e 6f 74 20 6e 65 65 64 65 64 22 29 ion not needed")
38a0: 0a 09 3b 3b 20 6f 6b 2c 20 73 6f 20 6c 65 74 73 ..;; ok, so lets
38b0: 20 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 65 20 connect to the
38c0: 73 65 72 76 65 72 0a 09 28 63 6c 69 65 6e 74 3a server..(client:
38d0: 6c 61 75 6e 63 68 29 29 29 0a 0a 3b 3b 3d 3d 3d launch)))..;;===
38e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
38f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3920: 3d 3d 3d 0a 3b 3b 20 57 65 69 72 64 20 73 70 65 ===.;; Weird spe
3930: 63 69 61 6c 20 63 61 6c 6c 73 20 74 68 61 74 20 cial calls that
3940: 6e 65 65 64 20 74 6f 20 72 75 6e 20 2a 61 66 74 need to run *aft
3950: 65 72 2a 20 74 68 65 20 73 65 72 76 65 72 20 68 er* the server h
3960: 61 73 20 73 74 61 72 74 65 64 3f 0a 3b 3b 3d 3d as started?.;;==
3970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
39a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
39b0: 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
39c0: 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 74 get-arg "-list-t
39d0: 61 72 67 65 74 73 22 29 0a 20 20 20 20 28 6c 65 argets"). (le
39e0: 74 20 28 28 74 61 72 67 65 74 73 20 28 63 6f 6d t ((targets (com
39f0: 6d 6f 6e 3a 67 65 74 2d 72 75 6e 63 6f 6e 66 69 mon:get-runconfi
3a00: 67 2d 74 61 72 67 65 74 73 29 29 29 0a 20 20 20 g-targets))).
3a10: 20 20 20 28 70 72 69 6e 74 20 22 46 6f 75 6e 64 (print "Found
3a20: 20 22 28 6c 65 6e 67 74 68 20 74 61 72 67 65 74 "(length target
3a30: 73 29 20 22 20 74 61 72 67 65 74 73 22 29 0a 20 s) " targets").
3a40: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 (for-each (
3a50: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 20 20 3b lambda (x)... ;
3a60: 3b 20 28 70 72 69 6e 74 20 22 5b 22 20 78 20 22 ; (print "[" x "
3a70: 5d 22 29 29 0a 09 09 20 20 28 70 72 69 6e 74 20 ]"))... (print
3a80: 78 29 29 0a 09 09 74 61 72 67 65 74 73 29 0a 20 x))...targets).
3a90: 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
3aa0: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
3ab0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
3ac0: 72 67 20 22 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e rg "-show-runcon
3ad0: 66 69 67 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 fig"). (let*
3ae0: 28 28 74 61 72 67 65 74 20 28 69 66 20 28 61 72 ((target (if (ar
3af0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 71 gs:get-arg "-req
3b00: 74 61 72 67 22 29 0a 09 09 20 20 20 20 20 20 20 targ")...
3b10: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3b20: 72 65 71 74 61 72 67 22 29 0a 09 09 20 20 20 20 reqtarg")...
3b30: 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 (if (args:get
3b40: 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 0a -arg "-target").
3b50: 09 09 09 20 20 20 28 61 72 67 73 3a 67 65 74 2d ... (args:get-
3b60: 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 0a 09 arg "-target")..
3b70: 09 09 20 20 20 23 66 29 29 29 0a 09 20 20 20 28 .. #f))).. (
3b80: 73 65 63 74 69 6f 6e 73 20 28 69 66 20 74 61 72 sections (if tar
3b90: 67 65 74 20 28 6c 69 73 74 20 22 64 65 66 61 75 get (list "defau
3ba0: 6c 74 22 20 74 61 72 67 65 74 29 20 23 66 29 29 lt" target) #f))
3bb0: 0a 09 20 20 20 28 64 61 74 61 20 20 20 20 20 28 .. (data (
3bc0: 72 65 61 64 2d 63 6f 6e 66 69 67 20 22 72 75 6e read-config "run
3bd0: 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 20 configs.config"
3be0: 23 66 20 23 74 20 73 65 63 74 69 6f 6e 73 3a 20 #f #t sections:
3bf0: 73 65 63 74 69 6f 6e 73 29 29 29 0a 0a 20 20 20 sections)))..
3c00: 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 ;; keep this
3c10: 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 20 one local.
3c20: 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 28 6e (cond. ((n
3c30: 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
3c40: 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 29 0a 09 "-dumpmode"))..
3c50: 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (pp (hash-table-
3c60: 3e 61 6c 69 73 74 20 64 61 74 61 29 29 29 0a 20 >alist data))).
3c70: 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 3d 3f ((string=?
3c80: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3c90: 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f -dumpmode") "jso
3ca0: 6e 22 29 0a 09 28 6a 73 6f 6e 2d 77 72 69 74 65 n")..(json-write
3cb0: 20 64 61 74 61 29 29 0a 20 20 20 20 20 20 20 28 data)). (
3cc0: 65 6c 73 65 0a 09 28 64 65 62 75 67 3a 70 72 69 else..(debug:pri
3cd0: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 2d 64 75 nt 0 "ERROR: -du
3ce0: 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 61 72 67 mpmode of " (arg
3cf0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
3d00: 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 72 65 63 mode") " not rec
3d10: 6f 67 6e 69 73 65 64 22 29 29 29 0a 20 20 20 20 ognised"))).
3d20: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
3d30: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
3d40: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
3d50: 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 22 29 0a "-show-config").
3d60: 20 20 20 20 28 6c 65 74 20 28 28 64 61 74 61 20 (let ((data
3d70: 2a 63 6f 6e 66 69 67 64 61 74 2a 29 29 20 3b 3b *configdat*)) ;;
3d80: 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 22 6d (read-config "m
3d90: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 20 egatest.config"
3da0: 23 66 20 23 74 29 29 29 0a 20 20 20 20 20 20 3b #f #t))). ;
3db0: 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 ; keep this one
3dc0: 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 63 6f 6e local. (con
3dd0: 64 20 0a 20 20 20 20 20 20 20 28 28 6e 6f 74 20 d . ((not
3de0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3df0: 64 75 6d 70 6d 6f 64 65 22 29 29 0a 09 28 70 70 dumpmode"))..(pp
3e00: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c (hash-table->al
3e10: 69 73 74 20 64 61 74 61 29 29 29 0a 20 20 20 20 ist data))).
3e20: 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 ((string=? (a
3e30: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
3e40: 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 29 mpmode") "json")
3e50: 0a 09 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 ..(json-write da
3e60: 74 61 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 ta)). (els
3e70: 65 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 e..(debug:print
3e80: 30 20 22 45 52 52 4f 52 3a 20 2d 64 75 6d 70 6d 0 "ERROR: -dumpm
3e90: 6f 64 65 20 6f 66 20 22 20 28 61 72 67 73 3a 67 ode of " (args:g
3ea0: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
3eb0: 65 22 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 6e e") " not recogn
3ec0: 69 73 65 64 22 29 29 29 0a 20 20 20 20 20 20 28 ised"))). (
3ed0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
3ee0: 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d ng* #t)))..;;===
3ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f30: 3d 3d 3d 0a 3b 3b 20 52 65 6d 6f 76 65 20 6f 6c ===.;; Remove ol
3f40: 64 20 72 75 6e 28 73 29 0a 3b 3b 3d 3d 3d 3d 3d d run(s).;;=====
3f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f90: 3d 0a 0a 3b 3b 20 73 69 6e 63 65 20 73 65 76 65 =..;; since seve
3fa0: 72 61 6c 20 61 63 74 69 6f 6e 73 20 63 61 6e 20 ral actions can
3fb0: 62 65 20 73 70 65 63 69 66 69 65 64 20 6f 6e 20 be specified on
3fc0: 74 68 65 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 the command line
3fd0: 20 74 68 65 20 72 65 6d 6f 76 61 6c 0a 3b 3b 20 the removal.;;
3fe0: 69 73 20 64 6f 6e 65 20 66 69 72 73 74 0a 28 64 is done first.(d
3ff0: 65 66 69 6e 65 20 28 6f 70 65 72 61 74 65 2d 6f efine (operate-o
4000: 6e 20 61 63 74 69 6f 6e 29 0a 20 20 28 63 6f 6e n action). (con
4010: 64 0a 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 d. ((not (args
4020: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
4030: 6d 65 22 29 29 0a 20 20 20 20 28 64 65 62 75 67 me")). (debug
4040: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
4050: 20 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 Missing require
4060: 64 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 d parameter for
4070: 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 " action ", you
4080: 6d 75 73 74 20 73 70 65 63 69 66 79 20 74 68 65 must specify the
4090: 20 72 75 6e 20 6e 61 6d 65 20 70 61 74 74 65 72 run name patter
40a0: 6e 20 77 69 74 68 20 3a 72 75 6e 6e 61 6d 65 20 n with :runname
40b0: 70 61 74 74 22 29 0a 20 20 20 20 28 65 78 69 74 patt"). (exit
40c0: 20 32 29 29 0a 20 20 20 28 28 6e 6f 74 20 28 61 2)). ((not (a
40d0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
40e0: 73 74 70 61 74 74 22 29 29 0a 20 20 20 20 28 64 stpatt")). (d
40f0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
4100: 52 4f 52 3a 20 4d 69 73 73 69 6e 67 20 72 65 71 ROR: Missing req
4110: 75 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 uired parameter
4120: 66 6f 72 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 for " action ",
4130: 79 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 you must specify
4140: 20 74 68 65 20 74 65 73 74 20 70 61 74 74 65 72 the test patter
4150: 6e 20 77 69 74 68 20 2d 74 65 73 74 70 61 74 74 n with -testpatt
4160: 22 29 0a 20 20 20 20 28 65 78 69 74 20 33 29 29 "). (exit 3))
4170: 0a 20 20 20 28 65 6c 73 65 0a 20 20 20 20 28 69 . (else. (i
4180: 66 20 28 6e 6f 74 20 28 63 61 72 20 2a 63 6f 6e f (not (car *con
4190: 66 69 67 69 6e 66 6f 2a 29 29 0a 09 28 62 65 67 figinfo*))..(beg
41a0: 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 in.. (debug:pri
41b0: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 41 74 74 nt 0 "ERROR: Att
41c0: 65 6d 70 74 65 64 20 22 20 61 63 74 69 6f 6e 20 empted " action
41d0: 22 6f 6e 20 74 65 73 74 28 73 29 20 62 75 74 20 "on test(s) but
41e0: 72 75 6e 20 61 72 65 61 20 63 6f 6e 66 69 67 20 run area config
41f0: 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 22 29 file not found")
4200: 0a 09 20 20 28 65 78 69 74 20 31 29 29 0a 09 3b .. (exit 1))..;
4210: 3b 20 70 75 74 20 74 65 73 74 20 70 61 72 61 6d ; put test param
4220: 65 74 65 72 73 20 69 6e 74 6f 20 63 6f 6e 76 65 eters into conve
4230: 6e 69 65 6e 74 20 76 61 72 69 61 62 6c 65 73 0a nient variables.
4240: 09 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f .(runs:operate-o
4250: 6e 20 20 61 63 74 69 6f 6e 0a 09 09 09 20 20 28 n action.... (
4260: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 args:get-arg ":r
4270: 75 6e 6e 61 6d 65 22 29 0a 09 09 09 20 20 28 61 unname").... (a
4280: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
4290: 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 73 74 stpatt").... st
42a0: 61 74 65 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 ate: (args:get-a
42b0: 72 67 20 22 3a 73 74 61 74 65 22 29 20 0a 09 09 rg ":state") ...
42c0: 09 20 20 73 74 61 74 75 73 3a 20 28 61 72 67 73 . status: (args
42d0: 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 :get-arg ":statu
42e0: 73 22 29 0a 09 09 09 20 20 6e 65 77 2d 73 74 61 s").... new-sta
42f0: 74 65 2d 73 74 61 74 75 73 3a 20 28 61 72 67 73 te-status: (args
4300: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 :get-arg "-set-s
4310: 74 61 74 65 2d 73 74 61 74 75 73 22 29 29 29 0a tate-status"))).
4320: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
4330: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a mething* #t)))).
4340: 09 20 20 0a 28 69 66 20 28 61 72 67 73 3a 67 65 . .(if (args:ge
4350: 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d 72 t-arg "-remove-r
4360: 75 6e 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 uns"). (gener
4370: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 al-run-call .
4380: 20 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 "-remove-runs"
4390: 0a 20 20 20 20 20 22 72 65 6d 6f 76 65 20 72 75 . "remove ru
43a0: 6e 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ns". (lambda
43b0: 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 (target runname
43c0: 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b keys keynames k
43d0: 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 20 20 eyvallst).
43e0: 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 72 65 (operate-on 're
43f0: 6d 6f 76 65 2d 72 75 6e 73 29 29 29 29 0a 0a 28 move-runs))))..(
4400: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
4410: 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 "-set-state-sta
4420: 74 75 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 tus"). (gener
4430: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 al-run-call .
4440: 20 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 "-set-state-st
4450: 61 74 75 73 22 0a 20 20 20 20 20 22 73 65 74 20 atus". "set
4460: 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 73 state and status
4470: 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ". (lambda (
4480: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
4490: 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 eys keynames key
44a0: 76 61 6c 6c 73 74 29 0a 20 20 20 20 20 20 20 28 vallst). (
44b0: 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d operate-on 'set-
44c0: 73 74 61 74 65 2d 73 74 61 74 75 73 29 29 29 29 state-status))))
44d0: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
44e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 75 ==========.;; Qu
4520: 65 72 79 20 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d 3d ery runs.;;=====
4530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4570: 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 =..(if (or (args
4580: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d :get-arg "-list-
4590: 72 75 6e 73 22 29 0a 09 28 61 72 67 73 3a 67 65 runs")..(args:ge
45a0: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d t-arg "-list-db-
45b0: 74 61 72 67 65 74 73 22 29 29 0a 20 20 20 20 28 targets")). (
45c0: 69 66 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 if (setup-for-ru
45d0: 6e 29 0a 09 28 6c 65 74 2a 20 28 28 64 62 20 20 n)..(let* ((db
45e0: 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 #f)..
45f0: 20 28 72 75 6e 70 61 74 74 20 20 28 61 72 67 73 (runpatt (args
4600: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d :get-arg "-list-
4610: 72 75 6e 73 22 29 29 0a 09 20 20 20 20 20 20 20 runs"))..
4620: 28 74 65 73 74 70 61 74 74 20 28 69 66 20 28 61 (testpatt (if (a
4630: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
4640: 73 74 70 61 74 74 22 29 20 0a 09 09 09 20 20 20 stpatt") ....
4650: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
4660: 22 2d 74 65 73 74 70 61 74 74 22 29 20 0a 09 09 "-testpatt") ...
4670: 09 20 20 20 20 20 22 25 22 29 29 0a 09 20 20 20 . "%"))..
4680: 20 20 20 20 28 72 75 6e 73 64 61 74 20 20 28 63 (runsdat (c
4690: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 db:remote-run db
46a0: 3a 67 65 74 2d 72 75 6e 73 20 23 66 20 72 75 6e :get-runs #f run
46b0: 70 61 74 74 20 23 66 20 23 66 20 27 28 29 29 29 patt #f #f '()))
46c0: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 20 20 .. (runs
46d0: 20 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 (db:get-rows
46e0: 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 runsdat))..
46f0: 20 20 28 68 65 61 64 65 72 20 20 20 28 64 62 3a (header (db:
4700: 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 73 64 get-header runsd
4710: 61 74 29 29 0a 09 20 20 20 20 20 20 20 28 6b 65 at)).. (ke
4720: 79 73 20 20 20 20 20 28 63 64 62 3a 72 65 6d 6f ys (cdb:remo
4730: 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 te-run db:get-ke
4740: 79 73 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 ys #f))..
4750: 28 6b 65 79 6e 61 6d 65 73 20 28 6d 61 70 20 6b (keynames (map k
4760: 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 ey:get-fieldname
4770: 20 6b 65 79 73 29 29 0a 09 20 20 20 20 20 20 20 keys))..
4780: 28 64 62 2d 74 61 72 67 65 74 73 20 28 61 72 67 (db-targets (arg
4790: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
47a0: 2d 64 62 2d 74 61 72 67 65 74 73 22 29 29 0a 09 -db-targets"))..
47b0: 20 20 20 20 20 20 20 28 73 65 65 6e 20 20 20 20 (seen
47c0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
47d0: 65 29 29 29 0a 09 20 20 3b 3b 20 45 61 63 68 20 e))).. ;; Each
47e0: 72 75 6e 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 run.. (for-each
47f0: 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 72 .. (lambda (r
4800: 75 6e 29 0a 09 20 20 20 20 20 28 6c 65 74 20 28 un).. (let (
4810: 28 74 61 72 67 65 74 73 74 72 20 28 73 74 72 69 (targetstr (stri
4820: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
4830: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a map (lambda (x).
4840: 09 09 09 09 09 09 09 20 28 64 62 3a 67 65 74 2d ....... (db:get-
4850: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
4860: 72 75 6e 20 68 65 61 64 65 72 20 78 29 29 0a 09 run header x))..
4870: 09 09 09 09 09 20 20 20 20 20 20 20 6b 65 79 6e ..... keyn
4880: 61 6d 65 73 29 20 22 2f 22 29 29 29 0a 09 20 20 ames) "/")))..
4890: 20 20 20 20 20 28 69 66 20 64 62 2d 74 61 72 67 (if db-targ
48a0: 65 74 73 0a 09 09 20 20 20 28 69 66 20 28 6e 6f ets... (if (no
48b0: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
48c0: 66 2f 64 65 66 61 75 6c 74 20 73 65 65 6e 20 74 f/default seen t
48d0: 61 72 67 65 74 73 74 72 20 23 66 29 29 0a 09 09 argetstr #f))...
48e0: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 (begin...
48f0: 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 . (hash-table-se
4900: 74 21 20 73 65 65 6e 20 74 61 72 67 65 74 73 74 t! seen targetst
4910: 72 20 23 74 29 0a 09 09 09 20 3b 3b 20 28 70 72 r #t).... ;; (pr
4920: 69 6e 74 20 22 5b 22 20 74 61 72 67 65 74 73 74 int "[" targetst
4930: 72 20 22 5d 22 29 29 29 29 0a 09 09 09 20 28 70 r "]")))).... (p
4940: 72 69 6e 74 20 74 61 72 67 65 74 73 74 72 29 29 rint targetstr))
4950: 29 29 0a 09 20 20 20 20 20 20 20 28 69 66 20 28 )).. (if (
4960: 6e 6f 74 20 64 62 2d 74 61 72 67 65 74 73 29 0a not db-targets).
4970: 09 09 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e .. (let* ((run
4980: 2d 69 64 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 -id (db:get-valu
4990: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
49a0: 68 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 09 header "id"))...
49b0: 09 20 20 28 74 65 73 74 73 20 20 28 63 64 62 3a . (tests (cdb:
49c0: 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 remote-run db:ge
49d0: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
49e0: 23 66 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 #f run-id testpa
49f0: 74 74 20 27 28 29 20 27 28 29 29 29 29 0a 09 09 tt '() '())))...
4a00: 20 20 20 20 20 28 70 72 69 6e 74 20 22 52 75 6e (print "Run
4a10: 3a 20 22 20 74 61 72 67 65 74 73 74 72 20 22 2f : " targetstr "/
4a20: 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d " (db:get-value-
4a30: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
4a40: 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 20 ader "runname")
4a50: 0a 09 09 09 20 20 20 20 22 20 73 74 61 74 75 73 .... " status
4a60: 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 : " (db:get-valu
4a70: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
4a80: 68 65 61 64 65 72 20 22 73 74 61 74 65 22 29 0a header "state").
4a90: 09 09 09 20 20 20 20 22 20 72 75 6e 2d 69 64 3a ... " run-id:
4aa0: 20 22 20 72 75 6e 2d 69 64 20 22 2c 20 6e 75 6d " run-id ", num
4ab0: 62 65 72 20 74 65 73 74 73 3a 20 22 20 28 6c 65 ber tests: " (le
4ac0: 6e 67 74 68 20 74 65 73 74 73 29 29 0a 09 09 20 ngth tests))...
4ad0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 (for-each ..
4ae0: 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
4af0: 74 65 73 74 29 0a 09 09 09 28 66 6f 72 6d 61 74 test)....(format
4b00: 20 23 74 0a 09 09 09 09 22 20 20 54 65 73 74 3a #t....." Test:
4b10: 20 7e 32 35 61 20 53 74 61 74 65 3a 20 7e 31 35 ~25a State: ~15
4b20: 61 20 53 74 61 74 75 73 3a 20 7e 31 35 61 20 52 a Status: ~15a R
4b30: 75 6e 74 69 6d 65 3a 20 7e 35 40 61 73 20 54 69 untime: ~5@as Ti
4b40: 6d 65 3a 20 7e 32 32 61 20 48 6f 73 74 3a 20 7e me: ~22a Host: ~
4b50: 31 30 61 5c 6e 22 0a 09 09 09 09 28 63 6f 6e 63 10a\n".....(conc
4b60: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 (db:test-get-te
4b70: 73 74 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 09 stname test)....
4b80: 09 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 . (if (equa
4b90: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
4ba0: 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 20 item-path test)
4bb0: 22 22 29 0a 09 09 09 09 09 20 20 22 22 20 0a 09 "")...... "" ..
4bc0: 09 09 09 09 20 20 28 63 6f 6e 63 20 22 28 22 20 .... (conc "("
4bd0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 (db:test-get-ite
4be0: 6d 2d 70 61 74 68 20 74 65 73 74 29 20 22 29 22 m-path test) ")"
4bf0: 29 29 29 0a 09 09 09 09 28 64 62 3a 74 65 73 74 ))).....(db:test
4c00: 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 29 -get-state test)
4c10: 0a 09 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65 .....(db:test-ge
4c20: 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 0a 09 t-status test)..
4c30: 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ...(db:test-get-
4c40: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 run_duration tes
4c50: 74 29 0a 09 09 09 09 28 64 62 3a 74 65 73 74 2d t).....(db:test-
4c60: 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 get-event_time t
4c70: 65 73 74 29 0a 09 09 09 09 28 64 62 3a 74 65 73 est).....(db:tes
4c80: 74 2d 67 65 74 2d 68 6f 73 74 20 74 65 73 74 29 t-get-host test)
4c90: 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 28 6f )....(if (not (o
4ca0: 72 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 r (equal? (db:te
4cb0: 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 st-get-status te
4cc0: 73 74 29 20 22 50 41 53 53 22 29 0a 09 09 09 09 st) "PASS").....
4cd0: 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 64 62 (equal? (db
4ce0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
4cf0: 20 74 65 73 74 29 20 22 57 41 52 4e 22 29 0a 09 test) "WARN")..
4d00: 09 09 09 20 20 20 20 20 28 65 71 75 61 6c 3f 20 ... (equal?
4d10: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
4d20: 74 65 20 74 65 73 74 29 20 20 22 4e 4f 54 5f 53 te test) "NOT_S
4d30: 54 41 52 54 45 44 22 29 29 29 0a 09 09 09 20 20 TARTED")))....
4d40: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 (begin....
4d50: 20 20 28 70 72 69 6e 74 20 22 20 20 20 20 20 20 (print "
4d60: 20 20 20 63 70 75 6c 6f 61 64 3a 20 20 22 20 28 cpuload: " (
4d70: 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 70 75 6c db:test-get-cpul
4d80: 6f 61 64 20 74 65 73 74 29 0a 09 09 09 09 20 20 oad test).....
4d90: 20 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 64 "\n d
4da0: 69 73 6b 66 72 65 65 3a 20 22 20 28 64 62 3a 74 iskfree: " (db:t
4db0: 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 65 est-get-diskfree
4dc0: 20 74 65 73 74 29 0a 09 09 09 09 20 20 20 20 20 test).....
4dd0: 22 5c 6e 20 20 20 20 20 20 20 20 20 75 6e 61 6d "\n unam
4de0: 65 3a 20 20 20 20 22 20 28 64 62 3a 74 65 73 74 e: " (db:test
4df0: 2d 67 65 74 2d 75 6e 61 6d 65 20 74 65 73 74 29 -get-uname test)
4e00: 0a 09 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 ..... "\n
4e10: 20 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 20 rundir:
4e20: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 " (db:test-get-r
4e30: 75 6e 64 69 72 20 74 65 73 74 29 0a 09 09 09 09 undir test).....
4e40: 20 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 20 )....
4e50: 3b 3b 20 45 61 63 68 20 74 65 73 74 0a 09 09 09 ;; Each test....
4e60: 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 ;; DO NOT
4e70: 72 65 6d 6f 74 65 20 72 75 6e 0a 09 09 09 20 20 remote run....
4e80: 20 20 20 20 28 6c 65 74 20 28 28 73 74 65 70 73 (let ((steps
4e90: 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 (db:get-steps-f
4ea0: 6f 72 2d 74 65 73 74 20 23 66 20 28 64 62 3a 74 or-test #f (db:t
4eb0: 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 29 est-get-id test)
4ec0: 29 29 29 0a 09 09 09 09 28 66 6f 72 2d 65 61 63 ))).....(for-eac
4ed0: 68 20 0a 09 09 09 09 20 28 6c 61 6d 62 64 61 20 h ..... (lambda
4ee0: 28 73 74 65 70 29 0a 09 09 09 09 20 20 20 28 66 (step)..... (f
4ef0: 6f 72 6d 61 74 20 23 74 20 0a 09 09 09 09 09 20 ormat #t ......
4f00: 20 20 22 20 20 20 20 53 74 65 70 3a 20 7e 32 30 " Step: ~20
4f10: 61 20 53 74 61 74 65 3a 20 7e 31 30 61 20 53 74 a State: ~10a St
4f20: 61 74 75 73 3a 20 7e 31 30 61 20 54 69 6d 65 20 atus: ~10a Time
4f30: 7e 32 32 61 5c 6e 22 0a 09 09 09 09 09 20 20 20 ~22a\n"......
4f40: 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 (db:step-get-ste
4f50: 70 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 09 09 pname step).....
4f60: 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 . (db:step-get
4f70: 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 09 09 -state step)....
4f80: 09 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 .. (db:step-ge
4f90: 74 2d 73 74 61 74 75 73 20 73 74 65 70 29 0a 09 t-status step)..
4fa0: 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 2d .... (db:step-
4fb0: 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 get-event_time s
4fc0: 74 65 70 29 29 29 0a 09 09 09 09 20 73 74 65 70 tep)))..... step
4fd0: 73 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 74 s)))))... t
4fe0: 65 73 74 73 29 29 29 29 29 0a 09 20 20 20 20 20 ests)))))..
4ff0: 72 75 6e 73 29 0a 09 20 20 20 28 73 65 74 21 20 runs).. (set!
5000: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
5010: 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d t))))..;;=======
5020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
5060: 3b 3b 20 66 75 6c 6c 20 72 75 6e 0a 3b 3b 3d 3d ;; full run.;;==
5070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
50a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
50b0: 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 20 6c 6f 63 ====..;; get loc
50c0: 6b 20 69 6e 20 64 62 20 66 6f 72 20 66 75 6c 6c k in db for full
50d0: 20 72 75 6e 20 66 6f 72 20 74 68 69 73 20 64 69 run for this di
50e0: 72 65 63 74 6f 72 79 0a 3b 3b 20 66 6f 72 20 61 rectory.;; for a
50f0: 6c 6c 20 74 65 73 74 73 20 77 69 74 68 20 64 65 ll tests with de
5100: 70 73 0a 3b 3b 20 20 20 77 61 6c 6b 20 74 72 65 ps.;; walk tre
5110: 65 20 6f 66 20 74 65 73 74 73 20 74 6f 20 66 69 e of tests to fi
5120: 6e 64 20 68 65 61 64 20 74 61 73 6b 73 0a 3b 3b nd head tasks.;;
5130: 20 20 20 61 64 64 20 68 65 61 64 20 74 61 73 6b add head task
5140: 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 0a s to task queue.
5150: 3b 3b 20 20 20 61 64 64 20 64 65 70 65 6e 64 61 ;; add dependa
5160: 6e 74 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b nt tasks to task
5170: 20 71 75 65 75 65 20 0a 3b 3b 20 20 20 61 64 64 queue .;; add
5180: 20 72 65 6d 61 69 6e 69 6e 67 20 74 61 73 6b 73 remaining tasks
5190: 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 0a 3b to task queue.;
51a0: 3b 20 66 6f 72 20 65 61 63 68 20 74 61 73 6b 20 ; for each task
51b0: 69 6e 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b in task queue.;;
51c0: 20 20 20 69 66 20 68 61 76 65 20 61 64 65 71 75 if have adequ
51d0: 61 74 65 20 72 65 73 6f 75 72 63 65 73 0a 3b 3b ate resources.;;
51e0: 20 20 20 20 20 6c 61 75 6e 63 68 20 74 61 73 6b launch task
51f0: 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b 20 20 20 .;; else.;;
5200: 20 20 70 75 74 20 74 61 73 6b 20 69 6e 20 64 65 put task in de
5210: 66 65 72 72 65 64 20 71 75 65 75 65 0a 3b 3b 20 ferred queue.;;
5220: 69 66 20 73 74 69 6c 6c 20 6f 6b 20 74 6f 20 72 if still ok to r
5230: 75 6e 20 74 61 73 6b 73 0a 3b 3b 20 20 20 70 72 un tasks.;; pr
5240: 6f 63 65 73 73 20 64 65 66 65 72 72 65 64 20 74 ocess deferred t
5250: 61 73 6b 73 20 70 65 72 20 61 62 6f 76 65 20 73 asks per above s
5260: 74 65 70 73 0a 0a 3b 3b 20 72 75 6e 20 61 6c 6c teps..;; run all
5270: 20 74 65 73 74 73 20 61 72 65 20 61 72 65 20 4e tests are are N
5280: 6f 74 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 ot COMPLETED and
5290: 20 50 41 53 53 20 6f 72 20 43 48 45 43 4b 0a 28 PASS or CHECK.(
52a0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
52b0: 20 22 2d 72 75 6e 61 6c 6c 22 29 0a 20 20 20 20 "-runall").
52c0: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
52d0: 6c 20 0a 20 20 20 20 20 22 2d 72 75 6e 61 6c 6c l . "-runall
52e0: 22 0a 20 20 20 20 20 22 72 75 6e 20 61 6c 6c 20 ". "run all
52f0: 74 65 73 74 73 22 0a 20 20 20 20 20 28 6c 61 6d tests". (lam
5300: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
5310: 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 ame keys keyname
5320: 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 s keyvallst).
5330: 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 (runs:run-te
5340: 73 74 73 20 74 61 72 67 65 74 0a 09 09 20 20 20 sts target...
5350: 20 20 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 runname...
5360: 20 20 20 20 20 22 25 22 0a 09 09 20 20 20 20 20 "%"...
5370: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
5380: 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 20 "-testpatt")...
5390: 20 20 20 20 20 20 75 73 65 72 0a 09 09 20 20 20 user...
53a0: 20 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 73 args:arg-has
53b0: 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d h))))..;;=======
53c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
5400: 3b 3b 20 72 75 6e 20 6f 6e 65 20 74 65 73 74 0a ;; run one test.
5410: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
5420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5450: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e 20 ========..;; 1.
5460: 66 69 6e 64 20 74 68 65 20 63 6f 6e 66 69 67 20 find the config
5470: 66 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 61 6e 67 file.;; 2. chang
5480: 65 20 74 6f 20 74 68 65 20 74 65 73 74 20 64 69 e to the test di
5490: 72 65 63 74 6f 72 79 0a 3b 3b 20 33 2e 20 75 70 rectory.;; 3. up
54a0: 64 61 74 65 20 74 68 65 20 64 62 20 77 69 74 68 date the db with
54b0: 20 22 74 65 73 74 20 73 74 61 72 74 65 64 22 20 "test started"
54c0: 73 74 61 74 75 73 2c 20 73 65 74 20 72 75 6e 6e status, set runn
54d0: 69 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 2e 20 70 ing host.;; 4. p
54e0: 72 6f 63 65 73 73 20 6c 61 75 6e 63 68 20 74 68 rocess launch th
54f0: 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 6d e test.;; - m
5500: 6f 6e 69 74 6f 72 20 74 68 65 20 70 72 6f 63 65 onitor the proce
5510: 73 73 2c 20 75 70 64 61 74 65 20 73 74 61 74 73 ss, update stats
5520: 20 69 6e 20 74 68 65 20 64 62 20 65 76 65 72 79 in the db every
5530: 20 32 5e 6e 20 6d 69 6e 75 74 65 73 0a 3b 3b 20 2^n minutes.;;
5540: 35 2e 20 61 73 20 74 68 65 20 74 65 73 74 20 70 5. as the test p
5550: 72 6f 63 65 65 64 73 20 69 6e 74 65 72 6e 61 6c roceeds internal
5560: 6c 79 20 69 74 20 63 61 6c 6c 73 20 6d 65 67 61 ly it calls mega
5570: 74 65 73 74 20 61 73 20 65 61 63 68 20 73 74 65 test as each ste
5580: 70 20 69 73 0a 3b 3b 20 20 20 20 73 74 61 72 74 p is.;; start
5590: 65 64 20 61 6e 64 20 63 6f 6d 70 6c 65 74 65 64 ed and completed
55a0: 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 73 74 .;; - step st
55b0: 61 72 74 65 64 2c 20 74 69 6d 65 73 74 61 6d 70 arted, timestamp
55c0: 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 63 6f .;; - step co
55d0: 6d 70 6c 65 74 65 64 2c 20 65 78 69 74 20 73 74 mpleted, exit st
55e0: 61 74 75 73 2c 20 74 69 6d 65 73 74 61 6d 70 0a atus, timestamp.
55f0: 3b 3b 20 36 2e 20 74 65 73 74 20 70 68 6f 6e 65 ;; 6. test phone
5600: 20 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d 20 69 66 home.;; - if
5610: 20 74 65 73 74 20 72 75 6e 20 74 69 6d 65 20 3e test run time >
5620: 20 61 6c 6c 6f 77 65 64 20 72 75 6e 20 74 69 6d allowed run tim
5630: 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a e then kill job.
5640: 3b 3b 20 20 20 20 2d 20 69 66 20 63 61 6e 6e 6f ;; - if canno
5650: 74 20 61 63 63 65 73 73 20 64 62 20 3e 20 61 6c t access db > al
5660: 6c 6f 77 65 64 20 64 69 73 63 6f 6e 6e 65 63 74 lowed disconnect
5670: 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 time then kill
5680: 6a 6f 62 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 job..(if (args:g
5690: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
56a0: 73 22 29 0a 20 20 28 67 65 6e 65 72 61 6c 2d 72 s"). (general-r
56b0: 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 22 2d 72 75 un-call . "-ru
56c0: 6e 74 65 73 74 73 22 20 0a 20 20 20 22 72 75 6e ntests" . "run
56d0: 20 61 20 74 65 73 74 22 20 0a 20 20 20 28 6c 61 a test" . (la
56e0: 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
56f0: 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d name keys keynam
5700: 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 es keyvallst).
5710: 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 (runs:run-tes
5720: 74 73 20 74 61 72 67 65 74 0a 09 09 20 20 20 20 ts target...
5730: 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 20 20 20 runname...
5740: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5750: 72 75 6e 74 65 73 74 73 22 29 0a 09 09 20 20 20 runtests")...
5760: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
5770: 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 20 "-testpatt")...
5780: 20 20 20 20 75 73 65 72 0a 09 09 20 20 20 20 20 user...
5790: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 args:arg-hash)))
57a0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
57b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 ===========.;; R
57f0: 6f 6c 6c 75 70 20 69 6e 74 6f 20 61 20 72 75 6e ollup into a run
5800: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
5810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
5850: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
5860: 6f 6c 6c 75 70 22 29 0a 20 20 20 20 28 62 65 67 ollup"). (beg
5870: 69 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a in. (debug:
5880: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
5890: 52 6f 6c 6c 75 70 20 69 73 20 63 75 72 72 65 6e Rollup is curren
58a0: 74 6c 79 20 6e 6f 74 20 77 6f 72 6b 69 6e 67 2e tly not working.
58b0: 20 49 66 20 79 6f 75 20 6e 65 65 64 20 69 74 20 If you need it
58c0: 70 6c 65 61 73 65 20 73 75 62 6d 69 74 20 61 20 please submit a
58d0: 74 69 63 6b 65 74 20 61 74 20 68 74 74 70 3a 2f ticket at http:/
58e0: 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f /www.kiatoa.com/
58f0: 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 fossils/megatest
5900: 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 34 "). (exit 4
5910: 29 29 29 0a 3b 3b 20 20 20 20 20 28 67 65 6e 65 ))).;; (gene
5920: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 3b 3b ral-run-call .;;
5930: 20 20 20 20 20 20 22 2d 72 6f 6c 6c 75 70 22 20 "-rollup"
5940: 0a 3b 3b 20 20 20 20 20 20 22 72 6f 6c 6c 75 70 .;; "rollup
5950: 20 74 65 73 74 73 22 20 0a 3b 3b 20 20 20 20 20 tests" .;;
5960: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
5970: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
5980: 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 ynames keyvallst
5990: 29 0a 3b 3b 20 20 20 20 20 20 20 20 28 72 75 6e ).;; (run
59a0: 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 6b 65 79 s:rollup-run key
59b0: 73 0a 3b 3b 20 09 09 09 28 6b 65 79 73 2d 3e 61 s.;; ...(keys->a
59c0: 6c 69 73 74 20 6b 65 79 73 20 22 6e 61 22 29 0a list keys "na").
59d0: 3b 3b 20 09 09 09 28 61 72 67 73 3a 67 65 74 2d ;; ...(args:get-
59e0: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 arg ":runname")
59f0: 0a 3b 3b 20 09 09 09 75 73 65 72 29 29 29 29 0a .;; ...user)))).
5a00: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
5a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 6f 63 =========.;; Loc
5a50: 6b 20 6f 72 20 75 6e 6c 6f 63 6b 20 61 20 72 75 k or unlock a ru
5a60: 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d n.;;============
5a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
5ab0: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
5ac0: 67 20 22 2d 6c 6f 63 6b 22 29 28 61 72 67 73 3a g "-lock")(args:
5ad0: 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b get-arg "-unlock
5ae0: 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c ")). (general
5af0: 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 -run-call .
5b00: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
5b10: 67 20 22 2d 6c 6f 63 6b 22 29 20 22 2d 6c 6f 63 g "-lock") "-loc
5b20: 6b 22 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 20 k" "-unlock").
5b30: 20 20 20 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 20 "lock/unlock
5b40: 74 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c 61 tests" . (la
5b50: 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
5b60: 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d name keys keynam
5b70: 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 es keyvallst).
5b80: 20 20 20 20 20 28 72 75 6e 73 3a 68 61 6e 64 6c (runs:handl
5b90: 65 2d 6c 6f 63 6b 69 6e 67 20 0a 09 09 20 20 74 e-locking ... t
5ba0: 61 72 67 65 74 0a 09 09 20 20 6b 65 79 73 0a 09 arget... keys..
5bb0: 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 . (args:get-arg
5bc0: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 0a 09 09 ":runname") ...
5bd0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
5be0: 22 2d 6c 6f 63 6b 22 29 0a 09 09 20 20 28 61 72 "-lock")... (ar
5bf0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c gs:get-arg "-unl
5c00: 6f 63 6b 22 29 0a 09 09 20 20 75 73 65 72 29 29 ock")... user))
5c10: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
5c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
5c60: 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 Get paths to tes
5c70: 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ts.;;===========
5c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 ===========.;; G
5cc0: 65 74 20 74 65 73 74 20 70 61 74 68 73 20 6d 61 et test paths ma
5cd0: 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 tching target, r
5ce0: 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 65 73 74 unname, and test
5cf0: 70 61 74 74 0a 28 69 66 20 28 6f 72 20 28 61 72 patt.(if (or (ar
5d00: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
5d10: 74 2d 66 69 6c 65 73 22 29 28 61 72 67 73 3a 67 t-files")(args:g
5d20: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 70 61 et-arg "-test-pa
5d30: 74 68 73 22 29 29 0a 20 20 20 20 3b 3b 20 69 66 ths")). ;; if
5d40: 20 77 65 20 61 72 65 20 69 6e 20 61 20 74 65 73 we are in a tes
5d50: 74 20 75 73 65 20 74 68 65 20 4d 54 5f 43 4d 44 t use the MT_CMD
5d60: 49 4e 46 4f 20 64 61 74 61 0a 20 20 20 20 28 69 INFO data. (i
5d70: 66 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d f (getenv "MT_CM
5d80: 44 49 4e 46 4f 22 29 0a 09 28 6c 65 74 2a 20 28 DINFO")..(let* (
5d90: 28 73 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 (startingdir (cu
5da0: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
5db0: 29 0a 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e ).. (cmdin
5dc0: 66 6f 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e fo (read (open
5dd0: 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 -input-string (b
5de0: 61 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 ase64:base64-dec
5df0: 6f 64 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f ode (getenv "MT_
5e00: 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 CMDINFO")))))..
5e10: 20 20 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 6d ;; (runrem
5e20: 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ote (assoc/defau
5e30: 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 6d lt 'runremote cm
5e40: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
5e50: 28 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f (transport (asso
5e60: 63 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 c/default 'trans
5e70: 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 port cmdinfo))..
5e80: 20 20 20 20 20 20 20 28 74 65 73 74 70 61 74 68 (testpath
5e90: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
5ea0: 20 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 'testpath cmdi
5eb0: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
5ec0: 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f est-name (assoc/
5ed0: 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 default 'test-na
5ee0: 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 me cmdinfo))..
5ef0: 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 (runscript
5f00: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
5f10: 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 runscript cmdinf
5f20: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d o)).. (db-
5f30: 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 host (assoc/de
5f40: 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 fault 'db-host
5f50: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
5f60: 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 (run-id (a
5f70: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
5f80: 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 n-id cmdinfo)
5f90: 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 ).. (itemd
5fa0: 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 at (assoc/defa
5fb0: 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 ult 'itemdat c
5fc0: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
5fd0: 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 0a (db #f).
5fe0: 09 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 . (state
5ff0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
6000: 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 ":state"))..
6010: 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 (status (
6020: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 args:get-arg ":s
6030: 74 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 tatus"))..
6040: 20 28 74 61 72 67 65 74 20 20 20 20 28 61 72 67 (target (arg
6050: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 s:get-arg "-targ
6060: 65 74 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 et")).. (t
6070: 6f 70 70 61 74 68 20 20 20 28 61 73 73 6f 63 2f oppath (assoc/
6080: 64 65 66 61 75 6c 74 20 27 74 6f 70 70 61 74 68 default 'toppath
6090: 20 20 20 63 6d 64 69 6e 66 6f 29 29 29 0a 09 20 cmdinfo)))..
60a0: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
60b0: 72 79 20 74 6f 70 70 61 74 68 29 0a 09 20 20 3b ry toppath).. ;
60c0: 3b 20 28 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f ; (set! *runremo
60d0: 74 65 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 te* runremote)..
60e0: 20 20 28 73 65 74 21 20 2a 74 72 61 6e 73 70 6f (set! *transpo
60f0: 72 74 2d 74 79 70 65 2a 20 28 73 74 72 69 6e 67 rt-type* (string
6100: 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 6e 73 70 6f ->symbol transpo
6110: 72 74 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 rt)).. (if (not
6120: 20 74 61 72 67 65 74 29 0a 09 20 20 20 20 20 20 target)..
6130: 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a (begin...(debug:
6140: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
6150: 2d 74 61 72 67 65 74 20 69 73 20 72 65 71 75 69 -target is requi
6160: 72 65 64 2e 22 29 0a 09 09 28 65 78 69 74 20 31 red.")...(exit 1
6170: 29 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 ))).. (if (not
6180: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
6190: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
61a0: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
61b0: 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 "Failed to setup
61c0: 2c 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 2d , giving up on -
61d0: 74 65 73 74 2d 70 61 74 68 73 20 6f 72 20 2d 74 test-paths or -t
61e0: 65 73 74 2d 66 69 6c 65 73 2c 20 65 78 69 74 69 est-files, exiti
61f0: 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 ng")...(exit 1))
6200: 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 ).. (let* ((key
6210: 73 20 20 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 s (cdb:remot
6220: 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 79 e-run db:get-key
6230: 73 20 64 62 29 29 0a 09 09 20 28 6b 65 79 6e 61 s db))... (keyna
6240: 6d 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 mes (map key:get
6250: 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 -fieldname keys)
6260: 29 0a 09 09 20 3b 3b 20 64 62 3a 74 65 73 74 2d )... ;; db:test-
6270: 67 65 74 2d 70 61 74 68 73 20 6d 75 73 74 20 6e get-paths must n
6280: 6f 74 20 62 65 20 72 75 6e 20 72 65 6d 6f 74 65 ot be run remote
6290: 0a 09 09 20 28 70 61 74 68 73 20 20 20 20 28 64 ... (paths (d
62a0: 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 b:test-get-paths
62b0: 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 -matching db key
62c0: 6e 61 6d 65 73 20 74 61 72 67 65 74 20 28 61 72 names target (ar
62d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
62e0: 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 20 t-files"))))..
62f0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
6300: 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 thing* #t)..
6310: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
6320: 61 20 28 70 61 74 68 29 0a 09 09 09 28 70 72 69 a (path)....(pri
6330: 6e 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 nt path))...
6340: 20 20 70 61 74 68 73 29 29 29 0a 09 3b 3b 20 65 paths)))..;; e
6350: 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 6c lse do a general
6360: 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 -run-call..(gene
6370: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 ral-run-call ..
6380: 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 0a 09 20 "-test-files"..
6390: 22 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 "Get paths to te
63a0: 73 74 22 0a 09 20 28 6c 61 6d 62 64 61 20 28 74 st".. (lambda (t
63b0: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
63c0: 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 ys keynames keyv
63d0: 61 6c 6c 73 74 29 0a 09 20 20 20 28 6c 65 74 2a allst).. (let*
63e0: 20 28 28 64 62 20 20 20 20 20 20 20 23 66 29 0a ((db #f).
63f0: 09 09 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 .. ;; DO NOT ru
6400: 6e 20 72 65 6d 6f 74 65 0a 09 09 20 20 28 70 61 n remote... (pa
6410: 74 68 73 20 20 20 20 28 64 62 3a 74 65 73 74 2d ths (db:test-
6420: 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 get-paths-matchi
6430: 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 ng db keynames t
6440: 61 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d arget (args:get-
6450: 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 arg "-test-files
6460: 22 29 29 29 29 0a 09 20 20 20 20 20 28 66 6f 72 ")))).. (for
6470: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 -each (lambda (p
6480: 61 74 68 29 0a 09 09 09 20 28 70 72 69 6e 74 20 ath).... (print
6490: 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 20 path))...
64a0: 70 61 74 68 73 29 29 29 29 29 29 0a 0a 3b 3b 3d paths))))))..;;=
64b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
64c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
64d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
64e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
64f0: 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 =====.;; Archive
6500: 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d tests.;;=======
6510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
6550: 3b 3b 20 41 72 63 68 69 76 65 20 74 65 73 74 73 ;; Archive tests
6560: 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 74 matching target
6570: 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 , runname, and t
6580: 65 73 74 70 61 74 74 0a 28 69 66 20 28 61 72 67 estpatt.(if (arg
6590: 73 3a 67 65 74 2d 61 72 67 20 22 2d 61 72 63 68 s:get-arg "-arch
65a0: 69 76 65 22 29 0a 20 20 20 20 3b 3b 20 69 66 20 ive"). ;; if
65b0: 77 65 20 61 72 65 20 69 6e 20 61 20 74 65 73 74 we are in a test
65c0: 20 75 73 65 20 74 68 65 20 4d 54 5f 43 4d 44 49 use the MT_CMDI
65d0: 4e 46 4f 20 64 61 74 61 0a 20 20 20 20 28 69 66 NFO data. (if
65e0: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
65f0: 49 4e 46 4f 22 29 0a 09 28 6c 65 74 2a 20 28 28 INFO")..(let* ((
6600: 73 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 72 startingdir (cur
6610: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 rent-directory))
6620: 0a 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 .. (cmdinf
6630: 6f 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d o (read (open-
6640: 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 input-string (ba
6650: 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f se64:base64-deco
6660: 64 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 de (getenv "MT_C
6670: 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 MDINFO")))))..
6680: 20 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 6d 6f ;; (runremo
6690: 74 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c te (assoc/defaul
66a0: 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 6d 64 t 'runremote cmd
66b0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
66c0: 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 transport (assoc
66d0: 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 /default 'transp
66e0: 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ort cmdinfo))..
66f0: 20 20 20 20 20 20 28 74 65 73 74 70 61 74 68 20 (testpath
6700: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
6710: 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 'testpath cmdin
6720: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 fo)).. (te
6730: 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 st-name (assoc/d
6740: 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d efault 'test-nam
6750: 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 e cmdinfo))..
6760: 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 (runscript (
6770: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
6780: 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f unscript cmdinfo
6790: 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 )).. (db-h
67a0: 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 ost (assoc/def
67b0: 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 ault 'db-host
67c0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
67d0: 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 (run-id (as
67e0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
67f0: 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 -id cmdinfo))
6800: 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 .. (itemda
6810: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
6820: 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d lt 'itemdat cm
6830: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
6840: 28 64 62 20 20 20 20 20 20 20 20 23 66 29 0a 09 (db #f)..
6850: 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 (state
6860: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
6870: 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 ":state"))..
6880: 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 61 (status (a
6890: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
68a0: 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 atus"))..
68b0: 28 74 61 72 67 65 74 20 20 20 20 28 61 72 67 73 (target (args
68c0: 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 :get-arg "-targe
68d0: 74 22 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 t"))).. (change
68e0: 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 -directory testp
68f0: 61 74 68 29 0a 09 20 20 3b 3b 20 28 73 65 74 21 ath).. ;; (set!
6900: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e *runremote* run
6910: 72 65 6d 6f 74 65 29 0a 09 20 20 28 73 65 74 21 remote).. (set!
6920: 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 *transport-type
6930: 2a 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f * (string->symbo
6940: 6c 20 74 72 61 6e 73 70 6f 72 74 29 29 0a 09 20 l transport))..
6950: 20 28 69 66 20 28 6e 6f 74 20 74 61 72 67 65 74 (if (not target
6960: 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ).. (begin.
6970: 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ..(debug:print 0
6980: 20 22 45 52 52 4f 52 3a 20 2d 74 61 72 67 65 74 "ERROR: -target
6990: 20 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 0a is required.").
69a0: 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 ..(exit 1)))..
69b0: 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d (if (not (setup-
69c0: 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 for-run))..
69d0: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
69e0: 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 :print 0 "Failed
69f0: 20 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 6e to setup, givin
6a00: 67 20 75 70 20 6f 6e 20 2d 61 72 63 68 69 76 65 g up on -archive
6a10: 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 , exiting")...(e
6a20: 78 69 74 20 31 29 29 29 0a 09 20 20 28 6c 65 74 xit 1))).. (let
6a30: 2a 20 28 28 6b 65 79 73 20 20 20 20 20 28 63 64 * ((keys (cd
6a40: 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a b:remote-run db:
6a50: 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 09 get-keys db))...
6a60: 20 28 6b 65 79 6e 61 6d 65 73 20 28 6d 61 70 20 (keynames (map
6a70: 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d key:get-fieldnam
6a80: 65 20 6b 65 79 73 29 29 0a 09 09 20 3b 3b 20 44 e keys))... ;; D
6a90: 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 O NOT run remote
6aa0: 0a 09 09 20 28 70 61 74 68 73 20 20 20 20 28 64 ... (paths (d
6ab0: 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 b:test-get-paths
6ac0: 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 -matching db key
6ad0: 6e 61 6d 65 73 20 74 61 72 67 65 74 29 29 29 0a names target))).
6ae0: 09 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 . (set! *dids
6af0: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 omething* #t)..
6b00: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
6b10: 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 28 mbda (path)....(
6b20: 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 20 print path))...
6b30: 20 20 20 20 20 70 61 74 68 73 29 29 29 0a 09 3b paths)))..;
6b40: 3b 20 65 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 ; else do a gene
6b50: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 ral-run-call..(g
6b60: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
6b70: 0a 09 20 22 2d 74 65 73 74 2d 70 61 74 68 73 22 .. "-test-paths"
6b80: 0a 09 20 22 47 65 74 20 70 61 74 68 73 20 74 6f .. "Get paths to
6b90: 20 74 65 73 74 73 22 0a 09 20 28 6c 61 6d 62 64 tests".. (lambd
6ba0: 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
6bb0: 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 e keys keynames
6bc0: 6b 65 79 76 61 6c 6c 73 74 29 0a 09 20 20 20 28 keyvallst).. (
6bd0: 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 let* ((db
6be0: 23 66 29 0a 09 09 20 20 3b 3b 20 44 4f 20 4e 4f #f)... ;; DO NO
6bf0: 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 T run remote...
6c00: 20 28 70 61 74 68 73 20 20 20 20 28 64 62 3a 74 (paths (db:t
6c10: 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 est-get-paths-ma
6c20: 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d tching db keynam
6c30: 65 73 20 74 61 72 67 65 74 29 29 29 0a 09 20 20 es target)))..
6c40: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
6c50: 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 20 mbda (path)....
6c60: 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 (print path))...
6c70: 20 20 20 20 20 20 20 70 61 74 68 73 29 29 29 29 paths))))
6c80: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
6c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
6cd0: 45 78 74 72 61 63 74 20 61 20 73 70 72 65 61 64 Extract a spread
6ce0: 73 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 72 sheet from the r
6cf0: 75 6e 73 20 64 61 74 61 62 61 73 65 0a 3b 3b 3d uns database.;;=
6d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d40: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
6d50: 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 61 :get-arg "-extra
6d60: 63 74 2d 6f 64 73 22 29 0a 20 20 20 20 28 67 65 ct-ods"). (ge
6d70: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 neral-run-call.
6d80: 20 20 20 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 "-extract-od
6d90: 73 22 0a 20 20 20 20 20 22 4d 61 6b 65 20 6f 64 s". "Make od
6da0: 73 20 73 70 72 65 61 64 73 68 65 65 74 22 0a 20 s spreadsheet".
6db0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
6dc0: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
6dd0: 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c keynames keyval
6de0: 6c 73 74 29 0a 20 20 20 20 20 20 20 28 6c 65 74 lst). (let
6df0: 20 28 28 64 62 20 20 20 20 20 20 20 20 20 23 66 ((db #f
6e00: 29 0a 09 20 20 20 20 20 28 6f 75 74 70 75 74 66 ).. (outputf
6e10: 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ile (args:get-ar
6e20: 67 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 g "-extract-ods"
6e30: 29 29 0a 09 20 20 20 20 20 28 72 75 6e 73 70 61 )).. (runspa
6e40: 74 74 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 tt (args:get-a
6e50: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a rg ":runname")).
6e60: 09 20 20 20 20 20 28 70 61 74 68 6d 6f 64 20 20 . (pathmod
6e70: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
6e80: 22 2d 70 61 74 68 6d 6f 64 22 29 29 0a 09 20 20 "-pathmod"))..
6e90: 20 20 20 28 6b 65 79 76 61 6c 61 6c 69 73 74 20 (keyvalalist
6ea0: 28 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 79 (keys->alist key
6eb0: 73 20 22 25 22 29 29 29 0a 09 20 28 64 65 62 75 s "%"))).. (debu
6ec0: 67 3a 70 72 69 6e 74 20 32 20 22 45 78 74 72 61 g:print 2 "Extra
6ed0: 63 74 20 6f 64 73 2c 20 6f 75 74 70 75 74 66 69 ct ods, outputfi
6ee0: 6c 65 3a 20 22 20 6f 75 74 70 75 74 66 69 6c 65 le: " outputfile
6ef0: 20 22 20 72 75 6e 73 70 61 74 74 3a 20 22 20 72 " runspatt: " r
6f00: 75 6e 73 70 61 74 74 20 22 20 6b 65 79 76 61 6c unspatt " keyval
6f10: 61 6c 69 73 74 3a 20 22 20 6b 65 79 76 61 6c 61 alist: " keyvala
6f20: 6c 69 73 74 29 0a 09 20 28 63 64 62 3a 72 65 6d list).. (cdb:rem
6f30: 6f 74 65 2d 72 75 6e 20 64 62 3a 65 78 74 72 61 ote-run db:extra
6f40: 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 20 6f ct-ods-file db o
6f50: 75 74 70 75 74 66 69 6c 65 20 6b 65 79 76 61 6c utputfile keyval
6f60: 61 6c 69 73 74 20 28 69 66 20 72 75 6e 73 70 61 alist (if runspa
6f70: 74 74 20 72 75 6e 73 70 61 74 74 20 22 25 22 29 tt runspatt "%")
6f80: 20 70 61 74 68 6d 6f 64 29 29 29 29 29 0a 0a 3b pathmod)))))..;
6f90: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
6fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6fd0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 63 75 =======.;; execu
6fe0: 74 65 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 te the test.;;
6ff0: 20 20 2d 20 67 65 74 73 20 63 61 6c 6c 65 64 20 - gets called
7000: 6f 6e 20 72 65 6d 6f 74 65 20 68 6f 73 74 0a 3b on remote host.;
7010: 3b 20 20 20 20 2d 20 72 65 63 65 69 76 65 73 20 ; - receives
7020: 69 6e 66 6f 20 66 72 6f 6d 20 74 68 65 20 2d 65 info from the -e
7030: 78 65 63 75 74 65 20 70 61 72 61 6d 0a 3b 3b 20 xecute param.;;
7040: 20 20 20 2d 20 70 61 73 73 65 73 20 69 6e 66 6f - passes info
7050: 20 74 6f 20 73 74 65 70 73 20 76 69 61 20 4d 54 to steps via MT
7060: 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 _CMDINFO env var
7070: 20 28 66 75 74 75 72 65 20 69 73 20 74 6f 20 75 (future is to u
7080: 73 65 20 61 20 64 6f 74 20 66 69 6c 65 29 0a 3b se a dot file).;
7090: 3b 20 20 20 20 2d 20 67 61 74 68 65 72 73 20 68 ; - gathers h
70a0: 6f 73 74 20 69 6e 66 6f 20 61 6e 64 20 0a 3b 3b ost info and .;;
70b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70f0: 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 ======..(if (arg
7100: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 s:get-arg "-exec
7110: 75 74 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e ute"). (begin
7120: 0a 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 65 . (launch:e
7130: 78 65 63 75 74 65 20 28 61 72 67 73 3a 67 65 74 xecute (args:get
7140: 2d 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 -arg "-execute")
7150: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
7160: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
7170: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
7180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
71c0: 54 65 73 74 20 63 6f 6d 6d 61 6e 64 73 20 28 69 Test commands (i
71d0: 2e 65 2e 20 66 6f 72 20 75 73 65 20 69 6e 73 69 .e. for use insi
71e0: 64 65 20 74 65 73 74 73 29 0a 3b 3b 3d 3d 3d 3d de tests).;;====
71f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7230: 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 6d 65 67 ==..(define (meg
7240: 61 74 65 73 74 3a 73 74 65 70 20 73 74 65 70 20 atest:step step
7250: 73 74 61 74 65 20 73 74 61 74 75 73 20 6c 6f 67 state status log
7260: 66 69 6c 65 20 6d 73 67 29 0a 20 20 28 69 66 20 file msg). (if
7270: 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 4d 54 (not (getenv "MT
7280: 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 20 20 20 20 _CMDINFO")).
7290: 20 20 28 62 65 67 69 6e 0a 09 28 64 65 62 75 67 (begin..(debug
72a0: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
72b0: 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 MT_CMDINFO env
72c0: 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 2d 73 74 var not set, -st
72d0: 65 70 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 ep must be calle
72e0: 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 d *inside* a meg
72f0: 61 74 65 73 74 20 69 6e 76 6f 6b 65 64 20 65 6e atest invoked en
7300: 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 28 65 vironment!")..(e
7310: 78 69 74 20 35 29 29 0a 20 20 20 20 20 20 28 6c xit 5)). (l
7320: 65 74 2a 20 28 28 63 6d 64 69 6e 66 6f 20 20 20 et* ((cmdinfo
7330: 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 (read (open-inpu
7340: 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 34 t-string (base64
7350: 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 28 :base64-decode (
7360: 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e getenv "MT_CMDIN
7370: 46 4f 22 29 29 29 29 29 0a 09 20 20 20 20 20 3b FO"))))).. ;
7380: 3b 20 28 72 75 6e 72 65 6d 6f 74 65 20 28 61 73 ; (runremote (as
7390: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
73a0: 72 65 6d 6f 74 65 20 63 6d 64 69 6e 66 6f 29 29 remote cmdinfo))
73b0: 0a 09 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 .. (transpor
73c0: 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
73d0: 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 'transport cmdi
73e0: 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 73 nfo)).. (tes
73f0: 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 tpath (assoc/de
7400: 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 fault 'testpath
7410: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
7420: 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 (test-name (ass
7430: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
7440: 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a -name cmdinfo)).
7450: 09 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 . (runscript
7460: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
7470: 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 'runscript cmdin
7480: 66 6f 29 29 0a 09 20 20 20 20 20 28 64 62 2d 68 fo)).. (db-h
7490: 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 ost (assoc/def
74a0: 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 ault 'db-host
74b0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
74c0: 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f (run-id (asso
74d0: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 c/default 'run-i
74e0: 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 d cmdinfo))..
74f0: 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 20 20 (test-id
7500: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
7510: 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 test-id cmdinf
7520: 6f 29 29 0a 09 20 20 20 20 20 28 69 74 65 6d 64 o)).. (itemd
7530: 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 at (assoc/defa
7540: 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 ult 'itemdat c
7550: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 mdinfo)).. (
7560: 64 62 20 20 20 20 20 20 20 20 23 66 29 29 0a 09 db #f))..
7570: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
7580: 79 20 74 65 73 74 70 61 74 68 29 0a 09 3b 3b 20 y testpath)..;;
7590: 28 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f 74 65 (set! *runremote
75a0: 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 28 73 * runremote)..(s
75b0: 65 74 21 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 et! *transport-t
75c0: 79 70 65 2a 20 28 73 74 72 69 6e 67 2d 3e 73 79 ype* (string->sy
75d0: 6d 62 6f 6c 20 74 72 61 6e 73 70 6f 72 74 29 29 mbol transport))
75e0: 0a 09 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 ..(if (not (setu
75f0: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 p-for-run))..
7600: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 (begin.. (
7610: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 debug:print 0 "F
7620: 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 ailed to setup,
7630: 65 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 exiting")..
7640: 20 28 65 78 69 74 20 31 29 29 29 0a 09 28 69 66 (exit 1)))..(if
7650: 20 28 61 6e 64 20 73 74 61 74 65 20 73 74 61 74 (and state stat
7660: 75 73 29 0a 09 20 20 20 20 3b 3b 20 44 4f 20 4e us).. ;; DO N
7670: 4f 54 20 72 65 6d 6f 74 65 20 72 75 6e 0a 09 20 OT remote run..
7680: 20 20 20 28 64 62 3a 74 65 73 74 73 74 65 70 2d (db:teststep-
7690: 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 set-status! db t
76a0: 65 73 74 2d 69 64 20 73 74 65 70 20 73 74 61 74 est-id step stat
76b0: 65 20 73 74 61 74 75 73 20 6d 73 67 20 6c 6f 67 e status msg log
76c0: 66 69 6c 65 29 0a 09 20 20 20 20 28 62 65 67 69 file).. (begi
76d0: 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a n.. (debug:
76e0: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
76f0: 59 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 You must specify
7700: 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 :state and :sta
7710: 74 75 73 20 77 69 74 68 20 65 76 65 72 79 20 63 tus with every c
7720: 61 6c 6c 20 74 6f 20 2d 73 74 65 70 22 29 0a 09 all to -step")..
7730: 20 20 20 20 20 20 28 65 78 69 74 20 36 29 29 29 (exit 6)))
7740: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
7750: 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a et-arg "-step").
7760: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
7770: 20 28 6d 65 67 61 74 65 73 74 3a 73 74 65 70 20 (megatest:step
7780: 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 . (args:ge
7790: 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a 20 t-arg "-step").
77a0: 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
77b0: 61 72 67 20 22 3a 73 74 61 74 65 22 29 0a 20 20 arg ":state").
77c0: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
77d0: 72 67 20 22 3a 73 74 61 74 75 73 22 29 0a 20 20 rg ":status").
77e0: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
77f0: 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a 20 20 rg "-setlog").
7800: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
7810: 72 67 20 22 2d 6d 22 29 29 0a 20 20 20 20 20 20 rg "-m")).
7820: 3b 3b 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 ;; (if db (sqlit
7830: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
7840: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
7850: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
7860: 29 29 0a 20 20 20 20 0a 28 69 66 20 28 6f 72 20 )). .(if (or
7870: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7880: 73 65 74 6c 6f 67 22 29 20 20 20 20 20 20 20 3b setlog") ;
7890: 3b 20 73 69 6e 63 65 20 73 65 74 74 69 6e 67 20 ; since setting
78a0: 75 70 20 69 73 20 73 6f 20 63 6f 73 74 6c 79 20 up is so costly
78b0: 6c 65 74 73 20 70 69 67 67 79 62 61 63 6b 20 6f lets piggyback o
78c0: 6e 20 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 09 n -test-status..
78d0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
78e0: 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 28 61 set-toplog")..(a
78f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
7900: 73 74 2d 73 74 61 74 75 73 22 29 0a 09 28 61 72 st-status")..(ar
7910: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
7920: 2d 76 61 6c 75 65 73 22 29 0a 09 28 61 72 67 73 -values")..(args
7930: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d :get-arg "-load-
7940: 74 65 73 74 2d 64 61 74 61 22 29 0a 09 28 61 72 test-data")..(ar
7950: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
7960: 73 74 65 70 22 29 0a 09 28 61 72 67 73 3a 67 65 step")..(args:ge
7970: 74 2d 61 72 67 20 22 2d 73 75 6d 6d 61 72 69 7a t-arg "-summariz
7980: 65 2d 69 74 65 6d 73 22 29 29 0a 20 20 20 20 28 e-items")). (
7990: 69 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 if (not (getenv
79a0: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 "MT_CMDINFO"))..
79b0: 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 (begin.. (debug
79c0: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
79d0: 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 MT_CMDINFO env
79e0: 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 63 6f 6d var not set, com
79f0: 6d 61 6e 64 73 20 2d 74 65 73 74 2d 73 74 61 74 mands -test-stat
7a00: 75 73 2c 20 2d 72 75 6e 73 74 65 70 20 61 6e 64 us, -runstep and
7a10: 20 2d 73 65 74 6c 6f 67 20 6d 75 73 74 20 62 65 -setlog must be
7a20: 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a called *inside*
7a30: 20 61 20 6d 65 67 61 74 65 73 74 20 65 6e 76 69 a megatest envi
7a40: 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 20 20 28 65 ronment!").. (e
7a50: 78 69 74 20 35 29 29 0a 09 28 6c 65 74 2a 20 28 xit 5))..(let* (
7a60: 28 73 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 (startingdir (cu
7a70: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
7a80: 29 0a 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e ).. (cmdin
7a90: 66 6f 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e fo (read (open
7aa0: 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 -input-string (b
7ab0: 61 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 ase64:base64-dec
7ac0: 6f 64 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f ode (getenv "MT_
7ad0: 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 CMDINFO")))))..
7ae0: 20 20 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 6d ;; (runrem
7af0: 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ote (assoc/defau
7b00: 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 6d lt 'runremote cm
7b10: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
7b20: 28 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f (transport (asso
7b30: 63 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 c/default 'trans
7b40: 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 port cmdinfo))..
7b50: 20 20 20 20 20 20 20 28 74 65 73 74 70 61 74 68 (testpath
7b60: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
7b70: 20 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 'testpath cmdi
7b80: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
7b90: 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f est-name (assoc/
7ba0: 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 default 'test-na
7bb0: 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 me cmdinfo))..
7bc0: 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 (runscript
7bd0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
7be0: 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 runscript cmdinf
7bf0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d o)).. (db-
7c00: 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 host (assoc/de
7c10: 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 fault 'db-host
7c20: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
7c30: 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 (run-id (a
7c40: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
7c50: 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 n-id cmdinfo)
7c60: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d ).. (test-
7c70: 69 64 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 id (assoc/defa
7c80: 75 6c 74 20 27 74 65 73 74 2d 69 64 20 20 20 63 ult 'test-id c
7c90: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
7ca0: 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 (itemdat (ass
7cb0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d oc/default 'item
7cc0: 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a dat cmdinfo)).
7cd0: 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 20 . (db
7ce0: 20 20 20 23 66 29 20 3b 3b 20 28 6f 70 65 6e 2d #f) ;; (open-
7cf0: 64 62 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 db)).. (st
7d00: 61 74 65 20 20 20 20 20 28 61 72 67 73 3a 67 65 ate (args:ge
7d10: 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 t-arg ":state"))
7d20: 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 .. (status
7d30: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
7d40: 67 20 22 3a 73 74 61 74 75 73 22 29 29 29 0a 09 g ":status")))..
7d50: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
7d60: 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 20 ory testpath)..
7d70: 20 3b 3b 20 28 73 65 74 21 20 2a 72 75 6e 72 65 ;; (set! *runre
7d80: 6d 6f 74 65 2a 20 72 75 6e 72 65 6d 6f 74 65 29 mote* runremote)
7d90: 0a 09 20 20 28 73 65 74 21 20 2a 74 72 61 6e 73 .. (set! *trans
7da0: 70 6f 72 74 2d 74 79 70 65 2a 20 28 73 74 72 69 port-type* (stri
7db0: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 6e 73 ng->symbol trans
7dc0: 70 6f 72 74 29 29 0a 09 20 20 28 69 66 20 28 6e port)).. (if (n
7dd0: 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 ot (setup-for-ru
7de0: 6e 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 n)).. (begi
7df0: 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 n...(debug:print
7e00: 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 0 "Failed to se
7e10: 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 tup, exiting")..
7e20: 09 28 65 78 69 74 20 31 29 29 29 0a 0a 09 20 20 .(exit 1)))...
7e30: 3b 3b 20 63 61 6e 20 73 65 74 75 70 20 61 73 20 ;; can setup as
7e40: 63 6c 69 65 6e 74 20 66 6f 72 20 73 65 72 76 65 client for serve
7e50: 72 20 6d 6f 64 65 20 6e 6f 77 0a 09 20 20 3b 3b r mode now.. ;;
7e60: 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 70 29 0a (client:setup).
7e70: 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 .. (if (args:ge
7e80: 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 t-arg "-load-tes
7e90: 74 2d 64 61 74 61 22 29 0a 09 20 20 20 20 20 20 t-data")..
7ea0: 3b 3b 20 68 61 73 20 73 75 62 20 63 6f 6d 6d 61 ;; has sub comma
7eb0: 6e 64 73 20 74 68 61 74 20 61 72 65 20 72 64 62 nds that are rdb
7ec0: 3a 0a 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e :.. ;; DO N
7ed0: 4f 54 20 70 75 74 20 74 68 69 73 20 6f 6e 65 20 OT put this one
7ee0: 69 6e 74 6f 20 65 69 74 68 65 72 20 63 64 62 3a into either cdb:
7ef0: 72 65 6d 6f 74 65 2d 72 75 6e 20 6f 72 20 6f 70 remote-run or op
7f00: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 0a 09 20 20 en-run-close..
7f10: 20 20 20 20 28 64 62 3a 6c 6f 61 64 2d 74 65 73 (db:load-tes
7f20: 74 2d 64 61 74 61 20 64 62 20 74 65 73 74 2d 69 t-data db test-i
7f30: 64 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 d)).. (if (args
7f40: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f :get-arg "-setlo
7f50: 67 22 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 g").. (let
7f60: 28 28 6c 6f 67 66 6e 61 6d 65 20 28 61 72 67 73 ((logfname (args
7f70: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f :get-arg "-setlo
7f80: 67 22 29 29 29 0a 09 09 28 63 64 62 3a 74 65 73 g")))...(cdb:tes
7f90: 74 2d 73 65 74 2d 6c 6f 67 21 20 2a 72 75 6e 72 t-set-log! *runr
7fa0: 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 20 6c emote* test-id l
7fb0: 6f 67 66 6e 61 6d 65 29 29 29 0a 09 20 20 28 69 ogfname))).. (i
7fc0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
7fd0: 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 "-set-toplog")..
7fe0: 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 ;; DO NOT
7ff0: 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 20 run remote..
8000: 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 (tests:test-se
8010: 74 2d 74 6f 70 6c 6f 67 21 20 64 62 20 72 75 6e t-toplog! db run
8020: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 28 61 -id test-name (a
8030: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
8040: 74 2d 74 6f 70 6c 6f 67 22 29 29 29 0a 09 20 20 t-toplog")))..
8050: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
8060: 67 20 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 g "-summarize-it
8070: 65 6d 73 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 ems").. ;;
8080: 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 DO NOT run remot
8090: 65 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 3a e.. (tests:
80a0: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 summarize-items
80b0: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
80c0: 61 6d 65 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 ame #t)) ;; do f
80d0: 6f 72 63 65 20 68 65 72 65 0a 09 20 20 28 69 66 orce here.. (if
80e0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
80f0: 2d 72 75 6e 73 74 65 70 22 29 0a 09 20 20 20 20 -runstep")..
8100: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d (if (null? rem
8110: 61 72 67 73 29 0a 09 09 20 20 28 62 65 67 69 6e args)... (begin
8120: 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
8130: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 6e 6f int 0 "ERROR: no
8140: 74 68 69 6e 67 20 73 70 65 63 69 66 69 65 64 20 thing specified
8150: 74 6f 20 72 75 6e 21 22 29 0a 09 09 20 20 20 20 to run!")...
8160: 28 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 3a (if db (sqlite3:
8170: 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 finalize! db))..
8180: 09 20 20 20 20 28 65 78 69 74 20 36 29 29 0a 09 . (exit 6))..
8190: 09 20 20 28 6c 65 74 2a 20 28 28 73 74 65 70 6e . (let* ((stepn
81a0: 61 6d 65 20 20 20 28 61 72 67 73 3a 67 65 74 2d ame (args:get-
81b0: 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 29 arg "-runstep"))
81c0: 0a 09 09 09 20 28 6c 6f 67 70 72 6f 66 69 6c 65 .... (logprofile
81d0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
81e0: 2d 6c 6f 67 70 72 6f 22 29 29 0a 09 09 09 20 28 -logpro")).... (
81f0: 6c 6f 67 66 69 6c 65 20 20 20 20 28 63 6f 6e 63 logfile (conc
8200: 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 stepname ".log"
8210: 29 29 0a 09 09 09 20 28 63 6d 64 20 20 20 20 20 )).... (cmd
8220: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 (if (null? re
8230: 6d 61 72 67 73 29 20 23 66 20 28 63 61 72 20 72 margs) #f (car r
8240: 65 6d 61 72 67 73 29 29 29 0a 09 09 09 20 28 70 emargs))).... (p
8250: 61 72 61 6d 73 20 20 20 20 20 28 69 66 20 63 6d arams (if cm
8260: 64 20 28 63 64 72 20 72 65 6d 61 72 67 73 29 20 d (cdr remargs)
8270: 27 28 29 29 29 0a 09 09 09 20 28 65 78 69 74 73 '())).... (exits
8280: 74 61 74 20 20 20 23 66 29 0a 09 09 09 20 28 73 tat #f).... (s
8290: 68 65 6c 6c 20 20 20 20 20 20 28 6c 61 73 74 20 hell (last
82a0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 67 (string-split (g
82b0: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
82c0: 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 ariable "SHELL")
82d0: 20 22 2f 22 29 29 29 0a 09 09 09 20 28 72 65 64 "/"))).... (red
82e0: 69 72 20 20 20 20 20 20 28 63 61 73 65 20 28 73 ir (case (s
82f0: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 68 tring->symbol sh
8300: 65 6c 6c 29 0a 09 09 09 09 20 20 20 20 20 20 20 ell).....
8310: 28 28 74 63 73 68 20 63 73 68 20 6b 73 68 29 20 ((tcsh csh ksh)
8320: 20 20 20 22 3e 26 22 29 0a 09 09 09 09 20 20 20 ">&").....
8330: 20 20 20 20 28 28 7a 73 68 20 62 61 73 68 20 73 ((zsh bash s
8340: 68 20 61 73 68 29 20 22 32 3e 26 31 20 3e 22 29 h ash) "2>&1 >")
8350: 0a 09 09 09 09 20 20 20 20 20 20 20 28 65 6c 73 ..... (els
8360: 65 20 22 3e 26 22 29 29 29 0a 09 09 09 20 28 66 e ">&"))).... (f
8370: 75 6c 6c 63 6d 64 20 20 20 20 28 63 6f 6e 63 20 ullcmd (conc
8380: 22 28 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 "(" (string-inte
8390: 72 73 70 65 72 73 65 20 0a 09 09 09 09 09 09 28 rsperse .......(
83a0: 63 6f 6e 73 20 63 6d 64 20 70 61 72 61 6d 73 29 cons cmd params)
83b0: 20 22 20 22 29 0a 09 09 09 09 09 20 20 20 22 29 " ")...... ")
83c0: 20 22 20 72 65 64 69 72 20 22 20 22 20 6c 6f 67 " redir " " log
83d0: 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 3b 3b file)))... ;;
83e0: 20 6d 61 72 6b 20 74 68 65 20 73 74 61 72 74 20 mark the start
83f0: 6f 66 20 74 68 65 20 74 65 73 74 0a 09 09 20 20 of the test...
8400: 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 ;; DO NOT run
8410: 72 65 6d 6f 74 65 0a 09 09 20 20 20 20 28 64 62 remote... (db
8420: 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 :teststep-set-st
8430: 61 74 75 73 21 20 64 62 20 74 65 73 74 2d 69 64 atus! db test-id
8440: 20 73 74 65 70 6e 61 6d 65 20 22 73 74 61 72 74 stepname "start
8450: 22 20 22 6e 2f 61 22 20 28 61 72 67 73 3a 67 65 " "n/a" (args:ge
8460: 74 2d 61 72 67 20 22 2d 6d 22 29 20 6c 6f 67 66 t-arg "-m") logf
8470: 69 6c 65 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 ile)... ;; ru
8480: 6e 20 74 68 65 20 74 65 73 74 20 73 74 65 70 0a n the test step.
8490: 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
84a0: 6e 74 2d 69 6e 66 6f 20 32 20 22 52 75 6e 6e 69 nt-info 2 "Runni
84b0: 6e 67 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 ng \"" fullcmd "
84c0: 5c 22 22 29 0a 09 09 20 20 20 20 28 63 68 61 6e \"")... (chan
84d0: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 ge-directory sta
84e0: 72 74 69 6e 67 64 69 72 29 0a 09 09 20 20 20 20 rtingdir)...
84f0: 28 73 65 74 21 20 65 78 69 74 73 74 61 74 20 28 (set! exitstat (
8500: 73 79 73 74 65 6d 20 66 75 6c 6c 63 6d 64 29 29 system fullcmd))
8510: 20 3b 3b 20 63 6d 64 20 70 61 72 61 6d 73 29 29 ;; cmd params))
8520: 0a 09 09 20 20 20 20 28 73 65 74 21 20 2a 67 6c ... (set! *gl
8530: 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 obalexitstatus*
8540: 65 78 69 74 73 74 61 74 29 0a 09 09 20 20 20 20 exitstat)...
8550: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
8560: 79 20 74 65 73 74 70 61 74 68 29 0a 09 09 20 20 y testpath)...
8570: 20 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 ;; run logpro
8580: 69 66 20 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b if applicable ;;
8590: 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c (process-run "l
85a0: 73 22 20 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20 s" (list "/foo"
85b0: 22 32 3e 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67 "2>&1" "blah.log
85c0: 22 29 29 0a 09 09 20 20 20 20 28 69 66 20 6c 6f "))... (if lo
85d0: 67 70 72 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74 gprofile....(let
85e0: 2a 20 28 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 * ((htmllogfile
85f0: 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 (conc stepname "
8600: 2e 68 74 6d 6c 22 29 29 0a 09 09 09 20 20 20 20 .html"))....
8610: 20 20 20 28 6f 6c 64 65 78 69 74 73 74 61 74 20 (oldexitstat
8620: 65 78 69 74 73 74 61 74 29 0a 09 09 09 20 20 20 exitstat)....
8630: 20 20 20 20 28 63 6d 64 20 20 20 20 20 20 20 20 (cmd
8640: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
8650: 65 72 73 65 20 28 6c 69 73 74 20 22 6c 6f 67 70 erse (list "logp
8660: 72 6f 22 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68 ro" logprofile h
8670: 74 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c tmllogfile "<" l
8680: 6f 67 66 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63 ogfile ">" (conc
8690: 20 73 74 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70 stepname "_logp
86a0: 72 6f 2e 6c 6f 67 22 29 29 20 22 20 22 29 29 29 ro.log")) " ")))
86b0: 0a 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 .... (debug:pri
86c0: 6e 74 2d 69 6e 66 6f 20 32 20 22 72 75 6e 6e 69 nt-info 2 "runni
86d0: 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 29 ng \"" cmd "\"")
86e0: 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 .... (change-di
86f0: 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 rectory starting
8700: 64 69 72 29 0a 09 09 09 20 20 28 73 65 74 21 20 dir).... (set!
8710: 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65 6d exitstat (system
8720: 20 63 6d 64 29 29 0a 09 09 09 20 20 28 73 65 74 cmd)).... (set
8730: 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 ! *globalexitsta
8740: 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 20 3b tus* exitstat) ;
8750: 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 0a 09 ; no necessary..
8760: 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 .. (change-dire
8770: 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a ctory testpath).
8780: 09 09 09 20 20 28 63 64 62 3a 74 65 73 74 2d 73 ... (cdb:test-s
8790: 65 74 2d 6c 6f 67 21 20 2a 72 75 6e 72 65 6d 6f et-log! *runremo
87a0: 74 65 2a 20 74 65 73 74 2d 69 64 20 68 74 6d 6c te* test-id html
87b0: 6c 6f 67 66 69 6c 65 29 29 29 0a 09 09 20 20 20 logfile)))...
87c0: 20 28 6c 65 74 20 28 28 6d 73 67 20 28 61 72 67 (let ((msg (arg
87d0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 s:get-arg "-m"))
87e0: 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 )... ;; DO
87f0: 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 NOT run remote..
8800: 09 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 73 . (db:tests
8810: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 tep-set-status!
8820: 64 62 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e db test-id stepn
8830: 61 6d 65 20 22 65 6e 64 22 20 65 78 69 74 73 74 ame "end" exitst
8840: 61 74 20 6d 73 67 20 6c 6f 67 66 69 6c 65 29 29 at msg logfile))
8850: 0a 09 09 20 20 20 20 29 29 29 0a 09 20 20 28 69 ... ))).. (i
8860: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
8870: 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 arg "-test-statu
8880: 73 22 29 0a 09 09 20 20 28 61 72 67 73 3a 67 65 s")... (args:ge
8890: 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 t-arg "-set-valu
88a0: 65 73 22 29 29 0a 09 20 20 20 20 20 20 28 6c 65 es")).. (le
88b0: 74 20 28 28 6e 65 77 73 74 61 74 75 73 20 28 63 t ((newstatus (c
88c0: 6f 6e 64 0a 09 09 09 09 28 28 6e 75 6d 62 65 72 ond.....((number
88d0: 3f 20 73 74 61 74 75 73 29 20 20 20 20 20 20 20 ? status)
88e0: 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 (if (equal? stat
88f0: 75 73 20 30 29 20 22 50 41 53 53 22 20 22 46 41 us 0) "PASS" "FA
8900: 49 4c 22 29 29 0a 09 09 09 09 28 28 61 6e 64 20 IL")).....((and
8910: 28 73 74 72 69 6e 67 3f 20 73 74 61 74 75 73 29 (string? status)
8920: 0a 09 09 09 09 20 20 20 20 20 20 28 73 74 72 69 ..... (stri
8930: 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 ng->number statu
8940: 73 29 29 28 69 66 20 28 65 71 75 61 6c 3f 20 28 s))(if (equal? (
8950: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 string->number s
8960: 74 61 74 75 73 29 20 30 29 20 22 50 41 53 53 22 tatus) 0) "PASS"
8970: 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 65 "FAIL")).....(e
8980: 6c 73 65 20 73 74 61 74 75 73 29 29 29 0a 09 09 lse status)))...
8990: 20 20 20 20 3b 3b 20 74 72 61 6e 73 66 65 72 20 ;; transfer
89a0: 72 65 6c 65 76 61 6e 74 20 6b 65 79 73 20 69 6e relevant keys in
89b0: 74 6f 20 61 20 68 61 73 68 20 74 6f 20 62 65 20 to a hash to be
89c0: 70 61 73 73 65 64 20 74 6f 20 74 65 73 74 2d 73 passed to test-s
89d0: 65 74 2d 73 74 61 74 75 73 21 0a 09 09 20 20 20 et-status!...
89e0: 20 3b 3b 20 63 6f 75 6c 64 20 75 73 65 20 61 6e ;; could use an
89f0: 20 61 73 73 6f 63 20 6c 69 73 74 20 49 20 67 75 assoc list I gu
8a00: 65 73 73 2e 20 0a 09 09 20 20 20 20 28 6f 74 68 ess. ... (oth
8a10: 65 72 64 61 74 61 20 28 6c 65 74 20 28 28 72 65 erdata (let ((re
8a20: 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 s (make-hash-tab
8a30: 6c 65 29 29 29 0a 09 09 09 09 20 28 66 6f 72 2d le)))..... (for-
8a40: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 each (lambda (ke
8a50: 79 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 y)...... (if
8a60: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 6b (args:get-arg k
8a70: 65 79 29 0a 09 09 09 09 09 09 20 28 68 61 73 68 ey)....... (hash
8a80: 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 -table-set! res
8a90: 6b 65 79 20 28 61 72 67 73 3a 67 65 74 2d 61 72 key (args:get-ar
8aa0: 67 20 6b 65 79 29 29 29 29 0a 09 09 09 09 09 20 g key))))......
8ab0: 20 20 28 6c 69 73 74 20 22 3a 76 61 6c 75 65 22 (list ":value"
8ac0: 20 22 3a 74 6f 6c 22 20 22 3a 65 78 70 65 63 74 ":tol" ":expect
8ad0: 65 64 22 20 22 3a 66 69 72 73 74 5f 65 72 72 22 ed" ":first_err"
8ae0: 20 22 3a 66 69 72 73 74 5f 77 61 72 6e 22 20 22 ":first_warn" "
8af0: 3a 75 6e 69 74 73 22 20 22 3a 63 61 74 65 67 6f :units" ":catego
8b00: 72 79 22 20 22 3a 76 61 72 69 61 62 6c 65 22 29 ry" ":variable")
8b10: 29 0a 09 09 09 09 20 72 65 73 29 29 29 0a 09 09 )..... res)))...
8b20: 28 69 66 20 28 61 6e 64 20 28 61 72 67 73 3a 67 (if (and (args:g
8b30: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 et-arg "-test-st
8b40: 61 74 75 73 22 29 0a 09 09 09 20 28 6f 72 20 28 atus").... (or (
8b50: 6e 6f 74 20 73 74 61 74 65 29 0a 09 09 09 20 20 not state)....
8b60: 20 20 20 28 6e 6f 74 20 73 74 61 74 75 73 29 29 (not status))
8b70: 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 )... (begin..
8b80: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
8b90: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 59 6f int 0 "ERROR: Yo
8ba0: 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 3a u must specify :
8bb0: 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 state and :statu
8bc0: 73 20 77 69 74 68 20 65 76 65 72 79 20 63 61 6c s with every cal
8bd0: 6c 20 74 6f 20 2d 74 65 73 74 2d 73 74 61 74 75 l to -test-statu
8be0: 73 5c 6e 22 20 68 65 6c 70 29 0a 09 09 20 20 20 s\n" help)...
8bf0: 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 ;; (sqlite3:f
8c00: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 20 inalize! db)...
8c10: 20 20 20 20 20 28 65 78 69 74 20 36 29 29 29 0a (exit 6))).
8c20: 09 09 28 6c 65 74 2a 20 28 28 6d 73 67 20 20 20 ..(let* ((msg
8c30: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8c40: 2d 6d 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 -m"))... (
8c50: 6e 75 6d 6f 74 68 20 28 6c 65 6e 67 74 68 20 28 numoth (length (
8c60: 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 hash-table-keys
8c70: 6f 74 68 65 72 64 61 74 61 29 29 29 29 0a 09 09 otherdata))))...
8c80: 20 20 3b 3b 20 43 6f 6e 76 65 72 74 20 74 6f 20 ;; Convert to
8c90: 72 70 63 20 69 6e 73 69 64 65 20 74 68 65 20 74 rpc inside the t
8ca0: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 ests:test-set-st
8cb0: 61 74 75 73 21 20 63 61 6c 6c 2c 20 6e 6f 74 20 atus! call, not
8cc0: 68 65 72 65 0a 09 09 20 20 28 74 65 73 74 73 3a here... (tests:
8cd0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
8ce0: 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 6e test-id state n
8cf0: 65 77 73 74 61 74 75 73 20 6d 73 67 20 6f 74 68 ewstatus msg oth
8d00: 65 72 64 61 74 61 29 29 29 29 0a 09 20 20 28 69 erdata)))).. (i
8d10: 66 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 f db (sqlite3:fi
8d20: 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 20 20 nalize! db))..
8d30: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
8d40: 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 3d ing* #t))))..;;=
8d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8d90: 3d 3d 3d 3d 3d 0a 3b 3b 20 56 61 72 69 6f 75 73 =====.;; Various
8da0: 20 68 65 6c 70 65 72 20 63 6f 6d 6d 61 6e 64 73 helper commands
8db0: 20 63 61 6e 20 67 6f 20 62 65 6c 6f 77 20 68 65 can go below he
8dc0: 72 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d re.;;===========
8dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
8e10: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8e20: 2d 73 68 6f 77 6b 65 79 73 22 29 0a 20 20 20 20 -showkeys").
8e30: 28 6c 65 74 20 28 28 64 62 20 23 66 29 0a 09 20 (let ((db #f)..
8e40: 20 28 6b 65 79 73 20 23 66 29 29 0a 20 20 20 20 (keys #f)).
8e50: 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 (if (not (setu
8e60: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 p-for-run)).. (
8e70: 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 begin.. (debu
8e80: 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 g:print 0 "Faile
8e90: 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit
8ea0: 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 69 74 ing").. (exit
8eb0: 20 31 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 1))). (set
8ec0: 21 20 6b 65 79 73 20 28 63 62 64 3a 72 65 6d 6f ! keys (cbd:remo
8ed0: 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 te-run db:get-ke
8ee0: 79 73 20 64 62 29 29 0a 20 20 20 20 20 20 28 64 ys db)). (d
8ef0: 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 4b 65 ebug:print 1 "Ke
8f00: 79 73 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e ys: " (string-in
8f10: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 6b tersperse (map k
8f20: 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 ey:get-fieldname
8f30: 20 6b 65 79 73 29 20 22 2c 20 22 29 29 0a 20 20 keys) ", ")).
8f40: 20 20 20 20 28 69 66 20 64 62 20 28 73 71 6c 69 (if db (sqli
8f50: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
8f60: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
8f70: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
8f80: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
8f90: 65 74 2d 61 72 67 20 22 2d 67 75 69 22 29 0a 20 et-arg "-gui").
8fa0: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
8fb0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
8fc0: 4c 6f 6f 6b 20 61 74 20 74 68 65 20 64 61 73 68 Look at the dash
8fd0: 62 6f 61 72 64 20 66 6f 72 20 6e 6f 77 22 29 0a board for now").
8fe0: 20 20 20 20 20 20 3b 3b 20 28 6d 65 67 61 74 65 ;; (megate
8ff0: 73 74 2d 67 75 69 29 0a 20 20 20 20 20 20 28 73 st-gui). (s
9000: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
9010: 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
9020: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 rgs:get-arg "-ge
9030: 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 22 n-megatest-area"
9040: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
9050: 20 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 3a 6d (genexample:m
9060: 6b 2d 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 k-megatest.confi
9070: 67 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a g). (set! *
9080: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
9090: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
90a0: 65 74 2d 61 72 67 20 22 2d 67 65 6e 2d 6d 65 67 et-arg "-gen-meg
90b0: 61 74 65 73 74 2d 74 65 73 74 22 29 0a 20 20 20 atest-test").
90c0: 20 28 6c 65 74 20 28 28 74 65 73 74 6e 61 6d 65 (let ((testname
90d0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
90e0: 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 -gen-megatest-te
90f0: 73 74 22 29 29 29 0a 20 20 20 20 20 20 28 67 65 st"))). (ge
9100: 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 nexample:mk-mega
9110: 74 65 73 74 2d 74 65 73 74 20 74 65 73 74 6e 61 test-test testna
9120: 6d 65 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 me). (set!
9130: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
9140: 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
9150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
9190: 3b 20 55 70 64 61 74 65 20 74 68 65 20 64 61 74 ; Update the dat
91a0: 61 62 61 73 65 20 73 63 68 65 6d 61 20 6f 6e 20 abase schema on
91b0: 72 65 71 75 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d request.;;======
91c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
91d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
91e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
91f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9200: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
9210: 61 72 67 20 22 2d 72 65 62 75 69 6c 64 2d 64 62 arg "-rebuild-db
9220: 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
9230: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 (if (not (se
9240: 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 tup-for-run))..
9250: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 (begin.. (de
9260: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 bug:print 0 "Fai
9270: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
9280: 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 iting") .. (e
9290: 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 3b xit 1))). ;
92a0: 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 ; keep this one
92b0: 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 6f 70 65 local. (ope
92c0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 70 61 74 63 n-run-close patc
92d0: 68 2d 64 62 20 23 66 29 0a 20 20 20 20 20 20 28 h-db #f). (
92e0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
92f0: 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d ng* #t)))..;;===
9300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9340: 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 ===.;; Update th
9350: 65 20 74 65 73 74 73 20 6d 65 74 61 20 64 61 74 e tests meta dat
9360: 61 20 66 72 6f 6d 20 74 68 65 20 74 65 73 74 63 a from the testc
9370: 6f 6e 66 69 67 20 66 69 6c 65 73 0a 3b 3b 3d 3d onfig files.;;==
9380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
93a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
93b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
93c0: 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
93d0: 67 65 74 2d 61 72 67 20 22 2d 75 70 64 61 74 65 get-arg "-update
93e0: 2d 6d 65 74 61 22 29 0a 20 20 20 20 28 62 65 67 -meta"). (beg
93f0: 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f in. (if (no
9400: 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e t (setup-for-run
9410: 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 )).. (begin..
9420: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
9430: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
9440: 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 p, exiting") ..
9450: 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))).
9460: 20 20 20 20 3b 3b 20 6e 6f 77 20 63 61 6e 20 66 ;; now can f
9470: 69 6e 64 20 6f 75 72 20 64 62 0a 20 20 20 20 20 ind our db.
9480: 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e ;; keep this on
9490: 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 6f e local. (o
94a0: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 72 75 pen-run-close ru
94b0: 6e 73 3a 75 70 64 61 74 65 2d 61 6c 6c 2d 74 65 ns:update-all-te
94c0: 73 74 5f 6d 65 74 61 20 64 62 29 0a 20 20 20 20 st_meta db).
94d0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
94e0: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
94f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9530: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 ======.;; Start
9540: 61 20 72 65 70 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d a repl.;;=======
9550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
9590: 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 .(if (or (args:g
95a0: 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 29 0a et-arg "-repl").
95b0: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
95c0: 2d 6c 6f 61 64 22 29 29 0a 20 20 20 20 28 6c 65 -load")). (le
95d0: 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 73 65 t* ((toppath (se
95e0: 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 tup-for-run))..
95f0: 20 20 28 64 62 20 20 20 20 20 20 28 69 66 20 74 (db (if t
9600: 6f 70 70 61 74 68 20 28 6f 70 65 6e 2d 64 62 29 oppath (open-db)
9610: 20 23 66 29 29 29 0a 20 20 20 20 20 20 28 69 66 #f))). (if
9620: 20 64 62 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 db.. (begin..
9630: 20 20 20 28 73 65 74 21 20 2a 64 62 2a 20 64 62 (set! *db* db
9640: 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a 63 6c ).. (set! *cl
9650: 69 65 6e 74 2d 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e ient-non-blockin
9660: 67 2d 6d 6f 64 65 2a 20 23 74 29 0a 09 20 20 20 g-mode* #t)..
9670: 20 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 ;; (client:setu
9680: 70 29 0a 09 20 20 20 20 3b 3b 20 28 63 6c 69 65 p).. ;; (clie
9690: 6e 74 3a 6c 61 75 6e 63 68 29 0a 09 20 20 20 20 nt:launch)..
96a0: 28 69 6d 70 6f 72 74 20 72 65 61 64 6c 69 6e 65 (import readline
96b0: 29 0a 09 20 20 20 20 28 69 6d 70 6f 72 74 20 61 ).. (import a
96c0: 70 72 6f 70 6f 73 29 0a 09 20 20 20 20 28 67 6e propos).. (gn
96d0: 75 2d 68 69 73 74 6f 72 79 2d 69 6e 73 74 61 6c u-history-instal
96e0: 6c 2d 66 69 6c 65 2d 6d 61 6e 61 67 65 72 0a 09 l-file-manager..
96f0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 61 70 70 (string-app
9700: 65 6e 64 0a 09 20 20 20 20 20 20 28 6f 72 20 28 end.. (or (
9710: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
9720: 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 variable "HOME")
9730: 20 22 2e 22 29 20 22 2f 2e 6d 65 67 61 74 65 73 ".") "/.megates
9740: 74 5f 68 69 73 74 6f 72 79 22 29 29 0a 09 20 20 t_history"))..
9750: 20 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 (current-input
9760: 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 67 6e 75 2d -port (make-gnu-
9770: 72 65 61 64 6c 69 6e 65 2d 70 6f 72 74 20 22 6d readline-port "m
9780: 65 67 61 74 65 73 74 3e 20 22 29 29 0a 09 20 20 egatest> "))..
9790: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
97a0: 61 72 67 20 22 2d 72 65 70 6c 22 29 0a 09 09 28 arg "-repl")...(
97b0: 72 65 70 6c 29 0a 09 09 28 6c 6f 61 64 20 28 61 repl)...(load (a
97c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
97d0: 61 64 22 29 29 29 29 0a 09 20 20 28 65 78 69 74 ad")))).. (exit
97e0: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
97f0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
9800: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
9810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
9850: 20 45 78 69 74 20 61 6e 64 20 63 6c 65 61 6e 20 Exit and clean
9860: 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d up.;;===========
9870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
98a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
98b0: 74 68 69 73 20 69 73 20 74 68 65 20 73 6f 63 6b this is the sock
98c0: 65 74 20 69 66 20 77 65 20 61 72 65 20 61 20 63 et if we are a c
98d0: 6c 69 65 6e 74 0a 3b 3b 20 28 69 66 20 28 61 6e lient.;; (if (an
98e0: 64 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 0a 3b 3b d *runremote*.;;
98f0: 20 09 20 28 73 6f 63 6b 65 74 3f 20 2a 72 75 6e . (socket? *run
9900: 72 65 6d 6f 74 65 2a 29 29 0a 3b 3b 20 20 20 20 remote*)).;;
9910: 20 28 63 6c 6f 73 65 2d 73 6f 63 6b 65 74 20 2a (close-socket *
9920: 72 75 6e 72 65 6d 6f 74 65 2a 29 29 0a 0a 28 69 runremote*))..(i
9930: 66 20 28 6e 6f 74 20 2a 64 69 64 73 6f 6d 65 74 f (not *didsomet
9940: 68 69 6e 67 2a 29 0a 20 20 20 20 28 64 65 62 75 hing*). (debu
9950: 67 3a 70 72 69 6e 74 20 30 20 68 65 6c 70 29 29 g:print 0 help))
9960: 0a 0a 3b 3b 20 28 69 66 20 2a 72 75 6e 72 65 6d ..;; (if *runrem
9970: 6f 74 65 2a 20 28 72 70 63 3a 63 6c 6f 73 65 2d ote* (rpc:close-
9980: 61 6c 6c 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 21 all-connections!
9990: 29 29 0a 20 20 20 20 0a 28 69 66 20 28 6e 6f 74 )). .(if (not
99a0: 20 28 65 71 3f 20 2a 67 6c 6f 62 61 6c 65 78 69 (eq? *globalexi
99b0: 74 73 74 61 74 75 73 2a 20 30 29 29 0a 20 20 20 tstatus* 0)).
99c0: 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 (if (or (args:g
99d0: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
99e0: 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 s")(args:get-arg
99f0: 20 22 2d 72 75 6e 61 6c 6c 22 29 29 0a 20 20 20 "-runall")).
9a00: 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
9a10: 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
9a20: 69 6e 74 20 30 20 22 4e 4f 54 45 3a 20 53 75 62 int 0 "NOTE: Sub
9a30: 70 72 6f 63 65 73 73 65 73 20 77 69 74 68 20 6e processes with n
9a40: 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 20 63 6f 64 on-zero exit cod
9a50: 65 20 64 65 74 65 63 74 65 64 3a 20 22 20 2a 67 e detected: " *g
9a60: 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
9a70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 78 ). (ex
9a80: 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 28 it 0)). (
9a90: 63 61 73 65 20 2a 67 6c 6f 62 61 6c 65 78 69 74 case *globalexit
9aa0: 73 74 61 74 75 73 2a 0a 20 20 20 20 20 20 20 20 status*.
9ab0: 20 28 28 30 29 28 65 78 69 74 20 30 29 29 0a 20 ((0)(exit 0)).
9ac0: 20 20 20 20 20 20 20 20 28 28 31 29 28 65 78 69 ((1)(exi
9ad0: 74 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 28 t 1)). (
9ae0: 28 32 29 28 65 78 69 74 20 32 29 29 0a 20 20 20 (2)(exit 2)).
9af0: 20 20 20 20 20 20 28 65 6c 73 65 20 28 65 78 69 (else (exi
9b00: 74 20 33 29 29 29 29 29 0a t 3))))).