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 29 20 3b 3b 20 28 ne apropos) ;; (
01e0: 73 72 66 69 20 31 38 29 20 65 78 74 72 61 73 29 srfi 18) extras)
01f0: 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 .(import (prefix
0200: 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 sqlite3 sqlite3
0210: 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 :)).(import (pre
0220: 66 69 78 20 62 61 73 65 36 34 20 62 61 73 65 36 fix base64 base6
0230: 34 3a 29 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 4:))..(declare (
0240: 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 uses common)).(d
0250: 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d 65 67 eclare (uses meg
0260: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 29 0a atest-version)).
0270: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
0280: 61 72 67 73 29 29 0a 28 64 65 63 6c 61 72 65 20 args)).(declare
0290: 28 75 73 65 73 20 72 75 6e 73 29 29 0a 28 64 65 (uses runs)).(de
02a0: 63 6c 61 72 65 20 28 75 73 65 73 20 6c 61 75 6e clare (uses laun
02b0: 63 68 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 ch)).(declare (u
02c0: 73 65 73 20 73 65 72 76 65 72 29 29 0a 28 64 65 ses server)).(de
02d0: 63 6c 61 72 65 20 28 75 73 65 73 20 74 65 73 74 clare (uses test
02e0: 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 s)).(declare (us
02f0: 65 73 20 67 65 6e 65 78 61 6d 70 6c 65 29 29 0a es genexample)).
0300: 0a 28 64 65 66 69 6e 65 20 2a 64 62 2a 20 23 66 .(define *db* #f
0310: 29 20 3b 3b 20 74 68 69 73 20 69 73 20 6f 6e 6c ) ;; this is onl
0320: 79 20 66 6f 72 20 74 68 65 20 72 65 70 6c 2c 20 y for the repl,
0330: 64 6f 20 6e 6f 74 20 75 73 65 20 69 6e 20 67 65 do not use in ge
0340: 6e 65 72 61 6c 21 21 21 21 0a 0a 28 69 6e 63 6c neral!!!!..(incl
0350: 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f ude "common_reco
0360: 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 rds.scm").(inclu
0370: 64 65 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e de "key_records.
0380: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
0390: 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 db_records.scm")
03a0: 0a 28 69 6e 63 6c 75 64 65 20 22 6d 65 67 61 74 .(include "megat
03b0: 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 2e est-fossil-hash.
03c0: 73 63 6d 22 29 0a 0a 28 64 65 66 69 6e 65 20 68 scm")..(define h
03d0: 65 6c 70 20 28 63 6f 6e 63 20 22 0a 4d 65 67 61 elp (conc ".Mega
03e0: 74 65 73 74 2c 20 64 6f 63 75 6d 65 6e 74 61 74 test, documentat
03f0: 69 6f 6e 20 61 74 20 68 74 74 70 3a 2f 2f 77 77 ion at http://ww
0400: 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 w.kiatoa.com/fos
0410: 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 0a 20 20 sils/megatest.
0420: 76 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 version " megate
0430: 73 74 2d 76 65 72 73 69 6f 6e 20 22 0a 20 20 6c st-version ". l
0440: 69 63 65 6e 73 65 20 47 50 4c 2c 20 43 6f 70 79 icense GPL, Copy
0450: 72 69 67 68 74 20 4d 61 74 74 20 57 65 6c 6c 61 right Matt Wella
0460: 6e 64 20 32 30 30 36 2d 32 30 31 32 0a 0a 55 73 nd 2006-2012..Us
0470: 61 67 65 3a 20 6d 65 67 61 74 65 73 74 20 5b 6f age: megatest [o
0480: 70 74 69 6f 6e 73 5d 0a 20 20 2d 68 20 20 20 20 ptions]. -h
0490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
04a0: 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a 20 20 : this help.
04b0: 2d 76 65 72 73 69 6f 6e 20 20 20 20 20 20 20 20 -version
04c0: 20 20 20 20 20 20 20 20 3a 20 70 72 69 6e 74 20 : print
04d0: 6d 65 67 61 74 65 73 74 20 76 65 72 73 69 6f 6e megatest version
04e0: 20 28 63 75 72 72 65 6e 74 6c 79 20 22 20 6d 65 (currently " me
04f0: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 gatest-version "
0500: 29 0a 0a 4c 61 75 6e 63 68 69 6e 67 20 61 6e 64 )..Launching and
0510: 20 6d 61 6e 61 67 69 6e 67 20 72 75 6e 73 0a 20 managing runs.
0520: 20 2d 72 75 6e 61 6c 6c 20 20 20 20 20 20 20 20 -runall
0530: 20 20 20 20 20 20 20 20 20 3a 20 72 75 6e 20 61 : run a
0540: 6c 6c 20 74 65 73 74 73 20 74 68 61 74 20 61 72 ll tests that ar
0550: 65 20 6e 6f 74 20 73 74 61 74 65 20 43 4f 4d 50 e not state COMP
0560: 4c 45 54 45 44 20 61 6e 64 20 73 74 61 74 75 73 LETED and status
0570: 20 50 41 53 53 2c 20 0a 20 20 20 20 20 20 20 20 PASS, .
0580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0590: 20 20 20 20 43 48 45 43 4b 20 6f 72 20 4b 49 4c CHECK or KIL
05a0: 4c 45 44 0a 20 20 2d 72 75 6e 74 65 73 74 73 20 LED. -runtests
05b0: 74 73 74 31 2c 74 73 74 32 20 2e 2e 2e 20 3a 20 tst1,tst2 ... :
05c0: 72 75 6e 20 74 65 73 74 73 0a 20 20 2d 72 65 6d run tests. -rem
05d0: 6f 76 65 2d 72 75 6e 73 20 20 20 20 20 20 20 20 ove-runs
05e0: 20 20 20 20 3a 20 72 65 6d 6f 76 65 20 74 68 65 : remove the
05f0: 20 64 61 74 61 20 66 6f 72 20 61 20 72 75 6e 2c data for a run,
0600: 20 72 65 71 75 69 72 65 73 20 3a 72 75 6e 6e 61 requires :runna
0610: 6d 65 20 61 6e 64 20 2d 74 65 73 74 70 61 74 74 me and -testpatt
0620: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0630: 20 20 20 20 20 20 20 20 20 20 20 20 20 4f 70 74 Opt
0640: 69 6f 6e 61 6c 6c 79 20 75 73 65 20 3a 73 74 61 ionally use :sta
0650: 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 0a 20 te and :status.
0660: 20 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 -set-state-stat
0670: 75 73 20 58 2c 59 20 20 20 3a 20 73 65 74 20 73 us X,Y : set s
0680: 74 61 74 65 20 74 6f 20 58 20 61 6e 64 20 73 74 tate to X and st
0690: 61 74 75 73 20 74 6f 20 59 2c 20 72 65 71 75 69 atus to Y, requi
06a0: 72 65 73 20 63 6f 6e 74 72 6f 6c 73 20 70 65 72 res controls per
06b0: 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 0a 20 20 -remove-runs.
06c0: 2d 72 65 72 75 6e 20 46 41 49 4c 2c 57 41 52 4e -rerun FAIL,WARN
06d0: 2e 2e 2e 20 20 20 20 20 3a 20 66 6f 72 63 65 20 ... : force
06e0: 72 65 2d 72 75 6e 20 66 6f 72 20 74 65 73 74 73 re-run for tests
06f0: 20 77 69 74 68 20 73 70 65 63 69 66 69 63 65 64 with specificed
0700: 20 73 74 61 74 75 73 28 73 29 0a 20 20 2d 72 6f status(s). -ro
0710: 6c 6c 75 70 20 20 20 20 20 20 20 20 20 20 20 20 llup
0720: 20 20 20 20 20 3a 20 28 63 75 72 72 65 6e 74 6c : (currentl
0730: 79 20 64 69 73 61 62 6c 65 64 29 20 66 69 6c 6c y disabled) fill
0740: 20 72 75 6e 20 28 73 65 74 20 62 79 20 3a 72 75 run (set by :ru
0750: 6e 6e 61 6d 65 29 20 20 77 69 74 68 20 6c 61 74 nname) with lat
0760: 65 73 74 20 74 65 73 74 28 73 29 0a 20 20 20 20 est test(s).
0770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0780: 20 20 20 20 20 20 20 20 66 72 6f 6d 20 70 72 69 from pri
0790: 6f 72 20 72 75 6e 73 20 77 69 74 68 20 73 61 6d or runs with sam
07a0: 65 20 6b 65 79 73 0a 20 20 2d 6c 6f 63 6b 20 20 e keys. -lock
07b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
07c0: 20 3a 20 6c 6f 63 6b 20 72 75 6e 20 73 70 65 63 : lock run spec
07d0: 69 66 69 65 64 20 62 79 20 74 61 72 67 65 74 20 ified by target
07e0: 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 20 2d 75 and runname. -u
07f0: 6e 6c 6f 63 6b 20 20 20 20 20 20 20 20 20 20 20 nlock
0800: 20 20 20 20 20 20 3a 20 75 6e 6c 6f 63 6b 20 72 : unlock r
0810: 75 6e 20 73 70 65 63 69 66 69 65 64 20 62 79 20 un specified by
0820: 74 61 72 67 65 74 20 61 6e 64 20 72 75 6e 6e 61 target and runna
0830: 6d 65 0a 0a 53 65 6c 65 63 74 6f 72 73 20 28 65 me..Selectors (e
0840: 2e 67 2e 20 75 73 65 20 66 6f 72 20 2d 72 75 6e .g. use for -run
0850: 74 65 73 74 73 2c 20 2d 72 65 6d 6f 76 65 2d 72 tests, -remove-r
0860: 75 6e 73 2c 20 2d 73 65 74 2d 73 74 61 74 65 2d uns, -set-state-
0870: 73 74 61 74 75 73 2c 20 2d 6c 69 73 74 2d 72 75 status, -list-ru
0880: 6e 73 20 65 74 63 2e 29 0a 20 20 2d 74 61 72 67 ns etc.). -targ
0890: 65 74 20 6b 65 79 31 2f 6b 65 79 32 2f 2e 2e 2e et key1/key2/...
08a0: 20 20 20 3a 20 72 75 6e 20 66 6f 72 20 6b 65 79 : run for key
08b0: 31 2c 20 6b 65 79 32 2c 20 65 74 63 2e 0a 20 20 1, key2, etc..
08c0: 2d 72 65 71 74 61 72 67 20 6b 65 79 31 2f 6b 65 -reqtarg key1/ke
08d0: 79 32 2f 2e 2e 2e 20 20 3a 20 72 75 6e 20 66 6f y2/... : run fo
08e0: 72 20 6b 65 79 31 2c 20 6b 65 79 32 2c 20 65 74 r key1, key2, et
08f0: 63 2e 20 62 75 74 20 6b 65 79 31 2f 6b 65 79 32 c. but key1/key2
0900: 20 6d 75 73 74 20 62 65 20 69 6e 20 72 75 6e 63 must be in runc
0910: 6f 6e 66 69 67 0a 20 20 2d 74 65 73 74 70 61 74 onfig. -testpat
0920: 74 20 70 61 74 74 31 2f 70 61 74 74 32 2c 70 61 t patt1/patt2,pa
0930: 74 74 33 2f 2e 2e 2e 20 20 3a 20 25 20 69 73 20 tt3/... : % is
0940: 77 69 6c 64 63 61 72 64 0a 20 20 3a 72 75 6e 6e wildcard. :runn
0950: 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 20 20 ame
0960: 20 20 20 3a 20 72 65 71 75 69 72 65 64 2c 20 6e : required, n
0970: 61 6d 65 20 66 6f 72 20 74 68 69 73 20 70 61 72 ame for this par
0980: 74 69 63 75 6c 61 72 20 74 65 73 74 20 72 75 6e ticular test run
0990: 0a 20 20 3a 73 74 61 74 65 20 20 20 20 20 20 20 . :state
09a0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 41 70 70 : App
09b0: 6c 69 65 73 20 74 6f 20 72 75 6e 73 2c 20 74 65 lies to runs, te
09c0: 73 74 73 20 6f 72 20 73 74 65 70 73 20 64 65 70 sts or steps dep
09d0: 65 6e 64 69 6e 67 20 6f 6e 20 63 6f 6e 74 65 78 ending on contex
09e0: 74 0a 20 20 3a 73 74 61 74 75 73 20 20 20 20 20 t. :status
09f0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 41 70 : Ap
0a00: 70 6c 69 65 73 20 74 6f 20 72 75 6e 73 2c 20 74 plies to runs, t
0a10: 65 73 74 73 20 6f 72 20 73 74 65 70 73 20 64 65 ests or steps de
0a20: 70 65 6e 64 69 6e 67 20 6f 6e 20 63 6f 6e 74 65 pending on conte
0a30: 78 74 0a 0a 54 65 73 74 20 68 65 6c 70 65 72 73 xt..Test helpers
0a40: 20 28 66 6f 72 20 75 73 65 20 69 6e 73 69 64 65 (for use inside
0a50: 20 74 65 73 74 73 29 0a 20 20 2d 73 74 65 70 20 tests). -step
0a60: 73 74 65 70 6e 61 6d 65 0a 20 20 2d 74 65 73 74 stepname. -test
0a70: 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 20 20 -status
0a80: 20 20 20 3a 20 73 65 74 20 74 68 65 20 73 74 61 : set the sta
0a90: 74 65 20 61 6e 64 20 73 74 61 74 75 73 20 6f 66 te and status of
0aa0: 20 61 20 74 65 73 74 20 28 75 73 65 20 3a 73 74 a test (use :st
0ab0: 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 29 ate and :status)
0ac0: 0a 20 20 2d 73 65 74 6c 6f 67 20 6c 6f 67 66 6e . -setlog logfn
0ad0: 61 6d 65 20 20 20 20 20 20 20 20 3a 20 73 65 74 ame : set
0ae0: 20 74 68 65 20 70 61 74 68 2f 66 69 6c 65 6e 61 the path/filena
0af0: 6d 65 20 74 6f 20 74 68 65 20 66 69 6e 61 6c 20 me to the final
0b00: 6c 6f 67 20 72 65 6c 61 74 69 76 65 20 74 6f 20 log relative to
0b10: 74 68 65 20 74 65 73 74 0a 20 20 20 20 20 20 20 the test.
0b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b30: 20 20 20 20 20 64 69 72 65 63 74 6f 72 79 2e 20 directory.
0b40: 6d 61 79 20 62 65 20 75 73 65 64 20 77 69 74 68 may be used with
0b50: 20 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 20 20 -test-status.
0b60: 2d 73 65 74 2d 74 6f 70 6c 6f 67 20 6c 6f 67 66 -set-toplog logf
0b70: 6e 61 6d 65 20 20 20 20 3a 20 73 65 74 20 74 68 name : set th
0b80: 65 20 6f 76 65 72 61 6c 6c 20 6c 6f 67 20 66 6f e overall log fo
0b90: 72 20 61 20 73 75 69 74 65 20 6f 66 20 73 75 62 r a suite of sub
0ba0: 2d 74 65 73 74 73 0a 20 20 2d 73 75 6d 6d 61 72 -tests. -summar
0bb0: 69 7a 65 2d 69 74 65 6d 73 20 20 20 20 20 20 20 ize-items
0bc0: 20 3a 20 66 6f 72 20 61 6e 20 69 74 65 6d 69 7a : for an itemiz
0bd0: 65 64 20 74 65 73 74 20 63 72 65 61 74 65 20 61 ed test create a
0be0: 20 73 75 6d 6d 61 72 79 20 68 74 6d 6c 20 0a 20 summary html .
0bf0: 20 2d 6d 20 63 6f 6d 6d 65 6e 74 20 20 20 20 20 -m comment
0c00: 20 20 20 20 20 20 20 20 20 3a 20 69 6e 73 65 72 : inser
0c10: 74 20 61 20 63 6f 6d 6d 65 6e 74 20 66 6f 72 20 t a comment for
0c20: 74 68 69 73 20 74 65 73 74 0a 0a 54 65 73 74 20 this test..Test
0c30: 64 61 74 61 20 63 61 70 74 75 72 65 0a 20 20 2d data capture. -
0c40: 73 65 74 2d 76 61 6c 75 65 73 20 20 20 20 20 20 set-values
0c50: 20 20 20 20 20 20 20 3a 20 75 70 64 61 74 65 20 : update
0c60: 6f 72 20 73 65 74 20 76 61 6c 75 65 73 20 69 6e or set values in
0c70: 20 74 68 65 20 74 65 73 74 64 61 74 61 20 74 61 the testdata ta
0c80: 62 6c 65 0a 20 20 3a 63 61 74 65 67 6f 72 79 20 ble. :category
0c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
0ca0: 73 65 74 20 74 68 65 20 63 61 74 65 67 6f 72 79 set the category
0cb0: 20 66 69 65 6c 64 20 28 6f 70 74 69 6f 6e 61 6c field (optional
0cc0: 29 0a 20 20 3a 76 61 72 69 61 62 6c 65 20 20 20 ). :variable
0cd0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 : se
0ce0: 74 20 74 68 65 20 76 61 72 69 61 62 6c 65 20 6e t the variable n
0cf0: 61 6d 65 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 ame (optional).
0d00: 20 3a 76 61 6c 75 65 20 20 20 20 20 20 20 20 20 :value
0d10: 20 20 20 20 20 20 20 20 20 3a 20 76 61 6c 75 65 : value
0d20: 20 6d 65 61 73 75 72 65 64 20 28 72 65 71 75 69 measured (requi
0d30: 72 65 64 29 0a 20 20 3a 65 78 70 65 63 74 65 64 red). :expected
0d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0d50: 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 20 value expected
0d60: 28 72 65 71 75 69 72 65 64 29 0a 20 20 3a 74 6f (required). :to
0d70: 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 l
0d80: 20 20 20 20 20 3a 20 7c 76 61 6c 75 65 2d 65 78 : |value-ex
0d90: 70 65 63 74 7c 20 3c 3d 20 74 6f 6c 20 28 72 65 pect| <= tol (re
0da0: 71 75 69 72 65 64 2c 20 63 61 6e 20 62 65 20 3c quired, can be <
0db0: 2c 20 3e 2c 20 3e 3d 2c 20 3c 3d 20 6f 72 20 6e , >, >=, <= or n
0dc0: 75 6d 62 65 72 29 0a 20 20 3a 75 6e 69 74 73 20 umber). :units
0dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0de0: 20 3a 20 6e 61 6d 65 20 6f 66 20 74 68 65 20 75 : name of the u
0df0: 6e 69 74 73 20 66 6f 72 20 76 61 6c 75 65 2c 20 nits for value,
0e00: 65 78 70 65 63 74 65 64 5f 76 61 6c 75 65 20 65 expected_value e
0e10: 74 63 2e 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 tc. (optional).
0e20: 20 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 -load-test-data
0e30: 20 20 20 20 20 20 20 20 20 3a 20 72 65 61 64 20 : read
0e40: 74 65 73 74 20 73 70 65 63 69 66 69 63 20 64 61 test specific da
0e50: 74 61 20 66 6f 72 20 73 74 6f 72 61 67 65 20 69 ta for storage i
0e60: 6e 20 74 68 65 20 74 65 73 74 5f 64 61 74 61 20 n the test_data
0e70: 74 61 62 6c 65 0a 20 20 20 20 20 20 20 20 20 20 table.
0e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e90: 20 20 66 72 6f 6d 20 73 74 61 6e 64 61 72 64 20 from standard
0ea0: 69 6e 2e 20 45 61 63 68 20 6c 69 6e 65 20 69 73 in. Each line is
0eb0: 20 63 6f 6d 6d 61 20 64 65 6c 69 6d 69 74 65 64 comma delimited
0ec0: 20 77 69 74 68 20 66 6f 75 72 0a 20 20 20 20 20 with four.
0ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ee0: 20 20 20 20 20 20 20 66 69 65 6c 64 73 20 63 61 fields ca
0ef0: 74 65 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c tegory,variable,
0f00: 76 61 6c 75 65 2c 63 6f 6d 6d 65 6e 74 0a 0a 51 value,comment..Q
0f10: 75 65 72 69 65 73 0a 20 20 2d 6c 69 73 74 2d 72 ueries. -list-r
0f20: 75 6e 73 20 70 61 74 74 20 20 20 20 20 20 20 20 uns patt
0f30: 20 3a 20 6c 69 73 74 20 72 75 6e 73 20 6d 61 74 : list runs mat
0f40: 63 68 69 6e 67 20 70 61 74 74 65 72 6e 20 5c 22 ching pattern \"
0f50: 70 61 74 74 5c 22 2c 20 25 20 69 73 20 74 68 65 patt\", % is the
0f60: 20 77 69 6c 64 63 61 72 64 0a 20 20 2d 73 68 6f wildcard. -sho
0f70: 77 6b 65 79 73 20 20 20 20 20 20 20 20 20 20 20 wkeys
0f80: 20 20 20 20 3a 20 73 68 6f 77 20 74 68 65 20 6b : show the k
0f90: 65 79 73 20 75 73 65 64 20 69 6e 20 74 68 69 73 eys used in this
0fa0: 20 6d 65 67 61 74 65 73 74 20 73 65 74 75 70 0a megatest setup.
0fb0: 20 20 2d 74 65 73 74 2d 66 69 6c 65 73 20 74 61 -test-files ta
0fc0: 72 67 70 61 74 74 20 20 20 20 20 3a 20 67 65 74 rgpatt : get
0fd0: 20 74 68 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 the most recent
0fe0: 20 74 65 73 74 20 70 61 74 68 2f 66 69 6c 65 20 test path/file
0ff0: 6d 61 74 63 68 69 6e 67 20 74 61 72 67 70 61 74 matching targpat
1000: 74 20 65 2e 67 2e 20 25 2f 25 2e 2e 2e 20 0a 20 t e.g. %/%... .
1010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1020: 20 20 20 20 20 20 20 20 20 20 20 72 65 74 75 72 retur
1030: 6e 73 20 6c 69 73 74 20 73 6f 72 74 65 64 20 62 ns list sorted b
1040: 79 20 61 67 65 20 61 73 63 65 6e 64 69 6e 67 2c y age ascending,
1050: 20 73 65 65 20 65 78 61 6d 70 6c 65 73 20 62 65 see examples be
1060: 6c 6f 77 0a 20 20 2d 74 65 73 74 2d 70 61 74 68 low. -test-path
1070: 73 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 s :
1080: 67 65 74 20 74 68 65 20 74 65 73 74 20 70 61 74 get the test pat
1090: 68 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 hs matching targ
10a0: 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 69 74 65 et, runname, ite
10b0: 6d 20 61 6e 64 20 74 65 73 74 0a 20 20 20 20 20 m and test.
10c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10d0: 20 20 20 20 20 20 20 70 61 74 74 65 72 6e 73 2e patterns.
10e0: 0a 0a 4d 69 73 63 20 0a 20 20 2d 72 65 62 75 69 ..Misc . -rebui
10f0: 6c 64 2d 64 62 20 20 20 20 20 20 20 20 20 20 20 ld-db
1100: 20 20 3a 20 62 72 69 6e 67 20 74 68 65 20 64 61 : bring the da
1110: 74 61 62 61 73 65 20 73 63 68 65 6d 61 20 75 70 tabase schema up
1120: 20 74 6f 20 64 61 74 65 0a 20 20 2d 75 70 64 61 to date. -upda
1130: 74 65 2d 6d 65 74 61 20 20 20 20 20 20 20 20 20 te-meta
1140: 20 20 20 3a 20 75 70 64 61 74 65 20 74 68 65 20 : update the
1150: 74 65 73 74 73 20 6d 65 74 61 64 61 74 61 20 66 tests metadata f
1160: 6f 72 20 61 6c 6c 20 74 65 73 74 73 0a 20 20 2d or all tests. -
1170: 65 6e 76 32 66 69 6c 65 20 66 6e 61 6d 65 20 20 env2file fname
1180: 20 20 20 20 20 20 20 3a 20 77 72 69 74 65 20 74 : write t
1190: 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 74 he environment t
11a0: 6f 20 66 6e 61 6d 65 2e 63 73 68 20 61 6e 64 20 o fname.csh and
11b0: 66 6e 61 6d 65 2e 73 68 0a 20 20 2d 73 65 74 76 fname.sh. -setv
11c0: 61 72 73 20 56 41 52 31 3d 76 61 6c 31 2c 56 41 ars VAR1=val1,VA
11d0: 52 32 3d 76 61 6c 32 20 3a 20 41 64 64 20 65 6e R2=val2 : Add en
11e0: 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 vironment variab
11f0: 6c 65 73 20 74 6f 20 61 20 72 75 6e 20 4e 42 2f les to a run NB/
1200: 2f 20 74 68 65 73 65 20 61 72 65 0a 20 20 20 20 / these are.
1210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1220: 20 20 20 20 20 20 20 20 20 20 20 20 20 6f 76 65 ove
1230: 72 77 72 69 74 74 65 6e 20 62 79 20 76 61 6c 75 rwritten by valu
1240: 65 73 20 73 65 74 20 69 6e 20 63 6f 6e 66 69 67 es set in config
1250: 20 66 69 6c 65 73 2e 0a 20 20 2d 73 65 72 76 65 files.. -serve
1260: 72 20 2d 7c 68 6f 73 74 6e 61 6d 65 20 20 20 20 r -|hostname
1270: 20 20 3a 20 73 74 61 72 74 20 74 68 65 20 73 65 : start the se
1280: 72 76 65 72 20 28 72 65 64 75 63 65 73 20 63 6f rver (reduces co
1290: 6e 74 65 6e 74 69 6f 6e 20 6f 6e 20 6d 65 67 61 ntention on mega
12a0: 74 65 73 74 2e 64 62 29 2c 20 75 73 65 0a 20 20 test.db), use.
12b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12c0: 20 20 20 20 20 20 20 20 20 20 2d 20 74 6f 20 61 - to a
12d0: 75 74 6f 6d 61 74 69 63 61 6c 6c 79 20 66 69 67 utomatically fig
12e0: 75 72 65 20 6f 75 74 20 68 6f 73 74 6e 61 6d 65 ure out hostname
12f0: 0a 20 20 2d 72 65 70 6c 20 20 20 20 20 20 20 20 . -repl
1300: 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 74 61 : sta
1310: 72 74 20 61 20 72 65 70 6c 20 28 75 73 65 66 75 rt a repl (usefu
1320: 6c 20 66 6f 72 20 65 78 74 65 6e 64 69 6e 67 20 l for extending
1330: 6d 65 67 61 74 65 73 74 29 0a 0a 53 70 72 65 61 megatest)..Sprea
1340: 64 73 68 65 65 74 20 67 65 6e 65 72 61 74 69 6f dsheet generatio
1350: 6e 0a 20 20 2d 65 78 74 72 61 63 74 2d 6f 64 73 n. -extract-ods
1360: 20 66 6e 61 6d 65 2e 6f 64 73 20 20 3a 20 65 78 fname.ods : ex
1370: 74 72 61 63 74 20 61 6e 20 6f 70 65 6e 20 64 6f tract an open do
1380: 63 75 6d 65 6e 74 20 73 70 72 65 61 64 73 68 65 cument spreadshe
1390: 65 74 20 66 72 6f 6d 20 74 68 65 20 64 61 74 61 et from the data
13a0: 62 61 73 65 0a 20 20 2d 70 61 74 68 6d 6f 64 20 base. -pathmod
13b0: 70 61 74 68 20 20 20 20 20 20 20 20 20 20 20 3a path :
13c0: 20 69 6e 73 65 72 74 20 70 61 74 68 2c 20 69 2e insert path, i.
13d0: 65 2e 20 70 61 74 68 2f 72 75 6e 61 6d 65 2f 69 e. path/runame/i
13e0: 74 65 6d 70 61 74 68 2f 6c 6f 67 66 69 6c 65 2e tempath/logfile.
13f0: 68 74 6d 6c 0a 20 20 20 20 20 20 20 20 20 20 20 html.
1400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1410: 20 77 69 6c 6c 20 63 6c 65 61 72 20 74 68 65 20 will clear the
1420: 66 69 65 6c 64 20 69 66 20 6e 6f 20 72 75 6e 64 field if no rund
1430: 69 72 2f 74 65 73 74 6e 61 6d 65 2f 69 74 65 6d ir/testname/item
1440: 70 61 74 68 2f 6c 6f 67 66 69 6c 65 0a 20 20 20 path/logfile.
1450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1460: 20 20 20 20 20 20 20 20 20 69 66 20 69 74 20 63 if it c
1470: 6f 6e 74 61 69 6e 73 20 66 6f 72 77 61 72 64 20 ontains forward
1480: 73 6c 61 73 68 65 73 20 74 68 65 20 70 61 74 68 slashes the path
1490: 20 77 69 6c 6c 20 62 65 20 63 6f 6e 76 65 72 74 will be convert
14a0: 65 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ed.
14b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
14c0: 6f 20 77 69 6e 64 6f 77 73 20 73 74 79 6c 65 0a o windows style.
14d0: 47 65 74 74 69 6e 67 20 73 74 61 72 74 65 64 0a Getting started.
14e0: 20 20 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d -gen-megatest-
14f0: 61 72 65 61 20 20 20 20 20 20 3a 20 63 72 65 61 area : crea
1500: 74 65 20 61 20 73 6b 65 6c 65 74 6f 6e 20 6d 65 te a skeleton me
1510: 67 61 74 65 73 74 20 61 72 65 61 2e 20 59 6f 75 gatest area. You
1520: 20 77 69 6c 6c 20 62 65 20 70 72 6f 6d 70 74 65 will be prompte
1530: 64 20 66 6f 72 20 70 61 74 68 73 0a 20 20 2d 67 d for paths. -g
1540: 65 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 en-megatest-test
1550: 20 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 61 : create a
1560: 20 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 65 skeleton megate
1570: 73 74 20 74 65 73 74 2e 20 59 6f 75 20 77 69 6c st test. You wil
1580: 6c 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 6f l be prompted fo
1590: 72 20 69 6e 66 6f 0a 0a 45 78 61 6d 70 6c 65 73 r info..Examples
15a0: 0a 0a 23 20 47 65 74 20 74 65 73 74 20 70 61 74 ..# Get test pat
15b0: 68 2c 20 75 73 65 20 27 2e 27 20 74 6f 20 67 65 h, use '.' to ge
15c0: 74 20 61 20 73 69 6e 67 6c 65 20 70 61 74 68 20 t a single path
15d0: 6f 72 20 61 20 73 70 65 63 69 66 69 63 20 70 61 or a specific pa
15e0: 74 68 2f 66 69 6c 65 20 70 61 74 74 65 72 6e 0a th/file pattern.
15f0: 6d 65 67 61 74 65 73 74 20 2d 74 65 73 74 2d 66 megatest -test-f
1600: 69 6c 65 73 20 27 6c 6f 67 73 2f 2a 2e 6c 6f 67 iles 'logs/*.log
1610: 27 20 2d 74 61 72 67 65 74 20 75 62 75 6e 74 75 ' -target ubuntu
1620: 2f 6e 25 2f 6e 6f 25 20 3a 72 75 6e 6e 61 6d 65 /n%/no% :runname
1630: 20 77 34 39 25 20 2d 74 65 73 74 70 61 74 74 20 w49% -testpatt
1640: 74 65 73 74 5f 6d 74 25 0a 0a 43 61 6c 6c 65 64 test_mt%..Called
1650: 20 61 73 20 22 20 28 73 74 72 69 6e 67 2d 69 6e as " (string-in
1660: 74 65 72 73 70 65 72 73 65 20 28 61 72 67 76 29 tersperse (argv)
1670: 20 22 20 22 29 20 22 0a 42 75 69 6c 74 20 66 72 " ") ".Built fr
1680: 6f 6d 20 22 20 6d 65 67 61 74 65 73 74 2d 66 6f om " megatest-fo
1690: 73 73 69 6c 2d 68 61 73 68 20 29 29 0a 0a 3b 3b ssil-hash ))..;;
16a0: 20 20 2d 67 75 69 20 20 20 20 20 20 20 20 20 20 -gui
16b0: 20 20 20 20 20 20 20 20 20 20 3a 20 73 74 61 72 : star
16c0: 74 20 61 20 67 75 69 20 69 6e 74 65 72 66 61 63 t a gui interfac
16d0: 65 0a 3b 3b 20 20 2d 63 6f 6e 66 69 67 20 66 6e e.;; -config fn
16e0: 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 3a 20 ame :
16f0: 6f 76 65 72 72 69 64 65 20 74 68 65 20 72 75 6e override the run
1700: 63 6f 6e 66 69 67 20 66 69 6c 65 20 77 69 74 68 config file with
1710: 20 66 6e 61 6d 65 0a 0a 3b 3b 20 70 72 6f 63 65 fname..;; proce
1720: 73 73 20 61 72 67 73 0a 28 64 65 66 69 6e 65 20 ss args.(define
1730: 72 65 6d 61 72 67 73 20 28 61 72 67 73 3a 67 65 remargs (args:ge
1740: 74 2d 61 72 67 73 20 0a 09 09 20 28 61 72 67 76 t-args ... (argv
1750: 29 0a 09 09 20 28 6c 69 73 74 20 20 22 2d 72 75 )... (list "-ru
1760: 6e 74 65 73 74 73 22 20 20 3b 3b 20 72 75 6e 20 ntests" ;; run
1770: 61 20 73 70 65 63 69 66 69 63 20 74 65 73 74 0a a specific test.
1780: 09 09 09 22 2d 63 6f 6e 66 69 67 22 20 20 20 20 ..."-config"
1790: 3b 3b 20 6f 76 65 72 72 69 64 65 20 74 68 65 20 ;; override the
17a0: 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e 61 6d 65 config file name
17b0: 0a 09 09 09 22 2d 65 78 65 63 75 74 65 22 20 20 ...."-execute"
17c0: 20 3b 3b 20 72 75 6e 20 74 68 65 20 63 6f 6d 6d ;; run the comm
17d0: 61 6e 64 20 65 6e 63 6f 64 65 64 20 69 6e 20 74 and encoded in t
17e0: 68 65 20 62 61 73 65 36 34 20 70 61 72 61 6d 65 he base64 parame
17f0: 74 65 72 0a 09 09 09 22 2d 73 74 65 70 22 0a 09 ter...."-step"..
1800: 09 09 22 3a 72 75 6e 6e 61 6d 65 22 20 20 20 0a ..":runname" .
1810: 09 09 09 22 2d 74 61 72 67 65 74 22 0a 09 09 09 ..."-target"....
1820: 22 2d 72 65 71 74 61 72 67 22 0a 09 09 09 22 3a "-reqtarg"....":
1830: 69 74 65 6d 22 0a 09 09 09 22 3a 72 75 6e 6e 61 item"....":runna
1840: 6d 65 22 20 20 20 0a 09 09 09 22 3a 73 74 61 74 me" ....":stat
1850: 65 22 20 20 0a 09 09 09 22 3a 73 74 61 74 75 73 e" ....":status
1860: 22 0a 09 09 09 22 2d 6c 69 73 74 2d 72 75 6e 73 "...."-list-runs
1870: 22 0a 09 09 09 22 2d 74 65 73 74 70 61 74 74 22 "...."-testpatt"
1880: 20 0a 09 09 09 22 2d 69 74 65 6d 70 61 74 74 22 ...."-itempatt"
1890: 0a 09 09 09 22 2d 73 65 74 6c 6f 67 22 0a 09 09 ...."-setlog"...
18a0: 09 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 0a 09 ."-set-toplog"..
18b0: 09 09 22 2d 72 75 6e 73 74 65 70 22 0a 09 09 09 .."-runstep"....
18c0: 22 2d 6c 6f 67 70 72 6f 22 0a 09 09 09 22 2d 6d "-logpro"...."-m
18d0: 22 0a 09 09 09 22 2d 72 65 72 75 6e 22 0a 09 09 "...."-rerun"...
18e0: 09 22 2d 64 61 79 73 22 0a 09 09 09 22 2d 72 65 ."-days"...."-re
18f0: 6e 61 6d 65 2d 72 75 6e 22 0a 09 09 09 22 2d 74 name-run"...."-t
1900: 6f 22 0a 09 09 09 3b 3b 20 76 61 6c 75 65 73 20 o"....;; values
1910: 61 6e 64 20 6d 65 73 73 61 67 65 73 0a 09 09 09 and messages....
1920: 22 3a 63 61 74 65 67 6f 72 79 22 0a 09 09 09 22 ":category"...."
1930: 3a 76 61 72 69 61 62 6c 65 22 0a 09 09 09 22 3a :variable"....":
1940: 76 61 6c 75 65 22 0a 09 09 09 22 3a 65 78 70 65 value"....":expe
1950: 63 74 65 64 22 0a 09 09 09 22 3a 74 6f 6c 22 0a cted"....":tol".
1960: 09 09 09 22 3a 75 6e 69 74 73 22 0a 09 09 09 3b ...":units"....;
1970: 3b 20 6d 69 73 63 0a 09 09 09 22 2d 73 65 72 76 ; misc...."-serv
1980: 65 72 22 0a 09 09 09 22 2d 65 78 74 72 61 63 74 er"...."-extract
1990: 2d 6f 64 73 22 0a 09 09 09 22 2d 70 61 74 68 6d -ods"...."-pathm
19a0: 6f 64 22 0a 09 09 09 22 2d 65 6e 76 32 66 69 6c od"...."-env2fil
19b0: 65 22 0a 09 09 09 22 2d 73 65 74 76 61 72 73 22 e"...."-setvars"
19c0: 0a 09 09 09 22 2d 73 65 74 2d 73 74 61 74 65 2d ...."-set-state-
19d0: 73 74 61 74 75 73 22 0a 09 09 09 22 2d 64 65 62 status"...."-deb
19e0: 75 67 22 20 3b 3b 20 66 6f 72 20 2a 76 65 72 62 ug" ;; for *verb
19f0: 6f 73 69 74 79 2a 20 3e 20 32 0a 09 09 09 22 2d osity* > 2...."-
1a00: 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 gen-megatest-tes
1a10: 74 22 0a 09 09 09 22 2d 6f 76 65 72 72 69 64 65 t"...."-override
1a20: 2d 74 69 6d 65 6f 75 74 22 0a 09 09 09 22 2d 74 -timeout"...."-t
1a30: 65 73 74 2d 66 69 6c 65 73 22 20 20 3b 3b 20 2d est-files" ;; -
1a40: 74 65 73 74 2d 70 61 74 68 73 20 69 73 20 66 6f test-paths is fo
1a50: 72 20 6c 69 73 74 69 6e 67 20 61 6c 6c 0a 09 09 r listing all...
1a60: 09 29 20 0a 09 09 20 28 6c 69 73 74 20 20 22 2d .) ... (list "-
1a70: 68 22 0a 09 09 09 22 2d 76 65 72 73 69 6f 6e 22 h"...."-version"
1a80: 0a 09 09 20 20 20 20 20 20 20 20 22 2d 66 6f 72 ... "-for
1a90: 63 65 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d ce"... "-
1aa0: 78 74 65 72 6d 22 0a 09 09 20 20 20 20 20 20 20 xterm"...
1ab0: 20 22 2d 73 68 6f 77 6b 65 79 73 22 0a 09 09 20 "-showkeys"...
1ac0: 20 20 20 20 20 20 20 22 2d 74 65 73 74 2d 73 74 "-test-st
1ad0: 61 74 75 73 22 0a 09 09 09 22 2d 73 65 74 2d 76 atus"...."-set-v
1ae0: 61 6c 75 65 73 22 0a 09 09 09 22 2d 6c 6f 61 64 alues"...."-load
1af0: 2d 74 65 73 74 2d 64 61 74 61 22 0a 09 09 09 22 -test-data"...."
1b00: 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 -summarize-items
1b10: 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d 67 75 "... "-gu
1b20: 69 22 0a 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 i"....;; misc...
1b30: 09 22 2d 61 72 63 68 69 76 65 22 0a 09 09 09 22 ."-archive"...."
1b40: 2d 72 65 70 6c 22 0a 09 09 09 22 2d 6c 6f 63 6b -repl"...."-lock
1b50: 22 0a 09 09 09 22 2d 75 6e 6c 6f 63 6b 22 0a 09 "...."-unlock"..
1b60: 09 09 3b 3b 20 71 75 65 72 69 65 73 0a 09 09 09 ..;; queries....
1b70: 22 2d 74 65 73 74 2d 70 61 74 68 73 22 20 3b 3b "-test-paths" ;;
1b80: 20 67 65 74 20 70 61 74 68 28 73 29 20 74 6f 20 get path(s) to
1b90: 61 20 74 65 73 74 2c 20 6f 72 64 65 72 65 64 20 a test, ordered
1ba0: 62 79 20 79 6f 75 6e 67 65 73 74 20 66 69 72 73 by youngest firs
1bb0: 74 0a 0a 09 09 09 22 2d 72 75 6e 61 6c 6c 22 20 t....."-runall"
1bc0: 20 20 20 3b 3b 20 72 75 6e 20 61 6c 6c 20 74 65 ;; run all te
1bd0: 73 74 73 0a 09 09 09 22 2d 72 65 6d 6f 76 65 2d sts...."-remove-
1be0: 72 75 6e 73 22 0a 09 09 09 22 2d 75 73 65 71 75 runs"...."-usequ
1bf0: 65 75 65 22 0a 09 09 09 22 2d 72 65 62 75 69 6c eue"...."-rebuil
1c00: 64 2d 64 62 22 0a 09 09 09 22 2d 72 6f 6c 6c 75 d-db"...."-rollu
1c10: 70 22 0a 09 09 09 22 2d 75 70 64 61 74 65 2d 6d p"...."-update-m
1c20: 65 74 61 22 0a 09 09 09 22 2d 67 65 6e 2d 6d 65 eta"...."-gen-me
1c30: 67 61 74 65 73 74 2d 61 72 65 61 22 0a 0a 09 09 gatest-area"....
1c40: 09 22 2d 6c 6f 67 67 69 6e 67 22 0a 09 09 09 22 ."-logging"...."
1c50: 2d 76 22 20 3b 3b 20 76 65 72 62 6f 73 65 20 32 -v" ;; verbose 2
1c60: 2c 20 6d 6f 72 65 20 74 68 61 6e 20 6e 6f 72 6d , more than norm
1c70: 61 6c 20 28 6e 6f 72 6d 61 6c 20 69 73 20 31 29 al (normal is 1)
1c80: 0a 09 09 09 22 2d 71 22 20 3b 3b 20 71 75 69 65 ...."-q" ;; quie
1c90: 74 20 30 2c 20 65 72 72 6f 72 73 2f 77 61 72 6e t 0, errors/warn
1ca0: 69 6e 67 73 20 6f 6e 6c 79 0a 09 09 20 20 20 20 ings only...
1cb0: 20 20 20 29 0a 09 09 20 61 72 67 73 3a 61 72 67 )... args:arg
1cc0: 2d 68 61 73 68 0a 09 09 20 30 29 29 0a 0a 28 69 -hash... 0))..(i
1cd0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
1ce0: 22 2d 68 22 29 0a 20 20 20 20 28 62 65 67 69 6e "-h"). (begin
1cf0: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 68 65 . (print he
1d00: 6c 70 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 lp). (exit)
1d10: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
1d20: 74 2d 61 72 67 20 22 2d 76 65 72 73 69 6f 6e 22 t-arg "-version"
1d30: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
1d40: 20 20 20 28 70 72 69 6e 74 20 6d 65 67 61 74 65 (print megate
1d50: 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 20 20 20 st-version).
1d60: 20 20 28 65 78 69 74 29 29 29 0a 0a 28 64 65 66 (exit)))..(def
1d70: 69 6e 65 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e ine *didsomethin
1d80: 67 2a 20 23 66 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d g* #f)..;;======
1d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1dd0: 0a 3b 3b 20 4d 69 73 63 20 73 65 74 75 70 20 73 .;; Misc setup s
1de0: 74 75 66 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d tuff.;;=========
1df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
1e30: 64 65 62 75 67 3a 73 65 74 75 70 29 0a 0a 28 69 debug:setup)..(i
1e40: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
1e50: 22 2d 6c 6f 67 67 69 6e 67 22 29 28 73 65 74 21 "-logging")(set!
1e60: 20 2a 6c 6f 67 67 69 6e 67 2a 20 23 74 29 29 0a *logging* #t)).
1e70: 0a 28 69 66 20 28 64 65 62 75 67 3a 64 65 62 75 .(if (debug:debu
1e80: 67 2d 6d 6f 64 65 20 33 29 20 3b 3b 20 77 65 20 g-mode 3) ;; we
1e90: 61 72 65 20 6f 62 76 69 6f 75 73 6c 79 20 64 65 are obviously de
1ea0: 62 75 67 67 69 6e 67 0a 20 20 20 20 28 73 65 74 bugging. (set
1eb0: 21 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 ! open-run-close
1ec0: 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d open-run-close-
1ed0: 6e 6f 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e no-exception-han
1ee0: 64 6c 69 6e 67 29 29 0a 0a 3b 3b 20 61 2c 62 2c dling))..;; a,b,
1ef0: 63 20 25 20 3d 3e 20 61 2f 25 2c 62 2f 25 2c 63 c % => a/%,b/%,c
1f00: 2f 25 0a 28 64 65 66 69 6e 65 20 28 74 61 63 6b /%.(define (tack
1f10: 2d 6f 6e 2d 70 61 74 74 20 73 72 63 73 74 72 20 -on-patt srcstr
1f20: 70 61 74 74 29 0a 20 20 28 6c 65 74 20 28 28 73 patt). (let ((s
1f30: 74 72 6c 73 74 20 28 73 74 72 69 6e 67 2d 73 70 trlst (string-sp
1f40: 6c 69 74 20 73 72 63 73 74 72 20 22 2c 22 29 29 lit srcstr ","))
1f50: 29 0a 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e ). (string-in
1f60: 74 65 72 73 70 65 72 73 65 20 0a 20 20 20 20 20 tersperse .
1f70: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 73 74 (map (lambda (st
1f80: 72 29 0a 09 20 20 20 20 28 69 66 20 28 6e 6f 74 r).. (if (not
1f90: 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 (substring-inde
1fa0: 78 20 22 2f 22 20 73 74 72 29 29 0a 09 09 28 63 x "/" str))...(c
1fb0: 6f 6e 63 20 73 74 72 20 22 2f 22 20 70 61 74 74 onc str "/" patt
1fc0: 29 0a 09 09 73 74 72 29 29 0a 09 20 20 73 74 72 )...str)).. str
1fd0: 6c 73 74 29 0a 09 20 20 20 22 2c 22 29 29 29 0a lst).. ","))).
1fe0: 0a 3b 3b 20 74 6f 20 74 72 79 20 61 6e 64 20 6e .;; to try and n
1ff0: 6f 74 20 62 75 72 64 65 6e 20 4b 69 6d 20 74 6f ot burden Kim to
2000: 6f 20 6d 75 63 68 2e 2e 2e 0a 28 69 66 20 28 61 o much....(if (a
2010: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 rgs:get-arg "-it
2020: 65 6d 70 61 74 74 22 29 0a 20 20 20 20 28 6c 65 empatt"). (le
2030: 74 20 28 28 6f 6c 64 2d 74 65 73 74 70 61 74 74 t ((old-testpatt
2040: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
2050: 2d 74 65 73 74 70 61 74 74 22 29 29 29 0a 20 20 -testpatt"))).
2060: 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 ;; (debug:pr
2070: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 70 61 int 0 "ERROR: pa
2080: 72 61 6d 65 74 65 72 20 5c 22 2d 69 74 65 6d 70 rameter \"-itemp
2090: 61 74 74 5c 22 20 68 61 73 20 62 65 65 6e 20 64 att\" has been d
20a0: 65 70 72 65 63 61 74 65 64 2e 20 46 6f 72 20 6e eprecated. For n
20b0: 6f 77 20 49 20 77 69 6c 6c 20 74 77 65 61 6b 20 ow I will tweak
20c0: 79 6f 75 72 20 2d 74 65 73 74 70 61 74 74 20 66 your -testpatt f
20d0: 6f 72 20 79 6f 75 22 29 0a 20 20 20 20 20 20 28 or you"). (
20e0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
20f0: 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 20 "-testpatt")..
2100: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
2110: 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 ! args:arg-hash
2120: 22 2d 74 65 73 74 70 61 74 74 22 20 28 74 61 63 "-testpatt" (tac
2130: 6b 2d 6f 6e 2d 70 61 74 74 20 6f 6c 64 2d 74 65 k-on-patt old-te
2140: 73 74 70 61 74 74 20 28 61 72 67 73 3a 67 65 74 stpatt (args:get
2150: 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 -arg "-itempatt"
2160: 29 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 28 64 )))). ;; (d
2170: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 20 20 ebug:print 0 "
2180: 20 20 6f 6c 64 3a 20 22 20 6f 6c 64 2d 74 65 73 old: " old-tes
2190: 74 70 61 74 74 20 22 2c 20 6e 65 77 3a 20 22 20 tpatt ", new: "
21a0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
21b0: 74 65 73 74 70 61 74 74 22 29 29 0a 20 20 20 20 testpatt")).
21c0: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
21d0: 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
21e0: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
21f0: 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ;; (debug:print
2200: 30 20 22 4e 4f 54 45 3a 20 41 6c 73 6f 20 6d 6f 0 "NOTE: Also mo
2210: 64 69 66 79 69 6e 67 20 2d 72 75 6e 74 65 73 74 difying -runtest
2220: 73 22 29 0a 09 20 20 20 20 28 68 61 73 68 2d 74 s").. (hash-t
2230: 61 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 able-set! args:a
2240: 72 67 2d 68 61 73 68 20 22 2d 72 75 6e 74 65 73 rg-hash "-runtes
2250: 74 73 22 20 28 74 61 63 6b 2d 6f 6e 2d 70 61 74 ts" (tack-on-pat
2260: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
2270: 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 09 09 "-runtests")....
2280: 09 09 09 09 09 20 20 20 20 20 28 61 72 67 73 3a ..... (args:
2290: 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 get-arg "-itempa
22a0: 74 74 22 29 29 29 29 29 0a 20 20 20 20 20 20 29 tt"))))). )
22b0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
22c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d ===========.;; M
2300: 69 73 63 20 67 65 6e 65 72 61 6c 20 63 61 6c 6c isc general call
2310: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
2320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
2360: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
2370: 65 6e 76 32 66 69 6c 65 22 29 0a 20 20 20 20 28 env2file"). (
2380: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 73 61 76 begin. (sav
2390: 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 e-environment-as
23a0: 2d 66 69 6c 65 73 20 28 61 72 67 73 3a 67 65 74 -files (args:get
23b0: 2d 61 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 -arg "-env2file"
23c0: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
23d0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
23e0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
23f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
2430: 20 52 65 6d 6f 76 65 20 6f 6c 64 20 72 75 6e 28 Remove old run(
2440: 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s).;;===========
2450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
2490: 73 69 6e 63 65 20 73 65 76 65 72 61 6c 20 61 63 since several ac
24a0: 74 69 6f 6e 73 20 63 61 6e 20 62 65 20 73 70 65 tions can be spe
24b0: 63 69 66 69 65 64 20 6f 6e 20 74 68 65 20 63 6f cified on the co
24c0: 6d 6d 61 6e 64 20 6c 69 6e 65 20 74 68 65 20 72 mmand line the r
24d0: 65 6d 6f 76 61 6c 0a 3b 3b 20 69 73 20 64 6f 6e emoval.;; is don
24e0: 65 20 66 69 72 73 74 0a 28 64 65 66 69 6e 65 20 e first.(define
24f0: 28 6f 70 65 72 61 74 65 2d 6f 6e 20 61 63 74 69 (operate-on acti
2500: 6f 6e 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 on). (cond. (
2510: 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 (not (args:get-a
2520: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a rg ":runname")).
2530: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
2540: 20 30 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 0 "ERROR: Missi
2550: 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 ng required para
2560: 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 meter for " acti
2570: 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 on ", you must s
2580: 70 65 63 69 66 79 20 74 68 65 20 72 75 6e 20 6e pecify the run n
2590: 61 6d 65 20 70 61 74 74 65 72 6e 20 77 69 74 68 ame pattern with
25a0: 20 3a 72 75 6e 6e 61 6d 65 20 70 61 74 74 22 29 :runname patt")
25b0: 0a 20 20 20 20 28 65 78 69 74 20 32 29 29 0a 20 . (exit 2)).
25c0: 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 ((not (args:ge
25d0: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
25e0: 22 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ")). (debug:p
25f0: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4d rint 0 "ERROR: M
2600: 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 issing required
2610: 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 parameter for "
2620: 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 action ", you mu
2630: 73 74 20 73 70 65 63 69 66 79 20 74 68 65 20 74 st specify the t
2640: 65 73 74 20 70 61 74 74 65 72 6e 20 77 69 74 68 est pattern with
2650: 20 2d 74 65 73 74 70 61 74 74 22 29 0a 20 20 20 -testpatt").
2660: 20 28 65 78 69 74 20 33 29 29 0a 20 20 20 28 65 (exit 3)). (e
2670: 6c 73 65 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 lse. (if (not
2680: 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 (car *configinf
2690: 6f 2a 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 o*))..(begin..
26a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
26b0: 45 52 52 4f 52 3a 20 41 74 74 65 6d 70 74 65 64 ERROR: Attempted
26c0: 20 22 20 61 63 74 69 6f 6e 20 22 6f 6e 20 74 65 " action "on te
26d0: 73 74 28 73 29 20 62 75 74 20 72 75 6e 20 61 72 st(s) but run ar
26e0: 65 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e ea config file n
26f0: 6f 74 20 66 6f 75 6e 64 22 29 0a 09 20 20 28 65 ot found").. (e
2700: 78 69 74 20 31 29 29 0a 09 3b 3b 20 70 75 74 20 xit 1))..;; put
2710: 74 65 73 74 20 70 61 72 61 6d 65 74 65 72 73 20 test parameters
2720: 69 6e 74 6f 20 63 6f 6e 76 65 6e 69 65 6e 74 20 into convenient
2730: 76 61 72 69 61 62 6c 65 73 0a 09 28 72 75 6e 73 variables..(runs
2740: 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 20 61 63 74 :operate-on act
2750: 69 6f 6e 0a 09 09 09 20 20 28 61 72 67 73 3a 67 ion.... (args:g
2760: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
2770: 22 29 0a 09 09 09 20 20 28 61 72 67 73 3a 67 65 ").... (args:ge
2780: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
2790: 22 29 0a 09 09 09 20 20 73 74 61 74 65 3a 20 28 ").... state: (
27a0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 args:get-arg ":s
27b0: 74 61 74 65 22 29 20 0a 09 09 09 20 20 73 74 61 tate") .... sta
27c0: 74 75 73 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 tus: (args:get-a
27d0: 72 67 20 22 3a 73 74 61 74 75 73 22 29 0a 09 09 rg ":status")...
27e0: 09 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 . new-state-sta
27f0: 74 75 73 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 tus: (args:get-a
2800: 72 67 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 rg "-set-state-s
2810: 74 61 74 75 73 22 29 29 29 0a 20 20 20 20 28 73 tatus"))). (s
2820: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
2830: 67 2a 20 23 74 29 29 29 29 0a 09 20 20 0a 28 69 g* #t)))).. .(i
2840: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
2850: 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a "-remove-runs").
2860: 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e (general-run
2870: 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 65 -call . "-re
2880: 6d 6f 76 65 2d 72 75 6e 73 22 0a 20 20 20 20 20 move-runs".
2890: 22 72 65 6d 6f 76 65 20 72 75 6e 73 22 0a 20 20 "remove runs".
28a0: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
28b0: 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
28c0: 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c keynames keyvall
28d0: 73 74 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 st). (oper
28e0: 61 74 65 2d 6f 6e 20 27 72 65 6d 6f 76 65 2d 72 ate-on 'remove-r
28f0: 75 6e 73 29 29 29 29 0a 0a 28 69 66 20 28 61 72 uns))))..(if (ar
2900: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
2910: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 29 0a -state-status").
2920: 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e (general-run
2930: 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 73 65 -call . "-se
2940: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 0a t-state-status".
2950: 20 20 20 20 20 22 73 65 74 20 73 74 61 74 65 20 "set state
2960: 61 6e 64 20 73 74 61 74 75 73 22 0a 20 20 20 20 and status".
2970: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
2980: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
2990: 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 ynames keyvallst
29a0: 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 ). (operat
29b0: 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d e-on 'set-state-
29c0: 73 74 61 74 75 73 29 29 29 29 0a 0a 3b 3b 3d 3d status))))..;;==
29d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a10: 3d 3d 3d 3d 0a 3b 3b 20 51 75 65 72 79 20 72 75 ====.;; Query ru
2a20: 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ns.;;===========
2a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
2a70: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
2a80: 2d 6c 69 73 74 2d 72 75 6e 73 22 29 0a 20 20 20 -list-runs").
2a90: 20 28 69 66 20 28 73 65 74 75 70 2d 66 6f 72 2d (if (setup-for-
2aa0: 72 75 6e 29 0a 09 28 6c 65 74 2a 20 28 28 64 62 run)..(let* ((db
2ab0: 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 #f)..
2ac0: 20 20 20 28 72 75 6e 70 61 74 74 20 20 28 61 72 (runpatt (ar
2ad0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 gs:get-arg "-lis
2ae0: 74 2d 72 75 6e 73 22 29 29 0a 09 20 20 20 20 20 t-runs"))..
2af0: 20 20 28 74 65 73 74 70 61 74 74 20 28 61 72 67 (testpatt (arg
2b00: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
2b10: 70 61 74 74 22 29 29 0a 09 20 20 20 20 20 20 20 patt"))..
2b20: 28 72 75 6e 73 64 61 74 20 20 28 6f 70 65 6e 2d (runsdat (open-
2b30: 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 run-close db:get
2b40: 2d 72 75 6e 73 20 64 62 20 72 75 6e 70 61 74 74 -runs db runpatt
2b50: 20 23 66 20 23 66 20 27 28 29 29 29 0a 09 20 20 #f #f '()))..
2b60: 20 20 20 20 20 28 72 75 6e 73 20 20 20 20 20 28 (runs (
2b70: 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e 73 db:get-rows runs
2b80: 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 28 68 dat)).. (h
2b90: 65 61 64 65 72 20 20 20 28 64 62 3a 67 65 74 2d eader (db:get-
2ba0: 68 65 61 64 65 72 20 72 75 6e 73 64 61 74 29 29 header runsdat))
2bb0: 0a 09 20 20 20 20 20 20 20 28 6b 65 79 73 20 20 .. (keys
2bc0: 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f (open-run-clo
2bd0: 73 65 20 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 se db:get-keys d
2be0: 62 29 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 b)).. (key
2bf0: 6e 61 6d 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 names (map key:g
2c00: 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 et-fieldname key
2c10: 73 29 29 29 0a 09 20 20 3b 3b 20 45 61 63 68 20 s))).. ;; Each
2c20: 72 75 6e 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 run.. (for-each
2c30: 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 72 .. (lambda (r
2c40: 75 6e 29 0a 09 20 20 20 20 20 28 64 65 62 75 67 un).. (debug
2c50: 3a 70 72 69 6e 74 20 31 20 22 52 75 6e 3a 20 22 :print 1 "Run: "
2c60: 0a 09 09 09 20 20 28 73 74 72 69 6e 67 2d 69 6e .... (string-in
2c70: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 tersperse (map (
2c80: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 lambda (x)......
2c90: 09 20 20 20 20 20 28 64 62 3a 67 65 74 2d 76 61 . (db:get-va
2ca0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
2cb0: 6e 20 68 65 61 64 65 72 20 78 29 29 0a 09 09 09 n header x))....
2cc0: 09 09 09 20 20 20 6b 65 79 6e 61 6d 65 73 29 20 ... keynames)
2cd0: 22 2f 22 29 0a 09 09 09 20 20 22 2f 22 0a 09 09 "/").... "/"...
2ce0: 09 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 . (db:get-value
2cf0: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
2d00: 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 eader "runname")
2d10: 0a 09 09 09 20 20 22 20 73 74 61 74 75 73 3a 20 .... " status:
2d20: 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d " (db:get-value-
2d30: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
2d40: 61 64 65 72 20 22 73 74 61 74 65 22 29 29 0a 09 ader "state"))..
2d50: 20 20 20 20 20 28 6c 65 74 20 28 28 72 75 6e 2d (let ((run-
2d60: 69 64 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f id (open-run-clo
2d70: 73 65 20 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d se db:get-value-
2d80: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
2d90: 61 64 65 72 20 22 69 64 22 29 29 29 0a 09 20 20 ader "id")))..
2da0: 20 20 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 (let ((test
2db0: 73 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 s (open-run-clos
2dc0: 65 20 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 e db:get-tests-f
2dd0: 6f 72 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 or-run db run-id
2de0: 20 74 65 73 74 70 61 74 74 20 27 28 29 20 27 28 testpatt '() '(
2df0: 29 29 29 29 0a 09 09 20 3b 3b 20 45 61 63 68 20 ))))... ;; Each
2e00: 74 65 73 74 0a 09 09 20 28 66 6f 72 2d 65 61 63 test... (for-eac
2e10: 68 20 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 28 h ... (lambda (
2e20: 74 65 73 74 29 0a 09 09 20 20 20 20 28 66 6f 72 test)... (for
2e30: 6d 61 74 20 23 74 0a 09 09 09 20 20 20 20 22 20 mat #t.... "
2e40: 20 54 65 73 74 3a 20 7e 32 35 61 20 53 74 61 74 Test: ~25a Stat
2e50: 65 3a 20 7e 31 35 61 20 53 74 61 74 75 73 3a 20 e: ~15a Status:
2e60: 7e 31 35 61 20 52 75 6e 74 69 6d 65 3a 20 7e 35 ~15a Runtime: ~5
2e70: 40 61 73 20 54 69 6d 65 3a 20 7e 32 32 61 20 48 @as Time: ~22a H
2e80: 6f 73 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 09 ost: ~10a\n"....
2e90: 20 20 20 20 28 63 6f 6e 63 20 28 64 62 3a 74 65 (conc (db:te
2ea0: 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 st-get-testname
2eb0: 74 65 73 74 29 0a 09 09 09 09 20 20 28 69 66 20 test)..... (if
2ec0: 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 (equal? (db:test
2ed0: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 -get-item-path t
2ee0: 65 73 74 29 20 22 22 29 0a 09 09 09 09 20 20 20 est) "").....
2ef0: 20 20 20 22 22 20 0a 09 09 09 09 20 20 20 20 20 "" .....
2f00: 20 28 63 6f 6e 63 20 22 28 22 20 28 64 62 3a 74 (conc "(" (db:t
2f10: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
2f20: 68 20 74 65 73 74 29 20 22 29 22 29 29 29 0a 09 h test) ")")))..
2f30: 09 09 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 .. (db:test-g
2f40: 65 74 2d 73 74 61 74 65 20 74 65 73 74 29 0a 09 et-state test)..
2f50: 09 09 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 .. (db:test-g
2f60: 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 0a et-status test).
2f70: 09 09 09 20 20 20 20 28 64 62 3a 74 65 73 74 2d ... (db:test-
2f80: 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e get-run_duration
2f90: 20 74 65 73 74 29 0a 09 09 09 20 20 20 20 28 64 test).... (d
2fa0: 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 b:test-get-event
2fb0: 5f 74 69 6d 65 20 74 65 73 74 29 0a 09 09 09 20 _time test)....
2fc0: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
2fd0: 68 6f 73 74 20 74 65 73 74 29 29 0a 09 09 20 20 host test))...
2fe0: 20 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 (if (not (or (
2ff0: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d equal? (db:test-
3000: 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 get-status test)
3010: 20 22 50 41 53 53 22 29 0a 09 09 09 09 20 28 65 "PASS")..... (e
3020: 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 qual? (db:test-g
3030: 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 20 et-status test)
3040: 22 57 41 52 4e 22 29 0a 09 09 09 09 20 28 65 71 "WARN")..... (eq
3050: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
3060: 74 2d 73 74 61 74 65 20 74 65 73 74 29 20 20 22 t-state test) "
3070: 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 29 29 0a NOT_STARTED"))).
3080: 09 09 09 28 62 65 67 69 6e 0a 09 09 09 20 20 28 ...(begin.... (
3090: 70 72 69 6e 74 20 22 20 20 20 20 20 20 20 20 20 print "
30a0: 63 70 75 6c 6f 61 64 3a 20 20 22 20 28 64 62 3a cpuload: " (db:
30b0: 74 65 73 74 2d 67 65 74 2d 63 70 75 6c 6f 61 64 test-get-cpuload
30c0: 20 74 65 73 74 29 0a 09 09 09 09 20 22 5c 6e 20 test)..... "\n
30d0: 20 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 diskfree
30e0: 3a 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 : " (db:test-get
30f0: 2d 64 69 73 6b 66 72 65 65 20 74 65 73 74 29 0a -diskfree test).
3100: 09 09 09 09 20 22 5c 6e 20 20 20 20 20 20 20 20 .... "\n
3110: 20 75 6e 61 6d 65 3a 20 20 20 20 22 20 28 64 62 uname: " (db
3120: 3a 74 65 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 :test-get-uname
3130: 74 65 73 74 29 0a 09 09 09 09 20 22 5c 6e 20 20 test)..... "\n
3140: 20 20 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 rundir:
3150: 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d " (db:test-get-
3160: 72 75 6e 64 69 72 20 74 65 73 74 29 0a 09 09 09 rundir test)....
3170: 09 20 29 0a 09 09 09 20 20 3b 3b 20 45 61 63 68 . ).... ;; Each
3180: 20 74 65 73 74 0a 09 09 09 20 20 28 6c 65 74 20 test.... (let
3190: 28 28 73 74 65 70 73 20 28 6f 70 65 6e 2d 72 75 ((steps (open-ru
31a0: 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 2d 73 n-close db:get-s
31b0: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 teps-for-test db
31c0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 (db:test-get-id
31d0: 20 74 65 73 74 29 29 29 29 0a 09 09 09 20 20 20 test))))....
31e0: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 (for-each ....
31f0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 74 65 (lambda (ste
3200: 70 29 0a 09 09 09 20 20 20 20 20 20 20 28 66 6f p).... (fo
3210: 72 6d 61 74 20 23 74 20 0a 09 09 09 09 20 20 20 rmat #t .....
3220: 20 20 20 20 22 20 20 20 20 53 74 65 70 3a 20 7e " Step: ~
3230: 32 30 61 20 53 74 61 74 65 3a 20 7e 31 30 61 20 20a State: ~10a
3240: 53 74 61 74 75 73 3a 20 7e 31 30 61 20 54 69 6d Status: ~10a Tim
3250: 65 20 7e 32 32 61 5c 6e 22 0a 09 09 09 09 20 20 e ~22a\n".....
3260: 20 20 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 (db:step-ge
3270: 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 70 29 t-stepname step)
3280: 0a 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a ..... (db:
3290: 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 step-get-state s
32a0: 74 65 70 29 0a 09 09 09 09 20 20 20 20 20 20 20 tep).....
32b0: 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 (db:step-get-sta
32c0: 74 75 73 20 73 74 65 70 29 0a 09 09 09 09 20 20 tus step).....
32d0: 20 20 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 (db:step-ge
32e0: 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 t-event_time ste
32f0: 70 29 29 29 0a 09 09 09 20 20 20 20 20 73 74 65 p))).... ste
3300: 70 73 29 29 29 29 29 0a 09 09 20 20 74 65 73 74 ps)))))... test
3310: 73 29 29 29 29 0a 09 20 20 20 72 75 6e 73 29 0a s)))).. runs).
3320: 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d . (set! *didsom
3330: 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 29 ething* #t).. )
3340: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
3350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
3390: 53 74 61 72 74 20 74 68 65 20 73 65 72 76 65 72 Start the server
33a0: 20 2d 20 63 61 6e 20 62 65 20 64 6f 6e 65 20 69 - can be done i
33b0: 6e 20 63 6f 6e 6a 75 6e 63 74 69 6f 6e 20 77 69 n conjunction wi
33c0: 74 68 20 2d 72 75 6e 61 6c 6c 20 6f 72 20 2d 72 th -runall or -r
33d0: 75 6e 74 65 73 74 73 20 28 6f 6e 65 20 64 61 79 untests (one day
33e0: 2e 2e 2e 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ...).;;=========
33f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 69 =============.(i
3430: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
3440: 22 2d 73 65 72 76 65 72 22 29 0a 20 20 20 20 28 "-server"). (
3450: 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 let* ((toppath (
3460: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
3470: 09 20 20 20 28 64 62 20 20 20 20 20 20 28 69 66 . (db (if
3480: 20 74 6f 70 70 61 74 68 20 28 6f 70 65 6e 2d 64 toppath (open-d
3490: 62 29 20 23 66 29 29 29 0a 20 20 20 20 20 20 28 b) #f))). (
34a0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
34b0: 20 30 20 22 53 74 61 72 74 69 6e 67 20 74 68 65 0 "Starting the
34c0: 20 73 74 61 6e 64 61 6c 6f 6e 65 20 73 65 72 76 standalone serv
34d0: 65 72 22 29 0a 20 20 20 20 20 20 28 69 66 20 64 er"). (if d
34e0: 62 20 0a 09 20 20 28 6c 65 74 2a 20 28 28 68 6f b .. (let* ((ho
34f0: 73 74 3a 70 6f 72 74 20 28 64 62 3a 67 65 74 2d st:port (db:get-
3500: 76 61 72 20 64 62 20 22 53 45 52 56 45 52 22 29 var db "SERVER")
3510: 29 20 3b 3b 20 74 68 69 73 20 64 6f 65 6e 27 74 ) ;; this doen't
3520: 20 73 75 70 70 6f 72 74 20 6d 75 6c 74 69 70 6c support multipl
3530: 65 20 73 65 72 76 65 72 73 20 42 55 47 21 21 21 e servers BUG!!!
3540: 21 0a 09 09 20 28 74 68 32 20 28 73 65 72 76 65 !... (th2 (serve
3550: 72 3a 73 74 61 72 74 20 64 62 20 28 61 72 67 73 r:start db (args
3560: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 72 76 65 :get-arg "-serve
3570: 72 22 29 29 29 0a 09 09 20 28 74 68 33 20 28 6d r")))... (th3 (m
3580: 61 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 ake-thread (lamb
3590: 64 61 20 28 29 0a 09 09 09 09 20 20 20 20 20 28 da ()..... (
35a0: 73 65 72 76 65 72 3a 6b 65 65 70 2d 72 75 6e 6e server:keep-runn
35b0: 69 6e 67 20 64 62 20 68 6f 73 74 3a 70 6f 72 74 ing db host:port
35c0: 29 29 29 29 29 0a 09 20 20 20 20 28 74 68 72 65 ))))).. (thre
35d0: 61 64 2d 73 74 61 72 74 21 20 74 68 33 29 0a 09 ad-start! th3)..
35e0: 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e (thread-join
35f0: 21 20 74 68 33 29 0a 09 20 20 20 20 28 73 65 74 ! th3).. (set
3600: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
3610: 20 23 74 29 29 0a 09 20 20 28 64 65 62 75 67 3a #t)).. (debug:
3620: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
3630: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 20 Failed to setup
3640: 66 6f 72 20 6d 65 67 61 74 65 73 74 22 29 29 29 for megatest")))
3650: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
3660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 66 ===========.;; f
36a0: 75 6c 6c 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d ull run.;;======
36b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36f0: 0a 0a 3b 3b 20 67 65 74 20 6c 6f 63 6b 20 69 6e ..;; get lock in
3700: 20 64 62 20 66 6f 72 20 66 75 6c 6c 20 72 75 6e db for full run
3710: 20 66 6f 72 20 74 68 69 73 20 64 69 72 65 63 74 for this direct
3720: 6f 72 79 0a 3b 3b 20 66 6f 72 20 61 6c 6c 20 74 ory.;; for all t
3730: 65 73 74 73 20 77 69 74 68 20 64 65 70 73 0a 3b ests with deps.;
3740: 3b 20 20 20 77 61 6c 6b 20 74 72 65 65 20 6f 66 ; walk tree of
3750: 20 74 65 73 74 73 20 74 6f 20 66 69 6e 64 20 68 tests to find h
3760: 65 61 64 20 74 61 73 6b 73 0a 3b 3b 20 20 20 61 ead tasks.;; a
3770: 64 64 20 68 65 61 64 20 74 61 73 6b 73 20 74 6f dd head tasks to
3780: 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 20 task queue.;;
3790: 20 61 64 64 20 64 65 70 65 6e 64 61 6e 74 20 74 add dependant t
37a0: 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 asks to task que
37b0: 75 65 20 0a 3b 3b 20 20 20 61 64 64 20 72 65 6d ue .;; add rem
37c0: 61 69 6e 69 6e 67 20 74 61 73 6b 73 20 74 6f 20 aining tasks to
37d0: 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 66 6f task queue.;; fo
37e0: 72 20 65 61 63 68 20 74 61 73 6b 20 69 6e 20 74 r each task in t
37f0: 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 20 20 69 ask queue.;; i
3800: 66 20 68 61 76 65 20 61 64 65 71 75 61 74 65 20 f have adequate
3810: 72 65 73 6f 75 72 63 65 73 0a 3b 3b 20 20 20 20 resources.;;
3820: 20 6c 61 75 6e 63 68 20 74 61 73 6b 0a 3b 3b 20 launch task.;;
3830: 20 20 65 6c 73 65 0a 3b 3b 20 20 20 20 20 70 75 else.;; pu
3840: 74 20 74 61 73 6b 20 69 6e 20 64 65 66 65 72 72 t task in deferr
3850: 65 64 20 71 75 65 75 65 0a 3b 3b 20 69 66 20 73 ed queue.;; if s
3860: 74 69 6c 6c 20 6f 6b 20 74 6f 20 72 75 6e 20 74 till ok to run t
3870: 61 73 6b 73 0a 3b 3b 20 20 20 70 72 6f 63 65 73 asks.;; proces
3880: 73 20 64 65 66 65 72 72 65 64 20 74 61 73 6b 73 s deferred tasks
3890: 20 70 65 72 20 61 62 6f 76 65 20 73 74 65 70 73 per above steps
38a0: 0a 0a 3b 3b 20 72 75 6e 20 61 6c 6c 20 74 65 73 ..;; run all tes
38b0: 74 73 20 61 72 65 20 61 72 65 20 4e 6f 74 20 43 ts are are Not C
38c0: 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 50 41 53 OMPLETED and PAS
38d0: 53 20 6f 72 20 43 48 45 43 4b 0a 28 69 66 20 28 S or CHECK.(if (
38e0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
38f0: 75 6e 61 6c 6c 22 29 0a 20 20 20 20 28 67 65 6e unall"). (gen
3900: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 eral-run-call .
3910: 20 20 20 20 22 2d 72 75 6e 61 6c 6c 22 0a 20 20 "-runall".
3920: 20 20 20 22 72 75 6e 20 61 6c 6c 20 74 65 73 74 "run all test
3930: 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 s". (lambda
3940: 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 (target runname
3950: 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 keys keynames ke
3960: 79 76 61 6c 6c 73 74 29 0a 09 20 28 72 75 6e 73 yvallst).. (runs
3970: 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 72 67 65 :run-tests targe
3980: 74 0a 09 09 09 20 72 75 6e 6e 61 6d 65 0a 09 09 t.... runname...
3990: 09 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d . (if (args:get-
39a0: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
39b0: 0a 09 09 09 20 20 20 20 20 28 61 72 67 73 3a 67 .... (args:g
39c0: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
39d0: 74 22 29 0a 09 09 09 20 20 20 20 20 22 25 2f 25 t").... "%/%
39e0: 22 29 0a 09 09 09 20 75 73 65 72 0a 09 09 09 20 ").... user....
39f0: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 args:arg-hash)))
3a00: 29 20 3b 3b 20 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ) ;; )..;;======
3a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a50: 0a 3b 3b 20 72 75 6e 20 6f 6e 65 20 74 65 73 74 .;; run one test
3a60: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
3a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e =========..;; 1.
3ab0: 20 66 69 6e 64 20 74 68 65 20 63 6f 6e 66 69 67 find the config
3ac0: 20 66 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 61 6e file.;; 2. chan
3ad0: 67 65 20 74 6f 20 74 68 65 20 74 65 73 74 20 64 ge to the test d
3ae0: 69 72 65 63 74 6f 72 79 0a 3b 3b 20 33 2e 20 75 irectory.;; 3. u
3af0: 70 64 61 74 65 20 74 68 65 20 64 62 20 77 69 74 pdate the db wit
3b00: 68 20 22 74 65 73 74 20 73 74 61 72 74 65 64 22 h "test started"
3b10: 20 73 74 61 74 75 73 2c 20 73 65 74 20 72 75 6e status, set run
3b20: 6e 69 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 2e 20 ning host.;; 4.
3b30: 70 72 6f 63 65 73 73 20 6c 61 75 6e 63 68 20 74 process launch t
3b40: 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 he test.;; -
3b50: 6d 6f 6e 69 74 6f 72 20 74 68 65 20 70 72 6f 63 monitor the proc
3b60: 65 73 73 2c 20 75 70 64 61 74 65 20 73 74 61 74 ess, update stat
3b70: 73 20 69 6e 20 74 68 65 20 64 62 20 65 76 65 72 s in the db ever
3b80: 79 20 32 5e 6e 20 6d 69 6e 75 74 65 73 0a 3b 3b y 2^n minutes.;;
3b90: 20 35 2e 20 61 73 20 74 68 65 20 74 65 73 74 20 5. as the test
3ba0: 70 72 6f 63 65 65 64 73 20 69 6e 74 65 72 6e 61 proceeds interna
3bb0: 6c 6c 79 20 69 74 20 63 61 6c 6c 73 20 6d 65 67 lly it calls meg
3bc0: 61 74 65 73 74 20 61 73 20 65 61 63 68 20 73 74 atest as each st
3bd0: 65 70 20 69 73 0a 3b 3b 20 20 20 20 73 74 61 72 ep is.;; star
3be0: 74 65 64 20 61 6e 64 20 63 6f 6d 70 6c 65 74 65 ted and complete
3bf0: 64 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 73 d.;; - step s
3c00: 74 61 72 74 65 64 2c 20 74 69 6d 65 73 74 61 6d tarted, timestam
3c10: 70 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 63 p.;; - step c
3c20: 6f 6d 70 6c 65 74 65 64 2c 20 65 78 69 74 20 73 ompleted, exit s
3c30: 74 61 74 75 73 2c 20 74 69 6d 65 73 74 61 6d 70 tatus, timestamp
3c40: 0a 3b 3b 20 36 2e 20 74 65 73 74 20 70 68 6f 6e .;; 6. test phon
3c50: 65 20 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d 20 69 e home.;; - i
3c60: 66 20 74 65 73 74 20 72 75 6e 20 74 69 6d 65 20 f test run time
3c70: 3e 20 61 6c 6c 6f 77 65 64 20 72 75 6e 20 74 69 > allowed run ti
3c80: 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 me then kill job
3c90: 0a 3b 3b 20 20 20 20 2d 20 69 66 20 63 61 6e 6e .;; - if cann
3ca0: 6f 74 20 61 63 63 65 73 73 20 64 62 20 3e 20 61 ot access db > a
3cb0: 6c 6c 6f 77 65 64 20 64 69 73 63 6f 6e 6e 65 63 llowed disconnec
3cc0: 74 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c t time then kill
3cd0: 20 6a 6f 62 0a 0a 28 69 66 20 28 61 72 67 73 3a job..(if (args:
3ce0: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 get-arg "-runtes
3cf0: 74 73 22 29 0a 20 20 28 67 65 6e 65 72 61 6c 2d ts"). (general-
3d00: 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 22 2d 72 run-call . "-r
3d10: 75 6e 74 65 73 74 73 22 20 0a 20 20 20 22 72 75 untests" . "ru
3d20: 6e 20 61 20 74 65 73 74 22 20 0a 20 20 20 28 6c n a test" . (l
3d30: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
3d40: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 nname keys keyna
3d50: 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 mes keyvallst).
3d60: 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 (runs:run-te
3d70: 73 74 73 20 74 61 72 67 65 74 0a 09 09 20 20 20 sts target...
3d80: 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 20 20 runname...
3d90: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3da0: 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 09 20 20 -runtests")...
3db0: 20 20 20 75 73 65 72 0a 09 09 20 20 20 20 20 61 user... a
3dc0: 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 29 rgs:arg-hash))))
3dd0: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
3de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 6f ==========.;; Ro
3e20: 6c 6c 75 70 20 69 6e 74 6f 20 61 20 72 75 6e 0a llup into a run.
3e30: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
3e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3e70: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
3e80: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 6f rgs:get-arg "-ro
3e90: 6c 6c 75 70 22 29 0a 20 20 20 20 28 62 65 67 69 llup"). (begi
3ea0: 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 n. (debug:p
3eb0: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 52 rint 0 "ERROR: R
3ec0: 6f 6c 6c 75 70 20 69 73 20 63 75 72 72 65 6e 74 ollup is current
3ed0: 6c 79 20 6e 6f 74 20 77 6f 72 6b 69 6e 67 2e 20 ly not working.
3ee0: 49 66 20 79 6f 75 20 6e 65 65 64 20 69 74 20 70 If you need it p
3ef0: 6c 65 61 73 65 20 73 75 62 6d 69 74 20 61 20 74 lease submit a t
3f00: 69 63 6b 65 74 20 61 74 20 68 74 74 70 3a 2f 2f icket at http://
3f10: 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 www.kiatoa.com/f
3f20: 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 22 ossils/megatest"
3f30: 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 34 29 ). (exit 4)
3f40: 29 29 0a 3b 3b 20 20 20 20 20 28 67 65 6e 65 72 )).;; (gener
3f50: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 3b 3b 20 al-run-call .;;
3f60: 20 20 20 20 20 22 2d 72 6f 6c 6c 75 70 22 20 0a "-rollup" .
3f70: 3b 3b 20 20 20 20 20 20 22 72 6f 6c 6c 75 70 20 ;; "rollup
3f80: 74 65 73 74 73 22 20 0a 3b 3b 20 20 20 20 20 20 tests" .;;
3f90: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
3fa0: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
3fb0: 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 names keyvallst)
3fc0: 0a 3b 3b 20 20 20 20 20 20 20 20 28 72 75 6e 73 .;; (runs
3fd0: 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 6b 65 79 73 :rollup-run keys
3fe0: 0a 3b 3b 20 09 09 09 28 6b 65 79 73 2d 3e 61 6c .;; ...(keys->al
3ff0: 69 73 74 20 6b 65 79 73 20 22 6e 61 22 29 0a 3b ist keys "na").;
4000: 3b 20 09 09 09 28 61 72 67 73 3a 67 65 74 2d 61 ; ...(args:get-a
4010: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 0a rg ":runname") .
4020: 3b 3b 20 09 09 09 75 73 65 72 29 29 29 29 0a 0a ;; ...user))))..
4030: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
4040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4070: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 6f 63 6b ========.;; Lock
4080: 20 6f 72 20 75 6e 6c 6f 63 6b 20 61 20 72 75 6e or unlock a run
4090: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
40a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
40e0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
40f0: 20 22 2d 6c 6f 63 6b 22 29 28 61 72 67 73 3a 67 "-lock")(args:g
4100: 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b 22 et-arg "-unlock"
4110: 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d )). (general-
4120: 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 28 run-call . (
4130: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
4140: 20 22 2d 6c 6f 63 6b 22 29 20 22 2d 6c 6f 63 6b "-lock") "-lock
4150: 22 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 20 20 " "-unlock").
4160: 20 20 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 20 74 "lock/unlock t
4170: 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c 61 6d ests" . (lam
4180: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
4190: 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 ame keys keyname
41a0: 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 s keyvallst).
41b0: 20 20 20 20 28 72 75 6e 73 3a 68 61 6e 64 6c 65 (runs:handle
41c0: 2d 6c 6f 63 6b 69 6e 67 20 0a 09 09 20 20 74 61 -locking ... ta
41d0: 72 67 65 74 0a 09 09 20 20 6b 65 79 73 0a 09 09 rget... keys...
41e0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
41f0: 22 3a 72 75 6e 6e 61 6d 65 22 29 20 0a 09 09 20 ":runname") ...
4200: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4210: 2d 6c 6f 63 6b 22 29 0a 09 09 20 20 28 61 72 67 -lock")... (arg
4220: 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f s:get-arg "-unlo
4230: 63 6b 22 29 0a 09 09 20 20 75 73 65 72 29 29 29 ck")... user)))
4240: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
4250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 ===========.;; G
4290: 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 74 et paths to test
42a0: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
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 0a 3b 3b 20 47 65 ==========.;; Ge
42f0: 74 20 74 65 73 74 20 70 61 74 68 73 20 6d 61 74 t test paths mat
4300: 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 75 ching target, ru
4310: 6e 6e 61 6d 65 2c 20 74 65 73 74 70 61 74 74 2c nname, testpatt,
4320: 20 61 6e 64 20 69 74 65 6d 70 61 74 74 0a 28 69 and itempatt.(i
4330: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
4340: 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 arg "-test-files
4350: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
4360: 22 2d 74 65 73 74 2d 70 61 74 68 73 22 29 29 0a "-test-paths")).
4370: 20 20 20 20 3b 3b 20 69 66 20 77 65 20 61 72 65 ;; if we are
4380: 20 69 6e 20 61 20 74 65 73 74 20 75 73 65 20 74 in a test use t
4390: 68 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 61 he MT_CMDINFO da
43a0: 74 61 0a 20 20 20 20 28 69 66 20 28 67 65 74 65 ta. (if (gete
43b0: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
43c0: 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 ..(let* ((starti
43d0: 6e 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 ngdir (current-d
43e0: 69 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 irectory))..
43f0: 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 (cmdinfo (r
4400: 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d ead (open-input-
4410: 73 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 string (base64:b
4420: 61 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 ase64-decode (ge
4430: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
4440: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 "))))).. (
4450: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
4460: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
4470: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
4480: 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
4490: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
44a0: 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
44b0: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
44c0: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
44d0: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
44e0: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
44f0: 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 (db-host (
4500: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 assoc/default 'd
4510: 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f b-host cmdinfo
4520: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
4530: 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 id (assoc/def
4540: 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 ault 'run-id
4550: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
4560: 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
4570: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
4580: 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
4590: 0a 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 .. (db
45a0: 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 #f)..
45b0: 28 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 (state (args
45c0: 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 :get-arg ":state
45d0: 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 ")).. (sta
45e0: 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 tus (args:get
45f0: 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 -arg ":status"))
4600: 0a 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 .. (target
4610: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
4620: 67 20 22 2d 74 61 72 67 65 74 22 29 29 0a 09 20 g "-target"))..
4630: 20 20 20 20 20 20 28 74 6f 70 70 61 74 68 20 20 (toppath
4640: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
4650: 27 74 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 'toppath cmdin
4660: 66 6f 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 fo))).. (change
4670: 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 70 61 -directory toppa
4680: 74 68 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 th).. (if (not
4690: 74 61 72 67 65 74 29 0a 09 20 20 20 20 20 20 28 target).. (
46a0: 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 begin...(debug:p
46b0: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 2d rint 0 "ERROR: -
46c0: 74 61 72 67 65 74 20 69 73 20 72 65 71 75 69 72 target is requir
46d0: 65 64 2e 22 29 0a 09 09 28 65 78 69 74 20 31 29 ed.")...(exit 1)
46e0: 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 )).. (if (not (
46f0: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
4700: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
4710: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
4720: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
4730: 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 2d 74 giving up on -t
4740: 65 73 74 2d 70 61 74 68 73 20 6f 72 20 2d 74 65 est-paths or -te
4750: 73 74 2d 66 69 6c 65 73 2c 20 65 78 69 74 69 6e st-files, exitin
4760: 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 g")...(exit 1)))
4770: 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 .. (let* ((keys
4780: 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
4790: 6c 6f 73 65 20 64 62 3a 67 65 74 2d 6b 65 79 73 lose db:get-keys
47a0: 20 64 62 29 29 0a 09 09 20 28 6b 65 79 6e 61 6d db))... (keynam
47b0: 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d es (map key:get-
47c0: 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 fieldname keys))
47d0: 0a 09 09 20 28 70 61 74 68 73 20 20 20 20 28 6f ... (paths (o
47e0: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 pen-run-close db
47f0: 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d :test-get-paths-
4800: 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e matching db keyn
4810: 61 6d 65 73 20 74 61 72 67 65 74 20 28 61 72 67 ames target (arg
4820: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
4830: 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 20 20 -files"))))..
4840: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
4850: 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 28 hing* #t).. (
4860: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
4870: 20 28 70 61 74 68 29 0a 09 09 09 28 70 72 69 6e (path)....(prin
4880: 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 t path))...
4890: 20 70 61 74 68 73 29 29 29 0a 09 3b 3b 20 65 6c paths)))..;; el
48a0: 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 6c 2d se do a general-
48b0: 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 72 run-call..(gener
48c0: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 22 al-run-call .. "
48d0: 2d 74 65 73 74 2d 66 69 6c 65 73 22 0a 09 20 22 -test-files".. "
48e0: 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 Get paths to tes
48f0: 74 22 0a 09 20 28 6c 61 6d 62 64 61 20 28 74 61 t".. (lambda (ta
4900: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
4910: 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 s keynames keyva
4920: 6c 6c 73 74 29 0a 09 20 20 20 28 6c 65 74 2a 20 llst).. (let*
4930: 28 28 64 62 20 20 20 20 20 20 20 23 66 29 0a 09 ((db #f)..
4940: 09 20 20 28 69 74 65 6d 70 61 74 74 20 28 61 72 . (itempatt (ar
4950: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 gs:get-arg "-ite
4960: 6d 70 61 74 74 22 29 29 0a 09 09 20 20 28 70 61 mpatt"))... (pa
4970: 74 68 73 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e ths (open-run
4980: 2d 63 6c 6f 73 65 20 64 62 3a 74 65 73 74 2d 67 -close db:test-g
4990: 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e et-paths-matchin
49a0: 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 g db keynames ta
49b0: 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d 61 rget (args:get-a
49c0: 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 rg "-test-files"
49d0: 29 29 29 29 0a 09 20 20 20 20 20 28 66 6f 72 2d )))).. (for-
49e0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 each (lambda (pa
49f0: 74 68 29 0a 09 09 09 20 28 70 72 69 6e 74 20 70 th).... (print p
4a00: 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 20 70 ath))... p
4a10: 61 74 68 73 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d aths))))))..;;==
4a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a60: 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 20 ====.;; Archive
4a70: 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d tests.;;========
4a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
4ac0: 3b 20 41 72 63 68 69 76 65 20 74 65 73 74 73 20 ; Archive tests
4ad0: 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c matching target,
4ae0: 20 72 75 6e 6e 61 6d 65 2c 20 74 65 73 74 70 61 runname, testpa
4af0: 74 74 2c 20 61 6e 64 20 69 74 65 6d 70 61 74 74 tt, and itempatt
4b00: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
4b10: 72 67 20 22 2d 61 72 63 68 69 76 65 22 29 0a 20 rg "-archive").
4b20: 20 20 20 3b 3b 20 69 66 20 77 65 20 61 72 65 20 ;; if we are
4b30: 69 6e 20 61 20 74 65 73 74 20 75 73 65 20 74 68 in a test use th
4b40: 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 61 74 e MT_CMDINFO dat
4b50: 61 0a 20 20 20 20 28 69 66 20 28 67 65 74 65 6e a. (if (geten
4b60: 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 0a v "MT_CMDINFO").
4b70: 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e .(let* ((startin
4b80: 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 gdir (current-di
4b90: 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 rectory))..
4ba0: 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 (cmdinfo (re
4bb0: 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 ad (open-input-s
4bc0: 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 tring (base64:ba
4bd0: 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 74 se64-decode (get
4be0: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
4bf0: 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 ))))).. (t
4c00: 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f estpath (assoc/
4c10: 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 default 'testpat
4c20: 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 h cmdinfo))..
4c30: 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 (test-name
4c40: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
4c50: 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 test-name cmdinf
4c60: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
4c70: 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 script (assoc/de
4c80: 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 fault 'runscript
4c90: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
4ca0: 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 (db-host (a
4cb0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 ssoc/default 'db
4cc0: 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 -host cmdinfo)
4cd0: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 ).. (run-i
4ce0: 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 d (assoc/defa
4cf0: 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 ult 'run-id c
4d00: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
4d10: 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 (itemdat (ass
4d20: 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d oc/default 'item
4d30: 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a dat cmdinfo)).
4d40: 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 20 . (db
4d50: 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 #f).. (
4d60: 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 3a state (args:
4d70: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 get-arg ":state"
4d80: 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 )).. (stat
4d90: 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d us (args:get-
4da0: 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a arg ":status")).
4db0: 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 20 . (target
4dc0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
4dd0: 20 22 2d 74 61 72 67 65 74 22 29 29 29 0a 09 20 "-target")))..
4de0: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
4df0: 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 20 20 ry testpath)..
4e00: 28 69 66 20 28 6e 6f 74 20 74 61 72 67 65 74 29 (if (not target)
4e10: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
4e20: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
4e30: 22 45 52 52 4f 52 3a 20 2d 74 61 72 67 65 74 20 "ERROR: -target
4e40: 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 0a 09 is required.")..
4e50: 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 .(exit 1))).. (
4e60: 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 if (not (setup-f
4e70: 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 or-run))..
4e80: 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a (begin...(debug:
4e90: 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 print 0 "Failed
4ea0: 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 6e 67 to setup, giving
4eb0: 20 75 70 20 6f 6e 20 2d 61 72 63 68 69 76 65 2c up on -archive,
4ec0: 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 exiting")...(ex
4ed0: 69 74 20 31 29 29 29 0a 09 20 20 28 6c 65 74 2a it 1))).. (let*
4ee0: 20 28 28 69 74 65 6d 70 61 74 74 20 28 61 72 67 ((itempatt (arg
4ef0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d s:get-arg "-item
4f00: 70 61 74 74 22 29 29 0a 09 09 20 28 6b 65 79 73 patt"))... (keys
4f10: 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
4f20: 6c 6f 73 65 20 64 62 3a 67 65 74 2d 6b 65 79 73 lose db:get-keys
4f30: 20 64 62 29 29 0a 09 09 20 28 6b 65 79 6e 61 6d db))... (keynam
4f40: 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d es (map key:get-
4f50: 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 fieldname keys))
4f60: 0a 09 09 20 28 70 61 74 68 73 20 20 20 20 28 6f ... (paths (o
4f70: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 pen-run-close db
4f80: 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d :test-get-paths-
4f90: 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e matching db keyn
4fa0: 61 6d 65 73 20 74 61 72 67 65 74 29 29 29 0a 09 ames target)))..
4fb0: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
4fc0: 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 mething* #t)..
4fd0: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
4fe0: 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 28 70 bda (path)....(p
4ff0: 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 20 20 rint path))...
5000: 20 20 20 20 70 61 74 68 73 29 29 29 0a 09 3b 3b paths)))..;;
5010: 20 65 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 72 else do a gener
5020: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 al-run-call..(ge
5030: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
5040: 09 20 22 2d 74 65 73 74 2d 70 61 74 68 73 22 0a . "-test-paths".
5050: 09 20 22 47 65 74 20 70 61 74 68 73 20 74 6f 20 . "Get paths to
5060: 74 65 73 74 73 22 0a 09 20 28 6c 61 6d 62 64 61 tests".. (lambda
5070: 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 (target runname
5080: 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b keys keynames k
5090: 65 79 76 61 6c 6c 73 74 29 0a 09 20 20 20 28 6c eyvallst).. (l
50a0: 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 23 et* ((db #
50b0: 66 29 0a 09 09 20 20 28 69 74 65 6d 70 61 74 74 f)... (itempatt
50c0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
50d0: 2d 69 74 65 6d 70 61 74 74 22 29 29 0a 09 09 20 -itempatt"))...
50e0: 20 28 70 61 74 68 73 20 20 20 20 28 6f 70 65 6e (paths (open
50f0: 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 74 65 -run-close db:te
5100: 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 st-get-paths-mat
5110: 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 ching db keyname
5120: 73 20 74 61 72 67 65 74 29 29 29 0a 09 20 20 20 s target)))..
5130: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
5140: 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 20 28 bda (path).... (
5150: 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 20 print path))...
5160: 20 20 20 20 20 20 70 61 74 68 73 29 29 29 29 29 paths)))))
5170: 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 ===========.;; E
51c0: 78 74 72 61 63 74 20 61 20 73 70 72 65 61 64 73 xtract a spreads
51d0: 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 72 75 heet from the ru
51e0: 6e 73 20 64 61 74 61 62 61 73 65 0a 3b 3b 3d 3d ns database.;;==
51f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5230: 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
5240: 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 61 63 get-arg "-extrac
5250: 74 2d 6f 64 73 22 29 0a 20 20 20 20 28 67 65 6e t-ods"). (gen
5260: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 eral-run-call.
5270: 20 20 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 "-extract-ods
5280: 22 0a 20 20 20 20 20 22 4d 61 6b 65 20 6f 64 73 ". "Make ods
5290: 20 73 70 72 65 61 64 73 68 65 65 74 22 0a 20 20 spreadsheet".
52a0: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
52b0: 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
52c0: 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c keynames keyvall
52d0: 73 74 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 st). (let
52e0: 28 28 64 62 20 20 20 20 20 20 20 20 20 23 66 29 ((db #f)
52f0: 0a 09 20 20 20 20 20 28 6f 75 74 70 75 74 66 69 .. (outputfi
5300: 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 le (args:get-arg
5310: 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 "-extract-ods")
5320: 29 0a 09 20 20 20 20 20 28 72 75 6e 73 70 61 74 ).. (runspat
5330: 74 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 t (args:get-ar
5340: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g ":runname"))..
5350: 20 20 20 20 20 28 70 61 74 68 6d 6f 64 20 20 20 (pathmod
5360: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5370: 2d 70 61 74 68 6d 6f 64 22 29 29 0a 09 20 20 20 -pathmod"))..
5380: 20 20 28 6b 65 79 76 61 6c 61 6c 69 73 74 20 28 (keyvalalist (
5390: 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 79 73 keys->alist keys
53a0: 20 22 25 22 29 29 29 0a 09 20 28 64 65 62 75 67 "%"))).. (debug
53b0: 3a 70 72 69 6e 74 20 32 20 22 45 78 74 72 61 63 :print 2 "Extrac
53c0: 74 20 6f 64 73 2c 20 6f 75 74 70 75 74 66 69 6c t ods, outputfil
53d0: 65 3a 20 22 20 6f 75 74 70 75 74 66 69 6c 65 20 e: " outputfile
53e0: 22 20 72 75 6e 73 70 61 74 74 3a 20 22 20 72 75 " runspatt: " ru
53f0: 6e 73 70 61 74 74 20 22 20 6b 65 79 76 61 6c 61 nspatt " keyvala
5400: 6c 69 73 74 3a 20 22 20 6b 65 79 76 61 6c 61 6c list: " keyvalal
5410: 69 73 74 29 0a 09 20 28 6f 70 65 6e 2d 72 75 6e ist).. (open-run
5420: 2d 63 6c 6f 73 65 20 64 62 3a 65 78 74 72 61 63 -close db:extrac
5430: 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 20 6f 75 t-ods-file db ou
5440: 74 70 75 74 66 69 6c 65 20 6b 65 79 76 61 6c 61 tputfile keyvala
5450: 6c 69 73 74 20 28 69 66 20 72 75 6e 73 70 61 74 list (if runspat
5460: 74 20 72 75 6e 73 70 61 74 74 20 22 25 22 29 20 t runspatt "%")
5470: 70 61 74 68 6d 6f 64 29 29 29 29 29 0a 0a 3b 3b pathmod)))))..;;
5480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
54a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
54b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
54c0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 63 75 74 ======.;; execut
54d0: 65 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 e the test.;;
54e0: 20 2d 20 67 65 74 73 20 63 61 6c 6c 65 64 20 6f - gets called o
54f0: 6e 20 72 65 6d 6f 74 65 20 68 6f 73 74 0a 3b 3b n remote host.;;
5500: 20 20 20 20 2d 20 72 65 63 65 69 76 65 73 20 69 - receives i
5510: 6e 66 6f 20 66 72 6f 6d 20 74 68 65 20 2d 65 78 nfo from the -ex
5520: 65 63 75 74 65 20 70 61 72 61 6d 0a 3b 3b 20 20 ecute param.;;
5530: 20 20 2d 20 70 61 73 73 65 73 20 69 6e 66 6f 20 - passes info
5540: 74 6f 20 73 74 65 70 73 20 76 69 61 20 4d 54 5f to steps via MT_
5550: 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 CMDINFO env var
5560: 28 66 75 74 75 72 65 20 69 73 20 74 6f 20 75 73 (future is to us
5570: 65 20 61 20 64 6f 74 20 66 69 6c 65 29 0a 3b 3b e a dot file).;;
5580: 20 20 20 20 2d 20 67 61 74 68 65 72 73 20 68 6f - gathers ho
5590: 73 74 20 69 6e 66 6f 20 61 6e 64 20 0a 3b 3b 3d st info and .;;=
55a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55e0: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
55f0: 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 :get-arg "-execu
5600: 74 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a te"). (begin.
5610: 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 65 78 (launch:ex
5620: 65 63 75 74 65 20 28 61 72 67 73 3a 67 65 74 2d ecute (args:get-
5630: 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 29 arg "-execute"))
5640: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
5650: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
5660: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
5670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
56a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 ===========.;; T
56b0: 65 73 74 20 63 6f 6d 6d 61 6e 64 73 20 28 69 2e est commands (i.
56c0: 65 2e 20 66 6f 72 20 75 73 65 20 69 6e 73 69 64 e. for use insid
56d0: 65 20 74 65 73 74 73 29 0a 3b 3b 3d 3d 3d 3d 3d e tests).;;=====
56e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
56f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5720: 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 =..(if (args:get
5730: 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a 20 20 -arg "-step").
5740: 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 65 (if (not (gete
5750: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
5760: 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 )..(begin.. (de
5770: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
5780: 4f 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 OR: MT_CMDINFO e
5790: 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 nv var not set,
57a0: 2d 73 74 65 70 20 6d 75 73 74 20 62 65 20 63 61 -step must be ca
57b0: 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 lled *inside* a
57c0: 6d 65 67 61 74 65 73 74 20 69 6e 76 6f 6b 65 64 megatest invoked
57d0: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a environment!").
57e0: 09 20 20 28 65 78 69 74 20 35 29 29 0a 09 28 6c . (exit 5))..(l
57f0: 65 74 2a 20 28 28 73 74 65 70 20 20 20 20 20 20 et* ((step
5800: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5810: 73 74 65 70 22 29 29 0a 09 20 20 20 20 20 20 20 step"))..
5820: 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 64 (cmdinfo (read
5830: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 (open-input-str
5840: 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 73 65 ing (base64:base
5850: 36 34 2d 64 65 63 6f 64 65 20 28 67 65 74 65 6e 64-decode (geten
5860: 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 v "MT_CMDINFO"))
5870: 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 ))).. (tes
5880: 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 tpath (assoc/de
5890: 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 fault 'testpath
58a0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
58b0: 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 (test-name (a
58c0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
58d0: 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 st-name cmdinfo)
58e0: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 ).. (runsc
58f0: 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 ript (assoc/defa
5900: 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 ult 'runscript c
5910: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
5920: 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 (db-host (ass
5930: 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 oc/default 'db-h
5940: 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a ost cmdinfo)).
5950: 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 . (run-id
5960: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
5970: 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 t 'run-id cmd
5980: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
5990: 74 65 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 test-id (assoc
59a0: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 /default 'test-i
59b0: 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 d cmdinfo))..
59c0: 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 (itemdat
59d0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
59e0: 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 'itemdat cmdin
59f0: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 fo)).. (db
5a00: 20 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 #f)..
5a10: 20 20 20 20 28 73 74 61 74 65 20 20 20 20 28 61 (state (a
5a20: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
5a30: 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 ate")).. (
5a40: 73 74 61 74 75 73 20 20 20 28 61 72 67 73 3a 67 status (args:g
5a50: 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 et-arg ":status"
5a60: 29 29 0a 09 20 20 20 20 20 20 20 28 6c 6f 67 66 )).. (logf
5a70: 69 6c 65 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ile (args:get-a
5a80: 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 29 29 0a rg "-setlog"))).
5a90: 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
5aa0: 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
5ab0: 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 (if (not (setu
5ac0: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 p-for-run))..
5ad0: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 (begin...(deb
5ae0: 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c ug:print 0 "Fail
5af0: 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
5b00: 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 ting")...(exit 1
5b10: 29 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 ))).. (if (and
5b20: 73 74 61 74 65 20 73 74 61 74 75 73 29 0a 09 20 state status)..
5b30: 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
5b40: 6c 6f 73 65 20 64 62 3a 74 65 73 74 73 74 65 70 lose db:teststep
5b50: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 -set-status! db
5b60: 74 65 73 74 2d 69 64 20 73 74 65 70 20 73 74 61 test-id step sta
5b70: 74 65 20 73 74 61 74 75 73 20 28 61 72 67 73 3a te status (args:
5b80: 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 6c 6f get-arg "-m") lo
5b90: 67 66 69 6c 65 29 0a 09 20 20 20 20 20 20 28 62 gfile).. (b
5ba0: 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 egin...(debug:pr
5bb0: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 59 6f int 0 "ERROR: Yo
5bc0: 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 3a u must specify :
5bd0: 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 state and :statu
5be0: 73 20 77 69 74 68 20 65 76 65 72 79 20 63 61 6c s with every cal
5bf0: 6c 20 74 6f 20 2d 73 74 65 70 22 29 0a 09 09 28 l to -step")...(
5c00: 65 78 69 74 20 36 29 29 29 0a 09 20 20 28 69 66 exit 6))).. (if
5c10: 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e db (sqlite3:fin
5c20: 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 20 20 28 alize! db)).. (
5c30: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
5c40: 6e 67 2a 20 23 74 29 29 29 29 0a 0a 28 69 66 20 ng* #t))))..(if
5c50: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
5c60: 67 20 22 2d 73 65 74 6c 6f 67 22 29 20 20 20 20 g "-setlog")
5c70: 20 20 20 3b 3b 20 73 69 6e 63 65 20 73 65 74 74 ;; since sett
5c80: 69 6e 67 20 75 70 20 69 73 20 73 6f 20 63 6f 73 ing up is so cos
5c90: 74 6c 79 20 6c 65 74 73 20 70 69 67 67 79 62 61 tly lets piggyba
5ca0: 63 6b 20 6f 6e 20 2d 74 65 73 74 2d 73 74 61 74 ck on -test-stat
5cb0: 75 73 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 us..(args:get-ar
5cc0: 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 g "-set-toplog")
5cd0: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
5ce0: 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a "-test-status").
5cf0: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
5d00: 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 0a 09 28 -set-values")..(
5d10: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
5d20: 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a oad-test-data").
5d30: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
5d40: 2d 72 75 6e 73 74 65 70 22 29 0a 09 28 61 72 67 -runstep")..(arg
5d50: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d 6d s:get-arg "-summ
5d60: 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 29 0a 20 arize-items")).
5d70: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 (if (not (get
5d80: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
5d90: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
5da0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
5db0: 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 ROR: MT_CMDINFO
5dc0: 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c env var not set,
5dd0: 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 65 73 74 2d commands -test-
5de0: 73 74 61 74 75 73 2c 20 2d 72 75 6e 73 74 65 70 status, -runstep
5df0: 20 61 6e 64 20 2d 73 65 74 6c 6f 67 20 6d 75 73 and -setlog mus
5e00: 74 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 t be called *ins
5e10: 69 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 ide* a megatest
5e20: 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 environment!")..
5e30: 20 20 28 65 78 69 74 20 35 29 29 0a 09 28 6c 65 (exit 5))..(le
5e40: 74 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 t* ((startingdir
5e50: 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 (current-direct
5e60: 6f 72 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 ory)).. (c
5e70: 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 mdinfo (read (
5e80: 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e open-input-strin
5e90: 67 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 g (base64:base64
5ea0: 2d 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 -decode (getenv
5eb0: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 "MT_CMDINFO"))))
5ec0: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 ).. (testp
5ed0: 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
5ee0: 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
5ef0: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
5f00: 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 (test-name (ass
5f10: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
5f20: 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a -name cmdinfo)).
5f30: 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 . (runscri
5f40: 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c pt (assoc/defaul
5f50: 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 t 'runscript cmd
5f60: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
5f70: 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 db-host (assoc
5f80: 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 /default 'db-hos
5f90: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
5fa0: 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id
5fb0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
5fc0: 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 'run-id cmdin
5fd0: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 fo)).. (te
5fe0: 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 st-id (assoc/d
5ff0: 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 efault 'test-id
6000: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
6010: 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 (itemdat (
6020: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 assoc/default 'i
6030: 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f temdat cmdinfo
6040: 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 20 20 )).. (db
6050: 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 #f)..
6060: 20 20 28 73 74 61 74 65 20 20 20 20 20 28 61 72 (state (ar
6070: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
6080: 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 te")).. (s
6090: 74 61 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 tatus (args:g
60a0: 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 et-arg ":status"
60b0: 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 ))).. (change-d
60c0: 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
60d0: 68 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 h).. (if (not (
60e0: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
60f0: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
6100: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
6110: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
6120: 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 exiting")...(ex
6130: 69 74 20 31 29 29 29 0a 0a 09 20 20 3b 3b 20 63 it 1)))... ;; c
6140: 61 6e 20 73 65 74 75 70 20 61 73 20 63 6c 69 65 an setup as clie
6150: 6e 74 20 66 6f 72 20 73 65 72 76 65 72 20 6d 6f nt for server mo
6160: 64 65 20 6e 6f 77 0a 09 20 20 28 73 65 72 76 65 de now.. (serve
6170: 72 3a 63 6c 69 65 6e 74 2d 73 65 74 75 70 29 0a r:client-setup).
6180: 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 .. (if (args:ge
6190: 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 t-arg "-load-tes
61a0: 74 2d 64 61 74 61 22 29 0a 09 20 20 20 20 20 20 t-data")..
61b0: 3b 3b 20 68 61 73 20 73 75 62 20 63 6f 6d 6d 61 ;; has sub comma
61c0: 6e 64 73 20 74 68 61 74 20 61 72 65 20 72 64 62 nds that are rdb
61d0: 3a 0a 09 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 :.. (open-r
61e0: 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 6c 6f 61 64 un-close db:load
61f0: 2d 74 65 73 74 2d 64 61 74 61 20 64 62 20 74 65 -test-data db te
6200: 73 74 2d 69 64 29 29 0a 09 20 20 28 69 66 20 28 st-id)).. (if (
6210: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
6220: 65 74 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 28 etlog").. (
6230: 6c 65 74 20 28 28 6c 6f 67 66 6e 61 6d 65 20 28 let ((logfname (
6240: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
6250: 65 74 6c 6f 67 22 29 29 29 0a 09 09 28 6f 70 65 etlog")))...(ope
6260: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 74 n-run-close db:t
6270: 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 64 62 20 est-set-log! db
6280: 74 65 73 74 2d 69 64 20 6c 6f 67 66 6e 61 6d 65 test-id logfname
6290: 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 ))).. (if (args
62a0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 :get-arg "-set-t
62b0: 6f 70 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 28 oplog").. (
62c0: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 open-run-close t
62d0: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 74 6f ests:test-set-to
62e0: 70 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 plog! db run-id
62f0: 74 65 73 74 2d 6e 61 6d 65 20 28 61 72 67 73 3a test-name (args:
6300: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f get-arg "-set-to
6310: 70 6c 6f 67 22 29 29 29 0a 09 20 20 28 69 66 20 plog"))).. (if
6320: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6330: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 summarize-items"
6340: 29 0a 09 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 ).. (open-r
6350: 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 73 3a 73 un-close tests:s
6360: 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 64 ummarize-items d
6370: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
6380: 6d 65 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 6f me #t)) ;; do fo
6390: 72 63 65 20 68 65 72 65 0a 09 20 20 28 69 66 20 rce here.. (if
63a0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
63b0: 72 75 6e 73 74 65 70 22 29 0a 09 20 20 20 20 20 runstep")..
63c0: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 (if (null? rema
63d0: 72 67 73 29 0a 09 09 20 20 28 62 65 67 69 6e 0a rgs)... (begin.
63e0: 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
63f0: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 6e 6f 74 nt 0 "ERROR: not
6400: 68 69 6e 67 20 73 70 65 63 69 66 69 65 64 20 74 hing specified t
6410: 6f 20 72 75 6e 21 22 29 0a 09 09 20 20 20 20 28 o run!")... (
6420: 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 if db (sqlite3:f
6430: 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 09 inalize! db))...
6440: 20 20 20 20 28 65 78 69 74 20 36 29 29 0a 09 09 (exit 6))...
6450: 20 20 28 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 (let* ((stepna
6460: 6d 65 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 me (args:get-a
6470: 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 29 0a rg "-runstep")).
6480: 09 09 09 20 28 6c 6f 67 70 72 6f 66 69 6c 65 20 ... (logprofile
6490: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
64a0: 6c 6f 67 70 72 6f 22 29 29 0a 09 09 09 20 28 6c logpro")).... (l
64b0: 6f 67 66 69 6c 65 20 20 20 20 28 63 6f 6e 63 20 ogfile (conc
64c0: 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 stepname ".log")
64d0: 29 0a 09 09 09 20 28 63 6d 64 20 20 20 20 20 20 ).... (cmd
64e0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d (if (null? rem
64f0: 61 72 67 73 29 20 23 66 20 28 63 61 72 20 72 65 args) #f (car re
6500: 6d 61 72 67 73 29 29 29 0a 09 09 09 20 28 70 61 margs))).... (pa
6510: 72 61 6d 73 20 20 20 20 20 28 69 66 20 63 6d 64 rams (if cmd
6520: 20 28 63 64 72 20 72 65 6d 61 72 67 73 29 20 27 (cdr remargs) '
6530: 28 29 29 29 0a 09 09 09 20 28 65 78 69 74 73 74 ())).... (exitst
6540: 61 74 20 20 20 23 66 29 0a 09 09 09 20 28 73 68 at #f).... (sh
6550: 65 6c 6c 20 20 20 20 20 20 28 6c 61 73 74 20 28 ell (last (
6560: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 67 65 string-split (ge
6570: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
6580: 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 20 riable "SHELL")
6590: 22 2f 22 29 29 29 0a 09 09 09 20 28 72 65 64 69 "/"))).... (redi
65a0: 72 20 20 20 20 20 20 28 63 61 73 65 20 28 73 74 r (case (st
65b0: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 68 65 ring->symbol she
65c0: 6c 6c 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 ll)..... (
65d0: 28 74 63 73 68 20 63 73 68 20 6b 73 68 29 20 20 (tcsh csh ksh)
65e0: 20 20 22 3e 26 22 29 0a 09 09 09 09 20 20 20 20 ">&").....
65f0: 20 20 20 28 28 7a 73 68 20 62 61 73 68 20 73 68 ((zsh bash sh
6600: 20 61 73 68 29 20 22 32 3e 26 31 20 3e 22 29 0a ash) "2>&1 >").
6610: 09 09 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 .... (else
6620: 20 22 3e 26 22 29 29 29 0a 09 09 09 20 28 66 75 ">&"))).... (fu
6630: 6c 6c 63 6d 64 20 20 20 20 28 63 6f 6e 63 20 22 llcmd (conc "
6640: 28 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 (" (string-inter
6650: 73 70 65 72 73 65 20 0a 09 09 09 09 09 09 28 63 sperse .......(c
6660: 6f 6e 73 20 63 6d 64 20 70 61 72 61 6d 73 29 20 ons cmd params)
6670: 22 20 22 29 0a 09 09 09 09 09 20 20 20 22 29 20 " ")...... ")
6680: 22 20 72 65 64 69 72 20 22 20 22 20 6c 6f 67 66 " redir " " logf
6690: 69 6c 65 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 ile)))... ;;
66a0: 6d 61 72 6b 20 74 68 65 20 73 74 61 72 74 20 6f mark the start o
66b0: 66 20 74 68 65 20 74 65 73 74 0a 09 09 20 20 20 f the test...
66c0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
66d0: 20 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 db:teststep-set
66e0: 2d 73 74 61 74 75 73 21 20 64 62 20 74 65 73 74 -status! db test
66f0: 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 73 74 -id stepname "st
6700: 61 72 74 22 20 22 6e 2f 61 22 20 28 61 72 67 73 art" "n/a" (args
6710: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 6c :get-arg "-m") l
6720: 6f 67 66 69 6c 65 29 0a 09 09 20 20 20 20 3b 3b ogfile)... ;;
6730: 20 72 75 6e 20 74 68 65 20 74 65 73 74 20 73 74 run the test st
6740: 65 70 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a ep... (debug:
6750: 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 52 75 print-info 2 "Ru
6760: 6e 6e 69 6e 67 20 5c 22 22 20 66 75 6c 6c 63 6d nning \"" fullcm
6770: 64 20 22 5c 22 22 29 0a 09 09 20 20 20 20 28 63 d "\"")... (c
6780: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
6790: 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 09 20 startingdir)...
67a0: 20 20 20 28 73 65 74 21 20 65 78 69 74 73 74 61 (set! exitsta
67b0: 74 20 28 73 79 73 74 65 6d 20 66 75 6c 6c 63 6d t (system fullcm
67c0: 64 29 29 20 3b 3b 20 63 6d 64 20 70 61 72 61 6d d)) ;; cmd param
67d0: 73 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 s))... (set!
67e0: 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 *globalexitstatu
67f0: 73 2a 20 65 78 69 74 73 74 61 74 29 0a 09 09 20 s* exitstat)...
6800: 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 (change-direc
6810: 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
6820: 09 20 20 20 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 . ;; run logp
6830: 72 6f 20 69 66 20 61 70 70 6c 69 63 61 62 6c 65 ro if applicable
6840: 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d 72 75 6e ;; (process-run
6850: 20 22 6c 73 22 20 28 6c 69 73 74 20 22 2f 66 6f "ls" (list "/fo
6860: 6f 22 20 22 32 3e 26 31 22 20 22 62 6c 61 68 2e o" "2>&1" "blah.
6870: 6c 6f 67 22 29 29 0a 09 09 20 20 20 20 28 69 66 log"))... (if
6880: 20 6c 6f 67 70 72 6f 66 69 6c 65 0a 09 09 09 28 logprofile....(
6890: 6c 65 74 2a 20 28 28 68 74 6d 6c 6c 6f 67 66 69 let* ((htmllogfi
68a0: 6c 65 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d le (conc stepnam
68b0: 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 09 09 20 e ".html"))....
68c0: 20 20 20 20 20 20 28 6f 6c 64 65 78 69 74 73 74 (oldexitst
68d0: 61 74 20 65 78 69 74 73 74 61 74 29 0a 09 09 09 at exitstat)....
68e0: 20 20 20 20 20 20 20 28 63 6d 64 20 20 20 20 20 (cmd
68f0: 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 (string-inte
6900: 72 73 70 65 72 73 65 20 28 6c 69 73 74 20 22 6c rsperse (list "l
6910: 6f 67 70 72 6f 22 20 6c 6f 67 70 72 6f 66 69 6c ogpro" logprofil
6920: 65 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c e htmllogfile "<
6930: 22 20 6c 6f 67 66 69 6c 65 20 22 3e 22 20 28 63 " logfile ">" (c
6940: 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 5f 6c onc stepname "_l
6950: 6f 67 70 72 6f 2e 6c 6f 67 22 29 29 20 22 20 22 ogpro.log")) " "
6960: 29 29 29 0a 09 09 09 20 20 28 64 65 62 75 67 3a ))).... (debug:
6970: 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 72 75 print-info 2 "ru
6980: 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c nning \"" cmd "\
6990: 22 22 29 0a 09 09 09 20 20 28 63 68 61 6e 67 65 "").... (change
69a0: 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 -directory start
69b0: 69 6e 67 64 69 72 29 0a 09 09 09 20 20 28 73 65 ingdir).... (se
69c0: 74 21 20 65 78 69 74 73 74 61 74 20 28 73 79 73 t! exitstat (sys
69d0: 74 65 6d 20 63 6d 64 29 29 0a 09 09 09 20 20 28 tem cmd)).... (
69e0: 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 set! *globalexit
69f0: 73 74 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 status* exitstat
6a00: 29 20 3b 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 ) ;; no necessar
6a10: 79 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 y.... (change-d
6a20: 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
6a30: 68 29 0a 09 09 09 20 20 28 6f 70 65 6e 2d 72 75 h).... (open-ru
6a40: 6e 2d 63 6c 6f 73 65 20 64 62 3a 74 65 73 74 2d n-close db:test-
6a50: 73 65 74 2d 6c 6f 67 21 20 64 62 20 74 65 73 74 set-log! db test
6a60: 2d 69 64 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 29 -id htmllogfile)
6a70: 29 29 0a 09 09 20 20 20 20 28 6c 65 74 20 28 28 ))... (let ((
6a80: 6d 73 67 20 28 61 72 67 73 3a 67 65 74 2d 61 72 msg (args:get-ar
6a90: 67 20 22 2d 6d 22 29 29 29 0a 09 09 20 20 20 20 g "-m")))...
6aa0: 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 (open-run-clos
6ab0: 65 20 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 e db:teststep-se
6ac0: 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 65 73 t-status! db tes
6ad0: 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 65 t-id stepname "e
6ae0: 6e 64 22 20 65 78 69 74 73 74 61 74 20 6d 73 67 nd" exitstat msg
6af0: 20 6c 6f 67 66 69 6c 65 29 29 0a 09 09 20 20 20 logfile))...
6b00: 20 29 29 29 0a 09 20 20 28 69 66 20 28 6f 72 20 ))).. (if (or
6b10: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6b20: 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 test-status")...
6b30: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
6b40: 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 29 0a "-set-values")).
6b50: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 . (let ((ne
6b60: 77 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 wstatus (cond...
6b70: 09 09 28 28 6e 75 6d 62 65 72 3f 20 73 74 61 74 ..((number? stat
6b80: 75 73 29 20 20 20 20 20 20 20 28 69 66 20 28 65 us) (if (e
6b90: 71 75 61 6c 3f 20 73 74 61 74 75 73 20 30 29 20 qual? status 0)
6ba0: 22 50 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a "PASS" "FAIL")).
6bb0: 09 09 09 09 28 28 61 6e 64 20 28 73 74 72 69 6e ....((and (strin
6bc0: 67 3f 20 73 74 61 74 75 73 29 0a 09 09 09 09 20 g? status).....
6bd0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 (string->nu
6be0: 6d 62 65 72 20 73 74 61 74 75 73 29 29 28 69 66 mber status))(if
6bf0: 20 28 65 71 75 61 6c 3f 20 28 73 74 72 69 6e 67 (equal? (string
6c00: 2d 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 73 29 ->number status)
6c10: 20 30 29 20 22 50 41 53 53 22 20 22 46 41 49 4c 0) "PASS" "FAIL
6c20: 22 29 29 0a 09 09 09 09 28 65 6c 73 65 20 73 74 ")).....(else st
6c30: 61 74 75 73 29 29 29 0a 09 09 20 20 20 20 3b 3b atus)))... ;;
6c40: 20 74 72 61 6e 73 66 65 72 20 72 65 6c 65 76 61 transfer releva
6c50: 6e 74 20 6b 65 79 73 20 69 6e 74 6f 20 61 20 68 nt keys into a h
6c60: 61 73 68 20 74 6f 20 62 65 20 70 61 73 73 65 64 ash to be passed
6c70: 20 74 6f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 to test-set-sta
6c80: 74 75 73 21 0a 09 09 20 20 20 20 3b 3b 20 63 6f tus!... ;; co
6c90: 75 6c 64 20 75 73 65 20 61 6e 20 61 73 73 6f 63 uld use an assoc
6ca0: 20 6c 69 73 74 20 49 20 67 75 65 73 73 2e 20 0a list I guess. .
6cb0: 09 09 20 20 20 20 28 6f 74 68 65 72 64 61 74 61 .. (otherdata
6cc0: 20 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b (let ((res (mak
6cd0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))).
6ce0: 09 09 09 09 20 28 66 6f 72 2d 65 61 63 68 20 28 .... (for-each (
6cf0: 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 lambda (key)....
6d00: 09 09 20 20 20 20 20 28 69 66 20 28 61 72 67 73 .. (if (args
6d10: 3a 67 65 74 2d 61 72 67 20 6b 65 79 29 0a 09 09 :get-arg key)...
6d20: 09 09 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 .... (hash-table
6d30: 2d 73 65 74 21 20 72 65 73 20 6b 65 79 20 28 61 -set! res key (a
6d40: 72 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 79 29 rgs:get-arg key)
6d50: 29 29 29 0a 09 09 09 09 09 20 20 20 28 6c 69 73 )))...... (lis
6d60: 74 20 22 3a 76 61 6c 75 65 22 20 22 3a 74 6f 6c t ":value" ":tol
6d70: 22 20 22 3a 65 78 70 65 63 74 65 64 22 20 22 3a " ":expected" ":
6d80: 66 69 72 73 74 5f 65 72 72 22 20 22 3a 66 69 72 first_err" ":fir
6d90: 73 74 5f 77 61 72 6e 22 20 22 3a 75 6e 69 74 73 st_warn" ":units
6da0: 22 20 22 3a 63 61 74 65 67 6f 72 79 22 20 22 3a " ":category" ":
6db0: 76 61 72 69 61 62 6c 65 22 29 29 0a 09 09 09 09 variable")).....
6dc0: 20 72 65 73 29 29 29 0a 09 09 28 69 66 20 28 61 res)))...(if (a
6dd0: 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 nd (args:get-arg
6de0: 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 "-test-status")
6df0: 0a 09 09 09 20 28 6f 72 20 28 6e 6f 74 20 73 74 .... (or (not st
6e00: 61 74 65 29 0a 09 09 09 20 20 20 20 20 28 6e 6f ate).... (no
6e10: 74 20 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 t status)))...
6e20: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 (begin...
6e30: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
6e40: 22 45 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 "ERROR: You must
6e50: 20 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 specify :state
6e60: 61 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 and :status with
6e70: 20 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d every call to -
6e80: 74 65 73 74 2d 73 74 61 74 75 73 5c 6e 22 20 68 test-status\n" h
6e90: 65 6c 70 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 elp)... ;;
6ea0: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
6eb0: 65 21 20 64 62 29 0a 09 09 20 20 20 20 20 20 28 e! db)... (
6ec0: 65 78 69 74 20 36 29 29 29 0a 09 09 28 6c 65 74 exit 6)))...(let
6ed0: 2a 20 28 28 6d 73 67 20 20 20 20 28 61 72 67 73 * ((msg (args
6ee0: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a :get-arg "-m")).
6ef0: 09 09 20 20 20 20 20 20 20 28 6e 75 6d 6f 74 68 .. (numoth
6f00: 20 28 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 (length (hash-t
6f10: 61 62 6c 65 2d 6b 65 79 73 20 6f 74 68 65 72 64 able-keys otherd
6f20: 61 74 61 29 29 29 29 0a 09 09 20 20 3b 3b 20 43 ata))))... ;; C
6f30: 6f 6e 76 65 72 74 20 74 6f 20 72 70 63 20 69 6e onvert to rpc in
6f40: 73 69 64 65 20 74 68 65 20 74 65 73 74 73 3a 74 side the tests:t
6f50: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
6f60: 63 61 6c 6c 2c 20 6e 6f 74 20 68 65 72 65 0a 09 call, not here..
6f70: 09 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 . (tests:test-s
6f80: 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 2d et-status! test-
6f90: 69 64 20 73 74 61 74 65 20 6e 65 77 73 74 61 74 id state newstat
6fa0: 75 73 20 6d 73 67 20 6f 74 68 65 72 64 61 74 61 us msg otherdata
6fb0: 29 29 29 29 0a 09 20 20 28 69 66 20 64 62 20 28 )))).. (if db (
6fc0: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
6fd0: 21 20 64 62 29 29 0a 09 20 20 28 73 65 74 21 20 ! db)).. (set!
6fe0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
6ff0: 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d t))))..;;=======
7000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
7040: 3b 3b 20 56 61 72 69 6f 75 73 20 68 65 6c 70 65 ;; Various helpe
7050: 72 20 63 6f 6d 6d 61 6e 64 73 20 63 61 6e 20 67 r commands can g
7060: 6f 20 62 65 6c 6f 77 20 68 65 72 65 0a 3b 3b 3d o below here.;;=
7070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70b0: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
70c0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 6b :get-arg "-showk
70d0: 65 79 73 22 29 0a 20 20 20 20 28 6c 65 74 20 28 eys"). (let (
70e0: 28 64 62 20 23 66 29 0a 09 20 20 28 6b 65 79 73 (db #f).. (keys
70f0: 20 23 66 29 29 0a 20 20 20 20 20 20 28 69 66 20 #f)). (if
7100: 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d (not (setup-for-
7110: 72 75 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a run)).. (begin.
7120: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
7130: 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 t 0 "Failed to s
7140: 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a etup, exiting").
7150: 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a . (exit 1))).
7160: 20 20 20 20 20 20 28 73 65 74 21 20 6b 65 79 73 (set! keys
7170: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
7180: 20 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 db:get-keys db)
7190: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
71a0: 72 69 6e 74 20 31 20 22 4b 65 79 73 3a 20 22 20 rint 1 "Keys: "
71b0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
71c0: 72 73 65 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 rse (map key:get
71d0: 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 -fieldname keys)
71e0: 20 22 2c 20 22 29 29 0a 20 20 20 20 20 20 28 69 ", ")). (i
71f0: 66 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 f db (sqlite3:fi
7200: 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 20 20 20 nalize! db)).
7210: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
7220: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 ething* #t)))..(
7230: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
7240: 20 22 2d 67 75 69 22 29 0a 20 20 20 20 28 62 65 "-gui"). (be
7250: 67 69 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 gin. (debug
7260: 3a 70 72 69 6e 74 20 30 20 22 4c 6f 6f 6b 20 61 :print 0 "Look a
7270: 74 20 74 68 65 20 64 61 73 68 62 6f 61 72 64 20 t the dashboard
7280: 66 6f 72 20 6e 6f 77 22 29 0a 20 20 20 20 20 20 for now").
7290: 3b 3b 20 28 6d 65 67 61 74 65 73 74 2d 67 75 69 ;; (megatest-gui
72a0: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
72b0: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
72c0: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
72d0: 74 2d 61 72 67 20 22 2d 67 65 6e 2d 6d 65 67 61 t-arg "-gen-mega
72e0: 74 65 73 74 2d 61 72 65 61 22 29 0a 20 20 20 20 test-area").
72f0: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 67 65 (begin. (ge
7300: 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 nexample:mk-mega
7310: 74 65 73 74 2e 63 6f 6e 66 69 67 29 0a 20 20 20 test.config).
7320: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
7330: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 ething* #t)))..(
7340: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
7350: 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d "-gen-megatest-
7360: 74 65 73 74 22 29 0a 20 20 20 20 28 6c 65 74 20 test"). (let
7370: 28 28 74 65 73 74 6e 61 6d 65 20 28 61 72 67 73 ((testname (args
7380: 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 6e 2d 6d :get-arg "-gen-m
7390: 65 67 61 74 65 73 74 2d 74 65 73 74 22 29 29 29 egatest-test")))
73a0: 0a 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 . (genexamp
73b0: 6c 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2d 74 le:mk-megatest-t
73c0: 65 73 74 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 est testname).
73d0: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
73e0: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
73f0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
7400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7430: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 ========.;; Upda
7440: 74 65 20 74 68 65 20 64 61 74 61 62 61 73 65 20 te the database
7450: 73 63 68 65 6d 61 20 6f 6e 20 72 65 71 75 65 73 schema on reques
7460: 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d t.;;============
7470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
74a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
74b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
74c0: 72 65 62 75 69 6c 64 2d 64 62 22 29 0a 20 20 20 rebuild-db").
74d0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 (begin. (i
74e0: 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f f (not (setup-fo
74f0: 72 2d 72 75 6e 29 29 0a 09 20 20 28 62 65 67 69 r-run)).. (begi
7500: 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 n.. (debug:pr
7510: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f int 0 "Failed to
7520: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
7530: 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ) .. (exit 1)
7540: 29 29 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 )). (open-r
7550: 75 6e 2d 63 6c 6f 73 65 20 70 61 74 63 68 2d 64 un-close patch-d
7560: 62 20 23 66 29 0a 20 20 20 20 20 20 28 73 65 74 b #f). (set
7570: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
7580: 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d #t)))..;;======
7590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
75a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
75b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
75c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
75d0: 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 74 .;; Update the t
75e0: 65 73 74 73 20 6d 65 74 61 20 64 61 74 61 20 66 ests meta data f
75f0: 72 6f 6d 20 74 68 65 20 74 65 73 74 63 6f 6e 66 rom the testconf
7600: 69 67 20 66 69 6c 65 73 0a 3b 3b 3d 3d 3d 3d 3d ig files.;;=====
7610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7650: 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 =..(if (args:get
7660: 2d 61 72 67 20 22 2d 75 70 64 61 74 65 2d 6d 65 -arg "-update-me
7670: 74 61 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ta"). (begin.
7680: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
7690: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
76a0: 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
76b0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 debug:print 0 "F
76c0: 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 ailed to setup,
76d0: 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 exiting") ..
76e0: 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 (exit 1))).
76f0: 20 3b 3b 20 6e 6f 77 20 63 61 6e 20 66 69 6e 64 ;; now can find
7700: 20 6f 75 72 20 64 62 0a 20 20 20 20 20 20 28 6f our db. (o
7710: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 72 75 pen-run-close ru
7720: 6e 73 3a 75 70 64 61 74 65 2d 61 6c 6c 2d 74 65 ns:update-all-te
7730: 73 74 5f 6d 65 74 61 20 64 62 29 0a 20 20 20 20 st_meta db).
7740: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
7750: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
7760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
77a0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 ======.;; Start
77b0: 61 20 72 65 70 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d a repl.;;=======
77c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
77d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
77e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
77f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
7800: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
7810: 72 67 20 22 2d 72 65 70 6c 22 29 0a 20 20 20 20 rg "-repl").
7820: 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 (let* ((toppath
7830: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
7840: 0a 09 20 20 20 28 64 62 20 20 20 20 20 20 28 69 .. (db (i
7850: 66 20 74 6f 70 70 61 74 68 20 28 6f 70 65 6e 2d f toppath (open-
7860: 64 62 29 20 23 66 29 29 29 0a 20 20 20 20 20 20 db) #f))).
7870: 28 69 66 20 64 62 0a 09 20 20 28 62 65 67 69 6e (if db.. (begin
7880: 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 62 2a .. (set! *db*
7890: 20 64 62 29 0a 09 20 20 20 20 28 69 66 20 28 6e db).. (if (n
78a0: 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
78b0: 20 22 2d 73 65 72 76 65 72 22 29 29 0a 09 09 28 "-server"))...(
78c0: 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d 73 65 server:client-se
78d0: 74 75 70 29 29 0a 09 20 20 20 20 28 69 6d 70 6f tup)).. (impo
78e0: 72 74 20 72 65 61 64 6c 69 6e 65 29 0a 09 20 20 rt readline)..
78f0: 20 20 28 69 6d 70 6f 72 74 20 61 70 72 6f 70 6f (import apropo
7900: 73 29 0a 09 20 20 20 20 28 67 6e 75 2d 68 69 73 s).. (gnu-his
7910: 74 6f 72 79 2d 69 6e 73 74 61 6c 6c 2d 66 69 6c tory-install-fil
7920: 65 2d 6d 61 6e 61 67 65 72 0a 09 20 20 20 20 20 e-manager..
7930: 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 0a 09 (string-append..
7940: 20 20 20 20 20 20 28 6f 72 20 28 67 65 74 2d 65 (or (get-e
7950: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
7960: 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2e 22 29 ble "HOME") ".")
7970: 20 22 2f 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 "/.megatest_his
7980: 74 6f 72 79 22 29 29 0a 09 20 20 20 20 28 63 75 tory")).. (cu
7990: 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 rrent-input-port
79a0: 20 28 6d 61 6b 65 2d 67 6e 75 2d 72 65 61 64 6c (make-gnu-readl
79b0: 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 65 ine-port "megate
79c0: 73 74 3e 20 22 29 29 0a 09 20 20 20 20 28 72 65 st> ")).. (re
79d0: 70 6c 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 pl))). (set
79e0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
79f0: 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d #t)))..;;======
7a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7a40: 0a 3b 3b 20 45 78 69 74 20 61 6e 64 20 63 6c 65 .;; Exit and cle
7a50: 61 6e 20 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d an up.;;========
7a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
7aa0: 28 69 66 20 28 6e 6f 74 20 2a 64 69 64 73 6f 6d (if (not *didsom
7ab0: 65 74 68 69 6e 67 2a 29 0a 20 20 20 20 28 64 65 ething*). (de
7ac0: 62 75 67 3a 70 72 69 6e 74 20 30 20 68 65 6c 70 bug:print 0 help
7ad0: 29 29 0a 0a 3b 3b 20 28 69 66 20 2a 72 75 6e 72 ))..;; (if *runr
7ae0: 65 6d 6f 74 65 2a 20 28 72 70 63 3a 63 6c 6f 73 emote* (rpc:clos
7af0: 65 2d 61 6c 6c 2d 63 6f 6e 6e 65 63 74 69 6f 6e e-all-connection
7b00: 73 21 29 29 0a 20 20 20 20 0a 28 69 66 20 28 6e s!)). .(if (n
7b10: 6f 74 20 28 65 71 3f 20 2a 67 6c 6f 62 61 6c 65 ot (eq? *globale
7b20: 78 69 74 73 74 61 74 75 73 2a 20 30 29 29 0a 20 xitstatus* 0)).
7b30: 20 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 (if (or (args
7b40: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
7b50: 73 74 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 sts")(args:get-a
7b60: 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 29 0a 20 rg "-runall")).
7b70: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 (begin.
7b80: 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
7b90: 70 72 69 6e 74 20 30 20 22 4e 4f 54 45 3a 20 53 print 0 "NOTE: S
7ba0: 75 62 70 72 6f 63 65 73 73 65 73 20 77 69 74 68 ubprocesses with
7bb0: 20 6e 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 20 63 non-zero exit c
7bc0: 6f 64 65 20 64 65 74 65 63 74 65 64 3a 20 22 20 ode detected: "
7bd0: 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 *globalexitstatu
7be0: 73 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 s*). (
7bf0: 65 78 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 exit 0)).
7c00: 20 28 63 61 73 65 20 2a 67 6c 6f 62 61 6c 65 78 (case *globalex
7c10: 69 74 73 74 61 74 75 73 2a 0a 20 20 20 20 20 20 itstatus*.
7c20: 20 20 20 28 28 30 29 28 65 78 69 74 20 30 29 29 ((0)(exit 0))
7c30: 0a 20 20 20 20 20 20 20 20 20 28 28 31 29 28 65 . ((1)(e
7c40: 78 69 74 20 31 29 29 0a 20 20 20 20 20 20 20 20 xit 1)).
7c50: 20 28 28 32 29 28 65 78 69 74 20 32 29 29 0a 20 ((2)(exit 2)).
7c60: 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 65 (else (e
7c70: 78 69 74 20 33 29 29 29 29 29 0a xit 3))))).