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