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 29 0a 3b 3b ; (use trace).;;
0400: 20 28 74 72 61 63 65 20 64 62 3a 74 65 73 74 73 (trace db:tests
0410: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 0a tep-set-status!.
0420: 3b 3b 20 20 20 20 20 20 20 20 74 65 73 74 73 3a ;; tests:
0430: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
0440: 0a 3b 3b 20 20 20 20 20 20 20 20 63 64 62 3a 74 .;; cdb:t
0450: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 2d 73 est-set-status-s
0460: 74 61 74 65 0a 3b 3b 20 20 20 20 20 20 20 20 63 tate.;; c
0470: 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 0a 3b db:client-call.;
0480: 3b 20 20 20 20 20 20 20 20 74 65 73 74 73 3a 63 ; tests:c
0490: 68 65 63 6b 2d 77 61 69 76 65 72 2d 65 6c 69 67 heck-waiver-elig
04a0: 69 62 69 6c 69 74 79 29 0a 20 20 20 20 20 20 20 ibility).
04b0: 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 28 ..(define help (
04c0: 63 6f 6e 63 20 22 0a 4d 65 67 61 74 65 73 74 2c conc ".Megatest,
04d0: 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20 61 documentation a
04e0: 74 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 t http://www.kia
04f0: 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f toa.com/fossils/
0500: 6d 65 67 61 74 65 73 74 0a 20 20 76 65 72 73 69 megatest. versi
0510: 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 on " megatest-ve
0520: 72 73 69 6f 6e 20 22 0a 20 20 6c 69 63 65 6e 73 rsion ". licens
0530: 65 20 47 50 4c 2c 20 43 6f 70 79 72 69 67 68 74 e GPL, Copyright
0540: 20 4d 61 74 74 20 57 65 6c 6c 61 6e 64 20 32 30 Matt Welland 20
0550: 30 36 2d 32 30 31 32 0a 0a 55 73 61 67 65 3a 20 06-2012..Usage:
0560: 6d 65 67 61 74 65 73 74 20 5b 6f 70 74 69 6f 6e megatest [option
0570: 73 5d 0a 20 20 2d 68 20 20 20 20 20 20 20 20 20 s]. -h
0580: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 74 : t
0590: 68 69 73 20 68 65 6c 70 0a 20 20 2d 76 65 72 73 his help. -vers
05a0: 69 6f 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 ion
05b0: 20 20 20 3a 20 70 72 69 6e 74 20 6d 65 67 61 74 : print megat
05c0: 65 73 74 20 76 65 72 73 69 6f 6e 20 28 63 75 72 est version (cur
05d0: 72 65 6e 74 6c 79 20 22 20 6d 65 67 61 74 65 73 rently " megates
05e0: 74 2d 76 65 72 73 69 6f 6e 20 22 29 0a 0a 4c 61 t-version ")..La
05f0: 75 6e 63 68 69 6e 67 20 61 6e 64 20 6d 61 6e 61 unching and mana
0600: 67 69 6e 67 20 72 75 6e 73 0a 20 20 2d 72 75 6e ging runs. -run
0610: 61 6c 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 all
0620: 20 20 20 20 3a 20 72 75 6e 20 61 6c 6c 20 74 65 : run all te
0630: 73 74 73 20 74 68 61 74 20 61 72 65 20 6e 6f 74 sts that are not
0640: 20 73 74 61 74 65 20 43 4f 4d 50 4c 45 54 45 44 state COMPLETED
0650: 20 61 6e 64 20 73 74 61 74 75 73 20 50 41 53 53 and status PASS
0660: 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 , .
0670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 43 C
0680: 48 45 43 4b 20 6f 72 20 4b 49 4c 4c 45 44 0a 20 HECK or KILLED.
0690: 20 2d 72 75 6e 74 65 73 74 73 20 74 73 74 31 2c -runtests tst1,
06a0: 74 73 74 32 20 2e 2e 2e 20 3a 20 72 75 6e 20 74 tst2 ... : run t
06b0: 65 73 74 73 0a 20 20 2d 72 65 6d 6f 76 65 2d 72 ests. -remove-r
06c0: 75 6e 73 20 20 20 20 20 20 20 20 20 20 20 20 3a uns :
06d0: 20 72 65 6d 6f 76 65 20 74 68 65 20 64 61 74 61 remove the data
06e0: 20 66 6f 72 20 61 20 72 75 6e 2c 20 72 65 71 75 for a run, requ
06f0: 69 72 65 73 20 3a 72 75 6e 6e 61 6d 65 20 61 6e ires :runname an
0700: 64 20 2d 74 65 73 74 70 61 74 74 0a 20 20 20 20 d -testpatt.
0710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0720: 20 20 20 20 20 20 20 20 4f 70 74 69 6f 6e 61 6c Optional
0730: 6c 79 20 75 73 65 20 3a 73 74 61 74 65 20 61 6e ly use :state an
0740: 64 20 3a 73 74 61 74 75 73 0a 20 20 2d 73 65 74 d :status. -set
0750: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 58 2c -state-status X,
0760: 59 20 20 20 3a 20 73 65 74 20 73 74 61 74 65 20 Y : set state
0770: 74 6f 20 58 20 61 6e 64 20 73 74 61 74 75 73 20 to X and status
0780: 74 6f 20 59 2c 20 72 65 71 75 69 72 65 73 20 63 to Y, requires c
0790: 6f 6e 74 72 6f 6c 73 20 70 65 72 20 2d 72 65 6d ontrols per -rem
07a0: 6f 76 65 2d 72 75 6e 73 0a 20 20 2d 72 65 72 75 ove-runs. -reru
07b0: 6e 20 46 41 49 4c 2c 57 41 52 4e 2e 2e 2e 20 20 n FAIL,WARN...
07c0: 20 20 20 3a 20 66 6f 72 63 65 20 72 65 2d 72 75 : force re-ru
07d0: 6e 20 66 6f 72 20 74 65 73 74 73 20 77 69 74 68 n for tests with
07e0: 20 73 70 65 63 69 66 69 63 65 64 20 73 74 61 74 specificed stat
07f0: 75 73 28 73 29 0a 20 20 2d 72 6f 6c 6c 75 70 20 us(s). -rollup
0800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0810: 3a 20 28 63 75 72 72 65 6e 74 6c 79 20 64 69 73 : (currently dis
0820: 61 62 6c 65 64 29 20 66 69 6c 6c 20 72 75 6e 20 abled) fill run
0830: 28 73 65 74 20 62 79 20 3a 72 75 6e 6e 61 6d 65 (set by :runname
0840: 29 20 20 77 69 74 68 20 6c 61 74 65 73 74 20 74 ) with latest t
0850: 65 73 74 28 73 29 0a 20 20 20 20 20 20 20 20 20 est(s).
0860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0870: 20 20 20 66 72 6f 6d 20 70 72 69 6f 72 20 72 75 from prior ru
0880: 6e 73 20 77 69 74 68 20 73 61 6d 65 20 6b 65 79 ns with same key
0890: 73 0a 20 20 2d 6c 6f 63 6b 20 20 20 20 20 20 20 s. -lock
08a0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 6f : lo
08b0: 63 6b 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 ck run specified
08c0: 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 by target and r
08d0: 75 6e 6e 61 6d 65 0a 20 20 2d 75 6e 6c 6f 63 6b unname. -unlock
08e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
08f0: 20 3a 20 75 6e 6c 6f 63 6b 20 72 75 6e 20 73 70 : unlock run sp
0900: 65 63 69 66 69 65 64 20 62 79 20 74 61 72 67 65 ecified by targe
0910: 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 0a 53 t and runname..S
0920: 65 6c 65 63 74 6f 72 73 20 28 65 2e 67 2e 20 75 electors (e.g. u
0930: 73 65 20 66 6f 72 20 2d 72 75 6e 74 65 73 74 73 se for -runtests
0940: 2c 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 2c 20 , -remove-runs,
0950: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
0960: 73 2c 20 2d 6c 69 73 74 2d 72 75 6e 73 20 65 74 s, -list-runs et
0970: 63 2e 29 0a 20 20 2d 74 61 72 67 65 74 20 6b 65 c.). -target ke
0980: 79 31 2f 6b 65 79 32 2f 2e 2e 2e 20 20 20 3a 20 y1/key2/... :
0990: 72 75 6e 20 66 6f 72 20 6b 65 79 31 2c 20 6b 65 run for key1, ke
09a0: 79 32 2c 20 65 74 63 2e 0a 20 20 2d 72 65 71 74 y2, etc.. -reqt
09b0: 61 72 67 20 6b 65 79 31 2f 6b 65 79 32 2f 2e 2e arg key1/key2/..
09c0: 2e 20 20 3a 20 72 75 6e 20 66 6f 72 20 6b 65 79 . : run for key
09d0: 31 2c 20 6b 65 79 32 2c 20 65 74 63 2e 20 62 75 1, key2, etc. bu
09e0: 74 20 6b 65 79 31 2f 6b 65 79 32 20 6d 75 73 74 t key1/key2 must
09f0: 20 62 65 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 be in runconfig
0a00: 0a 20 20 2d 74 65 73 74 70 61 74 74 20 70 61 74 . -testpatt pat
0a10: 74 31 2f 70 61 74 74 32 2c 70 61 74 74 33 2f 2e t1/patt2,patt3/.
0a20: 2e 2e 20 20 3a 20 25 20 69 73 20 77 69 6c 64 63 .. : % is wildc
0a30: 61 72 64 0a 20 20 3a 72 75 6e 6e 61 6d 65 20 20 ard. :runname
0a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
0a50: 72 65 71 75 69 72 65 64 2c 20 6e 61 6d 65 20 66 required, name f
0a60: 6f 72 20 74 68 69 73 20 70 61 72 74 69 63 75 6c or this particul
0a70: 61 72 20 74 65 73 74 20 72 75 6e 0a 20 20 3a 73 ar test run. :s
0a80: 74 61 74 65 20 20 20 20 20 20 20 20 20 20 20 20 tate
0a90: 20 20 20 20 20 20 3a 20 41 70 70 6c 69 65 73 20 : Applies
0aa0: 74 6f 20 72 75 6e 73 2c 20 74 65 73 74 73 20 6f to runs, tests o
0ab0: 72 20 73 74 65 70 73 20 64 65 70 65 6e 64 69 6e r steps dependin
0ac0: 67 20 6f 6e 20 63 6f 6e 74 65 78 74 0a 20 20 3a g on context. :
0ad0: 73 74 61 74 75 73 20 20 20 20 20 20 20 20 20 20 status
0ae0: 20 20 20 20 20 20 20 3a 20 41 70 70 6c 69 65 73 : Applies
0af0: 20 74 6f 20 72 75 6e 73 2c 20 74 65 73 74 73 20 to runs, tests
0b00: 6f 72 20 73 74 65 70 73 20 64 65 70 65 6e 64 69 or steps dependi
0b10: 6e 67 20 6f 6e 20 63 6f 6e 74 65 78 74 0a 0a 54 ng on context..T
0b20: 65 73 74 20 68 65 6c 70 65 72 73 20 28 66 6f 72 est helpers (for
0b30: 20 75 73 65 20 69 6e 73 69 64 65 20 74 65 73 74 use inside test
0b40: 73 29 0a 20 20 2d 73 74 65 70 20 73 74 65 70 6e s). -step stepn
0b50: 61 6d 65 0a 20 20 2d 74 65 73 74 2d 73 74 61 74 ame. -test-stat
0b60: 75 73 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 us :
0b70: 73 65 74 20 74 68 65 20 73 74 61 74 65 20 61 6e set the state an
0b80: 64 20 73 74 61 74 75 73 20 6f 66 20 61 20 74 65 d status of a te
0b90: 73 74 20 28 75 73 65 20 3a 73 74 61 74 65 20 61 st (use :state a
0ba0: 6e 64 20 3a 73 74 61 74 75 73 29 0a 20 20 2d 73 nd :status). -s
0bb0: 65 74 6c 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 20 etlog logfname
0bc0: 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 : set the
0bd0: 70 61 74 68 2f 66 69 6c 65 6e 61 6d 65 20 74 6f path/filename to
0be0: 20 74 68 65 20 66 69 6e 61 6c 20 6c 6f 67 20 72 the final log r
0bf0: 65 6c 61 74 69 76 65 20 74 6f 20 74 68 65 20 74 elative to the t
0c00: 65 73 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 est.
0c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c20: 64 69 72 65 63 74 6f 72 79 2e 20 6d 61 79 20 62 directory. may b
0c30: 65 20 75 73 65 64 20 77 69 74 68 20 2d 74 65 73 e used with -tes
0c40: 74 2d 73 74 61 74 75 73 0a 20 20 2d 73 65 74 2d t-status. -set-
0c50: 74 6f 70 6c 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 toplog logfname
0c60: 20 20 20 3a 20 73 65 74 20 74 68 65 20 6f 76 65 : set the ove
0c70: 72 61 6c 6c 20 6c 6f 67 20 66 6f 72 20 61 20 73 rall log for a s
0c80: 75 69 74 65 20 6f 66 20 73 75 62 2d 74 65 73 74 uite of sub-test
0c90: 73 0a 20 20 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 s. -summarize-i
0ca0: 74 65 6d 73 20 20 20 20 20 20 20 20 3a 20 66 6f tems : fo
0cb0: 72 20 61 6e 20 69 74 65 6d 69 7a 65 64 20 74 65 r an itemized te
0cc0: 73 74 20 63 72 65 61 74 65 20 61 20 73 75 6d 6d st create a summ
0cd0: 61 72 79 20 68 74 6d 6c 20 0a 20 20 2d 6d 20 63 ary html . -m c
0ce0: 6f 6d 6d 65 6e 74 20 20 20 20 20 20 20 20 20 20 omment
0cf0: 20 20 20 20 3a 20 69 6e 73 65 72 74 20 61 20 63 : insert a c
0d00: 6f 6d 6d 65 6e 74 20 66 6f 72 20 74 68 69 73 20 omment for this
0d10: 74 65 73 74 0a 0a 54 65 73 74 20 64 61 74 61 20 test..Test data
0d20: 63 61 70 74 75 72 65 0a 20 20 2d 73 65 74 2d 76 capture. -set-v
0d30: 61 6c 75 65 73 20 20 20 20 20 20 20 20 20 20 20 alues
0d40: 20 20 3a 20 75 70 64 61 74 65 20 6f 72 20 73 65 : update or se
0d50: 74 20 76 61 6c 75 65 73 20 69 6e 20 74 68 65 20 t values in the
0d60: 74 65 73 74 64 61 74 61 20 74 61 62 6c 65 0a 20 testdata table.
0d70: 20 3a 63 61 74 65 67 6f 72 79 20 20 20 20 20 20 :category
0d80: 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 : set t
0d90: 68 65 20 63 61 74 65 67 6f 72 79 20 66 69 65 6c he category fiel
0da0: 64 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a d (optional). :
0db0: 76 61 72 69 61 62 6c 65 20 20 20 20 20 20 20 20 variable
0dc0: 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 : set the
0dd0: 20 76 61 72 69 61 62 6c 65 20 6e 61 6d 65 20 28 variable name (
0de0: 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 6c optional). :val
0df0: 75 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ue
0e00: 20 20 20 20 3a 20 76 61 6c 75 65 20 6d 65 61 73 : value meas
0e10: 75 72 65 64 20 28 72 65 71 75 69 72 65 64 29 0a ured (required).
0e20: 20 20 3a 65 78 70 65 63 74 65 64 20 20 20 20 20 :expected
0e30: 20 20 20 20 20 20 20 20 20 20 3a 20 76 61 6c 75 : valu
0e40: 65 20 65 78 70 65 63 74 65 64 20 28 72 65 71 75 e expected (requ
0e50: 69 72 65 64 29 0a 20 20 3a 74 6f 6c 20 20 20 20 ired). :tol
0e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e70: 3a 20 7c 76 61 6c 75 65 2d 65 78 70 65 63 74 7c : |value-expect|
0e80: 20 3c 3d 20 74 6f 6c 20 28 72 65 71 75 69 72 65 <= tol (require
0e90: 64 2c 20 63 61 6e 20 62 65 20 3c 2c 20 3e 2c 20 d, can be <, >,
0ea0: 3e 3d 2c 20 3c 3d 20 6f 72 20 6e 75 6d 62 65 72 >=, <= or number
0eb0: 29 0a 20 20 3a 75 6e 69 74 73 20 20 20 20 20 20 ). :units
0ec0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6e 61 : na
0ed0: 6d 65 20 6f 66 20 74 68 65 20 75 6e 69 74 73 20 me of the units
0ee0: 66 6f 72 20 76 61 6c 75 65 2c 20 65 78 70 65 63 for value, expec
0ef0: 74 65 64 5f 76 61 6c 75 65 20 65 74 63 2e 20 28 ted_value etc. (
0f00: 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 2d 6c 6f 61 optional). -loa
0f10: 64 2d 74 65 73 74 2d 64 61 74 61 20 20 20 20 20 d-test-data
0f20: 20 20 20 20 3a 20 72 65 61 64 20 74 65 73 74 20 : read test
0f30: 73 70 65 63 69 66 69 63 20 64 61 74 61 20 66 6f specific data fo
0f40: 72 20 73 74 6f 72 61 67 65 20 69 6e 20 74 68 65 r storage in the
0f50: 20 74 65 73 74 5f 64 61 74 61 20 74 61 62 6c 65 test_data table
0f60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 66 72 6f fro
0f80: 6d 20 73 74 61 6e 64 61 72 64 20 69 6e 2e 20 45 m standard in. E
0f90: 61 63 68 20 6c 69 6e 65 20 69 73 20 63 6f 6d 6d ach line is comm
0fa0: 61 20 64 65 6c 69 6d 69 74 65 64 20 77 69 74 68 a delimited with
0fb0: 20 66 6f 75 72 0a 20 20 20 20 20 20 20 20 20 20 four.
0fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fd0: 20 20 66 69 65 6c 64 73 20 63 61 74 65 67 6f 72 fields categor
0fe0: 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 6c 75 65 y,variable,value
0ff0: 2c 63 6f 6d 6d 65 6e 74 0a 0a 51 75 65 72 69 65 ,comment..Querie
1000: 73 0a 20 20 2d 6c 69 73 74 2d 72 75 6e 73 20 70 s. -list-runs p
1010: 61 74 74 20 20 20 20 20 20 20 20 20 3a 20 6c 69 att : li
1020: 73 74 20 72 75 6e 73 20 6d 61 74 63 68 69 6e 67 st runs matching
1030: 20 70 61 74 74 65 72 6e 20 5c 22 70 61 74 74 5c pattern \"patt\
1040: 22 2c 20 25 20 69 73 20 74 68 65 20 77 69 6c 64 ", % is the wild
1050: 63 61 72 64 0a 20 20 2d 73 68 6f 77 6b 65 79 73 card. -showkeys
1060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
1070: 20 73 68 6f 77 20 74 68 65 20 6b 65 79 73 20 75 show the keys u
1080: 73 65 64 20 69 6e 20 74 68 69 73 20 6d 65 67 61 sed in this mega
1090: 74 65 73 74 20 73 65 74 75 70 0a 20 20 2d 74 65 test setup. -te
10a0: 73 74 2d 66 69 6c 65 73 20 74 61 72 67 70 61 74 st-files targpat
10b0: 74 20 20 20 20 20 3a 20 67 65 74 20 74 68 65 20 t : get the
10c0: 6d 6f 73 74 20 72 65 63 65 6e 74 20 74 65 73 74 most recent test
10d0: 20 70 61 74 68 2f 66 69 6c 65 20 6d 61 74 63 68 path/file match
10e0: 69 6e 67 20 74 61 72 67 70 61 74 74 20 65 2e 67 ing targpatt e.g
10f0: 2e 20 25 2f 25 2e 2e 2e 20 0a 20 20 20 20 20 20 . %/%... .
1100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1110: 20 20 20 20 20 20 72 65 74 75 72 6e 73 20 6c 69 returns li
1120: 73 74 20 73 6f 72 74 65 64 20 62 79 20 61 67 65 st sorted by age
1130: 20 61 73 63 65 6e 64 69 6e 67 2c 20 73 65 65 20 ascending, see
1140: 65 78 61 6d 70 6c 65 73 20 62 65 6c 6f 77 0a 20 examples below.
1150: 20 2d 74 65 73 74 2d 70 61 74 68 73 20 20 20 20 -test-paths
1160: 20 20 20 20 20 20 20 20 20 3a 20 67 65 74 20 74 : get t
1170: 68 65 20 74 65 73 74 20 70 61 74 68 73 20 6d 61 he test paths ma
1180: 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 tching target, r
1190: 75 6e 6e 61 6d 65 2c 20 69 74 65 6d 20 61 6e 64 unname, item and
11a0: 20 74 65 73 74 0a 20 20 20 20 20 20 20 20 20 20 test.
11b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11c0: 20 20 70 61 74 74 65 72 6e 73 2e 0a 20 20 2d 6c patterns.. -l
11d0: 69 73 74 2d 64 69 73 6b 73 20 20 20 20 20 20 20 ist-disks
11e0: 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 65 : list the
11f0: 20 64 69 73 6b 73 20 61 76 61 69 6c 61 62 6c 65 disks available
1200: 20 66 6f 72 20 73 74 6f 72 69 6e 67 20 72 75 6e for storing run
1210: 73 0a 20 20 2d 6c 69 73 74 2d 74 61 72 67 65 74 s. -list-target
1220: 73 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 69 s : li
1230: 73 74 20 74 68 65 20 74 61 72 67 65 74 73 20 69 st the targets i
1240: 6e 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e n runconfigs.con
1250: 66 69 67 0a 20 20 2d 6c 69 73 74 2d 64 62 2d 74 fig. -list-db-t
1260: 61 72 67 65 74 73 20 20 20 20 20 20 20 20 3a 20 argets :
1270: 6c 69 73 74 20 74 68 65 20 74 61 72 67 65 74 20 list the target
1280: 63 6f 6d 62 69 6e 61 74 69 6f 6e 73 20 75 73 65 combinations use
1290: 64 20 69 6e 20 74 68 65 20 64 62 0a 20 20 2d 73 d in the db. -s
12a0: 68 6f 77 2d 63 6f 6e 66 69 67 20 20 20 20 20 20 how-config
12b0: 20 20 20 20 20 20 3a 20 64 75 6d 70 20 74 68 65 : dump the
12c0: 20 69 6e 74 65 72 6e 61 6c 20 72 65 70 72 65 73 internal repres
12d0: 65 6e 74 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 entation of the
12e0: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 megatest.config
12f0: 66 69 6c 65 0a 20 20 2d 73 68 6f 77 2d 72 75 6e file. -show-run
1300: 63 6f 6e 66 69 67 20 20 20 20 20 20 20 20 20 3a config :
1310: 20 64 75 6d 70 20 74 68 65 20 69 6e 74 65 72 6e dump the intern
1320: 61 6c 20 72 65 70 72 65 73 65 6e 74 61 74 69 6f al representatio
1330: 6e 20 6f 66 20 74 68 65 20 72 75 6e 63 6f 6e 66 n of the runconf
1340: 69 67 73 2e 63 6f 6e 66 69 67 20 66 69 6c 65 0a igs.config file.
1350: 20 20 2d 64 75 6d 70 6d 6f 64 65 20 6a 73 6f 6e -dumpmode json
1360: 20 20 20 20 20 20 20 20 20 20 3a 20 64 75 6d 70 : dump
1370: 20 69 6e 20 6a 73 6f 6e 20 66 6f 72 6d 61 74 20 in json format
1380: 69 6e 73 74 65 61 64 20 6f 66 20 73 65 78 70 72 instead of sexpr
1390: 0a 0a 4d 69 73 63 20 0a 20 20 2d 72 65 62 75 69 ..Misc . -rebui
13a0: 6c 64 2d 64 62 20 20 20 20 20 20 20 20 20 20 20 ld-db
13b0: 20 20 3a 20 62 72 69 6e 67 20 74 68 65 20 64 61 : bring the da
13c0: 74 61 62 61 73 65 20 73 63 68 65 6d 61 20 75 70 tabase schema up
13d0: 20 74 6f 20 64 61 74 65 0a 20 20 2d 75 70 64 61 to date. -upda
13e0: 74 65 2d 6d 65 74 61 20 20 20 20 20 20 20 20 20 te-meta
13f0: 20 20 20 3a 20 75 70 64 61 74 65 20 74 68 65 20 : update the
1400: 74 65 73 74 73 20 6d 65 74 61 64 61 74 61 20 66 tests metadata f
1410: 6f 72 20 61 6c 6c 20 74 65 73 74 73 0a 20 20 2d or all tests. -
1420: 65 6e 76 32 66 69 6c 65 20 66 6e 61 6d 65 20 20 env2file fname
1430: 20 20 20 20 20 20 20 3a 20 77 72 69 74 65 20 74 : write t
1440: 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 74 he environment t
1450: 6f 20 66 6e 61 6d 65 2e 63 73 68 20 61 6e 64 20 o fname.csh and
1460: 66 6e 61 6d 65 2e 73 68 0a 20 20 2d 73 65 74 76 fname.sh. -setv
1470: 61 72 73 20 56 41 52 31 3d 76 61 6c 31 2c 56 41 ars VAR1=val1,VA
1480: 52 32 3d 76 61 6c 32 20 3a 20 41 64 64 20 65 6e R2=val2 : Add en
1490: 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 vironment variab
14a0: 6c 65 73 20 74 6f 20 61 20 72 75 6e 20 4e 42 2f les to a run NB/
14b0: 2f 20 74 68 65 73 65 20 61 72 65 0a 20 20 20 20 / these are.
14c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 6f 76 65 ove
14e0: 72 77 72 69 74 74 65 6e 20 62 79 20 76 61 6c 75 rwritten by valu
14f0: 65 73 20 73 65 74 20 69 6e 20 63 6f 6e 66 69 67 es set in config
1500: 20 66 69 6c 65 73 2e 0a 20 20 2d 73 65 72 76 65 files.. -serve
1510: 72 20 2d 7c 68 6f 73 74 6e 61 6d 65 20 20 20 20 r -|hostname
1520: 20 20 3a 20 73 74 61 72 74 20 74 68 65 20 73 65 : start the se
1530: 72 76 65 72 20 28 72 65 64 75 63 65 73 20 63 6f rver (reduces co
1540: 6e 74 65 6e 74 69 6f 6e 20 6f 6e 20 6d 65 67 61 ntention on mega
1550: 74 65 73 74 2e 64 62 29 2c 20 75 73 65 0a 20 20 test.db), use.
1560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1570: 20 20 20 20 20 20 20 20 20 20 2d 20 74 6f 20 61 - to a
1580: 75 74 6f 6d 61 74 69 63 61 6c 6c 79 20 66 69 67 utomatically fig
1590: 75 72 65 20 6f 75 74 20 68 6f 73 74 6e 61 6d 65 ure out hostname
15a0: 0a 20 20 2d 74 72 61 6e 73 70 6f 72 74 20 68 74 . -transport ht
15b0: 74 70 7c 7a 6d 71 20 20 20 20 20 3a 20 75 73 65 tp|zmq : use
15c0: 20 68 74 74 70 20 6f 72 20 7a 6d 71 20 66 6f 72 http or zmq for
15d0: 20 74 72 61 6e 73 70 6f 72 74 20 28 64 65 66 61 transport (defa
15e0: 75 6c 74 20 69 73 20 68 74 74 70 29 20 0a 20 20 ult is http) .
15f0: 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 20 20 20 -list-servers
1600: 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 : list t
1610: 68 65 20 73 65 72 76 65 72 73 20 0a 20 20 2d 72 he servers . -r
1620: 65 70 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 epl
1630: 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 61 20 : start a
1640: 72 65 70 6c 20 28 75 73 65 66 75 6c 20 66 6f 72 repl (useful for
1650: 20 65 78 74 65 6e 64 69 6e 67 20 6d 65 67 61 74 extending megat
1660: 65 73 74 29 0a 20 20 2d 6c 6f 61 64 20 66 69 6c est). -load fil
1670: 65 2e 73 63 6d 20 20 20 20 20 20 20 20 20 20 3a e.scm :
1680: 20 6c 6f 61 64 20 61 6e 64 20 72 75 6e 20 66 69 load and run fi
1690: 6c 65 2e 73 63 6d 0a 0a 53 70 72 65 61 64 73 68 le.scm..Spreadsh
16a0: 65 65 74 20 67 65 6e 65 72 61 74 69 6f 6e 0a 20 eet generation.
16b0: 20 2d 65 78 74 72 61 63 74 2d 6f 64 73 20 66 6e -extract-ods fn
16c0: 61 6d 65 2e 6f 64 73 20 20 3a 20 65 78 74 72 61 ame.ods : extra
16d0: 63 74 20 61 6e 20 6f 70 65 6e 20 64 6f 63 75 6d ct an open docum
16e0: 65 6e 74 20 73 70 72 65 61 64 73 68 65 65 74 20 ent spreadsheet
16f0: 66 72 6f 6d 20 74 68 65 20 64 61 74 61 62 61 73 from the databas
1700: 65 0a 20 20 2d 70 61 74 68 6d 6f 64 20 70 61 74 e. -pathmod pat
1710: 68 20 20 20 20 20 20 20 20 20 20 20 3a 20 69 6e h : in
1720: 73 65 72 74 20 70 61 74 68 2c 20 69 2e 65 2e 20 sert path, i.e.
1730: 70 61 74 68 2f 72 75 6e 61 6d 65 2f 69 74 65 6d path/runame/item
1740: 70 61 74 68 2f 6c 6f 67 66 69 6c 65 2e 68 74 6d path/logfile.htm
1750: 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 l.
1760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 77 69 wi
1770: 6c 6c 20 63 6c 65 61 72 20 74 68 65 20 66 69 65 ll clear the fie
1780: 6c 64 20 69 66 20 6e 6f 20 72 75 6e 64 69 72 2f ld if no rundir/
1790: 74 65 73 74 6e 61 6d 65 2f 69 74 65 6d 70 61 74 testname/itempat
17a0: 68 2f 6c 6f 67 66 69 6c 65 0a 20 20 20 20 20 20 h/logfile.
17b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17c0: 20 20 20 20 20 20 69 66 20 69 74 20 63 6f 6e 74 if it cont
17d0: 61 69 6e 73 20 66 6f 72 77 61 72 64 20 73 6c 61 ains forward sla
17e0: 73 68 65 73 20 74 68 65 20 70 61 74 68 20 77 69 shes the path wi
17f0: 6c 6c 20 62 65 20 63 6f 6e 76 65 72 74 65 64 0a ll be converted.
1800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1810: 20 20 20 20 20 20 20 20 20 20 20 20 74 6f 20 77 to w
1820: 69 6e 64 6f 77 73 20 73 74 79 6c 65 0a 47 65 74 indows style.Get
1830: 74 69 6e 67 20 73 74 61 72 74 65 64 0a 20 20 2d ting started. -
1840: 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 gen-megatest-are
1850: 61 20 20 20 20 20 20 20 3a 20 63 72 65 61 74 65 a : create
1860: 20 61 20 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 a skeleton mega
1870: 74 65 73 74 20 61 72 65 61 2e 20 59 6f 75 20 77 test area. You w
1880: 69 6c 6c 20 62 65 20 70 72 6f 6d 70 74 65 64 20 ill be prompted
1890: 66 6f 72 20 70 61 74 68 73 0a 20 20 2d 67 65 6e for paths. -gen
18a0: 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 20 74 -megatest-test t
18b0: 6e 61 6d 65 20 3a 20 63 72 65 61 74 65 20 61 20 name : create a
18c0: 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 skeleton megates
18d0: 74 20 74 65 73 74 2e 20 59 6f 75 20 77 69 6c 6c t test. You will
18e0: 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 be prompted for
18f0: 20 69 6e 66 6f 0a 0a 45 78 61 6d 70 6c 65 73 0a info..Examples.
1900: 0a 23 20 47 65 74 20 74 65 73 74 20 70 61 74 68 .# Get test path
1910: 2c 20 75 73 65 20 27 2e 27 20 74 6f 20 67 65 74 , use '.' to get
1920: 20 61 20 73 69 6e 67 6c 65 20 70 61 74 68 20 6f a single path o
1930: 72 20 61 20 73 70 65 63 69 66 69 63 20 70 61 74 r a specific pat
1940: 68 2f 66 69 6c 65 20 70 61 74 74 65 72 6e 0a 6d h/file pattern.m
1950: 65 67 61 74 65 73 74 20 2d 74 65 73 74 2d 66 69 egatest -test-fi
1960: 6c 65 73 20 27 6c 6f 67 73 2f 2a 2e 6c 6f 67 27 les 'logs/*.log'
1970: 20 2d 74 61 72 67 65 74 20 75 62 75 6e 74 75 2f -target ubuntu/
1980: 6e 25 2f 6e 6f 25 20 3a 72 75 6e 6e 61 6d 65 20 n%/no% :runname
1990: 77 34 39 25 20 2d 74 65 73 74 70 61 74 74 20 74 w49% -testpatt t
19a0: 65 73 74 5f 6d 74 25 0a 0a 43 61 6c 6c 65 64 20 est_mt%..Called
19b0: 61 73 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 as " (string-int
19c0: 65 72 73 70 65 72 73 65 20 28 61 72 67 76 29 20 ersperse (argv)
19d0: 22 20 22 29 20 22 0a 56 65 72 73 69 6f 6e 20 22 " ") ".Version "
19e0: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f megatest-versio
19f0: 6e 20 22 2c 20 62 75 69 6c 74 20 66 72 6f 6d 20 n ", built from
1a00: 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 " megatest-fossi
1a10: 6c 2d 68 61 73 68 20 29 29 0a 0a 3b 3b 20 20 2d l-hash ))..;; -
1a20: 67 75 69 20 20 20 20 20 20 20 20 20 20 20 20 20 gui
1a30: 20 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 61 : start a
1a40: 20 67 75 69 20 69 6e 74 65 72 66 61 63 65 0a 3b gui interface.;
1a50: 3b 20 20 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 ; -config fname
1a60: 20 20 20 20 20 20 20 20 20 20 20 3a 20 6f 76 65 : ove
1a70: 72 72 69 64 65 20 74 68 65 20 72 75 6e 63 6f 6e rride the runcon
1a80: 66 69 67 20 66 69 6c 65 20 77 69 74 68 20 66 6e fig file with fn
1a90: 61 6d 65 0a 3b 3b 20 20 2d 6b 69 6c 6c 2d 73 65 ame.;; -kill-se
1aa0: 72 76 65 72 20 68 6f 73 74 3a 70 6f 72 74 7c 70 rver host:port|p
1ab0: 69 64 20 3a 20 6b 69 6c 6c 20 73 65 72 76 65 72 id : kill server
1ac0: 20 73 70 65 63 69 66 69 65 64 20 62 79 20 68 6f specified by ho
1ad0: 73 74 3a 70 6f 72 74 20 6f 72 20 70 69 64 0a 0a st:port or pid..
1ae0: 3b 3b 20 70 72 6f 63 65 73 73 20 61 72 67 73 0a ;; process args.
1af0: 28 64 65 66 69 6e 65 20 72 65 6d 61 72 67 73 20 (define remargs
1b00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 73 20 0a (args:get-args .
1b10: 09 09 20 28 61 72 67 76 29 0a 09 09 20 28 6c 69 .. (argv)... (li
1b20: 73 74 20 20 22 2d 72 75 6e 74 65 73 74 73 22 20 st "-runtests"
1b30: 20 3b 3b 20 72 75 6e 20 61 20 73 70 65 63 69 66 ;; run a specif
1b40: 69 63 20 74 65 73 74 0a 09 09 09 22 2d 63 6f 6e ic test...."-con
1b50: 66 69 67 22 20 20 20 20 3b 3b 20 6f 76 65 72 72 fig" ;; overr
1b60: 69 64 65 20 74 68 65 20 63 6f 6e 66 69 67 20 66 ide the config f
1b70: 69 6c 65 20 6e 61 6d 65 0a 09 09 09 22 2d 65 78 ile name...."-ex
1b80: 65 63 75 74 65 22 20 20 20 3b 3b 20 72 75 6e 20 ecute" ;; run
1b90: 74 68 65 20 63 6f 6d 6d 61 6e 64 20 65 6e 63 6f the command enco
1ba0: 64 65 64 20 69 6e 20 74 68 65 20 62 61 73 65 36 ded in the base6
1bb0: 34 20 70 61 72 61 6d 65 74 65 72 0a 09 09 09 22 4 parameter...."
1bc0: 2d 73 74 65 70 22 0a 09 09 09 22 3a 72 75 6e 6e -step"....":runn
1bd0: 61 6d 65 22 20 20 20 0a 09 09 09 22 2d 74 61 72 ame" ...."-tar
1be0: 67 65 74 22 0a 09 09 09 22 2d 72 65 71 74 61 72 get"...."-reqtar
1bf0: 67 22 0a 09 09 09 22 3a 72 75 6e 6e 61 6d 65 22 g"....":runname"
1c00: 0a 09 09 09 22 2d 72 75 6e 6e 61 6d 65 22 0a 09 ...."-runname"..
1c10: 09 09 22 3a 73 74 61 74 65 22 20 20 0a 09 09 09 ..":state" ....
1c20: 22 2d 73 74 61 74 65 22 0a 09 09 09 22 3a 73 74 "-state"....":st
1c30: 61 74 75 73 22 0a 09 09 09 22 2d 73 74 61 74 75 atus"...."-statu
1c40: 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d 72 75 6e s"...."-list-run
1c50: 73 22 0a 09 09 09 22 2d 74 65 73 74 70 61 74 74 s"...."-testpatt
1c60: 22 20 0a 09 09 09 22 2d 69 74 65 6d 70 61 74 74 " ...."-itempatt
1c70: 22 0a 09 09 09 22 2d 73 65 74 6c 6f 67 22 0a 09 "...."-setlog"..
1c80: 09 09 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 0a .."-set-toplog".
1c90: 09 09 09 22 2d 72 75 6e 73 74 65 70 22 0a 09 09 ..."-runstep"...
1ca0: 09 22 2d 6c 6f 67 70 72 6f 22 0a 09 09 09 22 2d ."-logpro"...."-
1cb0: 6d 22 0a 09 09 09 22 2d 72 65 72 75 6e 22 0a 09 m"...."-rerun"..
1cc0: 09 09 22 2d 64 61 79 73 22 0a 09 09 09 22 2d 72 .."-days"...."-r
1cd0: 65 6e 61 6d 65 2d 72 75 6e 22 0a 09 09 09 22 2d ename-run"...."-
1ce0: 74 6f 22 0a 09 09 09 3b 3b 20 76 61 6c 75 65 73 to"....;; values
1cf0: 20 61 6e 64 20 6d 65 73 73 61 67 65 73 0a 09 09 and messages...
1d00: 09 22 3a 63 61 74 65 67 6f 72 79 22 0a 09 09 09 .":category"....
1d10: 22 3a 76 61 72 69 61 62 6c 65 22 0a 09 09 09 22 ":variable"...."
1d20: 3a 76 61 6c 75 65 22 0a 09 09 09 22 3a 65 78 70 :value"....":exp
1d30: 65 63 74 65 64 22 0a 09 09 09 22 3a 74 6f 6c 22 ected"....":tol"
1d40: 0a 09 09 09 22 3a 75 6e 69 74 73 22 0a 09 09 09 ....":units"....
1d50: 3b 3b 20 6d 69 73 63 0a 09 09 09 22 2d 73 65 72 ;; misc...."-ser
1d60: 76 65 72 22 0a 09 09 09 22 2d 74 72 61 6e 73 70 ver"...."-transp
1d70: 6f 72 74 22 0a 09 09 09 22 2d 6b 69 6c 6c 2d 73 ort"...."-kill-s
1d80: 65 72 76 65 72 22 0a 09 09 09 22 2d 70 6f 72 74 erver"...."-port
1d90: 22 0a 09 09 09 22 2d 65 78 74 72 61 63 74 2d 6f "...."-extract-o
1da0: 64 73 22 0a 09 09 09 22 2d 70 61 74 68 6d 6f 64 ds"...."-pathmod
1db0: 22 0a 09 09 09 22 2d 65 6e 76 32 66 69 6c 65 22 "...."-env2file"
1dc0: 0a 09 09 09 22 2d 73 65 74 76 61 72 73 22 0a 09 ...."-setvars"..
1dd0: 09 09 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 .."-set-state-st
1de0: 61 74 75 73 22 0a 09 09 09 22 2d 64 65 62 75 67 atus"...."-debug
1df0: 22 20 3b 3b 20 66 6f 72 20 2a 76 65 72 62 6f 73 " ;; for *verbos
1e00: 69 74 79 2a 20 3e 20 32 0a 09 09 09 22 2d 67 65 ity* > 2...."-ge
1e10: 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 22 n-megatest-test"
1e20: 0a 09 09 09 22 2d 6f 76 65 72 72 69 64 65 2d 74 ...."-override-t
1e30: 69 6d 65 6f 75 74 22 0a 09 09 09 22 2d 74 65 73 imeout"...."-tes
1e40: 74 2d 66 69 6c 65 73 22 20 20 3b 3b 20 2d 74 65 t-files" ;; -te
1e50: 73 74 2d 70 61 74 68 73 20 69 73 20 66 6f 72 20 st-paths is for
1e60: 6c 69 73 74 69 6e 67 20 61 6c 6c 0a 09 09 09 22 listing all...."
1e70: 2d 6c 6f 61 64 22 20 20 20 20 20 20 20 20 3b 3b -load" ;;
1e80: 20 6c 6f 61 64 20 61 6e 64 20 65 78 65 63 74 75 load and exectu
1e90: 74 65 20 61 20 73 63 68 65 6d 65 20 66 69 6c 65 te a scheme file
1ea0: 0a 09 09 09 22 2d 64 75 6d 70 6d 6f 64 65 22 0a ...."-dumpmode".
1eb0: 09 09 09 29 20 0a 09 09 20 28 6c 69 73 74 20 20 ...) ... (list
1ec0: 22 2d 68 22 0a 09 09 09 22 2d 76 65 72 73 69 6f "-h"...."-versio
1ed0: 6e 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d 66 n"... "-f
1ee0: 6f 72 63 65 22 0a 09 09 20 20 20 20 20 20 20 20 orce"...
1ef0: 22 2d 78 74 65 72 6d 22 0a 09 09 20 20 20 20 20 "-xterm"...
1f00: 20 20 20 22 2d 73 68 6f 77 6b 65 79 73 22 0a 09 "-showkeys"..
1f10: 09 20 20 20 20 20 20 20 20 22 2d 74 65 73 74 2d . "-test-
1f20: 73 74 61 74 75 73 22 0a 09 09 09 22 2d 73 65 74 status"...."-set
1f30: 2d 76 61 6c 75 65 73 22 0a 09 09 09 22 2d 6c 6f -values"...."-lo
1f40: 61 64 2d 74 65 73 74 2d 64 61 74 61 22 0a 09 09 ad-test-data"...
1f50: 09 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 ."-summarize-ite
1f60: 6d 73 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d ms"... "-
1f70: 67 75 69 22 0a 09 09 09 3b 3b 20 6d 69 73 63 0a gui"....;; misc.
1f80: 09 09 09 22 2d 61 72 63 68 69 76 65 22 0a 09 09 ..."-archive"...
1f90: 09 22 2d 72 65 70 6c 22 0a 09 09 09 22 2d 6c 6f ."-repl"...."-lo
1fa0: 63 6b 22 0a 09 09 09 22 2d 75 6e 6c 6f 63 6b 22 ck"...."-unlock"
1fb0: 0a 09 09 09 22 2d 6c 69 73 74 2d 73 65 72 76 65 ...."-list-serve
1fc0: 72 73 22 0a 09 09 09 3b 3b 20 6d 69 73 74 20 71 rs"....;; mist q
1fd0: 75 65 72 69 65 73 0a 09 09 09 22 2d 6c 69 73 74 ueries...."-list
1fe0: 2d 64 69 73 6b 73 22 0a 09 09 09 22 2d 6c 69 73 -disks"...."-lis
1ff0: 74 2d 74 61 72 67 65 74 73 22 0a 09 09 09 22 2d t-targets"...."-
2000: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 list-db-targets"
2010: 0a 09 09 09 22 2d 73 68 6f 77 2d 72 75 6e 63 6f ...."-show-runco
2020: 6e 66 69 67 22 0a 09 09 09 22 2d 73 68 6f 77 2d nfig"...."-show-
2030: 63 6f 6e 66 69 67 22 0a 09 09 09 3b 3b 20 71 75 config"....;; qu
2040: 65 72 69 65 73 0a 09 09 09 22 2d 74 65 73 74 2d eries...."-test-
2050: 70 61 74 68 73 22 20 3b 3b 20 67 65 74 20 70 61 paths" ;; get pa
2060: 74 68 28 73 29 20 74 6f 20 61 20 74 65 73 74 2c th(s) to a test,
2070: 20 6f 72 64 65 72 65 64 20 62 79 20 79 6f 75 6e ordered by youn
2080: 67 65 73 74 20 66 69 72 73 74 0a 0a 09 09 09 22 gest first....."
2090: 2d 72 75 6e 61 6c 6c 22 20 20 20 20 3b 3b 20 72 -runall" ;; r
20a0: 75 6e 20 61 6c 6c 20 74 65 73 74 73 0a 09 09 09 un all tests....
20b0: 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 0a 09 "-remove-runs"..
20c0: 09 09 22 2d 72 65 62 75 69 6c 64 2d 64 62 22 0a .."-rebuild-db".
20d0: 09 09 09 22 2d 72 6f 6c 6c 75 70 22 0a 09 09 09 ..."-rollup"....
20e0: 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 22 0a 09 "-update-meta"..
20f0: 09 09 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 .."-gen-megatest
2100: 2d 61 72 65 61 22 0a 0a 09 09 09 22 2d 6c 6f 67 -area"....."-log
2110: 67 69 6e 67 22 0a 09 09 09 22 2d 76 22 20 3b 3b ging"...."-v" ;;
2120: 20 76 65 72 62 6f 73 65 20 32 2c 20 6d 6f 72 65 verbose 2, more
2130: 20 74 68 61 6e 20 6e 6f 72 6d 61 6c 20 28 6e 6f than normal (no
2140: 72 6d 61 6c 20 69 73 20 31 29 0a 09 09 09 22 2d rmal is 1)...."-
2150: 71 22 20 3b 3b 20 71 75 69 65 74 20 30 2c 20 65 q" ;; quiet 0, e
2160: 72 72 6f 72 73 2f 77 61 72 6e 69 6e 67 73 20 6f rrors/warnings o
2170: 6e 6c 79 0a 09 09 20 20 20 20 20 20 20 29 0a 09 nly... )..
2180: 09 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 0a . args:arg-hash.
2190: 09 09 20 30 29 29 0a 0a 28 69 66 20 28 61 72 67 .. 0))..(if (arg
21a0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 22 29 0a s:get-arg "-h").
21b0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
21c0: 20 28 70 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 (print help).
21d0: 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a 28 69 (exit)))..(i
21e0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
21f0: 22 2d 76 65 72 73 69 6f 6e 22 29 0a 20 20 20 20 "-version").
2200: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 (begin. (pr
2210: 69 6e 74 20 6d 65 67 61 74 65 73 74 2d 76 65 72 int megatest-ver
2220: 73 69 6f 6e 29 0a 20 20 20 20 20 20 28 65 78 69 sion). (exi
2230: 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 t)))..(define *d
2240: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 66 29 idsomething* #f)
2250: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
2260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 ==========.;; Mi
22a0: 73 63 20 73 65 74 75 70 20 73 74 75 66 66 0a 3b sc setup stuff.;
22b0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
22c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22f0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 62 75 67 3a =======..(debug:
2300: 73 65 74 75 70 29 0a 0a 28 69 66 20 28 61 72 67 setup)..(if (arg
2310: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 67 s:get-arg "-logg
2320: 69 6e 67 22 29 28 73 65 74 21 20 2a 6c 6f 67 67 ing")(set! *logg
2330: 69 6e 67 2a 20 23 74 29 29 0a 0a 28 69 66 20 28 ing* #t))..(if (
2340: 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 debug:debug-mode
2350: 20 33 29 20 3b 3b 20 77 65 20 61 72 65 20 6f 62 3) ;; we are ob
2360: 76 69 6f 75 73 6c 79 20 64 65 62 75 67 67 69 6e viously debuggin
2370: 67 0a 20 20 20 20 28 73 65 74 21 20 6f 70 65 6e g. (set! open
2380: 2d 72 75 6e 2d 63 6c 6f 73 65 20 6f 70 65 6e 2d -run-close open-
2390: 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 run-close-no-exc
23a0: 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 29 eption-handling)
23b0: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
23c0: 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 -arg "-itempatt"
23d0: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 ). (let ((new
23e0: 76 61 6c 20 28 63 6f 6e 63 20 28 61 72 67 73 3a val (conc (args:
23f0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
2400: 74 74 22 29 20 22 2f 22 20 28 61 72 67 73 3a 67 tt") "/" (args:g
2410: 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 et-arg "-itempat
2420: 74 22 29 29 29 29 0a 20 20 20 20 20 20 28 64 65 t")))). (de
2430: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 bug:print 0 "WAR
2440: 4e 49 4e 47 3a 20 2d 69 74 65 6d 70 61 74 74 20 NING: -itempatt
2450: 68 61 73 20 62 65 65 6e 20 64 65 70 72 65 63 61 has been depreca
2460: 74 65 64 2c 20 70 6c 65 61 73 65 20 75 73 65 20 ted, please use
2470: 2d 74 65 73 74 70 61 74 74 20 74 65 73 74 70 61 -testpatt testpa
2480: 74 74 2f 69 74 65 6d 70 61 74 74 20 6d 65 74 68 tt/itempatt meth
2490: 6f 64 2c 20 6e 65 77 20 74 65 73 74 70 61 74 74 od, new testpatt
24a0: 20 69 73 20 22 6e 65 77 76 61 6c 29 0a 20 20 20 is "newval).
24b0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
24c0: 65 74 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 et! args:arg-has
24d0: 68 20 22 2d 74 65 73 74 70 61 74 74 22 20 6e 65 h "-testpatt" ne
24e0: 77 76 61 6c 29 0a 20 20 20 20 20 20 28 68 61 73 wval). (has
24f0: 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 h-table-delete!
2500: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d args:arg-hash "-
2510: 69 74 65 6d 70 61 74 74 22 29 29 29 0a 0a 3b 3b itempatt")))..;;
2520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2560: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 20 67 ======.;; Misc g
2570: 65 6e 65 72 61 6c 20 63 61 6c 6c 73 0a 3b 3b 3d eneral calls.;;=
2580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
25a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
25b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
25c0: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
25d0: 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 32 66 :get-arg "-env2f
25e0: 69 6c 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e ile"). (begin
25f0: 0a 20 20 20 20 20 20 28 73 61 76 65 2d 65 6e 76 . (save-env
2600: 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 ironment-as-file
2610: 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 s (args:get-arg
2620: 22 2d 65 6e 76 32 66 69 6c 65 22 29 29 0a 20 20 "-env2file")).
2630: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
2640: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
2650: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
2660: 67 20 22 2d 6c 69 73 74 2d 64 69 73 6b 73 22 29 g "-list-disks")
2670: 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
2680: 20 20 28 70 72 69 6e 74 20 0a 20 20 20 20 20 20 (print .
2690: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
26a0: 65 72 73 65 20 0a 09 28 6d 61 70 20 28 6c 61 6d erse ..(map (lam
26b0: 62 64 61 20 28 78 29 0a 09 20 20 20 20 20 20 20 bda (x)..
26c0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
26d0: 72 73 65 20 0a 09 09 78 0a 09 09 22 20 3d 3e 20 rse ...x..." =>
26e0: 22 29 29 0a 09 20 20 20 20 20 28 63 6f 6d 6d 6f ")).. (commo
26f0: 6e 3a 67 65 74 2d 64 69 73 6b 73 29 20 29 0a 09 n:get-disks) )..
2700: 22 5c 6e 22 29 29 0a 20 20 20 20 20 20 28 73 65 "\n")). (se
2710: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
2720: 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d * #t)))..;;=====
2730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2770: 3d 0a 3b 3b 20 53 74 61 72 74 20 74 68 65 20 73 =.;; Start the s
2780: 65 72 76 65 72 20 2d 20 63 61 6e 20 62 65 20 64 erver - can be d
2790: 6f 6e 65 20 69 6e 20 63 6f 6e 6a 75 6e 63 74 69 one in conjuncti
27a0: 6f 6e 20 77 69 74 68 20 2d 72 75 6e 61 6c 6c 20 on with -runall
27b0: 6f 72 20 2d 72 75 6e 74 65 73 74 73 20 28 6f 6e or -runtests (on
27c0: 65 20 64 61 79 2e 2e 2e 29 0a 3b 3b 20 20 20 77 e day...).;; w
27d0: 65 20 73 74 61 72 74 20 74 68 65 20 73 65 72 76 e start the serv
27e0: 65 72 20 69 66 20 6e 6f 74 20 72 75 6e 6e 69 6e er if not runnin
27f0: 67 20 65 6c 73 65 20 73 74 61 72 74 20 74 68 65 g else start the
2800: 20 63 6c 69 65 6e 74 20 74 68 72 65 61 64 0a 3b client thread.;
2810: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
2820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2850: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
2860: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 72 gs:get-arg "-ser
2870: 76 65 72 22 29 0a 20 20 20 20 28 6c 65 74 20 28 ver"). (let (
2880: 28 74 72 61 6e 73 70 6f 72 74 20 28 61 72 67 73 (transport (args
2890: 3a 67 65 74 2d 61 72 67 20 22 2d 74 72 61 6e 73 :get-arg "-trans
28a0: 70 6f 72 74 22 20 22 68 74 74 70 22 29 29 29 0a port" "http"))).
28b0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
28c0: 6e 74 20 32 20 22 4c 61 75 6e 63 68 69 6e 67 20 nt 2 "Launching
28d0: 73 65 72 76 65 72 20 75 73 69 6e 67 20 74 72 61 server using tra
28e0: 6e 73 70 6f 72 74 20 22 20 74 72 61 6e 73 70 6f nsport " transpo
28f0: 72 74 29 0a 20 20 20 20 20 20 28 73 65 72 76 65 rt). (serve
2900: 72 3a 6c 61 75 6e 63 68 20 28 73 74 72 69 6e 67 r:launch (string
2910: 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 6e 73 70 6f ->symbol transpo
2920: 72 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e rt))). (if (n
2930: 6f 74 20 28 6e 75 6c 6c 3f 20 28 6c 73 65 74 2d ot (null? (lset-
2940: 69 6e 74 65 72 73 65 63 74 69 6f 6e 20 0a 09 09 intersection ...
2950: 20 20 20 20 20 65 71 75 61 6c 3f 0a 09 09 20 20 equal?...
2960: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b (hash-table-k
2970: 65 79 73 20 61 72 67 73 3a 61 72 67 2d 68 61 73 eys args:arg-has
2980: 68 29 0a 09 09 20 20 20 20 20 27 28 22 2d 72 75 h)... '("-ru
2990: 6e 74 65 73 74 73 22 20 20 20 20 22 2d 6c 69 73 ntests" "-lis
29a0: 74 2d 72 75 6e 73 22 20 20 20 22 2d 72 6f 6c 6c t-runs" "-roll
29b0: 75 70 22 0a 09 09 20 20 20 20 20 20 20 22 2d 72 up"... "-r
29c0: 65 6d 6f 76 65 2d 72 75 6e 73 22 20 22 2d 6c 6f emove-runs" "-lo
29d0: 63 6b 22 20 20 20 20 20 20 20 20 22 2d 75 6e 6c ck" "-unl
29e0: 6f 63 6b 22 0a 09 09 20 20 20 20 20 20 20 22 2d ock"... "-
29f0: 75 70 64 61 74 65 2d 6d 65 74 61 22 20 22 2d 65 update-meta" "-e
2a00: 78 74 72 61 63 74 2d 6f 64 73 22 29 29 29 29 0a xtract-ods")))).
2a10: 09 28 69 66 20 28 73 65 74 75 70 2d 66 6f 72 2d .(if (setup-for-
2a20: 72 75 6e 29 0a 09 20 20 20 20 28 6c 65 74 20 28 run).. (let (
2a30: 28 73 65 72 76 65 72 73 20 28 6f 70 65 6e 2d 72 (servers (open-r
2a40: 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 67 un-close tasks:g
2a50: 65 74 2d 62 65 73 74 2d 73 65 72 76 65 72 20 74 et-best-server t
2a60: 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 29 29 0a asks:open-db))).
2a70: 09 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 . (if (or (
2a80: 6e 6f 74 20 73 65 72 76 65 72 73 29 0a 09 09 20 not servers)...
2a90: 20 20 20 20 20 28 6e 75 6c 6c 3f 20 73 65 72 76 (null? serv
2aa0: 65 72 73 29 29 0a 09 09 20 20 28 62 65 67 69 6e ers))... (begin
2ab0: 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
2ac0: 69 6e 74 20 30 20 22 49 4e 46 4f 3a 20 53 74 61 int 0 "INFO: Sta
2ad0: 72 74 69 6e 67 20 73 65 72 76 65 72 20 61 73 20 rting server as
2ae0: 6e 6f 6e 65 20 72 75 6e 6e 69 6e 67 20 2e 2e 2e none running ...
2af0: 22 29 0a 09 09 20 20 20 20 3b 3b 20 28 73 65 72 ")... ;; (ser
2b00: 76 65 72 3a 6c 61 75 6e 63 68 20 28 73 74 72 69 ver:launch (stri
2b10: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 61 72 67 73 ng->symbol (args
2b20: 3a 67 65 74 2d 61 72 67 20 22 2d 74 72 61 6e 73 :get-arg "-trans
2b30: 70 6f 72 74 22 20 22 68 74 74 70 22 29 29 29 29 port" "http"))))
2b40: 0a 09 09 20 20 20 20 28 73 79 73 74 65 6d 20 28 ... (system (
2b50: 63 6f 6e 63 20 28 63 61 72 20 28 61 72 67 76 29 conc (car (argv)
2b60: 29 20 22 20 2d 73 65 72 76 65 72 20 2d 20 2d 74 ) " -server - -t
2b70: 72 61 6e 73 70 6f 72 74 20 22 20 28 61 72 67 73 ransport " (args
2b80: 3a 67 65 74 2d 61 72 67 20 22 2d 74 72 61 6e 73 :get-arg "-trans
2b90: 70 6f 72 74 22 20 22 68 74 74 70 22 29 29 29 0a port" "http"))).
2ba0: 09 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c .. (thread-sl
2bb0: 65 65 70 21 20 33 29 29 20 3b 3b 20 67 69 76 65 eep! 3)) ;; give
2bc0: 20 74 68 65 20 73 65 72 76 65 72 20 61 20 66 65 the server a fe
2bd0: 77 20 73 65 63 6f 6e 64 73 20 74 6f 20 73 74 61 w seconds to sta
2be0: 72 74 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 rt... (debug:pr
2bf0: 69 6e 74 20 30 20 22 49 4e 46 4f 3a 20 53 65 72 int 0 "INFO: Ser
2c00: 76 65 72 73 20 61 6c 72 65 61 64 79 20 72 75 6e vers already run
2c10: 6e 69 6e 67 20 22 20 73 65 72 76 65 72 73 29 0a ning " servers).
2c20: 09 09 20 20 29 29 29 29 29 0a 09 0a 0a 28 69 66 .. )))))....(if
2c30: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
2c40: 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 29 0a -list-servers").
2c50: 09 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 .;; (args:get-ar
2c60: 67 20 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 22 g "-kill-server"
2c70: 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c )). (let ((tl
2c80: 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 (setup-for-run)
2c90: 29 29 0a 20 20 20 20 20 20 28 69 66 20 74 6c 20 )). (if tl
2ca0: 0a 09 20 20 28 6c 65 74 20 28 28 73 65 72 76 65 .. (let ((serve
2cb0: 72 73 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f rs (open-run-clo
2cc0: 73 65 20 74 61 73 6b 73 3a 67 65 74 2d 61 6c 6c se tasks:get-all
2cd0: 2d 73 65 72 76 65 72 73 20 74 61 73 6b 73 3a 6f -servers tasks:o
2ce0: 70 65 6e 2d 64 62 29 29 0a 09 09 28 66 6d 74 73 pen-db))...(fmts
2cf0: 74 72 20 20 22 7e 35 61 7e 38 61 7e 38 61 7e 32 tr "~5a~8a~8a~2
2d00: 30 61 7e 32 30 61 7e 31 30 61 7e 31 30 61 7e 31 0a~20a~10a~10a~1
2d10: 30 61 7e 31 30 61 7e 31 30 61 5c 6e 22 29 0a 09 0a~10a~10a\n")..
2d20: 09 28 73 65 72 76 65 72 73 2d 74 6f 2d 6b 69 6c .(servers-to-kil
2d30: 6c 20 27 28 29 29 29 0a 09 20 20 20 20 28 66 6f l '())).. (fo
2d40: 72 6d 61 74 20 23 74 20 66 6d 74 73 74 72 20 22 rmat #t fmtstr "
2d50: 49 64 22 20 22 4d 54 76 65 72 22 20 22 50 69 64 Id" "MTver" "Pid
2d60: 22 20 22 48 6f 73 74 22 20 22 49 6e 74 65 72 66 " "Host" "Interf
2d70: 61 63 65 22 20 22 4f 75 74 50 6f 72 74 22 20 22 ace" "OutPort" "
2d80: 49 6e 50 6f 72 74 22 20 22 4c 61 73 74 42 65 61 InPort" "LastBea
2d90: 74 22 20 22 53 74 61 74 65 22 20 22 54 72 61 6e t" "State" "Tran
2da0: 73 70 6f 72 74 22 29 0a 09 20 20 20 20 28 66 6f sport").. (fo
2db0: 72 6d 61 74 20 23 74 20 66 6d 74 73 74 72 20 22 rmat #t fmtstr "
2dc0: 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d ==" "=====" "===
2dd0: 22 20 22 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d " "====" "======
2de0: 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 22 20 22 ===" "=======" "
2df0: 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d ======" "=======
2e00: 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d =" "=====" "====
2e10: 3d 3d 3d 3d 3d 22 29 0a 09 20 20 20 20 28 66 6f =====").. (fo
2e20: 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 28 6c r-each .. (l
2e30: 61 6d 62 64 61 20 28 73 65 72 76 65 72 29 0a 09 ambda (server)..
2e40: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 3b 3b (let* (;;
2e50: 20 28 6b 69 6c 6c 69 6e 66 6f 20 20 20 28 61 72 (killinfo (ar
2e60: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6b 69 6c gs:get-arg "-kil
2e70: 6c 2d 73 65 72 76 65 72 22 29 29 0a 09 09 20 20 l-server"))...
2e80: 20 20 20 20 3b 3b 20 28 6b 68 6f 73 74 2d 70 6f ;; (khost-po
2e90: 72 74 20 28 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 rt (if killinfo
2ea0: 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d 69 (if (substring-i
2eb0: 6e 64 65 78 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 ndex ":" killinf
2ec0: 6f 29 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 o)(string-split
2ed0: 22 3a 22 29 20 23 66 29 20 23 66 29 29 0a 09 09 ":") #f) #f))...
2ee0: 20 20 20 20 20 20 3b 3b 20 28 6b 70 69 64 20 20 ;; (kpid
2ef0: 20 20 20 20 20 28 69 66 20 6b 69 6c 6c 69 6e 66 (if killinf
2f00: 6f 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 o (if (substring
2f10: 2d 69 6e 64 65 78 20 22 3a 22 20 6b 69 6c 6c 69 -index ":" killi
2f20: 6e 66 6f 29 20 23 66 20 28 73 74 72 69 6e 67 2d nfo) #f (string-
2f30: 3e 6e 75 6d 62 65 72 20 6b 69 6c 6c 69 6e 66 6f >number killinfo
2f40: 29 29 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 )) #f))...
2f50: 28 69 64 20 20 20 20 20 20 20 20 20 28 76 65 63 (id (vec
2f60: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 30 tor-ref server 0
2f70: 29 29 0a 09 09 20 20 20 20 20 20 28 70 69 64 20 ))... (pid
2f80: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 (vector-r
2f90: 65 66 20 73 65 72 76 65 72 20 31 29 29 0a 09 09 ef server 1))...
2fa0: 20 20 20 20 20 20 28 68 6f 73 74 6e 61 6d 65 20 (hostname
2fb0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
2fc0: 72 76 65 72 20 32 29 29 0a 09 09 20 20 20 20 20 rver 2))...
2fd0: 20 28 69 6e 74 65 72 66 61 63 65 20 20 28 76 65 (interface (ve
2fe0: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
2ff0: 33 29 29 0a 09 09 20 20 20 20 20 20 28 70 75 6c 3))... (pul
3000: 6c 70 6f 72 74 20 20 20 28 76 65 63 74 6f 72 2d lport (vector-
3010: 72 65 66 20 73 65 72 76 65 72 20 34 29 29 0a 09 ref server 4))..
3020: 09 20 20 20 20 20 20 28 70 75 62 70 6f 72 74 20 . (pubport
3030: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
3040: 65 72 76 65 72 20 35 29 29 0a 09 09 20 20 20 20 erver 5))...
3050: 20 20 28 73 74 61 72 74 2d 74 69 6d 65 20 28 76 (start-time (v
3060: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
3070: 20 36 29 29 0a 09 09 20 20 20 20 20 20 28 70 72 6))... (pr
3080: 69 6f 72 69 74 79 20 20 20 28 76 65 63 74 6f 72 iority (vector
3090: 2d 72 65 66 20 73 65 72 76 65 72 20 37 29 29 0a -ref server 7)).
30a0: 09 09 20 20 20 20 20 20 28 73 74 61 74 65 20 20 .. (state
30b0: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
30c0: 73 65 72 76 65 72 20 38 29 29 0a 09 09 20 20 20 server 8))...
30d0: 20 20 20 28 6d 74 2d 76 65 72 20 20 20 20 20 28 (mt-ver (
30e0: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
30f0: 72 20 39 29 29 0a 09 09 20 20 20 20 20 20 28 6c r 9))... (l
3100: 61 73 74 2d 75 70 64 61 74 65 20 28 76 65 63 74 ast-update (vect
3110: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 30 or-ref server 10
3120: 29 29 20 3b 3b 20 20 20 28 6f 70 65 6e 2d 72 75 )) ;; (open-ru
3130: 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 73 65 n-close tasks:se
3140: 72 76 65 72 2d 61 6c 69 76 65 3f 20 74 61 73 6b rver-alive? task
3150: 73 3a 6f 70 65 6e 2d 64 62 20 23 66 20 68 6f 73 s:open-db #f hos
3160: 74 6e 61 6d 65 3a 20 68 6f 73 74 6e 61 6d 65 20 tname: hostname
3170: 70 6f 72 74 3a 20 70 6f 72 74 29 29 0a 09 09 20 port: port))...
3180: 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 (transport
3190: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
31a0: 76 65 72 20 31 31 29 29 0a 09 09 20 20 20 20 20 ver 11))...
31b0: 20 28 6b 69 6c 6c 65 64 20 20 20 20 20 23 66 29 (killed #f)
31c0: 0a 09 09 20 20 20 20 20 20 28 73 74 61 74 75 73 ... (status
31d0: 20 20 20 20 20 28 3c 20 6c 61 73 74 2d 75 70 64 (< last-upd
31e0: 61 74 65 20 32 30 29 29 29 0a 09 09 20 3b 3b 20 ate 20)))... ;;
31f0: 20 20 28 7a 6d 71 2d 73 6f 63 6b 65 74 73 20 28 (zmq-sockets (
3200: 69 66 20 73 74 61 74 75 73 20 28 73 65 72 76 65 if status (serve
3210: 72 3a 63 6c 69 65 6e 74 2d 63 6f 6e 6e 65 63 74 r:client-connect
3220: 20 68 6f 73 74 6e 61 6d 65 20 70 6f 72 74 29 20 hostname port)
3230: 23 66 29 29 29 0a 09 09 20 3b 3b 20 6e 6f 20 6e #f)))... ;; no n
3240: 65 65 64 20 74 6f 20 6c 6f 67 69 6e 20 61 73 20 eed to login as
3250: 73 74 61 74 75 73 20 6f 66 20 23 74 20 69 6e 64 status of #t ind
3260: 69 63 61 74 65 73 20 77 65 20 61 72 65 20 63 6f icates we are co
3270: 6e 6e 65 63 74 69 6e 67 20 74 6f 20 63 6f 72 72 nnecting to corr
3280: 65 63 74 20 0a 09 09 20 3b 3b 20 73 65 72 76 65 ect ... ;; serve
3290: 72 0a 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f r... (if (equal?
32a0: 20 73 74 61 74 65 20 22 64 65 61 64 22 29 0a 09 state "dead")..
32b0: 09 20 20 20 20 20 28 69 66 20 28 3e 20 6c 61 73 . (if (> las
32c0: 74 2d 75 70 64 61 74 65 20 28 2a 20 32 35 20 36 t-update (* 25 6
32d0: 30 20 36 30 29 29 20 3b 3b 20 6b 65 65 70 20 72 0 60)) ;; keep r
32e0: 65 63 6f 72 64 73 20 61 72 6f 75 6e 64 20 66 6f ecords around fo
32f0: 72 20 73 6c 69 67 68 6c 79 20 6f 76 65 72 20 61 r slighly over a
3300: 20 64 61 79 2e 0a 09 09 09 20 28 6f 70 65 6e 2d day..... (open-
3310: 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a run-close tasks:
3320: 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 65 server-deregiste
3330: 72 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 r tasks:open-db
3340: 68 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 hostname pullpor
3350: 74 3a 20 70 75 6c 6c 70 6f 72 74 20 70 69 64 3a t: pullport pid:
3360: 20 70 69 64 20 61 63 74 69 6f 6e 3a 20 27 64 65 pid action: 'de
3370: 6c 65 74 65 29 29 0a 09 09 20 20 20 20 20 28 69 lete))... (i
3380: 66 20 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 f (> last-update
3390: 20 32 30 29 20 20 20 20 20 20 20 20 3b 3b 20 4d 20) ;; M
33a0: 61 72 6b 20 61 73 20 64 65 61 64 20 69 66 20 6e ark as dead if n
33b0: 6f 74 20 75 70 64 61 74 65 64 20 69 6e 20 6c 61 ot updated in la
33c0: 73 74 20 32 30 20 73 65 63 6f 6e 64 73 0a 09 09 st 20 seconds...
33d0: 09 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 . (open-run-clos
33e0: 65 20 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 e tasks:server-d
33f0: 65 72 65 67 69 73 74 65 72 20 74 61 73 6b 73 3a eregister tasks:
3400: 6f 70 65 6e 2d 64 62 20 68 6f 73 74 6e 61 6d 65 open-db hostname
3410: 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 6c 6c 70 pullport: pullp
3420: 6f 72 74 20 70 69 64 3a 20 70 69 64 29 29 29 0a ort pid: pid))).
3430: 0a 09 09 20 28 66 6f 72 6d 61 74 20 23 74 20 66 ... (format #t f
3440: 6d 74 73 74 72 20 69 64 20 6d 74 2d 76 65 72 20 mtstr id mt-ver
3450: 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 69 6e 74 pid hostname int
3460: 65 72 66 61 63 65 20 70 75 6c 6c 70 6f 72 74 20 erface pullport
3470: 70 75 62 70 6f 72 74 20 6c 61 73 74 2d 75 70 64 pubport last-upd
3480: 61 74 65 0a 09 09 09 20 28 69 66 20 73 74 61 74 ate.... (if stat
3490: 75 73 20 22 61 6c 69 76 65 22 20 22 64 65 61 64 us "alive" "dead
34a0: 22 29 20 74 72 61 6e 73 70 6f 72 74 29 29 29 0a ") transport))).
34b0: 09 20 20 20 20 20 73 65 72 76 65 72 73 29 0a 09 . servers)..
34c0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
34d0: 2d 69 6e 66 6f 20 31 20 22 44 6f 6e 65 20 77 69 -info 1 "Done wi
34e0: 74 68 20 6c 69 73 74 73 65 72 76 65 72 73 22 29 th listservers")
34f0: 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 .. (set! *did
3500: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 something* #t)..
3510: 20 20 20 20 28 65 78 69 74 29 20 3b 3b 20 6d 75 (exit) ;; mu
3520: 73 74 20 64 6f 2c 20 77 6f 75 6c 64 20 68 61 76 st do, would hav
3530: 65 20 74 6f 20 61 64 64 20 63 68 65 63 6b 73 20 e to add checks
3540: 74 6f 20 6d 61 6e 79 2f 61 6c 6c 20 63 61 6c 6c to many/all call
3550: 73 20 62 65 6c 6f 77 0a 09 20 20 20 20 29 0a 09 s below.. )..
3560: 20 20 28 65 78 69 74 29 29 29 0a 20 20 20 20 3b (exit))). ;
3570: 3b 20 69 66 20 6e 6f 74 20 6c 69 73 74 20 6f 72 ; if not list or
3580: 20 6b 69 6c 6c 20 74 68 65 6e 20 73 74 61 72 74 kill then start
3590: 20 61 20 63 6c 69 65 6e 74 20 28 69 66 20 61 70 a client (if ap
35a0: 70 72 6f 70 72 69 61 74 65 29 0a 20 20 20 20 28 propriate). (
35b0: 69 66 20 28 6f 72 20 28 61 72 67 73 2d 64 65 66 if (or (args-def
35c0: 69 6e 65 64 3f 20 22 2d 68 22 20 22 2d 76 65 72 ined? "-h" "-ver
35d0: 73 69 6f 6e 22 20 22 2d 67 65 6e 2d 6d 65 67 61 sion" "-gen-mega
35e0: 74 65 73 74 2d 61 72 65 61 22 20 22 2d 67 65 6e test-area" "-gen
35f0: 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 22 29 -megatest-test")
3600: 0a 09 20 20 20 20 28 65 71 3f 20 28 6c 65 6e 67 .. (eq? (leng
3610: 74 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b th (hash-table-k
3620: 65 79 73 20 61 72 67 73 3a 61 72 67 2d 68 61 73 eys args:arg-has
3630: 68 29 29 20 30 29 29 0a 09 28 64 65 62 75 67 3a h)) 0))..(debug:
3640: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 22 53 65 print-info 1 "Se
3650: 72 76 65 72 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 rver connection
3660: 6e 6f 74 20 6e 65 65 64 65 64 22 29 0a 09 3b 3b not needed")..;;
3670: 20 6f 6b 2c 20 73 6f 20 6c 65 74 73 20 63 6f 6e ok, so lets con
3680: 6e 65 63 74 20 74 6f 20 74 68 65 20 73 65 72 76 nect to the serv
3690: 65 72 0a 09 28 63 6c 69 65 6e 74 3a 6c 61 75 6e er..(client:laun
36a0: 63 68 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d ch)))..;;=======
36b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
36f0: 3b 3b 20 57 65 69 72 64 20 73 70 65 63 69 61 6c ;; Weird special
3700: 20 63 61 6c 6c 73 20 74 68 61 74 20 6e 65 65 64 calls that need
3710: 20 74 6f 20 72 75 6e 20 2a 61 66 74 65 72 2a 20 to run *after*
3720: 74 68 65 20 73 65 72 76 65 72 20 68 61 73 20 73 the server has s
3730: 74 61 72 74 65 64 3f 0a 3b 3b 3d 3d 3d 3d 3d 3d tarted?.;;======
3740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3780: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
3790: 61 72 67 20 22 2d 6c 69 73 74 2d 74 61 72 67 65 arg "-list-targe
37a0: 74 73 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 ts"). (let ((
37b0: 74 61 72 67 65 74 73 20 28 63 6f 6d 6d 6f 6e 3a targets (common:
37c0: 67 65 74 2d 72 75 6e 63 6f 6e 66 69 67 2d 74 61 get-runconfig-ta
37d0: 72 67 65 74 73 29 29 29 0a 20 20 20 20 20 20 28 rgets))). (
37e0: 70 72 69 6e 74 20 22 46 6f 75 6e 64 20 22 28 6c print "Found "(l
37f0: 65 6e 67 74 68 20 74 61 72 67 65 74 73 29 20 22 ength targets) "
3800: 20 74 61 72 67 65 74 73 22 29 0a 20 20 20 20 20 targets").
3810: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
3820: 64 61 20 28 78 29 0a 09 09 20 20 3b 3b 20 28 70 da (x)... ;; (p
3830: 72 69 6e 74 20 22 5b 22 20 78 20 22 5d 22 29 29 rint "[" x "]"))
3840: 0a 09 09 20 20 28 70 72 69 6e 74 20 78 29 29 0a ... (print x)).
3850: 09 09 74 61 72 67 65 74 73 29 0a 20 20 20 20 20 ..targets).
3860: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
3870: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 hing* #t)))..(if
3880: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3890: 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 22 -show-runconfig"
38a0: 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 74 61 ). (let* ((ta
38b0: 72 67 65 74 20 28 69 66 20 28 61 72 67 73 3a 67 rget (if (args:g
38c0: 65 74 2d 61 72 67 20 22 2d 72 65 71 74 61 72 67 et-arg "-reqtarg
38d0: 22 29 0a 09 09 20 20 20 20 20 20 20 28 61 72 67 ")... (arg
38e0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 71 74 s:get-arg "-reqt
38f0: 61 72 67 22 29 0a 09 09 20 20 20 20 20 20 20 28 arg")... (
3900: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
3910: 20 22 2d 74 61 72 67 65 74 22 29 0a 09 09 09 20 "-target")....
3920: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
3930: 22 2d 74 61 72 67 65 74 22 29 0a 09 09 09 20 20 "-target")....
3940: 20 23 66 29 29 29 0a 09 20 20 20 28 73 65 63 74 #f))).. (sect
3950: 69 6f 6e 73 20 28 69 66 20 74 61 72 67 65 74 20 ions (if target
3960: 28 6c 69 73 74 20 22 64 65 66 61 75 6c 74 22 20 (list "default"
3970: 74 61 72 67 65 74 29 20 23 66 29 29 0a 09 20 20 target) #f))..
3980: 20 28 64 61 74 61 20 20 20 20 20 28 72 65 61 64 (data (read
3990: 2d 63 6f 6e 66 69 67 20 22 72 75 6e 63 6f 6e 66 -config "runconf
39a0: 69 67 73 2e 63 6f 6e 66 69 67 22 20 23 66 20 23 igs.config" #f #
39b0: 74 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 t sections: sect
39c0: 69 6f 6e 73 29 29 29 0a 0a 20 20 20 20 20 20 3b ions))).. ;
39d0: 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 ; keep this one
39e0: 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 63 6f 6e local. (con
39f0: 64 0a 20 20 20 20 20 20 20 28 28 6e 6f 74 20 28 d. ((not (
3a00: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
3a10: 75 6d 70 6d 6f 64 65 22 29 29 0a 09 28 70 70 20 umpmode"))..(pp
3a20: 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 (hash-table->ali
3a30: 73 74 20 64 61 74 61 29 29 29 0a 20 20 20 20 20 st data))).
3a40: 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 ((string=? (ar
3a50: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d gs:get-arg "-dum
3a60: 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 29 0a pmode") "json").
3a70: 09 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 74 .(json-write dat
3a80: 61 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65 a)). (else
3a90: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ..(debug:print 0
3aa0: 20 22 45 52 52 4f 52 3a 20 2d 64 75 6d 70 6d 6f "ERROR: -dumpmo
3ab0: 64 65 20 6f 66 20 22 20 28 61 72 67 73 3a 67 65 de of " (args:ge
3ac0: 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 t-arg "-dumpmode
3ad0: 22 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 6e 69 ") " not recogni
3ae0: 73 65 64 22 29 29 29 0a 20 20 20 20 20 20 28 73 sed"))). (s
3af0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
3b00: 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
3b10: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 rgs:get-arg "-sh
3b20: 6f 77 2d 63 6f 6e 66 69 67 22 29 0a 20 20 20 20 ow-config").
3b30: 28 6c 65 74 20 28 28 64 61 74 61 20 28 72 65 61 (let ((data (rea
3b40: 64 2d 63 6f 6e 66 69 67 20 22 6d 65 67 61 74 65 d-config "megate
3b50: 73 74 2e 63 6f 6e 66 69 67 22 20 23 66 20 23 74 st.config" #f #t
3b60: 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 ))). ;; kee
3b70: 70 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c p this one local
3b80: 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 0a 20 20 . (cond .
3b90: 20 20 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 ((not (args
3ba0: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
3bb0: 6f 64 65 22 29 29 0a 09 28 70 70 20 28 68 61 73 ode"))..(pp (has
3bc0: 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 64 h-table->alist d
3bd0: 61 74 61 29 29 29 0a 20 20 20 20 20 20 20 28 28 ata))). ((
3be0: 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 string=? (args:g
3bf0: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
3c00: 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 28 6a 73 e") "json")..(js
3c10: 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 29 29 0a on-write data)).
3c20: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 64 (else..(d
3c30: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
3c40: 52 4f 52 3a 20 2d 64 75 6d 70 6d 6f 64 65 20 6f ROR: -dumpmode o
3c50: 66 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 f " (args:get-ar
3c60: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
3c70: 20 6e 6f 74 20 72 65 63 6f 67 6e 69 73 65 64 22 not recognised"
3c80: 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ))). (set!
3c90: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
3ca0: 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
3cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
3cf0: 3b 20 52 65 6d 6f 76 65 20 6f 6c 64 20 72 75 6e ; Remove old run
3d00: 28 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d (s).;;==========
3d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
3d50: 20 73 69 6e 63 65 20 73 65 76 65 72 61 6c 20 61 since several a
3d60: 63 74 69 6f 6e 73 20 63 61 6e 20 62 65 20 73 70 ctions can be sp
3d70: 65 63 69 66 69 65 64 20 6f 6e 20 74 68 65 20 63 ecified on the c
3d80: 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 74 68 65 20 ommand line the
3d90: 72 65 6d 6f 76 61 6c 0a 3b 3b 20 69 73 20 64 6f removal.;; is do
3da0: 6e 65 20 66 69 72 73 74 0a 28 64 65 66 69 6e 65 ne first.(define
3db0: 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 61 63 74 (operate-on act
3dc0: 69 6f 6e 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 ion). (cond.
3dd0: 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d ((not (args:get-
3de0: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 arg ":runname"))
3df0: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
3e00: 74 20 30 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 t 0 "ERROR: Miss
3e10: 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 ing required par
3e20: 61 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 ameter for " act
3e30: 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 ion ", you must
3e40: 73 70 65 63 69 66 79 20 74 68 65 20 72 75 6e 20 specify the run
3e50: 6e 61 6d 65 20 70 61 74 74 65 72 6e 20 77 69 74 name pattern wit
3e60: 68 20 3a 72 75 6e 6e 61 6d 65 20 70 61 74 74 22 h :runname patt"
3e70: 29 0a 20 20 20 20 28 65 78 69 74 20 32 29 29 0a ). (exit 2)).
3e80: 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 ((not (args:g
3e90: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
3ea0: 74 22 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a t")). (debug:
3eb0: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
3ec0: 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 Missing required
3ed0: 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 parameter for "
3ee0: 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d action ", you m
3ef0: 75 73 74 20 73 70 65 63 69 66 79 20 74 68 65 20 ust specify the
3f00: 74 65 73 74 20 70 61 74 74 65 72 6e 20 77 69 74 test pattern wit
3f10: 68 20 2d 74 65 73 74 70 61 74 74 22 29 0a 20 20 h -testpatt").
3f20: 20 20 28 65 78 69 74 20 33 29 29 0a 20 20 20 28 (exit 3)). (
3f30: 65 6c 73 65 0a 20 20 20 20 28 69 66 20 28 6e 6f else. (if (no
3f40: 74 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e t (car *configin
3f50: 66 6f 2a 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 fo*))..(begin..
3f60: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
3f70: 22 45 52 52 4f 52 3a 20 41 74 74 65 6d 70 74 65 "ERROR: Attempte
3f80: 64 20 22 20 61 63 74 69 6f 6e 20 22 6f 6e 20 74 d " action "on t
3f90: 65 73 74 28 73 29 20 62 75 74 20 72 75 6e 20 61 est(s) but run a
3fa0: 72 65 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 rea config file
3fb0: 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 09 20 20 28 not found").. (
3fc0: 65 78 69 74 20 31 29 29 0a 09 3b 3b 20 70 75 74 exit 1))..;; put
3fd0: 20 74 65 73 74 20 70 61 72 61 6d 65 74 65 72 73 test parameters
3fe0: 20 69 6e 74 6f 20 63 6f 6e 76 65 6e 69 65 6e 74 into convenient
3ff0: 20 76 61 72 69 61 62 6c 65 73 0a 09 28 72 75 6e variables..(run
4000: 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 20 61 63 s:operate-on ac
4010: 74 69 6f 6e 0a 09 09 09 20 20 28 61 72 67 73 3a tion.... (args:
4020: 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d get-arg ":runnam
4030: 65 22 29 0a 09 09 09 20 20 28 61 72 67 73 3a 67 e").... (args:g
4040: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
4050: 74 22 29 0a 09 09 09 20 20 73 74 61 74 65 3a 20 t").... state:
4060: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
4070: 73 74 61 74 65 22 29 20 0a 09 09 09 20 20 73 74 state") .... st
4080: 61 74 75 73 3a 20 28 61 72 67 73 3a 67 65 74 2d atus: (args:get-
4090: 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 0a 09 arg ":status")..
40a0: 09 09 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 .. new-state-st
40b0: 61 74 75 73 3a 20 28 61 72 67 73 3a 67 65 74 2d atus: (args:get-
40c0: 61 72 67 20 22 2d 73 65 74 2d 73 74 61 74 65 2d arg "-set-state-
40d0: 73 74 61 74 75 73 22 29 29 29 0a 20 20 20 20 28 status"))). (
40e0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
40f0: 6e 67 2a 20 23 74 29 29 29 29 0a 09 20 20 0a 28 ng* #t)))).. .(
4100: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
4110: 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 "-remove-runs")
4120: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
4130: 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 n-call . "-r
4140: 65 6d 6f 76 65 2d 72 75 6e 73 22 0a 20 20 20 20 emove-runs".
4150: 20 22 72 65 6d 6f 76 65 20 72 75 6e 73 22 0a 20 "remove runs".
4160: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
4170: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
4180: 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c keynames keyval
4190: 6c 73 74 29 0a 20 20 20 20 20 20 20 28 6f 70 65 lst). (ope
41a0: 72 61 74 65 2d 6f 6e 20 27 72 65 6d 6f 76 65 2d rate-on 'remove-
41b0: 72 75 6e 73 29 29 29 29 0a 0a 28 69 66 20 28 61 runs))))..(if (a
41c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
41d0: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 29 t-state-status")
41e0: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
41f0: 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 73 n-call . "-s
4200: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 et-state-status"
4210: 0a 20 20 20 20 20 22 73 65 74 20 73 74 61 74 65 . "set state
4220: 20 61 6e 64 20 73 74 61 74 75 73 22 0a 20 20 20 and status".
4230: 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 (lambda (targe
4240: 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
4250: 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 eynames keyvalls
4260: 74 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 t). (opera
4270: 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 te-on 'set-state
4280: 2d 73 74 61 74 75 73 29 29 29 29 0a 0a 3b 3b 3d -status))))..;;=
4290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
42a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
42b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
42c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
42d0: 3d 3d 3d 3d 3d 0a 3b 3b 20 51 75 65 72 79 20 72 =====.;; Query r
42e0: 75 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d uns.;;==========
42f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
4330: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
4340: 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 arg "-list-runs"
4350: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
4360: 20 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 "-list-db-targe
4370: 74 73 22 29 29 0a 20 20 20 20 28 69 66 20 28 73 ts")). (if (s
4380: 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 0a 09 28 etup-for-run)..(
4390: 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 let* ((db
43a0: 23 66 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e #f).. (run
43b0: 70 61 74 74 20 20 28 61 72 67 73 3a 67 65 74 2d patt (args:get-
43c0: 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 arg "-list-runs"
43d0: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
43e0: 70 61 74 74 20 28 69 66 20 28 61 72 67 73 3a 67 patt (if (args:g
43f0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
4400: 74 22 29 20 0a 09 09 09 20 20 20 20 20 28 61 72 t") .... (ar
4410: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
4420: 74 70 61 74 74 22 29 20 0a 09 09 09 20 20 20 20 tpatt") ....
4430: 20 22 25 22 29 29 0a 09 20 20 20 20 20 20 20 28 "%")).. (
4440: 72 75 6e 73 64 61 74 20 20 28 63 64 62 3a 72 65 runsdat (cdb:re
4450: 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d mote-run db:get-
4460: 72 75 6e 73 20 23 66 20 72 75 6e 70 61 74 74 20 runs #f runpatt
4470: 23 66 20 23 66 20 27 28 29 29 29 0a 09 20 20 20 #f #f '()))..
4480: 20 20 20 20 28 72 75 6e 73 20 20 20 20 20 28 64 (runs (d
4490: 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e 73 64 b:get-rows runsd
44a0: 61 74 29 29 0a 09 20 20 20 20 20 20 20 28 68 65 at)).. (he
44b0: 61 64 65 72 20 20 20 28 64 62 3a 67 65 74 2d 68 ader (db:get-h
44c0: 65 61 64 65 72 20 72 75 6e 73 64 61 74 29 29 0a eader runsdat)).
44d0: 09 20 20 20 20 20 20 20 28 6b 65 79 73 20 20 20 . (keys
44e0: 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 (cdb:remote-ru
44f0: 6e 20 64 62 3a 67 65 74 2d 6b 65 79 73 20 23 66 n db:get-keys #f
4500: 29 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 6e )).. (keyn
4510: 61 6d 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 ames (map key:ge
4520: 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 t-fieldname keys
4530: 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d 74 )).. (db-t
4540: 61 72 67 65 74 73 20 28 61 72 67 73 3a 67 65 74 argets (args:get
4550: 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 -arg "-list-db-t
4560: 61 72 67 65 74 73 22 29 29 0a 09 20 20 20 20 20 argets"))..
4570: 20 20 28 73 65 65 6e 20 20 20 20 20 28 6d 61 6b (seen (mak
4580: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))).
4590: 09 20 20 3b 3b 20 45 61 63 68 20 72 75 6e 0a 09 . ;; Each run..
45a0: 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 (for-each ..
45b0: 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 (lambda (run)..
45c0: 20 20 20 20 20 28 6c 65 74 20 28 28 74 61 72 67 (let ((targ
45d0: 65 74 73 74 72 20 28 73 74 72 69 6e 67 2d 69 6e etstr (string-in
45e0: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 tersperse (map (
45f0: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 lambda (x)......
4600: 09 09 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 .. (db:get-value
4610: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
4620: 65 61 64 65 72 20 78 29 29 0a 09 09 09 09 09 09 eader x)).......
4630: 20 20 20 20 20 20 20 6b 65 79 6e 61 6d 65 73 29 keynames)
4640: 20 22 2f 22 29 29 29 0a 09 20 20 20 20 20 20 20 "/")))..
4650: 28 69 66 20 64 62 2d 74 61 72 67 65 74 73 0a 09 (if db-targets..
4660: 09 20 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 . (if (not (ha
4670: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
4680: 61 75 6c 74 20 73 65 65 6e 20 74 61 72 67 65 74 ault seen target
4690: 73 74 72 20 23 66 29 29 0a 09 09 20 20 20 20 20 str #f))...
46a0: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 28 68 61 (begin.... (ha
46b0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 65 sh-table-set! se
46c0: 65 6e 20 74 61 72 67 65 74 73 74 72 20 23 74 29 en targetstr #t)
46d0: 0a 09 09 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 .... ;; (print "
46e0: 5b 22 20 74 61 72 67 65 74 73 74 72 20 22 5d 22 [" targetstr "]"
46f0: 29 29 29 29 0a 09 09 09 20 28 70 72 69 6e 74 20 )))).... (print
4700: 74 61 72 67 65 74 73 74 72 29 29 29 29 0a 09 20 targetstr))))..
4710: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 64 (if (not d
4720: 62 2d 74 61 72 67 65 74 73 29 0a 09 09 20 20 20 b-targets)...
4730: 28 6c 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 28 (let* ((run-id (
4740: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
4750: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
4760: 72 20 22 69 64 22 29 29 0a 09 09 09 20 20 28 74 r "id")).... (t
4770: 65 73 74 73 20 20 28 63 64 62 3a 72 65 6d 6f 74 ests (cdb:remot
4780: 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 74 65 73 e-run db:get-tes
4790: 74 73 2d 66 6f 72 2d 72 75 6e 20 23 66 20 72 75 ts-for-run #f ru
47a0: 6e 2d 69 64 20 74 65 73 74 70 61 74 74 20 27 28 n-id testpatt '(
47b0: 29 20 27 28 29 29 29 29 0a 09 09 20 20 20 20 20 ) '())))...
47c0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 (debug:print 1 "
47d0: 52 75 6e 3a 20 22 20 74 61 72 67 65 74 73 74 72 Run: " targetstr
47e0: 20 22 20 73 74 61 74 75 73 3a 20 22 20 28 64 62 " status: " (db
47f0: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
4800: 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 ader run header
4810: 22 73 74 61 74 65 22 29 0a 09 09 09 09 20 20 22 "state")..... "
4820: 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 run-id: " run-i
4830: 64 20 22 2c 20 6e 75 6d 62 65 72 20 74 65 73 74 d ", number test
4840: 73 3a 20 22 20 28 6c 65 6e 67 74 68 20 74 65 73 s: " (length tes
4850: 74 73 29 29 0a 09 09 20 20 20 20 20 28 66 6f 72 ts))... (for
4860: 2d 65 61 63 68 20 0a 09 09 20 20 20 20 20 20 28 -each ... (
4870: 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 lambda (test)...
4880: 09 28 66 6f 72 6d 61 74 20 23 74 0a 09 09 09 09 .(format #t.....
4890: 22 20 20 54 65 73 74 3a 20 7e 32 35 61 20 53 74 " Test: ~25a St
48a0: 61 74 65 3a 20 7e 31 35 61 20 53 74 61 74 75 73 ate: ~15a Status
48b0: 3a 20 7e 31 35 61 20 52 75 6e 74 69 6d 65 3a 20 : ~15a Runtime:
48c0: 7e 35 40 61 73 20 54 69 6d 65 3a 20 7e 32 32 61 ~5@as Time: ~22a
48d0: 20 48 6f 73 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 Host: ~10a\n"..
48e0: 09 09 09 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 ...(conc (db:tes
48f0: 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 t-get-testname t
4900: 65 73 74 29 0a 09 09 09 09 20 20 20 20 20 20 28 est)..... (
4910: 69 66 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 if (equal? (db:t
4920: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
4930: 68 20 74 65 73 74 29 20 22 22 29 0a 09 09 09 09 h test) "").....
4940: 09 20 20 22 22 20 0a 09 09 09 09 09 20 20 28 63 . "" ...... (c
4950: 6f 6e 63 20 22 28 22 20 28 64 62 3a 74 65 73 74 onc "(" (db:test
4960: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 -get-item-path t
4970: 65 73 74 29 20 22 29 22 29 29 29 0a 09 09 09 09 est) ")"))).....
4980: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
4990: 74 65 20 74 65 73 74 29 0a 09 09 09 09 28 64 62 te test).....(db
49a0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
49b0: 20 74 65 73 74 29 0a 09 09 09 09 28 64 62 3a 74 test).....(db:t
49c0: 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 est-get-run_dura
49d0: 74 69 6f 6e 20 74 65 73 74 29 0a 09 09 09 09 28 tion test).....(
49e0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e db:test-get-even
49f0: 74 5f 74 69 6d 65 20 74 65 73 74 29 0a 09 09 09 t_time test)....
4a00: 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f .(db:test-get-ho
4a10: 73 74 20 74 65 73 74 29 29 0a 09 09 09 28 69 66 st test))....(if
4a20: 20 28 6e 6f 74 20 28 6f 72 20 28 65 71 75 61 6c (not (or (equal
4a30: 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ? (db:test-get-s
4a40: 74 61 74 75 73 20 74 65 73 74 29 20 22 50 41 53 tatus test) "PAS
4a50: 53 22 29 0a 09 09 09 09 20 20 20 20 20 28 65 71 S")..... (eq
4a60: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
4a70: 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 20 22 t-status test) "
4a80: 57 41 52 4e 22 29 0a 09 09 09 09 20 20 20 20 20 WARN").....
4a90: 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 (equal? (db:test
4aa0: 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 29 -get-state test)
4ab0: 20 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 "NOT_STARTED")
4ac0: 29 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e )).... (begin
4ad0: 0a 09 09 09 20 20 20 20 20 20 28 70 72 69 6e 74 .... (print
4ae0: 20 22 20 20 20 20 20 20 20 20 20 63 70 75 6c 6f " cpulo
4af0: 61 64 3a 20 20 22 20 28 64 62 3a 74 65 73 74 2d ad: " (db:test-
4b00: 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 73 74 get-cpuload test
4b10: 29 0a 09 09 09 09 20 20 20 20 20 22 5c 6e 20 20 )..... "\n
4b20: 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 3a diskfree:
4b30: 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d " (db:test-get-
4b40: 64 69 73 6b 66 72 65 65 20 74 65 73 74 29 0a 09 diskfree test)..
4b50: 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 ... "\n
4b60: 20 20 20 20 75 6e 61 6d 65 3a 20 20 20 20 22 20 uname: "
4b70: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 75 6e 61 (db:test-get-una
4b80: 6d 65 20 74 65 73 74 29 0a 09 09 09 09 20 20 20 me test).....
4b90: 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 72 75 "\n ru
4ba0: 6e 64 69 72 3a 20 20 20 22 20 28 64 62 3a 74 65 ndir: " (db:te
4bb0: 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 st-get-rundir te
4bc0: 73 74 29 0a 09 09 09 09 20 20 20 20 20 29 0a 09 st)..... )..
4bd0: 09 09 20 20 20 20 20 20 3b 3b 20 45 61 63 68 20 .. ;; Each
4be0: 74 65 73 74 0a 09 09 09 20 20 20 20 20 20 3b 3b test.... ;;
4bf0: 20 44 4f 20 4e 4f 54 20 72 65 6d 6f 74 65 20 72 DO NOT remote r
4c00: 75 6e 0a 09 09 09 20 20 20 20 20 20 28 6c 65 74 un.... (let
4c10: 20 28 28 73 74 65 70 73 20 28 64 62 3a 67 65 74 ((steps (db:get
4c20: 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 -steps-for-test
4c30: 23 66 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d #f (db:test-get-
4c40: 69 64 20 74 65 73 74 29 29 29 29 0a 09 09 09 09 id test)))).....
4c50: 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 20 (for-each .....
4c60: 28 6c 61 6d 62 64 61 20 28 73 74 65 70 29 0a 09 (lambda (step)..
4c70: 09 09 09 20 20 20 28 66 6f 72 6d 61 74 20 23 74 ... (format #t
4c80: 20 0a 09 09 09 09 09 20 20 20 22 20 20 20 20 53 ...... " S
4c90: 74 65 70 3a 20 7e 32 30 61 20 53 74 61 74 65 3a tep: ~20a State:
4ca0: 20 7e 31 30 61 20 53 74 61 74 75 73 3a 20 7e 31 ~10a Status: ~1
4cb0: 30 61 20 54 69 6d 65 20 7e 32 32 61 5c 6e 22 0a 0a Time ~22a\n".
4cc0: 09 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 ..... (db:step
4cd0: 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 -get-stepname st
4ce0: 65 70 29 0a 09 09 09 09 09 20 20 20 28 64 62 3a ep)...... (db:
4cf0: 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 step-get-state s
4d00: 74 65 70 29 0a 09 09 09 09 09 20 20 20 28 64 62 tep)...... (db
4d10: 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 :step-get-status
4d20: 20 73 74 65 70 29 0a 09 09 09 09 09 20 20 20 28 step)...... (
4d30: 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e db:step-get-even
4d40: 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 0a 09 t_time step)))..
4d50: 09 09 09 20 73 74 65 70 73 29 29 29 29 29 0a 09 ... steps)))))..
4d60: 09 20 20 20 20 20 20 74 65 73 74 73 29 29 29 29 . tests))))
4d70: 29 0a 09 20 20 20 20 20 72 75 6e 73 29 0a 09 20 ).. runs)..
4d80: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
4d90: 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b thing* #t))))..;
4da0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
4db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4de0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 =======.;; full
4df0: 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;==========
4e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
4e40: 20 67 65 74 20 6c 6f 63 6b 20 69 6e 20 64 62 20 get lock in db
4e50: 66 6f 72 20 66 75 6c 6c 20 72 75 6e 20 66 6f 72 for full run for
4e60: 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 0a this directory.
4e70: 3b 3b 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 ;; for all tests
4e80: 20 77 69 74 68 20 64 65 70 73 0a 3b 3b 20 20 20 with deps.;;
4e90: 77 61 6c 6b 20 74 72 65 65 20 6f 66 20 74 65 73 walk tree of tes
4ea0: 74 73 20 74 6f 20 66 69 6e 64 20 68 65 61 64 20 ts to find head
4eb0: 74 61 73 6b 73 0a 3b 3b 20 20 20 61 64 64 20 68 tasks.;; add h
4ec0: 65 61 64 20 74 61 73 6b 73 20 74 6f 20 74 61 73 ead tasks to tas
4ed0: 6b 20 71 75 65 75 65 0a 3b 3b 20 20 20 61 64 64 k queue.;; add
4ee0: 20 64 65 70 65 6e 64 61 6e 74 20 74 61 73 6b 73 dependant tasks
4ef0: 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 20 0a to task queue .
4f00: 3b 3b 20 20 20 61 64 64 20 72 65 6d 61 69 6e 69 ;; add remaini
4f10: 6e 67 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b ng tasks to task
4f20: 20 71 75 65 75 65 0a 3b 3b 20 66 6f 72 20 65 61 queue.;; for ea
4f30: 63 68 20 74 61 73 6b 20 69 6e 20 74 61 73 6b 20 ch task in task
4f40: 71 75 65 75 65 0a 3b 3b 20 20 20 69 66 20 68 61 queue.;; if ha
4f50: 76 65 20 61 64 65 71 75 61 74 65 20 72 65 73 6f ve adequate reso
4f60: 75 72 63 65 73 0a 3b 3b 20 20 20 20 20 6c 61 75 urces.;; lau
4f70: 6e 63 68 20 74 61 73 6b 0a 3b 3b 20 20 20 65 6c nch task.;; el
4f80: 73 65 0a 3b 3b 20 20 20 20 20 70 75 74 20 74 61 se.;; put ta
4f90: 73 6b 20 69 6e 20 64 65 66 65 72 72 65 64 20 71 sk in deferred q
4fa0: 75 65 75 65 0a 3b 3b 20 69 66 20 73 74 69 6c 6c ueue.;; if still
4fb0: 20 6f 6b 20 74 6f 20 72 75 6e 20 74 61 73 6b 73 ok to run tasks
4fc0: 0a 3b 3b 20 20 20 70 72 6f 63 65 73 73 20 64 65 .;; process de
4fd0: 66 65 72 72 65 64 20 74 61 73 6b 73 20 70 65 72 ferred tasks per
4fe0: 20 61 62 6f 76 65 20 73 74 65 70 73 0a 0a 3b 3b above steps..;;
4ff0: 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 61 run all tests a
5000: 72 65 20 61 72 65 20 4e 6f 74 20 43 4f 4d 50 4c re are Not COMPL
5010: 45 54 45 44 20 61 6e 64 20 50 41 53 53 20 6f 72 ETED and PASS or
5020: 20 43 48 45 43 4b 0a 28 69 66 20 28 61 72 67 73 CHECK.(if (args
5030: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c :get-arg "-runal
5040: 6c 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c l"). (general
5050: 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 -run-call .
5060: 22 2d 72 75 6e 61 6c 6c 22 0a 20 20 20 20 20 22 "-runall". "
5070: 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 22 0a 20 run all tests".
5080: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
5090: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
50a0: 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c keynames keyval
50b0: 6c 73 74 29 0a 20 20 20 20 20 20 20 28 72 75 6e lst). (run
50c0: 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 72 67 s:run-tests targ
50d0: 65 74 0a 09 09 20 20 20 20 20 20 20 72 75 6e 6e et... runn
50e0: 61 6d 65 0a 09 09 20 20 20 20 20 20 20 22 25 22 ame... "%"
50f0: 0a 09 09 20 20 20 20 20 20 20 28 61 72 67 73 3a ... (args:
5100: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
5110: 74 74 22 29 0a 09 09 20 20 20 20 20 20 20 75 73 tt")... us
5120: 65 72 0a 09 09 20 20 20 20 20 20 20 61 72 67 73 er... args
5130: 3a 61 72 67 2d 68 61 73 68 29 29 29 29 0a 0a 3b :arg-hash))))..;
5140: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
5150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5180: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e 20 6f =======.;; run o
5190: 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d ne test.;;======
51a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51e0: 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 20 74 68 65 ..;; 1. find the
51f0: 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b 20 config file.;;
5200: 32 2e 20 63 68 61 6e 67 65 20 74 6f 20 74 68 65 2. change to the
5210: 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 79 0a test directory.
5220: 3b 3b 20 33 2e 20 75 70 64 61 74 65 20 74 68 65 ;; 3. update the
5230: 20 64 62 20 77 69 74 68 20 22 74 65 73 74 20 73 db with "test s
5240: 74 61 72 74 65 64 22 20 73 74 61 74 75 73 2c 20 tarted" status,
5250: 73 65 74 20 72 75 6e 6e 69 6e 67 20 68 6f 73 74 set running host
5260: 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 73 73 20 6c .;; 4. process l
5270: 61 75 6e 63 68 20 74 68 65 20 74 65 73 74 0a 3b aunch the test.;
5280: 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 6f 72 20 74 ; - monitor t
5290: 68 65 20 70 72 6f 63 65 73 73 2c 20 75 70 64 61 he process, upda
52a0: 74 65 20 73 74 61 74 73 20 69 6e 20 74 68 65 20 te stats in the
52b0: 64 62 20 65 76 65 72 79 20 32 5e 6e 20 6d 69 6e db every 2^n min
52c0: 75 74 65 73 0a 3b 3b 20 35 2e 20 61 73 20 74 68 utes.;; 5. as th
52d0: 65 20 74 65 73 74 20 70 72 6f 63 65 65 64 73 20 e test proceeds
52e0: 69 6e 74 65 72 6e 61 6c 6c 79 20 69 74 20 63 61 internally it ca
52f0: 6c 6c 73 20 6d 65 67 61 74 65 73 74 20 61 73 20 lls megatest as
5300: 65 61 63 68 20 73 74 65 70 20 69 73 0a 3b 3b 20 each step is.;;
5310: 20 20 20 73 74 61 72 74 65 64 20 61 6e 64 20 63 started and c
5320: 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 20 20 20 2d ompleted.;; -
5330: 20 73 74 65 70 20 73 74 61 72 74 65 64 2c 20 74 step started, t
5340: 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 20 20 20 2d imestamp.;; -
5350: 20 73 74 65 70 20 63 6f 6d 70 6c 65 74 65 64 2c step completed,
5360: 20 65 78 69 74 20 73 74 61 74 75 73 2c 20 74 69 exit status, ti
5370: 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 2e 20 74 65 mestamp.;; 6. te
5380: 73 74 20 70 68 6f 6e 65 20 68 6f 6d 65 0a 3b 3b st phone home.;;
5390: 20 20 20 20 2d 20 69 66 20 74 65 73 74 20 72 75 - if test ru
53a0: 6e 20 74 69 6d 65 20 3e 20 61 6c 6c 6f 77 65 64 n time > allowed
53b0: 20 72 75 6e 20 74 69 6d 65 20 74 68 65 6e 20 6b run time then k
53c0: 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 20 20 2d 20 ill job.;; -
53d0: 69 66 20 63 61 6e 6e 6f 74 20 61 63 63 65 73 73 if cannot access
53e0: 20 64 62 20 3e 20 61 6c 6c 6f 77 65 64 20 64 69 db > allowed di
53f0: 73 63 6f 6e 6e 65 63 74 20 74 69 6d 65 20 74 68 sconnect time th
5400: 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 0a 28 69 66 en kill job..(if
5410: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5420: 2d 72 75 6e 74 65 73 74 73 22 29 0a 20 20 28 67 -runtests"). (g
5430: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
5440: 0a 20 20 20 22 2d 72 75 6e 74 65 73 74 73 22 20 . "-runtests"
5450: 0a 20 20 20 22 72 75 6e 20 61 20 74 65 73 74 22 . "run a test"
5460: 20 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 . (lambda (ta
5470: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
5480: 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 s keynames keyva
5490: 6c 6c 73 74 29 0a 20 20 20 20 20 28 72 75 6e 73 llst). (runs
54a0: 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 72 67 65 :run-tests targe
54b0: 74 0a 09 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 t... runname
54c0: 0a 09 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 ... (args:ge
54d0: 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 t-arg "-runtests
54e0: 22 29 0a 09 09 20 20 20 20 20 28 61 72 67 73 3a ")... (args:
54f0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
5500: 74 74 22 29 0a 09 09 20 20 20 20 20 75 73 65 72 tt")... user
5510: 0a 09 09 20 20 20 20 20 61 72 67 73 3a 61 72 67 ... args:arg
5520: 2d 68 61 73 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d -hash))))..;;===
5530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5570: 3d 3d 3d 0a 3b 3b 20 52 6f 6c 6c 75 70 20 69 6e ===.;; Rollup in
5580: 74 6f 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d to a run.;;=====
5590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55d0: 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 =..(if (args:get
55e0: 2d 61 72 67 20 22 2d 72 6f 6c 6c 75 70 22 29 0a -arg "-rollup").
55f0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
5600: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
5610: 22 45 52 52 4f 52 3a 20 52 6f 6c 6c 75 70 20 69 "ERROR: Rollup i
5620: 73 20 63 75 72 72 65 6e 74 6c 79 20 6e 6f 74 20 s currently not
5630: 77 6f 72 6b 69 6e 67 2e 20 49 66 20 79 6f 75 20 working. If you
5640: 6e 65 65 64 20 69 74 20 70 6c 65 61 73 65 20 73 need it please s
5650: 75 62 6d 69 74 20 61 20 74 69 63 6b 65 74 20 61 ubmit a ticket a
5660: 74 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 t http://www.kia
5670: 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f toa.com/fossils/
5680: 6d 65 67 61 74 65 73 74 22 29 0a 20 20 20 20 20 megatest").
5690: 20 28 65 78 69 74 20 34 29 29 29 0a 3b 3b 20 20 (exit 4))).;;
56a0: 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
56b0: 63 61 6c 6c 20 0a 3b 3b 20 20 20 20 20 20 22 2d call .;; "-
56c0: 72 6f 6c 6c 75 70 22 20 0a 3b 3b 20 20 20 20 20 rollup" .;;
56d0: 20 22 72 6f 6c 6c 75 70 20 74 65 73 74 73 22 20 "rollup tests"
56e0: 0a 3b 3b 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .;; (lambda
56f0: 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 (target runname
5700: 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b keys keynames k
5710: 65 79 76 61 6c 6c 73 74 29 0a 3b 3b 20 20 20 20 eyvallst).;;
5720: 20 20 20 20 28 72 75 6e 73 3a 72 6f 6c 6c 75 70 (runs:rollup
5730: 2d 72 75 6e 20 6b 65 79 73 0a 3b 3b 20 09 09 09 -run keys.;; ...
5740: 28 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 79 (keys->alist key
5750: 73 20 22 6e 61 22 29 0a 3b 3b 20 09 09 09 28 61 s "na").;; ...(a
5760: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 rgs:get-arg ":ru
5770: 6e 6e 61 6d 65 22 29 20 0a 3b 3b 20 09 09 09 75 nname") .;; ...u
5780: 73 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d ser))))..;;=====
5790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 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 0a 3b 3b 20 4c 6f 63 6b 20 6f 72 20 75 6e 6c =.;; Lock or unl
57e0: 6f 63 6b 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d ock a run.;;====
57f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 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 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 ==..(if (or (arg
5840: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 6b s:get-arg "-lock
5850: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
5860: 22 2d 75 6e 6c 6f 63 6b 22 29 29 0a 20 20 20 20 "-unlock")).
5870: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
5880: 6c 20 0a 20 20 20 20 20 28 69 66 20 28 61 72 67 l . (if (arg
5890: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 6b s:get-arg "-lock
58a0: 22 29 20 22 2d 6c 6f 63 6b 22 20 22 2d 75 6e 6c ") "-lock" "-unl
58b0: 6f 63 6b 22 29 0a 20 20 20 20 20 22 6c 6f 63 6b ock"). "lock
58c0: 2f 75 6e 6c 6f 63 6b 20 74 65 73 74 73 22 20 0a /unlock tests" .
58d0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 (lambda (ta
58e0: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
58f0: 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 s keynames keyva
5900: 6c 6c 73 74 29 0a 20 20 20 20 20 20 20 28 72 75 llst). (ru
5910: 6e 73 3a 68 61 6e 64 6c 65 2d 6c 6f 63 6b 69 6e ns:handle-lockin
5920: 67 20 0a 09 09 20 20 74 61 72 67 65 74 0a 09 09 g ... target...
5930: 20 20 6b 65 79 73 0a 09 09 20 20 28 61 72 67 73 keys... (args
5940: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
5950: 6d 65 22 29 20 0a 09 09 20 20 28 61 72 67 73 3a me") ... (args:
5960: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 get-arg "-lock")
5970: 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ... (args:get-a
5980: 72 67 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 09 09 rg "-unlock")...
5990: 20 20 75 73 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d user))))..;;==
59a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59e0: 3d 3d 3d 3d 0a 3b 3b 20 47 65 74 20 70 61 74 68 ====.;; Get path
59f0: 73 20 74 6f 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d s to tests.;;===
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 3d 3d 3d 3d ================
5a40: 3d 3d 3d 0a 3b 3b 20 47 65 74 20 74 65 73 74 20 ===.;; Get test
5a50: 70 61 74 68 73 20 6d 61 74 63 68 69 6e 67 20 74 paths matching t
5a60: 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 arget, runname,
5a70: 61 6e 64 20 74 65 73 74 70 61 74 74 0a 28 69 66 and testpatt.(if
5a80: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
5a90: 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 rg "-test-files"
5aa0: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
5ab0: 2d 74 65 73 74 2d 70 61 74 68 73 22 29 29 0a 20 -test-paths")).
5ac0: 20 20 20 3b 3b 20 69 66 20 77 65 20 61 72 65 20 ;; if we are
5ad0: 69 6e 20 61 20 74 65 73 74 20 75 73 65 20 74 68 in a test use th
5ae0: 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 61 74 e MT_CMDINFO dat
5af0: 61 0a 20 20 20 20 28 69 66 20 28 67 65 74 65 6e a. (if (geten
5b00: 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 0a v "MT_CMDINFO").
5b10: 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e .(let* ((startin
5b20: 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 gdir (current-di
5b30: 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 rectory))..
5b40: 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 (cmdinfo (re
5b50: 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 ad (open-input-s
5b60: 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 tring (base64:ba
5b70: 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 74 se64-decode (get
5b80: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
5b90: 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b ))))).. ;;
5ba0: 20 28 72 75 6e 72 65 6d 6f 74 65 20 28 61 73 73 (runremote (ass
5bb0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 72 oc/default 'runr
5bc0: 65 6d 6f 74 65 20 63 6d 64 69 6e 66 6f 29 29 0a emote cmdinfo)).
5bd0: 09 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f . (transpo
5be0: 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c rt (assoc/defaul
5bf0: 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 t 'transport cmd
5c00: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
5c10: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
5c20: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
5c30: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
5c40: 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
5c50: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
5c60: 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
5c70: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
5c80: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
5c90: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
5ca0: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
5cb0: 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 (db-host (
5cc0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 assoc/default 'd
5cd0: 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f b-host cmdinfo
5ce0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
5cf0: 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 id (assoc/def
5d00: 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 ault 'run-id
5d10: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
5d20: 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
5d30: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
5d40: 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
5d50: 0a 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 .. (db
5d60: 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 #f)..
5d70: 28 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 (state (args
5d80: 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 :get-arg ":state
5d90: 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 ")).. (sta
5da0: 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 tus (args:get
5db0: 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 -arg ":status"))
5dc0: 0a 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 .. (target
5dd0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
5de0: 67 20 22 2d 74 61 72 67 65 74 22 29 29 0a 09 20 g "-target"))..
5df0: 20 20 20 20 20 20 28 74 6f 70 70 61 74 68 20 20 (toppath
5e00: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
5e10: 27 74 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 'toppath cmdin
5e20: 66 6f 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 fo))).. (change
5e30: 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 70 61 -directory toppa
5e40: 74 68 29 0a 09 20 20 3b 3b 20 28 73 65 74 21 20 th).. ;; (set!
5e50: 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e 72 *runremote* runr
5e60: 65 6d 6f 74 65 29 0a 09 20 20 28 73 65 74 21 20 emote).. (set!
5e70: 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 2a *transport-type*
5e80: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
5e90: 20 74 72 61 6e 73 70 6f 72 74 29 29 0a 09 20 20 transport))..
5ea0: 28 69 66 20 28 6e 6f 74 20 74 61 72 67 65 74 29 (if (not target)
5eb0: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
5ec0: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
5ed0: 22 45 52 52 4f 52 3a 20 2d 74 61 72 67 65 74 20 "ERROR: -target
5ee0: 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 0a 09 is required.")..
5ef0: 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 .(exit 1))).. (
5f00: 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 if (not (setup-f
5f10: 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 or-run))..
5f20: 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a (begin...(debug:
5f30: 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 print 0 "Failed
5f40: 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 6e 67 to setup, giving
5f50: 20 75 70 20 6f 6e 20 2d 74 65 73 74 2d 70 61 74 up on -test-pat
5f60: 68 73 20 6f 72 20 2d 74 65 73 74 2d 66 69 6c 65 hs or -test-file
5f70: 73 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 s, exiting")...(
5f80: 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 6c 65 exit 1))).. (le
5f90: 74 2a 20 28 28 6b 65 79 73 20 20 20 20 20 28 63 t* ((keys (c
5fa0: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 db:remote-run db
5fb0: 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 :get-keys db))..
5fc0: 09 20 28 6b 65 79 6e 61 6d 65 73 20 28 6d 61 70 . (keynames (map
5fd0: 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 key:get-fieldna
5fe0: 6d 65 20 6b 65 79 73 29 29 0a 09 09 20 3b 3b 20 me keys))... ;;
5ff0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 db:test-get-path
6000: 73 20 6d 75 73 74 20 6e 6f 74 20 62 65 20 72 75 s must not be ru
6010: 6e 20 72 65 6d 6f 74 65 0a 09 09 20 28 70 61 74 n remote... (pat
6020: 68 73 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 hs (db:test-g
6030: 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e et-paths-matchin
6040: 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 g db keynames ta
6050: 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d 61 rget (args:get-a
6060: 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 rg "-test-files"
6070: 29 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 20 )))).. (set!
6080: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
6090: 74 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 t).. (for-eac
60a0: 68 20 28 6c 61 6d 62 64 61 20 28 70 61 74 68 29 h (lambda (path)
60b0: 0a 09 09 09 28 70 72 69 6e 74 20 70 61 74 68 29 ....(print path)
60c0: 29 0a 09 09 20 20 20 20 20 20 70 61 74 68 73 29 )... paths)
60d0: 29 29 0a 09 3b 3b 20 65 6c 73 65 20 64 6f 20 61 ))..;; else do a
60e0: 20 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c general-run-cal
60f0: 6c 0a 09 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d l..(general-run-
6100: 63 61 6c 6c 20 0a 09 20 22 2d 74 65 73 74 2d 66 call .. "-test-f
6110: 69 6c 65 73 22 0a 09 20 22 47 65 74 20 70 61 74 iles".. "Get pat
6120: 68 73 20 74 6f 20 74 65 73 74 22 0a 09 20 28 6c hs to test".. (l
6130: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
6140: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 nname keys keyna
6150: 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 09 mes keyvallst)..
6160: 20 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 (let* ((db
6170: 20 20 20 20 23 66 29 0a 09 09 20 20 3b 3b 20 44 #f)... ;; D
6180: 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 O NOT run remote
6190: 0a 09 09 20 20 28 70 61 74 68 73 20 20 20 20 28 ... (paths (
61a0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 db:test-get-path
61b0: 73 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 s-matching db ke
61c0: 79 6e 61 6d 65 73 20 74 61 72 67 65 74 20 28 61 ynames target (a
61d0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
61e0: 73 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 st-files"))))..
61f0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
6200: 61 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 ambda (path)....
6210: 20 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 (print path))..
6220: 09 20 20 20 20 20 20 20 70 61 74 68 73 29 29 29 . paths)))
6230: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
6240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
6280: 20 41 72 63 68 69 76 65 20 74 65 73 74 73 0a 3b Archive tests.;
6290: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
62a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
62b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
62c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
62d0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 =======.;; Archi
62e0: 76 65 20 74 65 73 74 73 20 6d 61 74 63 68 69 6e ve tests matchin
62f0: 67 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d g target, runnam
6300: 65 2c 20 61 6e 64 20 74 65 73 74 70 61 74 74 0a e, and testpatt.
6310: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
6320: 67 20 22 2d 61 72 63 68 69 76 65 22 29 0a 20 20 g "-archive").
6330: 20 20 3b 3b 20 69 66 20 77 65 20 61 72 65 20 69 ;; if we are i
6340: 6e 20 61 20 74 65 73 74 20 75 73 65 20 74 68 65 n a test use the
6350: 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 61 74 61 MT_CMDINFO data
6360: 0a 20 20 20 20 28 69 66 20 28 67 65 74 65 6e 76 . (if (getenv
6370: 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 0a 09 "MT_CMDINFO")..
6380: 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e 67 (let* ((starting
6390: 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 72 dir (current-dir
63a0: 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 20 ectory))..
63b0: 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 (cmdinfo (rea
63c0: 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 d (open-input-st
63d0: 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 73 ring (base64:bas
63e0: 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 74 65 e64-decode (gete
63f0: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
6400: 29 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 )))).. ;;
6410: 28 72 75 6e 72 65 6d 6f 74 65 20 28 61 73 73 6f (runremote (asso
6420: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 72 65 c/default 'runre
6430: 6d 6f 74 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 mote cmdinfo))..
6440: 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 (transpor
6450: 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
6460: 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 'transport cmdi
6470: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
6480: 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f estpath (assoc/
6490: 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 default 'testpat
64a0: 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 h cmdinfo))..
64b0: 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 (test-name
64c0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
64d0: 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 test-name cmdinf
64e0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
64f0: 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 script (assoc/de
6500: 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 fault 'runscript
6510: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
6520: 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 (db-host (a
6530: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 ssoc/default 'db
6540: 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 -host cmdinfo)
6550: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 ).. (run-i
6560: 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 d (assoc/defa
6570: 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 ult 'run-id c
6580: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
6590: 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 (itemdat (ass
65a0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d oc/default 'item
65b0: 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a dat cmdinfo)).
65c0: 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 20 . (db
65d0: 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 #f).. (
65e0: 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 3a state (args:
65f0: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 get-arg ":state"
6600: 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 )).. (stat
6610: 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d us (args:get-
6620: 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a arg ":status")).
6630: 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 20 . (target
6640: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
6650: 20 22 2d 74 61 72 67 65 74 22 29 29 29 0a 09 20 "-target")))..
6660: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
6670: 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 20 20 ry testpath)..
6680: 3b 3b 20 28 73 65 74 21 20 2a 72 75 6e 72 65 6d ;; (set! *runrem
6690: 6f 74 65 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a ote* runremote).
66a0: 09 20 20 28 73 65 74 21 20 2a 74 72 61 6e 73 70 . (set! *transp
66b0: 6f 72 74 2d 74 79 70 65 2a 20 28 73 74 72 69 6e ort-type* (strin
66c0: 67 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 6e 73 70 g->symbol transp
66d0: 6f 72 74 29 29 0a 09 20 20 28 69 66 20 28 6e 6f ort)).. (if (no
66e0: 74 20 74 61 72 67 65 74 29 0a 09 20 20 20 20 20 t target)..
66f0: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
6700: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
6710: 20 2d 74 61 72 67 65 74 20 69 73 20 72 65 71 75 -target is requ
6720: 69 72 65 64 2e 22 29 0a 09 09 28 65 78 69 74 20 ired.")...(exit
6730: 31 29 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 1))).. (if (not
6740: 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 (setup-for-run)
6750: 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ).. (begin.
6760: 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ..(debug:print 0
6770: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
6780: 70 2c 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 p, giving up on
6790: 2d 61 72 63 68 69 76 65 2c 20 65 78 69 74 69 6e -archive, exitin
67a0: 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 g")...(exit 1)))
67b0: 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 .. (let* ((keys
67c0: 20 20 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 (cdb:remote
67d0: 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 79 73 -run db:get-keys
67e0: 20 64 62 29 29 0a 09 09 20 28 6b 65 79 6e 61 6d db))... (keynam
67f0: 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d es (map key:get-
6800: 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 fieldname keys))
6810: 0a 09 09 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 ... ;; DO NOT ru
6820: 6e 20 72 65 6d 6f 74 65 0a 09 09 20 28 70 61 74 n remote... (pat
6830: 68 73 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 hs (db:test-g
6840: 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e et-paths-matchin
6850: 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 g db keynames ta
6860: 72 67 65 74 29 29 29 0a 09 20 20 20 20 28 73 65 rget))).. (se
6870: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
6880: 2a 20 23 74 29 0a 09 20 20 20 20 28 66 6f 72 2d * #t).. (for-
6890: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 each (lambda (pa
68a0: 74 68 29 0a 09 09 09 28 70 72 69 6e 74 20 70 61 th)....(print pa
68b0: 74 68 29 29 0a 09 09 20 20 20 20 20 20 70 61 74 th))... pat
68c0: 68 73 29 29 29 0a 09 3b 3b 20 65 6c 73 65 20 64 hs)))..;; else d
68d0: 6f 20 61 20 67 65 6e 65 72 61 6c 2d 72 75 6e 2d o a general-run-
68e0: 63 61 6c 6c 0a 09 28 67 65 6e 65 72 61 6c 2d 72 call..(general-r
68f0: 75 6e 2d 63 61 6c 6c 20 0a 09 20 22 2d 74 65 73 un-call .. "-tes
6900: 74 2d 70 61 74 68 73 22 0a 09 20 22 47 65 74 20 t-paths".. "Get
6910: 70 61 74 68 73 20 74 6f 20 74 65 73 74 73 22 0a paths to tests".
6920: 09 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 . (lambda (targe
6930: 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
6940: 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 eynames keyvalls
6950: 74 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 64 t).. (let* ((d
6960: 62 20 20 20 20 20 20 20 23 66 29 0a 09 09 20 20 b #f)...
6970: 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 ;; DO NOT run re
6980: 6d 6f 74 65 0a 09 09 20 20 28 70 61 74 68 73 20 mote... (paths
6990: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
69a0: 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 64 paths-matching d
69b0: 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 b keynames targe
69c0: 74 29 29 29 0a 09 20 20 20 20 20 28 66 6f 72 2d t))).. (for-
69d0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 each (lambda (pa
69e0: 74 68 29 0a 09 09 09 20 28 70 72 69 6e 74 20 70 th).... (print p
69f0: 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 20 70 ath))... p
6a00: 61 74 68 73 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d aths))))))..;;==
6a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a50: 3d 3d 3d 3d 0a 3b 3b 20 45 78 74 72 61 63 74 20 ====.;; Extract
6a60: 61 20 73 70 72 65 61 64 73 68 65 65 74 20 66 72 a spreadsheet fr
6a70: 6f 6d 20 74 68 65 20 72 75 6e 73 20 64 61 74 61 om the runs data
6a80: 62 61 73 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d base.;;=========
6a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
6ad0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
6ae0: 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 "-extract-ods")
6af0: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
6b00: 6e 2d 63 61 6c 6c 0a 20 20 20 20 20 22 2d 65 78 n-call. "-ex
6b10: 74 72 61 63 74 2d 6f 64 73 22 0a 20 20 20 20 20 tract-ods".
6b20: 22 4d 61 6b 65 20 6f 64 73 20 73 70 72 65 61 64 "Make ods spread
6b30: 73 68 65 65 74 22 0a 20 20 20 20 20 28 6c 61 6d sheet". (lam
6b40: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
6b50: 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 ame keys keyname
6b60: 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 s keyvallst).
6b70: 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 20 20 (let ((db
6b80: 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 #f)..
6b90: 28 6f 75 74 70 75 74 66 69 6c 65 20 28 61 72 67 (outputfile (arg
6ba0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 s:get-arg "-extr
6bb0: 61 63 74 2d 6f 64 73 22 29 29 0a 09 20 20 20 20 act-ods"))..
6bc0: 20 28 72 75 6e 73 70 61 74 74 20 20 20 28 61 72 (runspatt (ar
6bd0: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
6be0: 6e 61 6d 65 22 29 29 0a 09 20 20 20 20 20 28 70 name")).. (p
6bf0: 61 74 68 6d 6f 64 20 20 20 20 28 61 72 67 73 3a athmod (args:
6c00: 67 65 74 2d 61 72 67 20 22 2d 70 61 74 68 6d 6f get-arg "-pathmo
6c10: 64 22 29 29 0a 09 20 20 20 20 20 28 6b 65 79 76 d")).. (keyv
6c20: 61 6c 61 6c 69 73 74 20 28 6b 65 79 73 2d 3e 61 alalist (keys->a
6c30: 6c 69 73 74 20 6b 65 79 73 20 22 25 22 29 29 29 list keys "%")))
6c40: 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 .. (debug:print
6c50: 32 20 22 45 78 74 72 61 63 74 20 6f 64 73 2c 20 2 "Extract ods,
6c60: 6f 75 74 70 75 74 66 69 6c 65 3a 20 22 20 6f 75 outputfile: " ou
6c70: 74 70 75 74 66 69 6c 65 20 22 20 72 75 6e 73 70 tputfile " runsp
6c80: 61 74 74 3a 20 22 20 72 75 6e 73 70 61 74 74 20 att: " runspatt
6c90: 22 20 6b 65 79 76 61 6c 61 6c 69 73 74 3a 20 22 " keyvalalist: "
6ca0: 20 6b 65 79 76 61 6c 61 6c 69 73 74 29 0a 09 20 keyvalalist)..
6cb0: 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 (cdb:remote-run
6cc0: 64 62 3a 65 78 74 72 61 63 74 2d 6f 64 73 2d 66 db:extract-ods-f
6cd0: 69 6c 65 20 64 62 20 6f 75 74 70 75 74 66 69 6c ile db outputfil
6ce0: 65 20 6b 65 79 76 61 6c 61 6c 69 73 74 20 28 69 e keyvalalist (i
6cf0: 66 20 72 75 6e 73 70 61 74 74 20 72 75 6e 73 70 f runspatt runsp
6d00: 61 74 74 20 22 25 22 29 20 70 61 74 68 6d 6f 64 att "%") pathmod
6d10: 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d )))))..;;=======
6d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
6d60: 3b 3b 20 65 78 65 63 75 74 65 20 74 68 65 20 74 ;; execute the t
6d70: 65 73 74 0a 3b 3b 20 20 20 20 2d 20 67 65 74 73 est.;; - gets
6d80: 20 63 61 6c 6c 65 64 20 6f 6e 20 72 65 6d 6f 74 called on remot
6d90: 65 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 72 e host.;; - r
6da0: 65 63 65 69 76 65 73 20 69 6e 66 6f 20 66 72 6f eceives info fro
6db0: 6d 20 74 68 65 20 2d 65 78 65 63 75 74 65 20 70 m the -execute p
6dc0: 61 72 61 6d 0a 3b 3b 20 20 20 20 2d 20 70 61 73 aram.;; - pas
6dd0: 73 65 73 20 69 6e 66 6f 20 74 6f 20 73 74 65 70 ses info to step
6de0: 73 20 76 69 61 20 4d 54 5f 43 4d 44 49 4e 46 4f s via MT_CMDINFO
6df0: 20 65 6e 76 20 76 61 72 20 28 66 75 74 75 72 65 env var (future
6e00: 20 69 73 20 74 6f 20 75 73 65 20 61 20 64 6f 74 is to use a dot
6e10: 20 66 69 6c 65 29 0a 3b 3b 20 20 20 20 2d 20 67 file).;; - g
6e20: 61 74 68 65 72 73 20 68 6f 73 74 20 69 6e 66 6f athers host info
6e30: 20 61 6e 64 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d and .;;========
6e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
6e80: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
6e90: 67 20 22 2d 65 78 65 63 75 74 65 22 29 0a 20 20 g "-execute").
6ea0: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
6eb0: 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 28 launch:execute (
6ec0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
6ed0: 78 65 63 75 74 65 22 29 29 0a 20 20 20 20 20 20 xecute")).
6ee0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
6ef0: 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d ing* #t)))..;;==
6f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f40: 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 20 63 6f 6d ====.;; Test com
6f50: 6d 61 6e 64 73 20 28 69 2e 65 2e 20 66 6f 72 20 mands (i.e. for
6f60: 75 73 65 20 69 6e 73 69 64 65 20 74 65 73 74 73 use inside tests
6f70: 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ).;;============
6f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f90: 3d 3d 3d 3d 3d 3d 3d 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 0a 0a 28 64 65 66 ==========..(def
6fc0: 69 6e 65 20 28 6d 65 67 61 74 65 73 74 3a 73 74 ine (megatest:st
6fd0: 65 70 20 73 74 65 70 20 73 74 61 74 65 20 73 74 ep step state st
6fe0: 61 74 75 73 20 6c 6f 67 66 69 6c 65 20 6d 73 67 atus logfile msg
6ff0: 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 ). (if (not (ge
7000: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
7010: 22 29 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e ")). (begin
7020: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ..(debug:print 0
7030: 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 "ERROR: MT_CMDI
7040: 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 NFO env var not
7050: 73 65 74 2c 20 2d 73 74 65 70 20 6d 75 73 74 20 set, -step must
7060: 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 64 be called *insid
7070: 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 69 6e e* a megatest in
7080: 76 6f 6b 65 64 20 65 6e 76 69 72 6f 6e 6d 65 6e voked environmen
7090: 74 21 22 29 0a 09 28 65 78 69 74 20 35 29 29 0a t!")..(exit 5)).
70a0: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6d (let* ((cm
70b0: 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 6f dinfo (read (o
70c0: 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 pen-input-string
70d0: 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d (base64:base64-
70e0: 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 22 decode (getenv "
70f0: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 MT_CMDINFO")))))
7100: 0a 09 20 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 .. ;; (runre
7110: 6d 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 66 61 mote (assoc/defa
7120: 75 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 ult 'runremote c
7130: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 mdinfo)).. (
7140: 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 transport (assoc
7150: 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 /default 'transp
7160: 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ort cmdinfo))..
7170: 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 (testpath (
7180: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
7190: 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
71a0: 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 2d 6e )).. (test-n
71b0: 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ame (assoc/defau
71c0: 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d lt 'test-name cm
71d0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 dinfo)).. (r
71e0: 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f unscript (assoc/
71f0: 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 default 'runscri
7200: 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 pt cmdinfo))..
7210: 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 (db-host (a
7220: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 ssoc/default 'db
7230: 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 -host cmdinfo)
7240: 29 0a 09 20 20 20 20 20 28 72 75 6e 2d 69 64 20 ).. (run-id
7250: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
7260: 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 t 'run-id cmd
7270: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 info)).. (te
7280: 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 st-id (assoc/d
7290: 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 efault 'test-id
72a0: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
72b0: 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
72c0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
72d0: 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
72e0: 0a 09 20 20 20 20 20 28 64 62 20 20 20 20 20 20 .. (db
72f0: 20 20 23 66 29 29 0a 09 28 63 68 61 6e 67 65 2d #f))..(change-
7300: 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 directory testpa
7310: 74 68 29 0a 09 3b 3b 20 28 73 65 74 21 20 2a 72 th)..;; (set! *r
7320: 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e 72 65 6d unremote* runrem
7330: 6f 74 65 29 0a 09 28 73 65 74 21 20 2a 74 72 61 ote)..(set! *tra
7340: 6e 73 70 6f 72 74 2d 74 79 70 65 2a 20 28 73 74 nsport-type* (st
7350: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 ring->symbol tra
7360: 6e 73 70 6f 72 74 29 29 0a 09 28 69 66 20 28 6e nsport))..(if (n
7370: 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 ot (setup-for-ru
7380: 6e 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a n)).. (begin.
7390: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
73a0: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f int 0 "Failed to
73b0: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
73c0: 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 20 31 ).. (exit 1
73d0: 29 29 29 0a 09 28 69 66 20 28 61 6e 64 20 73 74 )))..(if (and st
73e0: 61 74 65 20 73 74 61 74 75 73 29 0a 09 20 20 20 ate status)..
73f0: 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 65 6d 6f 74 ;; DO NOT remot
7400: 65 20 72 75 6e 0a 09 20 20 20 20 28 64 62 3a 74 e run.. (db:t
7410: 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 eststep-set-stat
7420: 75 73 21 20 64 62 20 74 65 73 74 2d 69 64 20 73 us! db test-id s
7430: 74 65 70 20 73 74 61 74 65 20 73 74 61 74 75 73 tep state status
7440: 20 6d 73 67 20 6c 6f 67 66 69 6c 65 29 0a 09 20 msg logfile)..
7450: 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
7460: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
7470: 22 45 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 "ERROR: You must
7480: 20 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 specify :state
7490: 61 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 and :status with
74a0: 20 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d every call to -
74b0: 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 28 65 step").. (e
74c0: 78 69 74 20 36 29 29 29 29 29 29 0a 0a 28 69 66 xit 6))))))..(if
74d0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
74e0: 2d 73 74 65 70 22 29 0a 20 20 20 20 28 62 65 67 -step"). (beg
74f0: 69 6e 0a 20 20 20 20 20 20 28 6d 65 67 61 74 65 in. (megate
7500: 73 74 3a 73 74 65 70 20 0a 20 20 20 20 20 20 20 st:step .
7510: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7520: 73 74 65 70 22 29 0a 20 20 20 20 20 20 20 28 61 step"). (a
7530: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
7540: 61 74 65 22 29 0a 20 20 20 20 20 20 20 28 61 72 ate"). (ar
7550: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
7560: 74 75 73 22 29 0a 20 20 20 20 20 20 20 28 61 72 tus"). (ar
7570: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
7580: 6c 6f 67 22 29 0a 20 20 20 20 20 20 20 28 61 72 log"). (ar
7590: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
75a0: 29 0a 20 20 20 20 20 20 3b 3b 20 28 69 66 20 64 ). ;; (if d
75b0: 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c b (sqlite3:final
75c0: 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 20 20 ize! db)).
75d0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
75e0: 69 6e 67 2a 20 23 74 29 29 29 0a 20 20 20 20 0a ing* #t))). .
75f0: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
7600: 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 t-arg "-setlog")
7610: 20 20 20 20 20 20 20 3b 3b 20 73 69 6e 63 65 20 ;; since
7620: 73 65 74 74 69 6e 67 20 75 70 20 69 73 20 73 6f setting up is so
7630: 20 63 6f 73 74 6c 79 20 6c 65 74 73 20 70 69 67 costly lets pig
7640: 67 79 62 61 63 6b 20 6f 6e 20 2d 74 65 73 74 2d gyback on -test-
7650: 73 74 61 74 75 73 0a 09 28 61 72 67 73 3a 67 65 status..(args:ge
7660: 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c t-arg "-set-topl
7670: 6f 67 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d og")..(args:get-
7680: 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 arg "-test-statu
7690: 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 s")..(args:get-a
76a0: 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 rg "-set-values"
76b0: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
76c0: 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 "-load-test-dat
76d0: 61 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 a")..(args:get-a
76e0: 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 rg "-runstep")..
76f0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7700: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 summarize-items"
7710: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 )). (if (not
7720: 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (getenv "MT_CMDI
7730: 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 NFO"))..(begin..
7740: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
7750: 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 "ERROR: MT_CMDI
7760: 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 NFO env var not
7770: 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 set, commands -t
7780: 65 73 74 2d 73 74 61 74 75 73 2c 20 2d 72 75 6e est-status, -run
7790: 73 74 65 70 20 61 6e 64 20 2d 73 65 74 6c 6f 67 step and -setlog
77a0: 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 20 must be called
77b0: 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 74 *inside* a megat
77c0: 65 73 74 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 est environment!
77d0: 22 29 0a 09 20 20 28 65 78 69 74 20 35 29 29 0a ").. (exit 5)).
77e0: 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e .(let* ((startin
77f0: 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 gdir (current-di
7800: 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 rectory))..
7810: 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 (cmdinfo (re
7820: 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 ad (open-input-s
7830: 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 tring (base64:ba
7840: 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 74 se64-decode (get
7850: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
7860: 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b ))))).. ;;
7870: 20 28 72 75 6e 72 65 6d 6f 74 65 20 28 61 73 73 (runremote (ass
7880: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 72 oc/default 'runr
7890: 65 6d 6f 74 65 20 63 6d 64 69 6e 66 6f 29 29 0a emote cmdinfo)).
78a0: 09 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f . (transpo
78b0: 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c rt (assoc/defaul
78c0: 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 t 'transport cmd
78d0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
78e0: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
78f0: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
7900: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
7910: 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
7920: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
7930: 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
7940: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
7950: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
7960: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
7970: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
7980: 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 (db-host (
7990: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 assoc/default 'd
79a0: 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f b-host cmdinfo
79b0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
79c0: 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 id (assoc/def
79d0: 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 ault 'run-id
79e0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
79f0: 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 73 (test-id (as
7a00: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
7a10: 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 t-id cmdinfo))
7a20: 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 .. (itemda
7a30: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
7a40: 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d lt 'itemdat cm
7a50: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
7a60: 28 64 62 20 20 20 20 20 20 20 20 23 66 29 20 3b (db #f) ;
7a70: 3b 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 20 20 ; (open-db))..
7a80: 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 20 (state
7a90: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
7aa0: 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 state"))..
7ab0: 20 28 73 74 61 74 75 73 20 20 20 20 28 61 72 67 (status (arg
7ac0: 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
7ad0: 75 73 22 29 29 29 0a 09 20 20 28 63 68 61 6e 67 us"))).. (chang
7ae0: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test
7af0: 70 61 74 68 29 0a 09 20 20 3b 3b 20 28 73 65 74 path).. ;; (set
7b00: 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 ! *runremote* ru
7b10: 6e 72 65 6d 6f 74 65 29 0a 09 20 20 28 73 65 74 nremote).. (set
7b20: 21 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 ! *transport-typ
7b30: 65 2a 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 e* (string->symb
7b40: 6f 6c 20 74 72 61 6e 73 70 6f 72 74 29 29 0a 09 ol transport))..
7b50: 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 (if (not (setu
7b60: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 p-for-run))..
7b70: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 (begin...(deb
7b80: 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c ug:print 0 "Fail
7b90: 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
7ba0: 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 ting")...(exit 1
7bb0: 29 29 29 0a 0a 09 20 20 3b 3b 20 63 61 6e 20 73 )))... ;; can s
7bc0: 65 74 75 70 20 61 73 20 63 6c 69 65 6e 74 20 66 etup as client f
7bd0: 6f 72 20 73 65 72 76 65 72 20 6d 6f 64 65 20 6e or server mode n
7be0: 6f 77 0a 09 20 20 3b 3b 20 28 63 6c 69 65 6e 74 ow.. ;; (client
7bf0: 3a 73 65 74 75 70 29 0a 0a 09 20 20 28 69 66 20 :setup)... (if
7c00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7c10: 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 load-test-data")
7c20: 0a 09 20 20 20 20 20 20 3b 3b 20 68 61 73 20 73 .. ;; has s
7c30: 75 62 20 63 6f 6d 6d 61 6e 64 73 20 74 68 61 74 ub commands that
7c40: 20 61 72 65 20 72 64 62 3a 0a 09 20 20 20 20 20 are rdb:..
7c50: 20 3b 3b 20 44 4f 20 4e 4f 54 20 70 75 74 20 74 ;; DO NOT put t
7c60: 68 69 73 20 6f 6e 65 20 69 6e 74 6f 20 65 69 74 his one into eit
7c70: 68 65 72 20 63 64 62 3a 72 65 6d 6f 74 65 2d 72 her cdb:remote-r
7c80: 75 6e 20 6f 72 20 6f 70 65 6e 2d 72 75 6e 2d 63 un or open-run-c
7c90: 6c 6f 73 65 0a 09 20 20 20 20 20 20 28 64 62 3a lose.. (db:
7ca0: 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 20 64 load-test-data d
7cb0: 62 20 74 65 73 74 2d 69 64 29 29 0a 09 20 20 28 b test-id)).. (
7cc0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
7cd0: 20 22 2d 73 65 74 6c 6f 67 22 29 0a 09 20 20 20 "-setlog")..
7ce0: 20 20 20 28 6c 65 74 20 28 28 6c 6f 67 66 6e 61 (let ((logfna
7cf0: 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 me (args:get-arg
7d00: 20 22 2d 73 65 74 6c 6f 67 22 29 29 29 0a 09 09 "-setlog")))...
7d10: 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 6c 6f (cdb:test-set-lo
7d20: 67 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 g! *runremote* t
7d30: 65 73 74 2d 69 64 20 6c 6f 67 66 6e 61 6d 65 29 est-id logfname)
7d40: 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a )).. (if (args:
7d50: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f get-arg "-set-to
7d60: 70 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 3b 3b plog").. ;;
7d70: 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f DO NOT run remo
7d80: 74 65 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 te.. (tests
7d90: 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 :test-set-toplog
7da0: 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 ! db run-id test
7db0: 2d 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d -name (args:get-
7dc0: 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 arg "-set-toplog
7dd0: 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 "))).. (if (arg
7de0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d 6d s:get-arg "-summ
7df0: 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 0a 09 20 arize-items")..
7e00: 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 ;; DO NOT r
7e10: 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 20 20 un remote..
7e20: 20 28 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a (tests:summariz
7e30: 65 2d 69 74 65 6d 73 20 64 62 20 72 75 6e 2d 69 e-items db run-i
7e40: 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 74 29 29 d test-name #t))
7e50: 20 3b 3b 20 64 6f 20 66 6f 72 63 65 20 68 65 72 ;; do force her
7e60: 65 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 e.. (if (args:g
7e70: 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 et-arg "-runstep
7e80: 22 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e ").. (if (n
7e90: 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 0a 09 09 ull? remargs)...
7ea0: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 (begin... (
7eb0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
7ec0: 52 52 4f 52 3a 20 6e 6f 74 68 69 6e 67 20 73 70 RROR: nothing sp
7ed0: 65 63 69 66 69 65 64 20 74 6f 20 72 75 6e 21 22 ecified to run!"
7ee0: 29 0a 09 09 20 20 20 20 28 69 66 20 64 62 20 28 )... (if db (
7ef0: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
7f00: 21 20 64 62 29 29 0a 09 09 20 20 20 20 28 65 78 ! db))... (ex
7f10: 69 74 20 36 29 29 0a 09 09 20 20 28 6c 65 74 2a it 6))... (let*
7f20: 20 28 28 73 74 65 70 6e 61 6d 65 20 20 20 28 61 ((stepname (a
7f30: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
7f40: 6e 73 74 65 70 22 29 29 0a 09 09 09 20 28 6c 6f nstep")).... (lo
7f50: 67 70 72 6f 66 69 6c 65 20 28 61 72 67 73 3a 67 gprofile (args:g
7f60: 65 74 2d 61 72 67 20 22 2d 6c 6f 67 70 72 6f 22 et-arg "-logpro"
7f70: 29 29 0a 09 09 09 20 28 6c 6f 67 66 69 6c 65 20 )).... (logfile
7f80: 20 20 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d (conc stepnam
7f90: 65 20 22 2e 6c 6f 67 22 29 29 0a 09 09 09 20 28 e ".log")).... (
7fa0: 63 6d 64 20 20 20 20 20 20 20 20 28 69 66 20 28 cmd (if (
7fb0: 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 23 null? remargs) #
7fc0: 66 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 f (car remargs))
7fd0: 29 0a 09 09 09 20 28 70 61 72 61 6d 73 20 20 20 ).... (params
7fe0: 20 20 28 69 66 20 63 6d 64 20 28 63 64 72 20 72 (if cmd (cdr r
7ff0: 65 6d 61 72 67 73 29 20 27 28 29 29 29 0a 09 09 emargs) '()))...
8000: 09 20 28 65 78 69 74 73 74 61 74 20 20 20 23 66 . (exitstat #f
8010: 29 0a 09 09 09 20 28 73 68 65 6c 6c 20 20 20 20 ).... (shell
8020: 20 20 28 6c 61 73 74 20 28 73 74 72 69 6e 67 2d (last (string-
8030: 73 70 6c 69 74 20 28 67 65 74 2d 65 6e 76 69 72 split (get-envir
8040: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
8050: 22 53 48 45 4c 4c 22 29 20 22 2f 22 29 29 29 0a "SHELL") "/"))).
8060: 09 09 09 20 28 72 65 64 69 72 20 20 20 20 20 20 ... (redir
8070: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
8080: 79 6d 62 6f 6c 20 73 68 65 6c 6c 29 0a 09 09 09 ymbol shell)....
8090: 09 20 20 20 20 20 20 20 28 28 74 63 73 68 20 63 . ((tcsh c
80a0: 73 68 20 6b 73 68 29 20 20 20 20 22 3e 26 22 29 sh ksh) ">&")
80b0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 7a 73 ..... ((zs
80c0: 68 20 62 61 73 68 20 73 68 20 61 73 68 29 20 22 h bash sh ash) "
80d0: 32 3e 26 31 20 3e 22 29 0a 09 09 09 09 20 20 20 2>&1 >").....
80e0: 20 20 20 20 28 65 6c 73 65 20 22 3e 26 22 29 29 (else ">&"))
80f0: 29 0a 09 09 09 20 28 66 75 6c 6c 63 6d 64 20 20 ).... (fullcmd
8100: 20 20 28 63 6f 6e 63 20 22 28 22 20 28 73 74 72 (conc "(" (str
8110: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
8120: 0a 09 09 09 09 09 09 28 63 6f 6e 73 20 63 6d 64 .......(cons cmd
8130: 20 70 61 72 61 6d 73 29 20 22 20 22 29 0a 09 09 params) " ")...
8140: 09 09 09 20 20 20 22 29 20 22 20 72 65 64 69 72 ... ") " redir
8150: 20 22 20 22 20 6c 6f 67 66 69 6c 65 29 29 29 0a " " logfile))).
8160: 09 09 20 20 20 20 3b 3b 20 6d 61 72 6b 20 74 68 .. ;; mark th
8170: 65 20 73 74 61 72 74 20 6f 66 20 74 68 65 20 74 e start of the t
8180: 65 73 74 0a 09 09 20 20 20 20 3b 3b 20 44 4f 20 est... ;; DO
8190: 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 NOT run remote..
81a0: 09 20 20 20 20 28 64 62 3a 74 65 73 74 73 74 65 . (db:testste
81b0: 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 p-set-status! db
81c0: 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d test-id stepnam
81d0: 65 20 22 73 74 61 72 74 22 20 22 6e 2f 61 22 20 e "start" "n/a"
81e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
81f0: 6d 22 29 20 6c 6f 67 66 69 6c 65 29 0a 09 09 20 m") logfile)...
8200: 20 20 20 3b 3b 20 72 75 6e 20 74 68 65 20 74 65 ;; run the te
8210: 73 74 20 73 74 65 70 0a 09 09 20 20 20 20 28 64 st step... (d
8220: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
8230: 32 20 22 52 75 6e 6e 69 6e 67 20 5c 22 22 20 66 2 "Running \"" f
8240: 75 6c 6c 63 6d 64 20 22 5c 22 22 29 0a 09 09 20 ullcmd "\"")...
8250: 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 (change-direc
8260: 74 6f 72 79 20 73 74 61 72 74 69 6e 67 64 69 72 tory startingdir
8270: 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 65 78 )... (set! ex
8280: 69 74 73 74 61 74 20 28 73 79 73 74 65 6d 20 66 itstat (system f
8290: 75 6c 6c 63 6d 64 29 29 20 3b 3b 20 63 6d 64 20 ullcmd)) ;; cmd
82a0: 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20 20 28 params))... (
82b0: 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 set! *globalexit
82c0: 73 74 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 status* exitstat
82d0: 29 0a 09 09 20 20 20 20 28 63 68 61 6e 67 65 2d )... (change-
82e0: 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 directory testpa
82f0: 74 68 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e th)... ;; run
8300: 20 6c 6f 67 70 72 6f 20 69 66 20 61 70 70 6c 69 logpro if appli
8310: 63 61 62 6c 65 20 3b 3b 20 28 70 72 6f 63 65 73 cable ;; (proces
8320: 73 2d 72 75 6e 20 22 6c 73 22 20 28 6c 69 73 74 s-run "ls" (list
8330: 20 22 2f 66 6f 6f 22 20 22 32 3e 26 31 22 20 22 "/foo" "2>&1" "
8340: 62 6c 61 68 2e 6c 6f 67 22 29 29 0a 09 09 20 20 blah.log"))...
8350: 20 20 28 69 66 20 6c 6f 67 70 72 6f 66 69 6c 65 (if logprofile
8360: 0a 09 09 09 28 6c 65 74 2a 20 28 28 68 74 6d 6c ....(let* ((html
8370: 6c 6f 67 66 69 6c 65 20 28 63 6f 6e 63 20 73 74 logfile (conc st
8380: 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 epname ".html"))
8390: 0a 09 09 09 20 20 20 20 20 20 20 28 6f 6c 64 65 .... (olde
83a0: 78 69 74 73 74 61 74 20 65 78 69 74 73 74 61 74 xitstat exitstat
83b0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 63 6d 64 ).... (cmd
83c0: 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 (string
83d0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6c 69 -intersperse (li
83e0: 73 74 20 22 6c 6f 67 70 72 6f 22 20 6c 6f 67 70 st "logpro" logp
83f0: 72 6f 66 69 6c 65 20 68 74 6d 6c 6c 6f 67 66 69 rofile htmllogfi
8400: 6c 65 20 22 3c 22 20 6c 6f 67 66 69 6c 65 20 22 le "<" logfile "
8410: 3e 22 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d >" (conc stepnam
8420: 65 20 22 5f 6c 6f 67 70 72 6f 2e 6c 6f 67 22 29 e "_logpro.log")
8430: 29 20 22 20 22 29 29 29 0a 09 09 09 20 20 28 64 ) " "))).... (d
8440: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
8450: 32 20 22 72 75 6e 6e 69 6e 67 20 5c 22 22 20 63 2 "running \"" c
8460: 6d 64 20 22 5c 22 22 29 0a 09 09 09 20 20 28 63 md "\"").... (c
8470: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
8480: 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 09 09 startingdir)....
8490: 20 20 28 73 65 74 21 20 65 78 69 74 73 74 61 74 (set! exitstat
84a0: 20 28 73 79 73 74 65 6d 20 63 6d 64 29 29 0a 09 (system cmd))..
84b0: 09 09 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 .. (set! *globa
84c0: 6c 65 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 lexitstatus* exi
84d0: 74 73 74 61 74 29 20 3b 3b 20 6e 6f 20 6e 65 63 tstat) ;; no nec
84e0: 65 73 73 61 72 79 0a 09 09 09 20 20 28 63 68 61 essary.... (cha
84f0: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 nge-directory te
8500: 73 74 70 61 74 68 29 0a 09 09 09 20 20 28 63 64 stpath).... (cd
8510: 62 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 b:test-set-log!
8520: 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 73 74 *runremote* test
8530: 2d 69 64 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 29 -id htmllogfile)
8540: 29 29 0a 09 09 20 20 20 20 28 6c 65 74 20 28 28 ))... (let ((
8550: 6d 73 67 20 28 61 72 67 73 3a 67 65 74 2d 61 72 msg (args:get-ar
8560: 67 20 22 2d 6d 22 29 29 29 0a 09 09 20 20 20 20 g "-m")))...
8570: 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 ;; DO NOT run
8580: 72 65 6d 6f 74 65 0a 09 09 20 20 20 20 20 20 28 remote... (
8590: 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d db:teststep-set-
85a0: 73 74 61 74 75 73 21 20 64 62 20 74 65 73 74 2d status! db test-
85b0: 69 64 20 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 id stepname "end
85c0: 22 20 65 78 69 74 73 74 61 74 20 6d 73 67 20 6c " exitstat msg l
85d0: 6f 67 66 69 6c 65 29 29 0a 09 09 20 20 20 20 29 ogfile))... )
85e0: 29 29 0a 09 20 20 28 69 66 20 28 6f 72 20 28 61 )).. (if (or (a
85f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
8600: 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 20 20 st-status")...
8610: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8620: 73 65 74 2d 76 61 6c 75 65 73 22 29 29 0a 09 20 set-values"))..
8630: 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 73 (let ((news
8640: 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 tatus (cond.....
8650: 28 28 6e 75 6d 62 65 72 3f 20 73 74 61 74 75 73 ((number? status
8660: 29 20 20 20 20 20 20 20 28 69 66 20 28 65 71 75 ) (if (equ
8670: 61 6c 3f 20 73 74 61 74 75 73 20 30 29 20 22 50 al? status 0) "P
8680: 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 09 ASS" "FAIL"))...
8690: 09 09 28 28 61 6e 64 20 28 73 74 72 69 6e 67 3f ..((and (string?
86a0: 20 73 74 61 74 75 73 29 0a 09 09 09 09 20 20 20 status).....
86b0: 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 (string->numb
86c0: 65 72 20 73 74 61 74 75 73 29 29 28 69 66 20 28 er status))(if (
86d0: 65 71 75 61 6c 3f 20 28 73 74 72 69 6e 67 2d 3e equal? (string->
86e0: 6e 75 6d 62 65 72 20 73 74 61 74 75 73 29 20 30 number status) 0
86f0: 29 20 22 50 41 53 53 22 20 22 46 41 49 4c 22 29 ) "PASS" "FAIL")
8700: 29 0a 09 09 09 09 28 65 6c 73 65 20 73 74 61 74 ).....(else stat
8710: 75 73 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 74 us)))... ;; t
8720: 72 61 6e 73 66 65 72 20 72 65 6c 65 76 61 6e 74 ransfer relevant
8730: 20 6b 65 79 73 20 69 6e 74 6f 20 61 20 68 61 73 keys into a has
8740: 68 20 74 6f 20 62 65 20 70 61 73 73 65 64 20 74 h to be passed t
8750: 6f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 o test-set-statu
8760: 73 21 0a 09 09 20 20 20 20 3b 3b 20 63 6f 75 6c s!... ;; coul
8770: 64 20 75 73 65 20 61 6e 20 61 73 73 6f 63 20 6c d use an assoc l
8780: 69 73 74 20 49 20 67 75 65 73 73 2e 20 0a 09 09 ist I guess. ...
8790: 20 20 20 20 28 6f 74 68 65 72 64 61 74 61 20 28 (otherdata (
87a0: 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 2d let ((res (make-
87b0: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 hash-table)))...
87c0: 09 09 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 .. (for-each (la
87d0: 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 09 09 mbda (key)......
87e0: 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 (if (args:g
87f0: 65 74 2d 61 72 67 20 6b 65 79 29 0a 09 09 09 09 et-arg key).....
8800: 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 .. (hash-table-s
8810: 65 74 21 20 72 65 73 20 6b 65 79 20 28 61 72 67 et! res key (arg
8820: 73 3a 67 65 74 2d 61 72 67 20 6b 65 79 29 29 29 s:get-arg key)))
8830: 29 0a 09 09 09 09 09 20 20 20 28 6c 69 73 74 20 )...... (list
8840: 22 3a 76 61 6c 75 65 22 20 22 3a 74 6f 6c 22 20 ":value" ":tol"
8850: 22 3a 65 78 70 65 63 74 65 64 22 20 22 3a 66 69 ":expected" ":fi
8860: 72 73 74 5f 65 72 72 22 20 22 3a 66 69 72 73 74 rst_err" ":first
8870: 5f 77 61 72 6e 22 20 22 3a 75 6e 69 74 73 22 20 _warn" ":units"
8880: 22 3a 63 61 74 65 67 6f 72 79 22 20 22 3a 76 61 ":category" ":va
8890: 72 69 61 62 6c 65 22 29 29 0a 09 09 09 09 20 72 riable"))..... r
88a0: 65 73 29 29 29 0a 09 09 28 69 66 20 28 61 6e 64 es)))...(if (and
88b0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
88c0: 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a 09 -test-status")..
88d0: 09 09 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 .. (or (not stat
88e0: 65 29 0a 09 09 09 20 20 20 20 20 28 6e 6f 74 20 e).... (not
88f0: 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 20 20 status)))...
8900: 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 28 (begin... (
8910: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
8920: 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 20 73 RROR: You must s
8930: 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 6e pecify :state an
8940: 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 65 d :status with e
8950: 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 74 65 very call to -te
8960: 73 74 2d 73 74 61 74 75 73 5c 6e 22 20 68 65 6c st-status\n" hel
8970: 70 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 28 73 p)... ;; (s
8980: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
8990: 20 64 62 29 0a 09 09 20 20 20 20 20 20 28 65 78 db)... (ex
89a0: 69 74 20 36 29 29 29 0a 09 09 28 6c 65 74 2a 20 it 6)))...(let*
89b0: 28 28 6d 73 67 20 20 20 20 28 61 72 67 73 3a 67 ((msg (args:g
89c0: 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 et-arg "-m"))...
89d0: 20 20 20 20 20 20 20 28 6e 75 6d 6f 74 68 20 28 (numoth (
89e0: 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 length (hash-tab
89f0: 6c 65 2d 6b 65 79 73 20 6f 74 68 65 72 64 61 74 le-keys otherdat
8a00: 61 29 29 29 29 0a 09 09 20 20 3b 3b 20 43 6f 6e a))))... ;; Con
8a10: 76 65 72 74 20 74 6f 20 72 70 63 20 69 6e 73 69 vert to rpc insi
8a20: 64 65 20 74 68 65 20 74 65 73 74 73 3a 74 65 73 de the tests:tes
8a30: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 63 61 t-set-status! ca
8a40: 6c 6c 2c 20 6e 6f 74 20 68 65 72 65 0a 09 09 20 ll, not here...
8a50: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 (tests:test-set
8a60: 2d 73 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 -status! test-id
8a70: 20 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 state newstatus
8a80: 20 6d 73 67 20 6f 74 68 65 72 64 61 74 61 29 29 msg otherdata))
8a90: 29 29 0a 09 20 20 28 69 66 20 64 62 20 28 73 71 )).. (if db (sq
8aa0: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
8ab0: 64 62 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 db)).. (set! *d
8ac0: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
8ad0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
8ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
8b20: 20 56 61 72 69 6f 75 73 20 68 65 6c 70 65 72 20 Various helper
8b30: 63 6f 6d 6d 61 6e 64 73 20 63 61 6e 20 67 6f 20 commands can go
8b40: 62 65 6c 6f 77 20 68 65 72 65 0a 3b 3b 3d 3d 3d below here.;;===
8b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8b90: 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
8ba0: 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 6b 65 79 et-arg "-showkey
8bb0: 73 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 64 s"). (let ((d
8bc0: 62 20 23 66 29 0a 09 20 20 28 6b 65 79 73 20 23 b #f).. (keys #
8bd0: 66 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e f)). (if (n
8be0: 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 ot (setup-for-ru
8bf0: 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 n)).. (begin..
8c00: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
8c10: 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 0 "Failed to set
8c20: 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 up, exiting")..
8c30: 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))).
8c40: 20 20 20 20 28 73 65 74 21 20 6b 65 79 73 20 28 (set! keys (
8c50: 63 62 64 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 cbd:remote-run d
8c60: 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a b:get-keys db)).
8c70: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
8c80: 6e 74 20 31 20 22 4b 65 79 73 3a 20 22 20 28 73 nt 1 "Keys: " (s
8c90: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
8ca0: 65 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 e (map key:get-f
8cb0: 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 20 22 ieldname keys) "
8cc0: 2c 20 22 29 29 0a 20 20 20 20 20 20 28 69 66 20 , ")). (if
8cd0: 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 db (sqlite3:fina
8ce0: 6c 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 20 lize! db)).
8cf0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
8d00: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 hing* #t)))..(if
8d10: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8d20: 2d 67 75 69 22 29 0a 20 20 20 20 28 62 65 67 69 -gui"). (begi
8d30: 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 n. (debug:p
8d40: 72 69 6e 74 20 30 20 22 4c 6f 6f 6b 20 61 74 20 rint 0 "Look at
8d50: 74 68 65 20 64 61 73 68 62 6f 61 72 64 20 66 6f the dashboard fo
8d60: 72 20 6e 6f 77 22 29 0a 20 20 20 20 20 20 3b 3b r now"). ;;
8d70: 20 28 6d 65 67 61 74 65 73 74 2d 67 75 69 29 0a (megatest-gui).
8d80: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
8d90: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
8da0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
8db0: 61 72 67 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 arg "-gen-megate
8dc0: 73 74 2d 61 72 65 61 22 29 0a 20 20 20 20 28 62 st-area"). (b
8dd0: 65 67 69 6e 0a 20 20 20 20 20 20 28 67 65 6e 65 egin. (gene
8de0: 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 65 xample:mk-megate
8df0: 73 74 2e 63 6f 6e 66 69 67 29 0a 20 20 20 20 20 st.config).
8e00: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
8e10: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 hing* #t)))..(if
8e20: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8e30: 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 -gen-megatest-te
8e40: 73 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 st"). (let ((
8e50: 74 65 73 74 6e 61 6d 65 20 28 61 72 67 73 3a 67 testname (args:g
8e60: 65 74 2d 61 72 67 20 22 2d 67 65 6e 2d 6d 65 67 et-arg "-gen-meg
8e70: 61 74 65 73 74 2d 74 65 73 74 22 29 29 29 0a 20 atest-test"))).
8e80: 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 (genexample
8e90: 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 :mk-megatest-tes
8ea0: 74 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 20 20 t testname).
8eb0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
8ec0: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
8ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f10: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 ======.;; Update
8f20: 20 74 68 65 20 64 61 74 61 62 61 73 65 20 73 63 the database sc
8f30: 68 65 6d 61 20 6f 6e 20 72 65 71 75 65 73 74 0a hema on request.
8f40: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
8f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f80: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
8f90: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
8fa0: 62 75 69 6c 64 2d 64 62 22 29 0a 20 20 20 20 28 build-db"). (
8fb0: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 begin. (if
8fc0: 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d (not (setup-for-
8fd0: 72 75 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a run)).. (begin.
8fe0: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
8ff0: 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 t 0 "Failed to s
9000: 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 etup, exiting")
9010: 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 .. (exit 1)))
9020: 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 . ;; keep t
9030: 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 his one local.
9040: 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c (open-run-cl
9050: 6f 73 65 20 70 61 74 63 68 2d 64 62 20 23 66 29 ose patch-db #f)
9060: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
9070: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
9080: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
9090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 ===========.;; U
90d0: 70 64 61 74 65 20 74 68 65 20 74 65 73 74 73 20 pdate the tests
90e0: 6d 65 74 61 20 64 61 74 61 20 66 72 6f 6d 20 74 meta data from t
90f0: 68 65 20 74 65 73 74 63 6f 6e 66 69 67 20 66 69 he testconfig fi
9100: 6c 65 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d les.;;==========
9110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
9150: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
9160: 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 22 29 0a "-update-meta").
9170: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
9180: 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 (if (not (setup
9190: 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 62 -for-run)).. (b
91a0: 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 egin.. (debug
91b0: 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 :print 0 "Failed
91c0: 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 to setup, exiti
91d0: 6e 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 ng") .. (exit
91e0: 20 31 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6e 1))). ;; n
91f0: 6f 77 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 ow can find our
9200: 64 62 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 db. ;; keep
9210: 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a this one local.
9220: 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d (open-run-
9230: 63 6c 6f 73 65 20 72 75 6e 73 3a 75 70 64 61 74 close runs:updat
9240: 65 2d 61 6c 6c 2d 74 65 73 74 5f 6d 65 74 61 20 e-all-test_meta
9250: 64 62 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 db). (set!
9260: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
9270: 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
9280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
92c0: 3b 20 53 74 61 72 74 20 61 20 72 65 70 6c 0a 3b ; Start a repl.;
92d0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
92e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9310: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 =======..(if (or
9320: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9330: 2d 72 65 70 6c 22 29 0a 09 28 61 72 67 73 3a 67 -repl")..(args:g
9340: 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 et-arg "-load"))
9350: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 . (let* ((top
9360: 70 61 74 68 20 28 73 65 74 75 70 2d 66 6f 72 2d path (setup-for-
9370: 72 75 6e 29 29 0a 09 20 20 20 28 64 62 20 20 20 run)).. (db
9380: 20 20 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 (if toppath (
9390: 6f 70 65 6e 2d 64 62 29 20 23 66 29 29 29 0a 20 open-db) #f))).
93a0: 20 20 20 20 20 28 69 66 20 64 62 0a 09 20 20 28 (if db.. (
93b0: 62 65 67 69 6e 0a 09 20 20 20 20 28 73 65 74 21 begin.. (set!
93c0: 20 2a 64 62 2a 20 64 62 29 0a 09 20 20 20 20 28 *db* db).. (
93d0: 73 65 74 21 20 2a 63 6c 69 65 6e 74 2d 6e 6f 6e set! *client-non
93e0: 2d 62 6c 6f 63 6b 69 6e 67 2d 6d 6f 64 65 2a 20 -blocking-mode*
93f0: 23 74 29 0a 09 20 20 20 20 3b 3b 20 28 63 6c 69 #t).. ;; (cli
9400: 65 6e 74 3a 73 65 74 75 70 29 0a 09 20 20 20 20 ent:setup)..
9410: 3b 3b 20 28 63 6c 69 65 6e 74 3a 6c 61 75 6e 63 ;; (client:launc
9420: 68 29 0a 09 20 20 20 20 28 69 6d 70 6f 72 74 20 h).. (import
9430: 72 65 61 64 6c 69 6e 65 29 0a 09 20 20 20 20 28 readline).. (
9440: 69 6d 70 6f 72 74 20 61 70 72 6f 70 6f 73 29 0a import apropos).
9450: 09 20 20 20 20 28 67 6e 75 2d 68 69 73 74 6f 72 . (gnu-histor
9460: 79 2d 69 6e 73 74 61 6c 6c 2d 66 69 6c 65 2d 6d y-install-file-m
9470: 61 6e 61 67 65 72 0a 09 20 20 20 20 20 28 73 74 anager.. (st
9480: 72 69 6e 67 2d 61 70 70 65 6e 64 0a 09 20 20 20 ring-append..
9490: 20 20 20 28 6f 72 20 28 67 65 74 2d 65 6e 76 69 (or (get-envi
94a0: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
94b0: 20 22 48 4f 4d 45 22 29 20 22 2e 22 29 20 22 2f "HOME") ".") "/
94c0: 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 74 6f 72 .megatest_histor
94d0: 79 22 29 29 0a 09 20 20 20 20 28 63 75 72 72 65 y")).. (curre
94e0: 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 20 28 6d nt-input-port (m
94f0: 61 6b 65 2d 67 6e 75 2d 72 65 61 64 6c 69 6e 65 ake-gnu-readline
9500: 2d 70 6f 72 74 20 22 6d 65 67 61 74 65 73 74 3e -port "megatest>
9510: 20 22 29 29 0a 09 20 20 20 20 28 69 66 20 28 61 ")).. (if (a
9520: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
9530: 70 6c 22 29 0a 09 09 28 72 65 70 6c 29 0a 09 09 pl")...(repl)...
9540: 28 6c 6f 61 64 20 28 61 72 67 73 3a 67 65 74 2d (load (args:get-
9550: 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 29 29 0a arg "-load")))).
9560: 09 20 20 28 65 78 69 74 29 29 0a 20 20 20 20 20 . (exit)).
9570: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
9580: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d hing* #t)))..;;=
9590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
95a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
95b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
95c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
95d0: 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 69 74 20 61 6e =====.;; Exit an
95e0: 64 20 63 6c 65 61 6e 20 75 70 0a 3b 3b 3d 3d 3d d clean up.;;===
95f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9630: 3d 3d 3d 0a 0a 3b 3b 20 74 68 69 73 20 69 73 20 ===..;; this is
9640: 74 68 65 20 73 6f 63 6b 65 74 20 69 66 20 77 65 the socket if we
9650: 20 61 72 65 20 61 20 63 6c 69 65 6e 74 0a 3b 3b are a client.;;
9660: 20 28 69 66 20 28 61 6e 64 20 2a 72 75 6e 72 65 (if (and *runre
9670: 6d 6f 74 65 2a 0a 3b 3b 20 09 20 28 73 6f 63 6b mote*.;; . (sock
9680: 65 74 3f 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 et? *runremote*)
9690: 29 0a 3b 3b 20 20 20 20 20 28 63 6c 6f 73 65 2d ).;; (close-
96a0: 73 6f 63 6b 65 74 20 2a 72 75 6e 72 65 6d 6f 74 socket *runremot
96b0: 65 2a 29 29 0a 0a 28 69 66 20 28 6e 6f 74 20 2a e*))..(if (not *
96c0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 29 0a 20 didsomething*).
96d0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
96e0: 30 20 68 65 6c 70 29 29 0a 0a 3b 3b 20 28 69 66 0 help))..;; (if
96f0: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 28 72 70 *runremote* (rp
9700: 63 3a 63 6c 6f 73 65 2d 61 6c 6c 2d 63 6f 6e 6e c:close-all-conn
9710: 65 63 74 69 6f 6e 73 21 29 29 0a 20 20 20 20 0a ections!)). .
9720: 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 2a 67 (if (not (eq? *g
9730: 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
9740: 20 30 29 29 0a 20 20 20 20 28 69 66 20 28 6f 72 0)). (if (or
9750: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9760: 2d 72 75 6e 74 65 73 74 73 22 29 28 61 72 67 73 -runtests")(args
9770: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c :get-arg "-runal
9780: 6c 22 29 29 0a 20 20 20 20 20 20 20 20 28 62 65 l")). (be
9790: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 28 gin. (
97a0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 4e debug:print 0 "N
97b0: 4f 54 45 3a 20 53 75 62 70 72 6f 63 65 73 73 65 OTE: Subprocesse
97c0: 73 20 77 69 74 68 20 6e 6f 6e 2d 7a 65 72 6f 20 s with non-zero
97d0: 65 78 69 74 20 63 6f 64 65 20 64 65 74 65 63 74 exit code detect
97e0: 65 64 3a 20 22 20 2a 67 6c 6f 62 61 6c 65 78 69 ed: " *globalexi
97f0: 74 73 74 61 74 75 73 2a 29 0a 20 20 20 20 20 20 tstatus*).
9800: 20 20 20 20 20 28 65 78 69 74 20 30 29 29 0a 20 (exit 0)).
9810: 20 20 20 20 20 20 20 28 63 61 73 65 20 2a 67 6c (case *gl
9820: 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 0a obalexitstatus*.
9830: 20 20 20 20 20 20 20 20 20 28 28 30 29 28 65 78 ((0)(ex
9840: 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 it 0)).
9850: 28 28 31 29 28 65 78 69 74 20 31 29 29 0a 20 20 ((1)(exit 1)).
9860: 20 20 20 20 20 20 20 28 28 32 29 28 65 78 69 74 ((2)(exit
9870: 20 32 29 29 0a 20 20 20 20 20 20 20 20 20 28 65 2)). (e
9880: 6c 73 65 20 28 65 78 69 74 20 33 29 29 29 29 29 lse (exit 3)))))
9890: 0a .