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 28 75 73 65 20 base64:))..(use
0240: 7a 6d 71 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 zmq)..(declare (
0250: 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 uses common)).(d
0260: 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d 65 67 eclare (uses meg
0270: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 29 0a atest-version)).
0280: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
0290: 61 72 67 73 29 29 0a 28 64 65 63 6c 61 72 65 20 args)).(declare
02a0: 28 75 73 65 73 20 72 75 6e 73 29 29 0a 28 64 65 (uses runs)).(de
02b0: 63 6c 61 72 65 20 28 75 73 65 73 20 6c 61 75 6e clare (uses laun
02c0: 63 68 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 ch)).(declare (u
02d0: 73 65 73 20 73 65 72 76 65 72 29 29 0a 28 64 65 ses server)).(de
02e0: 63 6c 61 72 65 20 28 75 73 65 73 20 63 6c 69 65 clare (uses clie
02f0: 6e 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 nt)).(declare (u
0300: 73 65 73 20 74 65 73 74 73 29 29 0a 28 64 65 63 ses tests)).(dec
0310: 6c 61 72 65 20 28 75 73 65 73 20 67 65 6e 65 78 lare (uses genex
0320: 61 6d 70 6c 65 29 29 0a 0a 28 64 65 66 69 6e 65 ample))..(define
0330: 20 2a 64 62 2a 20 23 66 29 20 3b 3b 20 74 68 69 *db* #f) ;; thi
0340: 73 20 69 73 20 6f 6e 6c 79 20 66 6f 72 20 74 68 s is only for th
0350: 65 20 72 65 70 6c 2c 20 64 6f 20 6e 6f 74 20 75 e repl, do not u
0360: 73 65 20 69 6e 20 67 65 6e 65 72 61 6c 21 21 21 se in general!!!
0370: 21 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d !..(include "com
0380: 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 mon_records.scm"
0390: 29 0a 28 69 6e 63 6c 75 64 65 20 22 6b 65 79 5f ).(include "key_
03a0: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 records.scm").(i
03b0: 6e 63 6c 75 64 65 20 22 64 62 5f 72 65 63 6f 72 nclude "db_recor
03c0: 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 ds.scm").(includ
03d0: 65 20 22 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 e "megatest-foss
03e0: 69 6c 2d 68 61 73 68 2e 73 63 6d 22 29 0a 0a 3b il-hash.scm")..;
03f0: 3b 20 28 75 73 65 20 74 72 61 63 65 20 64 6f 74 ; (use trace dot
0400: 2d 6c 6f 63 6b 69 6e 67 29 0a 3b 3b 20 28 74 72 -locking).;; (tr
0410: 61 63 65 0a 3b 3b 20 20 63 64 62 3a 63 6c 69 65 ace.;; cdb:clie
0420: 6e 74 2d 63 61 6c 6c 0a 3b 3b 20 20 63 64 62 3a nt-call.;; cdb:
0430: 72 65 6d 6f 74 65 2d 72 75 6e 0a 3b 3b 20 20 63 remote-run.;; c
0440: 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 db:test-set-stat
0450: 75 73 2d 73 74 61 74 65 0a 3b 3b 20 20 63 68 61 us-state.;; cha
0460: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 0a 3b 3b nge-directory.;;
0470: 20 20 64 62 3a 70 72 6f 63 65 73 73 2d 71 75 65 db:process-que
0480: 75 65 2d 69 74 65 6d 0a 3b 3b 20 20 64 62 3a 74 ue-item.;; db:t
0490: 65 73 74 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 2d est-get-logfile-
04a0: 69 6e 66 6f 0a 3b 3b 20 20 64 62 3a 74 65 73 74 info.;; db:test
04b0: 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
04c0: 0a 3b 3b 20 20 6e 69 63 65 2d 70 61 74 68 0a 3b .;; nice-path.;
04d0: 3b 20 20 6f 62 74 61 69 6e 2d 64 6f 74 2d 6c 6f ; obtain-dot-lo
04e0: 63 6b 0a 3b 3b 20 20 6f 70 65 6e 2d 72 75 6e 2d ck.;; open-run-
04f0: 63 6c 6f 73 65 0a 3b 3b 20 20 72 65 61 64 2d 63 close.;; read-c
0500: 6f 6e 66 69 67 0a 3b 3b 20 20 72 75 6e 73 3a 63 onfig.;; runs:c
0510: 61 6e 2d 72 75 6e 2d 6d 6f 72 65 2d 74 65 73 74 an-run-more-test
0520: 73 0a 3b 3b 20 20 73 71 6c 69 74 65 33 3a 65 78 s.;; sqlite3:ex
0530: 65 63 75 74 65 0a 3b 3b 20 20 73 71 6c 69 74 65 ecute.;; sqlite
0540: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 3b 3:for-each-row.;
0550: 3b 20 20 74 65 73 74 73 3a 63 68 65 63 6b 2d 77 ; tests:check-w
0560: 61 69 76 65 72 2d 65 6c 69 67 69 62 69 6c 69 74 aiver-eligibilit
0570: 79 0a 3b 3b 20 20 74 65 73 74 73 3a 73 75 6d 6d y.;; tests:summ
0580: 61 72 69 7a 65 2d 69 74 65 6d 73 0a 3b 3b 20 20 arize-items.;;
0590: 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 tests:test-set-s
05a0: 74 61 74 75 73 21 0a 3b 3b 20 20 74 68 72 65 61 tatus!.;; threa
05b0: 64 2d 73 6c 65 65 70 21 0a 3b 3b 29 0a 20 20 20 d-sleep!.;;).
05c0: 20 20 20 20 0a 0a 28 64 65 66 69 6e 65 20 68 65 ..(define he
05d0: 6c 70 20 28 63 6f 6e 63 20 22 0a 4d 65 67 61 74 lp (conc ".Megat
05e0: 65 73 74 2c 20 64 6f 63 75 6d 65 6e 74 61 74 69 est, documentati
05f0: 6f 6e 20 61 74 20 68 74 74 70 3a 2f 2f 77 77 77 on at http://www
0600: 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 .kiatoa.com/foss
0610: 69 6c 73 2f 6d 65 67 61 74 65 73 74 0a 20 20 76 ils/megatest. v
0620: 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 ersion " megates
0630: 74 2d 76 65 72 73 69 6f 6e 20 22 0a 20 20 6c 69 t-version ". li
0640: 63 65 6e 73 65 20 47 50 4c 2c 20 43 6f 70 79 72 cense GPL, Copyr
0650: 69 67 68 74 20 4d 61 74 74 20 57 65 6c 6c 61 6e ight Matt Wellan
0660: 64 20 32 30 30 36 2d 32 30 31 32 0a 0a 55 73 61 d 2006-2012..Usa
0670: 67 65 3a 20 6d 65 67 61 74 65 73 74 20 5b 6f 70 ge: megatest [op
0680: 74 69 6f 6e 73 5d 0a 20 20 2d 68 20 20 20 20 20 tions]. -h
0690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
06a0: 20 3a 20 74 68 69 73 20 68 65 6c 70 0a 20 20 2d : this help. -
06b0: 76 65 72 73 69 6f 6e 20 20 20 20 20 20 20 20 20 version
06c0: 20 20 20 20 20 20 20 3a 20 70 72 69 6e 74 20 6d : print m
06d0: 65 67 61 74 65 73 74 20 76 65 72 73 69 6f 6e 20 egatest version
06e0: 28 63 75 72 72 65 6e 74 6c 79 20 22 20 6d 65 67 (currently " meg
06f0: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 29 atest-version ")
0700: 0a 0a 4c 61 75 6e 63 68 69 6e 67 20 61 6e 64 20 ..Launching and
0710: 6d 61 6e 61 67 69 6e 67 20 72 75 6e 73 0a 20 20 managing runs.
0720: 2d 72 75 6e 61 6c 6c 20 20 20 20 20 20 20 20 20 -runall
0730: 20 20 20 20 20 20 20 20 3a 20 72 75 6e 20 61 6c : run al
0740: 6c 20 74 65 73 74 73 20 74 68 61 74 20 61 72 65 l tests that are
0750: 20 6e 6f 74 20 73 74 61 74 65 20 43 4f 4d 50 4c not state COMPL
0760: 45 54 45 44 20 61 6e 64 20 73 74 61 74 75 73 20 ETED and status
0770: 50 41 53 53 2c 20 0a 20 20 20 20 20 20 20 20 20 PASS, .
0780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0790: 20 20 20 43 48 45 43 4b 20 6f 72 20 4b 49 4c 4c CHECK or KILL
07a0: 45 44 0a 20 20 2d 72 75 6e 74 65 73 74 73 20 74 ED. -runtests t
07b0: 73 74 31 2c 74 73 74 32 20 2e 2e 2e 20 3a 20 72 st1,tst2 ... : r
07c0: 75 6e 20 74 65 73 74 73 0a 20 20 2d 72 65 6d 6f un tests. -remo
07d0: 76 65 2d 72 75 6e 73 20 20 20 20 20 20 20 20 20 ve-runs
07e0: 20 20 20 3a 20 72 65 6d 6f 76 65 20 74 68 65 20 : remove the
07f0: 64 61 74 61 20 66 6f 72 20 61 20 72 75 6e 2c 20 data for a run,
0800: 72 65 71 75 69 72 65 73 20 3a 72 75 6e 6e 61 6d requires :runnam
0810: 65 20 61 6e 64 20 2d 74 65 73 74 70 61 74 74 0a e and -testpatt.
0820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0830: 20 20 20 20 20 20 20 20 20 20 20 20 4f 70 74 69 Opti
0840: 6f 6e 61 6c 6c 79 20 75 73 65 20 3a 73 74 61 74 onally use :stat
0850: 65 20 61 6e 64 20 3a 73 74 61 74 75 73 0a 20 20 e and :status.
0860: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
0870: 73 20 58 2c 59 20 20 20 3a 20 73 65 74 20 73 74 s X,Y : set st
0880: 61 74 65 20 74 6f 20 58 20 61 6e 64 20 73 74 61 ate to X and sta
0890: 74 75 73 20 74 6f 20 59 2c 20 72 65 71 75 69 72 tus to Y, requir
08a0: 65 73 20 63 6f 6e 74 72 6f 6c 73 20 70 65 72 20 es controls per
08b0: 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 0a 20 20 2d -remove-runs. -
08c0: 72 65 72 75 6e 20 46 41 49 4c 2c 57 41 52 4e 2e rerun FAIL,WARN.
08d0: 2e 2e 20 20 20 20 20 3a 20 66 6f 72 63 65 20 72 .. : force r
08e0: 65 2d 72 75 6e 20 66 6f 72 20 74 65 73 74 73 20 e-run for tests
08f0: 77 69 74 68 20 73 70 65 63 69 66 69 63 65 64 20 with specificed
0900: 73 74 61 74 75 73 28 73 29 0a 20 20 2d 72 6f 6c status(s). -rol
0910: 6c 75 70 20 20 20 20 20 20 20 20 20 20 20 20 20 lup
0920: 20 20 20 20 3a 20 28 63 75 72 72 65 6e 74 6c 79 : (currently
0930: 20 64 69 73 61 62 6c 65 64 29 20 66 69 6c 6c 20 disabled) fill
0940: 72 75 6e 20 28 73 65 74 20 62 79 20 3a 72 75 6e run (set by :run
0950: 6e 61 6d 65 29 20 20 77 69 74 68 20 6c 61 74 65 name) with late
0960: 73 74 20 74 65 73 74 28 73 29 0a 20 20 20 20 20 st 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 66 72 6f 6d 20 70 72 69 6f from prio
0990: 72 20 72 75 6e 73 20 77 69 74 68 20 73 61 6d 65 r runs with same
09a0: 20 6b 65 79 73 0a 20 20 2d 6c 6f 63 6b 20 20 20 keys. -lock
09b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09c0: 3a 20 6c 6f 63 6b 20 72 75 6e 20 73 70 65 63 69 : lock run speci
09d0: 66 69 65 64 20 62 79 20 74 61 72 67 65 74 20 61 fied by target a
09e0: 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 20 2d 75 6e nd runname. -un
09f0: 6c 6f 63 6b 20 20 20 20 20 20 20 20 20 20 20 20 lock
0a00: 20 20 20 20 20 3a 20 75 6e 6c 6f 63 6b 20 72 75 : unlock ru
0a10: 6e 20 73 70 65 63 69 66 69 65 64 20 62 79 20 74 n specified by t
0a20: 61 72 67 65 74 20 61 6e 64 20 72 75 6e 6e 61 6d arget and runnam
0a30: 65 0a 0a 53 65 6c 65 63 74 6f 72 73 20 28 65 2e e..Selectors (e.
0a40: 67 2e 20 75 73 65 20 66 6f 72 20 2d 72 75 6e 74 g. use for -runt
0a50: 65 73 74 73 2c 20 2d 72 65 6d 6f 76 65 2d 72 75 ests, -remove-ru
0a60: 6e 73 2c 20 2d 73 65 74 2d 73 74 61 74 65 2d 73 ns, -set-state-s
0a70: 74 61 74 75 73 2c 20 2d 6c 69 73 74 2d 72 75 6e tatus, -list-run
0a80: 73 20 65 74 63 2e 29 0a 20 20 2d 74 61 72 67 65 s etc.). -targe
0a90: 74 20 6b 65 79 31 2f 6b 65 79 32 2f 2e 2e 2e 20 t key1/key2/...
0aa0: 20 20 3a 20 72 75 6e 20 66 6f 72 20 6b 65 79 31 : run for key1
0ab0: 2c 20 6b 65 79 32 2c 20 65 74 63 2e 0a 20 20 2d , key2, etc.. -
0ac0: 72 65 71 74 61 72 67 20 6b 65 79 31 2f 6b 65 79 reqtarg key1/key
0ad0: 32 2f 2e 2e 2e 20 20 3a 20 72 75 6e 20 66 6f 72 2/... : run for
0ae0: 20 6b 65 79 31 2c 20 6b 65 79 32 2c 20 65 74 63 key1, key2, etc
0af0: 2e 20 62 75 74 20 6b 65 79 31 2f 6b 65 79 32 20 . but key1/key2
0b00: 6d 75 73 74 20 62 65 20 69 6e 20 72 75 6e 63 6f must be in runco
0b10: 6e 66 69 67 0a 20 20 2d 74 65 73 74 70 61 74 74 nfig. -testpatt
0b20: 20 70 61 74 74 31 2f 70 61 74 74 32 2c 70 61 74 patt1/patt2,pat
0b30: 74 33 2f 2e 2e 2e 20 20 3a 20 25 20 69 73 20 77 t3/... : % is w
0b40: 69 6c 64 63 61 72 64 0a 20 20 3a 72 75 6e 6e 61 ildcard. :runna
0b50: 6d 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 me
0b60: 20 20 3a 20 72 65 71 75 69 72 65 64 2c 20 6e 61 : required, na
0b70: 6d 65 20 66 6f 72 20 74 68 69 73 20 70 61 72 74 me for this part
0b80: 69 63 75 6c 61 72 20 74 65 73 74 20 72 75 6e 0a icular test run.
0b90: 20 20 3a 73 74 61 74 65 20 20 20 20 20 20 20 20 :state
0ba0: 20 20 20 20 20 20 20 20 20 20 3a 20 41 70 70 6c : Appl
0bb0: 69 65 73 20 74 6f 20 72 75 6e 73 2c 20 74 65 73 ies to runs, tes
0bc0: 74 73 20 6f 72 20 73 74 65 70 73 20 64 65 70 65 ts or steps depe
0bd0: 6e 64 69 6e 67 20 6f 6e 20 63 6f 6e 74 65 78 74 nding on context
0be0: 0a 20 20 3a 73 74 61 74 75 73 20 20 20 20 20 20 . :status
0bf0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 41 70 70 : App
0c00: 6c 69 65 73 20 74 6f 20 72 75 6e 73 2c 20 74 65 lies to runs, te
0c10: 73 74 73 20 6f 72 20 73 74 65 70 73 20 64 65 70 sts or steps dep
0c20: 65 6e 64 69 6e 67 20 6f 6e 20 63 6f 6e 74 65 78 ending on contex
0c30: 74 0a 0a 54 65 73 74 20 68 65 6c 70 65 72 73 20 t..Test helpers
0c40: 28 66 6f 72 20 75 73 65 20 69 6e 73 69 64 65 20 (for use inside
0c50: 74 65 73 74 73 29 0a 20 20 2d 73 74 65 70 20 73 tests). -step s
0c60: 74 65 70 6e 61 6d 65 0a 20 20 2d 74 65 73 74 2d tepname. -test-
0c70: 73 74 61 74 75 73 20 20 20 20 20 20 20 20 20 20 status
0c80: 20 20 3a 20 73 65 74 20 74 68 65 20 73 74 61 74 : set the stat
0c90: 65 20 61 6e 64 20 73 74 61 74 75 73 20 6f 66 20 e and status of
0ca0: 61 20 74 65 73 74 20 28 75 73 65 20 3a 73 74 61 a test (use :sta
0cb0: 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 29 0a te and :status).
0cc0: 20 20 2d 73 65 74 6c 6f 67 20 6c 6f 67 66 6e 61 -setlog logfna
0cd0: 6d 65 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 me : set
0ce0: 74 68 65 20 70 61 74 68 2f 66 69 6c 65 6e 61 6d the path/filenam
0cf0: 65 20 74 6f 20 74 68 65 20 66 69 6e 61 6c 20 6c e to the final l
0d00: 6f 67 20 72 65 6c 61 74 69 76 65 20 74 6f 20 74 og relative to t
0d10: 68 65 20 74 65 73 74 0a 20 20 20 20 20 20 20 20 he test.
0d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d30: 20 20 20 20 64 69 72 65 63 74 6f 72 79 2e 20 6d directory. m
0d40: 61 79 20 62 65 20 75 73 65 64 20 77 69 74 68 20 ay be used with
0d50: 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 20 20 2d -test-status. -
0d60: 73 65 74 2d 74 6f 70 6c 6f 67 20 6c 6f 67 66 6e set-toplog logfn
0d70: 61 6d 65 20 20 20 20 3a 20 73 65 74 20 74 68 65 ame : set the
0d80: 20 6f 76 65 72 61 6c 6c 20 6c 6f 67 20 66 6f 72 overall log for
0d90: 20 61 20 73 75 69 74 65 20 6f 66 20 73 75 62 2d a suite of sub-
0da0: 74 65 73 74 73 0a 20 20 2d 73 75 6d 6d 61 72 69 tests. -summari
0db0: 7a 65 2d 69 74 65 6d 73 20 20 20 20 20 20 20 20 ze-items
0dc0: 3a 20 66 6f 72 20 61 6e 20 69 74 65 6d 69 7a 65 : for an itemize
0dd0: 64 20 74 65 73 74 20 63 72 65 61 74 65 20 61 20 d test create a
0de0: 73 75 6d 6d 61 72 79 20 68 74 6d 6c 20 0a 20 20 summary html .
0df0: 2d 6d 20 63 6f 6d 6d 65 6e 74 20 20 20 20 20 20 -m comment
0e00: 20 20 20 20 20 20 20 20 3a 20 69 6e 73 65 72 74 : insert
0e10: 20 61 20 63 6f 6d 6d 65 6e 74 20 66 6f 72 20 74 a comment for t
0e20: 68 69 73 20 74 65 73 74 0a 0a 54 65 73 74 20 64 his test..Test d
0e30: 61 74 61 20 63 61 70 74 75 72 65 0a 20 20 2d 73 ata capture. -s
0e40: 65 74 2d 76 61 6c 75 65 73 20 20 20 20 20 20 20 et-values
0e50: 20 20 20 20 20 20 3a 20 75 70 64 61 74 65 20 6f : update o
0e60: 72 20 73 65 74 20 76 61 6c 75 65 73 20 69 6e 20 r set values in
0e70: 74 68 65 20 74 65 73 74 64 61 74 61 20 74 61 62 the testdata tab
0e80: 6c 65 0a 20 20 3a 63 61 74 65 67 6f 72 79 20 20 le. :category
0e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 : s
0ea0: 65 74 20 74 68 65 20 63 61 74 65 67 6f 72 79 20 et the category
0eb0: 66 69 65 6c 64 20 28 6f 70 74 69 6f 6e 61 6c 29 field (optional)
0ec0: 0a 20 20 3a 76 61 72 69 61 62 6c 65 20 20 20 20 . :variable
0ed0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 : set
0ee0: 20 74 68 65 20 76 61 72 69 61 62 6c 65 20 6e 61 the variable na
0ef0: 6d 65 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 me (optional).
0f00: 3a 76 61 6c 75 65 20 20 20 20 20 20 20 20 20 20 :value
0f10: 20 20 20 20 20 20 20 20 3a 20 76 61 6c 75 65 20 : value
0f20: 6d 65 61 73 75 72 65 64 20 28 72 65 71 75 69 72 measured (requir
0f30: 65 64 29 0a 20 20 3a 65 78 70 65 63 74 65 64 20 ed). :expected
0f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
0f50: 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 20 28 value expected (
0f60: 72 65 71 75 69 72 65 64 29 0a 20 20 3a 74 6f 6c required). :tol
0f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f80: 20 20 20 20 3a 20 7c 76 61 6c 75 65 2d 65 78 70 : |value-exp
0f90: 65 63 74 7c 20 3c 3d 20 74 6f 6c 20 28 72 65 71 ect| <= tol (req
0fa0: 75 69 72 65 64 2c 20 63 61 6e 20 62 65 20 3c 2c uired, can be <,
0fb0: 20 3e 2c 20 3e 3d 2c 20 3c 3d 20 6f 72 20 6e 75 >, >=, <= or nu
0fc0: 6d 62 65 72 29 0a 20 20 3a 75 6e 69 74 73 20 20 mber). :units
0fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fe0: 3a 20 6e 61 6d 65 20 6f 66 20 74 68 65 20 75 6e : name of the un
0ff0: 69 74 73 20 66 6f 72 20 76 61 6c 75 65 2c 20 65 its for value, e
1000: 78 70 65 63 74 65 64 5f 76 61 6c 75 65 20 65 74 xpected_value et
1010: 63 2e 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 c. (optional).
1020: 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 20 -load-test-data
1030: 20 20 20 20 20 20 20 20 3a 20 72 65 61 64 20 74 : read t
1040: 65 73 74 20 73 70 65 63 69 66 69 63 20 64 61 74 est specific dat
1050: 61 20 66 6f 72 20 73 74 6f 72 61 67 65 20 69 6e a for storage in
1060: 20 74 68 65 20 74 65 73 74 5f 64 61 74 61 20 74 the test_data t
1070: 61 62 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 able.
1080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1090: 20 66 72 6f 6d 20 73 74 61 6e 64 61 72 64 20 69 from standard i
10a0: 6e 2e 20 45 61 63 68 20 6c 69 6e 65 20 69 73 20 n. Each line is
10b0: 63 6f 6d 6d 61 20 64 65 6c 69 6d 69 74 65 64 20 comma delimited
10c0: 77 69 74 68 20 66 6f 75 72 0a 20 20 20 20 20 20 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 66 69 65 6c 64 73 20 63 61 74 fields cat
10f0: 65 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c 76 egory,variable,v
1100: 61 6c 75 65 2c 63 6f 6d 6d 65 6e 74 0a 0a 51 75 alue,comment..Qu
1110: 65 72 69 65 73 0a 20 20 2d 6c 69 73 74 2d 72 75 eries. -list-ru
1120: 6e 73 20 70 61 74 74 20 20 20 20 20 20 20 20 20 ns patt
1130: 3a 20 6c 69 73 74 20 72 75 6e 73 20 6d 61 74 63 : list runs matc
1140: 68 69 6e 67 20 70 61 74 74 65 72 6e 20 5c 22 70 hing pattern \"p
1150: 61 74 74 5c 22 2c 20 25 20 69 73 20 74 68 65 20 att\", % is the
1160: 77 69 6c 64 63 61 72 64 0a 20 20 2d 73 68 6f 77 wildcard. -show
1170: 6b 65 79 73 20 20 20 20 20 20 20 20 20 20 20 20 keys
1180: 20 20 20 3a 20 73 68 6f 77 20 74 68 65 20 6b 65 : show the ke
1190: 79 73 20 75 73 65 64 20 69 6e 20 74 68 69 73 20 ys used in this
11a0: 6d 65 67 61 74 65 73 74 20 73 65 74 75 70 0a 20 megatest setup.
11b0: 20 2d 74 65 73 74 2d 66 69 6c 65 73 20 74 61 72 -test-files tar
11c0: 67 70 61 74 74 20 20 20 20 20 3a 20 67 65 74 20 gpatt : get
11d0: 74 68 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 20 the most recent
11e0: 74 65 73 74 20 70 61 74 68 2f 66 69 6c 65 20 6d test path/file m
11f0: 61 74 63 68 69 6e 67 20 74 61 72 67 70 61 74 74 atching targpatt
1200: 20 65 2e 67 2e 20 25 2f 25 2e 2e 2e 20 0a 20 20 e.g. %/%... .
1210: 20 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 72 65 74 75 72 6e return
1230: 73 20 6c 69 73 74 20 73 6f 72 74 65 64 20 62 79 s list sorted by
1240: 20 61 67 65 20 61 73 63 65 6e 64 69 6e 67 2c 20 age ascending,
1250: 73 65 65 20 65 78 61 6d 70 6c 65 73 20 62 65 6c see examples bel
1260: 6f 77 0a 20 20 2d 74 65 73 74 2d 70 61 74 68 73 ow. -test-paths
1270: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 67 : g
1280: 65 74 20 74 68 65 20 74 65 73 74 20 70 61 74 68 et the test path
1290: 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 s matching targe
12a0: 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 69 74 65 6d t, runname, item
12b0: 20 61 6e 64 20 74 65 73 74 0a 20 20 20 20 20 20 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 70 61 74 74 65 72 6e 73 2e 0a patterns..
12e0: 20 20 2d 6c 69 73 74 2d 64 69 73 6b 73 20 20 20 -list-disks
12f0: 20 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 : list
1300: 20 74 68 65 20 64 69 73 6b 73 20 61 76 61 69 6c the disks avail
1310: 61 62 6c 65 20 66 6f 72 20 73 74 6f 72 69 6e 67 able for storing
1320: 20 72 75 6e 73 0a 20 20 2d 6c 69 73 74 2d 74 61 runs. -list-ta
1330: 72 67 65 74 73 20 20 20 20 20 20 20 20 20 20 20 rgets
1340: 3a 20 6c 69 73 74 20 74 68 65 20 74 61 72 67 65 : list the targe
1350: 74 73 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 73 ts in runconfigs
1360: 2e 63 6f 6e 66 69 67 0a 20 20 2d 6c 69 73 74 2d .config. -list-
1370: 64 62 2d 74 61 72 67 65 74 73 20 20 20 20 20 20 db-targets
1380: 20 20 3a 20 6c 69 73 74 20 74 68 65 20 74 61 72 : list the tar
1390: 67 65 74 20 63 6f 6d 62 69 6e 61 74 69 6f 6e 73 get combinations
13a0: 20 75 73 65 64 20 69 6e 20 74 68 65 20 64 62 0a used in the db.
13b0: 20 20 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 20 20 -show-config
13c0: 20 20 20 20 20 20 20 20 20 20 3a 20 64 75 6d 70 : dump
13d0: 20 74 68 65 20 69 6e 74 65 72 6e 61 6c 20 72 65 the internal re
13e0: 70 72 65 73 65 6e 74 61 74 69 6f 6e 20 6f 66 20 presentation of
13f0: 74 68 65 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e the megatest.con
1400: 66 69 67 20 66 69 6c 65 0a 20 20 2d 73 68 6f 77 fig file. -show
1410: 2d 72 75 6e 63 6f 6e 66 69 67 20 20 20 20 20 20 -runconfig
1420: 20 20 20 3a 20 64 75 6d 70 20 74 68 65 20 69 6e : dump the in
1430: 74 65 72 6e 61 6c 20 72 65 70 72 65 73 65 6e 74 ternal represent
1440: 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 72 75 6e ation of the run
1450: 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 20 66 configs.config f
1460: 69 6c 65 0a 20 20 2d 64 75 6d 70 6d 6f 64 65 20 ile. -dumpmode
1470: 6a 73 6f 6e 20 20 20 20 20 20 20 20 20 20 3a 20 json :
1480: 64 75 6d 70 20 69 6e 20 6a 73 6f 6e 20 66 6f 72 dump in json for
1490: 6d 61 74 20 69 6e 73 74 65 61 64 20 6f 66 20 73 mat instead of s
14a0: 65 78 70 72 0a 0a 4d 69 73 63 20 0a 20 20 2d 72 expr..Misc . -r
14b0: 65 62 75 69 6c 64 2d 64 62 20 20 20 20 20 20 20 ebuild-db
14c0: 20 20 20 20 20 20 3a 20 62 72 69 6e 67 20 74 68 : bring th
14d0: 65 20 64 61 74 61 62 61 73 65 20 73 63 68 65 6d e database schem
14e0: 61 20 75 70 20 74 6f 20 64 61 74 65 0a 20 20 2d a up to date. -
14f0: 75 70 64 61 74 65 2d 6d 65 74 61 20 20 20 20 20 update-meta
1500: 20 20 20 20 20 20 20 3a 20 75 70 64 61 74 65 20 : update
1510: 74 68 65 20 74 65 73 74 73 20 6d 65 74 61 64 61 the tests metada
1520: 74 61 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 ta for all tests
1530: 0a 20 20 2d 65 6e 76 32 66 69 6c 65 20 66 6e 61 . -env2file fna
1540: 6d 65 20 20 20 20 20 20 20 20 20 3a 20 77 72 69 me : wri
1550: 74 65 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 te the environme
1560: 6e 74 20 74 6f 20 66 6e 61 6d 65 2e 63 73 68 20 nt to fname.csh
1570: 61 6e 64 20 66 6e 61 6d 65 2e 73 68 0a 20 20 2d and fname.sh. -
1580: 73 65 74 76 61 72 73 20 56 41 52 31 3d 76 61 6c setvars VAR1=val
1590: 31 2c 56 41 52 32 3d 76 61 6c 32 20 3a 20 41 64 1,VAR2=val2 : Ad
15a0: 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 d environment va
15b0: 72 69 61 62 6c 65 73 20 74 6f 20 61 20 72 75 6e riables to a run
15c0: 20 4e 42 2f 2f 20 74 68 65 73 65 20 61 72 65 0a NB// these are.
15d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15f0: 20 6f 76 65 72 77 72 69 74 74 65 6e 20 62 79 20 overwritten by
1600: 76 61 6c 75 65 73 20 73 65 74 20 69 6e 20 63 6f values set in co
1610: 6e 66 69 67 20 66 69 6c 65 73 2e 0a 20 20 2d 73 nfig files.. -s
1620: 65 72 76 65 72 20 2d 7c 68 6f 73 74 6e 61 6d 65 erver -|hostname
1630: 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 74 68 : start th
1640: 65 20 73 65 72 76 65 72 20 28 72 65 64 75 63 65 e server (reduce
1650: 73 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 6f 6e 20 s contention on
1660: 6d 65 67 61 74 65 73 74 2e 64 62 29 2c 20 75 73 megatest.db), us
1670: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
1680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d 20 -
1690: 74 6f 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c 79 to automatically
16a0: 20 66 69 67 75 72 65 20 6f 75 74 20 68 6f 73 74 figure out host
16b0: 6e 61 6d 65 0a 20 20 2d 74 72 61 6e 73 70 6f 72 name. -transpor
16c0: 74 20 68 74 74 70 7c 7a 6d 71 20 20 20 20 20 3a t http|zmq :
16d0: 20 75 73 65 20 68 74 74 70 20 6f 72 20 7a 6d 71 use http or zmq
16e0: 20 66 6f 72 20 74 72 61 6e 73 70 6f 72 74 20 28 for transport (
16f0: 64 65 66 61 75 6c 74 20 69 73 20 68 74 74 70 29 default is http)
1700: 20 0a 20 20 2d 64 61 65 6d 6f 6e 69 7a 65 20 20 . -daemonize
1710: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 66 6f : fo
1720: 72 6b 20 69 6e 74 6f 20 62 61 63 6b 67 72 6f 75 rk into backgrou
1730: 6e 64 20 61 6e 64 20 64 69 73 63 6f 6e 6e 65 63 nd and disconnec
1740: 74 20 66 72 6f 6d 20 73 74 64 69 6e 2f 6f 75 74 t from stdin/out
1750: 0a 20 20 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 . -list-servers
1760: 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 : lis
1770: 74 20 74 68 65 20 73 65 72 76 65 72 73 20 0a 20 t the servers .
1780: 20 2d 73 74 6f 70 2d 73 65 72 76 65 72 20 69 64 -stop-server id
1790: 20 20 20 20 20 20 20 20 20 3a 20 73 74 6f 70 20 : stop
17a0: 73 65 72 76 65 72 20 73 70 65 63 69 66 69 65 64 server specified
17b0: 20 62 79 20 69 64 20 28 73 65 65 20 6f 75 74 70 by id (see outp
17c0: 75 74 20 6f 66 20 2d 6c 69 73 74 2d 73 65 72 76 ut of -list-serv
17d0: 65 72 73 29 0a 20 20 2d 72 65 70 6c 20 20 20 20 ers). -repl
17e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
17f0: 20 73 74 61 72 74 20 61 20 72 65 70 6c 20 28 75 start a repl (u
1800: 73 65 66 75 6c 20 66 6f 72 20 65 78 74 65 6e 64 seful for extend
1810: 69 6e 67 20 6d 65 67 61 74 65 73 74 29 0a 20 20 ing megatest).
1820: 2d 6c 6f 61 64 20 66 69 6c 65 2e 73 63 6d 20 20 -load file.scm
1830: 20 20 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 61 : load a
1840: 6e 64 20 72 75 6e 20 66 69 6c 65 2e 73 63 6d 0a nd run file.scm.
1850: 0a 53 70 72 65 61 64 73 68 65 65 74 20 67 65 6e .Spreadsheet gen
1860: 65 72 61 74 69 6f 6e 0a 20 20 2d 65 78 74 72 61 eration. -extra
1870: 63 74 2d 6f 64 73 20 66 6e 61 6d 65 2e 6f 64 73 ct-ods fname.ods
1880: 20 20 3a 20 65 78 74 72 61 63 74 20 61 6e 20 6f : extract an o
1890: 70 65 6e 20 64 6f 63 75 6d 65 6e 74 20 73 70 72 pen document spr
18a0: 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 74 68 eadsheet from th
18b0: 65 20 64 61 74 61 62 61 73 65 0a 20 20 2d 70 61 e database. -pa
18c0: 74 68 6d 6f 64 20 70 61 74 68 20 20 20 20 20 20 thmod path
18d0: 20 20 20 20 20 3a 20 69 6e 73 65 72 74 20 70 61 : insert pa
18e0: 74 68 2c 20 69 2e 65 2e 20 70 61 74 68 2f 72 75 th, i.e. path/ru
18f0: 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f name/itempath/lo
1900: 67 66 69 6c 65 2e 68 74 6d 6c 0a 20 20 20 20 20 gfile.html.
1910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1920: 20 20 20 20 20 20 20 77 69 6c 6c 20 63 6c 65 61 will clea
1930: 72 20 74 68 65 20 66 69 65 6c 64 20 69 66 20 6e r the field if n
1940: 6f 20 72 75 6e 64 69 72 2f 74 65 73 74 6e 61 6d o rundir/testnam
1950: 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 69 e/itempath/logfi
1960: 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 le.
1970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 i
1980: 66 20 69 74 20 63 6f 6e 74 61 69 6e 73 20 66 6f f it contains fo
1990: 72 77 61 72 64 20 73 6c 61 73 68 65 73 20 74 68 rward slashes th
19a0: 65 20 70 61 74 68 20 77 69 6c 6c 20 62 65 20 63 e path will be c
19b0: 6f 6e 76 65 72 74 65 64 0a 20 20 20 20 20 20 20 onverted.
19c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19d0: 20 20 20 20 20 74 6f 20 77 69 6e 64 6f 77 73 20 to windows
19e0: 73 74 79 6c 65 0a 47 65 74 74 69 6e 67 20 73 74 style.Getting st
19f0: 61 72 74 65 64 0a 20 20 2d 67 65 6e 2d 6d 65 67 arted. -gen-meg
1a00: 61 74 65 73 74 2d 61 72 65 61 20 20 20 20 20 20 atest-area
1a10: 20 3a 20 63 72 65 61 74 65 20 61 20 73 6b 65 6c : create a skel
1a20: 65 74 6f 6e 20 6d 65 67 61 74 65 73 74 20 61 72 eton megatest ar
1a30: 65 61 2e 20 59 6f 75 20 77 69 6c 6c 20 62 65 20 ea. You will be
1a40: 70 72 6f 6d 70 74 65 64 20 66 6f 72 20 70 61 74 prompted for pat
1a50: 68 73 0a 20 20 2d 67 65 6e 2d 6d 65 67 61 74 65 hs. -gen-megate
1a60: 73 74 2d 74 65 73 74 20 74 6e 61 6d 65 20 3a 20 st-test tname :
1a70: 63 72 65 61 74 65 20 61 20 73 6b 65 6c 65 74 6f create a skeleto
1a80: 6e 20 6d 65 67 61 74 65 73 74 20 74 65 73 74 2e n megatest test.
1a90: 20 59 6f 75 20 77 69 6c 6c 20 62 65 20 70 72 6f You will be pro
1aa0: 6d 70 74 65 64 20 66 6f 72 20 69 6e 66 6f 0a 0a mpted for info..
1ab0: 45 78 61 6d 70 6c 65 73 0a 0a 23 20 47 65 74 20 Examples..# Get
1ac0: 74 65 73 74 20 70 61 74 68 2c 20 75 73 65 20 27 test path, use '
1ad0: 2e 27 20 74 6f 20 67 65 74 20 61 20 73 69 6e 67 .' to get a sing
1ae0: 6c 65 20 70 61 74 68 20 6f 72 20 61 20 73 70 65 le path or a spe
1af0: 63 69 66 69 63 20 70 61 74 68 2f 66 69 6c 65 20 cific path/file
1b00: 70 61 74 74 65 72 6e 0a 6d 65 67 61 74 65 73 74 pattern.megatest
1b10: 20 2d 74 65 73 74 2d 66 69 6c 65 73 20 27 6c 6f -test-files 'lo
1b20: 67 73 2f 2a 2e 6c 6f 67 27 20 2d 74 61 72 67 65 gs/*.log' -targe
1b30: 74 20 75 62 75 6e 74 75 2f 6e 25 2f 6e 6f 25 20 t ubuntu/n%/no%
1b40: 3a 72 75 6e 6e 61 6d 65 20 77 34 39 25 20 2d 74 :runname w49% -t
1b50: 65 73 74 70 61 74 74 20 74 65 73 74 5f 6d 74 25 estpatt test_mt%
1b60: 0a 0a 43 61 6c 6c 65 64 20 61 73 20 22 20 28 73 ..Called as " (s
1b70: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
1b80: 65 20 28 61 72 67 76 29 20 22 20 22 29 20 22 0a e (argv) " ") ".
1b90: 56 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 Version " megate
1ba0: 73 74 2d 76 65 72 73 69 6f 6e 20 22 2c 20 62 75 st-version ", bu
1bb0: 69 6c 74 20 66 72 6f 6d 20 22 20 6d 65 67 61 74 ilt from " megat
1bc0: 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 20 est-fossil-hash
1bd0: 29 29 0a 0a 3b 3b 20 20 2d 67 75 69 20 20 20 20 ))..;; -gui
1be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bf0: 3a 20 73 74 61 72 74 20 61 20 67 75 69 20 69 6e : start a gui in
1c00: 74 65 72 66 61 63 65 0a 3b 3b 20 20 2d 63 6f 6e terface.;; -con
1c10: 66 69 67 20 66 6e 61 6d 65 20 20 20 20 20 20 20 fig fname
1c20: 20 20 20 20 3a 20 6f 76 65 72 72 69 64 65 20 74 : override t
1c30: 68 65 20 72 75 6e 63 6f 6e 66 69 67 20 66 69 6c he runconfig fil
1c40: 65 20 77 69 74 68 20 66 6e 61 6d 65 0a 0a 3b 3b e with fname..;;
1c50: 20 70 72 6f 63 65 73 73 20 61 72 67 73 0a 28 64 process args.(d
1c60: 65 66 69 6e 65 20 72 65 6d 61 72 67 73 20 28 61 efine remargs (a
1c70: 72 67 73 3a 67 65 74 2d 61 72 67 73 20 0a 09 09 rgs:get-args ...
1c80: 20 28 61 72 67 76 29 0a 09 09 20 28 6c 69 73 74 (argv)... (list
1c90: 20 20 22 2d 72 75 6e 74 65 73 74 73 22 20 20 3b "-runtests" ;
1ca0: 3b 20 72 75 6e 20 61 20 73 70 65 63 69 66 69 63 ; run a specific
1cb0: 20 74 65 73 74 0a 09 09 09 22 2d 63 6f 6e 66 69 test...."-confi
1cc0: 67 22 20 20 20 20 3b 3b 20 6f 76 65 72 72 69 64 g" ;; overrid
1cd0: 65 20 74 68 65 20 63 6f 6e 66 69 67 20 66 69 6c e the config fil
1ce0: 65 20 6e 61 6d 65 0a 09 09 09 22 2d 65 78 65 63 e name...."-exec
1cf0: 75 74 65 22 20 20 20 3b 3b 20 72 75 6e 20 74 68 ute" ;; run th
1d00: 65 20 63 6f 6d 6d 61 6e 64 20 65 6e 63 6f 64 65 e command encode
1d10: 64 20 69 6e 20 74 68 65 20 62 61 73 65 36 34 20 d in the base64
1d20: 70 61 72 61 6d 65 74 65 72 0a 09 09 09 22 2d 73 parameter...."-s
1d30: 74 65 70 22 0a 09 09 09 22 3a 72 75 6e 6e 61 6d tep"....":runnam
1d40: 65 22 20 20 20 0a 09 09 09 22 2d 74 61 72 67 65 e" ...."-targe
1d50: 74 22 0a 09 09 09 22 2d 72 65 71 74 61 72 67 22 t"...."-reqtarg"
1d60: 0a 09 09 09 22 3a 72 75 6e 6e 61 6d 65 22 0a 09 ....":runname"..
1d70: 09 09 22 2d 72 75 6e 6e 61 6d 65 22 0a 09 09 09 .."-runname"....
1d80: 22 3a 73 74 61 74 65 22 20 20 0a 09 09 09 22 2d ":state" ...."-
1d90: 73 74 61 74 65 22 0a 09 09 09 22 3a 73 74 61 74 state"....":stat
1da0: 75 73 22 0a 09 09 09 22 2d 73 74 61 74 75 73 22 us"...."-status"
1db0: 0a 09 09 09 22 2d 6c 69 73 74 2d 72 75 6e 73 22 ...."-list-runs"
1dc0: 0a 09 09 09 22 2d 74 65 73 74 70 61 74 74 22 20 ...."-testpatt"
1dd0: 0a 09 09 09 22 2d 69 74 65 6d 70 61 74 74 22 0a ...."-itempatt".
1de0: 09 09 09 22 2d 73 65 74 6c 6f 67 22 0a 09 09 09 ..."-setlog"....
1df0: 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 0a 09 09 "-set-toplog"...
1e00: 09 22 2d 72 75 6e 73 74 65 70 22 0a 09 09 09 22 ."-runstep"...."
1e10: 2d 6c 6f 67 70 72 6f 22 0a 09 09 09 22 2d 6d 22 -logpro"...."-m"
1e20: 0a 09 09 09 22 2d 72 65 72 75 6e 22 0a 09 09 09 ...."-rerun"....
1e30: 22 2d 64 61 79 73 22 0a 09 09 09 22 2d 72 65 6e "-days"...."-ren
1e40: 61 6d 65 2d 72 75 6e 22 0a 09 09 09 22 2d 74 6f ame-run"...."-to
1e50: 22 0a 09 09 09 3b 3b 20 76 61 6c 75 65 73 20 61 "....;; values a
1e60: 6e 64 20 6d 65 73 73 61 67 65 73 0a 09 09 09 22 nd messages...."
1e70: 3a 63 61 74 65 67 6f 72 79 22 0a 09 09 09 22 3a :category"....":
1e80: 76 61 72 69 61 62 6c 65 22 0a 09 09 09 22 3a 76 variable"....":v
1e90: 61 6c 75 65 22 0a 09 09 09 22 3a 65 78 70 65 63 alue"....":expec
1ea0: 74 65 64 22 0a 09 09 09 22 3a 74 6f 6c 22 0a 09 ted"....":tol"..
1eb0: 09 09 22 3a 75 6e 69 74 73 22 0a 09 09 09 3b 3b ..":units"....;;
1ec0: 20 6d 69 73 63 0a 09 09 09 22 2d 73 65 72 76 65 misc...."-serve
1ed0: 72 22 0a 09 09 09 22 2d 74 72 61 6e 73 70 6f 72 r"...."-transpor
1ee0: 74 22 0a 09 09 09 22 2d 73 74 6f 70 2d 73 65 72 t"...."-stop-ser
1ef0: 76 65 72 22 0a 09 09 09 22 2d 70 6f 72 74 22 0a ver"...."-port".
1f00: 09 09 09 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 ..."-extract-ods
1f10: 22 0a 09 09 09 22 2d 70 61 74 68 6d 6f 64 22 0a "...."-pathmod".
1f20: 09 09 09 22 2d 65 6e 76 32 66 69 6c 65 22 0a 09 ..."-env2file"..
1f30: 09 09 22 2d 73 65 74 76 61 72 73 22 0a 09 09 09 .."-setvars"....
1f40: 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 "-set-state-stat
1f50: 75 73 22 0a 09 09 09 22 2d 64 65 62 75 67 22 20 us"...."-debug"
1f60: 3b 3b 20 66 6f 72 20 2a 76 65 72 62 6f 73 69 74 ;; for *verbosit
1f70: 79 2a 20 3e 20 32 0a 09 09 09 22 2d 67 65 6e 2d y* > 2...."-gen-
1f80: 6d 65 67 61 74 65 73 74 2d 74 65 73 74 22 0a 09 megatest-test"..
1f90: 09 09 22 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d .."-override-tim
1fa0: 65 6f 75 74 22 0a 09 09 09 22 2d 74 65 73 74 2d eout"...."-test-
1fb0: 66 69 6c 65 73 22 20 20 3b 3b 20 2d 74 65 73 74 files" ;; -test
1fc0: 2d 70 61 74 68 73 20 69 73 20 66 6f 72 20 6c 69 -paths is for li
1fd0: 73 74 69 6e 67 20 61 6c 6c 0a 09 09 09 22 2d 6c sting all...."-l
1fe0: 6f 61 64 22 20 20 20 20 20 20 20 20 3b 3b 20 6c oad" ;; l
1ff0: 6f 61 64 20 61 6e 64 20 65 78 65 63 74 75 74 65 oad and exectute
2000: 20 61 20 73 63 68 65 6d 65 20 66 69 6c 65 0a 09 a scheme file..
2010: 09 09 22 2d 64 75 6d 70 6d 6f 64 65 22 0a 09 09 .."-dumpmode"...
2020: 09 29 20 0a 09 09 20 28 6c 69 73 74 20 20 22 2d .) ... (list "-
2030: 68 22 0a 09 09 09 22 2d 76 65 72 73 69 6f 6e 22 h"...."-version"
2040: 0a 09 09 20 20 20 20 20 20 20 20 22 2d 66 6f 72 ... "-for
2050: 63 65 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d ce"... "-
2060: 78 74 65 72 6d 22 0a 09 09 20 20 20 20 20 20 20 xterm"...
2070: 20 22 2d 73 68 6f 77 6b 65 79 73 22 0a 09 09 20 "-showkeys"...
2080: 20 20 20 20 20 20 20 22 2d 74 65 73 74 2d 73 74 "-test-st
2090: 61 74 75 73 22 0a 09 09 09 22 2d 73 65 74 2d 76 atus"...."-set-v
20a0: 61 6c 75 65 73 22 0a 09 09 09 22 2d 6c 6f 61 64 alues"...."-load
20b0: 2d 74 65 73 74 2d 64 61 74 61 22 0a 09 09 09 22 -test-data"...."
20c0: 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 -summarize-items
20d0: 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d 67 75 "... "-gu
20e0: 69 22 0a 09 09 09 22 2d 64 61 65 6d 6f 6e 69 7a i"...."-daemoniz
20f0: 65 22 0a 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 e"....;; misc...
2100: 09 22 2d 61 72 63 68 69 76 65 22 0a 09 09 09 22 ."-archive"...."
2110: 2d 72 65 70 6c 22 0a 09 09 09 22 2d 6c 6f 63 6b -repl"...."-lock
2120: 22 0a 09 09 09 22 2d 75 6e 6c 6f 63 6b 22 0a 09 "...."-unlock"..
2130: 09 09 22 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 .."-list-servers
2140: 22 0a 09 09 09 3b 3b 20 6d 69 73 74 20 71 75 65 "....;; mist que
2150: 72 69 65 73 0a 09 09 09 22 2d 6c 69 73 74 2d 64 ries...."-list-d
2160: 69 73 6b 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d isks"...."-list-
2170: 74 61 72 67 65 74 73 22 0a 09 09 09 22 2d 6c 69 targets"...."-li
2180: 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 0a 09 st-db-targets"..
2190: 09 09 22 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 .."-show-runconf
21a0: 69 67 22 0a 09 09 09 22 2d 73 68 6f 77 2d 63 6f ig"...."-show-co
21b0: 6e 66 69 67 22 0a 09 09 09 3b 3b 20 71 75 65 72 nfig"....;; quer
21c0: 69 65 73 0a 09 09 09 22 2d 74 65 73 74 2d 70 61 ies...."-test-pa
21d0: 74 68 73 22 20 3b 3b 20 67 65 74 20 70 61 74 68 ths" ;; get path
21e0: 28 73 29 20 74 6f 20 61 20 74 65 73 74 2c 20 6f (s) to a test, o
21f0: 72 64 65 72 65 64 20 62 79 20 79 6f 75 6e 67 65 rdered by younge
2200: 73 74 20 66 69 72 73 74 0a 0a 09 09 09 22 2d 72 st first....."-r
2210: 75 6e 61 6c 6c 22 20 20 20 20 3b 3b 20 72 75 6e unall" ;; run
2220: 20 61 6c 6c 20 74 65 73 74 73 0a 09 09 09 22 2d all tests...."-
2230: 72 65 6d 6f 76 65 2d 72 75 6e 73 22 0a 09 09 09 remove-runs"....
2240: 22 2d 72 65 62 75 69 6c 64 2d 64 62 22 0a 09 09 "-rebuild-db"...
2250: 09 22 2d 72 6f 6c 6c 75 70 22 0a 09 09 09 22 2d ."-rollup"...."-
2260: 75 70 64 61 74 65 2d 6d 65 74 61 22 0a 09 09 09 update-meta"....
2270: 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 61 "-gen-megatest-a
2280: 72 65 61 22 0a 0a 09 09 09 22 2d 6c 6f 67 67 69 rea"....."-loggi
2290: 6e 67 22 0a 09 09 09 22 2d 76 22 20 3b 3b 20 76 ng"...."-v" ;; v
22a0: 65 72 62 6f 73 65 20 32 2c 20 6d 6f 72 65 20 74 erbose 2, more t
22b0: 68 61 6e 20 6e 6f 72 6d 61 6c 20 28 6e 6f 72 6d han normal (norm
22c0: 61 6c 20 69 73 20 31 29 0a 09 09 09 22 2d 71 22 al is 1)...."-q"
22d0: 20 3b 3b 20 71 75 69 65 74 20 30 2c 20 65 72 72 ;; quiet 0, err
22e0: 6f 72 73 2f 77 61 72 6e 69 6e 67 73 20 6f 6e 6c ors/warnings onl
22f0: 79 0a 09 09 20 20 20 20 20 20 20 29 0a 09 09 20 y... )...
2300: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 0a 09 09 args:arg-hash...
2310: 20 30 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 0))..(if (args:
2320: 67 65 74 2d 61 72 67 20 22 2d 68 22 29 0a 20 20 get-arg "-h").
2330: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
2340: 70 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 20 20 print help).
2350: 20 20 28 65 78 69 74 29 29 29 0a 0a 28 69 66 20 (exit)))..(if
2360: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
2370: 76 65 72 73 69 6f 6e 22 29 0a 20 20 20 20 28 62 version"). (b
2380: 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e egin. (prin
2390: 74 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 t megatest-versi
23a0: 6f 6e 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 on). (exit)
23b0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 69 64 ))..(define *did
23c0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 66 29 0a 0a something* #f)..
23d0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
23e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2410: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 ========.;; Misc
2420: 20 73 65 74 75 70 20 73 74 75 66 66 0a 3b 3b 3d setup stuff.;;=
2430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 64 65 62 75 67 3a 73 65 =====..(debug:se
2480: 74 75 70 29 0a 0a 28 69 66 20 28 61 72 67 73 3a tup)..(if (args:
2490: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 67 69 6e get-arg "-loggin
24a0: 67 22 29 28 73 65 74 21 20 2a 6c 6f 67 67 69 6e g")(set! *loggin
24b0: 67 2a 20 23 74 29 29 0a 0a 28 69 66 20 28 64 65 g* #t))..(if (de
24c0: 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 33 bug:debug-mode 3
24d0: 29 20 3b 3b 20 77 65 20 61 72 65 20 6f 62 76 69 ) ;; we are obvi
24e0: 6f 75 73 6c 79 20 64 65 62 75 67 67 69 6e 67 0a ously debugging.
24f0: 20 20 20 20 28 73 65 74 21 20 6f 70 65 6e 2d 72 (set! open-r
2500: 75 6e 2d 63 6c 6f 73 65 20 6f 70 65 6e 2d 72 75 un-close open-ru
2510: 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 n-close-no-excep
2520: 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 29 29 0a tion-handling)).
2530: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
2540: 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 29 0a rg "-itempatt").
2550: 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 (let ((newva
2560: 6c 20 28 63 6f 6e 63 20 28 61 72 67 73 3a 67 65 l (conc (args:ge
2570: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
2580: 22 29 20 22 2f 22 20 28 61 72 67 73 3a 67 65 74 ") "/" (args:get
2590: 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 -arg "-itempatt"
25a0: 29 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 )))). (debu
25b0: 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 g:print 0 "WARNI
25c0: 4e 47 3a 20 2d 69 74 65 6d 70 61 74 74 20 68 61 NG: -itempatt ha
25d0: 73 20 62 65 65 6e 20 64 65 70 72 65 63 61 74 65 s been deprecate
25e0: 64 2c 20 70 6c 65 61 73 65 20 75 73 65 20 2d 74 d, please use -t
25f0: 65 73 74 70 61 74 74 20 74 65 73 74 70 61 74 74 estpatt testpatt
2600: 2f 69 74 65 6d 70 61 74 74 20 6d 65 74 68 6f 64 /itempatt method
2610: 2c 20 6e 65 77 20 74 65 73 74 70 61 74 74 20 69 , new testpatt i
2620: 73 20 22 6e 65 77 76 61 6c 29 0a 20 20 20 20 20 s "newval).
2630: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
2640: 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 ! args:arg-hash
2650: 22 2d 74 65 73 74 70 61 74 74 22 20 6e 65 77 76 "-testpatt" newv
2660: 61 6c 29 0a 20 20 20 20 20 20 28 68 61 73 68 2d al). (hash-
2670: 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 61 72 table-delete! ar
2680: 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 69 74 gs:arg-hash "-it
2690: 65 6d 70 61 74 74 22 29 29 29 0a 0a 3b 3b 3d 3d empatt")))..;;==
26a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 4d 69 73 63 20 67 65 6e ====.;; Misc gen
26f0: 65 72 61 6c 20 63 61 6c 6c 73 0a 3b 3b 3d 3d 3d eral calls.;;===
2700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
2750: 65 74 2d 61 72 67 20 22 2d 65 6e 76 32 66 69 6c et-arg "-env2fil
2760: 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 e"). (begin.
2770: 20 20 20 20 20 28 73 61 76 65 2d 65 6e 76 69 72 (save-envir
2780: 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 onment-as-files
2790: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
27a0: 65 6e 76 32 66 69 6c 65 22 29 29 0a 20 20 20 20 env2file")).
27b0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
27c0: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
27d0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
27e0: 22 2d 6c 69 73 74 2d 64 69 73 6b 73 22 29 0a 20 "-list-disks").
27f0: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
2800: 28 70 72 69 6e 74 20 0a 20 20 20 20 20 20 20 28 (print . (
2810: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
2820: 73 65 20 0a 09 28 6d 61 70 20 28 6c 61 6d 62 64 se ..(map (lambd
2830: 61 20 28 78 29 0a 09 20 20 20 20 20 20 20 28 73 a (x).. (s
2840: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
2850: 65 20 0a 09 09 78 0a 09 09 22 20 3d 3e 20 22 29 e ...x..." => ")
2860: 29 0a 09 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a ).. (common:
2870: 67 65 74 2d 64 69 73 6b 73 29 20 29 0a 09 22 5c get-disks) ).."\
2880: 6e 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 n")). (set!
2890: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
28a0: 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d #t)))..;;=======
28b0: 3d 3d 3d 3d 3d 3d 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 0a ===============.
28f0: 3b 3b 20 53 74 61 72 74 20 74 68 65 20 73 65 72 ;; Start the ser
2900: 76 65 72 20 2d 20 63 61 6e 20 62 65 20 64 6f 6e ver - can be don
2910: 65 20 69 6e 20 63 6f 6e 6a 75 6e 63 74 69 6f 6e e in conjunction
2920: 20 77 69 74 68 20 2d 72 75 6e 61 6c 6c 20 6f 72 with -runall or
2930: 20 2d 72 75 6e 74 65 73 74 73 20 28 6f 6e 65 20 -runtests (one
2940: 64 61 79 2e 2e 2e 29 0a 3b 3b 20 20 20 77 65 20 day...).;; we
2950: 73 74 61 72 74 20 74 68 65 20 73 65 72 76 65 72 start the server
2960: 20 69 66 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 if not running
2970: 65 6c 73 65 20 73 74 61 72 74 20 74 68 65 20 63 else start the c
2980: 6c 69 65 6e 74 20 74 68 72 65 61 64 0a 3b 3b 3d lient thread.;;=
2990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
29e0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 72 76 65 :get-arg "-serve
29f0: 72 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 r"). (let ((t
2a00: 72 61 6e 73 70 6f 72 74 20 28 61 72 67 73 3a 67 ransport (args:g
2a10: 65 74 2d 61 72 67 20 22 2d 74 72 61 6e 73 70 6f et-arg "-transpo
2a20: 72 74 22 20 22 68 74 74 70 22 29 29 29 0a 20 20 rt" "http"))).
2a30: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
2a40: 20 32 20 22 4c 61 75 6e 63 68 69 6e 67 20 73 65 2 "Launching se
2a50: 72 76 65 72 20 75 73 69 6e 67 20 74 72 61 6e 73 rver using trans
2a60: 70 6f 72 74 20 22 20 74 72 61 6e 73 70 6f 72 74 port " transport
2a70: 29 0a 20 20 20 20 20 20 28 73 65 72 76 65 72 3a ). (server:
2a80: 6c 61 75 6e 63 68 20 28 73 74 72 69 6e 67 2d 3e launch (string->
2a90: 73 79 6d 62 6f 6c 20 74 72 61 6e 73 70 6f 72 74 symbol transport
2aa0: 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 ))). (if (not
2ab0: 20 28 6e 75 6c 6c 3f 20 28 6c 73 65 74 2d 69 6e (null? (lset-in
2ac0: 74 65 72 73 65 63 74 69 6f 6e 20 0a 09 09 20 20 tersection ...
2ad0: 20 20 20 65 71 75 61 6c 3f 0a 09 09 20 20 20 20 equal?...
2ae0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 (hash-table-key
2af0: 73 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 s args:arg-hash)
2b00: 0a 09 09 20 20 20 20 20 27 28 22 2d 72 75 6e 74 ... '("-runt
2b10: 65 73 74 73 22 20 20 20 20 22 2d 6c 69 73 74 2d ests" "-list-
2b20: 72 75 6e 73 22 20 20 20 22 2d 72 6f 6c 6c 75 70 runs" "-rollup
2b30: 22 0a 09 09 20 20 20 20 20 20 20 22 2d 72 65 6d "... "-rem
2b40: 6f 76 65 2d 72 75 6e 73 22 20 22 2d 6c 6f 63 6b ove-runs" "-lock
2b50: 22 20 20 20 20 20 20 20 20 22 2d 75 6e 6c 6f 63 " "-unloc
2b60: 6b 22 0a 09 09 20 20 20 20 20 20 20 22 2d 75 70 k"... "-up
2b70: 64 61 74 65 2d 6d 65 74 61 22 20 22 2d 65 78 74 date-meta" "-ext
2b80: 72 61 63 74 2d 6f 64 73 22 29 29 29 29 0a 09 28 ract-ods"))))..(
2b90: 69 66 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 if (setup-for-ru
2ba0: 6e 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 73 n).. (let ((s
2bb0: 65 72 76 65 72 73 20 28 6f 70 65 6e 2d 72 75 6e ervers (open-run
2bc0: 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 67 65 74 -close tasks:get
2bd0: 2d 62 65 73 74 2d 73 65 72 76 65 72 20 74 61 73 -best-server tas
2be0: 6b 73 3a 6f 70 65 6e 2d 64 62 29 29 29 0a 09 20 ks:open-db)))..
2bf0: 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f (if (or (no
2c00: 74 20 73 65 72 76 65 72 73 29 0a 09 09 20 20 20 t servers)...
2c10: 20 20 20 28 6e 75 6c 6c 3f 20 73 65 72 76 65 72 (null? server
2c20: 73 29 29 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 s))... (begin..
2c30: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
2c40: 74 20 30 20 22 49 4e 46 4f 3a 20 53 74 61 72 74 t 0 "INFO: Start
2c50: 69 6e 67 20 73 65 72 76 65 72 20 61 73 20 6e 6f ing server as no
2c60: 6e 65 20 72 75 6e 6e 69 6e 67 20 2e 2e 2e 22 29 ne running ...")
2c70: 0a 09 09 20 20 20 20 3b 3b 20 28 73 65 72 76 65 ... ;; (serve
2c80: 72 3a 6c 61 75 6e 63 68 20 28 73 74 72 69 6e 67 r:launch (string
2c90: 2d 3e 73 79 6d 62 6f 6c 20 28 61 72 67 73 3a 67 ->symbol (args:g
2ca0: 65 74 2d 61 72 67 20 22 2d 74 72 61 6e 73 70 6f et-arg "-transpo
2cb0: 72 74 22 20 22 68 74 74 70 22 29 29 29 29 0a 09 rt" "http"))))..
2cc0: 09 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f . (system (co
2cd0: 6e 63 20 28 63 61 72 20 28 61 72 67 76 29 29 20 nc (car (argv))
2ce0: 22 20 2d 73 65 72 76 65 72 20 2d 20 2d 64 61 65 " -server - -dae
2cf0: 6d 6f 6e 69 7a 65 20 2d 74 72 61 6e 73 70 6f 72 monize -transpor
2d00: 74 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 t " (args:get-ar
2d10: 67 20 22 2d 74 72 61 6e 73 70 6f 72 74 22 20 22 g "-transport" "
2d20: 68 74 74 70 22 29 29 29 0a 09 09 20 20 20 20 28 http")))... (
2d30: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 33 29 thread-sleep! 3)
2d40: 29 20 3b 3b 20 67 69 76 65 20 74 68 65 20 73 65 ) ;; give the se
2d50: 72 76 65 72 20 61 20 66 65 77 20 73 65 63 6f 6e rver a few secon
2d60: 64 73 20 74 6f 20 73 74 61 72 74 0a 09 09 20 20 ds to start...
2d70: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
2d80: 49 4e 46 4f 3a 20 53 65 72 76 65 72 73 20 61 6c INFO: Servers al
2d90: 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 20 22 20 ready running "
2da0: 73 65 72 76 65 72 73 29 0a 09 09 20 20 29 29 29 servers)... )))
2db0: 29 29 0a 09 0a 0a 28 69 66 20 28 6f 72 20 28 61 ))....(if (or (a
2dc0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
2dd0: 73 74 2d 73 65 72 76 65 72 73 22 29 0a 09 28 61 st-servers")..(a
2de0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
2df0: 6f 70 2d 73 65 72 76 65 72 22 29 29 0a 20 20 20 op-server")).
2e00: 20 28 6c 65 74 20 28 28 74 6c 20 28 73 65 74 75 (let ((tl (setu
2e10: 70 2d 66 6f 72 2d 72 75 6e 29 29 29 0a 20 20 20 p-for-run))).
2e20: 20 20 20 28 69 66 20 74 6c 20 0a 09 20 20 28 6c (if tl .. (l
2e30: 65 74 2a 20 28 28 73 65 72 76 65 72 73 20 28 6f et* ((servers (o
2e40: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 pen-run-close ta
2e50: 73 6b 73 3a 67 65 74 2d 61 6c 6c 2d 73 65 72 76 sks:get-all-serv
2e60: 65 72 73 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 ers tasks:open-d
2e70: 62 29 29 0a 09 09 20 28 66 6d 74 73 74 72 20 20 b))... (fmtstr
2e80: 22 7e 35 61 7e 38 61 7e 38 61 7e 32 30 61 7e 32 "~5a~8a~8a~20a~2
2e90: 30 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 0a~10a~10a~10a~1
2ea0: 30 61 7e 31 30 61 5c 6e 22 29 0a 09 09 20 28 73 0a~10a\n")... (s
2eb0: 65 72 76 65 72 73 2d 74 6f 2d 6b 69 6c 6c 20 27 ervers-to-kill '
2ec0: 28 29 29 0a 09 09 20 28 6b 69 6c 6c 69 6e 66 6f ())... (killinfo
2ed0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
2ee0: 20 22 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 29 "-stop-server")
2ef0: 29 0a 09 09 20 28 6b 68 6f 73 74 2d 70 6f 72 74 )... (khost-port
2f00: 20 28 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 69 (if killinfo (i
2f10: 66 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 f (substring-ind
2f20: 65 78 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f 29 ex ":" killinfo)
2f30: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 22 3a (string-split ":
2f40: 22 29 20 23 66 29 20 23 66 29 29 0a 09 09 20 28 ") #f) #f))... (
2f50: 73 69 64 20 20 20 20 20 20 20 20 28 69 66 20 6b sid (if k
2f60: 69 6c 6c 69 6e 66 6f 20 28 69 66 20 28 73 75 62 illinfo (if (sub
2f70: 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 3a 22 string-index ":"
2f80: 20 6b 69 6c 6c 69 6e 66 6f 29 20 23 66 20 28 73 killinfo) #f (s
2f90: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 6b 69 tring->number ki
2fa0: 6c 6c 69 6e 66 6f 29 29 20 23 66 29 29 29 0a 09 llinfo)) #f)))..
2fb0: 20 20 20 20 28 66 6f 72 6d 61 74 20 23 74 20 66 (format #t f
2fc0: 6d 74 73 74 72 20 22 49 64 22 20 22 4d 54 76 65 mtstr "Id" "MTve
2fd0: 72 22 20 22 50 69 64 22 20 22 48 6f 73 74 22 20 r" "Pid" "Host"
2fe0: 22 49 6e 74 65 72 66 61 63 65 22 20 22 4f 75 74 "Interface" "Out
2ff0: 50 6f 72 74 22 20 22 49 6e 50 6f 72 74 22 20 22 Port" "InPort" "
3000: 4c 61 73 74 42 65 61 74 22 20 22 53 74 61 74 65 LastBeat" "State
3010: 22 20 22 54 72 61 6e 73 70 6f 72 74 22 29 0a 09 " "Transport")..
3020: 20 20 20 20 28 66 6f 72 6d 61 74 20 23 74 20 66 (format #t f
3030: 6d 74 73 74 72 20 22 3d 3d 22 20 22 3d 3d 3d 3d mtstr "==" "====
3040: 3d 22 20 22 3d 3d 3d 22 20 22 3d 3d 3d 3d 22 20 =" "===" "===="
3050: 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d "=========" "===
3060: 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 22 20 22 ====" "======" "
3070: 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d ========" "=====
3080: 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 29 0a 09 " "=========")..
3090: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 (for-each ..
30a0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 (lambda (se
30b0: 72 76 65 72 29 0a 09 20 20 20 20 20 20 20 28 6c rver).. (l
30c0: 65 74 2a 20 28 28 69 64 20 20 20 20 20 20 20 20 et* ((id
30d0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
30e0: 76 65 72 20 30 29 29 0a 09 09 20 20 20 20 20 20 ver 0))...
30f0: 28 70 69 64 20 20 20 20 20 20 20 20 28 76 65 63 (pid (vec
3100: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 tor-ref server 1
3110: 29 29 0a 09 09 20 20 20 20 20 20 28 68 6f 73 74 ))... (host
3120: 6e 61 6d 65 20 20 20 28 76 65 63 74 6f 72 2d 72 name (vector-r
3130: 65 66 20 73 65 72 76 65 72 20 32 29 29 0a 09 09 ef server 2))...
3140: 20 20 20 20 20 20 28 69 6e 74 65 72 66 61 63 65 (interface
3150: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
3160: 72 76 65 72 20 33 29 29 0a 09 09 20 20 20 20 20 rver 3))...
3170: 20 28 70 75 6c 6c 70 6f 72 74 20 20 20 28 76 65 (pullport (ve
3180: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
3190: 34 29 29 0a 09 09 20 20 20 20 20 20 28 70 75 62 4))... (pub
31a0: 70 6f 72 74 20 20 20 20 28 76 65 63 74 6f 72 2d port (vector-
31b0: 72 65 66 20 73 65 72 76 65 72 20 35 29 29 0a 09 ref server 5))..
31c0: 09 20 20 20 20 20 20 28 73 74 61 72 74 2d 74 69 . (start-ti
31d0: 6d 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 me (vector-ref s
31e0: 65 72 76 65 72 20 36 29 29 0a 09 09 20 20 20 20 erver 6))...
31f0: 20 20 28 70 72 69 6f 72 69 74 79 20 20 20 28 76 (priority (v
3200: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
3210: 20 37 29 29 0a 09 09 20 20 20 20 20 20 28 73 74 7))... (st
3220: 61 74 65 20 20 20 20 20 20 28 76 65 63 74 6f 72 ate (vector
3230: 2d 72 65 66 20 73 65 72 76 65 72 20 38 29 29 0a -ref server 8)).
3240: 09 09 20 20 20 20 20 20 28 6d 74 2d 76 65 72 20 .. (mt-ver
3250: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
3260: 73 65 72 76 65 72 20 39 29 29 0a 09 09 20 20 20 server 9))...
3270: 20 20 20 28 6c 61 73 74 2d 75 70 64 61 74 65 20 (last-update
3280: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 (vector-ref serv
3290: 65 72 20 31 30 29 29 20 3b 3b 20 20 20 28 6f 70 er 10)) ;; (op
32a0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 en-run-close tas
32b0: 6b 73 3a 73 65 72 76 65 72 2d 61 6c 69 76 65 3f ks:server-alive?
32c0: 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 23 tasks:open-db #
32d0: 66 20 68 6f 73 74 6e 61 6d 65 3a 20 68 6f 73 74 f hostname: host
32e0: 6e 61 6d 65 20 70 6f 72 74 3a 20 70 6f 72 74 29 name port: port)
32f0: 29 0a 09 09 20 20 20 20 20 20 28 74 72 61 6e 73 )... (trans
3300: 70 6f 72 74 20 20 28 76 65 63 74 6f 72 2d 72 65 port (vector-re
3310: 66 20 73 65 72 76 65 72 20 31 31 29 29 0a 09 09 f server 11))...
3320: 20 20 20 20 20 20 28 6b 69 6c 6c 65 64 20 20 20 (killed
3330: 20 20 23 66 29 0a 09 09 20 20 20 20 20 20 28 73 #f)... (s
3340: 74 61 74 75 73 20 20 20 20 20 28 3c 20 6c 61 73 tatus (< las
3350: 74 2d 75 70 64 61 74 65 20 32 30 29 29 29 0a 09 t-update 20)))..
3360: 09 20 3b 3b 20 20 20 28 7a 6d 71 2d 73 6f 63 6b . ;; (zmq-sock
3370: 65 74 73 20 28 69 66 20 73 74 61 74 75 73 20 28 ets (if status (
3380: 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d 63 6f server:client-co
3390: 6e 6e 65 63 74 20 68 6f 73 74 6e 61 6d 65 20 70 nnect hostname p
33a0: 6f 72 74 29 20 23 66 29 29 29 0a 09 09 20 3b 3b ort) #f)))... ;;
33b0: 20 6e 6f 20 6e 65 65 64 20 74 6f 20 6c 6f 67 69 no need to logi
33c0: 6e 20 61 73 20 73 74 61 74 75 73 20 6f 66 20 23 n as status of #
33d0: 74 20 69 6e 64 69 63 61 74 65 73 20 77 65 20 61 t indicates we a
33e0: 72 65 20 63 6f 6e 6e 65 63 74 69 6e 67 20 74 6f re connecting to
33f0: 20 63 6f 72 72 65 63 74 20 0a 09 09 20 3b 3b 20 correct ... ;;
3400: 73 65 72 76 65 72 0a 09 09 20 28 69 66 20 28 65 server... (if (e
3410: 71 75 61 6c 3f 20 73 74 61 74 65 20 22 64 65 61 qual? state "dea
3420: 64 22 29 0a 09 09 20 20 20 20 20 28 69 66 20 28 d")... (if (
3430: 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 28 2a > last-update (*
3440: 20 32 35 20 36 30 20 36 30 29 29 20 3b 3b 20 6b 25 60 60)) ;; k
3450: 65 65 70 20 72 65 63 6f 72 64 73 20 61 72 6f 75 eep records arou
3460: 6e 64 20 66 6f 72 20 73 6c 69 67 68 6c 79 20 6f nd for slighly o
3470: 76 65 72 20 61 20 64 61 79 2e 0a 09 09 09 20 28 ver a day..... (
3480: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 open-run-close t
3490: 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 65 asks:server-dere
34a0: 67 69 73 74 65 72 20 74 61 73 6b 73 3a 6f 70 65 gister tasks:ope
34b0: 6e 2d 64 62 20 68 6f 73 74 6e 61 6d 65 20 70 75 n-db hostname pu
34c0: 6c 6c 70 6f 72 74 3a 20 70 75 6c 6c 70 6f 72 74 llport: pullport
34d0: 20 70 69 64 3a 20 70 69 64 20 61 63 74 69 6f 6e pid: pid action
34e0: 3a 20 27 64 65 6c 65 74 65 29 29 0a 09 09 20 20 : 'delete))...
34f0: 20 20 20 28 69 66 20 28 3e 20 6c 61 73 74 2d 75 (if (> last-u
3500: 70 64 61 74 65 20 32 30 29 20 20 20 20 20 20 20 pdate 20)
3510: 20 3b 3b 20 4d 61 72 6b 20 61 73 20 64 65 61 64 ;; Mark as dead
3520: 20 69 66 20 6e 6f 74 20 75 70 64 61 74 65 64 20 if not updated
3530: 69 6e 20 6c 61 73 74 20 32 30 20 73 65 63 6f 6e in last 20 secon
3540: 64 73 0a 09 09 09 20 28 6f 70 65 6e 2d 72 75 6e ds.... (open-run
3550: 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 73 65 72 -close tasks:ser
3560: 76 65 72 2d 64 65 72 65 67 69 73 74 65 72 20 74 ver-deregister t
3570: 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 asks:open-db hos
3580: 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 74 3a 20 tname pullport:
3590: 70 75 6c 6c 70 6f 72 74 20 70 69 64 3a 20 70 69 pullport pid: pi
35a0: 64 29 29 29 0a 09 09 20 28 66 6f 72 6d 61 74 20 d)))... (format
35b0: 23 74 20 66 6d 74 73 74 72 20 69 64 20 6d 74 2d #t fmtstr id mt-
35c0: 76 65 72 20 70 69 64 20 68 6f 73 74 6e 61 6d 65 ver pid hostname
35d0: 20 69 6e 74 65 72 66 61 63 65 20 70 75 6c 6c 70 interface pullp
35e0: 6f 72 74 20 70 75 62 70 6f 72 74 20 6c 61 73 74 ort pubport last
35f0: 2d 75 70 64 61 74 65 0a 09 09 09 20 28 69 66 20 -update.... (if
3600: 73 74 61 74 75 73 20 22 61 6c 69 76 65 22 20 22 status "alive" "
3610: 64 65 61 64 22 29 20 74 72 61 6e 73 70 6f 72 74 dead") transport
3620: 29 0a 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f )... (if (equal?
3630: 20 69 64 20 73 69 64 29 0a 09 09 20 20 20 20 20 id sid)...
3640: 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 20 (begin...
3650: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
3660: 6f 20 30 20 22 41 74 74 65 6d 70 74 69 6e 67 20 o 0 "Attempting
3670: 74 6f 20 73 74 6f 70 20 73 65 72 76 65 72 20 77 to stop server w
3680: 69 74 68 20 70 69 64 20 22 20 70 69 64 29 0a 09 ith pid " pid)..
3690: 09 20 20 20 20 20 20 20 28 74 61 73 6b 73 3a 6b . (tasks:k
36a0: 69 6c 6c 2d 73 65 72 76 65 72 20 73 74 61 74 75 ill-server statu
36b0: 73 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 s hostname pullp
36c0: 6f 72 74 20 70 69 64 20 74 72 61 6e 73 70 6f 72 ort pid transpor
36d0: 74 29 29 29 29 29 0a 09 20 20 20 20 20 73 65 72 t))))).. ser
36e0: 76 65 72 73 29 0a 09 20 20 20 20 28 64 65 62 75 vers).. (debu
36f0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 22 g:print-info 1 "
3700: 44 6f 6e 65 20 77 69 74 68 20 6c 69 73 74 73 65 Done with listse
3710: 72 76 65 72 73 22 29 0a 09 20 20 20 20 28 73 65 rvers").. (se
3720: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
3730: 2a 20 23 74 29 0a 09 20 20 20 20 28 65 78 69 74 * #t).. (exit
3740: 29 20 3b 3b 20 6d 75 73 74 20 64 6f 2c 20 77 6f ) ;; must do, wo
3750: 75 6c 64 20 68 61 76 65 20 74 6f 20 61 64 64 20 uld have to add
3760: 63 68 65 63 6b 73 20 74 6f 20 6d 61 6e 79 2f 61 checks to many/a
3770: 6c 6c 20 63 61 6c 6c 73 20 62 65 6c 6f 77 0a 09 ll calls below..
3780: 20 20 20 20 29 0a 09 20 20 28 65 78 69 74 29 29 ).. (exit))
3790: 29 0a 20 20 20 20 3b 3b 20 69 66 20 6e 6f 74 20 ). ;; if not
37a0: 6c 69 73 74 20 6f 72 20 6b 69 6c 6c 20 74 68 65 list or kill the
37b0: 6e 20 73 74 61 72 74 20 61 20 63 6c 69 65 6e 74 n start a client
37c0: 20 28 69 66 20 61 70 70 72 6f 70 72 69 61 74 65 (if appropriate
37d0: 29 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 61 ). (if (or (a
37e0: 72 67 73 2d 64 65 66 69 6e 65 64 3f 20 22 2d 68 rgs-defined? "-h
37f0: 22 20 22 2d 76 65 72 73 69 6f 6e 22 20 22 2d 67 " "-version" "-g
3800: 65 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 en-megatest-area
3810: 22 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 " "-gen-megatest
3820: 2d 74 65 73 74 22 29 0a 09 20 20 20 20 28 65 71 -test").. (eq
3830: 3f 20 28 6c 65 6e 67 74 68 20 28 68 61 73 68 2d ? (length (hash-
3840: 74 61 62 6c 65 2d 6b 65 79 73 20 61 72 67 73 3a table-keys args:
3850: 61 72 67 2d 68 61 73 68 29 29 20 30 29 29 0a 09 arg-hash)) 0))..
3860: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
3870: 6f 20 31 20 22 53 65 72 76 65 72 20 63 6f 6e 6e o 1 "Server conn
3880: 65 63 74 69 6f 6e 20 6e 6f 74 20 6e 65 65 64 65 ection not neede
3890: 64 22 29 0a 09 3b 3b 20 6f 6b 2c 20 73 6f 20 6c d")..;; ok, so l
38a0: 65 74 73 20 63 6f 6e 6e 65 63 74 20 74 6f 20 74 ets connect to t
38b0: 68 65 20 73 65 72 76 65 72 0a 09 28 63 6c 69 65 he server..(clie
38c0: 6e 74 3a 6c 61 75 6e 63 68 29 29 29 0a 0a 3b 3b nt:launch)))..;;
38d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 57 65 69 72 64 20 ======.;; Weird
3920: 73 70 65 63 69 61 6c 20 63 61 6c 6c 73 20 74 68 special calls th
3930: 61 74 20 6e 65 65 64 20 74 6f 20 72 75 6e 20 2a at need to run *
3940: 61 66 74 65 72 2a 20 74 68 65 20 73 65 72 76 65 after* the serve
3950: 72 20 68 61 73 20 73 74 61 72 74 65 64 3f 0a 3b r has started?.;
3960: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
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 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
39b0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 gs:get-arg "-lis
39c0: 74 2d 74 61 72 67 65 74 73 22 29 0a 20 20 20 20 t-targets").
39d0: 28 6c 65 74 20 28 28 74 61 72 67 65 74 73 20 28 (let ((targets (
39e0: 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 72 75 6e 63 6f common:get-runco
39f0: 6e 66 69 67 2d 74 61 72 67 65 74 73 29 29 29 0a nfig-targets))).
3a00: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 46 6f (print "Fo
3a10: 75 6e 64 20 22 28 6c 65 6e 67 74 68 20 74 61 72 und "(length tar
3a20: 67 65 74 73 29 20 22 20 74 61 72 67 65 74 73 22 gets) " targets"
3a30: 29 0a 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 ). (for-eac
3a40: 68 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 h (lambda (x)...
3a50: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 5b 22 20 ;; (print "["
3a60: 78 20 22 5d 22 29 29 0a 09 09 20 20 28 70 72 69 x "]"))... (pri
3a70: 6e 74 20 78 29 29 0a 09 09 74 61 72 67 65 74 73 nt x))...targets
3a80: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
3a90: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
3aa0: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
3ab0: 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 72 75 6e t-arg "-show-run
3ac0: 63 6f 6e 66 69 67 22 29 0a 20 20 20 20 28 6c 65 config"). (le
3ad0: 74 2a 20 28 28 74 61 72 67 65 74 20 28 69 66 20 t* ((target (if
3ae0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3af0: 72 65 71 74 61 72 67 22 29 0a 09 09 20 20 20 20 reqtarg")...
3b00: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
3b10: 20 22 2d 72 65 71 74 61 72 67 22 29 0a 09 09 20 "-reqtarg")...
3b20: 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a (if (args:
3b30: 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 get-arg "-target
3b40: 22 29 0a 09 09 09 20 20 20 28 61 72 67 73 3a 67 ").... (args:g
3b50: 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 et-arg "-target"
3b60: 29 0a 09 09 09 20 20 20 23 66 29 29 29 0a 09 20 ).... #f)))..
3b70: 20 20 28 73 65 63 74 69 6f 6e 73 20 28 69 66 20 (sections (if
3b80: 74 61 72 67 65 74 20 28 6c 69 73 74 20 22 64 65 target (list "de
3b90: 66 61 75 6c 74 22 20 74 61 72 67 65 74 29 20 23 fault" target) #
3ba0: 66 29 29 0a 09 20 20 20 28 64 61 74 61 20 20 20 f)).. (data
3bb0: 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 22 (read-config "
3bc0: 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 runconfigs.confi
3bd0: 67 22 20 23 66 20 23 74 20 73 65 63 74 69 6f 6e g" #f #t section
3be0: 73 3a 20 73 65 63 74 69 6f 6e 73 29 29 29 0a 0a s: sections)))..
3bf0: 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 ;; keep th
3c00: 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 is one local.
3c10: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond.
3c20: 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d ((not (args:get-
3c30: 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 arg "-dumpmode")
3c40: 29 0a 09 28 70 70 20 28 68 61 73 68 2d 74 61 62 )..(pp (hash-tab
3c50: 6c 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 29 29 le->alist data))
3c60: 29 0a 20 20 20 20 20 20 20 28 28 73 74 72 69 6e ). ((strin
3c70: 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 g=? (args:get-ar
3c80: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
3c90: 6a 73 6f 6e 22 29 0a 09 28 6a 73 6f 6e 2d 77 72 json")..(json-wr
3ca0: 69 74 65 20 64 61 74 61 29 29 0a 20 20 20 20 20 ite data)).
3cb0: 20 20 28 65 6c 73 65 0a 09 28 64 65 62 75 67 3a (else..(debug:
3cc0: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
3cd0: 2d 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 -dumpmode of " (
3ce0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
3cf0: 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 umpmode") " not
3d00: 72 65 63 6f 67 6e 69 73 65 64 22 29 29 29 0a 20 recognised"))).
3d10: 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
3d20: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
3d30: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
3d40: 72 67 20 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 rg "-show-config
3d50: 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 64 61 "). (let ((da
3d60: 74 61 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 29 ta *configdat*))
3d70: 20 3b 3b 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 ;; (read-config
3d80: 20 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 "megatest.confi
3d90: 67 22 20 23 66 20 23 74 29 29 29 0a 20 20 20 20 g" #f #t))).
3da0: 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 6f ;; keep this o
3db0: 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 ne local. (
3dc0: 63 6f 6e 64 20 0a 20 20 20 20 20 20 20 28 28 6e cond . ((n
3dd0: 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
3de0: 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 29 0a 09 "-dumpmode"))..
3df0: 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (pp (hash-table-
3e00: 3e 61 6c 69 73 74 20 64 61 74 61 29 29 29 0a 20 >alist data))).
3e10: 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 3d 3f ((string=?
3e20: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3e30: 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f -dumpmode") "jso
3e40: 6e 22 29 0a 09 28 6a 73 6f 6e 2d 77 72 69 74 65 n")..(json-write
3e50: 20 64 61 74 61 29 29 0a 20 20 20 20 20 20 20 28 data)). (
3e60: 65 6c 73 65 0a 09 28 64 65 62 75 67 3a 70 72 69 else..(debug:pri
3e70: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 2d 64 75 nt 0 "ERROR: -du
3e80: 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 61 72 67 mpmode of " (arg
3e90: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
3ea0: 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 72 65 63 mode") " not rec
3eb0: 6f 67 6e 69 73 65 64 22 29 29 29 0a 20 20 20 20 ognised"))).
3ec0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
3ed0: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
3ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 52 65 6d 6f 76 65 ======.;; Remove
3f30: 20 6f 6c 64 20 72 75 6e 28 73 29 0a 3b 3b 3d 3d old run(s).;;==
3f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 3b 3b 20 73 69 6e 63 65 20 73 ====..;; since s
3f90: 65 76 65 72 61 6c 20 61 63 74 69 6f 6e 73 20 63 everal actions c
3fa0: 61 6e 20 62 65 20 73 70 65 63 69 66 69 65 64 20 an be specified
3fb0: 6f 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 6c on the command l
3fc0: 69 6e 65 20 74 68 65 20 72 65 6d 6f 76 61 6c 0a ine the removal.
3fd0: 3b 3b 20 69 73 20 64 6f 6e 65 20 66 69 72 73 74 ;; is done first
3fe0: 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 72 61 74 .(define (operat
3ff0: 65 2d 6f 6e 20 61 63 74 69 6f 6e 29 0a 20 20 28 e-on action). (
4000: 63 6f 6e 64 0a 20 20 20 28 28 6e 6f 74 20 28 61 cond. ((not (a
4010: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 rgs:get-arg ":ru
4020: 6e 6e 61 6d 65 22 29 29 0a 20 20 20 20 28 64 65 nname")). (de
4030: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
4040: 4f 52 3a 20 4d 69 73 73 69 6e 67 20 72 65 71 75 OR: Missing requ
4050: 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 ired parameter f
4060: 6f 72 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 or " action ", y
4070: 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 ou must specify
4080: 74 68 65 20 72 75 6e 20 6e 61 6d 65 20 70 61 74 the run name pat
4090: 74 65 72 6e 20 77 69 74 68 20 3a 72 75 6e 6e 61 tern with :runna
40a0: 6d 65 20 70 61 74 74 22 29 0a 20 20 20 20 28 65 me patt"). (e
40b0: 78 69 74 20 32 29 29 0a 20 20 20 28 28 6e 6f 74 xit 2)). ((not
40c0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
40d0: 2d 74 65 73 74 70 61 74 74 22 29 29 0a 20 20 20 -testpatt")).
40e0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
40f0: 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 20 "ERROR: Missing
4100: 72 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 74 required paramet
4110: 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f 6e 20 er for " action
4120: 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 ", you must spec
4130: 69 66 79 20 74 68 65 20 74 65 73 74 20 70 61 74 ify the test pat
4140: 74 65 72 6e 20 77 69 74 68 20 2d 74 65 73 74 70 tern with -testp
4150: 61 74 74 22 29 0a 20 20 20 20 28 65 78 69 74 20 att"). (exit
4160: 33 29 29 0a 20 20 20 28 65 6c 73 65 0a 20 20 20 3)). (else.
4170: 20 28 69 66 20 28 6e 6f 74 20 28 63 61 72 20 2a (if (not (car *
4180: 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 29 0a 09 28 configinfo*))..(
4190: 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a begin.. (debug:
41a0: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
41b0: 41 74 74 65 6d 70 74 65 64 20 22 20 61 63 74 69 Attempted " acti
41c0: 6f 6e 20 22 6f 6e 20 74 65 73 74 28 73 29 20 62 on "on test(s) b
41d0: 75 74 20 72 75 6e 20 61 72 65 61 20 63 6f 6e 66 ut run area conf
41e0: 69 67 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e ig file not foun
41f0: 64 22 29 0a 09 20 20 28 65 78 69 74 20 31 29 29 d").. (exit 1))
4200: 0a 09 3b 3b 20 70 75 74 20 74 65 73 74 20 70 61 ..;; put test pa
4210: 72 61 6d 65 74 65 72 73 20 69 6e 74 6f 20 63 6f rameters into co
4220: 6e 76 65 6e 69 65 6e 74 20 76 61 72 69 61 62 6c nvenient variabl
4230: 65 73 0a 09 28 72 75 6e 73 3a 6f 70 65 72 61 74 es..(runs:operat
4240: 65 2d 6f 6e 20 20 61 63 74 69 6f 6e 0a 09 09 09 e-on action....
4250: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
4260: 22 3a 72 75 6e 6e 61 6d 65 22 29 0a 09 09 09 20 ":runname")....
4270: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4280: 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 -testpatt")....
4290: 20 73 74 61 74 65 3a 20 28 61 72 67 73 3a 67 65 state: (args:ge
42a0: 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 20 t-arg ":state")
42b0: 0a 09 09 09 20 20 73 74 61 74 75 73 3a 20 28 61 .... status: (a
42c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
42d0: 61 74 75 73 22 29 0a 09 09 09 20 20 6e 65 77 2d atus").... new-
42e0: 73 74 61 74 65 2d 73 74 61 74 75 73 3a 20 28 61 state-status: (a
42f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
4300: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 29 t-state-status")
4310: 29 29 0a 20 20 20 20 28 73 65 74 21 20 2a 64 69 )). (set! *di
4320: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
4330: 29 29 0a 09 20 20 0a 28 69 66 20 28 61 72 67 73 )).. .(if (args
4340: 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 :get-arg "-remov
4350: 65 2d 72 75 6e 73 22 29 0a 20 20 20 20 28 67 65 e-runs"). (ge
4360: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
4370: 20 20 20 20 20 22 2d 72 65 6d 6f 76 65 2d 72 75 "-remove-ru
4380: 6e 73 22 0a 20 20 20 20 20 22 72 65 6d 6f 76 65 ns". "remove
4390: 20 72 75 6e 73 22 0a 20 20 20 20 20 28 6c 61 6d runs". (lam
43a0: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
43b0: 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 ame keys keyname
43c0: 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 s keyvallst).
43d0: 20 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 (operate-on
43e0: 27 72 65 6d 6f 76 65 2d 72 75 6e 73 29 29 29 29 'remove-runs))))
43f0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
4400: 61 72 67 20 22 2d 73 65 74 2d 73 74 61 74 65 2d arg "-set-state-
4410: 73 74 61 74 75 73 22 29 0a 20 20 20 20 28 67 65 status"). (ge
4420: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
4430: 20 20 20 20 20 22 2d 73 65 74 2d 73 74 61 74 65 "-set-state
4440: 2d 73 74 61 74 75 73 22 0a 20 20 20 20 20 22 73 -status". "s
4450: 65 74 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 et state and sta
4460: 74 75 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 tus". (lambd
4470: 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
4480: 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 e keys keynames
4490: 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 20 keyvallst).
44a0: 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 (operate-on 's
44b0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 et-state-status)
44c0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
44d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
44f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
4510: 20 51 75 65 72 79 20 72 75 6e 73 0a 3b 3b 3d 3d Query runs.;;==
4520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 69 66 20 28 6f 72 20 28 61 ====..(if (or (a
4570: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
4580: 73 74 2d 72 75 6e 73 22 29 0a 09 28 61 72 67 73 st-runs")..(args
4590: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d :get-arg "-list-
45a0: 64 62 2d 74 61 72 67 65 74 73 22 29 29 0a 20 20 db-targets")).
45b0: 20 20 28 69 66 20 28 73 65 74 75 70 2d 66 6f 72 (if (setup-for
45c0: 2d 72 75 6e 29 0a 09 28 6c 65 74 2a 20 28 28 64 -run)..(let* ((d
45d0: 62 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 b #f)..
45e0: 20 20 20 20 28 72 75 6e 70 61 74 74 20 20 28 61 (runpatt (a
45f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
4600: 73 74 2d 72 75 6e 73 22 29 29 0a 09 20 20 20 20 st-runs"))..
4610: 20 20 20 28 74 65 73 74 70 61 74 74 20 28 69 66 (testpatt (if
4620: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4630: 2d 74 65 73 74 70 61 74 74 22 29 20 0a 09 09 09 -testpatt") ....
4640: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
4650: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 20 rg "-testpatt")
4660: 0a 09 09 09 20 20 20 20 20 22 25 22 29 29 0a 09 .... "%"))..
4670: 20 20 20 20 20 20 20 28 72 75 6e 73 64 61 74 20 (runsdat
4680: 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e (cdb:remote-run
4690: 20 64 62 3a 67 65 74 2d 72 75 6e 73 20 23 66 20 db:get-runs #f
46a0: 72 75 6e 70 61 74 74 20 23 66 20 23 66 20 27 28 runpatt #f #f '(
46b0: 29 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e ))).. (run
46c0: 73 20 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f s (db:get-ro
46d0: 77 73 20 72 75 6e 73 64 61 74 29 29 0a 09 20 20 ws runsdat))..
46e0: 20 20 20 20 20 28 68 65 61 64 65 72 20 20 20 28 (header (
46f0: 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 db:get-header ru
4700: 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 nsdat))..
4710: 28 6b 65 79 73 20 20 20 20 20 28 63 64 62 3a 72 (keys (cdb:r
4720: 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 emote-run db:get
4730: 2d 6b 65 79 73 20 23 66 29 29 0a 09 20 20 20 20 -keys #f))..
4740: 20 20 20 28 6b 65 79 6e 61 6d 65 73 20 28 6d 61 (keynames (ma
4750: 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e p key:get-fieldn
4760: 61 6d 65 20 6b 65 79 73 29 29 0a 09 20 20 20 20 ame keys))..
4770: 20 20 20 28 64 62 2d 74 61 72 67 65 74 73 20 28 (db-targets (
4780: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
4790: 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 29 ist-db-targets")
47a0: 29 0a 09 20 20 20 20 20 20 20 28 73 65 65 6e 20 ).. (seen
47b0: 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 (make-hash-t
47c0: 61 62 6c 65 29 29 29 0a 09 20 20 3b 3b 20 45 61 able))).. ;; Ea
47d0: 63 68 20 72 75 6e 0a 09 20 20 28 66 6f 72 2d 65 ch run.. (for-e
47e0: 61 63 68 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 ach .. (lambda
47f0: 20 28 72 75 6e 29 0a 09 20 20 20 20 20 28 6c 65 (run).. (le
4800: 74 20 28 28 74 61 72 67 65 74 73 74 72 20 28 73 t ((targetstr (s
4810: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
4820: 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 e (map (lambda (
4830: 78 29 0a 09 09 09 09 09 09 09 20 28 64 62 3a 67 x)........ (db:g
4840: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
4850: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 78 29 er run header x)
4860: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 6b )....... k
4870: 65 79 6e 61 6d 65 73 29 20 22 2f 22 29 29 29 0a eynames) "/"))).
4880: 09 20 20 20 20 20 20 20 28 69 66 20 64 62 2d 74 . (if db-t
4890: 61 72 67 65 74 73 0a 09 09 20 20 20 28 69 66 20 argets... (if
48a0: 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 (not (hash-table
48b0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 73 65 65 -ref/default see
48c0: 6e 20 74 61 72 67 65 74 73 74 72 20 23 66 29 29 n targetstr #f))
48d0: 0a 09 09 20 20 20 20 20 20 20 28 62 65 67 69 6e ... (begin
48e0: 0a 09 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 .... (hash-table
48f0: 2d 73 65 74 21 20 73 65 65 6e 20 74 61 72 67 65 -set! seen targe
4900: 74 73 74 72 20 23 74 29 0a 09 09 09 20 3b 3b 20 tstr #t).... ;;
4910: 28 70 72 69 6e 74 20 22 5b 22 20 74 61 72 67 65 (print "[" targe
4920: 74 73 74 72 20 22 5d 22 29 29 29 29 0a 09 09 09 tstr "]"))))....
4930: 20 28 70 72 69 6e 74 20 74 61 72 67 65 74 73 74 (print targetst
4940: 72 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 69 r)))).. (i
4950: 66 20 28 6e 6f 74 20 64 62 2d 74 61 72 67 65 74 f (not db-target
4960: 73 29 0a 09 09 20 20 20 28 6c 65 74 2a 20 28 28 s)... (let* ((
4970: 72 75 6e 2d 69 64 20 28 64 62 3a 67 65 74 2d 76 run-id (db:get-v
4980: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
4990: 75 6e 20 68 65 61 64 65 72 20 22 69 64 22 29 29 un header "id"))
49a0: 0a 09 09 09 20 20 28 74 65 73 74 73 20 20 28 63 .... (tests (c
49b0: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 db:remote-run db
49c0: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
49d0: 75 6e 20 23 66 20 72 75 6e 2d 69 64 20 74 65 73 un #f run-id tes
49e0: 74 70 61 74 74 20 27 28 29 20 27 28 29 29 29 29 tpatt '() '())))
49f0: 0a 09 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 ... (debug:p
4a00: 72 69 6e 74 20 31 20 22 52 75 6e 3a 20 22 20 74 rint 1 "Run: " t
4a10: 61 72 67 65 74 73 74 72 20 22 20 73 74 61 74 75 argetstr " statu
4a20: 73 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 61 6c s: " (db:get-val
4a30: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
4a40: 20 68 65 61 64 65 72 20 22 73 74 61 74 65 22 29 header "state")
4a50: 0a 09 09 09 09 20 20 22 20 72 75 6e 2d 69 64 3a ..... " run-id:
4a60: 20 22 20 72 75 6e 2d 69 64 20 22 2c 20 6e 75 6d " run-id ", num
4a70: 62 65 72 20 74 65 73 74 73 3a 20 22 20 28 6c 65 ber tests: " (le
4a80: 6e 67 74 68 20 74 65 73 74 73 29 29 0a 09 09 20 ngth tests))...
4a90: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 (for-each ..
4aa0: 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
4ab0: 74 65 73 74 29 0a 09 09 09 28 66 6f 72 6d 61 74 test)....(format
4ac0: 20 23 74 0a 09 09 09 09 22 20 20 54 65 73 74 3a #t....." Test:
4ad0: 20 7e 32 35 61 20 53 74 61 74 65 3a 20 7e 31 35 ~25a State: ~15
4ae0: 61 20 53 74 61 74 75 73 3a 20 7e 31 35 61 20 52 a Status: ~15a R
4af0: 75 6e 74 69 6d 65 3a 20 7e 35 40 61 73 20 54 69 untime: ~5@as Ti
4b00: 6d 65 3a 20 7e 32 32 61 20 48 6f 73 74 3a 20 7e me: ~22a Host: ~
4b10: 31 30 61 5c 6e 22 0a 09 09 09 09 28 63 6f 6e 63 10a\n".....(conc
4b20: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 (db:test-get-te
4b30: 73 74 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 09 stname test)....
4b40: 09 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 . (if (equa
4b50: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
4b60: 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 20 item-path test)
4b70: 22 22 29 0a 09 09 09 09 09 20 20 22 22 20 0a 09 "")...... "" ..
4b80: 09 09 09 09 20 20 28 63 6f 6e 63 20 22 28 22 20 .... (conc "("
4b90: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 (db:test-get-ite
4ba0: 6d 2d 70 61 74 68 20 74 65 73 74 29 20 22 29 22 m-path test) ")"
4bb0: 29 29 29 0a 09 09 09 09 28 64 62 3a 74 65 73 74 ))).....(db:test
4bc0: 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 29 -get-state test)
4bd0: 0a 09 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65 .....(db:test-ge
4be0: 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 0a 09 t-status test)..
4bf0: 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ...(db:test-get-
4c00: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 run_duration tes
4c10: 74 29 0a 09 09 09 09 28 64 62 3a 74 65 73 74 2d t).....(db:test-
4c20: 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 get-event_time t
4c30: 65 73 74 29 0a 09 09 09 09 28 64 62 3a 74 65 73 est).....(db:tes
4c40: 74 2d 67 65 74 2d 68 6f 73 74 20 74 65 73 74 29 t-get-host test)
4c50: 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 28 6f )....(if (not (o
4c60: 72 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 r (equal? (db:te
4c70: 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 st-get-status te
4c80: 73 74 29 20 22 50 41 53 53 22 29 0a 09 09 09 09 st) "PASS").....
4c90: 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 64 62 (equal? (db
4ca0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
4cb0: 20 74 65 73 74 29 20 22 57 41 52 4e 22 29 0a 09 test) "WARN")..
4cc0: 09 09 09 20 20 20 20 20 28 65 71 75 61 6c 3f 20 ... (equal?
4cd0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
4ce0: 74 65 20 74 65 73 74 29 20 20 22 4e 4f 54 5f 53 te test) "NOT_S
4cf0: 54 41 52 54 45 44 22 29 29 29 0a 09 09 09 20 20 TARTED")))....
4d00: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 (begin....
4d10: 20 20 28 70 72 69 6e 74 20 22 20 20 20 20 20 20 (print "
4d20: 20 20 20 63 70 75 6c 6f 61 64 3a 20 20 22 20 28 cpuload: " (
4d30: 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 70 75 6c db:test-get-cpul
4d40: 6f 61 64 20 74 65 73 74 29 0a 09 09 09 09 20 20 oad test).....
4d50: 20 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 64 "\n d
4d60: 69 73 6b 66 72 65 65 3a 20 22 20 28 64 62 3a 74 iskfree: " (db:t
4d70: 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 65 est-get-diskfree
4d80: 20 74 65 73 74 29 0a 09 09 09 09 20 20 20 20 20 test).....
4d90: 22 5c 6e 20 20 20 20 20 20 20 20 20 75 6e 61 6d "\n unam
4da0: 65 3a 20 20 20 20 22 20 28 64 62 3a 74 65 73 74 e: " (db:test
4db0: 2d 67 65 74 2d 75 6e 61 6d 65 20 74 65 73 74 29 -get-uname test)
4dc0: 0a 09 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 ..... "\n
4dd0: 20 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 20 rundir:
4de0: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 " (db:test-get-r
4df0: 75 6e 64 69 72 20 74 65 73 74 29 0a 09 09 09 09 undir test).....
4e00: 20 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 20 )....
4e10: 3b 3b 20 45 61 63 68 20 74 65 73 74 0a 09 09 09 ;; Each test....
4e20: 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 ;; DO NOT
4e30: 72 65 6d 6f 74 65 20 72 75 6e 0a 09 09 09 20 20 remote run....
4e40: 20 20 20 20 28 6c 65 74 20 28 28 73 74 65 70 73 (let ((steps
4e50: 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 (db:get-steps-f
4e60: 6f 72 2d 74 65 73 74 20 23 66 20 28 64 62 3a 74 or-test #f (db:t
4e70: 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 29 est-get-id test)
4e80: 29 29 29 0a 09 09 09 09 28 66 6f 72 2d 65 61 63 ))).....(for-eac
4e90: 68 20 0a 09 09 09 09 20 28 6c 61 6d 62 64 61 20 h ..... (lambda
4ea0: 28 73 74 65 70 29 0a 09 09 09 09 20 20 20 28 66 (step)..... (f
4eb0: 6f 72 6d 61 74 20 23 74 20 0a 09 09 09 09 09 20 ormat #t ......
4ec0: 20 20 22 20 20 20 20 53 74 65 70 3a 20 7e 32 30 " Step: ~20
4ed0: 61 20 53 74 61 74 65 3a 20 7e 31 30 61 20 53 74 a State: ~10a St
4ee0: 61 74 75 73 3a 20 7e 31 30 61 20 54 69 6d 65 20 atus: ~10a Time
4ef0: 7e 32 32 61 5c 6e 22 0a 09 09 09 09 09 20 20 20 ~22a\n"......
4f00: 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 (db:step-get-ste
4f10: 70 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 09 09 pname step).....
4f20: 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 . (db:step-get
4f30: 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 09 09 -state step)....
4f40: 09 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 .. (db:step-ge
4f50: 74 2d 73 74 61 74 75 73 20 73 74 65 70 29 0a 09 t-status step)..
4f60: 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 2d .... (db:step-
4f70: 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 get-event_time s
4f80: 74 65 70 29 29 29 0a 09 09 09 09 20 73 74 65 70 tep)))..... step
4f90: 73 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 74 s)))))... t
4fa0: 65 73 74 73 29 29 29 29 29 0a 09 20 20 20 20 20 ests)))))..
4fb0: 72 75 6e 73 29 0a 09 20 20 20 28 73 65 74 21 20 runs).. (set!
4fc0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
4fd0: 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d t))))..;;=======
4fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
5020: 3b 3b 20 66 75 6c 6c 20 72 75 6e 0a 3b 3b 3d 3d ;; full run.;;==
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 3d ================
5060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5070: 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 20 6c 6f 63 ====..;; get loc
5080: 6b 20 69 6e 20 64 62 20 66 6f 72 20 66 75 6c 6c k in db for full
5090: 20 72 75 6e 20 66 6f 72 20 74 68 69 73 20 64 69 run for this di
50a0: 72 65 63 74 6f 72 79 0a 3b 3b 20 66 6f 72 20 61 rectory.;; for a
50b0: 6c 6c 20 74 65 73 74 73 20 77 69 74 68 20 64 65 ll tests with de
50c0: 70 73 0a 3b 3b 20 20 20 77 61 6c 6b 20 74 72 65 ps.;; walk tre
50d0: 65 20 6f 66 20 74 65 73 74 73 20 74 6f 20 66 69 e of tests to fi
50e0: 6e 64 20 68 65 61 64 20 74 61 73 6b 73 0a 3b 3b nd head tasks.;;
50f0: 20 20 20 61 64 64 20 68 65 61 64 20 74 61 73 6b add head task
5100: 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 0a s to task queue.
5110: 3b 3b 20 20 20 61 64 64 20 64 65 70 65 6e 64 61 ;; add dependa
5120: 6e 74 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b nt tasks to task
5130: 20 71 75 65 75 65 20 0a 3b 3b 20 20 20 61 64 64 queue .;; add
5140: 20 72 65 6d 61 69 6e 69 6e 67 20 74 61 73 6b 73 remaining tasks
5150: 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 0a 3b to task queue.;
5160: 3b 20 66 6f 72 20 65 61 63 68 20 74 61 73 6b 20 ; for each task
5170: 69 6e 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b in task queue.;;
5180: 20 20 20 69 66 20 68 61 76 65 20 61 64 65 71 75 if have adequ
5190: 61 74 65 20 72 65 73 6f 75 72 63 65 73 0a 3b 3b ate resources.;;
51a0: 20 20 20 20 20 6c 61 75 6e 63 68 20 74 61 73 6b launch task
51b0: 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b 20 20 20 .;; else.;;
51c0: 20 20 70 75 74 20 74 61 73 6b 20 69 6e 20 64 65 put task in de
51d0: 66 65 72 72 65 64 20 71 75 65 75 65 0a 3b 3b 20 ferred queue.;;
51e0: 69 66 20 73 74 69 6c 6c 20 6f 6b 20 74 6f 20 72 if still ok to r
51f0: 75 6e 20 74 61 73 6b 73 0a 3b 3b 20 20 20 70 72 un tasks.;; pr
5200: 6f 63 65 73 73 20 64 65 66 65 72 72 65 64 20 74 ocess deferred t
5210: 61 73 6b 73 20 70 65 72 20 61 62 6f 76 65 20 73 asks per above s
5220: 74 65 70 73 0a 0a 3b 3b 20 72 75 6e 20 61 6c 6c teps..;; run all
5230: 20 74 65 73 74 73 20 61 72 65 20 61 72 65 20 4e tests are are N
5240: 6f 74 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 ot COMPLETED and
5250: 20 50 41 53 53 20 6f 72 20 43 48 45 43 4b 0a 28 PASS or CHECK.(
5260: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
5270: 20 22 2d 72 75 6e 61 6c 6c 22 29 0a 20 20 20 20 "-runall").
5280: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
5290: 6c 20 0a 20 20 20 20 20 22 2d 72 75 6e 61 6c 6c l . "-runall
52a0: 22 0a 20 20 20 20 20 22 72 75 6e 20 61 6c 6c 20 ". "run all
52b0: 74 65 73 74 73 22 0a 20 20 20 20 20 28 6c 61 6d tests". (lam
52c0: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
52d0: 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 ame keys keyname
52e0: 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 s keyvallst).
52f0: 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 (runs:run-te
5300: 73 74 73 20 74 61 72 67 65 74 0a 09 09 20 20 20 sts target...
5310: 20 20 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 runname...
5320: 20 20 20 20 20 22 25 22 0a 09 09 20 20 20 20 20 "%"...
5330: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
5340: 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 20 "-testpatt")...
5350: 20 20 20 20 20 20 75 73 65 72 0a 09 09 20 20 20 user...
5360: 20 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 73 args:arg-has
5370: 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d h))))..;;=======
5380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
53c0: 3b 3b 20 72 75 6e 20 6f 6e 65 20 74 65 73 74 0a ;; run one test.
53d0: 3b 3b 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 3d ================
5400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5410: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e 20 ========..;; 1.
5420: 66 69 6e 64 20 74 68 65 20 63 6f 6e 66 69 67 20 find the config
5430: 66 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 61 6e 67 file.;; 2. chang
5440: 65 20 74 6f 20 74 68 65 20 74 65 73 74 20 64 69 e to the test di
5450: 72 65 63 74 6f 72 79 0a 3b 3b 20 33 2e 20 75 70 rectory.;; 3. up
5460: 64 61 74 65 20 74 68 65 20 64 62 20 77 69 74 68 date the db with
5470: 20 22 74 65 73 74 20 73 74 61 72 74 65 64 22 20 "test started"
5480: 73 74 61 74 75 73 2c 20 73 65 74 20 72 75 6e 6e status, set runn
5490: 69 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 2e 20 70 ing host.;; 4. p
54a0: 72 6f 63 65 73 73 20 6c 61 75 6e 63 68 20 74 68 rocess launch th
54b0: 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 6d e test.;; - m
54c0: 6f 6e 69 74 6f 72 20 74 68 65 20 70 72 6f 63 65 onitor the proce
54d0: 73 73 2c 20 75 70 64 61 74 65 20 73 74 61 74 73 ss, update stats
54e0: 20 69 6e 20 74 68 65 20 64 62 20 65 76 65 72 79 in the db every
54f0: 20 32 5e 6e 20 6d 69 6e 75 74 65 73 0a 3b 3b 20 2^n minutes.;;
5500: 35 2e 20 61 73 20 74 68 65 20 74 65 73 74 20 70 5. as the test p
5510: 72 6f 63 65 65 64 73 20 69 6e 74 65 72 6e 61 6c roceeds internal
5520: 6c 79 20 69 74 20 63 61 6c 6c 73 20 6d 65 67 61 ly it calls mega
5530: 74 65 73 74 20 61 73 20 65 61 63 68 20 73 74 65 test as each ste
5540: 70 20 69 73 0a 3b 3b 20 20 20 20 73 74 61 72 74 p is.;; start
5550: 65 64 20 61 6e 64 20 63 6f 6d 70 6c 65 74 65 64 ed and completed
5560: 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 73 74 .;; - step st
5570: 61 72 74 65 64 2c 20 74 69 6d 65 73 74 61 6d 70 arted, timestamp
5580: 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 63 6f .;; - step co
5590: 6d 70 6c 65 74 65 64 2c 20 65 78 69 74 20 73 74 mpleted, exit st
55a0: 61 74 75 73 2c 20 74 69 6d 65 73 74 61 6d 70 0a atus, timestamp.
55b0: 3b 3b 20 36 2e 20 74 65 73 74 20 70 68 6f 6e 65 ;; 6. test phone
55c0: 20 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d 20 69 66 home.;; - if
55d0: 20 74 65 73 74 20 72 75 6e 20 74 69 6d 65 20 3e test run time >
55e0: 20 61 6c 6c 6f 77 65 64 20 72 75 6e 20 74 69 6d allowed run tim
55f0: 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a e then kill job.
5600: 3b 3b 20 20 20 20 2d 20 69 66 20 63 61 6e 6e 6f ;; - if canno
5610: 74 20 61 63 63 65 73 73 20 64 62 20 3e 20 61 6c t access db > al
5620: 6c 6f 77 65 64 20 64 69 73 63 6f 6e 6e 65 63 74 lowed disconnect
5630: 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 time then kill
5640: 6a 6f 62 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 job..(if (args:g
5650: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
5660: 73 22 29 0a 20 20 28 67 65 6e 65 72 61 6c 2d 72 s"). (general-r
5670: 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 22 2d 72 75 un-call . "-ru
5680: 6e 74 65 73 74 73 22 20 0a 20 20 20 22 72 75 6e ntests" . "run
5690: 20 61 20 74 65 73 74 22 20 0a 20 20 20 28 6c 61 a test" . (la
56a0: 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
56b0: 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d name keys keynam
56c0: 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 es keyvallst).
56d0: 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 (runs:run-tes
56e0: 74 73 20 74 61 72 67 65 74 0a 09 09 20 20 20 20 ts target...
56f0: 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 20 20 20 runname...
5700: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5710: 72 75 6e 74 65 73 74 73 22 29 0a 09 09 20 20 20 runtests")...
5720: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
5730: 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 20 "-testpatt")...
5740: 20 20 20 20 75 73 65 72 0a 09 09 20 20 20 20 20 user...
5750: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 args:arg-hash)))
5760: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
5770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 ===========.;; R
57b0: 6f 6c 6c 75 70 20 69 6e 74 6f 20 61 20 72 75 6e ollup into a run
57c0: 0a 3b 3b 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 3d 3d 3d 3d 3d ================
57f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
5810: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
5820: 6f 6c 6c 75 70 22 29 0a 20 20 20 20 28 62 65 67 ollup"). (beg
5830: 69 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a in. (debug:
5840: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
5850: 52 6f 6c 6c 75 70 20 69 73 20 63 75 72 72 65 6e Rollup is curren
5860: 74 6c 79 20 6e 6f 74 20 77 6f 72 6b 69 6e 67 2e tly not working.
5870: 20 49 66 20 79 6f 75 20 6e 65 65 64 20 69 74 20 If you need it
5880: 70 6c 65 61 73 65 20 73 75 62 6d 69 74 20 61 20 please submit a
5890: 74 69 63 6b 65 74 20 61 74 20 68 74 74 70 3a 2f ticket at http:/
58a0: 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f /www.kiatoa.com/
58b0: 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 fossils/megatest
58c0: 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 34 "). (exit 4
58d0: 29 29 29 0a 3b 3b 20 20 20 20 20 28 67 65 6e 65 ))).;; (gene
58e0: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 3b 3b ral-run-call .;;
58f0: 20 20 20 20 20 20 22 2d 72 6f 6c 6c 75 70 22 20 "-rollup"
5900: 0a 3b 3b 20 20 20 20 20 20 22 72 6f 6c 6c 75 70 .;; "rollup
5910: 20 74 65 73 74 73 22 20 0a 3b 3b 20 20 20 20 20 tests" .;;
5920: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
5930: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
5940: 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 ynames keyvallst
5950: 29 0a 3b 3b 20 20 20 20 20 20 20 20 28 72 75 6e ).;; (run
5960: 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 6b 65 79 s:rollup-run key
5970: 73 0a 3b 3b 20 09 09 09 28 6b 65 79 73 2d 3e 61 s.;; ...(keys->a
5980: 6c 69 73 74 20 6b 65 79 73 20 22 6e 61 22 29 0a list keys "na").
5990: 3b 3b 20 09 09 09 28 61 72 67 73 3a 67 65 74 2d ;; ...(args:get-
59a0: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 arg ":runname")
59b0: 0a 3b 3b 20 09 09 09 75 73 65 72 29 29 29 29 0a .;; ...user)))).
59c0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
59d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 6f 63 =========.;; Loc
5a10: 6b 20 6f 72 20 75 6e 6c 6f 63 6b 20 61 20 72 75 k or unlock a ru
5a20: 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d n.;;============
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 3d 3d 3d 3d 3d 3d 3d ================
5a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
5a70: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
5a80: 67 20 22 2d 6c 6f 63 6b 22 29 28 61 72 67 73 3a g "-lock")(args:
5a90: 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b get-arg "-unlock
5aa0: 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c ")). (general
5ab0: 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 -run-call .
5ac0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
5ad0: 67 20 22 2d 6c 6f 63 6b 22 29 20 22 2d 6c 6f 63 g "-lock") "-loc
5ae0: 6b 22 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 20 k" "-unlock").
5af0: 20 20 20 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 20 "lock/unlock
5b00: 74 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c 61 tests" . (la
5b10: 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
5b20: 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d name keys keynam
5b30: 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 es keyvallst).
5b40: 20 20 20 20 20 28 72 75 6e 73 3a 68 61 6e 64 6c (runs:handl
5b50: 65 2d 6c 6f 63 6b 69 6e 67 20 0a 09 09 20 20 74 e-locking ... t
5b60: 61 72 67 65 74 0a 09 09 20 20 6b 65 79 73 0a 09 arget... keys..
5b70: 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 . (args:get-arg
5b80: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 0a 09 09 ":runname") ...
5b90: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
5ba0: 22 2d 6c 6f 63 6b 22 29 0a 09 09 20 20 28 61 72 "-lock")... (ar
5bb0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c gs:get-arg "-unl
5bc0: 6f 63 6b 22 29 0a 09 09 20 20 75 73 65 72 29 29 ock")... user))
5bd0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
5be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
5c20: 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 Get paths to tes
5c30: 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ts.;;===========
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 3d 3d 3d 3d ================
5c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 ===========.;; G
5c80: 65 74 20 74 65 73 74 20 70 61 74 68 73 20 6d 61 et test paths ma
5c90: 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 tching target, r
5ca0: 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 65 73 74 unname, and test
5cb0: 70 61 74 74 0a 28 69 66 20 28 6f 72 20 28 61 72 patt.(if (or (ar
5cc0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
5cd0: 74 2d 66 69 6c 65 73 22 29 28 61 72 67 73 3a 67 t-files")(args:g
5ce0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 70 61 et-arg "-test-pa
5cf0: 74 68 73 22 29 29 0a 20 20 20 20 3b 3b 20 69 66 ths")). ;; if
5d00: 20 77 65 20 61 72 65 20 69 6e 20 61 20 74 65 73 we are in a tes
5d10: 74 20 75 73 65 20 74 68 65 20 4d 54 5f 43 4d 44 t use the MT_CMD
5d20: 49 4e 46 4f 20 64 61 74 61 0a 20 20 20 20 28 69 INFO data. (i
5d30: 66 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d f (getenv "MT_CM
5d40: 44 49 4e 46 4f 22 29 0a 09 28 6c 65 74 2a 20 28 DINFO")..(let* (
5d50: 28 73 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 (startingdir (cu
5d60: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
5d70: 29 0a 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e ).. (cmdin
5d80: 66 6f 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e fo (read (open
5d90: 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 -input-string (b
5da0: 61 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 ase64:base64-dec
5db0: 6f 64 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f ode (getenv "MT_
5dc0: 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 CMDINFO")))))..
5dd0: 20 20 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 6d ;; (runrem
5de0: 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ote (assoc/defau
5df0: 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 6d lt 'runremote cm
5e00: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
5e10: 28 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f (transport (asso
5e20: 63 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 c/default 'trans
5e30: 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 port cmdinfo))..
5e40: 20 20 20 20 20 20 20 28 74 65 73 74 70 61 74 68 (testpath
5e50: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
5e60: 20 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 'testpath cmdi
5e70: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
5e80: 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f est-name (assoc/
5e90: 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 default 'test-na
5ea0: 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 me cmdinfo))..
5eb0: 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 (runscript
5ec0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
5ed0: 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 runscript cmdinf
5ee0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d o)).. (db-
5ef0: 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 host (assoc/de
5f00: 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 fault 'db-host
5f10: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
5f20: 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 (run-id (a
5f30: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
5f40: 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 n-id cmdinfo)
5f50: 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 ).. (itemd
5f60: 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 at (assoc/defa
5f70: 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 ult 'itemdat c
5f80: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
5f90: 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 0a (db #f).
5fa0: 09 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 . (state
5fb0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
5fc0: 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 ":state"))..
5fd0: 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 (status (
5fe0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 args:get-arg ":s
5ff0: 74 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 tatus"))..
6000: 20 28 74 61 72 67 65 74 20 20 20 20 28 61 72 67 (target (arg
6010: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 s:get-arg "-targ
6020: 65 74 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 et")).. (t
6030: 6f 70 70 61 74 68 20 20 20 28 61 73 73 6f 63 2f oppath (assoc/
6040: 64 65 66 61 75 6c 74 20 27 74 6f 70 70 61 74 68 default 'toppath
6050: 20 20 20 63 6d 64 69 6e 66 6f 29 29 29 0a 09 20 cmdinfo)))..
6060: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
6070: 72 79 20 74 6f 70 70 61 74 68 29 0a 09 20 20 3b ry toppath).. ;
6080: 3b 20 28 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f ; (set! *runremo
6090: 74 65 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 te* runremote)..
60a0: 20 20 28 73 65 74 21 20 2a 74 72 61 6e 73 70 6f (set! *transpo
60b0: 72 74 2d 74 79 70 65 2a 20 28 73 74 72 69 6e 67 rt-type* (string
60c0: 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 6e 73 70 6f ->symbol transpo
60d0: 72 74 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 rt)).. (if (not
60e0: 20 74 61 72 67 65 74 29 0a 09 20 20 20 20 20 20 target)..
60f0: 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a (begin...(debug:
6100: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
6110: 2d 74 61 72 67 65 74 20 69 73 20 72 65 71 75 69 -target is requi
6120: 72 65 64 2e 22 29 0a 09 09 28 65 78 69 74 20 31 red.")...(exit 1
6130: 29 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 ))).. (if (not
6140: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
6150: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
6160: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
6170: 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 "Failed to setup
6180: 2c 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 2d , giving up on -
6190: 74 65 73 74 2d 70 61 74 68 73 20 6f 72 20 2d 74 test-paths or -t
61a0: 65 73 74 2d 66 69 6c 65 73 2c 20 65 78 69 74 69 est-files, exiti
61b0: 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 ng")...(exit 1))
61c0: 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 ).. (let* ((key
61d0: 73 20 20 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 s (cdb:remot
61e0: 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 79 e-run db:get-key
61f0: 73 20 64 62 29 29 0a 09 09 20 28 6b 65 79 6e 61 s db))... (keyna
6200: 6d 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 mes (map key:get
6210: 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 -fieldname keys)
6220: 29 0a 09 09 20 3b 3b 20 64 62 3a 74 65 73 74 2d )... ;; db:test-
6230: 67 65 74 2d 70 61 74 68 73 20 6d 75 73 74 20 6e get-paths must n
6240: 6f 74 20 62 65 20 72 75 6e 20 72 65 6d 6f 74 65 ot be run remote
6250: 0a 09 09 20 28 70 61 74 68 73 20 20 20 20 28 64 ... (paths (d
6260: 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 b:test-get-paths
6270: 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 -matching db key
6280: 6e 61 6d 65 73 20 74 61 72 67 65 74 20 28 61 72 names target (ar
6290: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
62a0: 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 20 t-files"))))..
62b0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
62c0: 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 thing* #t)..
62d0: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
62e0: 61 20 28 70 61 74 68 29 0a 09 09 09 28 70 72 69 a (path)....(pri
62f0: 6e 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 nt path))...
6300: 20 20 70 61 74 68 73 29 29 29 0a 09 3b 3b 20 65 paths)))..;; e
6310: 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 6c lse do a general
6320: 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 -run-call..(gene
6330: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 ral-run-call ..
6340: 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 0a 09 20 "-test-files"..
6350: 22 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 "Get paths to te
6360: 73 74 22 0a 09 20 28 6c 61 6d 62 64 61 20 28 74 st".. (lambda (t
6370: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
6380: 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 ys keynames keyv
6390: 61 6c 6c 73 74 29 0a 09 20 20 20 28 6c 65 74 2a allst).. (let*
63a0: 20 28 28 64 62 20 20 20 20 20 20 20 23 66 29 0a ((db #f).
63b0: 09 09 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 .. ;; DO NOT ru
63c0: 6e 20 72 65 6d 6f 74 65 0a 09 09 20 20 28 70 61 n remote... (pa
63d0: 74 68 73 20 20 20 20 28 64 62 3a 74 65 73 74 2d ths (db:test-
63e0: 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 get-paths-matchi
63f0: 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 ng db keynames t
6400: 61 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d arget (args:get-
6410: 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 arg "-test-files
6420: 22 29 29 29 29 0a 09 20 20 20 20 20 28 66 6f 72 ")))).. (for
6430: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 -each (lambda (p
6440: 61 74 68 29 0a 09 09 09 20 28 70 72 69 6e 74 20 ath).... (print
6450: 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 20 path))...
6460: 70 61 74 68 73 29 29 29 29 29 29 0a 0a 3b 3b 3d paths))))))..;;=
6470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
64a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
64b0: 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 =====.;; Archive
64c0: 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d tests.;;=======
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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
6510: 3b 3b 20 41 72 63 68 69 76 65 20 74 65 73 74 73 ;; Archive tests
6520: 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 74 matching target
6530: 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 , runname, and t
6540: 65 73 74 70 61 74 74 0a 28 69 66 20 28 61 72 67 estpatt.(if (arg
6550: 73 3a 67 65 74 2d 61 72 67 20 22 2d 61 72 63 68 s:get-arg "-arch
6560: 69 76 65 22 29 0a 20 20 20 20 3b 3b 20 69 66 20 ive"). ;; if
6570: 77 65 20 61 72 65 20 69 6e 20 61 20 74 65 73 74 we are in a test
6580: 20 75 73 65 20 74 68 65 20 4d 54 5f 43 4d 44 49 use the MT_CMDI
6590: 4e 46 4f 20 64 61 74 61 0a 20 20 20 20 28 69 66 NFO data. (if
65a0: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
65b0: 49 4e 46 4f 22 29 0a 09 28 6c 65 74 2a 20 28 28 INFO")..(let* ((
65c0: 73 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 72 startingdir (cur
65d0: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 rent-directory))
65e0: 0a 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 .. (cmdinf
65f0: 6f 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d o (read (open-
6600: 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 input-string (ba
6610: 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f se64:base64-deco
6620: 64 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 de (getenv "MT_C
6630: 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 MDINFO")))))..
6640: 20 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 6d 6f ;; (runremo
6650: 74 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c te (assoc/defaul
6660: 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 6d 64 t 'runremote cmd
6670: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
6680: 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 transport (assoc
6690: 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 /default 'transp
66a0: 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ort cmdinfo))..
66b0: 20 20 20 20 20 20 28 74 65 73 74 70 61 74 68 20 (testpath
66c0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
66d0: 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 'testpath cmdin
66e0: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 fo)).. (te
66f0: 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 st-name (assoc/d
6700: 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d efault 'test-nam
6710: 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 e cmdinfo))..
6720: 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 (runscript (
6730: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
6740: 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f unscript cmdinfo
6750: 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 )).. (db-h
6760: 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 ost (assoc/def
6770: 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 ault 'db-host
6780: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
6790: 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 (run-id (as
67a0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
67b0: 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 -id cmdinfo))
67c0: 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 .. (itemda
67d0: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
67e0: 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d lt 'itemdat cm
67f0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
6800: 28 64 62 20 20 20 20 20 20 20 20 23 66 29 0a 09 (db #f)..
6810: 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 (state
6820: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
6830: 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 ":state"))..
6840: 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 61 (status (a
6850: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
6860: 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 atus"))..
6870: 28 74 61 72 67 65 74 20 20 20 20 28 61 72 67 73 (target (args
6880: 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 :get-arg "-targe
6890: 74 22 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 t"))).. (change
68a0: 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 -directory testp
68b0: 61 74 68 29 0a 09 20 20 3b 3b 20 28 73 65 74 21 ath).. ;; (set!
68c0: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e *runremote* run
68d0: 72 65 6d 6f 74 65 29 0a 09 20 20 28 73 65 74 21 remote).. (set!
68e0: 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 *transport-type
68f0: 2a 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f * (string->symbo
6900: 6c 20 74 72 61 6e 73 70 6f 72 74 29 29 0a 09 20 l transport))..
6910: 20 28 69 66 20 28 6e 6f 74 20 74 61 72 67 65 74 (if (not target
6920: 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ).. (begin.
6930: 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ..(debug:print 0
6940: 20 22 45 52 52 4f 52 3a 20 2d 74 61 72 67 65 74 "ERROR: -target
6950: 20 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 0a is required.").
6960: 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 ..(exit 1)))..
6970: 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d (if (not (setup-
6980: 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 for-run))..
6990: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
69a0: 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 :print 0 "Failed
69b0: 20 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 6e to setup, givin
69c0: 67 20 75 70 20 6f 6e 20 2d 61 72 63 68 69 76 65 g up on -archive
69d0: 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 , exiting")...(e
69e0: 78 69 74 20 31 29 29 29 0a 09 20 20 28 6c 65 74 xit 1))).. (let
69f0: 2a 20 28 28 6b 65 79 73 20 20 20 20 20 28 63 64 * ((keys (cd
6a00: 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a b:remote-run db:
6a10: 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 09 get-keys db))...
6a20: 20 28 6b 65 79 6e 61 6d 65 73 20 28 6d 61 70 20 (keynames (map
6a30: 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d key:get-fieldnam
6a40: 65 20 6b 65 79 73 29 29 0a 09 09 20 3b 3b 20 44 e keys))... ;; D
6a50: 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 O NOT run remote
6a60: 0a 09 09 20 28 70 61 74 68 73 20 20 20 20 28 64 ... (paths (d
6a70: 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 b:test-get-paths
6a80: 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 -matching db key
6a90: 6e 61 6d 65 73 20 74 61 72 67 65 74 29 29 29 0a names target))).
6aa0: 09 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 . (set! *dids
6ab0: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 omething* #t)..
6ac0: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
6ad0: 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 28 mbda (path)....(
6ae0: 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 20 print path))...
6af0: 20 20 20 20 20 70 61 74 68 73 29 29 29 0a 09 3b paths)))..;
6b00: 3b 20 65 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 ; else do a gene
6b10: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 ral-run-call..(g
6b20: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
6b30: 0a 09 20 22 2d 74 65 73 74 2d 70 61 74 68 73 22 .. "-test-paths"
6b40: 0a 09 20 22 47 65 74 20 70 61 74 68 73 20 74 6f .. "Get paths to
6b50: 20 74 65 73 74 73 22 0a 09 20 28 6c 61 6d 62 64 tests".. (lambd
6b60: 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
6b70: 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 e keys keynames
6b80: 6b 65 79 76 61 6c 6c 73 74 29 0a 09 20 20 20 28 keyvallst).. (
6b90: 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 let* ((db
6ba0: 23 66 29 0a 09 09 20 20 3b 3b 20 44 4f 20 4e 4f #f)... ;; DO NO
6bb0: 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 T run remote...
6bc0: 20 28 70 61 74 68 73 20 20 20 20 28 64 62 3a 74 (paths (db:t
6bd0: 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 est-get-paths-ma
6be0: 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d tching db keynam
6bf0: 65 73 20 74 61 72 67 65 74 29 29 29 0a 09 20 20 es target)))..
6c00: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
6c10: 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 20 mbda (path)....
6c20: 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 (print path))...
6c30: 20 20 20 20 20 20 20 70 61 74 68 73 29 29 29 29 paths))))
6c40: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
6c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
6c90: 45 78 74 72 61 63 74 20 61 20 73 70 72 65 61 64 Extract a spread
6ca0: 73 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 72 sheet from the r
6cb0: 75 6e 73 20 64 61 74 61 62 61 73 65 0a 3b 3b 3d uns database.;;=
6cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d00: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
6d10: 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 61 :get-arg "-extra
6d20: 63 74 2d 6f 64 73 22 29 0a 20 20 20 20 28 67 65 ct-ods"). (ge
6d30: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 neral-run-call.
6d40: 20 20 20 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 "-extract-od
6d50: 73 22 0a 20 20 20 20 20 22 4d 61 6b 65 20 6f 64 s". "Make od
6d60: 73 20 73 70 72 65 61 64 73 68 65 65 74 22 0a 20 s spreadsheet".
6d70: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
6d80: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
6d90: 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c keynames keyval
6da0: 6c 73 74 29 0a 20 20 20 20 20 20 20 28 6c 65 74 lst). (let
6db0: 20 28 28 64 62 20 20 20 20 20 20 20 20 20 23 66 ((db #f
6dc0: 29 0a 09 20 20 20 20 20 28 6f 75 74 70 75 74 66 ).. (outputf
6dd0: 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ile (args:get-ar
6de0: 67 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 g "-extract-ods"
6df0: 29 29 0a 09 20 20 20 20 20 28 72 75 6e 73 70 61 )).. (runspa
6e00: 74 74 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 tt (args:get-a
6e10: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a rg ":runname")).
6e20: 09 20 20 20 20 20 28 70 61 74 68 6d 6f 64 20 20 . (pathmod
6e30: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
6e40: 22 2d 70 61 74 68 6d 6f 64 22 29 29 0a 09 20 20 "-pathmod"))..
6e50: 20 20 20 28 6b 65 79 76 61 6c 61 6c 69 73 74 20 (keyvalalist
6e60: 28 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 79 (keys->alist key
6e70: 73 20 22 25 22 29 29 29 0a 09 20 28 64 65 62 75 s "%"))).. (debu
6e80: 67 3a 70 72 69 6e 74 20 32 20 22 45 78 74 72 61 g:print 2 "Extra
6e90: 63 74 20 6f 64 73 2c 20 6f 75 74 70 75 74 66 69 ct ods, outputfi
6ea0: 6c 65 3a 20 22 20 6f 75 74 70 75 74 66 69 6c 65 le: " outputfile
6eb0: 20 22 20 72 75 6e 73 70 61 74 74 3a 20 22 20 72 " runspatt: " r
6ec0: 75 6e 73 70 61 74 74 20 22 20 6b 65 79 76 61 6c unspatt " keyval
6ed0: 61 6c 69 73 74 3a 20 22 20 6b 65 79 76 61 6c 61 alist: " keyvala
6ee0: 6c 69 73 74 29 0a 09 20 28 63 64 62 3a 72 65 6d list).. (cdb:rem
6ef0: 6f 74 65 2d 72 75 6e 20 64 62 3a 65 78 74 72 61 ote-run db:extra
6f00: 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 20 6f ct-ods-file db o
6f10: 75 74 70 75 74 66 69 6c 65 20 6b 65 79 76 61 6c utputfile keyval
6f20: 61 6c 69 73 74 20 28 69 66 20 72 75 6e 73 70 61 alist (if runspa
6f30: 74 74 20 72 75 6e 73 70 61 74 74 20 22 25 22 29 tt runspatt "%")
6f40: 20 70 61 74 68 6d 6f 64 29 29 29 29 29 0a 0a 3b pathmod)))))..;
6f50: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
6f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f90: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 63 75 =======.;; execu
6fa0: 74 65 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 te the test.;;
6fb0: 20 20 2d 20 67 65 74 73 20 63 61 6c 6c 65 64 20 - gets called
6fc0: 6f 6e 20 72 65 6d 6f 74 65 20 68 6f 73 74 0a 3b on remote host.;
6fd0: 3b 20 20 20 20 2d 20 72 65 63 65 69 76 65 73 20 ; - receives
6fe0: 69 6e 66 6f 20 66 72 6f 6d 20 74 68 65 20 2d 65 info from the -e
6ff0: 78 65 63 75 74 65 20 70 61 72 61 6d 0a 3b 3b 20 xecute param.;;
7000: 20 20 20 2d 20 70 61 73 73 65 73 20 69 6e 66 6f - passes info
7010: 20 74 6f 20 73 74 65 70 73 20 76 69 61 20 4d 54 to steps via MT
7020: 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 _CMDINFO env var
7030: 20 28 66 75 74 75 72 65 20 69 73 20 74 6f 20 75 (future is to u
7040: 73 65 20 61 20 64 6f 74 20 66 69 6c 65 29 0a 3b se a dot file).;
7050: 3b 20 20 20 20 2d 20 67 61 74 68 65 72 73 20 68 ; - gathers h
7060: 6f 73 74 20 69 6e 66 6f 20 61 6e 64 20 0a 3b 3b ost info and .;;
7070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70b0: 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 ======..(if (arg
70c0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 s:get-arg "-exec
70d0: 75 74 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e ute"). (begin
70e0: 0a 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 65 . (launch:e
70f0: 78 65 63 75 74 65 20 28 61 72 67 73 3a 67 65 74 xecute (args:get
7100: 2d 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 -arg "-execute")
7110: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
7120: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
7130: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
7140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
7180: 54 65 73 74 20 63 6f 6d 6d 61 6e 64 73 20 28 69 Test commands (i
7190: 2e 65 2e 20 66 6f 72 20 75 73 65 20 69 6e 73 69 .e. for use insi
71a0: 64 65 20 74 65 73 74 73 29 0a 3b 3b 3d 3d 3d 3d de tests).;;====
71b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71f0: 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 6d 65 67 ==..(define (meg
7200: 61 74 65 73 74 3a 73 74 65 70 20 73 74 65 70 20 atest:step step
7210: 73 74 61 74 65 20 73 74 61 74 75 73 20 6c 6f 67 state status log
7220: 66 69 6c 65 20 6d 73 67 29 0a 20 20 28 69 66 20 file msg). (if
7230: 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 4d 54 (not (getenv "MT
7240: 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 20 20 20 20 _CMDINFO")).
7250: 20 20 28 62 65 67 69 6e 0a 09 28 64 65 62 75 67 (begin..(debug
7260: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
7270: 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 MT_CMDINFO env
7280: 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 2d 73 74 var not set, -st
7290: 65 70 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 ep must be calle
72a0: 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 d *inside* a meg
72b0: 61 74 65 73 74 20 69 6e 76 6f 6b 65 64 20 65 6e atest invoked en
72c0: 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 28 65 vironment!")..(e
72d0: 78 69 74 20 35 29 29 0a 20 20 20 20 20 20 28 6c xit 5)). (l
72e0: 65 74 2a 20 28 28 63 6d 64 69 6e 66 6f 20 20 20 et* ((cmdinfo
72f0: 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 (read (open-inpu
7300: 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 34 t-string (base64
7310: 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 28 :base64-decode (
7320: 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e getenv "MT_CMDIN
7330: 46 4f 22 29 29 29 29 29 0a 09 20 20 20 20 20 3b FO"))))).. ;
7340: 3b 20 28 72 75 6e 72 65 6d 6f 74 65 20 28 61 73 ; (runremote (as
7350: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
7360: 72 65 6d 6f 74 65 20 63 6d 64 69 6e 66 6f 29 29 remote cmdinfo))
7370: 0a 09 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 .. (transpor
7380: 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
7390: 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 'transport cmdi
73a0: 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 73 nfo)).. (tes
73b0: 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 tpath (assoc/de
73c0: 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 fault 'testpath
73d0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
73e0: 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 (test-name (ass
73f0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
7400: 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a -name cmdinfo)).
7410: 09 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 . (runscript
7420: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
7430: 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 'runscript cmdin
7440: 66 6f 29 29 0a 09 20 20 20 20 20 28 64 62 2d 68 fo)).. (db-h
7450: 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 ost (assoc/def
7460: 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 ault 'db-host
7470: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
7480: 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f (run-id (asso
7490: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 c/default 'run-i
74a0: 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 d cmdinfo))..
74b0: 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 20 20 (test-id
74c0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
74d0: 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 test-id cmdinf
74e0: 6f 29 29 0a 09 20 20 20 20 20 28 69 74 65 6d 64 o)).. (itemd
74f0: 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 at (assoc/defa
7500: 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 ult 'itemdat c
7510: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 mdinfo)).. (
7520: 64 62 20 20 20 20 20 20 20 20 23 66 29 29 0a 09 db #f))..
7530: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
7540: 79 20 74 65 73 74 70 61 74 68 29 0a 09 3b 3b 20 y testpath)..;;
7550: 28 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f 74 65 (set! *runremote
7560: 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 28 73 * runremote)..(s
7570: 65 74 21 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 et! *transport-t
7580: 79 70 65 2a 20 28 73 74 72 69 6e 67 2d 3e 73 79 ype* (string->sy
7590: 6d 62 6f 6c 20 74 72 61 6e 73 70 6f 72 74 29 29 mbol transport))
75a0: 0a 09 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 ..(if (not (setu
75b0: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 p-for-run))..
75c0: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 (begin.. (
75d0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 debug:print 0 "F
75e0: 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 ailed to setup,
75f0: 65 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 exiting")..
7600: 20 28 65 78 69 74 20 31 29 29 29 0a 09 28 69 66 (exit 1)))..(if
7610: 20 28 61 6e 64 20 73 74 61 74 65 20 73 74 61 74 (and state stat
7620: 75 73 29 0a 09 20 20 20 20 3b 3b 20 44 4f 20 4e us).. ;; DO N
7630: 4f 54 20 72 65 6d 6f 74 65 20 72 75 6e 0a 09 20 OT remote run..
7640: 20 20 20 28 64 62 3a 74 65 73 74 73 74 65 70 2d (db:teststep-
7650: 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 set-status! db t
7660: 65 73 74 2d 69 64 20 73 74 65 70 20 73 74 61 74 est-id step stat
7670: 65 20 73 74 61 74 75 73 20 6d 73 67 20 6c 6f 67 e status msg log
7680: 66 69 6c 65 29 0a 09 20 20 20 20 28 62 65 67 69 file).. (begi
7690: 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a n.. (debug:
76a0: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
76b0: 59 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 You must specify
76c0: 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 :state and :sta
76d0: 74 75 73 20 77 69 74 68 20 65 76 65 72 79 20 63 tus with every c
76e0: 61 6c 6c 20 74 6f 20 2d 73 74 65 70 22 29 0a 09 all to -step")..
76f0: 20 20 20 20 20 20 28 65 78 69 74 20 36 29 29 29 (exit 6)))
7700: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
7710: 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a et-arg "-step").
7720: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
7730: 20 28 6d 65 67 61 74 65 73 74 3a 73 74 65 70 20 (megatest:step
7740: 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 . (args:ge
7750: 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a 20 t-arg "-step").
7760: 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
7770: 61 72 67 20 22 3a 73 74 61 74 65 22 29 0a 20 20 arg ":state").
7780: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
7790: 72 67 20 22 3a 73 74 61 74 75 73 22 29 0a 20 20 rg ":status").
77a0: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
77b0: 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a 20 20 rg "-setlog").
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 2d 6d 22 29 29 0a 20 20 20 20 20 20 rg "-m")).
77e0: 3b 3b 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 ;; (if db (sqlit
77f0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
7800: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
7810: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
7820: 29 29 0a 20 20 20 20 0a 28 69 66 20 28 6f 72 20 )). .(if (or
7830: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7840: 73 65 74 6c 6f 67 22 29 20 20 20 20 20 20 20 3b setlog") ;
7850: 3b 20 73 69 6e 63 65 20 73 65 74 74 69 6e 67 20 ; since setting
7860: 75 70 20 69 73 20 73 6f 20 63 6f 73 74 6c 79 20 up is so costly
7870: 6c 65 74 73 20 70 69 67 67 79 62 61 63 6b 20 6f lets piggyback o
7880: 6e 20 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 09 n -test-status..
7890: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
78a0: 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 28 61 set-toplog")..(a
78b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
78c0: 73 74 2d 73 74 61 74 75 73 22 29 0a 09 28 61 72 st-status")..(ar
78d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
78e0: 2d 76 61 6c 75 65 73 22 29 0a 09 28 61 72 67 73 -values")..(args
78f0: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d :get-arg "-load-
7900: 74 65 73 74 2d 64 61 74 61 22 29 0a 09 28 61 72 test-data")..(ar
7910: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
7920: 73 74 65 70 22 29 0a 09 28 61 72 67 73 3a 67 65 step")..(args:ge
7930: 74 2d 61 72 67 20 22 2d 73 75 6d 6d 61 72 69 7a t-arg "-summariz
7940: 65 2d 69 74 65 6d 73 22 29 29 0a 20 20 20 20 28 e-items")). (
7950: 69 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 if (not (getenv
7960: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 "MT_CMDINFO"))..
7970: 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 (begin.. (debug
7980: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
7990: 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 MT_CMDINFO env
79a0: 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 63 6f 6d var not set, com
79b0: 6d 61 6e 64 73 20 2d 74 65 73 74 2d 73 74 61 74 mands -test-stat
79c0: 75 73 2c 20 2d 72 75 6e 73 74 65 70 20 61 6e 64 us, -runstep and
79d0: 20 2d 73 65 74 6c 6f 67 20 6d 75 73 74 20 62 65 -setlog must be
79e0: 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a called *inside*
79f0: 20 61 20 6d 65 67 61 74 65 73 74 20 65 6e 76 69 a megatest envi
7a00: 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 20 20 28 65 ronment!").. (e
7a10: 78 69 74 20 35 29 29 0a 09 28 6c 65 74 2a 20 28 xit 5))..(let* (
7a20: 28 73 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 (startingdir (cu
7a30: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
7a40: 29 0a 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e ).. (cmdin
7a50: 66 6f 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e fo (read (open
7a60: 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 -input-string (b
7a70: 61 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 ase64:base64-dec
7a80: 6f 64 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f ode (getenv "MT_
7a90: 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 CMDINFO")))))..
7aa0: 20 20 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 6d ;; (runrem
7ab0: 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ote (assoc/defau
7ac0: 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 6d lt 'runremote cm
7ad0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
7ae0: 28 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f (transport (asso
7af0: 63 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 c/default 'trans
7b00: 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 port cmdinfo))..
7b10: 20 20 20 20 20 20 20 28 74 65 73 74 70 61 74 68 (testpath
7b20: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
7b30: 20 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 'testpath cmdi
7b40: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
7b50: 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f est-name (assoc/
7b60: 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 default 'test-na
7b70: 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 me cmdinfo))..
7b80: 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 (runscript
7b90: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
7ba0: 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 runscript cmdinf
7bb0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d o)).. (db-
7bc0: 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 host (assoc/de
7bd0: 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 fault 'db-host
7be0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
7bf0: 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 (run-id (a
7c00: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
7c10: 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 n-id cmdinfo)
7c20: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d ).. (test-
7c30: 69 64 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 id (assoc/defa
7c40: 75 6c 74 20 27 74 65 73 74 2d 69 64 20 20 20 63 ult 'test-id c
7c50: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
7c60: 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 (itemdat (ass
7c70: 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d oc/default 'item
7c80: 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a dat cmdinfo)).
7c90: 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 20 . (db
7ca0: 20 20 20 23 66 29 20 3b 3b 20 28 6f 70 65 6e 2d #f) ;; (open-
7cb0: 64 62 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 db)).. (st
7cc0: 61 74 65 20 20 20 20 20 28 61 72 67 73 3a 67 65 ate (args:ge
7cd0: 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 t-arg ":state"))
7ce0: 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 .. (status
7cf0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
7d00: 67 20 22 3a 73 74 61 74 75 73 22 29 29 29 0a 09 g ":status")))..
7d10: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
7d20: 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 20 ory testpath)..
7d30: 20 3b 3b 20 28 73 65 74 21 20 2a 72 75 6e 72 65 ;; (set! *runre
7d40: 6d 6f 74 65 2a 20 72 75 6e 72 65 6d 6f 74 65 29 mote* runremote)
7d50: 0a 09 20 20 28 73 65 74 21 20 2a 74 72 61 6e 73 .. (set! *trans
7d60: 70 6f 72 74 2d 74 79 70 65 2a 20 28 73 74 72 69 port-type* (stri
7d70: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 6e 73 ng->symbol trans
7d80: 70 6f 72 74 29 29 0a 09 20 20 28 69 66 20 28 6e port)).. (if (n
7d90: 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 ot (setup-for-ru
7da0: 6e 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 n)).. (begi
7db0: 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 n...(debug:print
7dc0: 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 0 "Failed to se
7dd0: 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 tup, exiting")..
7de0: 09 28 65 78 69 74 20 31 29 29 29 0a 0a 09 20 20 .(exit 1)))...
7df0: 3b 3b 20 63 61 6e 20 73 65 74 75 70 20 61 73 20 ;; can setup as
7e00: 63 6c 69 65 6e 74 20 66 6f 72 20 73 65 72 76 65 client for serve
7e10: 72 20 6d 6f 64 65 20 6e 6f 77 0a 09 20 20 3b 3b r mode now.. ;;
7e20: 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 70 29 0a (client:setup).
7e30: 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 .. (if (args:ge
7e40: 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 t-arg "-load-tes
7e50: 74 2d 64 61 74 61 22 29 0a 09 20 20 20 20 20 20 t-data")..
7e60: 3b 3b 20 68 61 73 20 73 75 62 20 63 6f 6d 6d 61 ;; has sub comma
7e70: 6e 64 73 20 74 68 61 74 20 61 72 65 20 72 64 62 nds that are rdb
7e80: 3a 0a 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e :.. ;; DO N
7e90: 4f 54 20 70 75 74 20 74 68 69 73 20 6f 6e 65 20 OT put this one
7ea0: 69 6e 74 6f 20 65 69 74 68 65 72 20 63 64 62 3a into either cdb:
7eb0: 72 65 6d 6f 74 65 2d 72 75 6e 20 6f 72 20 6f 70 remote-run or op
7ec0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 0a 09 20 20 en-run-close..
7ed0: 20 20 20 20 28 64 62 3a 6c 6f 61 64 2d 74 65 73 (db:load-tes
7ee0: 74 2d 64 61 74 61 20 64 62 20 74 65 73 74 2d 69 t-data db test-i
7ef0: 64 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 d)).. (if (args
7f00: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f :get-arg "-setlo
7f10: 67 22 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 g").. (let
7f20: 28 28 6c 6f 67 66 6e 61 6d 65 20 28 61 72 67 73 ((logfname (args
7f30: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f :get-arg "-setlo
7f40: 67 22 29 29 29 0a 09 09 28 63 64 62 3a 74 65 73 g")))...(cdb:tes
7f50: 74 2d 73 65 74 2d 6c 6f 67 21 20 2a 72 75 6e 72 t-set-log! *runr
7f60: 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 20 6c emote* test-id l
7f70: 6f 67 66 6e 61 6d 65 29 29 29 0a 09 20 20 28 69 ogfname))).. (i
7f80: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
7f90: 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 "-set-toplog")..
7fa0: 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 ;; DO NOT
7fb0: 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 20 run remote..
7fc0: 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 (tests:test-se
7fd0: 74 2d 74 6f 70 6c 6f 67 21 20 64 62 20 72 75 6e t-toplog! db run
7fe0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 28 61 -id test-name (a
7ff0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
8000: 74 2d 74 6f 70 6c 6f 67 22 29 29 29 0a 09 20 20 t-toplog")))..
8010: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
8020: 67 20 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 g "-summarize-it
8030: 65 6d 73 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 ems").. ;;
8040: 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 DO NOT run remot
8050: 65 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 3a e.. (tests:
8060: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 summarize-items
8070: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
8080: 61 6d 65 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 ame #t)) ;; do f
8090: 6f 72 63 65 20 68 65 72 65 0a 09 20 20 28 69 66 orce here.. (if
80a0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
80b0: 2d 72 75 6e 73 74 65 70 22 29 0a 09 20 20 20 20 -runstep")..
80c0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d (if (null? rem
80d0: 61 72 67 73 29 0a 09 09 20 20 28 62 65 67 69 6e args)... (begin
80e0: 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
80f0: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 6e 6f int 0 "ERROR: no
8100: 74 68 69 6e 67 20 73 70 65 63 69 66 69 65 64 20 thing specified
8110: 74 6f 20 72 75 6e 21 22 29 0a 09 09 20 20 20 20 to run!")...
8120: 28 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 3a (if db (sqlite3:
8130: 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 finalize! db))..
8140: 09 20 20 20 20 28 65 78 69 74 20 36 29 29 0a 09 . (exit 6))..
8150: 09 20 20 28 6c 65 74 2a 20 28 28 73 74 65 70 6e . (let* ((stepn
8160: 61 6d 65 20 20 20 28 61 72 67 73 3a 67 65 74 2d ame (args:get-
8170: 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 29 arg "-runstep"))
8180: 0a 09 09 09 20 28 6c 6f 67 70 72 6f 66 69 6c 65 .... (logprofile
8190: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
81a0: 2d 6c 6f 67 70 72 6f 22 29 29 0a 09 09 09 20 28 -logpro")).... (
81b0: 6c 6f 67 66 69 6c 65 20 20 20 20 28 63 6f 6e 63 logfile (conc
81c0: 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 stepname ".log"
81d0: 29 29 0a 09 09 09 20 28 63 6d 64 20 20 20 20 20 )).... (cmd
81e0: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 (if (null? re
81f0: 6d 61 72 67 73 29 20 23 66 20 28 63 61 72 20 72 margs) #f (car r
8200: 65 6d 61 72 67 73 29 29 29 0a 09 09 09 20 28 70 emargs))).... (p
8210: 61 72 61 6d 73 20 20 20 20 20 28 69 66 20 63 6d arams (if cm
8220: 64 20 28 63 64 72 20 72 65 6d 61 72 67 73 29 20 d (cdr remargs)
8230: 27 28 29 29 29 0a 09 09 09 20 28 65 78 69 74 73 '())).... (exits
8240: 74 61 74 20 20 20 23 66 29 0a 09 09 09 20 28 73 tat #f).... (s
8250: 68 65 6c 6c 20 20 20 20 20 20 28 6c 61 73 74 20 hell (last
8260: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 67 (string-split (g
8270: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
8280: 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 ariable "SHELL")
8290: 20 22 2f 22 29 29 29 0a 09 09 09 20 28 72 65 64 "/"))).... (red
82a0: 69 72 20 20 20 20 20 20 28 63 61 73 65 20 28 73 ir (case (s
82b0: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 68 tring->symbol sh
82c0: 65 6c 6c 29 0a 09 09 09 09 20 20 20 20 20 20 20 ell).....
82d0: 28 28 74 63 73 68 20 63 73 68 20 6b 73 68 29 20 ((tcsh csh ksh)
82e0: 20 20 20 22 3e 26 22 29 0a 09 09 09 09 20 20 20 ">&").....
82f0: 20 20 20 20 28 28 7a 73 68 20 62 61 73 68 20 73 ((zsh bash s
8300: 68 20 61 73 68 29 20 22 32 3e 26 31 20 3e 22 29 h ash) "2>&1 >")
8310: 0a 09 09 09 09 20 20 20 20 20 20 20 28 65 6c 73 ..... (els
8320: 65 20 22 3e 26 22 29 29 29 0a 09 09 09 20 28 66 e ">&"))).... (f
8330: 75 6c 6c 63 6d 64 20 20 20 20 28 63 6f 6e 63 20 ullcmd (conc
8340: 22 28 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 "(" (string-inte
8350: 72 73 70 65 72 73 65 20 0a 09 09 09 09 09 09 28 rsperse .......(
8360: 63 6f 6e 73 20 63 6d 64 20 70 61 72 61 6d 73 29 cons cmd params)
8370: 20 22 20 22 29 0a 09 09 09 09 09 20 20 20 22 29 " ")...... ")
8380: 20 22 20 72 65 64 69 72 20 22 20 22 20 6c 6f 67 " redir " " log
8390: 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 3b 3b file)))... ;;
83a0: 20 6d 61 72 6b 20 74 68 65 20 73 74 61 72 74 20 mark the start
83b0: 6f 66 20 74 68 65 20 74 65 73 74 0a 09 09 20 20 of the test...
83c0: 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 ;; DO NOT run
83d0: 72 65 6d 6f 74 65 0a 09 09 20 20 20 20 28 64 62 remote... (db
83e0: 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 :teststep-set-st
83f0: 61 74 75 73 21 20 64 62 20 74 65 73 74 2d 69 64 atus! db test-id
8400: 20 73 74 65 70 6e 61 6d 65 20 22 73 74 61 72 74 stepname "start
8410: 22 20 22 6e 2f 61 22 20 28 61 72 67 73 3a 67 65 " "n/a" (args:ge
8420: 74 2d 61 72 67 20 22 2d 6d 22 29 20 6c 6f 67 66 t-arg "-m") logf
8430: 69 6c 65 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 ile)... ;; ru
8440: 6e 20 74 68 65 20 74 65 73 74 20 73 74 65 70 0a n the test step.
8450: 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
8460: 6e 74 2d 69 6e 66 6f 20 32 20 22 52 75 6e 6e 69 nt-info 2 "Runni
8470: 6e 67 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 ng \"" fullcmd "
8480: 5c 22 22 29 0a 09 09 20 20 20 20 28 63 68 61 6e \"")... (chan
8490: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 ge-directory sta
84a0: 72 74 69 6e 67 64 69 72 29 0a 09 09 20 20 20 20 rtingdir)...
84b0: 28 73 65 74 21 20 65 78 69 74 73 74 61 74 20 28 (set! exitstat (
84c0: 73 79 73 74 65 6d 20 66 75 6c 6c 63 6d 64 29 29 system fullcmd))
84d0: 20 3b 3b 20 63 6d 64 20 70 61 72 61 6d 73 29 29 ;; cmd params))
84e0: 0a 09 09 20 20 20 20 28 73 65 74 21 20 2a 67 6c ... (set! *gl
84f0: 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 obalexitstatus*
8500: 65 78 69 74 73 74 61 74 29 0a 09 09 20 20 20 20 exitstat)...
8510: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
8520: 79 20 74 65 73 74 70 61 74 68 29 0a 09 09 20 20 y testpath)...
8530: 20 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 ;; run logpro
8540: 69 66 20 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b if applicable ;;
8550: 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c (process-run "l
8560: 73 22 20 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20 s" (list "/foo"
8570: 22 32 3e 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67 "2>&1" "blah.log
8580: 22 29 29 0a 09 09 20 20 20 20 28 69 66 20 6c 6f "))... (if lo
8590: 67 70 72 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74 gprofile....(let
85a0: 2a 20 28 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 * ((htmllogfile
85b0: 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 (conc stepname "
85c0: 2e 68 74 6d 6c 22 29 29 0a 09 09 09 20 20 20 20 .html"))....
85d0: 20 20 20 28 6f 6c 64 65 78 69 74 73 74 61 74 20 (oldexitstat
85e0: 65 78 69 74 73 74 61 74 29 0a 09 09 09 20 20 20 exitstat)....
85f0: 20 20 20 20 28 63 6d 64 20 20 20 20 20 20 20 20 (cmd
8600: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
8610: 65 72 73 65 20 28 6c 69 73 74 20 22 6c 6f 67 70 erse (list "logp
8620: 72 6f 22 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68 ro" logprofile h
8630: 74 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c tmllogfile "<" l
8640: 6f 67 66 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63 ogfile ">" (conc
8650: 20 73 74 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70 stepname "_logp
8660: 72 6f 2e 6c 6f 67 22 29 29 20 22 20 22 29 29 29 ro.log")) " ")))
8670: 0a 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 .... (debug:pri
8680: 6e 74 2d 69 6e 66 6f 20 32 20 22 72 75 6e 6e 69 nt-info 2 "runni
8690: 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 29 ng \"" cmd "\"")
86a0: 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 .... (change-di
86b0: 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 rectory starting
86c0: 64 69 72 29 0a 09 09 09 20 20 28 73 65 74 21 20 dir).... (set!
86d0: 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65 6d exitstat (system
86e0: 20 63 6d 64 29 29 0a 09 09 09 20 20 28 73 65 74 cmd)).... (set
86f0: 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 ! *globalexitsta
8700: 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 20 3b tus* exitstat) ;
8710: 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 0a 09 ; no necessary..
8720: 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 .. (change-dire
8730: 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a ctory testpath).
8740: 09 09 09 20 20 28 63 64 62 3a 74 65 73 74 2d 73 ... (cdb:test-s
8750: 65 74 2d 6c 6f 67 21 20 2a 72 75 6e 72 65 6d 6f et-log! *runremo
8760: 74 65 2a 20 74 65 73 74 2d 69 64 20 68 74 6d 6c te* test-id html
8770: 6c 6f 67 66 69 6c 65 29 29 29 0a 09 09 20 20 20 logfile)))...
8780: 20 28 6c 65 74 20 28 28 6d 73 67 20 28 61 72 67 (let ((msg (arg
8790: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 s:get-arg "-m"))
87a0: 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 )... ;; DO
87b0: 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 NOT run remote..
87c0: 09 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 73 . (db:tests
87d0: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 tep-set-status!
87e0: 64 62 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e db test-id stepn
87f0: 61 6d 65 20 22 65 6e 64 22 20 65 78 69 74 73 74 ame "end" exitst
8800: 61 74 20 6d 73 67 20 6c 6f 67 66 69 6c 65 29 29 at msg logfile))
8810: 0a 09 09 20 20 20 20 29 29 29 0a 09 20 20 28 69 ... ))).. (i
8820: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
8830: 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 arg "-test-statu
8840: 73 22 29 0a 09 09 20 20 28 61 72 67 73 3a 67 65 s")... (args:ge
8850: 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 t-arg "-set-valu
8860: 65 73 22 29 29 0a 09 20 20 20 20 20 20 28 6c 65 es")).. (le
8870: 74 20 28 28 6e 65 77 73 74 61 74 75 73 20 28 63 t ((newstatus (c
8880: 6f 6e 64 0a 09 09 09 09 28 28 6e 75 6d 62 65 72 ond.....((number
8890: 3f 20 73 74 61 74 75 73 29 20 20 20 20 20 20 20 ? status)
88a0: 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 (if (equal? stat
88b0: 75 73 20 30 29 20 22 50 41 53 53 22 20 22 46 41 us 0) "PASS" "FA
88c0: 49 4c 22 29 29 0a 09 09 09 09 28 28 61 6e 64 20 IL")).....((and
88d0: 28 73 74 72 69 6e 67 3f 20 73 74 61 74 75 73 29 (string? status)
88e0: 0a 09 09 09 09 20 20 20 20 20 20 28 73 74 72 69 ..... (stri
88f0: 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 ng->number statu
8900: 73 29 29 28 69 66 20 28 65 71 75 61 6c 3f 20 28 s))(if (equal? (
8910: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 string->number s
8920: 74 61 74 75 73 29 20 30 29 20 22 50 41 53 53 22 tatus) 0) "PASS"
8930: 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 65 "FAIL")).....(e
8940: 6c 73 65 20 73 74 61 74 75 73 29 29 29 0a 09 09 lse status)))...
8950: 20 20 20 20 3b 3b 20 74 72 61 6e 73 66 65 72 20 ;; transfer
8960: 72 65 6c 65 76 61 6e 74 20 6b 65 79 73 20 69 6e relevant keys in
8970: 74 6f 20 61 20 68 61 73 68 20 74 6f 20 62 65 20 to a hash to be
8980: 70 61 73 73 65 64 20 74 6f 20 74 65 73 74 2d 73 passed to test-s
8990: 65 74 2d 73 74 61 74 75 73 21 0a 09 09 20 20 20 et-status!...
89a0: 20 3b 3b 20 63 6f 75 6c 64 20 75 73 65 20 61 6e ;; could use an
89b0: 20 61 73 73 6f 63 20 6c 69 73 74 20 49 20 67 75 assoc list I gu
89c0: 65 73 73 2e 20 0a 09 09 20 20 20 20 28 6f 74 68 ess. ... (oth
89d0: 65 72 64 61 74 61 20 28 6c 65 74 20 28 28 72 65 erdata (let ((re
89e0: 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 s (make-hash-tab
89f0: 6c 65 29 29 29 0a 09 09 09 09 20 28 66 6f 72 2d le)))..... (for-
8a00: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 each (lambda (ke
8a10: 79 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 y)...... (if
8a20: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 6b (args:get-arg k
8a30: 65 79 29 0a 09 09 09 09 09 09 20 28 68 61 73 68 ey)....... (hash
8a40: 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 -table-set! res
8a50: 6b 65 79 20 28 61 72 67 73 3a 67 65 74 2d 61 72 key (args:get-ar
8a60: 67 20 6b 65 79 29 29 29 29 0a 09 09 09 09 09 20 g key))))......
8a70: 20 20 28 6c 69 73 74 20 22 3a 76 61 6c 75 65 22 (list ":value"
8a80: 20 22 3a 74 6f 6c 22 20 22 3a 65 78 70 65 63 74 ":tol" ":expect
8a90: 65 64 22 20 22 3a 66 69 72 73 74 5f 65 72 72 22 ed" ":first_err"
8aa0: 20 22 3a 66 69 72 73 74 5f 77 61 72 6e 22 20 22 ":first_warn" "
8ab0: 3a 75 6e 69 74 73 22 20 22 3a 63 61 74 65 67 6f :units" ":catego
8ac0: 72 79 22 20 22 3a 76 61 72 69 61 62 6c 65 22 29 ry" ":variable")
8ad0: 29 0a 09 09 09 09 20 72 65 73 29 29 29 0a 09 09 )..... res)))...
8ae0: 28 69 66 20 28 61 6e 64 20 28 61 72 67 73 3a 67 (if (and (args:g
8af0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 et-arg "-test-st
8b00: 61 74 75 73 22 29 0a 09 09 09 20 28 6f 72 20 28 atus").... (or (
8b10: 6e 6f 74 20 73 74 61 74 65 29 0a 09 09 09 20 20 not state)....
8b20: 20 20 20 28 6e 6f 74 20 73 74 61 74 75 73 29 29 (not status))
8b30: 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 )... (begin..
8b40: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
8b50: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 59 6f int 0 "ERROR: Yo
8b60: 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 3a u must specify :
8b70: 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 state and :statu
8b80: 73 20 77 69 74 68 20 65 76 65 72 79 20 63 61 6c s with every cal
8b90: 6c 20 74 6f 20 2d 74 65 73 74 2d 73 74 61 74 75 l to -test-statu
8ba0: 73 5c 6e 22 20 68 65 6c 70 29 0a 09 09 20 20 20 s\n" help)...
8bb0: 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 ;; (sqlite3:f
8bc0: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 20 inalize! db)...
8bd0: 20 20 20 20 20 28 65 78 69 74 20 36 29 29 29 0a (exit 6))).
8be0: 09 09 28 6c 65 74 2a 20 28 28 6d 73 67 20 20 20 ..(let* ((msg
8bf0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8c00: 2d 6d 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 -m"))... (
8c10: 6e 75 6d 6f 74 68 20 28 6c 65 6e 67 74 68 20 28 numoth (length (
8c20: 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 hash-table-keys
8c30: 6f 74 68 65 72 64 61 74 61 29 29 29 29 0a 09 09 otherdata))))...
8c40: 20 20 3b 3b 20 43 6f 6e 76 65 72 74 20 74 6f 20 ;; Convert to
8c50: 72 70 63 20 69 6e 73 69 64 65 20 74 68 65 20 74 rpc inside the t
8c60: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 ests:test-set-st
8c70: 61 74 75 73 21 20 63 61 6c 6c 2c 20 6e 6f 74 20 atus! call, not
8c80: 68 65 72 65 0a 09 09 20 20 28 74 65 73 74 73 3a here... (tests:
8c90: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
8ca0: 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 6e test-id state n
8cb0: 65 77 73 74 61 74 75 73 20 6d 73 67 20 6f 74 68 ewstatus msg oth
8cc0: 65 72 64 61 74 61 29 29 29 29 0a 09 20 20 28 69 erdata)))).. (i
8cd0: 66 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 f db (sqlite3:fi
8ce0: 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 20 20 nalize! db))..
8cf0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
8d00: 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 3d ing* #t))))..;;=
8d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8d50: 3d 3d 3d 3d 3d 0a 3b 3b 20 56 61 72 69 6f 75 73 =====.;; Various
8d60: 20 68 65 6c 70 65 72 20 63 6f 6d 6d 61 6e 64 73 helper commands
8d70: 20 63 61 6e 20 67 6f 20 62 65 6c 6f 77 20 68 65 can go below he
8d80: 72 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d re.;;===========
8d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
8dd0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8de0: 2d 73 68 6f 77 6b 65 79 73 22 29 0a 20 20 20 20 -showkeys").
8df0: 28 6c 65 74 20 28 28 64 62 20 23 66 29 0a 09 20 (let ((db #f)..
8e00: 20 28 6b 65 79 73 20 23 66 29 29 0a 20 20 20 20 (keys #f)).
8e10: 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 (if (not (setu
8e20: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 p-for-run)).. (
8e30: 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 begin.. (debu
8e40: 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 g:print 0 "Faile
8e50: 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit
8e60: 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 69 74 ing").. (exit
8e70: 20 31 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 1))). (set
8e80: 21 20 6b 65 79 73 20 28 63 62 64 3a 72 65 6d 6f ! keys (cbd:remo
8e90: 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 te-run db:get-ke
8ea0: 79 73 20 64 62 29 29 0a 20 20 20 20 20 20 28 64 ys db)). (d
8eb0: 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 4b 65 ebug:print 1 "Ke
8ec0: 79 73 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e ys: " (string-in
8ed0: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 6b tersperse (map k
8ee0: 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 ey:get-fieldname
8ef0: 20 6b 65 79 73 29 20 22 2c 20 22 29 29 0a 20 20 keys) ", ")).
8f00: 20 20 20 20 28 69 66 20 64 62 20 28 73 71 6c 69 (if db (sqli
8f10: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
8f20: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
8f30: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
8f40: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
8f50: 65 74 2d 61 72 67 20 22 2d 67 75 69 22 29 0a 20 et-arg "-gui").
8f60: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
8f70: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
8f80: 4c 6f 6f 6b 20 61 74 20 74 68 65 20 64 61 73 68 Look at the dash
8f90: 62 6f 61 72 64 20 66 6f 72 20 6e 6f 77 22 29 0a board for now").
8fa0: 20 20 20 20 20 20 3b 3b 20 28 6d 65 67 61 74 65 ;; (megate
8fb0: 73 74 2d 67 75 69 29 0a 20 20 20 20 20 20 28 73 st-gui). (s
8fc0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
8fd0: 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
8fe0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 rgs:get-arg "-ge
8ff0: 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 22 n-megatest-area"
9000: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
9010: 20 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 3a 6d (genexample:m
9020: 6b 2d 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 k-megatest.confi
9030: 67 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a g). (set! *
9040: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
9050: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
9060: 65 74 2d 61 72 67 20 22 2d 67 65 6e 2d 6d 65 67 et-arg "-gen-meg
9070: 61 74 65 73 74 2d 74 65 73 74 22 29 0a 20 20 20 atest-test").
9080: 20 28 6c 65 74 20 28 28 74 65 73 74 6e 61 6d 65 (let ((testname
9090: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
90a0: 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 -gen-megatest-te
90b0: 73 74 22 29 29 29 0a 20 20 20 20 20 20 28 67 65 st"))). (ge
90c0: 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 nexample:mk-mega
90d0: 74 65 73 74 2d 74 65 73 74 20 74 65 73 74 6e 61 test-test testna
90e0: 6d 65 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 me). (set!
90f0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
9100: 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
9110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
9150: 3b 20 55 70 64 61 74 65 20 74 68 65 20 64 61 74 ; Update the dat
9160: 61 62 61 73 65 20 73 63 68 65 6d 61 20 6f 6e 20 abase schema on
9170: 72 65 71 75 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d request.;;======
9180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
91a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
91b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
91c0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
91d0: 61 72 67 20 22 2d 72 65 62 75 69 6c 64 2d 64 62 arg "-rebuild-db
91e0: 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
91f0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 (if (not (se
9200: 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 tup-for-run))..
9210: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 (begin.. (de
9220: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 bug:print 0 "Fai
9230: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
9240: 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 iting") .. (e
9250: 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 3b xit 1))). ;
9260: 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 ; keep this one
9270: 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 6f 70 65 local. (ope
9280: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 70 61 74 63 n-run-close patc
9290: 68 2d 64 62 20 23 66 29 0a 20 20 20 20 20 20 28 h-db #f). (
92a0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
92b0: 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d ng* #t)))..;;===
92c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9300: 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 ===.;; Update th
9310: 65 20 74 65 73 74 73 20 6d 65 74 61 20 64 61 74 e tests meta dat
9320: 61 20 66 72 6f 6d 20 74 68 65 20 74 65 73 74 63 a from the testc
9330: 6f 6e 66 69 67 20 66 69 6c 65 73 0a 3b 3b 3d 3d onfig files.;;==
9340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9380: 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
9390: 67 65 74 2d 61 72 67 20 22 2d 75 70 64 61 74 65 get-arg "-update
93a0: 2d 6d 65 74 61 22 29 0a 20 20 20 20 28 62 65 67 -meta"). (beg
93b0: 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f in. (if (no
93c0: 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e t (setup-for-run
93d0: 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 )).. (begin..
93e0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
93f0: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
9400: 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 p, exiting") ..
9410: 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))).
9420: 20 20 20 20 3b 3b 20 6e 6f 77 20 63 61 6e 20 66 ;; now can f
9430: 69 6e 64 20 6f 75 72 20 64 62 0a 20 20 20 20 20 ind our db.
9440: 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e ;; keep this on
9450: 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 6f e local. (o
9460: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 72 75 pen-run-close ru
9470: 6e 73 3a 75 70 64 61 74 65 2d 61 6c 6c 2d 74 65 ns:update-all-te
9480: 73 74 5f 6d 65 74 61 20 64 62 29 0a 20 20 20 20 st_meta db).
9490: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
94a0: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
94b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
94c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
94d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
94e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
94f0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 ======.;; Start
9500: 61 20 72 65 70 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d a repl.;;=======
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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
9550: 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 .(if (or (args:g
9560: 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 29 0a et-arg "-repl").
9570: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
9580: 2d 6c 6f 61 64 22 29 29 0a 20 20 20 20 28 6c 65 -load")). (le
9590: 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 73 65 t* ((toppath (se
95a0: 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 tup-for-run))..
95b0: 20 20 28 64 62 20 20 20 20 20 20 28 69 66 20 74 (db (if t
95c0: 6f 70 70 61 74 68 20 28 6f 70 65 6e 2d 64 62 29 oppath (open-db)
95d0: 20 23 66 29 29 29 0a 20 20 20 20 20 20 28 69 66 #f))). (if
95e0: 20 64 62 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 db.. (begin..
95f0: 20 20 20 28 73 65 74 21 20 2a 64 62 2a 20 64 62 (set! *db* db
9600: 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a 63 6c ).. (set! *cl
9610: 69 65 6e 74 2d 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e ient-non-blockin
9620: 67 2d 6d 6f 64 65 2a 20 23 74 29 0a 09 20 20 20 g-mode* #t)..
9630: 20 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 ;; (client:setu
9640: 70 29 0a 09 20 20 20 20 3b 3b 20 28 63 6c 69 65 p).. ;; (clie
9650: 6e 74 3a 6c 61 75 6e 63 68 29 0a 09 20 20 20 20 nt:launch)..
9660: 28 69 6d 70 6f 72 74 20 72 65 61 64 6c 69 6e 65 (import readline
9670: 29 0a 09 20 20 20 20 28 69 6d 70 6f 72 74 20 61 ).. (import a
9680: 70 72 6f 70 6f 73 29 0a 09 20 20 20 20 28 67 6e propos).. (gn
9690: 75 2d 68 69 73 74 6f 72 79 2d 69 6e 73 74 61 6c u-history-instal
96a0: 6c 2d 66 69 6c 65 2d 6d 61 6e 61 67 65 72 0a 09 l-file-manager..
96b0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 61 70 70 (string-app
96c0: 65 6e 64 0a 09 20 20 20 20 20 20 28 6f 72 20 28 end.. (or (
96d0: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
96e0: 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 variable "HOME")
96f0: 20 22 2e 22 29 20 22 2f 2e 6d 65 67 61 74 65 73 ".") "/.megates
9700: 74 5f 68 69 73 74 6f 72 79 22 29 29 0a 09 20 20 t_history"))..
9710: 20 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 (current-input
9720: 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 67 6e 75 2d -port (make-gnu-
9730: 72 65 61 64 6c 69 6e 65 2d 70 6f 72 74 20 22 6d readline-port "m
9740: 65 67 61 74 65 73 74 3e 20 22 29 29 0a 09 20 20 egatest> "))..
9750: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
9760: 61 72 67 20 22 2d 72 65 70 6c 22 29 0a 09 09 28 arg "-repl")...(
9770: 72 65 70 6c 29 0a 09 09 28 6c 6f 61 64 20 28 61 repl)...(load (a
9780: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
9790: 61 64 22 29 29 29 29 0a 09 20 20 28 65 78 69 74 ad")))).. (exit
97a0: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
97b0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
97c0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
97d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
9810: 20 45 78 69 74 20 61 6e 64 20 63 6c 65 61 6e 20 Exit and clean
9820: 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d up.;;===========
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 3d 3d 3d ================
9850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
9870: 74 68 69 73 20 69 73 20 74 68 65 20 73 6f 63 6b this is the sock
9880: 65 74 20 69 66 20 77 65 20 61 72 65 20 61 20 63 et if we are a c
9890: 6c 69 65 6e 74 0a 3b 3b 20 28 69 66 20 28 61 6e lient.;; (if (an
98a0: 64 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 0a 3b 3b d *runremote*.;;
98b0: 20 09 20 28 73 6f 63 6b 65 74 3f 20 2a 72 75 6e . (socket? *run
98c0: 72 65 6d 6f 74 65 2a 29 29 0a 3b 3b 20 20 20 20 remote*)).;;
98d0: 20 28 63 6c 6f 73 65 2d 73 6f 63 6b 65 74 20 2a (close-socket *
98e0: 72 75 6e 72 65 6d 6f 74 65 2a 29 29 0a 0a 28 69 runremote*))..(i
98f0: 66 20 28 6e 6f 74 20 2a 64 69 64 73 6f 6d 65 74 f (not *didsomet
9900: 68 69 6e 67 2a 29 0a 20 20 20 20 28 64 65 62 75 hing*). (debu
9910: 67 3a 70 72 69 6e 74 20 30 20 68 65 6c 70 29 29 g:print 0 help))
9920: 0a 0a 3b 3b 20 28 69 66 20 2a 72 75 6e 72 65 6d ..;; (if *runrem
9930: 6f 74 65 2a 20 28 72 70 63 3a 63 6c 6f 73 65 2d ote* (rpc:close-
9940: 61 6c 6c 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 21 all-connections!
9950: 29 29 0a 20 20 20 20 0a 28 69 66 20 28 6e 6f 74 )). .(if (not
9960: 20 28 65 71 3f 20 2a 67 6c 6f 62 61 6c 65 78 69 (eq? *globalexi
9970: 74 73 74 61 74 75 73 2a 20 30 29 29 0a 20 20 20 tstatus* 0)).
9980: 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 (if (or (args:g
9990: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
99a0: 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 s")(args:get-arg
99b0: 20 22 2d 72 75 6e 61 6c 6c 22 29 29 0a 20 20 20 "-runall")).
99c0: 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
99d0: 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
99e0: 69 6e 74 20 30 20 22 4e 4f 54 45 3a 20 53 75 62 int 0 "NOTE: Sub
99f0: 70 72 6f 63 65 73 73 65 73 20 77 69 74 68 20 6e processes with n
9a00: 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 20 63 6f 64 on-zero exit cod
9a10: 65 20 64 65 74 65 63 74 65 64 3a 20 22 20 2a 67 e detected: " *g
9a20: 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
9a30: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 78 ). (ex
9a40: 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 28 it 0)). (
9a50: 63 61 73 65 20 2a 67 6c 6f 62 61 6c 65 78 69 74 case *globalexit
9a60: 73 74 61 74 75 73 2a 0a 20 20 20 20 20 20 20 20 status*.
9a70: 20 28 28 30 29 28 65 78 69 74 20 30 29 29 0a 20 ((0)(exit 0)).
9a80: 20 20 20 20 20 20 20 20 28 28 31 29 28 65 78 69 ((1)(exi
9a90: 74 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 28 t 1)). (
9aa0: 28 32 29 28 65 78 69 74 20 32 29 29 0a 20 20 20 (2)(exit 2)).
9ab0: 20 20 20 20 20 20 28 65 6c 73 65 20 28 65 78 69 (else (exi
9ac0: 74 20 33 29 29 29 29 29 0a t 3))))).