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 70 72 69 6e 74 20 22 ... (print "
4a00: 52 75 6e 3a 20 22 20 74 61 72 67 65 74 73 74 72 Run: " targetstr
4a10: 20 22 2f 22 20 28 64 62 3a 67 65 74 2d 76 61 6c "/" (db:get-val
4a20: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
4a30: 20 68 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 header "runname
4a40: 22 29 20 0a 09 09 09 20 20 20 20 22 20 73 74 61 ") .... " sta
4a50: 74 75 73 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 tus: " (db:get-v
4a60: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
4a70: 75 6e 20 68 65 61 64 65 72 20 22 73 74 61 74 65 un header "state
4a80: 22 29 0a 09 09 09 20 20 20 20 22 20 72 75 6e 2d ").... " run-
4a90: 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 2c 20 id: " run-id ",
4aa0: 6e 75 6d 62 65 72 20 74 65 73 74 73 3a 20 22 20 number tests: "
4ab0: 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 29 0a (length tests)).
4ac0: 09 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 .. (for-each
4ad0: 20 0a 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 ... (lambd
4ae0: 61 20 28 74 65 73 74 29 0a 09 09 09 28 66 6f 72 a (test)....(for
4af0: 6d 61 74 20 23 74 0a 09 09 09 09 22 20 20 54 65 mat #t....." Te
4b00: 73 74 3a 20 7e 32 35 61 20 53 74 61 74 65 3a 20 st: ~25a State:
4b10: 7e 31 35 61 20 53 74 61 74 75 73 3a 20 7e 31 35 ~15a Status: ~15
4b20: 61 20 52 75 6e 74 69 6d 65 3a 20 7e 35 40 61 73 a Runtime: ~5@as
4b30: 20 54 69 6d 65 3a 20 7e 32 32 61 20 48 6f 73 74 Time: ~22a Host
4b40: 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 09 09 28 63 : ~10a\n".....(c
4b50: 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 onc (db:test-get
4b60: 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 29 0a -testname test).
4b70: 09 09 09 09 20 20 20 20 20 20 28 69 66 20 28 65 .... (if (e
4b80: 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 qual? (db:test-g
4b90: 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 et-item-path tes
4ba0: 74 29 20 22 22 29 0a 09 09 09 09 09 20 20 22 22 t) "")...... ""
4bb0: 20 0a 09 09 09 09 09 20 20 28 63 6f 6e 63 20 22 ...... (conc "
4bc0: 28 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (" (db:test-get-
4bd0: 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 20 item-path test)
4be0: 22 29 22 29 29 29 0a 09 09 09 09 28 64 62 3a 74 ")"))).....(db:t
4bf0: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 est-get-state te
4c00: 73 74 29 0a 09 09 09 09 28 64 62 3a 74 65 73 74 st).....(db:test
4c10: 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 -get-status test
4c20: 29 0a 09 09 09 09 28 64 62 3a 74 65 73 74 2d 67 ).....(db:test-g
4c30: 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 et-run_duration
4c40: 74 65 73 74 29 0a 09 09 09 09 28 64 62 3a 74 65 test).....(db:te
4c50: 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d st-get-event_tim
4c60: 65 20 74 65 73 74 29 0a 09 09 09 09 28 64 62 3a e test).....(db:
4c70: 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 20 74 65 test-get-host te
4c80: 73 74 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 st))....(if (not
4c90: 20 28 6f 72 20 28 65 71 75 61 6c 3f 20 28 64 62 (or (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 50 41 53 53 22 29 0a 09 test) "PASS")..
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 75 73 20 74 65 73 74 29 20 22 57 41 52 4e 22 tus test) "WARN"
4cf0: 29 0a 09 09 09 09 20 20 20 20 20 28 65 71 75 61 )..... (equa
4d00: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
4d10: 73 74 61 74 65 20 74 65 73 74 29 20 20 22 4e 4f state test) "NO
4d20: 54 5f 53 54 41 52 54 45 44 22 29 29 29 0a 09 09 T_STARTED")))...
4d30: 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 20 . (begin....
4d40: 20 20 20 20 20 28 70 72 69 6e 74 20 22 20 20 20 (print "
4d50: 20 20 20 20 20 20 63 70 75 6c 6f 61 64 3a 20 20 cpuload:
4d60: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 " (db:test-get-c
4d70: 70 75 6c 6f 61 64 20 74 65 73 74 29 0a 09 09 09 puload test)....
4d80: 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 20 20 . "\n
4d90: 20 20 64 69 73 6b 66 72 65 65 3a 20 22 20 28 64 diskfree: " (d
4da0: 62 3a 74 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 b:test-get-diskf
4db0: 72 65 65 20 74 65 73 74 29 0a 09 09 09 09 20 20 ree test).....
4dc0: 20 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 75 "\n u
4dd0: 6e 61 6d 65 3a 20 20 20 20 22 20 28 64 62 3a 74 name: " (db:t
4de0: 65 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 74 65 est-get-uname te
4df0: 73 74 29 0a 09 09 09 09 20 20 20 20 20 22 5c 6e st)..... "\n
4e00: 20 20 20 20 20 20 20 20 20 72 75 6e 64 69 72 3a rundir:
4e10: 20 20 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 " (db:test-ge
4e20: 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 0a 09 t-rundir test)..
4e30: 09 09 09 20 20 20 20 20 29 0a 09 09 09 20 20 20 ... )....
4e40: 20 20 20 3b 3b 20 45 61 63 68 20 74 65 73 74 0a ;; Each test.
4e50: 09 09 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e ... ;; DO N
4e60: 4f 54 20 72 65 6d 6f 74 65 20 72 75 6e 0a 09 09 OT remote run...
4e70: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 . (let ((st
4e80: 65 70 73 20 28 64 62 3a 67 65 74 2d 73 74 65 70 eps (db:get-step
4e90: 73 2d 66 6f 72 2d 74 65 73 74 20 23 66 20 28 64 s-for-test #f (d
4ea0: 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 b:test-get-id te
4eb0: 73 74 29 29 29 29 0a 09 09 09 09 28 66 6f 72 2d st)))).....(for-
4ec0: 65 61 63 68 20 0a 09 09 09 09 20 28 6c 61 6d 62 each ..... (lamb
4ed0: 64 61 20 28 73 74 65 70 29 0a 09 09 09 09 20 20 da (step).....
4ee0: 20 28 66 6f 72 6d 61 74 20 23 74 20 0a 09 09 09 (format #t ....
4ef0: 09 09 20 20 20 22 20 20 20 20 53 74 65 70 3a 20 .. " Step:
4f00: 7e 32 30 61 20 53 74 61 74 65 3a 20 7e 31 30 61 ~20a State: ~10a
4f10: 20 53 74 61 74 75 73 3a 20 7e 31 30 61 20 54 69 Status: ~10a Ti
4f20: 6d 65 20 7e 32 32 61 5c 6e 22 0a 09 09 09 09 09 me ~22a\n"......
4f30: 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d (db:step-get-
4f40: 73 74 65 70 6e 61 6d 65 20 73 74 65 70 29 0a 09 stepname step)..
4f50: 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 2d .... (db:step-
4f60: 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a get-state step).
4f70: 09 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 ..... (db:step
4f80: 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 70 -get-status step
4f90: 29 0a 09 09 09 09 09 20 20 20 28 64 62 3a 73 74 )...... (db:st
4fa0: 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d ep-get-event_tim
4fb0: 65 20 73 74 65 70 29 29 29 0a 09 09 09 09 20 73 e step)))..... s
4fc0: 74 65 70 73 29 29 29 29 29 0a 09 09 20 20 20 20 teps)))))...
4fd0: 20 20 74 65 73 74 73 29 29 29 29 29 0a 09 20 20 tests)))))..
4fe0: 20 20 20 72 75 6e 73 29 0a 09 20 20 20 28 73 65 runs).. (se
4ff0: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
5000: 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d * #t))))..;;====
5010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5050: 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e 0a 3b ==.;; full run.;
5060: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
5070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
50a0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 20 =======..;; get
50b0: 6c 6f 63 6b 20 69 6e 20 64 62 20 66 6f 72 20 66 lock in db for f
50c0: 75 6c 6c 20 72 75 6e 20 66 6f 72 20 74 68 69 73 ull run for this
50d0: 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 66 6f directory.;; fo
50e0: 72 20 61 6c 6c 20 74 65 73 74 73 20 77 69 74 68 r all tests with
50f0: 20 64 65 70 73 0a 3b 3b 20 20 20 77 61 6c 6b 20 deps.;; walk
5100: 74 72 65 65 20 6f 66 20 74 65 73 74 73 20 74 6f tree of tests to
5110: 20 66 69 6e 64 20 68 65 61 64 20 74 61 73 6b 73 find head tasks
5120: 0a 3b 3b 20 20 20 61 64 64 20 68 65 61 64 20 74 .;; add head t
5130: 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 asks to task que
5140: 75 65 0a 3b 3b 20 20 20 61 64 64 20 64 65 70 65 ue.;; add depe
5150: 6e 64 61 6e 74 20 74 61 73 6b 73 20 74 6f 20 74 ndant tasks to t
5160: 61 73 6b 20 71 75 65 75 65 20 0a 3b 3b 20 20 20 ask queue .;;
5170: 61 64 64 20 72 65 6d 61 69 6e 69 6e 67 20 74 61 add remaining ta
5180: 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 sks to task queu
5190: 65 0a 3b 3b 20 66 6f 72 20 65 61 63 68 20 74 61 e.;; for each ta
51a0: 73 6b 20 69 6e 20 74 61 73 6b 20 71 75 65 75 65 sk in task queue
51b0: 0a 3b 3b 20 20 20 69 66 20 68 61 76 65 20 61 64 .;; if have ad
51c0: 65 71 75 61 74 65 20 72 65 73 6f 75 72 63 65 73 equate resources
51d0: 0a 3b 3b 20 20 20 20 20 6c 61 75 6e 63 68 20 74 .;; launch t
51e0: 61 73 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b ask.;; else.;;
51f0: 20 20 20 20 20 70 75 74 20 74 61 73 6b 20 69 6e put task in
5200: 20 64 65 66 65 72 72 65 64 20 71 75 65 75 65 0a deferred queue.
5210: 3b 3b 20 69 66 20 73 74 69 6c 6c 20 6f 6b 20 74 ;; if still ok t
5220: 6f 20 72 75 6e 20 74 61 73 6b 73 0a 3b 3b 20 20 o run tasks.;;
5230: 20 70 72 6f 63 65 73 73 20 64 65 66 65 72 72 65 process deferre
5240: 64 20 74 61 73 6b 73 20 70 65 72 20 61 62 6f 76 d tasks per abov
5250: 65 20 73 74 65 70 73 0a 0a 3b 3b 20 72 75 6e 20 e steps..;; run
5260: 61 6c 6c 20 74 65 73 74 73 20 61 72 65 20 61 72 all tests are ar
5270: 65 20 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 44 20 e Not COMPLETED
5280: 61 6e 64 20 50 41 53 53 20 6f 72 20 43 48 45 43 and PASS or CHEC
5290: 4b 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d K.(if (args:get-
52a0: 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 0a 20 arg "-runall").
52b0: 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
52c0: 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 75 6e call . "-run
52d0: 61 6c 6c 22 0a 20 20 20 20 20 22 72 75 6e 20 61 all". "run a
52e0: 6c 6c 20 74 65 73 74 73 22 0a 20 20 20 20 20 28 ll tests". (
52f0: 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 lambda (target r
5300: 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e unname keys keyn
5310: 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a ames keyvallst).
5320: 20 20 20 20 20 20 20 28 72 75 6e 73 3a 72 75 6e (runs:run
5330: 2d 74 65 73 74 73 20 74 61 72 67 65 74 0a 09 09 -tests target...
5340: 20 20 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a 09 runname..
5350: 09 20 20 20 20 20 20 20 22 25 22 0a 09 09 20 20 . "%"...
5360: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
5370: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a rg "-testpatt").
5380: 09 09 20 20 20 20 20 20 20 75 73 65 72 0a 09 09 .. user...
5390: 20 20 20 20 20 20 20 61 72 67 73 3a 61 72 67 2d args:arg-
53a0: 68 61 73 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d hash))))..;;====
53b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53f0: 3d 3d 0a 3b 3b 20 72 75 6e 20 6f 6e 65 20 74 65 ==.;; run one te
5400: 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d st.;;===========
5410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
5450: 31 2e 20 66 69 6e 64 20 74 68 65 20 63 6f 6e 66 1. find the conf
5460: 69 67 20 66 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 ig file.;; 2. ch
5470: 61 6e 67 65 20 74 6f 20 74 68 65 20 74 65 73 74 ange to the test
5480: 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 33 2e directory.;; 3.
5490: 20 75 70 64 61 74 65 20 74 68 65 20 64 62 20 77 update the db w
54a0: 69 74 68 20 22 74 65 73 74 20 73 74 61 72 74 65 ith "test starte
54b0: 64 22 20 73 74 61 74 75 73 2c 20 73 65 74 20 72 d" status, set r
54c0: 75 6e 6e 69 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 unning host.;; 4
54d0: 2e 20 70 72 6f 63 65 73 73 20 6c 61 75 6e 63 68 . process launch
54e0: 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 the test.;;
54f0: 2d 20 6d 6f 6e 69 74 6f 72 20 74 68 65 20 70 72 - monitor the pr
5500: 6f 63 65 73 73 2c 20 75 70 64 61 74 65 20 73 74 ocess, update st
5510: 61 74 73 20 69 6e 20 74 68 65 20 64 62 20 65 76 ats in the db ev
5520: 65 72 79 20 32 5e 6e 20 6d 69 6e 75 74 65 73 0a ery 2^n minutes.
5530: 3b 3b 20 35 2e 20 61 73 20 74 68 65 20 74 65 73 ;; 5. as the tes
5540: 74 20 70 72 6f 63 65 65 64 73 20 69 6e 74 65 72 t proceeds inter
5550: 6e 61 6c 6c 79 20 69 74 20 63 61 6c 6c 73 20 6d nally it calls m
5560: 65 67 61 74 65 73 74 20 61 73 20 65 61 63 68 20 egatest as each
5570: 73 74 65 70 20 69 73 0a 3b 3b 20 20 20 20 73 74 step is.;; st
5580: 61 72 74 65 64 20 61 6e 64 20 63 6f 6d 70 6c 65 arted and comple
5590: 74 65 64 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 ted.;; - step
55a0: 20 73 74 61 72 74 65 64 2c 20 74 69 6d 65 73 74 started, timest
55b0: 61 6d 70 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 amp.;; - step
55c0: 20 63 6f 6d 70 6c 65 74 65 64 2c 20 65 78 69 74 completed, exit
55d0: 20 73 74 61 74 75 73 2c 20 74 69 6d 65 73 74 61 status, timesta
55e0: 6d 70 0a 3b 3b 20 36 2e 20 74 65 73 74 20 70 68 mp.;; 6. test ph
55f0: 6f 6e 65 20 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d one home.;; -
5600: 20 69 66 20 74 65 73 74 20 72 75 6e 20 74 69 6d if test run tim
5610: 65 20 3e 20 61 6c 6c 6f 77 65 64 20 72 75 6e 20 e > allowed run
5620: 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a time then kill j
5630: 6f 62 0a 3b 3b 20 20 20 20 2d 20 69 66 20 63 61 ob.;; - if ca
5640: 6e 6e 6f 74 20 61 63 63 65 73 73 20 64 62 20 3e nnot access db >
5650: 20 61 6c 6c 6f 77 65 64 20 64 69 73 63 6f 6e 6e allowed disconn
5660: 65 63 74 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 ect time then ki
5670: 6c 6c 20 6a 6f 62 0a 0a 28 69 66 20 28 61 72 67 ll job..(if (arg
5680: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 s:get-arg "-runt
5690: 65 73 74 73 22 29 0a 20 20 28 67 65 6e 65 72 61 ests"). (genera
56a0: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 22 l-run-call . "
56b0: 2d 72 75 6e 74 65 73 74 73 22 20 0a 20 20 20 22 -runtests" . "
56c0: 72 75 6e 20 61 20 74 65 73 74 22 20 0a 20 20 20 run a test" .
56d0: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
56e0: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
56f0: 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 names keyvallst)
5700: 0a 20 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d . (runs:run-
5710: 74 65 73 74 73 20 74 61 72 67 65 74 0a 09 09 20 tests target...
5720: 20 20 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 runname...
5730: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
5740: 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 09 "-runtests")...
5750: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
5760: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a rg "-testpatt").
5770: 09 09 20 20 20 20 20 75 73 65 72 0a 09 09 20 20 .. user...
5780: 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 args:arg-hash
5790: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
57a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
57e0: 3b 20 52 6f 6c 6c 75 70 20 69 6e 74 6f 20 61 20 ; Rollup into a
57f0: 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;==========
5800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
5840: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
5850: 22 2d 72 6f 6c 6c 75 70 22 29 0a 20 20 20 20 28 "-rollup"). (
5860: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 64 65 62 begin. (deb
5870: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
5880: 52 3a 20 52 6f 6c 6c 75 70 20 69 73 20 63 75 72 R: Rollup is cur
5890: 72 65 6e 74 6c 79 20 6e 6f 74 20 77 6f 72 6b 69 rently not worki
58a0: 6e 67 2e 20 49 66 20 79 6f 75 20 6e 65 65 64 20 ng. If you need
58b0: 69 74 20 70 6c 65 61 73 65 20 73 75 62 6d 69 74 it please submit
58c0: 20 61 20 74 69 63 6b 65 74 20 61 74 20 68 74 74 a ticket at htt
58d0: 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 p://www.kiatoa.c
58e0: 6f 6d 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 om/fossils/megat
58f0: 65 73 74 22 29 0a 20 20 20 20 20 20 28 65 78 69 est"). (exi
5900: 74 20 34 29 29 29 0a 3b 3b 20 20 20 20 20 28 67 t 4))).;; (g
5910: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
5920: 0a 3b 3b 20 20 20 20 20 20 22 2d 72 6f 6c 6c 75 .;; "-rollu
5930: 70 22 20 0a 3b 3b 20 20 20 20 20 20 22 72 6f 6c p" .;; "rol
5940: 6c 75 70 20 74 65 73 74 73 22 20 0a 3b 3b 20 20 lup tests" .;;
5950: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
5960: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
5970: 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c keynames keyval
5980: 6c 73 74 29 0a 3b 3b 20 20 20 20 20 20 20 20 28 lst).;; (
5990: 72 75 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 runs:rollup-run
59a0: 6b 65 79 73 0a 3b 3b 20 09 09 09 28 6b 65 79 73 keys.;; ...(keys
59b0: 2d 3e 61 6c 69 73 74 20 6b 65 79 73 20 22 6e 61 ->alist keys "na
59c0: 22 29 0a 3b 3b 20 09 09 09 28 61 72 67 73 3a 67 ").;; ...(args:g
59d0: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
59e0: 22 29 20 0a 3b 3b 20 09 09 09 75 73 65 72 29 29 ") .;; ...user))
59f0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
5a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
5a40: 4c 6f 63 6b 20 6f 72 20 75 6e 6c 6f 63 6b 20 61 Lock or unlock a
5a50: 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;=========
5a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
5aa0: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
5ab0: 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 28 61 72 -arg "-lock")(ar
5ac0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c gs:get-arg "-unl
5ad0: 6f 63 6b 22 29 29 0a 20 20 20 20 28 67 65 6e 65 ock")). (gene
5ae0: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 ral-run-call .
5af0: 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 (if (args:get
5b00: 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 20 22 2d -arg "-lock") "-
5b10: 6c 6f 63 6b 22 20 22 2d 75 6e 6c 6f 63 6b 22 29 lock" "-unlock")
5b20: 0a 20 20 20 20 20 22 6c 6f 63 6b 2f 75 6e 6c 6f . "lock/unlo
5b30: 63 6b 20 74 65 73 74 73 22 20 0a 20 20 20 20 20 ck tests" .
5b40: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
5b50: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
5b60: 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 names keyvallst)
5b70: 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a 68 61 . (runs:ha
5b80: 6e 64 6c 65 2d 6c 6f 63 6b 69 6e 67 20 0a 09 09 ndle-locking ...
5b90: 20 20 74 61 72 67 65 74 0a 09 09 20 20 6b 65 79 target... key
5ba0: 73 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d s... (args:get-
5bb0: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 arg ":runname")
5bc0: 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ... (args:get-a
5bd0: 72 67 20 22 2d 6c 6f 63 6b 22 29 0a 09 09 20 20 rg "-lock")...
5be0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5bf0: 75 6e 6c 6f 63 6b 22 29 0a 09 09 20 20 75 73 65 unlock")... use
5c00: 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d r))))..;;=======
5c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
5c50: 3b 3b 20 47 65 74 20 70 61 74 68 73 20 74 6f 20 ;; Get paths to
5c60: 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d tests.;;========
5c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
5cb0: 3b 20 47 65 74 20 74 65 73 74 20 70 61 74 68 73 ; Get test paths
5cc0: 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 74 matching target
5cd0: 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 , runname, and t
5ce0: 65 73 74 70 61 74 74 0a 28 69 66 20 28 6f 72 20 estpatt.(if (or
5cf0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5d00: 74 65 73 74 2d 66 69 6c 65 73 22 29 28 61 72 67 test-files")(arg
5d10: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
5d20: 2d 70 61 74 68 73 22 29 29 0a 20 20 20 20 3b 3b -paths")). ;;
5d30: 20 69 66 20 77 65 20 61 72 65 20 69 6e 20 61 20 if we are in a
5d40: 74 65 73 74 20 75 73 65 20 74 68 65 20 4d 54 5f test use the MT_
5d50: 43 4d 44 49 4e 46 4f 20 64 61 74 61 0a 20 20 20 CMDINFO data.
5d60: 20 28 69 66 20 28 67 65 74 65 6e 76 20 22 4d 54 (if (getenv "MT
5d70: 5f 43 4d 44 49 4e 46 4f 22 29 0a 09 28 6c 65 74 _CMDINFO")..(let
5d80: 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 20 * ((startingdir
5d90: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
5da0: 72 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 6d ry)).. (cm
5db0: 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 6f dinfo (read (o
5dc0: 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 pen-input-string
5dd0: 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d (base64:base64-
5de0: 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 22 decode (getenv "
5df0: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 MT_CMDINFO")))))
5e00: 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 72 75 6e .. ;; (run
5e10: 72 65 6d 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 remote (assoc/de
5e20: 66 61 75 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 fault 'runremote
5e30: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
5e40: 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 (transport (a
5e50: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 ssoc/default 'tr
5e60: 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 ansport cmdinfo)
5e70: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 ).. (testp
5e80: 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
5e90: 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
5ea0: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
5eb0: 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 (test-name (ass
5ec0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
5ed0: 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a -name cmdinfo)).
5ee0: 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 . (runscri
5ef0: 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c pt (assoc/defaul
5f00: 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 t 'runscript cmd
5f10: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
5f20: 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 db-host (assoc
5f30: 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 /default 'db-hos
5f40: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
5f50: 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id
5f60: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
5f70: 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 'run-id cmdin
5f80: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 fo)).. (it
5f90: 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 emdat (assoc/d
5fa0: 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 efault 'itemdat
5fb0: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
5fc0: 20 20 20 20 28 64 62 20 20 20 20 20 20 20 20 23 (db #
5fd0: 66 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 f).. (stat
5fe0: 65 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d e (args:get-
5ff0: 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 arg ":state"))..
6000: 20 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 (status
6010: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
6020: 22 3a 73 74 61 74 75 73 22 29 29 0a 09 20 20 20 ":status"))..
6030: 20 20 20 20 28 74 61 72 67 65 74 20 20 20 20 28 (target (
6040: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
6050: 61 72 67 65 74 22 29 29 0a 09 20 20 20 20 20 20 arget"))..
6060: 20 28 74 6f 70 70 61 74 68 20 20 20 28 61 73 73 (toppath (ass
6070: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 6f 70 70 oc/default 'topp
6080: 61 74 68 20 20 20 63 6d 64 69 6e 66 6f 29 29 29 ath cmdinfo)))
6090: 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 .. (change-dire
60a0: 63 74 6f 72 79 20 74 6f 70 70 61 74 68 29 0a 09 ctory toppath)..
60b0: 20 20 3b 3b 20 28 73 65 74 21 20 2a 72 75 6e 72 ;; (set! *runr
60c0: 65 6d 6f 74 65 2a 20 72 75 6e 72 65 6d 6f 74 65 emote* runremote
60d0: 29 0a 09 20 20 28 73 65 74 21 20 2a 74 72 61 6e ).. (set! *tran
60e0: 73 70 6f 72 74 2d 74 79 70 65 2a 20 28 73 74 72 sport-type* (str
60f0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 6e ing->symbol tran
6100: 73 70 6f 72 74 29 29 0a 09 20 20 28 69 66 20 28 sport)).. (if (
6110: 6e 6f 74 20 74 61 72 67 65 74 29 0a 09 20 20 20 not target)..
6120: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 (begin...(deb
6130: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
6140: 52 3a 20 2d 74 61 72 67 65 74 20 69 73 20 72 65 R: -target is re
6150: 71 75 69 72 65 64 2e 22 29 0a 09 09 28 65 78 69 quired.")...(exi
6160: 74 20 31 29 29 29 0a 09 20 20 28 69 66 20 28 6e t 1))).. (if (n
6170: 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 ot (setup-for-ru
6180: 6e 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 n)).. (begi
6190: 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 n...(debug:print
61a0: 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 0 "Failed to se
61b0: 74 75 70 2c 20 67 69 76 69 6e 67 20 75 70 20 6f tup, giving up o
61c0: 6e 20 2d 74 65 73 74 2d 70 61 74 68 73 20 6f 72 n -test-paths or
61d0: 20 2d 74 65 73 74 2d 66 69 6c 65 73 2c 20 65 78 -test-files, ex
61e0: 69 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 iting")...(exit
61f0: 31 29 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 1))).. (let* ((
6200: 6b 65 79 73 20 20 20 20 20 28 63 64 62 3a 72 65 keys (cdb:re
6210: 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d mote-run db:get-
6220: 6b 65 79 73 20 64 62 29 29 0a 09 09 20 28 6b 65 keys db))... (ke
6230: 79 6e 61 6d 65 73 20 28 6d 61 70 20 6b 65 79 3a ynames (map key:
6240: 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 get-fieldname ke
6250: 79 73 29 29 0a 09 09 20 3b 3b 20 64 62 3a 74 65 ys))... ;; db:te
6260: 73 74 2d 67 65 74 2d 70 61 74 68 73 20 6d 75 73 st-get-paths mus
6270: 74 20 6e 6f 74 20 62 65 20 72 75 6e 20 72 65 6d t not be run rem
6280: 6f 74 65 0a 09 09 20 28 70 61 74 68 73 20 20 20 ote... (paths
6290: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 (db:test-get-pa
62a0: 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 ths-matching db
62b0: 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 20 keynames target
62c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
62d0: 74 65 73 74 2d 66 69 6c 65 73 22 29 29 29 29 0a test-files")))).
62e0: 09 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 . (set! *dids
62f0: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 omething* #t)..
6300: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
6310: 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 28 mbda (path)....(
6320: 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 20 print path))...
6330: 20 20 20 20 20 70 61 74 68 73 29 29 29 0a 09 3b paths)))..;
6340: 3b 20 65 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 ; else do a gene
6350: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 ral-run-call..(g
6360: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
6370: 0a 09 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 .. "-test-files"
6380: 0a 09 20 22 47 65 74 20 70 61 74 68 73 20 74 6f .. "Get paths to
6390: 20 74 65 73 74 22 0a 09 20 28 6c 61 6d 62 64 61 test".. (lambda
63a0: 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 (target runname
63b0: 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b keys keynames k
63c0: 65 79 76 61 6c 6c 73 74 29 0a 09 20 20 20 28 6c eyvallst).. (l
63d0: 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 23 et* ((db #
63e0: 66 29 0a 09 09 20 20 3b 3b 20 44 4f 20 4e 4f 54 f)... ;; DO NOT
63f0: 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 20 run remote...
6400: 28 70 61 74 68 73 20 20 20 20 28 64 62 3a 74 65 (paths (db:te
6410: 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 st-get-paths-mat
6420: 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 ching db keyname
6430: 73 20 74 61 72 67 65 74 20 28 61 72 67 73 3a 67 s target (args:g
6440: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 et-arg "-test-fi
6450: 6c 65 73 22 29 29 29 29 0a 09 20 20 20 20 20 28 les")))).. (
6460: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
6470: 20 28 70 61 74 68 29 0a 09 09 09 20 28 70 72 69 (path).... (pri
6480: 6e 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 nt path))...
6490: 20 20 20 70 61 74 68 73 29 29 29 29 29 29 0a 0a paths))))))..
64a0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
64b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
64c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
64d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
64e0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 ========.;; Arch
64f0: 69 76 65 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d ive tests.;;====
6500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6540: 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 20 74 65 ==.;; Archive te
6550: 73 74 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 sts matching tar
6560: 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e get, runname, an
6570: 64 20 74 65 73 74 70 61 74 74 0a 28 69 66 20 28 d testpatt.(if (
6580: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 61 args:get-arg "-a
6590: 72 63 68 69 76 65 22 29 0a 20 20 20 20 3b 3b 20 rchive"). ;;
65a0: 69 66 20 77 65 20 61 72 65 20 69 6e 20 61 20 74 if we are in a t
65b0: 65 73 74 20 75 73 65 20 74 68 65 20 4d 54 5f 43 est use the MT_C
65c0: 4d 44 49 4e 46 4f 20 64 61 74 61 0a 20 20 20 20 MDINFO data.
65d0: 28 69 66 20 28 67 65 74 65 6e 76 20 22 4d 54 5f (if (getenv "MT_
65e0: 43 4d 44 49 4e 46 4f 22 29 0a 09 28 6c 65 74 2a CMDINFO")..(let*
65f0: 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 20 28 ((startingdir (
6600: 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 current-director
6610: 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 6d 64 y)).. (cmd
6620: 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 6f 70 info (read (op
6630: 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 en-input-string
6640: 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d 64 (base64:base64-d
6650: 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 22 4d ecode (getenv "M
6660: 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a T_CMDINFO"))))).
6670: 09 20 20 20 20 20 20 20 3b 3b 20 28 72 75 6e 72 . ;; (runr
6680: 65 6d 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 66 emote (assoc/def
6690: 61 75 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 ault 'runremote
66a0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
66b0: 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 73 (transport (as
66c0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 61 soc/default 'tra
66d0: 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 nsport cmdinfo))
66e0: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 61 .. (testpa
66f0: 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 th (assoc/defau
6700: 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 6d lt 'testpath cm
6710: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
6720: 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f (test-name (asso
6730: 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d c/default 'test-
6740: 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 name cmdinfo))..
6750: 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 (runscrip
6760: 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
6770: 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 'runscript cmdi
6780: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 nfo)).. (d
6790: 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f b-host (assoc/
67a0: 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 default 'db-host
67b0: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
67c0: 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 (run-id
67d0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
67e0: 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 run-id cmdinf
67f0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 o)).. (ite
6800: 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 mdat (assoc/de
6810: 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 fault 'itemdat
6820: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
6830: 20 20 20 28 64 62 20 20 20 20 20 20 20 20 23 66 (db #f
6840: 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 65 ).. (state
6850: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
6860: 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 rg ":state"))..
6870: 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 (status
6880: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6890: 3a 73 74 61 74 75 73 22 29 29 0a 09 20 20 20 20 :status"))..
68a0: 20 20 20 28 74 61 72 67 65 74 20 20 20 20 28 61 (target (a
68b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 rgs:get-arg "-ta
68c0: 72 67 65 74 22 29 29 29 0a 09 20 20 28 63 68 61 rget"))).. (cha
68d0: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 nge-directory te
68e0: 73 74 70 61 74 68 29 0a 09 20 20 3b 3b 20 28 73 stpath).. ;; (s
68f0: 65 74 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 et! *runremote*
6900: 72 75 6e 72 65 6d 6f 74 65 29 0a 09 20 20 28 73 runremote).. (s
6910: 65 74 21 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 et! *transport-t
6920: 79 70 65 2a 20 28 73 74 72 69 6e 67 2d 3e 73 79 ype* (string->sy
6930: 6d 62 6f 6c 20 74 72 61 6e 73 70 6f 72 74 29 29 mbol transport))
6940: 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 74 61 72 .. (if (not tar
6950: 67 65 74 29 0a 09 20 20 20 20 20 20 28 62 65 67 get).. (beg
6960: 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e in...(debug:prin
6970: 74 20 30 20 22 45 52 52 4f 52 3a 20 2d 74 61 72 t 0 "ERROR: -tar
6980: 67 65 74 20 69 73 20 72 65 71 75 69 72 65 64 2e get is required.
6990: 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a ")...(exit 1))).
69a0: 09 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 . (if (not (set
69b0: 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 up-for-run))..
69c0: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 (begin...(de
69d0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 bug:print 0 "Fai
69e0: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 67 69 led to setup, gi
69f0: 76 69 6e 67 20 75 70 20 6f 6e 20 2d 61 72 63 68 ving up on -arch
6a00: 69 76 65 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 ive, exiting")..
6a10: 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 .(exit 1))).. (
6a20: 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 20 20 let* ((keys
6a30: 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 (cdb:remote-run
6a40: 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 db:get-keys db))
6a50: 0a 09 09 20 28 6b 65 79 6e 61 6d 65 73 20 28 6d ... (keynames (m
6a60: 61 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 ap key:get-field
6a70: 6e 61 6d 65 20 6b 65 79 73 29 29 0a 09 09 20 3b name keys))... ;
6a80: 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d ; DO NOT run rem
6a90: 6f 74 65 0a 09 09 20 28 70 61 74 68 73 20 20 20 ote... (paths
6aa0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 (db:test-get-pa
6ab0: 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 ths-matching db
6ac0: 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 29 keynames target)
6ad0: 29 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 )).. (set! *d
6ae0: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
6af0: 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 .. (for-each
6b00: 28 6c 61 6d 62 64 61 20 28 70 61 74 68 29 0a 09 (lambda (path)..
6b10: 09 09 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a ..(print path)).
6b20: 09 09 20 20 20 20 20 20 70 61 74 68 73 29 29 29 .. paths)))
6b30: 0a 09 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 67 ..;; else do a g
6b40: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a eneral-run-call.
6b50: 09 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 .(general-run-ca
6b60: 6c 6c 20 0a 09 20 22 2d 74 65 73 74 2d 70 61 74 ll .. "-test-pat
6b70: 68 73 22 0a 09 20 22 47 65 74 20 70 61 74 68 73 hs".. "Get paths
6b80: 20 74 6f 20 74 65 73 74 73 22 0a 09 20 28 6c 61 to tests".. (la
6b90: 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
6ba0: 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d name keys keynam
6bb0: 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 09 20 es keyvallst)..
6bc0: 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 20 (let* ((db
6bd0: 20 20 20 23 66 29 0a 09 09 20 20 3b 3b 20 44 4f #f)... ;; DO
6be0: 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a NOT run remote.
6bf0: 09 09 20 20 28 70 61 74 68 73 20 20 20 20 28 64 .. (paths (d
6c00: 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 b:test-get-paths
6c10: 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 -matching db key
6c20: 6e 61 6d 65 73 20 74 61 72 67 65 74 29 29 29 0a names target))).
6c30: 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 . (for-each
6c40: 28 6c 61 6d 62 64 61 20 28 70 61 74 68 29 0a 09 (lambda (path)..
6c50: 09 09 20 28 70 72 69 6e 74 20 70 61 74 68 29 29 .. (print path))
6c60: 0a 09 09 20 20 20 20 20 20 20 70 61 74 68 73 29 ... paths)
6c70: 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d )))))..;;=======
6c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
6cc0: 3b 3b 20 45 78 74 72 61 63 74 20 61 20 73 70 72 ;; Extract a spr
6cd0: 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 74 68 eadsheet from th
6ce0: 65 20 72 75 6e 73 20 64 61 74 61 62 61 73 65 0a e runs database.
6cf0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
6d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d30: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
6d40: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 rgs:get-arg "-ex
6d50: 74 72 61 63 74 2d 6f 64 73 22 29 0a 20 20 20 20 tract-ods").
6d60: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
6d70: 6c 0a 20 20 20 20 20 22 2d 65 78 74 72 61 63 74 l. "-extract
6d80: 2d 6f 64 73 22 0a 20 20 20 20 20 22 4d 61 6b 65 -ods". "Make
6d90: 20 6f 64 73 20 73 70 72 65 61 64 73 68 65 65 74 ods spreadsheet
6da0: 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ". (lambda (
6db0: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
6dc0: 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 eys keynames key
6dd0: 76 61 6c 6c 73 74 29 0a 20 20 20 20 20 20 20 28 vallst). (
6de0: 6c 65 74 20 28 28 64 62 20 20 20 20 20 20 20 20 let ((db
6df0: 20 23 66 29 0a 09 20 20 20 20 20 28 6f 75 74 70 #f).. (outp
6e00: 75 74 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 utfile (args:get
6e10: 2d 61 72 67 20 22 2d 65 78 74 72 61 63 74 2d 6f -arg "-extract-o
6e20: 64 73 22 29 29 0a 09 20 20 20 20 20 28 72 75 6e ds")).. (run
6e30: 73 70 61 74 74 20 20 20 28 61 72 67 73 3a 67 65 spatt (args:ge
6e40: 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 t-arg ":runname"
6e50: 29 29 0a 09 20 20 20 20 20 28 70 61 74 68 6d 6f )).. (pathmo
6e60: 64 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 d (args:get-a
6e70: 72 67 20 22 2d 70 61 74 68 6d 6f 64 22 29 29 0a rg "-pathmod")).
6e80: 09 20 20 20 20 20 28 6b 65 79 76 61 6c 61 6c 69 . (keyvalali
6e90: 73 74 20 28 6b 65 79 73 2d 3e 61 6c 69 73 74 20 st (keys->alist
6ea0: 6b 65 79 73 20 22 25 22 29 29 29 0a 09 20 28 64 keys "%"))).. (d
6eb0: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 45 78 ebug:print 2 "Ex
6ec0: 74 72 61 63 74 20 6f 64 73 2c 20 6f 75 74 70 75 tract ods, outpu
6ed0: 74 66 69 6c 65 3a 20 22 20 6f 75 74 70 75 74 66 tfile: " outputf
6ee0: 69 6c 65 20 22 20 72 75 6e 73 70 61 74 74 3a 20 ile " runspatt:
6ef0: 22 20 72 75 6e 73 70 61 74 74 20 22 20 6b 65 79 " runspatt " key
6f00: 76 61 6c 61 6c 69 73 74 3a 20 22 20 6b 65 79 76 valalist: " keyv
6f10: 61 6c 61 6c 69 73 74 29 0a 09 20 28 63 64 62 3a alalist).. (cdb:
6f20: 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 65 78 remote-run db:ex
6f30: 74 72 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 tract-ods-file d
6f40: 62 20 6f 75 74 70 75 74 66 69 6c 65 20 6b 65 79 b outputfile key
6f50: 76 61 6c 61 6c 69 73 74 20 28 69 66 20 72 75 6e valalist (if run
6f60: 73 70 61 74 74 20 72 75 6e 73 70 61 74 74 20 22 spatt runspatt "
6f70: 25 22 29 20 70 61 74 68 6d 6f 64 29 29 29 29 29 %") pathmod)))))
6f80: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
6f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 ==========.;; ex
6fd0: 65 63 75 74 65 20 74 68 65 20 74 65 73 74 0a 3b ecute the test.;
6fe0: 3b 20 20 20 20 2d 20 67 65 74 73 20 63 61 6c 6c ; - gets call
6ff0: 65 64 20 6f 6e 20 72 65 6d 6f 74 65 20 68 6f 73 ed on remote hos
7000: 74 0a 3b 3b 20 20 20 20 2d 20 72 65 63 65 69 76 t.;; - receiv
7010: 65 73 20 69 6e 66 6f 20 66 72 6f 6d 20 74 68 65 es info from the
7020: 20 2d 65 78 65 63 75 74 65 20 70 61 72 61 6d 0a -execute param.
7030: 3b 3b 20 20 20 20 2d 20 70 61 73 73 65 73 20 69 ;; - passes i
7040: 6e 66 6f 20 74 6f 20 73 74 65 70 73 20 76 69 61 nfo to steps via
7050: 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 MT_CMDINFO env
7060: 76 61 72 20 28 66 75 74 75 72 65 20 69 73 20 74 var (future is t
7070: 6f 20 75 73 65 20 61 20 64 6f 74 20 66 69 6c 65 o use a dot file
7080: 29 0a 3b 3b 20 20 20 20 2d 20 67 61 74 68 65 72 ).;; - gather
7090: 73 20 68 6f 73 74 20 69 6e 66 6f 20 61 6e 64 20 s host info and
70a0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
70b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
70f0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
7100: 78 65 63 75 74 65 22 29 0a 20 20 20 20 28 62 65 xecute"). (be
7110: 67 69 6e 0a 20 20 20 20 20 20 28 6c 61 75 6e 63 gin. (launc
7120: 68 3a 65 78 65 63 75 74 65 20 28 61 72 67 73 3a h:execute (args:
7130: 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 get-arg "-execut
7140: 65 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 e")). (set!
7150: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
7160: 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d #t)))..;;=======
7170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
71b0: 3b 3b 20 54 65 73 74 20 63 6f 6d 6d 61 6e 64 73 ;; Test commands
71c0: 20 28 69 2e 65 2e 20 66 6f 72 20 75 73 65 20 69 (i.e. for use i
71d0: 6e 73 69 64 65 20 74 65 73 74 73 29 0a 3b 3b 3d nside tests).;;=
71e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7220: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
7230: 6d 65 67 61 74 65 73 74 3a 73 74 65 70 20 73 74 megatest:step st
7240: 65 70 20 73 74 61 74 65 20 73 74 61 74 75 73 20 ep state status
7250: 6c 6f 67 66 69 6c 65 20 6d 73 67 29 0a 20 20 28 logfile msg). (
7260: 69 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 if (not (getenv
7270: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 20 "MT_CMDINFO")).
7280: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 (begin..(de
7290: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
72a0: 4f 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 OR: MT_CMDINFO e
72b0: 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 nv var not set,
72c0: 2d 73 74 65 70 20 6d 75 73 74 20 62 65 20 63 61 -step must be ca
72d0: 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 lled *inside* a
72e0: 6d 65 67 61 74 65 73 74 20 69 6e 76 6f 6b 65 64 megatest invoked
72f0: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a environment!").
7300: 09 28 65 78 69 74 20 35 29 29 0a 20 20 20 20 20 .(exit 5)).
7310: 20 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e 66 6f (let* ((cmdinfo
7320: 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 (read (open-i
7330: 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 nput-string (bas
7340: 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 e64:base64-decod
7350: 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d e (getenv "MT_CM
7360: 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 20 DINFO")))))..
7370: 20 20 3b 3b 20 28 72 75 6e 72 65 6d 6f 74 65 20 ;; (runremote
7380: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
7390: 72 75 6e 72 65 6d 6f 74 65 20 63 6d 64 69 6e 66 runremote cmdinf
73a0: 6f 29 29 0a 09 20 20 20 20 20 28 74 72 61 6e 73 o)).. (trans
73b0: 70 6f 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 port (assoc/defa
73c0: 75 6c 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 ult 'transport c
73d0: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 mdinfo)).. (
73e0: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
73f0: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
7400: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
7410: 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 (test-name (
7420: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
7430: 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f est-name cmdinfo
7440: 29 29 0a 09 20 20 20 20 20 28 72 75 6e 73 63 72 )).. (runscr
7450: 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ipt (assoc/defau
7460: 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d lt 'runscript cm
7470: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 64 dinfo)).. (d
7480: 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f b-host (assoc/
7490: 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 default 'db-host
74a0: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
74b0: 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 (run-id (a
74c0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
74d0: 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 n-id cmdinfo)
74e0: 29 0a 09 20 20 20 20 20 28 74 65 73 74 2d 69 64 ).. (test-id
74f0: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
7500: 74 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 t 'test-id cmd
7510: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 69 74 info)).. (it
7520: 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 emdat (assoc/d
7530: 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 efault 'itemdat
7540: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
7550: 20 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 (db #f)
7560: 29 0a 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 )..(change-direc
7570: 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
7580: 3b 3b 20 28 73 65 74 21 20 2a 72 75 6e 72 65 6d ;; (set! *runrem
7590: 6f 74 65 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a ote* runremote).
75a0: 09 28 73 65 74 21 20 2a 74 72 61 6e 73 70 6f 72 .(set! *transpor
75b0: 74 2d 74 79 70 65 2a 20 28 73 74 72 69 6e 67 2d t-type* (string-
75c0: 3e 73 79 6d 62 6f 6c 20 74 72 61 6e 73 70 6f 72 >symbol transpor
75d0: 74 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 73 t))..(if (not (s
75e0: 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 etup-for-run))..
75f0: 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 (begin..
7600: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
7610: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
7620: 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 p, exiting")..
7630: 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 09 (exit 1)))..
7640: 28 69 66 20 28 61 6e 64 20 73 74 61 74 65 20 73 (if (and state s
7650: 74 61 74 75 73 29 0a 09 20 20 20 20 3b 3b 20 44 tatus).. ;; D
7660: 4f 20 4e 4f 54 20 72 65 6d 6f 74 65 20 72 75 6e O NOT remote run
7670: 0a 09 20 20 20 20 28 64 62 3a 74 65 73 74 73 74 .. (db:testst
7680: 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 ep-set-status! d
7690: 62 20 74 65 73 74 2d 69 64 20 73 74 65 70 20 73 b test-id step s
76a0: 74 61 74 65 20 73 74 61 74 75 73 20 6d 73 67 20 tate status msg
76b0: 6c 6f 67 66 69 6c 65 29 0a 09 20 20 20 20 28 62 logfile).. (b
76c0: 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 egin.. (deb
76d0: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
76e0: 52 3a 20 59 6f 75 20 6d 75 73 74 20 73 70 65 63 R: You must spec
76f0: 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a ify :state and :
7700: 73 74 61 74 75 73 20 77 69 74 68 20 65 76 65 72 status with ever
7710: 79 20 63 61 6c 6c 20 74 6f 20 2d 73 74 65 70 22 y call to -step"
7720: 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 20 36 ).. (exit 6
7730: 29 29 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 ))))))..(if (arg
7740: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 s:get-arg "-step
7750: 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
7760: 20 20 20 20 28 6d 65 67 61 74 65 73 74 3a 73 74 (megatest:st
7770: 65 70 20 0a 20 20 20 20 20 20 20 28 61 72 67 73 ep . (args
7780: 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 :get-arg "-step"
7790: 29 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 ). (args:g
77a0: 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 et-arg ":state")
77b0: 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 . (args:ge
77c0: 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 t-arg ":status")
77d0: 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 . (args:ge
77e0: 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 t-arg "-setlog")
77f0: 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 . (args:ge
7800: 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 20 20 20 t-arg "-m")).
7810: 20 20 20 3b 3b 20 28 69 66 20 64 62 20 28 73 71 ;; (if db (sq
7820: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
7830: 64 62 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 db)). (set!
7840: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
7850: 23 74 29 29 29 0a 20 20 20 20 0a 28 69 66 20 28 #t))). .(if (
7860: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
7870: 20 22 2d 73 65 74 6c 6f 67 22 29 20 20 20 20 20 "-setlog")
7880: 20 20 3b 3b 20 73 69 6e 63 65 20 73 65 74 74 69 ;; since setti
7890: 6e 67 20 75 70 20 69 73 20 73 6f 20 63 6f 73 74 ng up is so cost
78a0: 6c 79 20 6c 65 74 73 20 70 69 67 67 79 62 61 63 ly lets piggybac
78b0: 6b 20 6f 6e 20 2d 74 65 73 74 2d 73 74 61 74 75 k on -test-statu
78c0: 73 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 s..(args:get-arg
78d0: 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a "-set-toplog").
78e0: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
78f0: 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a 09 -test-status")..
7900: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7910: 73 65 74 2d 76 61 6c 75 65 73 22 29 0a 09 28 61 set-values")..(a
7920: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
7930: 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a 09 ad-test-data")..
7940: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7950: 72 75 6e 73 74 65 70 22 29 0a 09 28 61 72 67 73 runstep")..(args
7960: 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d 6d 61 :get-arg "-summa
7970: 72 69 7a 65 2d 69 74 65 6d 73 22 29 29 0a 20 20 rize-items")).
7980: 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 65 (if (not (gete
7990: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
79a0: 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 )..(begin.. (de
79b0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
79c0: 4f 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 OR: MT_CMDINFO e
79d0: 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 nv var not set,
79e0: 63 6f 6d 6d 61 6e 64 73 20 2d 74 65 73 74 2d 73 commands -test-s
79f0: 74 61 74 75 73 2c 20 2d 72 75 6e 73 74 65 70 20 tatus, -runstep
7a00: 61 6e 64 20 2d 73 65 74 6c 6f 67 20 6d 75 73 74 and -setlog must
7a10: 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 be called *insi
7a20: 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 65 de* a megatest e
7a30: 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 20 nvironment!")..
7a40: 20 28 65 78 69 74 20 35 29 29 0a 09 28 6c 65 74 (exit 5))..(let
7a50: 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 20 * ((startingdir
7a60: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
7a70: 72 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 6d ry)).. (cm
7a80: 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 6f dinfo (read (o
7a90: 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 pen-input-string
7aa0: 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d (base64:base64-
7ab0: 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 22 decode (getenv "
7ac0: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 MT_CMDINFO")))))
7ad0: 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 72 75 6e .. ;; (run
7ae0: 72 65 6d 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 remote (assoc/de
7af0: 66 61 75 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 fault 'runremote
7b00: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
7b10: 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 (transport (a
7b20: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 ssoc/default 'tr
7b30: 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 ansport cmdinfo)
7b40: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 ).. (testp
7b50: 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
7b60: 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
7b70: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
7b80: 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 (test-name (ass
7b90: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
7ba0: 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a -name cmdinfo)).
7bb0: 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 . (runscri
7bc0: 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c pt (assoc/defaul
7bd0: 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 t 'runscript cmd
7be0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
7bf0: 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 db-host (assoc
7c00: 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 /default 'db-hos
7c10: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
7c20: 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id
7c30: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
7c40: 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 'run-id cmdin
7c50: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 fo)).. (te
7c60: 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 st-id (assoc/d
7c70: 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 efault 'test-id
7c80: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
7c90: 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 (itemdat (
7ca0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 assoc/default 'i
7cb0: 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f temdat cmdinfo
7cc0: 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 20 20 )).. (db
7cd0: 20 20 20 20 20 20 23 66 29 20 3b 3b 20 28 6f 70 #f) ;; (op
7ce0: 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 20 20 20 en-db))..
7cf0: 28 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 (state (args
7d00: 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 :get-arg ":state
7d10: 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 ")).. (sta
7d20: 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 tus (args:get
7d30: 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 -arg ":status"))
7d40: 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 ).. (change-dir
7d50: 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 ectory testpath)
7d60: 0a 09 20 20 3b 3b 20 28 73 65 74 21 20 2a 72 75 .. ;; (set! *ru
7d70: 6e 72 65 6d 6f 74 65 2a 20 72 75 6e 72 65 6d 6f nremote* runremo
7d80: 74 65 29 0a 09 20 20 28 73 65 74 21 20 2a 74 72 te).. (set! *tr
7d90: 61 6e 73 70 6f 72 74 2d 74 79 70 65 2a 20 28 73 ansport-type* (s
7da0: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 74 72 tring->symbol tr
7db0: 61 6e 73 70 6f 72 74 29 29 0a 09 20 20 28 69 66 ansport)).. (if
7dc0: 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 (not (setup-for
7dd0: 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 28 62 -run)).. (b
7de0: 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 egin...(debug:pr
7df0: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f int 0 "Failed to
7e00: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
7e10: 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 0a )...(exit 1)))..
7e20: 09 20 20 3b 3b 20 63 61 6e 20 73 65 74 75 70 20 . ;; can setup
7e30: 61 73 20 63 6c 69 65 6e 74 20 66 6f 72 20 73 65 as client for se
7e40: 72 76 65 72 20 6d 6f 64 65 20 6e 6f 77 0a 09 20 rver mode now..
7e50: 20 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 ;; (client:setu
7e60: 70 29 0a 0a 09 20 20 28 69 66 20 28 61 72 67 73 p)... (if (args
7e70: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d :get-arg "-load-
7e80: 74 65 73 74 2d 64 61 74 61 22 29 0a 09 20 20 20 test-data")..
7e90: 20 20 20 3b 3b 20 68 61 73 20 73 75 62 20 63 6f ;; has sub co
7ea0: 6d 6d 61 6e 64 73 20 74 68 61 74 20 61 72 65 20 mmands that are
7eb0: 72 64 62 3a 0a 09 20 20 20 20 20 20 3b 3b 20 44 rdb:.. ;; D
7ec0: 4f 20 4e 4f 54 20 70 75 74 20 74 68 69 73 20 6f O NOT put this o
7ed0: 6e 65 20 69 6e 74 6f 20 65 69 74 68 65 72 20 63 ne into either c
7ee0: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 6f 72 db:remote-run or
7ef0: 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 0a open-run-close.
7f00: 09 20 20 20 20 20 20 28 64 62 3a 6c 6f 61 64 2d . (db:load-
7f10: 74 65 73 74 2d 64 61 74 61 20 64 62 20 74 65 73 test-data db tes
7f20: 74 2d 69 64 29 29 0a 09 20 20 28 69 66 20 28 61 t-id)).. (if (a
7f30: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
7f40: 74 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 28 6c tlog").. (l
7f50: 65 74 20 28 28 6c 6f 67 66 6e 61 6d 65 20 28 61 et ((logfname (a
7f60: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
7f70: 74 6c 6f 67 22 29 29 29 0a 09 09 28 63 64 62 3a tlog")))...(cdb:
7f80: 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 2a 72 test-set-log! *r
7f90: 75 6e 72 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 unremote* test-i
7fa0: 64 20 6c 6f 67 66 6e 61 6d 65 29 29 29 0a 09 20 d logfname)))..
7fb0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
7fc0: 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 rg "-set-toplog"
7fd0: 29 0a 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e ).. ;; DO N
7fe0: 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 OT run remote..
7ff0: 20 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 (tests:test
8000: 2d 73 65 74 2d 74 6f 70 6c 6f 67 21 20 64 62 20 -set-toplog! db
8010: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
8020: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8030: 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 29 29 0a -set-toplog"))).
8040: 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 . (if (args:get
8050: 2d 61 72 67 20 22 2d 73 75 6d 6d 61 72 69 7a 65 -arg "-summarize
8060: 2d 69 74 65 6d 73 22 29 0a 09 20 20 20 20 20 20 -items")..
8070: 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 ;; DO NOT run re
8080: 6d 6f 74 65 0a 09 20 20 20 20 20 20 28 74 65 73 mote.. (tes
8090: 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 ts:summarize-ite
80a0: 6d 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 ms db run-id tes
80b0: 74 2d 6e 61 6d 65 20 23 74 29 29 20 3b 3b 20 64 t-name #t)) ;; d
80c0: 6f 20 66 6f 72 63 65 20 68 65 72 65 0a 09 20 20 o force here..
80d0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
80e0: 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 20 g "-runstep")..
80f0: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
8100: 72 65 6d 61 72 67 73 29 0a 09 09 20 20 28 62 65 remargs)... (be
8110: 67 69 6e 0a 09 09 20 20 20 20 28 64 65 62 75 67 gin... (debug
8120: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
8130: 20 6e 6f 74 68 69 6e 67 20 73 70 65 63 69 66 69 nothing specifi
8140: 65 64 20 74 6f 20 72 75 6e 21 22 29 0a 09 09 20 ed to run!")...
8150: 20 20 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 (if db (sqlit
8160: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
8170: 29 0a 09 09 20 20 20 20 28 65 78 69 74 20 36 29 )... (exit 6)
8180: 29 0a 09 09 20 20 28 6c 65 74 2a 20 28 28 73 74 )... (let* ((st
8190: 65 70 6e 61 6d 65 20 20 20 28 61 72 67 73 3a 67 epname (args:g
81a0: 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 et-arg "-runstep
81b0: 22 29 29 0a 09 09 09 20 28 6c 6f 67 70 72 6f 66 ")).... (logprof
81c0: 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ile (args:get-ar
81d0: 67 20 22 2d 6c 6f 67 70 72 6f 22 29 29 0a 09 09 g "-logpro"))...
81e0: 09 20 28 6c 6f 67 66 69 6c 65 20 20 20 20 28 63 . (logfile (c
81f0: 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c onc stepname ".l
8200: 6f 67 22 29 29 0a 09 09 09 20 28 63 6d 64 20 20 og")).... (cmd
8210: 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f (if (null?
8220: 20 72 65 6d 61 72 67 73 29 20 23 66 20 28 63 61 remargs) #f (ca
8230: 72 20 72 65 6d 61 72 67 73 29 29 29 0a 09 09 09 r remargs)))....
8240: 20 28 70 61 72 61 6d 73 20 20 20 20 20 28 69 66 (params (if
8250: 20 63 6d 64 20 28 63 64 72 20 72 65 6d 61 72 67 cmd (cdr remarg
8260: 73 29 20 27 28 29 29 29 0a 09 09 09 20 28 65 78 s) '())).... (ex
8270: 69 74 73 74 61 74 20 20 20 23 66 29 0a 09 09 09 itstat #f)....
8280: 20 28 73 68 65 6c 6c 20 20 20 20 20 20 28 6c 61 (shell (la
8290: 73 74 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 st (string-split
82a0: 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e (get-environmen
82b0: 74 2d 76 61 72 69 61 62 6c 65 20 22 53 48 45 4c t-variable "SHEL
82c0: 4c 22 29 20 22 2f 22 29 29 29 0a 09 09 09 20 28 L") "/"))).... (
82d0: 72 65 64 69 72 20 20 20 20 20 20 28 63 61 73 65 redir (case
82e0: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
82f0: 20 73 68 65 6c 6c 29 0a 09 09 09 09 20 20 20 20 shell).....
8300: 20 20 20 28 28 74 63 73 68 20 63 73 68 20 6b 73 ((tcsh csh ks
8310: 68 29 20 20 20 20 22 3e 26 22 29 0a 09 09 09 09 h) ">&").....
8320: 20 20 20 20 20 20 20 28 28 7a 73 68 20 62 61 73 ((zsh bas
8330: 68 20 73 68 20 61 73 68 29 20 22 32 3e 26 31 20 h sh ash) "2>&1
8340: 3e 22 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 >")..... (
8350: 65 6c 73 65 20 22 3e 26 22 29 29 29 0a 09 09 09 else ">&")))....
8360: 20 28 66 75 6c 6c 63 6d 64 20 20 20 20 28 63 6f (fullcmd (co
8370: 6e 63 20 22 28 22 20 28 73 74 72 69 6e 67 2d 69 nc "(" (string-i
8380: 6e 74 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 ntersperse .....
8390: 09 09 28 63 6f 6e 73 20 63 6d 64 20 70 61 72 61 ..(cons cmd para
83a0: 6d 73 29 20 22 20 22 29 0a 09 09 09 09 09 20 20 ms) " ")......
83b0: 20 22 29 20 22 20 72 65 64 69 72 20 22 20 22 20 ") " redir " "
83c0: 6c 6f 67 66 69 6c 65 29 29 29 0a 09 09 20 20 20 logfile)))...
83d0: 20 3b 3b 20 6d 61 72 6b 20 74 68 65 20 73 74 61 ;; mark the sta
83e0: 72 74 20 6f 66 20 74 68 65 20 74 65 73 74 0a 09 rt of the test..
83f0: 09 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 . ;; DO NOT r
8400: 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 20 20 20 un remote...
8410: 28 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 (db:teststep-set
8420: 2d 73 74 61 74 75 73 21 20 64 62 20 74 65 73 74 -status! db test
8430: 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 73 74 -id stepname "st
8440: 61 72 74 22 20 22 6e 2f 61 22 20 28 61 72 67 73 art" "n/a" (args
8450: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 6c :get-arg "-m") l
8460: 6f 67 66 69 6c 65 29 0a 09 09 20 20 20 20 3b 3b ogfile)... ;;
8470: 20 72 75 6e 20 74 68 65 20 74 65 73 74 20 73 74 run the test st
8480: 65 70 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a ep... (debug:
8490: 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 52 75 print-info 2 "Ru
84a0: 6e 6e 69 6e 67 20 5c 22 22 20 66 75 6c 6c 63 6d nning \"" fullcm
84b0: 64 20 22 5c 22 22 29 0a 09 09 20 20 20 20 28 63 d "\"")... (c
84c0: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
84d0: 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 09 20 startingdir)...
84e0: 20 20 20 28 73 65 74 21 20 65 78 69 74 73 74 61 (set! exitsta
84f0: 74 20 28 73 79 73 74 65 6d 20 66 75 6c 6c 63 6d t (system fullcm
8500: 64 29 29 20 3b 3b 20 63 6d 64 20 70 61 72 61 6d d)) ;; cmd param
8510: 73 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 s))... (set!
8520: 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 *globalexitstatu
8530: 73 2a 20 65 78 69 74 73 74 61 74 29 0a 09 09 20 s* exitstat)...
8540: 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 (change-direc
8550: 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
8560: 09 20 20 20 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 . ;; run logp
8570: 72 6f 20 69 66 20 61 70 70 6c 69 63 61 62 6c 65 ro if applicable
8580: 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d 72 75 6e ;; (process-run
8590: 20 22 6c 73 22 20 28 6c 69 73 74 20 22 2f 66 6f "ls" (list "/fo
85a0: 6f 22 20 22 32 3e 26 31 22 20 22 62 6c 61 68 2e o" "2>&1" "blah.
85b0: 6c 6f 67 22 29 29 0a 09 09 20 20 20 20 28 69 66 log"))... (if
85c0: 20 6c 6f 67 70 72 6f 66 69 6c 65 0a 09 09 09 28 logprofile....(
85d0: 6c 65 74 2a 20 28 28 68 74 6d 6c 6c 6f 67 66 69 let* ((htmllogfi
85e0: 6c 65 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d le (conc stepnam
85f0: 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 09 09 20 e ".html"))....
8600: 20 20 20 20 20 20 28 6f 6c 64 65 78 69 74 73 74 (oldexitst
8610: 61 74 20 65 78 69 74 73 74 61 74 29 0a 09 09 09 at exitstat)....
8620: 20 20 20 20 20 20 20 28 63 6d 64 20 20 20 20 20 (cmd
8630: 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 (string-inte
8640: 72 73 70 65 72 73 65 20 28 6c 69 73 74 20 22 6c rsperse (list "l
8650: 6f 67 70 72 6f 22 20 6c 6f 67 70 72 6f 66 69 6c ogpro" logprofil
8660: 65 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c e htmllogfile "<
8670: 22 20 6c 6f 67 66 69 6c 65 20 22 3e 22 20 28 63 " logfile ">" (c
8680: 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 5f 6c onc stepname "_l
8690: 6f 67 70 72 6f 2e 6c 6f 67 22 29 29 20 22 20 22 ogpro.log")) " "
86a0: 29 29 29 0a 09 09 09 20 20 28 64 65 62 75 67 3a ))).... (debug:
86b0: 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 72 75 print-info 2 "ru
86c0: 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c nning \"" cmd "\
86d0: 22 22 29 0a 09 09 09 20 20 28 63 68 61 6e 67 65 "").... (change
86e0: 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 -directory start
86f0: 69 6e 67 64 69 72 29 0a 09 09 09 20 20 28 73 65 ingdir).... (se
8700: 74 21 20 65 78 69 74 73 74 61 74 20 28 73 79 73 t! exitstat (sys
8710: 74 65 6d 20 63 6d 64 29 29 0a 09 09 09 20 20 28 tem cmd)).... (
8720: 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 set! *globalexit
8730: 73 74 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 status* exitstat
8740: 29 20 3b 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 ) ;; no necessar
8750: 79 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 y.... (change-d
8760: 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
8770: 68 29 0a 09 09 09 20 20 28 63 64 62 3a 74 65 73 h).... (cdb:tes
8780: 74 2d 73 65 74 2d 6c 6f 67 21 20 2a 72 75 6e 72 t-set-log! *runr
8790: 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 20 68 emote* test-id h
87a0: 74 6d 6c 6c 6f 67 66 69 6c 65 29 29 29 0a 09 09 tmllogfile)))...
87b0: 20 20 20 20 28 6c 65 74 20 28 28 6d 73 67 20 28 (let ((msg (
87c0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
87d0: 22 29 29 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 ")))... ;;
87e0: 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 DO NOT run remot
87f0: 65 0a 09 09 20 20 20 20 20 20 28 64 62 3a 74 65 e... (db:te
8800: 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 ststep-set-statu
8810: 73 21 20 64 62 20 74 65 73 74 2d 69 64 20 73 74 s! db test-id st
8820: 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 78 69 epname "end" exi
8830: 74 73 74 61 74 20 6d 73 67 20 6c 6f 67 66 69 6c tstat msg logfil
8840: 65 29 29 0a 09 09 20 20 20 20 29 29 29 0a 09 20 e))... )))..
8850: 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 (if (or (args:g
8860: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 et-arg "-test-st
8870: 61 74 75 73 22 29 0a 09 09 20 20 28 61 72 67 73 atus")... (args
8880: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 :get-arg "-set-v
8890: 61 6c 75 65 73 22 29 29 0a 09 20 20 20 20 20 20 alues"))..
88a0: 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 75 73 (let ((newstatus
88b0: 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e 75 6d (cond.....((num
88c0: 62 65 72 3f 20 73 74 61 74 75 73 29 20 20 20 20 ber? status)
88d0: 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 (if (equal? s
88e0: 74 61 74 75 73 20 30 29 20 22 50 41 53 53 22 20 tatus 0) "PASS"
88f0: 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 28 61 "FAIL")).....((a
8900: 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 74 61 74 nd (string? stat
8910: 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 28 73 us)..... (s
8920: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 tring->number st
8930: 61 74 75 73 29 29 28 69 66 20 28 65 71 75 61 6c atus))(if (equal
8940: 3f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 ? (string->numbe
8950: 72 20 73 74 61 74 75 73 29 20 30 29 20 22 50 41 r status) 0) "PA
8960: 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 09 09 SS" "FAIL"))....
8970: 09 28 65 6c 73 65 20 73 74 61 74 75 73 29 29 29 .(else status)))
8980: 0a 09 09 20 20 20 20 3b 3b 20 74 72 61 6e 73 66 ... ;; transf
8990: 65 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 79 73 er relevant keys
89a0: 20 69 6e 74 6f 20 61 20 68 61 73 68 20 74 6f 20 into a hash to
89b0: 62 65 20 70 61 73 73 65 64 20 74 6f 20 74 65 73 be passed to tes
89c0: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a 09 09 t-set-status!...
89d0: 20 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 73 65 ;; could use
89e0: 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 20 49 an assoc list I
89f0: 20 67 75 65 73 73 2e 20 0a 09 09 20 20 20 20 28 guess. ... (
8a00: 6f 74 68 65 72 64 61 74 61 20 28 6c 65 74 20 28 otherdata (let (
8a10: 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d (res (make-hash-
8a20: 74 61 62 6c 65 29 29 29 0a 09 09 09 09 20 28 66 table)))..... (f
8a30: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
8a40: 28 6b 65 79 29 0a 09 09 09 09 09 20 20 20 20 20 (key)......
8a50: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
8a60: 67 20 6b 65 79 29 0a 09 09 09 09 09 09 20 28 68 g key)....... (h
8a70: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 ash-table-set! r
8a80: 65 73 20 6b 65 79 20 28 61 72 67 73 3a 67 65 74 es key (args:get
8a90: 2d 61 72 67 20 6b 65 79 29 29 29 29 0a 09 09 09 -arg key))))....
8aa0: 09 09 20 20 20 28 6c 69 73 74 20 22 3a 76 61 6c .. (list ":val
8ab0: 75 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 78 70 ue" ":tol" ":exp
8ac0: 65 63 74 65 64 22 20 22 3a 66 69 72 73 74 5f 65 ected" ":first_e
8ad0: 72 72 22 20 22 3a 66 69 72 73 74 5f 77 61 72 6e rr" ":first_warn
8ae0: 22 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 61 74 " ":units" ":cat
8af0: 65 67 6f 72 79 22 20 22 3a 76 61 72 69 61 62 6c egory" ":variabl
8b00: 65 22 29 29 0a 09 09 09 09 20 72 65 73 29 29 29 e"))..... res)))
8b10: 0a 09 09 28 69 66 20 28 61 6e 64 20 28 61 72 67 ...(if (and (arg
8b20: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
8b30: 2d 73 74 61 74 75 73 22 29 0a 09 09 09 20 28 6f -status").... (o
8b40: 72 20 28 6e 6f 74 20 73 74 61 74 65 29 0a 09 09 r (not state)...
8b50: 09 20 20 20 20 20 28 6e 6f 74 20 73 74 61 74 75 . (not statu
8b60: 73 29 29 29 0a 09 09 20 20 20 20 28 62 65 67 69 s)))... (begi
8b70: 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 67 n... (debug
8b80: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
8b90: 20 59 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 You must specif
8ba0: 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 y :state and :st
8bb0: 61 74 75 73 20 77 69 74 68 20 65 76 65 72 79 20 atus with every
8bc0: 63 61 6c 6c 20 74 6f 20 2d 74 65 73 74 2d 73 74 call to -test-st
8bd0: 61 74 75 73 5c 6e 22 20 68 65 6c 70 29 0a 09 09 atus\n" help)...
8be0: 20 20 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 ;; (sqlite
8bf0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
8c00: 09 09 20 20 20 20 20 20 28 65 78 69 74 20 36 29 .. (exit 6)
8c10: 29 29 0a 09 09 28 6c 65 74 2a 20 28 28 6d 73 67 ))...(let* ((msg
8c20: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
8c30: 67 20 22 2d 6d 22 29 29 0a 09 09 20 20 20 20 20 g "-m"))...
8c40: 20 20 28 6e 75 6d 6f 74 68 20 28 6c 65 6e 67 74 (numoth (lengt
8c50: 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 h (hash-table-ke
8c60: 79 73 20 6f 74 68 65 72 64 61 74 61 29 29 29 29 ys otherdata))))
8c70: 0a 09 09 20 20 3b 3b 20 43 6f 6e 76 65 72 74 20 ... ;; Convert
8c80: 74 6f 20 72 70 63 20 69 6e 73 69 64 65 20 74 68 to rpc inside th
8c90: 65 20 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 e tests:test-set
8ca0: 2d 73 74 61 74 75 73 21 20 63 61 6c 6c 2c 20 6e -status! call, n
8cb0: 6f 74 20 68 65 72 65 0a 09 09 20 20 28 74 65 73 ot here... (tes
8cc0: 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ts:test-set-stat
8cd0: 75 73 21 20 74 65 73 74 2d 69 64 20 73 74 61 74 us! test-id stat
8ce0: 65 20 6e 65 77 73 74 61 74 75 73 20 6d 73 67 20 e newstatus msg
8cf0: 6f 74 68 65 72 64 61 74 61 29 29 29 29 0a 09 20 otherdata))))..
8d00: 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 (if db (sqlite3
8d10: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
8d20: 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d . (set! *didsom
8d30: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a ething* #t))))..
8d40: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
8d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8d80: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 56 61 72 69 ========.;; Vari
8d90: 6f 75 73 20 68 65 6c 70 65 72 20 63 6f 6d 6d 61 ous helper comma
8da0: 6e 64 73 20 63 61 6e 20 67 6f 20 62 65 6c 6f 77 nds can go below
8db0: 20 68 65 72 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d here.;;========
8dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
8e00: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
8e10: 67 20 22 2d 73 68 6f 77 6b 65 79 73 22 29 0a 20 g "-showkeys").
8e20: 20 20 20 28 6c 65 74 20 28 28 64 62 20 23 66 29 (let ((db #f)
8e30: 0a 09 20 20 28 6b 65 79 73 20 23 66 29 29 0a 20 .. (keys #f)).
8e40: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 73 (if (not (s
8e50: 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 etup-for-run))..
8e60: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 (begin.. (d
8e70: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 ebug:print 0 "Fa
8e80: 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 iled to setup, e
8e90: 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 28 65 xiting").. (e
8ea0: 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 xit 1))). (
8eb0: 73 65 74 21 20 6b 65 79 73 20 28 63 62 64 3a 72 set! keys (cbd:r
8ec0: 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 emote-run db:get
8ed0: 2d 6b 65 79 73 20 64 62 29 29 0a 20 20 20 20 20 -keys db)).
8ee0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 (debug:print 1
8ef0: 22 4b 65 79 73 3a 20 22 20 28 73 74 72 69 6e 67 "Keys: " (string
8f00: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 -intersperse (ma
8f10: 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e p key:get-fieldn
8f20: 61 6d 65 20 6b 65 79 73 29 20 22 2c 20 22 29 29 ame keys) ", "))
8f30: 0a 20 20 20 20 20 20 28 69 66 20 64 62 20 28 73 . (if db (s
8f40: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
8f50: 20 64 62 29 29 0a 20 20 20 20 20 20 28 73 65 74 db)). (set
8f60: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
8f70: 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
8f80: 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 75 69 22 s:get-arg "-gui"
8f90: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
8fa0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
8fb0: 30 20 22 4c 6f 6f 6b 20 61 74 20 74 68 65 20 64 0 "Look at the d
8fc0: 61 73 68 62 6f 61 72 64 20 66 6f 72 20 6e 6f 77 ashboard for now
8fd0: 22 29 0a 20 20 20 20 20 20 3b 3b 20 28 6d 65 67 "). ;; (meg
8fe0: 61 74 65 73 74 2d 67 75 69 29 0a 20 20 20 20 20 atest-gui).
8ff0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
9000: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 hing* #t)))..(if
9010: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9020: 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 -gen-megatest-ar
9030: 65 61 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ea"). (begin.
9040: 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c (genexampl
9050: 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2e 63 6f e:mk-megatest.co
9060: 6e 66 69 67 29 0a 20 20 20 20 20 20 28 73 65 74 nfig). (set
9070: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
9080: 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
9090: 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 6e 2d s:get-arg "-gen-
90a0: 6d 65 67 61 74 65 73 74 2d 74 65 73 74 22 29 0a megatest-test").
90b0: 20 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 6e (let ((testn
90c0: 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ame (args:get-ar
90d0: 67 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 g "-gen-megatest
90e0: 2d 74 65 73 74 22 29 29 29 0a 20 20 20 20 20 20 -test"))).
90f0: 28 67 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d (genexample:mk-m
9100: 65 67 61 74 65 73 74 2d 74 65 73 74 20 74 65 73 egatest-test tes
9110: 74 6e 61 6d 65 29 0a 20 20 20 20 20 20 28 73 65 tname). (se
9120: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
9130: 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d * #t)))..;;=====
9140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9180: 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 =.;; Update the
9190: 64 61 74 61 62 61 73 65 20 73 63 68 65 6d 61 20 database schema
91a0: 6f 6e 20 72 65 71 75 65 73 74 0a 3b 3b 3d 3d 3d on request.;;===
91b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
91c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
91d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
91e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
91f0: 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
9200: 65 74 2d 61 72 67 20 22 2d 72 65 62 75 69 6c 64 et-arg "-rebuild
9210: 2d 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e -db"). (begin
9220: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
9230: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
9240: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
9250: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
9260: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
9270: 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 exiting") ..
9280: 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 (exit 1))).
9290: 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 6f ;; keep this o
92a0: 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 ne local. (
92b0: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 70 open-run-close p
92c0: 61 74 63 68 2d 64 62 20 23 66 29 0a 20 20 20 20 atch-db #f).
92d0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
92e0: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
92f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9330: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 ======.;; Update
9340: 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 61 20 the tests meta
9350: 64 61 74 61 20 66 72 6f 6d 20 74 68 65 20 74 65 data from the te
9360: 73 74 63 6f 6e 66 69 67 20 66 69 6c 65 73 0a 3b stconfig files.;
9370: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
9380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
93a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
93b0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
93c0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 70 64 gs:get-arg "-upd
93d0: 61 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 20 28 ate-meta"). (
93e0: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 begin. (if
93f0: 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d (not (setup-for-
9400: 72 75 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a run)).. (begin.
9410: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
9420: 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 t 0 "Failed to s
9430: 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 etup, exiting")
9440: 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 .. (exit 1)))
9450: 0a 20 20 20 20 20 20 3b 3b 20 6e 6f 77 20 63 61 . ;; now ca
9460: 6e 20 66 69 6e 64 20 6f 75 72 20 64 62 0a 20 20 n find our db.
9470: 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 ;; keep this
9480: 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 one local.
9490: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
94a0: 20 72 75 6e 73 3a 75 70 64 61 74 65 2d 61 6c 6c runs:update-all
94b0: 2d 74 65 73 74 5f 6d 65 74 61 20 64 62 29 0a 20 -test_meta db).
94c0: 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
94d0: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
94e0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
94f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 =========.;; Sta
9530: 72 74 20 61 20 72 65 70 6c 0a 3b 3b 3d 3d 3d 3d rt a repl.;;====
9540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9580: 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 ==..(if (or (arg
9590: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c s:get-arg "-repl
95a0: 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
95b0: 67 20 22 2d 6c 6f 61 64 22 29 29 0a 20 20 20 20 g "-load")).
95c0: 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 (let* ((toppath
95d0: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
95e0: 0a 09 20 20 20 28 64 62 20 20 20 20 20 20 28 69 .. (db (i
95f0: 66 20 74 6f 70 70 61 74 68 20 28 6f 70 65 6e 2d f toppath (open-
9600: 64 62 29 20 23 66 29 29 29 0a 20 20 20 20 20 20 db) #f))).
9610: 28 69 66 20 64 62 0a 09 20 20 28 62 65 67 69 6e (if db.. (begin
9620: 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 62 2a .. (set! *db*
9630: 20 64 62 29 0a 09 20 20 20 20 28 73 65 74 21 20 db).. (set!
9640: 2a 63 6c 69 65 6e 74 2d 6e 6f 6e 2d 62 6c 6f 63 *client-non-bloc
9650: 6b 69 6e 67 2d 6d 6f 64 65 2a 20 23 74 29 0a 09 king-mode* #t)..
9660: 20 20 20 20 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 ;; (client:s
9670: 65 74 75 70 29 0a 09 20 20 20 20 3b 3b 20 28 63 etup).. ;; (c
9680: 6c 69 65 6e 74 3a 6c 61 75 6e 63 68 29 0a 09 20 lient:launch)..
9690: 20 20 20 28 69 6d 70 6f 72 74 20 72 65 61 64 6c (import readl
96a0: 69 6e 65 29 0a 09 20 20 20 20 28 69 6d 70 6f 72 ine).. (impor
96b0: 74 20 61 70 72 6f 70 6f 73 29 0a 09 20 20 20 20 t apropos)..
96c0: 28 67 6e 75 2d 68 69 73 74 6f 72 79 2d 69 6e 73 (gnu-history-ins
96d0: 74 61 6c 6c 2d 66 69 6c 65 2d 6d 61 6e 61 67 65 tall-file-manage
96e0: 72 0a 09 20 20 20 20 20 28 73 74 72 69 6e 67 2d r.. (string-
96f0: 61 70 70 65 6e 64 0a 09 20 20 20 20 20 20 28 6f append.. (o
9700: 72 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 r (get-environme
9710: 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f 4d nt-variable "HOM
9720: 45 22 29 20 22 2e 22 29 20 22 2f 2e 6d 65 67 61 E") ".") "/.mega
9730: 74 65 73 74 5f 68 69 73 74 6f 72 79 22 29 29 0a test_history")).
9740: 09 20 20 20 20 28 63 75 72 72 65 6e 74 2d 69 6e . (current-in
9750: 70 75 74 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 67 put-port (make-g
9760: 6e 75 2d 72 65 61 64 6c 69 6e 65 2d 70 6f 72 74 nu-readline-port
9770: 20 22 6d 65 67 61 74 65 73 74 3e 20 22 29 29 0a "megatest> ")).
9780: 09 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 . (if (args:g
9790: 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 29 0a et-arg "-repl").
97a0: 09 09 28 72 65 70 6c 29 0a 09 09 28 6c 6f 61 64 ..(repl)...(load
97b0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
97c0: 2d 6c 6f 61 64 22 29 29 29 29 0a 09 20 20 28 65 -load")))).. (e
97d0: 78 69 74 29 29 0a 20 20 20 20 20 20 28 73 65 74 xit)). (set
97e0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
97f0: 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d #t)))..;;======
9800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9840: 0a 3b 3b 20 45 78 69 74 20 61 6e 64 20 63 6c 65 .;; Exit and cle
9850: 61 6e 20 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d an up.;;========
9860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
98a0: 3b 3b 20 74 68 69 73 20 69 73 20 74 68 65 20 73 ;; this is the s
98b0: 6f 63 6b 65 74 20 69 66 20 77 65 20 61 72 65 20 ocket if we are
98c0: 61 20 63 6c 69 65 6e 74 0a 3b 3b 20 28 69 66 20 a client.;; (if
98d0: 28 61 6e 64 20 2a 72 75 6e 72 65 6d 6f 74 65 2a (and *runremote*
98e0: 0a 3b 3b 20 09 20 28 73 6f 63 6b 65 74 3f 20 2a .;; . (socket? *
98f0: 72 75 6e 72 65 6d 6f 74 65 2a 29 29 0a 3b 3b 20 runremote*)).;;
9900: 20 20 20 20 28 63 6c 6f 73 65 2d 73 6f 63 6b 65 (close-socke
9910: 74 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 29 0a t *runremote*)).
9920: 0a 28 69 66 20 28 6e 6f 74 20 2a 64 69 64 73 6f .(if (not *didso
9930: 6d 65 74 68 69 6e 67 2a 29 0a 20 20 20 20 28 64 mething*). (d
9940: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 68 65 6c ebug:print 0 hel
9950: 70 29 29 0a 0a 3b 3b 20 28 69 66 20 2a 72 75 6e p))..;; (if *run
9960: 72 65 6d 6f 74 65 2a 20 28 72 70 63 3a 63 6c 6f remote* (rpc:clo
9970: 73 65 2d 61 6c 6c 2d 63 6f 6e 6e 65 63 74 69 6f se-all-connectio
9980: 6e 73 21 29 29 0a 20 20 20 20 0a 28 69 66 20 28 ns!)). .(if (
9990: 6e 6f 74 20 28 65 71 3f 20 2a 67 6c 6f 62 61 6c not (eq? *global
99a0: 65 78 69 74 73 74 61 74 75 73 2a 20 30 29 29 0a exitstatus* 0)).
99b0: 20 20 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 (if (or (arg
99c0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 s:get-arg "-runt
99d0: 65 73 74 73 22 29 28 61 72 67 73 3a 67 65 74 2d ests")(args:get-
99e0: 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 29 0a arg "-runall")).
99f0: 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 (begin.
9a00: 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
9a10: 3a 70 72 69 6e 74 20 30 20 22 4e 4f 54 45 3a 20 :print 0 "NOTE:
9a20: 53 75 62 70 72 6f 63 65 73 73 65 73 20 77 69 74 Subprocesses wit
9a30: 68 20 6e 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 20 h non-zero exit
9a40: 63 6f 64 65 20 64 65 74 65 63 74 65 64 3a 20 22 code detected: "
9a50: 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 *globalexitstat
9a60: 75 73 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 us*).
9a70: 28 65 78 69 74 20 30 29 29 0a 20 20 20 20 20 20 (exit 0)).
9a80: 20 20 28 63 61 73 65 20 2a 67 6c 6f 62 61 6c 65 (case *globale
9a90: 78 69 74 73 74 61 74 75 73 2a 0a 20 20 20 20 20 xitstatus*.
9aa0: 20 20 20 20 28 28 30 29 28 65 78 69 74 20 30 29 ((0)(exit 0)
9ab0: 29 0a 20 20 20 20 20 20 20 20 20 28 28 31 29 28 ). ((1)(
9ac0: 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 20 20 exit 1)).
9ad0: 20 20 28 28 32 29 28 65 78 69 74 20 32 29 29 0a ((2)(exit 2)).
9ae0: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 (else (
9af0: 65 78 69 74 20 33 29 29 29 29 29 0a exit 3))))).