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: 73 65 74 21 20 2a 76 65 72 62 6f 73 69 74 79 2a set! *verbosity*
1e40: 20 28 64 65 62 75 67 3a 63 61 6c 63 2d 76 65 72 (debug:calc-ver
1e50: 62 6f 73 69 74 79 20 28 61 72 67 73 3a 67 65 74 bosity (args:get
1e60: 2d 61 72 67 20 22 2d 64 65 62 75 67 22 29 29 29 -arg "-debug")))
1e70: 0a 28 64 65 62 75 67 3a 63 68 65 63 6b 2d 76 65 .(debug:check-ve
1e80: 72 62 6f 73 69 74 79 20 2a 76 65 72 62 6f 73 69 rbosity *verbosi
1e90: 74 79 2a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ty* (args:get-ar
1ea0: 67 20 22 2d 64 65 62 75 67 22 29 29 0a 0a 28 69 g "-debug"))..(i
1eb0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
1ec0: 22 2d 6c 6f 67 67 69 6e 67 22 29 28 73 65 74 21 "-logging")(set!
1ed0: 20 2a 6c 6f 67 67 69 6e 67 2a 20 23 74 29 29 0a *logging* #t)).
1ee0: 0a 28 69 66 20 28 64 65 62 75 67 3a 64 65 62 75 .(if (debug:debu
1ef0: 67 2d 6d 6f 64 65 20 33 29 20 3b 3b 20 77 65 20 g-mode 3) ;; we
1f00: 61 72 65 20 6f 62 76 69 6f 75 73 6c 79 20 64 65 are obviously de
1f10: 62 75 67 67 69 6e 67 0a 20 20 20 20 28 73 65 74 bugging. (set
1f20: 21 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 ! open-run-close
1f30: 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d open-run-close-
1f40: 6e 6f 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e no-exception-han
1f50: 64 6c 69 6e 67 29 29 0a 0a 3b 3b 20 61 2c 62 2c dling))..;; a,b,
1f60: 63 20 25 20 3d 3e 20 61 2f 25 2c 62 2f 25 2c 63 c % => a/%,b/%,c
1f70: 2f 25 0a 28 64 65 66 69 6e 65 20 28 74 61 63 6b /%.(define (tack
1f80: 2d 6f 6e 2d 70 61 74 74 20 73 72 63 73 74 72 20 -on-patt srcstr
1f90: 70 61 74 74 29 0a 20 20 28 6c 65 74 20 28 28 73 patt). (let ((s
1fa0: 74 72 6c 73 74 20 28 73 74 72 69 6e 67 2d 73 70 trlst (string-sp
1fb0: 6c 69 74 20 73 72 63 73 74 72 20 22 2c 22 29 29 lit srcstr ","))
1fc0: 29 0a 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e ). (string-in
1fd0: 74 65 72 73 70 65 72 73 65 20 0a 20 20 20 20 20 tersperse .
1fe0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 73 74 (map (lambda (st
1ff0: 72 29 0a 09 20 20 20 20 28 69 66 20 28 6e 6f 74 r).. (if (not
2000: 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 (substring-inde
2010: 78 20 22 2f 22 20 73 74 72 29 29 0a 09 09 28 63 x "/" str))...(c
2020: 6f 6e 63 20 73 74 72 20 22 2f 22 20 70 61 74 74 onc str "/" patt
2030: 29 0a 09 09 73 74 72 29 29 0a 09 20 20 73 74 72 )...str)).. str
2040: 6c 73 74 29 0a 09 20 20 20 22 2c 22 29 29 29 0a lst).. ","))).
2050: 0a 3b 3b 20 74 6f 20 74 72 79 20 61 6e 64 20 6e .;; to try and n
2060: 6f 74 20 62 75 72 64 65 6e 20 4b 69 6d 20 74 6f ot burden Kim to
2070: 6f 20 6d 75 63 68 2e 2e 2e 0a 28 69 66 20 28 61 o much....(if (a
2080: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 rgs:get-arg "-it
2090: 65 6d 70 61 74 74 22 29 0a 20 20 20 20 28 6c 65 empatt"). (le
20a0: 74 20 28 28 6f 6c 64 2d 74 65 73 74 70 61 74 74 t ((old-testpatt
20b0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
20c0: 2d 74 65 73 74 70 61 74 74 22 29 29 29 0a 20 20 -testpatt"))).
20d0: 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 ;; (debug:pr
20e0: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 70 61 int 0 "ERROR: pa
20f0: 72 61 6d 65 74 65 72 20 5c 22 2d 69 74 65 6d 70 rameter \"-itemp
2100: 61 74 74 5c 22 20 68 61 73 20 62 65 65 6e 20 64 att\" has been d
2110: 65 70 72 65 63 61 74 65 64 2e 20 46 6f 72 20 6e eprecated. For n
2120: 6f 77 20 49 20 77 69 6c 6c 20 74 77 65 61 6b 20 ow I will tweak
2130: 79 6f 75 72 20 2d 74 65 73 74 70 61 74 74 20 66 your -testpatt f
2140: 6f 72 20 79 6f 75 22 29 0a 20 20 20 20 20 20 28 or you"). (
2150: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
2160: 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 20 "-testpatt")..
2170: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
2180: 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 ! args:arg-hash
2190: 22 2d 74 65 73 74 70 61 74 74 22 20 28 74 61 63 "-testpatt" (tac
21a0: 6b 2d 6f 6e 2d 70 61 74 74 20 6f 6c 64 2d 74 65 k-on-patt old-te
21b0: 73 74 70 61 74 74 20 28 61 72 67 73 3a 67 65 74 stpatt (args:get
21c0: 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 -arg "-itempatt"
21d0: 29 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 28 64 )))). ;; (d
21e0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 20 20 ebug:print 0 "
21f0: 20 20 6f 6c 64 3a 20 22 20 6f 6c 64 2d 74 65 73 old: " old-tes
2200: 74 70 61 74 74 20 22 2c 20 6e 65 77 3a 20 22 20 tpatt ", new: "
2210: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
2220: 74 65 73 74 70 61 74 74 22 29 29 0a 20 20 20 20 testpatt")).
2230: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
2240: 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
2250: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
2260: 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ;; (debug:print
2270: 30 20 22 4e 4f 54 45 3a 20 41 6c 73 6f 20 6d 6f 0 "NOTE: Also mo
2280: 64 69 66 79 69 6e 67 20 2d 72 75 6e 74 65 73 74 difying -runtest
2290: 73 22 29 0a 09 20 20 20 20 28 68 61 73 68 2d 74 s").. (hash-t
22a0: 61 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 able-set! args:a
22b0: 72 67 2d 68 61 73 68 20 22 2d 72 75 6e 74 65 73 rg-hash "-runtes
22c0: 74 73 22 20 28 74 61 63 6b 2d 6f 6e 2d 70 61 74 ts" (tack-on-pat
22d0: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
22e0: 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 09 09 "-runtests")....
22f0: 09 09 09 09 09 20 20 20 20 20 28 61 72 67 73 3a ..... (args:
2300: 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 get-arg "-itempa
2310: 74 74 22 29 29 29 29 29 0a 20 20 20 20 20 20 29 tt"))))). )
2320: 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d ================
2360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d ===========.;; M
2370: 69 73 63 20 67 65 6e 65 72 61 6c 20 63 61 6c 6c isc general call
2380: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
2390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
23d0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
23e0: 65 6e 76 32 66 69 6c 65 22 29 0a 20 20 20 20 28 env2file"). (
23f0: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 73 61 76 begin. (sav
2400: 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 e-environment-as
2410: 2d 66 69 6c 65 73 20 28 61 72 67 73 3a 67 65 74 -files (args:get
2420: 2d 61 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 -arg "-env2file"
2430: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
2440: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
2450: 29 29 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d ================
2490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
24a0: 20 52 65 6d 6f 76 65 20 6f 6c 64 20 72 75 6e 28 Remove old run(
24b0: 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s).;;===========
24c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
2500: 73 69 6e 63 65 20 73 65 76 65 72 61 6c 20 61 63 since several ac
2510: 74 69 6f 6e 73 20 63 61 6e 20 62 65 20 73 70 65 tions can be spe
2520: 63 69 66 69 65 64 20 6f 6e 20 74 68 65 20 63 6f cified on the co
2530: 6d 6d 61 6e 64 20 6c 69 6e 65 20 74 68 65 20 72 mmand line the r
2540: 65 6d 6f 76 61 6c 0a 3b 3b 20 69 73 20 64 6f 6e emoval.;; is don
2550: 65 20 66 69 72 73 74 0a 28 64 65 66 69 6e 65 20 e first.(define
2560: 28 6f 70 65 72 61 74 65 2d 6f 6e 20 61 63 74 69 (operate-on acti
2570: 6f 6e 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 on). (cond. (
2580: 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 (not (args:get-a
2590: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a rg ":runname")).
25a0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
25b0: 20 30 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 0 "ERROR: Missi
25c0: 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 ng required para
25d0: 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 meter for " acti
25e0: 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 on ", you must s
25f0: 70 65 63 69 66 79 20 74 68 65 20 72 75 6e 20 6e pecify the run n
2600: 61 6d 65 20 70 61 74 74 65 72 6e 20 77 69 74 68 ame pattern with
2610: 20 3a 72 75 6e 6e 61 6d 65 20 70 61 74 74 22 29 :runname patt")
2620: 0a 20 20 20 20 28 65 78 69 74 20 32 29 29 0a 20 . (exit 2)).
2630: 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 ((not (args:ge
2640: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
2650: 22 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ")). (debug:p
2660: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4d rint 0 "ERROR: M
2670: 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 issing required
2680: 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 parameter for "
2690: 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 action ", you mu
26a0: 73 74 20 73 70 65 63 69 66 79 20 74 68 65 20 74 st specify the t
26b0: 65 73 74 20 70 61 74 74 65 72 6e 20 77 69 74 68 est pattern with
26c0: 20 2d 74 65 73 74 70 61 74 74 22 29 0a 20 20 20 -testpatt").
26d0: 20 28 65 78 69 74 20 33 29 29 0a 20 20 20 28 65 (exit 3)). (e
26e0: 6c 73 65 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 lse. (if (not
26f0: 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 (car *configinf
2700: 6f 2a 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 o*))..(begin..
2710: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
2720: 45 52 52 4f 52 3a 20 41 74 74 65 6d 70 74 65 64 ERROR: Attempted
2730: 20 22 20 61 63 74 69 6f 6e 20 22 6f 6e 20 74 65 " action "on te
2740: 73 74 28 73 29 20 62 75 74 20 72 75 6e 20 61 72 st(s) but run ar
2750: 65 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e ea config file n
2760: 6f 74 20 66 6f 75 6e 64 22 29 0a 09 20 20 28 65 ot found").. (e
2770: 78 69 74 20 31 29 29 0a 09 3b 3b 20 70 75 74 20 xit 1))..;; put
2780: 74 65 73 74 20 70 61 72 61 6d 65 74 65 72 73 20 test parameters
2790: 69 6e 74 6f 20 63 6f 6e 76 65 6e 69 65 6e 74 20 into convenient
27a0: 76 61 72 69 61 62 6c 65 73 0a 09 28 72 75 6e 73 variables..(runs
27b0: 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 20 61 63 74 :operate-on act
27c0: 69 6f 6e 0a 09 09 09 20 20 28 61 72 67 73 3a 67 ion.... (args:g
27d0: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
27e0: 22 29 0a 09 09 09 20 20 28 61 72 67 73 3a 67 65 ").... (args:ge
27f0: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
2800: 22 29 0a 09 09 09 20 20 73 74 61 74 65 3a 20 28 ").... state: (
2810: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 args:get-arg ":s
2820: 74 61 74 65 22 29 20 0a 09 09 09 20 20 73 74 61 tate") .... sta
2830: 74 75 73 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 tus: (args:get-a
2840: 72 67 20 22 3a 73 74 61 74 75 73 22 29 0a 09 09 rg ":status")...
2850: 09 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 . new-state-sta
2860: 74 75 73 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 tus: (args:get-a
2870: 72 67 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 rg "-set-state-s
2880: 74 61 74 75 73 22 29 29 29 0a 20 20 20 20 28 73 tatus"))). (s
2890: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
28a0: 67 2a 20 23 74 29 29 29 29 0a 09 20 20 0a 28 69 g* #t)))).. .(i
28b0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
28c0: 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a "-remove-runs").
28d0: 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e (general-run
28e0: 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 65 -call . "-re
28f0: 6d 6f 76 65 2d 72 75 6e 73 22 0a 20 20 20 20 20 move-runs".
2900: 22 72 65 6d 6f 76 65 20 72 75 6e 73 22 0a 20 20 "remove runs".
2910: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
2920: 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
2930: 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c keynames keyvall
2940: 73 74 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 st). (oper
2950: 61 74 65 2d 6f 6e 20 27 72 65 6d 6f 76 65 2d 72 ate-on 'remove-r
2960: 75 6e 73 29 29 29 29 0a 0a 28 69 66 20 28 61 72 uns))))..(if (ar
2970: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
2980: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 29 0a -state-status").
2990: 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e (general-run
29a0: 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 73 65 -call . "-se
29b0: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 0a t-state-status".
29c0: 20 20 20 20 20 22 73 65 74 20 73 74 61 74 65 20 "set state
29d0: 61 6e 64 20 73 74 61 74 75 73 22 0a 20 20 20 20 and status".
29e0: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
29f0: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
2a00: 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 ynames keyvallst
2a10: 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 ). (operat
2a20: 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d e-on 'set-state-
2a30: 73 74 61 74 75 73 29 29 29 29 0a 0a 3b 3b 3d 3d status))))..;;==
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 3d 3d 3d 3d 3d ================
2a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a80: 3d 3d 3d 3d 0a 3b 3b 20 51 75 65 72 79 20 72 75 ====.;; Query ru
2a90: 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ns.;;===========
2aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
2ae0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
2af0: 2d 6c 69 73 74 2d 72 75 6e 73 22 29 0a 20 20 20 -list-runs").
2b00: 20 28 69 66 20 28 73 65 74 75 70 2d 66 6f 72 2d (if (setup-for-
2b10: 72 75 6e 29 0a 09 28 6c 65 74 2a 20 28 28 64 62 run)..(let* ((db
2b20: 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 #f)..
2b30: 20 20 20 28 72 75 6e 70 61 74 74 20 20 28 61 72 (runpatt (ar
2b40: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 gs:get-arg "-lis
2b50: 74 2d 72 75 6e 73 22 29 29 0a 09 20 20 20 20 20 t-runs"))..
2b60: 20 20 28 74 65 73 74 70 61 74 74 20 28 61 72 67 (testpatt (arg
2b70: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
2b80: 70 61 74 74 22 29 29 0a 09 20 20 20 20 20 20 20 patt"))..
2b90: 28 72 75 6e 73 64 61 74 20 20 28 6f 70 65 6e 2d (runsdat (open-
2ba0: 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 run-close db:get
2bb0: 2d 72 75 6e 73 20 64 62 20 72 75 6e 70 61 74 74 -runs db runpatt
2bc0: 20 23 66 20 23 66 20 27 28 29 29 29 0a 09 20 20 #f #f '()))..
2bd0: 20 20 20 20 20 28 72 75 6e 73 20 20 20 20 20 28 (runs (
2be0: 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e 73 db:get-rows runs
2bf0: 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 28 68 dat)).. (h
2c00: 65 61 64 65 72 20 20 20 28 64 62 3a 67 65 74 2d eader (db:get-
2c10: 68 65 61 64 65 72 20 72 75 6e 73 64 61 74 29 29 header runsdat))
2c20: 0a 09 20 20 20 20 20 20 20 28 6b 65 79 73 20 20 .. (keys
2c30: 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f (open-run-clo
2c40: 73 65 20 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 se db:get-keys d
2c50: 62 29 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 b)).. (key
2c60: 6e 61 6d 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 names (map key:g
2c70: 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 et-fieldname key
2c80: 73 29 29 29 0a 09 20 20 3b 3b 20 45 61 63 68 20 s))).. ;; Each
2c90: 72 75 6e 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 run.. (for-each
2ca0: 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 72 .. (lambda (r
2cb0: 75 6e 29 0a 09 20 20 20 20 20 28 64 65 62 75 67 un).. (debug
2cc0: 3a 70 72 69 6e 74 20 31 20 22 52 75 6e 3a 20 22 :print 1 "Run: "
2cd0: 0a 09 09 09 20 20 28 73 74 72 69 6e 67 2d 69 6e .... (string-in
2ce0: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 tersperse (map (
2cf0: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 lambda (x)......
2d00: 09 20 20 20 20 20 28 64 62 3a 67 65 74 2d 76 61 . (db:get-va
2d10: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
2d20: 6e 20 68 65 61 64 65 72 20 78 29 29 0a 09 09 09 n header x))....
2d30: 09 09 09 20 20 20 6b 65 79 6e 61 6d 65 73 29 20 ... keynames)
2d40: 22 2f 22 29 0a 09 09 09 20 20 22 2f 22 0a 09 09 "/").... "/"...
2d50: 09 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 . (db:get-value
2d60: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
2d70: 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 eader "runname")
2d80: 0a 09 09 09 20 20 22 20 73 74 61 74 75 73 3a 20 .... " status:
2d90: 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d " (db:get-value-
2da0: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
2db0: 61 64 65 72 20 22 73 74 61 74 65 22 29 29 0a 09 ader "state"))..
2dc0: 20 20 20 20 20 28 6c 65 74 20 28 28 72 75 6e 2d (let ((run-
2dd0: 69 64 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f id (open-run-clo
2de0: 73 65 20 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d se db:get-value-
2df0: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
2e00: 61 64 65 72 20 22 69 64 22 29 29 29 0a 09 20 20 ader "id")))..
2e10: 20 20 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 (let ((test
2e20: 73 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 s (open-run-clos
2e30: 65 20 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 e db:get-tests-f
2e40: 6f 72 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 or-run db run-id
2e50: 20 74 65 73 74 70 61 74 74 20 27 28 29 20 27 28 testpatt '() '(
2e60: 29 29 29 29 0a 09 09 20 3b 3b 20 45 61 63 68 20 ))))... ;; Each
2e70: 74 65 73 74 0a 09 09 20 28 66 6f 72 2d 65 61 63 test... (for-eac
2e80: 68 20 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 28 h ... (lambda (
2e90: 74 65 73 74 29 0a 09 09 20 20 20 20 28 66 6f 72 test)... (for
2ea0: 6d 61 74 20 23 74 0a 09 09 09 20 20 20 20 22 20 mat #t.... "
2eb0: 20 54 65 73 74 3a 20 7e 32 35 61 20 53 74 61 74 Test: ~25a Stat
2ec0: 65 3a 20 7e 31 35 61 20 53 74 61 74 75 73 3a 20 e: ~15a Status:
2ed0: 7e 31 35 61 20 52 75 6e 74 69 6d 65 3a 20 7e 35 ~15a Runtime: ~5
2ee0: 40 61 73 20 54 69 6d 65 3a 20 7e 32 32 61 20 48 @as Time: ~22a H
2ef0: 6f 73 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 09 ost: ~10a\n"....
2f00: 20 20 20 20 28 63 6f 6e 63 20 28 64 62 3a 74 65 (conc (db:te
2f10: 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 st-get-testname
2f20: 74 65 73 74 29 0a 09 09 09 09 20 20 28 69 66 20 test)..... (if
2f30: 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 (equal? (db:test
2f40: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 -get-item-path t
2f50: 65 73 74 29 20 22 22 29 0a 09 09 09 09 20 20 20 est) "").....
2f60: 20 20 20 22 22 20 0a 09 09 09 09 20 20 20 20 20 "" .....
2f70: 20 28 63 6f 6e 63 20 22 28 22 20 28 64 62 3a 74 (conc "(" (db:t
2f80: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
2f90: 68 20 74 65 73 74 29 20 22 29 22 29 29 29 0a 09 h test) ")")))..
2fa0: 09 09 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 .. (db:test-g
2fb0: 65 74 2d 73 74 61 74 65 20 74 65 73 74 29 0a 09 et-state test)..
2fc0: 09 09 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 .. (db:test-g
2fd0: 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 0a et-status test).
2fe0: 09 09 09 20 20 20 20 28 64 62 3a 74 65 73 74 2d ... (db:test-
2ff0: 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e get-run_duration
3000: 20 74 65 73 74 29 0a 09 09 09 20 20 20 20 28 64 test).... (d
3010: 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 b:test-get-event
3020: 5f 74 69 6d 65 20 74 65 73 74 29 0a 09 09 09 20 _time test)....
3030: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
3040: 68 6f 73 74 20 74 65 73 74 29 29 0a 09 09 20 20 host test))...
3050: 20 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 (if (not (or (
3060: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d equal? (db:test-
3070: 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 get-status test)
3080: 20 22 50 41 53 53 22 29 0a 09 09 09 09 20 28 65 "PASS")..... (e
3090: 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 qual? (db:test-g
30a0: 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 20 et-status test)
30b0: 22 57 41 52 4e 22 29 0a 09 09 09 09 20 28 65 71 "WARN")..... (eq
30c0: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
30d0: 74 2d 73 74 61 74 65 20 74 65 73 74 29 20 20 22 t-state test) "
30e0: 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 29 29 0a NOT_STARTED"))).
30f0: 09 09 09 28 62 65 67 69 6e 0a 09 09 09 20 20 28 ...(begin.... (
3100: 70 72 69 6e 74 20 22 20 20 20 20 20 20 20 20 20 print "
3110: 63 70 75 6c 6f 61 64 3a 20 20 22 20 28 64 62 3a cpuload: " (db:
3120: 74 65 73 74 2d 67 65 74 2d 63 70 75 6c 6f 61 64 test-get-cpuload
3130: 20 74 65 73 74 29 0a 09 09 09 09 20 22 5c 6e 20 test)..... "\n
3140: 20 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 diskfree
3150: 3a 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 : " (db:test-get
3160: 2d 64 69 73 6b 66 72 65 65 20 74 65 73 74 29 0a -diskfree test).
3170: 09 09 09 09 20 22 5c 6e 20 20 20 20 20 20 20 20 .... "\n
3180: 20 75 6e 61 6d 65 3a 20 20 20 20 22 20 28 64 62 uname: " (db
3190: 3a 74 65 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 :test-get-uname
31a0: 74 65 73 74 29 0a 09 09 09 09 20 22 5c 6e 20 20 test)..... "\n
31b0: 20 20 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 rundir:
31c0: 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d " (db:test-get-
31d0: 72 75 6e 64 69 72 20 74 65 73 74 29 0a 09 09 09 rundir test)....
31e0: 09 20 29 0a 09 09 09 20 20 3b 3b 20 45 61 63 68 . ).... ;; Each
31f0: 20 74 65 73 74 0a 09 09 09 20 20 28 6c 65 74 20 test.... (let
3200: 28 28 73 74 65 70 73 20 28 6f 70 65 6e 2d 72 75 ((steps (open-ru
3210: 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 2d 73 n-close db:get-s
3220: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 teps-for-test db
3230: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 (db:test-get-id
3240: 20 74 65 73 74 29 29 29 29 0a 09 09 09 20 20 20 test))))....
3250: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 (for-each ....
3260: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 74 65 (lambda (ste
3270: 70 29 0a 09 09 09 20 20 20 20 20 20 20 28 66 6f p).... (fo
3280: 72 6d 61 74 20 23 74 20 0a 09 09 09 09 20 20 20 rmat #t .....
3290: 20 20 20 20 22 20 20 20 20 53 74 65 70 3a 20 7e " Step: ~
32a0: 32 30 61 20 53 74 61 74 65 3a 20 7e 31 30 61 20 20a State: ~10a
32b0: 53 74 61 74 75 73 3a 20 7e 31 30 61 20 54 69 6d Status: ~10a Tim
32c0: 65 20 7e 32 32 61 5c 6e 22 0a 09 09 09 09 20 20 e ~22a\n".....
32d0: 20 20 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 (db:step-ge
32e0: 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 70 29 t-stepname step)
32f0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a ..... (db:
3300: 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 step-get-state s
3310: 74 65 70 29 0a 09 09 09 09 20 20 20 20 20 20 20 tep).....
3320: 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 (db:step-get-sta
3330: 74 75 73 20 73 74 65 70 29 0a 09 09 09 09 20 20 tus step).....
3340: 20 20 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 (db:step-ge
3350: 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 t-event_time ste
3360: 70 29 29 29 0a 09 09 09 20 20 20 20 20 73 74 65 p))).... ste
3370: 70 73 29 29 29 29 29 0a 09 09 20 20 74 65 73 74 ps)))))... test
3380: 73 29 29 29 29 0a 09 20 20 20 72 75 6e 73 29 0a s)))).. runs).
3390: 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d . (set! *didsom
33a0: 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 29 ething* #t).. )
33b0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
33c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
33d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
33e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
33f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
3400: 53 74 61 72 74 20 74 68 65 20 73 65 72 76 65 72 Start the server
3410: 20 2d 20 63 61 6e 20 62 65 20 64 6f 6e 65 20 69 - can be done i
3420: 6e 20 63 6f 6e 6a 75 6e 63 74 69 6f 6e 20 77 69 n conjunction wi
3430: 74 68 20 2d 72 75 6e 61 6c 6c 20 6f 72 20 2d 72 th -runall or -r
3440: 75 6e 74 65 73 74 73 20 28 6f 6e 65 20 64 61 79 untests (one day
3450: 2e 2e 2e 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ...).;;=========
3460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 69 =============.(i
34a0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
34b0: 22 2d 73 65 72 76 65 72 22 29 0a 20 20 20 20 28 "-server"). (
34c0: 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 let* ((toppath (
34d0: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
34e0: 09 20 20 20 28 64 62 20 20 20 20 20 20 28 69 66 . (db (if
34f0: 20 74 6f 70 70 61 74 68 20 28 6f 70 65 6e 2d 64 toppath (open-d
3500: 62 29 20 23 66 29 29 29 0a 20 20 20 20 20 20 28 b) #f))). (
3510: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
3520: 20 30 20 22 53 74 61 72 74 69 6e 67 20 74 68 65 0 "Starting the
3530: 20 73 74 61 6e 64 61 6c 6f 6e 65 20 73 65 72 76 standalone serv
3540: 65 72 22 29 0a 20 20 20 20 20 20 28 69 66 20 64 er"). (if d
3550: 62 20 0a 09 20 20 28 6c 65 74 2a 20 28 28 68 6f b .. (let* ((ho
3560: 73 74 3a 70 6f 72 74 20 28 64 62 3a 67 65 74 2d st:port (db:get-
3570: 76 61 72 20 64 62 20 22 53 45 52 56 45 52 22 29 var db "SERVER")
3580: 29 20 3b 3b 20 74 68 69 73 20 64 6f 65 6e 27 74 ) ;; this doen't
3590: 20 73 75 70 70 6f 72 74 20 6d 75 6c 74 69 70 6c support multipl
35a0: 65 20 73 65 72 76 65 72 73 20 42 55 47 21 21 21 e servers BUG!!!
35b0: 21 0a 09 09 20 28 74 68 32 20 28 73 65 72 76 65 !... (th2 (serve
35c0: 72 3a 73 74 61 72 74 20 64 62 20 28 61 72 67 73 r:start db (args
35d0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 72 76 65 :get-arg "-serve
35e0: 72 22 29 29 29 0a 09 09 20 28 74 68 33 20 28 6d r")))... (th3 (m
35f0: 61 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 ake-thread (lamb
3600: 64 61 20 28 29 0a 09 09 09 09 20 20 20 20 20 28 da ()..... (
3610: 73 65 72 76 65 72 3a 6b 65 65 70 2d 72 75 6e 6e server:keep-runn
3620: 69 6e 67 20 64 62 20 68 6f 73 74 3a 70 6f 72 74 ing db host:port
3630: 29 29 29 29 29 0a 09 20 20 20 20 28 74 68 72 65 ))))).. (thre
3640: 61 64 2d 73 74 61 72 74 21 20 74 68 33 29 0a 09 ad-start! th3)..
3650: 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e (thread-join
3660: 21 20 74 68 33 29 0a 09 20 20 20 20 28 73 65 74 ! th3).. (set
3670: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
3680: 20 23 74 29 29 0a 09 20 20 28 64 65 62 75 67 3a #t)).. (debug:
3690: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
36a0: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 20 Failed to setup
36b0: 66 6f 72 20 6d 65 67 61 74 65 73 74 22 29 29 29 for megatest")))
36c0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
36d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 66 ===========.;; f
3710: 75 6c 6c 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d ull run.;;======
3720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3760: 0a 0a 3b 3b 20 67 65 74 20 6c 6f 63 6b 20 69 6e ..;; get lock in
3770: 20 64 62 20 66 6f 72 20 66 75 6c 6c 20 72 75 6e db for full run
3780: 20 66 6f 72 20 74 68 69 73 20 64 69 72 65 63 74 for this direct
3790: 6f 72 79 0a 3b 3b 20 66 6f 72 20 61 6c 6c 20 74 ory.;; for all t
37a0: 65 73 74 73 20 77 69 74 68 20 64 65 70 73 0a 3b ests with deps.;
37b0: 3b 20 20 20 77 61 6c 6b 20 74 72 65 65 20 6f 66 ; walk tree of
37c0: 20 74 65 73 74 73 20 74 6f 20 66 69 6e 64 20 68 tests to find h
37d0: 65 61 64 20 74 61 73 6b 73 0a 3b 3b 20 20 20 61 ead tasks.;; a
37e0: 64 64 20 68 65 61 64 20 74 61 73 6b 73 20 74 6f dd head tasks to
37f0: 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 20 task queue.;;
3800: 20 61 64 64 20 64 65 70 65 6e 64 61 6e 74 20 74 add dependant t
3810: 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 asks to task que
3820: 75 65 20 0a 3b 3b 20 20 20 61 64 64 20 72 65 6d ue .;; add rem
3830: 61 69 6e 69 6e 67 20 74 61 73 6b 73 20 74 6f 20 aining tasks to
3840: 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 66 6f task queue.;; fo
3850: 72 20 65 61 63 68 20 74 61 73 6b 20 69 6e 20 74 r each task in t
3860: 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 20 20 69 ask queue.;; i
3870: 66 20 68 61 76 65 20 61 64 65 71 75 61 74 65 20 f have adequate
3880: 72 65 73 6f 75 72 63 65 73 0a 3b 3b 20 20 20 20 resources.;;
3890: 20 6c 61 75 6e 63 68 20 74 61 73 6b 0a 3b 3b 20 launch task.;;
38a0: 20 20 65 6c 73 65 0a 3b 3b 20 20 20 20 20 70 75 else.;; pu
38b0: 74 20 74 61 73 6b 20 69 6e 20 64 65 66 65 72 72 t task in deferr
38c0: 65 64 20 71 75 65 75 65 0a 3b 3b 20 69 66 20 73 ed queue.;; if s
38d0: 74 69 6c 6c 20 6f 6b 20 74 6f 20 72 75 6e 20 74 till ok to run t
38e0: 61 73 6b 73 0a 3b 3b 20 20 20 70 72 6f 63 65 73 asks.;; proces
38f0: 73 20 64 65 66 65 72 72 65 64 20 74 61 73 6b 73 s deferred tasks
3900: 20 70 65 72 20 61 62 6f 76 65 20 73 74 65 70 73 per above steps
3910: 0a 0a 3b 3b 20 72 75 6e 20 61 6c 6c 20 74 65 73 ..;; run all tes
3920: 74 73 20 61 72 65 20 61 72 65 20 4e 6f 74 20 43 ts are are Not C
3930: 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 50 41 53 OMPLETED and PAS
3940: 53 20 6f 72 20 43 48 45 43 4b 0a 28 69 66 20 28 S or CHECK.(if (
3950: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
3960: 75 6e 61 6c 6c 22 29 0a 20 20 20 20 28 67 65 6e unall"). (gen
3970: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 eral-run-call .
3980: 20 20 20 20 22 2d 72 75 6e 61 6c 6c 22 0a 20 20 "-runall".
3990: 20 20 20 22 72 75 6e 20 61 6c 6c 20 74 65 73 74 "run all test
39a0: 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 s". (lambda
39b0: 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 (target runname
39c0: 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 keys keynames ke
39d0: 79 76 61 6c 6c 73 74 29 0a 09 20 28 72 75 6e 73 yvallst).. (runs
39e0: 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 72 67 65 :run-tests targe
39f0: 74 0a 09 09 09 20 72 75 6e 6e 61 6d 65 0a 09 09 t.... runname...
3a00: 09 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d . (if (args:get-
3a10: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
3a20: 0a 09 09 09 20 20 20 20 20 28 61 72 67 73 3a 67 .... (args:g
3a30: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
3a40: 74 22 29 0a 09 09 09 20 20 20 20 20 22 25 2f 25 t").... "%/%
3a50: 22 29 0a 09 09 09 20 75 73 65 72 0a 09 09 09 20 ").... user....
3a60: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 args:arg-hash)))
3a70: 29 20 3b 3b 20 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d ================
3ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ac0: 0a 3b 3b 20 72 75 6e 20 6f 6e 65 20 74 65 73 74 .;; run one test
3ad0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
3ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e =========..;; 1.
3b20: 20 66 69 6e 64 20 74 68 65 20 63 6f 6e 66 69 67 find the config
3b30: 20 66 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 61 6e file.;; 2. chan
3b40: 67 65 20 74 6f 20 74 68 65 20 74 65 73 74 20 64 ge to the test d
3b50: 69 72 65 63 74 6f 72 79 0a 3b 3b 20 33 2e 20 75 irectory.;; 3. u
3b60: 70 64 61 74 65 20 74 68 65 20 64 62 20 77 69 74 pdate the db wit
3b70: 68 20 22 74 65 73 74 20 73 74 61 72 74 65 64 22 h "test started"
3b80: 20 73 74 61 74 75 73 2c 20 73 65 74 20 72 75 6e status, set run
3b90: 6e 69 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 2e 20 ning host.;; 4.
3ba0: 70 72 6f 63 65 73 73 20 6c 61 75 6e 63 68 20 74 process launch t
3bb0: 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 he test.;; -
3bc0: 6d 6f 6e 69 74 6f 72 20 74 68 65 20 70 72 6f 63 monitor the proc
3bd0: 65 73 73 2c 20 75 70 64 61 74 65 20 73 74 61 74 ess, update stat
3be0: 73 20 69 6e 20 74 68 65 20 64 62 20 65 76 65 72 s in the db ever
3bf0: 79 20 32 5e 6e 20 6d 69 6e 75 74 65 73 0a 3b 3b y 2^n minutes.;;
3c00: 20 35 2e 20 61 73 20 74 68 65 20 74 65 73 74 20 5. as the test
3c10: 70 72 6f 63 65 65 64 73 20 69 6e 74 65 72 6e 61 proceeds interna
3c20: 6c 6c 79 20 69 74 20 63 61 6c 6c 73 20 6d 65 67 lly it calls meg
3c30: 61 74 65 73 74 20 61 73 20 65 61 63 68 20 73 74 atest as each st
3c40: 65 70 20 69 73 0a 3b 3b 20 20 20 20 73 74 61 72 ep is.;; star
3c50: 74 65 64 20 61 6e 64 20 63 6f 6d 70 6c 65 74 65 ted and complete
3c60: 64 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 73 d.;; - step s
3c70: 74 61 72 74 65 64 2c 20 74 69 6d 65 73 74 61 6d tarted, timestam
3c80: 70 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 63 p.;; - step c
3c90: 6f 6d 70 6c 65 74 65 64 2c 20 65 78 69 74 20 73 ompleted, exit s
3ca0: 74 61 74 75 73 2c 20 74 69 6d 65 73 74 61 6d 70 tatus, timestamp
3cb0: 0a 3b 3b 20 36 2e 20 74 65 73 74 20 70 68 6f 6e .;; 6. test phon
3cc0: 65 20 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d 20 69 e home.;; - i
3cd0: 66 20 74 65 73 74 20 72 75 6e 20 74 69 6d 65 20 f test run time
3ce0: 3e 20 61 6c 6c 6f 77 65 64 20 72 75 6e 20 74 69 > allowed run ti
3cf0: 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 me then kill job
3d00: 0a 3b 3b 20 20 20 20 2d 20 69 66 20 63 61 6e 6e .;; - if cann
3d10: 6f 74 20 61 63 63 65 73 73 20 64 62 20 3e 20 61 ot access db > a
3d20: 6c 6c 6f 77 65 64 20 64 69 73 63 6f 6e 6e 65 63 llowed disconnec
3d30: 74 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c t time then kill
3d40: 20 6a 6f 62 0a 0a 28 69 66 20 28 61 72 67 73 3a job..(if (args:
3d50: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 get-arg "-runtes
3d60: 74 73 22 29 0a 20 20 28 67 65 6e 65 72 61 6c 2d ts"). (general-
3d70: 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 22 2d 72 run-call . "-r
3d80: 75 6e 74 65 73 74 73 22 20 0a 20 20 20 22 72 75 untests" . "ru
3d90: 6e 20 61 20 74 65 73 74 22 20 0a 20 20 20 28 6c n a test" . (l
3da0: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
3db0: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 nname keys keyna
3dc0: 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 mes keyvallst).
3dd0: 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 (runs:run-te
3de0: 73 74 73 20 74 61 72 67 65 74 0a 09 09 20 20 20 sts target...
3df0: 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 20 20 runname...
3e00: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3e10: 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 09 20 20 -runtests")...
3e20: 20 20 20 75 73 65 72 0a 09 09 20 20 20 20 20 61 user... a
3e30: 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 29 rgs:arg-hash))))
3e40: 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d ================
3e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 6f ==========.;; Ro
3e90: 6c 6c 75 70 20 69 6e 74 6f 20 61 20 72 75 6e 0a llup into a run.
3ea0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
3eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ee0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
3ef0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 6f rgs:get-arg "-ro
3f00: 6c 6c 75 70 22 29 0a 20 20 20 20 28 62 65 67 69 llup"). (begi
3f10: 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 n. (debug:p
3f20: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 52 rint 0 "ERROR: R
3f30: 6f 6c 6c 75 70 20 69 73 20 63 75 72 72 65 6e 74 ollup is current
3f40: 6c 79 20 6e 6f 74 20 77 6f 72 6b 69 6e 67 2e 20 ly not working.
3f50: 49 66 20 79 6f 75 20 6e 65 65 64 20 69 74 20 70 If you need it p
3f60: 6c 65 61 73 65 20 73 75 62 6d 69 74 20 61 20 74 lease submit a t
3f70: 69 63 6b 65 74 20 61 74 20 68 74 74 70 3a 2f 2f icket at http://
3f80: 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 www.kiatoa.com/f
3f90: 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 22 ossils/megatest"
3fa0: 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 34 29 ). (exit 4)
3fb0: 29 29 0a 3b 3b 20 20 20 20 20 28 67 65 6e 65 72 )).;; (gener
3fc0: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 3b 3b 20 al-run-call .;;
3fd0: 20 20 20 20 20 22 2d 72 6f 6c 6c 75 70 22 20 0a "-rollup" .
3fe0: 3b 3b 20 20 20 20 20 20 22 72 6f 6c 6c 75 70 20 ;; "rollup
3ff0: 74 65 73 74 73 22 20 0a 3b 3b 20 20 20 20 20 20 tests" .;;
4000: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
4010: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
4020: 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 names keyvallst)
4030: 0a 3b 3b 20 20 20 20 20 20 20 20 28 72 75 6e 73 .;; (runs
4040: 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 6b 65 79 73 :rollup-run keys
4050: 0a 3b 3b 20 09 09 09 28 6b 65 79 73 2d 3e 61 6c .;; ...(keys->al
4060: 69 73 74 20 6b 65 79 73 20 22 6e 61 22 29 0a 3b ist keys "na").;
4070: 3b 20 09 09 09 28 61 72 67 73 3a 67 65 74 2d 61 ; ...(args:get-a
4080: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 0a rg ":runname") .
4090: 3b 3b 20 09 09 09 75 73 65 72 29 29 29 29 0a 0a ;; ...user))))..
40a0: 3b 3b 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 3d 3d 3d 3d 3d 3d 3d ================
40e0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 6f 63 6b ========.;; Lock
40f0: 20 6f 72 20 75 6e 6c 6f 63 6b 20 61 20 72 75 6e or unlock a run
4100: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
4110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
4150: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
4160: 20 22 2d 6c 6f 63 6b 22 29 28 61 72 67 73 3a 67 "-lock")(args:g
4170: 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b 22 et-arg "-unlock"
4180: 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d )). (general-
4190: 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 28 run-call . (
41a0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
41b0: 20 22 2d 6c 6f 63 6b 22 29 20 22 2d 6c 6f 63 6b "-lock") "-lock
41c0: 22 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 20 20 " "-unlock").
41d0: 20 20 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 20 74 "lock/unlock t
41e0: 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c 61 6d ests" . (lam
41f0: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
4200: 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 ame keys keyname
4210: 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 s keyvallst).
4220: 20 20 20 20 28 72 75 6e 73 3a 68 61 6e 64 6c 65 (runs:handle
4230: 2d 6c 6f 63 6b 69 6e 67 20 0a 09 09 20 20 74 61 -locking ... ta
4240: 72 67 65 74 0a 09 09 20 20 6b 65 79 73 0a 09 09 rget... keys...
4250: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
4260: 22 3a 72 75 6e 6e 61 6d 65 22 29 20 0a 09 09 20 ":runname") ...
4270: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4280: 2d 6c 6f 63 6b 22 29 0a 09 09 20 20 28 61 72 67 -lock")... (arg
4290: 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f s:get-arg "-unlo
42a0: 63 6b 22 29 0a 09 09 20 20 75 73 65 72 29 29 29 ck")... user)))
42b0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
42c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
42d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
42e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
42f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 ===========.;; G
4300: 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 74 et paths to test
4310: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
4320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 65 ==========.;; Ge
4360: 74 20 74 65 73 74 20 70 61 74 68 73 20 6d 61 74 t test paths mat
4370: 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 75 ching target, ru
4380: 6e 6e 61 6d 65 2c 20 74 65 73 74 70 61 74 74 2c nname, testpatt,
4390: 20 61 6e 64 20 69 74 65 6d 70 61 74 74 0a 28 69 and itempatt.(i
43a0: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
43b0: 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 arg "-test-files
43c0: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
43d0: 22 2d 74 65 73 74 2d 70 61 74 68 73 22 29 29 0a "-test-paths")).
43e0: 20 20 20 20 3b 3b 20 69 66 20 77 65 20 61 72 65 ;; if we are
43f0: 20 69 6e 20 61 20 74 65 73 74 20 75 73 65 20 74 in a test use t
4400: 68 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 61 he MT_CMDINFO da
4410: 74 61 0a 20 20 20 20 28 69 66 20 28 67 65 74 65 ta. (if (gete
4420: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
4430: 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 ..(let* ((starti
4440: 6e 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 ngdir (current-d
4450: 69 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 irectory))..
4460: 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 (cmdinfo (r
4470: 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d ead (open-input-
4480: 73 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 string (base64:b
4490: 61 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 ase64-decode (ge
44a0: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
44b0: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 "))))).. (
44c0: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
44d0: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
44e0: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
44f0: 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
4500: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
4510: 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
4520: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
4530: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
4540: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
4550: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
4560: 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 (db-host (
4570: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 assoc/default 'd
4580: 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f b-host cmdinfo
4590: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
45a0: 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 id (assoc/def
45b0: 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 ault 'run-id
45c0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
45d0: 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
45e0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
45f0: 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
4600: 0a 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 .. (db
4610: 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 #f)..
4620: 28 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 (state (args
4630: 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 :get-arg ":state
4640: 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 ")).. (sta
4650: 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 tus (args:get
4660: 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 -arg ":status"))
4670: 0a 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 .. (target
4680: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
4690: 67 20 22 2d 74 61 72 67 65 74 22 29 29 0a 09 20 g "-target"))..
46a0: 20 20 20 20 20 20 28 74 6f 70 70 61 74 68 20 20 (toppath
46b0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
46c0: 27 74 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 'toppath cmdin
46d0: 66 6f 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 fo))).. (change
46e0: 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 70 61 -directory toppa
46f0: 74 68 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 th).. (if (not
4700: 74 61 72 67 65 74 29 0a 09 20 20 20 20 20 20 28 target).. (
4710: 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 begin...(debug:p
4720: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 2d rint 0 "ERROR: -
4730: 74 61 72 67 65 74 20 69 73 20 72 65 71 75 69 72 target is requir
4740: 65 64 2e 22 29 0a 09 09 28 65 78 69 74 20 31 29 ed.")...(exit 1)
4750: 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 )).. (if (not (
4760: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
4770: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
4780: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
4790: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
47a0: 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 2d 74 giving up on -t
47b0: 65 73 74 2d 70 61 74 68 73 20 6f 72 20 2d 74 65 est-paths or -te
47c0: 73 74 2d 66 69 6c 65 73 2c 20 65 78 69 74 69 6e st-files, exitin
47d0: 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 g")...(exit 1)))
47e0: 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 .. (let* ((keys
47f0: 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
4800: 6c 6f 73 65 20 64 62 3a 67 65 74 2d 6b 65 79 73 lose db:get-keys
4810: 20 64 62 29 29 0a 09 09 20 28 6b 65 79 6e 61 6d db))... (keynam
4820: 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d es (map key:get-
4830: 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 fieldname keys))
4840: 0a 09 09 20 28 70 61 74 68 73 20 20 20 20 28 6f ... (paths (o
4850: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 pen-run-close db
4860: 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d :test-get-paths-
4870: 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e matching db keyn
4880: 61 6d 65 73 20 74 61 72 67 65 74 20 28 61 72 67 ames target (arg
4890: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
48a0: 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 20 20 -files"))))..
48b0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
48c0: 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 28 hing* #t).. (
48d0: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
48e0: 20 28 70 61 74 68 29 0a 09 09 09 28 70 72 69 6e (path)....(prin
48f0: 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 t path))...
4900: 20 70 61 74 68 73 29 29 29 0a 09 3b 3b 20 65 6c paths)))..;; el
4910: 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 6c 2d se do a general-
4920: 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 72 run-call..(gener
4930: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 22 al-run-call .. "
4940: 2d 74 65 73 74 2d 66 69 6c 65 73 22 0a 09 20 22 -test-files".. "
4950: 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 Get paths to tes
4960: 74 22 0a 09 20 28 6c 61 6d 62 64 61 20 28 74 61 t".. (lambda (ta
4970: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
4980: 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 s keynames keyva
4990: 6c 6c 73 74 29 0a 09 20 20 20 28 6c 65 74 2a 20 llst).. (let*
49a0: 28 28 64 62 20 20 20 20 20 20 20 23 66 29 0a 09 ((db #f)..
49b0: 09 20 20 28 69 74 65 6d 70 61 74 74 20 28 61 72 . (itempatt (ar
49c0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 gs:get-arg "-ite
49d0: 6d 70 61 74 74 22 29 29 0a 09 09 20 20 28 70 61 mpatt"))... (pa
49e0: 74 68 73 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e ths (open-run
49f0: 2d 63 6c 6f 73 65 20 64 62 3a 74 65 73 74 2d 67 -close db:test-g
4a00: 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e et-paths-matchin
4a10: 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 g db keynames ta
4a20: 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d 61 rget (args:get-a
4a30: 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 rg "-test-files"
4a40: 29 29 29 29 0a 09 20 20 20 20 20 28 66 6f 72 2d )))).. (for-
4a50: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 each (lambda (pa
4a60: 74 68 29 0a 09 09 09 20 28 70 72 69 6e 74 20 70 th).... (print p
4a70: 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 20 70 ath))... p
4a80: 61 74 68 73 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d aths))))))..;;==
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 3d 3d ================
4ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4ad0: 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 20 ====.;; Archive
4ae0: 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d tests.;;========
4af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
4b30: 3b 20 41 72 63 68 69 76 65 20 74 65 73 74 73 20 ; Archive tests
4b40: 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c matching target,
4b50: 20 72 75 6e 6e 61 6d 65 2c 20 74 65 73 74 70 61 runname, testpa
4b60: 74 74 2c 20 61 6e 64 20 69 74 65 6d 70 61 74 74 tt, and itempatt
4b70: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
4b80: 72 67 20 22 2d 61 72 63 68 69 76 65 22 29 0a 20 rg "-archive").
4b90: 20 20 20 3b 3b 20 69 66 20 77 65 20 61 72 65 20 ;; if we are
4ba0: 69 6e 20 61 20 74 65 73 74 20 75 73 65 20 74 68 in a test use th
4bb0: 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 61 74 e MT_CMDINFO dat
4bc0: 61 0a 20 20 20 20 28 69 66 20 28 67 65 74 65 6e a. (if (geten
4bd0: 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 0a v "MT_CMDINFO").
4be0: 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e .(let* ((startin
4bf0: 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 gdir (current-di
4c00: 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 rectory))..
4c10: 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 (cmdinfo (re
4c20: 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 ad (open-input-s
4c30: 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 tring (base64:ba
4c40: 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 74 se64-decode (get
4c50: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
4c60: 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 ))))).. (t
4c70: 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f estpath (assoc/
4c80: 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 default 'testpat
4c90: 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 h cmdinfo))..
4ca0: 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 (test-name
4cb0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
4cc0: 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 test-name cmdinf
4cd0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
4ce0: 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 script (assoc/de
4cf0: 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 fault 'runscript
4d00: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
4d10: 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 (db-host (a
4d20: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 ssoc/default 'db
4d30: 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 -host cmdinfo)
4d40: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 ).. (run-i
4d50: 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 d (assoc/defa
4d60: 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 ult 'run-id c
4d70: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
4d80: 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 (itemdat (ass
4d90: 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d oc/default 'item
4da0: 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a dat cmdinfo)).
4db0: 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 20 . (db
4dc0: 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 #f).. (
4dd0: 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 3a state (args:
4de0: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 get-arg ":state"
4df0: 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 )).. (stat
4e00: 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d us (args:get-
4e10: 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a arg ":status")).
4e20: 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 20 . (target
4e30: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
4e40: 20 22 2d 74 61 72 67 65 74 22 29 29 29 0a 09 20 "-target")))..
4e50: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
4e60: 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 20 20 ry testpath)..
4e70: 28 69 66 20 28 6e 6f 74 20 74 61 72 67 65 74 29 (if (not target)
4e80: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
4e90: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
4ea0: 22 45 52 52 4f 52 3a 20 2d 74 61 72 67 65 74 20 "ERROR: -target
4eb0: 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 0a 09 is required.")..
4ec0: 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 .(exit 1))).. (
4ed0: 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 if (not (setup-f
4ee0: 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 or-run))..
4ef0: 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a (begin...(debug:
4f00: 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 print 0 "Failed
4f10: 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 6e 67 to setup, giving
4f20: 20 75 70 20 6f 6e 20 2d 61 72 63 68 69 76 65 2c up on -archive,
4f30: 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 exiting")...(ex
4f40: 69 74 20 31 29 29 29 0a 09 20 20 28 6c 65 74 2a it 1))).. (let*
4f50: 20 28 28 69 74 65 6d 70 61 74 74 20 28 61 72 67 ((itempatt (arg
4f60: 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d s:get-arg "-item
4f70: 70 61 74 74 22 29 29 0a 09 09 20 28 6b 65 79 73 patt"))... (keys
4f80: 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
4f90: 6c 6f 73 65 20 64 62 3a 67 65 74 2d 6b 65 79 73 lose db:get-keys
4fa0: 20 64 62 29 29 0a 09 09 20 28 6b 65 79 6e 61 6d db))... (keynam
4fb0: 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d es (map key:get-
4fc0: 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 fieldname keys))
4fd0: 0a 09 09 20 28 70 61 74 68 73 20 20 20 20 28 6f ... (paths (o
4fe0: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 pen-run-close db
4ff0: 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d :test-get-paths-
5000: 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e matching db keyn
5010: 61 6d 65 73 20 74 61 72 67 65 74 29 29 29 0a 09 ames target)))..
5020: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
5030: 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 mething* #t)..
5040: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
5050: 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 28 70 bda (path)....(p
5060: 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 20 20 rint path))...
5070: 20 20 20 20 70 61 74 68 73 29 29 29 0a 09 3b 3b paths)))..;;
5080: 20 65 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 72 else do a gener
5090: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 al-run-call..(ge
50a0: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
50b0: 09 20 22 2d 74 65 73 74 2d 70 61 74 68 73 22 0a . "-test-paths".
50c0: 09 20 22 47 65 74 20 70 61 74 68 73 20 74 6f 20 . "Get paths to
50d0: 74 65 73 74 73 22 0a 09 20 28 6c 61 6d 62 64 61 tests".. (lambda
50e0: 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 (target runname
50f0: 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b keys keynames k
5100: 65 79 76 61 6c 6c 73 74 29 0a 09 20 20 20 28 6c eyvallst).. (l
5110: 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 23 et* ((db #
5120: 66 29 0a 09 09 20 20 28 69 74 65 6d 70 61 74 74 f)... (itempatt
5130: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5140: 2d 69 74 65 6d 70 61 74 74 22 29 29 0a 09 09 20 -itempatt"))...
5150: 20 28 70 61 74 68 73 20 20 20 20 28 6f 70 65 6e (paths (open
5160: 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 74 65 -run-close db:te
5170: 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 st-get-paths-mat
5180: 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 ching db keyname
5190: 73 20 74 61 72 67 65 74 29 29 29 0a 09 20 20 20 s target)))..
51a0: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
51b0: 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 20 28 bda (path).... (
51c0: 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 20 print path))...
51d0: 20 20 20 20 20 20 70 61 74 68 73 29 29 29 29 29 paths)))))
51e0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
51f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5200: 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 0a 3b 3b 20 45 ===========.;; E
5230: 78 74 72 61 63 74 20 61 20 73 70 72 65 61 64 73 xtract a spreads
5240: 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 72 75 heet from the ru
5250: 6e 73 20 64 61 74 61 62 61 73 65 0a 3b 3b 3d 3d ns database.;;==
5260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52a0: 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
52b0: 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 61 63 get-arg "-extrac
52c0: 74 2d 6f 64 73 22 29 0a 20 20 20 20 28 67 65 6e t-ods"). (gen
52d0: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 eral-run-call.
52e0: 20 20 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 "-extract-ods
52f0: 22 0a 20 20 20 20 20 22 4d 61 6b 65 20 6f 64 73 ". "Make ods
5300: 20 73 70 72 65 61 64 73 68 65 65 74 22 0a 20 20 spreadsheet".
5310: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
5320: 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
5330: 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c keynames keyvall
5340: 73 74 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 st). (let
5350: 28 28 64 62 20 20 20 20 20 20 20 20 20 23 66 29 ((db #f)
5360: 0a 09 20 20 20 20 20 28 6f 75 74 70 75 74 66 69 .. (outputfi
5370: 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 le (args:get-arg
5380: 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 "-extract-ods")
5390: 29 0a 09 20 20 20 20 20 28 72 75 6e 73 70 61 74 ).. (runspat
53a0: 74 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 t (args:get-ar
53b0: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g ":runname"))..
53c0: 20 20 20 20 20 28 70 61 74 68 6d 6f 64 20 20 20 (pathmod
53d0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
53e0: 2d 70 61 74 68 6d 6f 64 22 29 29 0a 09 20 20 20 -pathmod"))..
53f0: 20 20 28 6b 65 79 76 61 6c 61 6c 69 73 74 20 28 (keyvalalist (
5400: 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 79 73 keys->alist keys
5410: 20 22 25 22 29 29 29 0a 09 20 28 64 65 62 75 67 "%"))).. (debug
5420: 3a 70 72 69 6e 74 20 32 20 22 45 78 74 72 61 63 :print 2 "Extrac
5430: 74 20 6f 64 73 2c 20 6f 75 74 70 75 74 66 69 6c t ods, outputfil
5440: 65 3a 20 22 20 6f 75 74 70 75 74 66 69 6c 65 20 e: " outputfile
5450: 22 20 72 75 6e 73 70 61 74 74 3a 20 22 20 72 75 " runspatt: " ru
5460: 6e 73 70 61 74 74 20 22 20 6b 65 79 76 61 6c 61 nspatt " keyvala
5470: 6c 69 73 74 3a 20 22 20 6b 65 79 76 61 6c 61 6c list: " keyvalal
5480: 69 73 74 29 0a 09 20 28 6f 70 65 6e 2d 72 75 6e ist).. (open-run
5490: 2d 63 6c 6f 73 65 20 64 62 3a 65 78 74 72 61 63 -close db:extrac
54a0: 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 20 6f 75 t-ods-file db ou
54b0: 74 70 75 74 66 69 6c 65 20 6b 65 79 76 61 6c 61 tputfile keyvala
54c0: 6c 69 73 74 20 28 69 66 20 72 75 6e 73 70 61 74 list (if runspat
54d0: 74 20 72 75 6e 73 70 61 74 74 20 22 25 22 29 20 t runspatt "%")
54e0: 70 61 74 68 6d 6f 64 29 29 29 29 29 0a 0a 3b 3b pathmod)))))..;;
54f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5530: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 63 75 74 ======.;; execut
5540: 65 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 e the test.;;
5550: 20 2d 20 67 65 74 73 20 63 61 6c 6c 65 64 20 6f - gets called o
5560: 6e 20 72 65 6d 6f 74 65 20 68 6f 73 74 0a 3b 3b n remote host.;;
5570: 20 20 20 20 2d 20 72 65 63 65 69 76 65 73 20 69 - receives i
5580: 6e 66 6f 20 66 72 6f 6d 20 74 68 65 20 2d 65 78 nfo from the -ex
5590: 65 63 75 74 65 20 70 61 72 61 6d 0a 3b 3b 20 20 ecute param.;;
55a0: 20 20 2d 20 70 61 73 73 65 73 20 69 6e 66 6f 20 - passes info
55b0: 74 6f 20 73 74 65 70 73 20 76 69 61 20 4d 54 5f to steps via MT_
55c0: 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 CMDINFO env var
55d0: 28 66 75 74 75 72 65 20 69 73 20 74 6f 20 75 73 (future is to us
55e0: 65 20 61 20 64 6f 74 20 66 69 6c 65 29 0a 3b 3b e a dot file).;;
55f0: 20 20 20 20 2d 20 67 61 74 68 65 72 73 20 68 6f - gathers ho
5600: 73 74 20 69 6e 66 6f 20 61 6e 64 20 0a 3b 3b 3d st info and .;;=
5610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5650: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
5660: 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 :get-arg "-execu
5670: 74 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a te"). (begin.
5680: 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 65 78 (launch:ex
5690: 65 63 75 74 65 20 28 61 72 67 73 3a 67 65 74 2d ecute (args:get-
56a0: 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 29 arg "-execute"))
56b0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
56c0: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
56d0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
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 0a 3b 3b 20 54 ===========.;; T
5720: 65 73 74 20 63 6f 6d 6d 61 6e 64 73 20 28 69 2e est commands (i.
5730: 65 2e 20 66 6f 72 20 75 73 65 20 69 6e 73 69 64 e. for use insid
5740: 65 20 74 65 73 74 73 29 0a 3b 3b 3d 3d 3d 3d 3d e tests).;;=====
5750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5790: 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 =..(if (args:get
57a0: 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a 20 20 -arg "-step").
57b0: 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 65 (if (not (gete
57c0: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
57d0: 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 )..(begin.. (de
57e0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
57f0: 4f 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 OR: MT_CMDINFO e
5800: 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 nv var not set,
5810: 2d 73 74 65 70 20 6d 75 73 74 20 62 65 20 63 61 -step must be ca
5820: 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 lled *inside* a
5830: 6d 65 67 61 74 65 73 74 20 69 6e 76 6f 6b 65 64 megatest invoked
5840: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a environment!").
5850: 09 20 20 28 65 78 69 74 20 35 29 29 0a 09 28 6c . (exit 5))..(l
5860: 65 74 2a 20 28 28 73 74 65 70 20 20 20 20 20 20 et* ((step
5870: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5880: 73 74 65 70 22 29 29 0a 09 20 20 20 20 20 20 20 step"))..
5890: 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 64 (cmdinfo (read
58a0: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 (open-input-str
58b0: 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 73 65 ing (base64:base
58c0: 36 34 2d 64 65 63 6f 64 65 20 28 67 65 74 65 6e 64-decode (geten
58d0: 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 v "MT_CMDINFO"))
58e0: 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 ))).. (tes
58f0: 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 tpath (assoc/de
5900: 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 fault 'testpath
5910: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
5920: 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 (test-name (a
5930: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
5940: 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 st-name cmdinfo)
5950: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 ).. (runsc
5960: 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 ript (assoc/defa
5970: 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 ult 'runscript c
5980: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
5990: 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 (db-host (ass
59a0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 oc/default 'db-h
59b0: 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a ost cmdinfo)).
59c0: 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 . (run-id
59d0: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
59e0: 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 t 'run-id cmd
59f0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
5a00: 74 65 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 test-id (assoc
5a10: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 /default 'test-i
5a20: 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 d cmdinfo))..
5a30: 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 (itemdat
5a40: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
5a50: 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 'itemdat cmdin
5a60: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 fo)).. (db
5a70: 20 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 #f)..
5a80: 20 20 20 20 28 73 74 61 74 65 20 20 20 20 28 61 (state (a
5a90: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
5aa0: 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 ate")).. (
5ab0: 73 74 61 74 75 73 20 20 20 28 61 72 67 73 3a 67 status (args:g
5ac0: 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 et-arg ":status"
5ad0: 29 29 0a 09 20 20 20 20 20 20 20 28 6c 6f 67 66 )).. (logf
5ae0: 69 6c 65 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ile (args:get-a
5af0: 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 29 29 0a rg "-setlog"))).
5b00: 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
5b10: 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
5b20: 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 (if (not (setu
5b30: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 p-for-run))..
5b40: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 (begin...(deb
5b50: 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c ug:print 0 "Fail
5b60: 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
5b70: 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 ting")...(exit 1
5b80: 29 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 ))).. (if (and
5b90: 73 74 61 74 65 20 73 74 61 74 75 73 29 0a 09 20 state status)..
5ba0: 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
5bb0: 6c 6f 73 65 20 64 62 3a 74 65 73 74 73 74 65 70 lose db:teststep
5bc0: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 -set-status! db
5bd0: 74 65 73 74 2d 69 64 20 73 74 65 70 20 73 74 61 test-id step sta
5be0: 74 65 20 73 74 61 74 75 73 20 28 61 72 67 73 3a te status (args:
5bf0: 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 6c 6f get-arg "-m") lo
5c00: 67 66 69 6c 65 29 0a 09 20 20 20 20 20 20 28 62 gfile).. (b
5c10: 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 egin...(debug:pr
5c20: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 59 6f int 0 "ERROR: Yo
5c30: 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 3a u must specify :
5c40: 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 state and :statu
5c50: 73 20 77 69 74 68 20 65 76 65 72 79 20 63 61 6c s with every cal
5c60: 6c 20 74 6f 20 2d 73 74 65 70 22 29 0a 09 09 28 l to -step")...(
5c70: 65 78 69 74 20 36 29 29 29 0a 09 20 20 28 69 66 exit 6))).. (if
5c80: 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e db (sqlite3:fin
5c90: 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 20 20 28 alize! db)).. (
5ca0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
5cb0: 6e 67 2a 20 23 74 29 29 29 29 0a 0a 28 69 66 20 ng* #t))))..(if
5cc0: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
5cd0: 67 20 22 2d 73 65 74 6c 6f 67 22 29 20 20 20 20 g "-setlog")
5ce0: 20 20 20 3b 3b 20 73 69 6e 63 65 20 73 65 74 74 ;; since sett
5cf0: 69 6e 67 20 75 70 20 69 73 20 73 6f 20 63 6f 73 ing up is so cos
5d00: 74 6c 79 20 6c 65 74 73 20 70 69 67 67 79 62 61 tly lets piggyba
5d10: 63 6b 20 6f 6e 20 2d 74 65 73 74 2d 73 74 61 74 ck on -test-stat
5d20: 75 73 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 us..(args:get-ar
5d30: 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 g "-set-toplog")
5d40: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
5d50: 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a "-test-status").
5d60: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
5d70: 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 0a 09 28 -set-values")..(
5d80: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
5d90: 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a oad-test-data").
5da0: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
5db0: 2d 72 75 6e 73 74 65 70 22 29 0a 09 28 61 72 67 -runstep")..(arg
5dc0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d 6d s:get-arg "-summ
5dd0: 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 29 0a 20 arize-items")).
5de0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 (if (not (get
5df0: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
5e00: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
5e10: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
5e20: 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 ROR: MT_CMDINFO
5e30: 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c env var not set,
5e40: 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 65 73 74 2d commands -test-
5e50: 73 74 61 74 75 73 2c 20 2d 72 75 6e 73 74 65 70 status, -runstep
5e60: 20 61 6e 64 20 2d 73 65 74 6c 6f 67 20 6d 75 73 and -setlog mus
5e70: 74 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 t be called *ins
5e80: 69 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 ide* a megatest
5e90: 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 environment!")..
5ea0: 20 20 28 65 78 69 74 20 35 29 29 0a 09 28 6c 65 (exit 5))..(le
5eb0: 74 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 t* ((startingdir
5ec0: 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 (current-direct
5ed0: 6f 72 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 ory)).. (c
5ee0: 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 mdinfo (read (
5ef0: 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e open-input-strin
5f00: 67 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 g (base64:base64
5f10: 2d 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 -decode (getenv
5f20: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 "MT_CMDINFO"))))
5f30: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 ).. (testp
5f40: 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
5f50: 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
5f60: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
5f70: 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 (test-name (ass
5f80: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
5f90: 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a -name cmdinfo)).
5fa0: 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 . (runscri
5fb0: 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c pt (assoc/defaul
5fc0: 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 t 'runscript cmd
5fd0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
5fe0: 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 db-host (assoc
5ff0: 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 /default 'db-hos
6000: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
6010: 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id
6020: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
6030: 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 'run-id cmdin
6040: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 fo)).. (te
6050: 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 st-id (assoc/d
6060: 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 efault 'test-id
6070: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
6080: 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 (itemdat (
6090: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 assoc/default 'i
60a0: 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f temdat cmdinfo
60b0: 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 20 20 )).. (db
60c0: 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 #f)..
60d0: 20 20 28 73 74 61 74 65 20 20 20 20 20 28 61 72 (state (ar
60e0: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
60f0: 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 te")).. (s
6100: 74 61 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 tatus (args:g
6110: 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 et-arg ":status"
6120: 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 ))).. (change-d
6130: 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
6140: 68 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 h).. (if (not (
6150: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
6160: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
6170: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
6180: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
6190: 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 exiting")...(ex
61a0: 69 74 20 31 29 29 29 0a 0a 09 20 20 3b 3b 20 63 it 1)))... ;; c
61b0: 61 6e 20 73 65 74 75 70 20 61 73 20 63 6c 69 65 an setup as clie
61c0: 6e 74 20 66 6f 72 20 73 65 72 76 65 72 20 6d 6f nt for server mo
61d0: 64 65 20 6e 6f 77 0a 09 20 20 28 73 65 72 76 65 de now.. (serve
61e0: 72 3a 63 6c 69 65 6e 74 2d 73 65 74 75 70 29 0a r:client-setup).
61f0: 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 .. (if (args:ge
6200: 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 t-arg "-load-tes
6210: 74 2d 64 61 74 61 22 29 0a 09 20 20 20 20 20 20 t-data")..
6220: 3b 3b 20 68 61 73 20 73 75 62 20 63 6f 6d 6d 61 ;; has sub comma
6230: 6e 64 73 20 74 68 61 74 20 61 72 65 20 72 64 62 nds that are rdb
6240: 3a 0a 09 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 :.. (open-r
6250: 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 6c 6f 61 64 un-close db:load
6260: 2d 74 65 73 74 2d 64 61 74 61 20 64 62 20 74 65 -test-data db te
6270: 73 74 2d 69 64 29 29 0a 09 20 20 28 69 66 20 28 st-id)).. (if (
6280: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
6290: 65 74 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 28 etlog").. (
62a0: 6c 65 74 20 28 28 6c 6f 67 66 6e 61 6d 65 20 28 let ((logfname (
62b0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
62c0: 65 74 6c 6f 67 22 29 29 29 0a 09 09 28 6f 70 65 etlog")))...(ope
62d0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 74 n-run-close db:t
62e0: 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 64 62 20 est-set-log! db
62f0: 74 65 73 74 2d 69 64 20 6c 6f 67 66 6e 61 6d 65 test-id logfname
6300: 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 ))).. (if (args
6310: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 :get-arg "-set-t
6320: 6f 70 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 28 oplog").. (
6330: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 open-run-close t
6340: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 74 6f ests:test-set-to
6350: 70 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 plog! db run-id
6360: 74 65 73 74 2d 6e 61 6d 65 20 28 61 72 67 73 3a test-name (args:
6370: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f get-arg "-set-to
6380: 70 6c 6f 67 22 29 29 29 0a 09 20 20 28 69 66 20 plog"))).. (if
6390: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
63a0: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 summarize-items"
63b0: 29 0a 09 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 ).. (open-r
63c0: 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 73 3a 73 un-close tests:s
63d0: 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 64 ummarize-items d
63e0: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
63f0: 6d 65 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 6f me #t)) ;; do fo
6400: 72 63 65 20 68 65 72 65 0a 09 20 20 28 69 66 20 rce here.. (if
6410: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6420: 72 75 6e 73 74 65 70 22 29 0a 09 20 20 20 20 20 runstep")..
6430: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 (if (null? rema
6440: 72 67 73 29 0a 09 09 20 20 28 62 65 67 69 6e 0a rgs)... (begin.
6450: 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
6460: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 6e 6f 74 nt 0 "ERROR: not
6470: 68 69 6e 67 20 73 70 65 63 69 66 69 65 64 20 74 hing specified t
6480: 6f 20 72 75 6e 21 22 29 0a 09 09 20 20 20 20 28 o run!")... (
6490: 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 if db (sqlite3:f
64a0: 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 09 inalize! db))...
64b0: 20 20 20 20 28 65 78 69 74 20 36 29 29 0a 09 09 (exit 6))...
64c0: 20 20 28 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 (let* ((stepna
64d0: 6d 65 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 me (args:get-a
64e0: 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 29 0a rg "-runstep")).
64f0: 09 09 09 20 28 6c 6f 67 70 72 6f 66 69 6c 65 20 ... (logprofile
6500: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6510: 6c 6f 67 70 72 6f 22 29 29 0a 09 09 09 20 28 6c logpro")).... (l
6520: 6f 67 66 69 6c 65 20 20 20 20 28 63 6f 6e 63 20 ogfile (conc
6530: 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 stepname ".log")
6540: 29 0a 09 09 09 20 28 63 6d 64 20 20 20 20 20 20 ).... (cmd
6550: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d (if (null? rem
6560: 61 72 67 73 29 20 23 66 20 28 63 61 72 20 72 65 args) #f (car re
6570: 6d 61 72 67 73 29 29 29 0a 09 09 09 20 28 70 61 margs))).... (pa
6580: 72 61 6d 73 20 20 20 20 20 28 69 66 20 63 6d 64 rams (if cmd
6590: 20 28 63 64 72 20 72 65 6d 61 72 67 73 29 20 27 (cdr remargs) '
65a0: 28 29 29 29 0a 09 09 09 20 28 65 78 69 74 73 74 ())).... (exitst
65b0: 61 74 20 20 20 23 66 29 0a 09 09 09 20 28 73 68 at #f).... (sh
65c0: 65 6c 6c 20 20 20 20 20 20 28 6c 61 73 74 20 28 ell (last (
65d0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 67 65 string-split (ge
65e0: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
65f0: 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 20 riable "SHELL")
6600: 22 2f 22 29 29 29 0a 09 09 09 20 28 72 65 64 69 "/"))).... (redi
6610: 72 20 20 20 20 20 20 28 63 61 73 65 20 28 73 74 r (case (st
6620: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 68 65 ring->symbol she
6630: 6c 6c 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 ll)..... (
6640: 28 74 63 73 68 20 63 73 68 20 6b 73 68 29 20 20 (tcsh csh ksh)
6650: 20 20 22 3e 26 22 29 0a 09 09 09 09 20 20 20 20 ">&").....
6660: 20 20 20 28 28 7a 73 68 20 62 61 73 68 20 73 68 ((zsh bash sh
6670: 20 61 73 68 29 20 22 32 3e 26 31 20 3e 22 29 0a ash) "2>&1 >").
6680: 09 09 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 .... (else
6690: 20 22 3e 26 22 29 29 29 0a 09 09 09 20 28 66 75 ">&"))).... (fu
66a0: 6c 6c 63 6d 64 20 20 20 20 28 63 6f 6e 63 20 22 llcmd (conc "
66b0: 28 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 (" (string-inter
66c0: 73 70 65 72 73 65 20 0a 09 09 09 09 09 09 28 63 sperse .......(c
66d0: 6f 6e 73 20 63 6d 64 20 70 61 72 61 6d 73 29 20 ons cmd params)
66e0: 22 20 22 29 0a 09 09 09 09 09 20 20 20 22 29 20 " ")...... ")
66f0: 22 20 72 65 64 69 72 20 22 20 22 20 6c 6f 67 66 " redir " " logf
6700: 69 6c 65 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 ile)))... ;;
6710: 6d 61 72 6b 20 74 68 65 20 73 74 61 72 74 20 6f mark the start o
6720: 66 20 74 68 65 20 74 65 73 74 0a 09 09 20 20 20 f the test...
6730: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
6740: 20 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 db:teststep-set
6750: 2d 73 74 61 74 75 73 21 20 64 62 20 74 65 73 74 -status! db test
6760: 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 73 74 -id stepname "st
6770: 61 72 74 22 20 22 6e 2f 61 22 20 28 61 72 67 73 art" "n/a" (args
6780: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 6c :get-arg "-m") l
6790: 6f 67 66 69 6c 65 29 0a 09 09 20 20 20 20 3b 3b ogfile)... ;;
67a0: 20 72 75 6e 20 74 68 65 20 74 65 73 74 20 73 74 run the test st
67b0: 65 70 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a ep... (debug:
67c0: 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 52 75 print-info 2 "Ru
67d0: 6e 6e 69 6e 67 20 5c 22 22 20 66 75 6c 6c 63 6d nning \"" fullcm
67e0: 64 20 22 5c 22 22 29 0a 09 09 20 20 20 20 28 63 d "\"")... (c
67f0: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
6800: 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 09 20 startingdir)...
6810: 20 20 20 28 73 65 74 21 20 65 78 69 74 73 74 61 (set! exitsta
6820: 74 20 28 73 79 73 74 65 6d 20 66 75 6c 6c 63 6d t (system fullcm
6830: 64 29 29 20 3b 3b 20 63 6d 64 20 70 61 72 61 6d d)) ;; cmd param
6840: 73 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 s))... (set!
6850: 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 *globalexitstatu
6860: 73 2a 20 65 78 69 74 73 74 61 74 29 0a 09 09 20 s* exitstat)...
6870: 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 (change-direc
6880: 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
6890: 09 20 20 20 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 . ;; run logp
68a0: 72 6f 20 69 66 20 61 70 70 6c 69 63 61 62 6c 65 ro if applicable
68b0: 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d 72 75 6e ;; (process-run
68c0: 20 22 6c 73 22 20 28 6c 69 73 74 20 22 2f 66 6f "ls" (list "/fo
68d0: 6f 22 20 22 32 3e 26 31 22 20 22 62 6c 61 68 2e o" "2>&1" "blah.
68e0: 6c 6f 67 22 29 29 0a 09 09 20 20 20 20 28 69 66 log"))... (if
68f0: 20 6c 6f 67 70 72 6f 66 69 6c 65 0a 09 09 09 28 logprofile....(
6900: 6c 65 74 2a 20 28 28 68 74 6d 6c 6c 6f 67 66 69 let* ((htmllogfi
6910: 6c 65 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d le (conc stepnam
6920: 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 09 09 20 e ".html"))....
6930: 20 20 20 20 20 20 28 6f 6c 64 65 78 69 74 73 74 (oldexitst
6940: 61 74 20 65 78 69 74 73 74 61 74 29 0a 09 09 09 at exitstat)....
6950: 20 20 20 20 20 20 20 28 63 6d 64 20 20 20 20 20 (cmd
6960: 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 (string-inte
6970: 72 73 70 65 72 73 65 20 28 6c 69 73 74 20 22 6c rsperse (list "l
6980: 6f 67 70 72 6f 22 20 6c 6f 67 70 72 6f 66 69 6c ogpro" logprofil
6990: 65 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c e htmllogfile "<
69a0: 22 20 6c 6f 67 66 69 6c 65 20 22 3e 22 20 28 63 " logfile ">" (c
69b0: 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 5f 6c onc stepname "_l
69c0: 6f 67 70 72 6f 2e 6c 6f 67 22 29 29 20 22 20 22 ogpro.log")) " "
69d0: 29 29 29 0a 09 09 09 20 20 28 64 65 62 75 67 3a ))).... (debug:
69e0: 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 72 75 print-info 2 "ru
69f0: 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c nning \"" cmd "\
6a00: 22 22 29 0a 09 09 09 20 20 28 63 68 61 6e 67 65 "").... (change
6a10: 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 -directory start
6a20: 69 6e 67 64 69 72 29 0a 09 09 09 20 20 28 73 65 ingdir).... (se
6a30: 74 21 20 65 78 69 74 73 74 61 74 20 28 73 79 73 t! exitstat (sys
6a40: 74 65 6d 20 63 6d 64 29 29 0a 09 09 09 20 20 28 tem cmd)).... (
6a50: 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 set! *globalexit
6a60: 73 74 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 status* exitstat
6a70: 29 20 3b 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 ) ;; no necessar
6a80: 79 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 y.... (change-d
6a90: 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
6aa0: 68 29 0a 09 09 09 20 20 28 6f 70 65 6e 2d 72 75 h).... (open-ru
6ab0: 6e 2d 63 6c 6f 73 65 20 64 62 3a 74 65 73 74 2d n-close db:test-
6ac0: 73 65 74 2d 6c 6f 67 21 20 64 62 20 74 65 73 74 set-log! db test
6ad0: 2d 69 64 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 29 -id htmllogfile)
6ae0: 29 29 0a 09 09 20 20 20 20 28 6c 65 74 20 28 28 ))... (let ((
6af0: 6d 73 67 20 28 61 72 67 73 3a 67 65 74 2d 61 72 msg (args:get-ar
6b00: 67 20 22 2d 6d 22 29 29 29 0a 09 09 20 20 20 20 g "-m")))...
6b10: 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 (open-run-clos
6b20: 65 20 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 e db:teststep-se
6b30: 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 65 73 t-status! db tes
6b40: 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 65 t-id stepname "e
6b50: 6e 64 22 20 65 78 69 74 73 74 61 74 20 6d 73 67 nd" exitstat msg
6b60: 20 6c 6f 67 66 69 6c 65 29 29 0a 09 09 20 20 20 logfile))...
6b70: 20 29 29 29 0a 09 20 20 28 69 66 20 28 6f 72 20 ))).. (if (or
6b80: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6b90: 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 test-status")...
6ba0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
6bb0: 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 29 0a "-set-values")).
6bc0: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 . (let ((ne
6bd0: 77 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 wstatus (cond...
6be0: 09 09 28 28 6e 75 6d 62 65 72 3f 20 73 74 61 74 ..((number? stat
6bf0: 75 73 29 20 20 20 20 20 20 20 28 69 66 20 28 65 us) (if (e
6c00: 71 75 61 6c 3f 20 73 74 61 74 75 73 20 30 29 20 qual? status 0)
6c10: 22 50 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a "PASS" "FAIL")).
6c20: 09 09 09 09 28 28 61 6e 64 20 28 73 74 72 69 6e ....((and (strin
6c30: 67 3f 20 73 74 61 74 75 73 29 0a 09 09 09 09 20 g? status).....
6c40: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 (string->nu
6c50: 6d 62 65 72 20 73 74 61 74 75 73 29 29 28 69 66 mber status))(if
6c60: 20 28 65 71 75 61 6c 3f 20 28 73 74 72 69 6e 67 (equal? (string
6c70: 2d 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 73 29 ->number status)
6c80: 20 30 29 20 22 50 41 53 53 22 20 22 46 41 49 4c 0) "PASS" "FAIL
6c90: 22 29 29 0a 09 09 09 09 28 65 6c 73 65 20 73 74 ")).....(else st
6ca0: 61 74 75 73 29 29 29 0a 09 09 20 20 20 20 3b 3b atus)))... ;;
6cb0: 20 74 72 61 6e 73 66 65 72 20 72 65 6c 65 76 61 transfer releva
6cc0: 6e 74 20 6b 65 79 73 20 69 6e 74 6f 20 61 20 68 nt keys into a h
6cd0: 61 73 68 20 74 6f 20 62 65 20 70 61 73 73 65 64 ash to be passed
6ce0: 20 74 6f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 to test-set-sta
6cf0: 74 75 73 21 0a 09 09 20 20 20 20 3b 3b 20 63 6f tus!... ;; co
6d00: 75 6c 64 20 75 73 65 20 61 6e 20 61 73 73 6f 63 uld use an assoc
6d10: 20 6c 69 73 74 20 49 20 67 75 65 73 73 2e 20 0a list I guess. .
6d20: 09 09 20 20 20 20 28 6f 74 68 65 72 64 61 74 61 .. (otherdata
6d30: 20 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b (let ((res (mak
6d40: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))).
6d50: 09 09 09 09 20 28 66 6f 72 2d 65 61 63 68 20 28 .... (for-each (
6d60: 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 lambda (key)....
6d70: 09 09 20 20 20 20 20 28 69 66 20 28 61 72 67 73 .. (if (args
6d80: 3a 67 65 74 2d 61 72 67 20 6b 65 79 29 0a 09 09 :get-arg key)...
6d90: 09 09 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 .... (hash-table
6da0: 2d 73 65 74 21 20 72 65 73 20 6b 65 79 20 28 61 -set! res key (a
6db0: 72 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 79 29 rgs:get-arg key)
6dc0: 29 29 29 0a 09 09 09 09 09 20 20 20 28 6c 69 73 )))...... (lis
6dd0: 74 20 22 3a 76 61 6c 75 65 22 20 22 3a 74 6f 6c t ":value" ":tol
6de0: 22 20 22 3a 65 78 70 65 63 74 65 64 22 20 22 3a " ":expected" ":
6df0: 66 69 72 73 74 5f 65 72 72 22 20 22 3a 66 69 72 first_err" ":fir
6e00: 73 74 5f 77 61 72 6e 22 20 22 3a 75 6e 69 74 73 st_warn" ":units
6e10: 22 20 22 3a 63 61 74 65 67 6f 72 79 22 20 22 3a " ":category" ":
6e20: 76 61 72 69 61 62 6c 65 22 29 29 0a 09 09 09 09 variable")).....
6e30: 20 72 65 73 29 29 29 0a 09 09 28 69 66 20 28 61 res)))...(if (a
6e40: 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 nd (args:get-arg
6e50: 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 "-test-status")
6e60: 0a 09 09 09 20 28 6f 72 20 28 6e 6f 74 20 73 74 .... (or (not st
6e70: 61 74 65 29 0a 09 09 09 20 20 20 20 20 28 6e 6f ate).... (no
6e80: 74 20 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 t status)))...
6e90: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 (begin...
6ea0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
6eb0: 22 45 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 "ERROR: You must
6ec0: 20 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 specify :state
6ed0: 61 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 and :status with
6ee0: 20 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d every call to -
6ef0: 74 65 73 74 2d 73 74 61 74 75 73 5c 6e 22 20 68 test-status\n" h
6f00: 65 6c 70 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 elp)... ;;
6f10: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
6f20: 65 21 20 64 62 29 0a 09 09 20 20 20 20 20 20 28 e! db)... (
6f30: 65 78 69 74 20 36 29 29 29 0a 09 09 28 6c 65 74 exit 6)))...(let
6f40: 2a 20 28 28 6d 73 67 20 20 20 20 28 61 72 67 73 * ((msg (args
6f50: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a :get-arg "-m")).
6f60: 09 09 20 20 20 20 20 20 20 28 6e 75 6d 6f 74 68 .. (numoth
6f70: 20 28 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 (length (hash-t
6f80: 61 62 6c 65 2d 6b 65 79 73 20 6f 74 68 65 72 64 able-keys otherd
6f90: 61 74 61 29 29 29 29 0a 09 09 20 20 3b 3b 20 43 ata))))... ;; C
6fa0: 6f 6e 76 65 72 74 20 74 6f 20 72 70 63 20 69 6e onvert to rpc in
6fb0: 73 69 64 65 20 74 68 65 20 74 65 73 74 73 3a 74 side the tests:t
6fc0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
6fd0: 63 61 6c 6c 2c 20 6e 6f 74 20 68 65 72 65 0a 09 call, not here..
6fe0: 09 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 . (tests:test-s
6ff0: 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 2d et-status! test-
7000: 69 64 20 73 74 61 74 65 20 6e 65 77 73 74 61 74 id state newstat
7010: 75 73 20 6d 73 67 20 6f 74 68 65 72 64 61 74 61 us msg otherdata
7020: 29 29 29 29 0a 09 20 20 28 69 66 20 64 62 20 28 )))).. (if db (
7030: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
7040: 21 20 64 62 29 29 0a 09 20 20 28 73 65 74 21 20 ! db)).. (set!
7050: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
7060: 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d t))))..;;=======
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 0a ===============.
70b0: 3b 3b 20 56 61 72 69 6f 75 73 20 68 65 6c 70 65 ;; Various helpe
70c0: 72 20 63 6f 6d 6d 61 6e 64 73 20 63 61 6e 20 67 r commands can g
70d0: 6f 20 62 65 6c 6f 77 20 68 65 72 65 0a 3b 3b 3d o below here.;;=
70e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7120: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
7130: 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 6b :get-arg "-showk
7140: 65 79 73 22 29 0a 20 20 20 20 28 6c 65 74 20 28 eys"). (let (
7150: 28 64 62 20 23 66 29 0a 09 20 20 28 6b 65 79 73 (db #f).. (keys
7160: 20 23 66 29 29 0a 20 20 20 20 20 20 28 69 66 20 #f)). (if
7170: 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d (not (setup-for-
7180: 72 75 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a run)).. (begin.
7190: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
71a0: 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 t 0 "Failed to s
71b0: 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a etup, exiting").
71c0: 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a . (exit 1))).
71d0: 20 20 20 20 20 20 28 73 65 74 21 20 6b 65 79 73 (set! keys
71e0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
71f0: 20 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 db:get-keys db)
7200: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
7210: 72 69 6e 74 20 31 20 22 4b 65 79 73 3a 20 22 20 rint 1 "Keys: "
7220: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
7230: 72 73 65 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 rse (map key:get
7240: 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 -fieldname keys)
7250: 20 22 2c 20 22 29 29 0a 20 20 20 20 20 20 28 69 ", ")). (i
7260: 66 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 f db (sqlite3:fi
7270: 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 20 20 20 nalize! db)).
7280: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
7290: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 ething* #t)))..(
72a0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
72b0: 20 22 2d 67 75 69 22 29 0a 20 20 20 20 28 62 65 "-gui"). (be
72c0: 67 69 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 gin. (debug
72d0: 3a 70 72 69 6e 74 20 30 20 22 4c 6f 6f 6b 20 61 :print 0 "Look a
72e0: 74 20 74 68 65 20 64 61 73 68 62 6f 61 72 64 20 t the dashboard
72f0: 66 6f 72 20 6e 6f 77 22 29 0a 20 20 20 20 20 20 for now").
7300: 3b 3b 20 28 6d 65 67 61 74 65 73 74 2d 67 75 69 ;; (megatest-gui
7310: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
7320: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
7330: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
7340: 74 2d 61 72 67 20 22 2d 67 65 6e 2d 6d 65 67 61 t-arg "-gen-mega
7350: 74 65 73 74 2d 61 72 65 61 22 29 0a 20 20 20 20 test-area").
7360: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 67 65 (begin. (ge
7370: 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 nexample:mk-mega
7380: 74 65 73 74 2e 63 6f 6e 66 69 67 29 0a 20 20 20 test.config).
7390: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
73a0: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 ething* #t)))..(
73b0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
73c0: 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d "-gen-megatest-
73d0: 74 65 73 74 22 29 0a 20 20 20 20 28 6c 65 74 20 test"). (let
73e0: 28 28 74 65 73 74 6e 61 6d 65 20 28 61 72 67 73 ((testname (args
73f0: 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 6e 2d 6d :get-arg "-gen-m
7400: 65 67 61 74 65 73 74 2d 74 65 73 74 22 29 29 29 egatest-test")))
7410: 0a 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 . (genexamp
7420: 6c 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2d 74 le:mk-megatest-t
7430: 65 73 74 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 est testname).
7440: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
7450: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
7460: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
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 0a 3b 3b 20 55 70 64 61 ========.;; Upda
74b0: 74 65 20 74 68 65 20 64 61 74 61 62 61 73 65 20 te the database
74c0: 73 63 68 65 6d 61 20 6f 6e 20 72 65 71 75 65 73 schema on reques
74d0: 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d t.;;============
74e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
74f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
7520: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7530: 72 65 62 75 69 6c 64 2d 64 62 22 29 0a 20 20 20 rebuild-db").
7540: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 (begin. (i
7550: 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f f (not (setup-fo
7560: 72 2d 72 75 6e 29 29 0a 09 20 20 28 62 65 67 69 r-run)).. (begi
7570: 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 n.. (debug:pr
7580: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f int 0 "Failed to
7590: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
75a0: 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ) .. (exit 1)
75b0: 29 29 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 )). (open-r
75c0: 75 6e 2d 63 6c 6f 73 65 20 70 61 74 63 68 2d 64 un-close patch-d
75d0: 62 20 23 66 29 0a 20 20 20 20 20 20 28 73 65 74 b #f). (set
75e0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
75f0: 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d #t)))..;;======
7600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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: 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 74 .;; Update the t
7650: 65 73 74 73 20 6d 65 74 61 20 64 61 74 61 20 66 ests meta data f
7660: 72 6f 6d 20 74 68 65 20 74 65 73 74 63 6f 6e 66 rom the testconf
7670: 69 67 20 66 69 6c 65 73 0a 3b 3b 3d 3d 3d 3d 3d ig files.;;=====
7680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76c0: 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 =..(if (args:get
76d0: 2d 61 72 67 20 22 2d 75 70 64 61 74 65 2d 6d 65 -arg "-update-me
76e0: 74 61 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ta"). (begin.
76f0: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
7700: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
7710: 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
7720: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 debug:print 0 "F
7730: 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 ailed to setup,
7740: 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 exiting") ..
7750: 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 (exit 1))).
7760: 20 3b 3b 20 6e 6f 77 20 63 61 6e 20 66 69 6e 64 ;; now can find
7770: 20 6f 75 72 20 64 62 0a 20 20 20 20 20 20 28 6f our db. (o
7780: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 72 75 pen-run-close ru
7790: 6e 73 3a 75 70 64 61 74 65 2d 61 6c 6c 2d 74 65 ns:update-all-te
77a0: 73 74 5f 6d 65 74 61 20 64 62 29 0a 20 20 20 20 st_meta db).
77b0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
77c0: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
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 3d ================
7800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7810: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 ======.;; Start
7820: 61 20 72 65 70 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d a repl.;;=======
7830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
7870: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
7880: 72 67 20 22 2d 72 65 70 6c 22 29 0a 20 20 20 20 rg "-repl").
7890: 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 (let* ((toppath
78a0: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
78b0: 0a 09 20 20 20 28 64 62 20 20 20 20 20 20 28 69 .. (db (i
78c0: 66 20 74 6f 70 70 61 74 68 20 28 6f 70 65 6e 2d f toppath (open-
78d0: 64 62 29 20 23 66 29 29 29 0a 20 20 20 20 20 20 db) #f))).
78e0: 28 69 66 20 64 62 0a 09 20 20 28 62 65 67 69 6e (if db.. (begin
78f0: 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 62 2a .. (set! *db*
7900: 20 64 62 29 0a 09 20 20 20 20 28 69 66 20 28 6e db).. (if (n
7910: 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
7920: 20 22 2d 73 65 72 76 65 72 22 29 29 0a 09 09 28 "-server"))...(
7930: 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d 73 65 server:client-se
7940: 74 75 70 29 29 0a 09 20 20 20 20 28 69 6d 70 6f tup)).. (impo
7950: 72 74 20 72 65 61 64 6c 69 6e 65 29 0a 09 20 20 rt readline)..
7960: 20 20 28 69 6d 70 6f 72 74 20 61 70 72 6f 70 6f (import apropo
7970: 73 29 0a 09 20 20 20 20 28 67 6e 75 2d 68 69 73 s).. (gnu-his
7980: 74 6f 72 79 2d 69 6e 73 74 61 6c 6c 2d 66 69 6c tory-install-fil
7990: 65 2d 6d 61 6e 61 67 65 72 0a 09 20 20 20 20 20 e-manager..
79a0: 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 0a 09 (string-append..
79b0: 20 20 20 20 20 20 28 6f 72 20 28 67 65 74 2d 65 (or (get-e
79c0: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
79d0: 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2e 22 29 ble "HOME") ".")
79e0: 20 22 2f 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 "/.megatest_his
79f0: 74 6f 72 79 22 29 29 0a 09 20 20 20 20 28 63 75 tory")).. (cu
7a00: 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 rrent-input-port
7a10: 20 28 6d 61 6b 65 2d 67 6e 75 2d 72 65 61 64 6c (make-gnu-readl
7a20: 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 65 ine-port "megate
7a30: 73 74 3e 20 22 29 29 0a 09 20 20 20 20 28 72 65 st> ")).. (re
7a40: 70 6c 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 pl))). (set
7a50: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
7a60: 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d #t)))..;;======
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 3d 3d ================
7aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ab0: 0a 3b 3b 20 45 78 69 74 20 61 6e 64 20 63 6c 65 .;; Exit and cle
7ac0: 61 6e 20 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d an up.;;========
7ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
7b10: 28 69 66 20 28 6e 6f 74 20 2a 64 69 64 73 6f 6d (if (not *didsom
7b20: 65 74 68 69 6e 67 2a 29 0a 20 20 20 20 28 64 65 ething*). (de
7b30: 62 75 67 3a 70 72 69 6e 74 20 30 20 68 65 6c 70 bug:print 0 help
7b40: 29 29 0a 0a 3b 3b 20 28 69 66 20 2a 72 75 6e 72 ))..;; (if *runr
7b50: 65 6d 6f 74 65 2a 20 28 72 70 63 3a 63 6c 6f 73 emote* (rpc:clos
7b60: 65 2d 61 6c 6c 2d 63 6f 6e 6e 65 63 74 69 6f 6e e-all-connection
7b70: 73 21 29 29 0a 20 20 20 20 0a 28 69 66 20 28 6e s!)). .(if (n
7b80: 6f 74 20 28 65 71 3f 20 2a 67 6c 6f 62 61 6c 65 ot (eq? *globale
7b90: 78 69 74 73 74 61 74 75 73 2a 20 30 29 29 0a 20 xitstatus* 0)).
7ba0: 20 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 (if (or (args
7bb0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
7bc0: 73 74 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 sts")(args:get-a
7bd0: 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 29 0a 20 rg "-runall")).
7be0: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 (begin.
7bf0: 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
7c00: 70 72 69 6e 74 20 30 20 22 4e 4f 54 45 3a 20 53 print 0 "NOTE: S
7c10: 75 62 70 72 6f 63 65 73 73 65 73 20 77 69 74 68 ubprocesses with
7c20: 20 6e 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 20 63 non-zero exit c
7c30: 6f 64 65 20 64 65 74 65 63 74 65 64 3a 20 22 20 ode detected: "
7c40: 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 *globalexitstatu
7c50: 73 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 s*). (
7c60: 65 78 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 exit 0)).
7c70: 20 28 63 61 73 65 20 2a 67 6c 6f 62 61 6c 65 78 (case *globalex
7c80: 69 74 73 74 61 74 75 73 2a 0a 20 20 20 20 20 20 itstatus*.
7c90: 20 20 20 28 28 30 29 28 65 78 69 74 20 30 29 29 ((0)(exit 0))
7ca0: 0a 20 20 20 20 20 20 20 20 20 28 28 31 29 28 65 . ((1)(e
7cb0: 78 69 74 20 31 29 29 0a 20 20 20 20 20 20 20 20 xit 1)).
7cc0: 20 28 28 32 29 28 65 78 69 74 20 32 29 29 0a 20 ((2)(exit 2)).
7cd0: 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 65 (else (e
7ce0: 78 69 74 20 33 29 29 29 29 29 0a xit 3))))).