0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 20 6-2012, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 made available
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 .;; greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 ng file COPYING
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 for details..;;
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 .;; This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c ven the.;; impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 ied warranty of
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 PARTICULAR.;;
0140: 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 20 28 69 6e PURPOSE...;; (in
0150: 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 2e 73 63 clude "common.sc
0160: 6d 22 29 0a 3b 3b 20 28 69 6e 63 6c 75 64 65 20 m").;; (include
0170: 22 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f "megatest-versio
0180: 6e 2e 73 63 6d 22 29 0a 0a 28 75 73 65 20 73 71 n.scm")..(use sq
0190: 6c 69 74 65 33 20 73 72 66 69 2d 31 20 70 6f 73 lite3 srfi-1 pos
01a0: 69 78 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 ix regex regex-c
01b0: 61 73 65 20 73 72 66 69 2d 36 39 20 62 61 73 65 ase srfi-69 base
01c0: 36 34 20 66 6f 72 6d 61 74 20 72 65 61 64 6c 69 64 format readli
01d0: 6e 65 20 61 70 72 6f 70 6f 73 20 6a 73 6f 6e 20 ne apropos json
01e0: 68 74 74 70 2d 63 6c 69 65 6e 74 29 20 3b 3b 20 http-client) ;;
01f0: 28 73 72 66 69 20 31 38 29 20 65 78 74 72 61 73 (srfi 18) extras
0200: 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 ).(import (prefi
0210: 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 x sqlite3 sqlite
0220: 33 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 3:)).(import (pr
0230: 65 66 69 78 20 62 61 73 65 36 34 20 62 61 73 65 efix base64 base
0240: 36 34 3a 29 29 0a 0a 3b 3b 20 28 75 73 65 20 7a 64:))..;; (use z
0250: 6d 71 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 mq)..(declare (u
0260: 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 ses common)).(de
0270: 63 6c 61 72 65 20 28 75 73 65 73 20 6d 65 67 61 clare (uses mega
0280: 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 29 0a 28 test-version)).(
0290: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d 61 declare (uses ma
02a0: 72 67 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 rgs)).(declare (
02b0: 75 73 65 73 20 72 75 6e 73 29 29 0a 28 64 65 63 uses runs)).(dec
02c0: 6c 61 72 65 20 28 75 73 65 73 20 6c 61 75 6e 63 lare (uses launc
02d0: 68 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 h)).(declare (us
02e0: 65 73 20 73 65 72 76 65 72 29 29 0a 28 64 65 63 es server)).(dec
02f0: 6c 61 72 65 20 28 75 73 65 73 20 63 6c 69 65 6e lare (uses clien
0300: 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 t)).(declare (us
0310: 65 73 20 74 65 73 74 73 29 29 0a 28 64 65 63 6c es tests)).(decl
0320: 61 72 65 20 28 75 73 65 73 20 67 65 6e 65 78 61 are (uses genexa
0330: 6d 70 6c 65 29 29 0a 28 64 65 63 6c 61 72 65 20 mple)).(declare
0340: 28 75 73 65 73 20 64 61 65 6d 6f 6e 29 29 0a 0a (uses daemon))..
0350: 28 64 65 66 69 6e 65 20 2a 64 62 2a 20 23 66 29 (define *db* #f)
0360: 20 3b 3b 20 74 68 69 73 20 69 73 20 6f 6e 6c 79 ;; this is only
0370: 20 66 6f 72 20 74 68 65 20 72 65 70 6c 2c 20 64 for the repl, d
0380: 6f 20 6e 6f 74 20 75 73 65 20 69 6e 20 67 65 6e o not use in gen
0390: 65 72 61 6c 21 21 21 21 0a 0a 28 69 6e 63 6c 75 eral!!!!..(inclu
03a0: 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 de "common_recor
03b0: 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 ds.scm").(includ
03c0: 65 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 e "key_records.s
03d0: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 cm").(include "d
03e0: 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a b_records.scm").
03f0: 28 69 6e 63 6c 75 64 65 20 22 6d 65 67 61 74 65 (include "megate
0400: 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 2e 73 st-fossil-hash.s
0410: 63 6d 22 29 0a 0a 28 6c 65 74 20 28 28 64 65 62 cm")..(let ((deb
0420: 75 67 63 6f 6e 74 72 6f 6c 66 20 28 63 6f 6e 63 ugcontrolf (conc
0430: 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e (get-environmen
0440: 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 t-variable "HOME
0450: 22 29 20 22 2f 2e 6d 65 67 61 74 65 73 74 72 63 ") "/.megatestrc
0460: 22 29 29 29 0a 20 20 28 69 66 20 28 66 69 6c 65 "))). (if (file
0470: 2d 65 78 69 73 74 73 3f 20 64 65 62 75 67 63 6f -exists? debugco
0480: 6e 74 72 6f 6c 66 29 0a 20 20 20 20 20 20 28 6c ntrolf). (l
0490: 6f 61 64 20 64 65 62 75 67 63 6f 6e 74 72 6f 6c oad debugcontrol
04a0: 66 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 68 f)))...(define h
04b0: 65 6c 70 20 28 63 6f 6e 63 20 22 0a 4d 65 67 61 elp (conc ".Mega
04c0: 74 65 73 74 2c 20 64 6f 63 75 6d 65 6e 74 61 74 test, documentat
04d0: 69 6f 6e 20 61 74 20 68 74 74 70 3a 2f 2f 77 77 ion at http://ww
04e0: 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 w.kiatoa.com/fos
04f0: 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 0a 20 20 sils/megatest.
0500: 76 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 version " megate
0510: 73 74 2d 76 65 72 73 69 6f 6e 20 22 0a 20 20 6c st-version ". l
0520: 69 63 65 6e 73 65 20 47 50 4c 2c 20 43 6f 70 79 icense GPL, Copy
0530: 72 69 67 68 74 20 4d 61 74 74 20 57 65 6c 6c 61 right Matt Wella
0540: 6e 64 20 32 30 30 36 2d 32 30 31 32 0a 0a 55 73 nd 2006-2012..Us
0550: 61 67 65 3a 20 6d 65 67 61 74 65 73 74 20 5b 6f age: megatest [o
0560: 70 74 69 6f 6e 73 5d 0a 20 20 2d 68 20 20 20 20 ptions]. -h
0570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0580: 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a 20 20 : this help.
0590: 2d 76 65 72 73 69 6f 6e 20 20 20 20 20 20 20 20 -version
05a0: 20 20 20 20 20 20 20 20 3a 20 70 72 69 6e 74 20 : print
05b0: 6d 65 67 61 74 65 73 74 20 76 65 72 73 69 6f 6e megatest version
05c0: 20 28 63 75 72 72 65 6e 74 6c 79 20 22 20 6d 65 (currently " me
05d0: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 gatest-version "
05e0: 29 0a 0a 4c 61 75 6e 63 68 69 6e 67 20 61 6e 64 )..Launching and
05f0: 20 6d 61 6e 61 67 69 6e 67 20 72 75 6e 73 0a 20 managing runs.
0600: 20 2d 72 75 6e 61 6c 6c 20 20 20 20 20 20 20 20 -runall
0610: 20 20 20 20 20 20 20 20 20 3a 20 72 75 6e 20 61 : run a
0620: 6c 6c 20 74 65 73 74 73 20 74 68 61 74 20 61 72 ll tests that ar
0630: 65 20 6e 6f 74 20 73 74 61 74 65 20 43 4f 4d 50 e not state COMP
0640: 4c 45 54 45 44 20 61 6e 64 20 73 74 61 74 75 73 LETED and status
0650: 20 50 41 53 53 2c 20 0a 20 20 20 20 20 20 20 20 PASS, .
0660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0670: 20 20 20 20 43 48 45 43 4b 20 6f 72 20 4b 49 4c CHECK or KIL
0680: 4c 45 44 0a 20 20 2d 72 75 6e 74 65 73 74 73 20 LED. -runtests
0690: 74 73 74 31 2c 74 73 74 32 20 2e 2e 2e 20 3a 20 tst1,tst2 ... :
06a0: 72 75 6e 20 74 65 73 74 73 0a 20 20 2d 72 65 6d run tests. -rem
06b0: 6f 76 65 2d 72 75 6e 73 20 20 20 20 20 20 20 20 ove-runs
06c0: 20 20 20 20 3a 20 72 65 6d 6f 76 65 20 74 68 65 : remove the
06d0: 20 64 61 74 61 20 66 6f 72 20 61 20 72 75 6e 2c data for a run,
06e0: 20 72 65 71 75 69 72 65 73 20 3a 72 75 6e 6e 61 requires :runna
06f0: 6d 65 20 61 6e 64 20 2d 74 65 73 74 70 61 74 74 me and -testpatt
0700: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0710: 20 20 20 20 20 20 20 20 20 20 20 20 20 4f 70 74 Opt
0720: 69 6f 6e 61 6c 6c 79 20 75 73 65 20 3a 73 74 61 ionally use :sta
0730: 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 0a 20 te and :status.
0740: 20 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 -set-state-stat
0750: 75 73 20 58 2c 59 20 20 20 3a 20 73 65 74 20 73 us X,Y : set s
0760: 74 61 74 65 20 74 6f 20 58 20 61 6e 64 20 73 74 tate to X and st
0770: 61 74 75 73 20 74 6f 20 59 2c 20 72 65 71 75 69 atus to Y, requi
0780: 72 65 73 20 63 6f 6e 74 72 6f 6c 73 20 70 65 72 res controls per
0790: 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 0a 20 20 -remove-runs.
07a0: 2d 72 65 72 75 6e 20 46 41 49 4c 2c 57 41 52 4e -rerun FAIL,WARN
07b0: 2e 2e 2e 20 20 20 20 20 3a 20 66 6f 72 63 65 20 ... : force
07c0: 72 65 2d 72 75 6e 20 66 6f 72 20 74 65 73 74 73 re-run for tests
07d0: 20 77 69 74 68 20 73 70 65 63 69 66 69 63 65 64 with specificed
07e0: 20 73 74 61 74 75 73 28 73 29 0a 20 20 2d 72 6f status(s). -ro
07f0: 6c 6c 75 70 20 20 20 20 20 20 20 20 20 20 20 20 llup
0800: 20 20 20 20 20 3a 20 28 63 75 72 72 65 6e 74 6c : (currentl
0810: 79 20 64 69 73 61 62 6c 65 64 29 20 66 69 6c 6c y disabled) fill
0820: 20 72 75 6e 20 28 73 65 74 20 62 79 20 3a 72 75 run (set by :ru
0830: 6e 6e 61 6d 65 29 20 20 77 69 74 68 20 6c 61 74 nname) with lat
0840: 65 73 74 20 74 65 73 74 28 73 29 0a 20 20 20 20 est test(s).
0850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0860: 20 20 20 20 20 20 20 20 66 72 6f 6d 20 70 72 69 from pri
0870: 6f 72 20 72 75 6e 73 20 77 69 74 68 20 73 61 6d or runs with sam
0880: 65 20 6b 65 79 73 0a 20 20 2d 6c 6f 63 6b 20 20 e keys. -lock
0890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
08a0: 20 3a 20 6c 6f 63 6b 20 72 75 6e 20 73 70 65 63 : lock run spec
08b0: 69 66 69 65 64 20 62 79 20 74 61 72 67 65 74 20 ified by target
08c0: 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 20 2d 75 and runname. -u
08d0: 6e 6c 6f 63 6b 20 20 20 20 20 20 20 20 20 20 20 nlock
08e0: 20 20 20 20 20 20 3a 20 75 6e 6c 6f 63 6b 20 72 : unlock r
08f0: 75 6e 20 73 70 65 63 69 66 69 65 64 20 62 79 20 un specified by
0900: 74 61 72 67 65 74 20 61 6e 64 20 72 75 6e 6e 61 target and runna
0910: 6d 65 0a 0a 53 65 6c 65 63 74 6f 72 73 20 28 65 me..Selectors (e
0920: 2e 67 2e 20 75 73 65 20 66 6f 72 20 2d 72 75 6e .g. use for -run
0930: 74 65 73 74 73 2c 20 2d 72 65 6d 6f 76 65 2d 72 tests, -remove-r
0940: 75 6e 73 2c 20 2d 73 65 74 2d 73 74 61 74 65 2d uns, -set-state-
0950: 73 74 61 74 75 73 2c 20 2d 6c 69 73 74 2d 72 75 status, -list-ru
0960: 6e 73 20 65 74 63 2e 29 0a 20 20 2d 74 61 72 67 ns etc.). -targ
0970: 65 74 20 6b 65 79 31 2f 6b 65 79 32 2f 2e 2e 2e et key1/key2/...
0980: 20 20 20 3a 20 72 75 6e 20 66 6f 72 20 6b 65 79 : run for key
0990: 31 2c 20 6b 65 79 32 2c 20 65 74 63 2e 0a 20 20 1, key2, etc..
09a0: 2d 72 65 71 74 61 72 67 20 6b 65 79 31 2f 6b 65 -reqtarg key1/ke
09b0: 79 32 2f 2e 2e 2e 20 20 3a 20 72 75 6e 20 66 6f y2/... : run fo
09c0: 72 20 6b 65 79 31 2c 20 6b 65 79 32 2c 20 65 74 r key1, key2, et
09d0: 63 2e 20 62 75 74 20 6b 65 79 31 2f 6b 65 79 32 c. but key1/key2
09e0: 20 6d 75 73 74 20 62 65 20 69 6e 20 72 75 6e 63 must be in runc
09f0: 6f 6e 66 69 67 0a 20 20 2d 74 65 73 74 70 61 74 onfig. -testpat
0a00: 74 20 70 61 74 74 31 2f 70 61 74 74 32 2c 70 61 t patt1/patt2,pa
0a10: 74 74 33 2f 2e 2e 2e 20 20 3a 20 25 20 69 73 20 tt3/... : % is
0a20: 77 69 6c 64 63 61 72 64 0a 20 20 3a 72 75 6e 6e wildcard. :runn
0a30: 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 20 20 ame
0a40: 20 20 20 3a 20 72 65 71 75 69 72 65 64 2c 20 6e : required, n
0a50: 61 6d 65 20 66 6f 72 20 74 68 69 73 20 70 61 72 ame for this par
0a60: 74 69 63 75 6c 61 72 20 74 65 73 74 20 72 75 6e ticular test run
0a70: 0a 20 20 3a 73 74 61 74 65 20 20 20 20 20 20 20 . :state
0a80: 20 20 20 20 20 20 20 20 20 20 20 3a 20 41 70 70 : App
0a90: 6c 69 65 73 20 74 6f 20 72 75 6e 73 2c 20 74 65 lies to runs, te
0aa0: 73 74 73 20 6f 72 20 73 74 65 70 73 20 64 65 70 sts or steps dep
0ab0: 65 6e 64 69 6e 67 20 6f 6e 20 63 6f 6e 74 65 78 ending on contex
0ac0: 74 0a 20 20 3a 73 74 61 74 75 73 20 20 20 20 20 t. :status
0ad0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 41 70 : Ap
0ae0: 70 6c 69 65 73 20 74 6f 20 72 75 6e 73 2c 20 74 plies to runs, t
0af0: 65 73 74 73 20 6f 72 20 73 74 65 70 73 20 64 65 ests or steps de
0b00: 70 65 6e 64 69 6e 67 20 6f 6e 20 63 6f 6e 74 65 pending on conte
0b10: 78 74 0a 0a 54 65 73 74 20 68 65 6c 70 65 72 73 xt..Test helpers
0b20: 20 28 66 6f 72 20 75 73 65 20 69 6e 73 69 64 65 (for use inside
0b30: 20 74 65 73 74 73 29 0a 20 20 2d 73 74 65 70 20 tests). -step
0b40: 73 74 65 70 6e 61 6d 65 0a 20 20 2d 74 65 73 74 stepname. -test
0b50: 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 20 20 -status
0b60: 20 20 20 3a 20 73 65 74 20 74 68 65 20 73 74 61 : set the sta
0b70: 74 65 20 61 6e 64 20 73 74 61 74 75 73 20 6f 66 te and status of
0b80: 20 61 20 74 65 73 74 20 28 75 73 65 20 3a 73 74 a test (use :st
0b90: 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 29 ate and :status)
0ba0: 0a 20 20 2d 73 65 74 6c 6f 67 20 6c 6f 67 66 6e . -setlog logfn
0bb0: 61 6d 65 20 20 20 20 20 20 20 20 3a 20 73 65 74 ame : set
0bc0: 20 74 68 65 20 70 61 74 68 2f 66 69 6c 65 6e 61 the path/filena
0bd0: 6d 65 20 74 6f 20 74 68 65 20 66 69 6e 61 6c 20 me to the final
0be0: 6c 6f 67 20 72 65 6c 61 74 69 76 65 20 74 6f 20 log relative to
0bf0: 74 68 65 20 74 65 73 74 0a 20 20 20 20 20 20 20 the test.
0c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c10: 20 20 20 20 20 64 69 72 65 63 74 6f 72 79 2e 20 directory.
0c20: 6d 61 79 20 62 65 20 75 73 65 64 20 77 69 74 68 may be used with
0c30: 20 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 20 20 -test-status.
0c40: 2d 73 65 74 2d 74 6f 70 6c 6f 67 20 6c 6f 67 66 -set-toplog logf
0c50: 6e 61 6d 65 20 20 20 20 3a 20 73 65 74 20 74 68 name : set th
0c60: 65 20 6f 76 65 72 61 6c 6c 20 6c 6f 67 20 66 6f e overall log fo
0c70: 72 20 61 20 73 75 69 74 65 20 6f 66 20 73 75 62 r a suite of sub
0c80: 2d 74 65 73 74 73 0a 20 20 2d 73 75 6d 6d 61 72 -tests. -summar
0c90: 69 7a 65 2d 69 74 65 6d 73 20 20 20 20 20 20 20 ize-items
0ca0: 20 3a 20 66 6f 72 20 61 6e 20 69 74 65 6d 69 7a : for an itemiz
0cb0: 65 64 20 74 65 73 74 20 63 72 65 61 74 65 20 61 ed test create a
0cc0: 20 73 75 6d 6d 61 72 79 20 68 74 6d 6c 20 0a 20 summary html .
0cd0: 20 2d 6d 20 63 6f 6d 6d 65 6e 74 20 20 20 20 20 -m comment
0ce0: 20 20 20 20 20 20 20 20 20 3a 20 69 6e 73 65 72 : inser
0cf0: 74 20 61 20 63 6f 6d 6d 65 6e 74 20 66 6f 72 20 t a comment for
0d00: 74 68 69 73 20 74 65 73 74 0a 0a 54 65 73 74 20 this test..Test
0d10: 64 61 74 61 20 63 61 70 74 75 72 65 0a 20 20 2d data capture. -
0d20: 73 65 74 2d 76 61 6c 75 65 73 20 20 20 20 20 20 set-values
0d30: 20 20 20 20 20 20 20 3a 20 75 70 64 61 74 65 20 : update
0d40: 6f 72 20 73 65 74 20 76 61 6c 75 65 73 20 69 6e or set values in
0d50: 20 74 68 65 20 74 65 73 74 64 61 74 61 20 74 61 the testdata ta
0d60: 62 6c 65 0a 20 20 3a 63 61 74 65 67 6f 72 79 20 ble. :category
0d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
0d80: 73 65 74 20 74 68 65 20 63 61 74 65 67 6f 72 79 set the category
0d90: 20 66 69 65 6c 64 20 28 6f 70 74 69 6f 6e 61 6c field (optional
0da0: 29 0a 20 20 3a 76 61 72 69 61 62 6c 65 20 20 20 ). :variable
0db0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 : se
0dc0: 74 20 74 68 65 20 76 61 72 69 61 62 6c 65 20 6e t the variable n
0dd0: 61 6d 65 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 ame (optional).
0de0: 20 3a 76 61 6c 75 65 20 20 20 20 20 20 20 20 20 :value
0df0: 20 20 20 20 20 20 20 20 20 3a 20 76 61 6c 75 65 : value
0e00: 20 6d 65 61 73 75 72 65 64 20 28 72 65 71 75 69 measured (requi
0e10: 72 65 64 29 0a 20 20 3a 65 78 70 65 63 74 65 64 red). :expected
0e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0e30: 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 20 value expected
0e40: 28 72 65 71 75 69 72 65 64 29 0a 20 20 3a 74 6f (required). :to
0e50: 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 l
0e60: 20 20 20 20 20 3a 20 7c 76 61 6c 75 65 2d 65 78 : |value-ex
0e70: 70 65 63 74 7c 20 3c 3d 20 74 6f 6c 20 28 72 65 pect| <= tol (re
0e80: 71 75 69 72 65 64 2c 20 63 61 6e 20 62 65 20 3c quired, can be <
0e90: 2c 20 3e 2c 20 3e 3d 2c 20 3c 3d 20 6f 72 20 6e , >, >=, <= or n
0ea0: 75 6d 62 65 72 29 0a 20 20 3a 75 6e 69 74 73 20 umber). :units
0eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ec0: 20 3a 20 6e 61 6d 65 20 6f 66 20 74 68 65 20 75 : name of the u
0ed0: 6e 69 74 73 20 66 6f 72 20 76 61 6c 75 65 2c 20 nits for value,
0ee0: 65 78 70 65 63 74 65 64 5f 76 61 6c 75 65 20 65 expected_value e
0ef0: 74 63 2e 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 tc. (optional).
0f00: 20 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 -load-test-data
0f10: 20 20 20 20 20 20 20 20 20 3a 20 72 65 61 64 20 : read
0f20: 74 65 73 74 20 73 70 65 63 69 66 69 63 20 64 61 test specific da
0f30: 74 61 20 66 6f 72 20 73 74 6f 72 61 67 65 20 69 ta for storage i
0f40: 6e 20 74 68 65 20 74 65 73 74 5f 64 61 74 61 20 n the test_data
0f50: 74 61 62 6c 65 0a 20 20 20 20 20 20 20 20 20 20 table.
0f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f70: 20 20 66 72 6f 6d 20 73 74 61 6e 64 61 72 64 20 from standard
0f80: 69 6e 2e 20 45 61 63 68 20 6c 69 6e 65 20 69 73 in. Each line is
0f90: 20 63 6f 6d 6d 61 20 64 65 6c 69 6d 69 74 65 64 comma delimited
0fa0: 20 77 69 74 68 20 66 6f 75 72 0a 20 20 20 20 20 with four.
0fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fc0: 20 20 20 20 20 20 20 66 69 65 6c 64 73 20 63 61 fields ca
0fd0: 74 65 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c tegory,variable,
0fe0: 76 61 6c 75 65 2c 63 6f 6d 6d 65 6e 74 0a 0a 51 value,comment..Q
0ff0: 75 65 72 69 65 73 0a 20 20 2d 6c 69 73 74 2d 72 ueries. -list-r
1000: 75 6e 73 20 70 61 74 74 20 20 20 20 20 20 20 20 uns patt
1010: 20 3a 20 6c 69 73 74 20 72 75 6e 73 20 6d 61 74 : list runs mat
1020: 63 68 69 6e 67 20 70 61 74 74 65 72 6e 20 5c 22 ching pattern \"
1030: 70 61 74 74 5c 22 2c 20 25 20 69 73 20 74 68 65 patt\", % is the
1040: 20 77 69 6c 64 63 61 72 64 0a 20 20 2d 73 68 6f wildcard. -sho
1050: 77 6b 65 79 73 20 20 20 20 20 20 20 20 20 20 20 wkeys
1060: 20 20 20 20 3a 20 73 68 6f 77 20 74 68 65 20 6b : show the k
1070: 65 79 73 20 75 73 65 64 20 69 6e 20 74 68 69 73 eys used in this
1080: 20 6d 65 67 61 74 65 73 74 20 73 65 74 75 70 0a megatest setup.
1090: 20 20 2d 74 65 73 74 2d 66 69 6c 65 73 20 74 61 -test-files ta
10a0: 72 67 70 61 74 74 20 20 20 20 20 3a 20 67 65 74 rgpatt : get
10b0: 20 74 68 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 the most recent
10c0: 20 74 65 73 74 20 70 61 74 68 2f 66 69 6c 65 20 test path/file
10d0: 6d 61 74 63 68 69 6e 67 20 74 61 72 67 70 61 74 matching targpat
10e0: 74 20 65 2e 67 2e 20 25 2f 25 2e 2e 2e 20 0a 20 t e.g. %/%... .
10f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1100: 20 20 20 20 20 20 20 20 20 20 20 72 65 74 75 72 retur
1110: 6e 73 20 6c 69 73 74 20 73 6f 72 74 65 64 20 62 ns list sorted b
1120: 79 20 61 67 65 20 61 73 63 65 6e 64 69 6e 67 2c y age ascending,
1130: 20 73 65 65 20 65 78 61 6d 70 6c 65 73 20 62 65 see examples be
1140: 6c 6f 77 0a 20 20 2d 74 65 73 74 2d 70 61 74 68 low. -test-path
1150: 73 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 s :
1160: 67 65 74 20 74 68 65 20 74 65 73 74 20 70 61 74 get the test pat
1170: 68 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 hs matching targ
1180: 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 69 74 65 et, runname, ite
1190: 6d 20 61 6e 64 20 74 65 73 74 0a 20 20 20 20 20 m and test.
11a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11b0: 20 20 20 20 20 20 20 70 61 74 74 65 72 6e 73 2e patterns.
11c0: 0a 20 20 2d 6c 69 73 74 2d 64 69 73 6b 73 20 20 . -list-disks
11d0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 : lis
11e0: 74 20 74 68 65 20 64 69 73 6b 73 20 61 76 61 69 t the disks avai
11f0: 6c 61 62 6c 65 20 66 6f 72 20 73 74 6f 72 69 6e lable for storin
1200: 67 20 72 75 6e 73 0a 20 20 2d 6c 69 73 74 2d 74 g runs. -list-t
1210: 61 72 67 65 74 73 20 20 20 20 20 20 20 20 20 20 argets
1220: 20 3a 20 6c 69 73 74 20 74 68 65 20 74 61 72 67 : list the targ
1230: 65 74 73 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 ets in runconfig
1240: 73 2e 63 6f 6e 66 69 67 0a 20 20 2d 6c 69 73 74 s.config. -list
1250: 2d 64 62 2d 74 61 72 67 65 74 73 20 20 20 20 20 -db-targets
1260: 20 20 20 3a 20 6c 69 73 74 20 74 68 65 20 74 61 : list the ta
1270: 72 67 65 74 20 63 6f 6d 62 69 6e 61 74 69 6f 6e rget combination
1280: 73 20 75 73 65 64 20 69 6e 20 74 68 65 20 64 62 s used in the db
1290: 0a 20 20 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 20 . -show-config
12a0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 64 75 6d : dum
12b0: 70 20 74 68 65 20 69 6e 74 65 72 6e 61 6c 20 72 p the internal r
12c0: 65 70 72 65 73 65 6e 74 61 74 69 6f 6e 20 6f 66 epresentation of
12d0: 20 74 68 65 20 6d 65 67 61 74 65 73 74 2e 63 6f the megatest.co
12e0: 6e 66 69 67 20 66 69 6c 65 0a 20 20 2d 73 68 6f nfig file. -sho
12f0: 77 2d 72 75 6e 63 6f 6e 66 69 67 20 20 20 20 20 w-runconfig
1300: 20 20 20 20 3a 20 64 75 6d 70 20 74 68 65 20 69 : dump the i
1310: 6e 74 65 72 6e 61 6c 20 72 65 70 72 65 73 65 6e nternal represen
1320: 74 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 72 75 tation of the ru
1330: 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 20 nconfigs.config
1340: 66 69 6c 65 0a 20 20 2d 64 75 6d 70 6d 6f 64 65 file. -dumpmode
1350: 20 6a 73 6f 6e 20 20 20 20 20 20 20 20 20 20 3a json :
1360: 20 64 75 6d 70 20 69 6e 20 6a 73 6f 6e 20 66 6f dump in json fo
1370: 72 6d 61 74 20 69 6e 73 74 65 61 64 20 6f 66 20 rmat instead of
1380: 73 65 78 70 72 0a 20 20 2d 73 68 6f 77 2d 63 6d sexpr. -show-cm
1390: 64 69 6e 66 6f 20 20 20 20 20 20 20 20 20 20 20 dinfo
13a0: 3a 20 64 75 6d 70 20 74 68 65 20 63 6f 6d 6d 61 : dump the comma
13b0: 6e 64 20 69 6e 66 6f 20 66 6f 72 20 61 20 74 65 nd info for a te
13c0: 73 74 20 28 72 75 6e 20 69 6e 20 74 65 73 74 20 st (run in test
13d0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 29 0a 0a 4d 69 environment)..Mi
13e0: 73 63 20 0a 20 20 2d 72 65 62 75 69 6c 64 2d 64 sc . -rebuild-d
13f0: 62 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 b :
1400: 62 72 69 6e 67 20 74 68 65 20 64 61 74 61 62 61 bring the databa
1410: 73 65 20 73 63 68 65 6d 61 20 75 70 20 74 6f 20 se schema up to
1420: 64 61 74 65 0a 20 20 2d 75 70 64 61 74 65 2d 6d date. -update-m
1430: 65 74 61 20 20 20 20 20 20 20 20 20 20 20 20 3a eta :
1440: 20 75 70 64 61 74 65 20 74 68 65 20 74 65 73 74 update the test
1450: 73 20 6d 65 74 61 64 61 74 61 20 66 6f 72 20 61 s metadata for a
1460: 6c 6c 20 74 65 73 74 73 0a 20 20 2d 65 6e 76 32 ll tests. -env2
1470: 66 69 6c 65 20 66 6e 61 6d 65 20 20 20 20 20 20 file fname
1480: 20 20 20 3a 20 77 72 69 74 65 20 74 68 65 20 65 : write the e
1490: 6e 76 69 72 6f 6e 6d 65 6e 74 20 74 6f 20 66 6e nvironment to fn
14a0: 61 6d 65 2e 63 73 68 20 61 6e 64 20 66 6e 61 6d ame.csh and fnam
14b0: 65 2e 73 68 0a 20 20 2d 73 65 74 76 61 72 73 20 e.sh. -setvars
14c0: 56 41 52 31 3d 76 61 6c 31 2c 56 41 52 32 3d 76 VAR1=val1,VAR2=v
14d0: 61 6c 32 20 3a 20 41 64 64 20 65 6e 76 69 72 6f al2 : Add enviro
14e0: 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 20 nment variables
14f0: 74 6f 20 61 20 72 75 6e 20 4e 42 2f 2f 20 74 68 to a run NB// th
1500: 65 73 65 20 61 72 65 0a 20 20 20 20 20 20 20 20 ese are.
1510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1520: 20 20 20 20 20 20 20 20 20 6f 76 65 72 77 72 69 overwri
1530: 74 74 65 6e 20 62 79 20 76 61 6c 75 65 73 20 73 tten by values s
1540: 65 74 20 69 6e 20 63 6f 6e 66 69 67 20 66 69 6c et in config fil
1550: 65 73 2e 0a 20 20 2d 73 65 72 76 65 72 20 2d 7c es.. -server -|
1560: 68 6f 73 74 6e 61 6d 65 20 20 20 20 20 20 3a 20 hostname :
1570: 73 74 61 72 74 20 74 68 65 20 73 65 72 76 65 72 start the server
1580: 20 28 72 65 64 75 63 65 73 20 63 6f 6e 74 65 6e (reduces conten
1590: 74 69 6f 6e 20 6f 6e 20 6d 65 67 61 74 65 73 74 tion on megatest
15a0: 2e 64 62 29 2c 20 75 73 65 0a 20 20 20 20 20 20 .db), use.
15b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15c0: 20 20 20 20 20 20 2d 20 74 6f 20 61 75 74 6f 6d - to autom
15d0: 61 74 69 63 61 6c 6c 79 20 66 69 67 75 72 65 20 atically figure
15e0: 6f 75 74 20 68 6f 73 74 6e 61 6d 65 0a 20 20 2d out hostname. -
15f0: 74 72 61 6e 73 70 6f 72 74 20 68 74 74 70 7c 66 transport http|f
1600: 73 20 20 20 20 20 20 3a 20 75 73 65 20 68 74 74 s : use htt
1610: 70 20 6f 72 20 64 69 72 65 63 74 20 61 63 63 65 p or direct acce
1620: 73 73 20 66 6f 72 20 74 72 61 6e 73 70 6f 72 74 ss for transport
1630: 20 28 64 65 66 61 75 6c 74 20 69 73 20 68 74 74 (default is htt
1640: 70 29 20 0a 20 20 2d 64 61 65 6d 6f 6e 69 7a 65 p) . -daemonize
1650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
1660: 66 6f 72 6b 20 69 6e 74 6f 20 62 61 63 6b 67 72 fork into backgr
1670: 6f 75 6e 64 20 61 6e 64 20 64 69 73 63 6f 6e 6e ound and disconn
1680: 65 63 74 20 66 72 6f 6d 20 73 74 64 69 6e 2f 6f ect from stdin/o
1690: 75 74 0a 20 20 2d 6c 69 73 74 2d 73 65 72 76 65 ut. -list-serve
16a0: 72 73 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c rs : l
16b0: 69 73 74 20 74 68 65 20 73 65 72 76 65 72 73 20 ist the servers
16c0: 0a 20 20 2d 73 74 6f 70 2d 73 65 72 76 65 72 20 . -stop-server
16d0: 69 64 20 20 20 20 20 20 20 20 20 3a 20 73 74 6f id : sto
16e0: 70 20 73 65 72 76 65 72 20 73 70 65 63 69 66 69 p server specifi
16f0: 65 64 20 62 79 20 69 64 20 28 73 65 65 20 6f 75 ed by id (see ou
1700: 74 70 75 74 20 6f 66 20 2d 6c 69 73 74 2d 73 65 tput of -list-se
1710: 72 76 65 72 73 29 0a 20 20 2d 72 65 70 6c 20 20 rvers). -repl
1720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1730: 20 3a 20 73 74 61 72 74 20 61 20 72 65 70 6c 20 : start a repl
1740: 28 75 73 65 66 75 6c 20 66 6f 72 20 65 78 74 65 (useful for exte
1750: 6e 64 69 6e 67 20 6d 65 67 61 74 65 73 74 29 0a nding megatest).
1760: 20 20 2d 6c 6f 61 64 20 66 69 6c 65 2e 73 63 6d -load file.scm
1770: 20 20 20 20 20 20 20 20 20 20 3a 20 6c 6f 61 64 : load
1780: 20 61 6e 64 20 72 75 6e 20 66 69 6c 65 2e 73 63 and run file.sc
1790: 6d 0a 0a 53 70 72 65 61 64 73 68 65 65 74 20 67 m..Spreadsheet g
17a0: 65 6e 65 72 61 74 69 6f 6e 0a 20 20 2d 65 78 74 eneration. -ext
17b0: 72 61 63 74 2d 6f 64 73 20 66 6e 61 6d 65 2e 6f ract-ods fname.o
17c0: 64 73 20 20 3a 20 65 78 74 72 61 63 74 20 61 6e ds : extract an
17d0: 20 6f 70 65 6e 20 64 6f 63 75 6d 65 6e 74 20 73 open document s
17e0: 70 72 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 preadsheet from
17f0: 74 68 65 20 64 61 74 61 62 61 73 65 0a 20 20 2d the database. -
1800: 70 61 74 68 6d 6f 64 20 70 61 74 68 20 20 20 20 pathmod path
1810: 20 20 20 20 20 20 20 3a 20 69 6e 73 65 72 74 20 : insert
1820: 70 61 74 68 2c 20 69 2e 65 2e 20 70 61 74 68 2f path, i.e. path/
1830: 72 75 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f runame/itempath/
1840: 6c 6f 67 66 69 6c 65 2e 68 74 6d 6c 0a 20 20 20 logfile.html.
1850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1860: 20 20 20 20 20 20 20 20 20 77 69 6c 6c 20 63 6c will cl
1870: 65 61 72 20 74 68 65 20 66 69 65 6c 64 20 69 66 ear the field if
1880: 20 6e 6f 20 72 75 6e 64 69 72 2f 74 65 73 74 6e no rundir/testn
1890: 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f 67 ame/itempath/log
18a0: 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 file.
18b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18c0: 20 69 66 20 69 74 20 63 6f 6e 74 61 69 6e 73 20 if it contains
18d0: 66 6f 72 77 61 72 64 20 73 6c 61 73 68 65 73 20 forward slashes
18e0: 74 68 65 20 70 61 74 68 20 77 69 6c 6c 20 62 65 the path will be
18f0: 20 63 6f 6e 76 65 72 74 65 64 0a 20 20 20 20 20 converted.
1900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1910: 20 20 20 20 20 20 20 74 6f 20 77 69 6e 64 6f 77 to window
1920: 73 20 73 74 79 6c 65 0a 47 65 74 74 69 6e 67 20 s style.Getting
1930: 73 74 61 72 74 65 64 0a 20 20 2d 67 65 6e 2d 6d started. -gen-m
1940: 65 67 61 74 65 73 74 2d 61 72 65 61 20 20 20 20 egatest-area
1950: 20 20 20 3a 20 63 72 65 61 74 65 20 61 20 73 6b : create a sk
1960: 65 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 74 20 eleton megatest
1970: 61 72 65 61 2e 20 59 6f 75 20 77 69 6c 6c 20 62 area. You will b
1980: 65 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 20 70 e prompted for p
1990: 61 74 68 73 0a 20 20 2d 67 65 6e 2d 6d 65 67 61 aths. -gen-mega
19a0: 74 65 73 74 2d 74 65 73 74 20 74 6e 61 6d 65 20 test-test tname
19b0: 3a 20 63 72 65 61 74 65 20 61 20 73 6b 65 6c 65 : create a skele
19c0: 74 6f 6e 20 6d 65 67 61 74 65 73 74 20 74 65 73 ton megatest tes
19d0: 74 2e 20 59 6f 75 20 77 69 6c 6c 20 62 65 20 70 t. You will be p
19e0: 72 6f 6d 70 74 65 64 20 66 6f 72 20 69 6e 66 6f rompted for info
19f0: 0a 0a 45 78 61 6d 70 6c 65 73 0a 0a 23 20 47 65 ..Examples..# Ge
1a00: 74 20 74 65 73 74 20 70 61 74 68 2c 20 75 73 65 t test path, use
1a10: 20 27 2e 27 20 74 6f 20 67 65 74 20 61 20 73 69 '.' to get a si
1a20: 6e 67 6c 65 20 70 61 74 68 20 6f 72 20 61 20 73 ngle path or a s
1a30: 70 65 63 69 66 69 63 20 70 61 74 68 2f 66 69 6c pecific path/fil
1a40: 65 20 70 61 74 74 65 72 6e 0a 6d 65 67 61 74 65 e pattern.megate
1a50: 73 74 20 2d 74 65 73 74 2d 66 69 6c 65 73 20 27 st -test-files '
1a60: 6c 6f 67 73 2f 2a 2e 6c 6f 67 27 20 2d 74 61 72 logs/*.log' -tar
1a70: 67 65 74 20 75 62 75 6e 74 75 2f 6e 25 2f 6e 6f get ubuntu/n%/no
1a80: 25 20 3a 72 75 6e 6e 61 6d 65 20 77 34 39 25 20 % :runname w49%
1a90: 2d 74 65 73 74 70 61 74 74 20 74 65 73 74 5f 6d -testpatt test_m
1aa0: 74 25 0a 0a 43 61 6c 6c 65 64 20 61 73 20 22 20 t%..Called as "
1ab0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
1ac0: 72 73 65 20 28 61 72 67 76 29 20 22 20 22 29 20 rse (argv) " ")
1ad0: 22 0a 56 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 ".Version " mega
1ae0: 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 2c 20 test-version ",
1af0: 62 75 69 6c 74 20 66 72 6f 6d 20 22 20 6d 65 67 built from " meg
1b00: 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 atest-fossil-has
1b10: 68 20 29 29 0a 0a 3b 3b 20 20 2d 67 75 69 20 20 h ))..;; -gui
1b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b30: 20 20 3a 20 73 74 61 72 74 20 61 20 67 75 69 20 : start a gui
1b40: 69 6e 74 65 72 66 61 63 65 0a 3b 3b 20 20 2d 63 interface.;; -c
1b50: 6f 6e 66 69 67 20 66 6e 61 6d 65 20 20 20 20 20 onfig fname
1b60: 20 20 20 20 20 20 3a 20 6f 76 65 72 72 69 64 65 : override
1b70: 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 20 66 the runconfig f
1b80: 69 6c 65 20 77 69 74 68 20 66 6e 61 6d 65 0a 0a ile with fname..
1b90: 3b 3b 20 70 72 6f 63 65 73 73 20 61 72 67 73 0a ;; process args.
1ba0: 28 64 65 66 69 6e 65 20 72 65 6d 61 72 67 73 20 (define remargs
1bb0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 73 20 0a (args:get-args .
1bc0: 09 09 20 28 61 72 67 76 29 0a 09 09 20 28 6c 69 .. (argv)... (li
1bd0: 73 74 20 20 22 2d 72 75 6e 74 65 73 74 73 22 20 st "-runtests"
1be0: 20 3b 3b 20 72 75 6e 20 61 20 73 70 65 63 69 66 ;; run a specif
1bf0: 69 63 20 74 65 73 74 0a 09 09 09 22 2d 63 6f 6e ic test...."-con
1c00: 66 69 67 22 20 20 20 20 3b 3b 20 6f 76 65 72 72 fig" ;; overr
1c10: 69 64 65 20 74 68 65 20 63 6f 6e 66 69 67 20 66 ide the config f
1c20: 69 6c 65 20 6e 61 6d 65 0a 09 09 09 22 2d 65 78 ile name...."-ex
1c30: 65 63 75 74 65 22 20 20 20 3b 3b 20 72 75 6e 20 ecute" ;; run
1c40: 74 68 65 20 63 6f 6d 6d 61 6e 64 20 65 6e 63 6f the command enco
1c50: 64 65 64 20 69 6e 20 74 68 65 20 62 61 73 65 36 ded in the base6
1c60: 34 20 70 61 72 61 6d 65 74 65 72 0a 09 09 09 22 4 parameter...."
1c70: 2d 73 74 65 70 22 0a 09 09 09 22 3a 72 75 6e 6e -step"....":runn
1c80: 61 6d 65 22 20 20 20 0a 09 09 09 22 2d 74 61 72 ame" ...."-tar
1c90: 67 65 74 22 0a 09 09 09 22 2d 72 65 71 74 61 72 get"...."-reqtar
1ca0: 67 22 0a 09 09 09 22 3a 72 75 6e 6e 61 6d 65 22 g"....":runname"
1cb0: 0a 09 09 09 22 2d 72 75 6e 6e 61 6d 65 22 0a 09 ...."-runname"..
1cc0: 09 09 22 3a 73 74 61 74 65 22 20 20 0a 09 09 09 ..":state" ....
1cd0: 22 2d 73 74 61 74 65 22 0a 09 09 09 22 3a 73 74 "-state"....":st
1ce0: 61 74 75 73 22 0a 09 09 09 22 2d 73 74 61 74 75 atus"...."-statu
1cf0: 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d 72 75 6e s"...."-list-run
1d00: 73 22 0a 09 09 09 22 2d 74 65 73 74 70 61 74 74 s"...."-testpatt
1d10: 22 20 0a 09 09 09 22 2d 69 74 65 6d 70 61 74 74 " ...."-itempatt
1d20: 22 0a 09 09 09 22 2d 73 65 74 6c 6f 67 22 0a 09 "...."-setlog"..
1d30: 09 09 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 0a .."-set-toplog".
1d40: 09 09 09 22 2d 72 75 6e 73 74 65 70 22 0a 09 09 ..."-runstep"...
1d50: 09 22 2d 6c 6f 67 70 72 6f 22 0a 09 09 09 22 2d ."-logpro"...."-
1d60: 6d 22 0a 09 09 09 22 2d 72 65 72 75 6e 22 0a 09 m"...."-rerun"..
1d70: 09 09 22 2d 64 61 79 73 22 0a 09 09 09 22 2d 72 .."-days"...."-r
1d80: 65 6e 61 6d 65 2d 72 75 6e 22 0a 09 09 09 22 2d ename-run"...."-
1d90: 74 6f 22 0a 09 09 09 3b 3b 20 76 61 6c 75 65 73 to"....;; values
1da0: 20 61 6e 64 20 6d 65 73 73 61 67 65 73 0a 09 09 and messages...
1db0: 09 22 3a 63 61 74 65 67 6f 72 79 22 0a 09 09 09 .":category"....
1dc0: 22 3a 76 61 72 69 61 62 6c 65 22 0a 09 09 09 22 ":variable"...."
1dd0: 3a 76 61 6c 75 65 22 0a 09 09 09 22 3a 65 78 70 :value"....":exp
1de0: 65 63 74 65 64 22 0a 09 09 09 22 3a 74 6f 6c 22 ected"....":tol"
1df0: 0a 09 09 09 22 3a 75 6e 69 74 73 22 0a 09 09 09 ....":units"....
1e00: 3b 3b 20 6d 69 73 63 0a 09 09 09 22 2d 73 65 72 ;; misc...."-ser
1e10: 76 65 72 22 0a 09 09 09 22 2d 74 72 61 6e 73 70 ver"...."-transp
1e20: 6f 72 74 22 0a 09 09 09 22 2d 73 74 6f 70 2d 73 ort"...."-stop-s
1e30: 65 72 76 65 72 22 0a 09 09 09 22 2d 70 6f 72 74 erver"...."-port
1e40: 22 0a 09 09 09 22 2d 65 78 74 72 61 63 74 2d 6f "...."-extract-o
1e50: 64 73 22 0a 09 09 09 22 2d 70 61 74 68 6d 6f 64 ds"...."-pathmod
1e60: 22 0a 09 09 09 22 2d 65 6e 76 32 66 69 6c 65 22 "...."-env2file"
1e70: 0a 09 09 09 22 2d 73 65 74 76 61 72 73 22 0a 09 ...."-setvars"..
1e80: 09 09 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 .."-set-state-st
1e90: 61 74 75 73 22 0a 09 09 09 22 2d 64 65 62 75 67 atus"...."-debug
1ea0: 22 20 3b 3b 20 66 6f 72 20 2a 76 65 72 62 6f 73 " ;; for *verbos
1eb0: 69 74 79 2a 20 3e 20 32 0a 09 09 09 22 2d 67 65 ity* > 2...."-ge
1ec0: 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 22 n-megatest-test"
1ed0: 0a 09 09 09 22 2d 6f 76 65 72 72 69 64 65 2d 74 ...."-override-t
1ee0: 69 6d 65 6f 75 74 22 0a 09 09 09 22 2d 74 65 73 imeout"...."-tes
1ef0: 74 2d 66 69 6c 65 73 22 20 20 3b 3b 20 2d 74 65 t-files" ;; -te
1f00: 73 74 2d 70 61 74 68 73 20 69 73 20 66 6f 72 20 st-paths is for
1f10: 6c 69 73 74 69 6e 67 20 61 6c 6c 0a 09 09 09 22 listing all...."
1f20: 2d 6c 6f 61 64 22 20 20 20 20 20 20 20 20 3b 3b -load" ;;
1f30: 20 6c 6f 61 64 20 61 6e 64 20 65 78 65 63 74 75 load and exectu
1f40: 74 65 20 61 20 73 63 68 65 6d 65 20 66 69 6c 65 te a scheme file
1f50: 0a 09 09 09 22 2d 64 75 6d 70 6d 6f 64 65 22 0a ...."-dumpmode".
1f60: 09 09 09 29 20 0a 09 09 20 28 6c 69 73 74 20 20 ...) ... (list
1f70: 22 2d 68 22 0a 09 09 09 22 2d 76 65 72 73 69 6f "-h"...."-versio
1f80: 6e 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d 66 n"... "-f
1f90: 6f 72 63 65 22 0a 09 09 20 20 20 20 20 20 20 20 orce"...
1fa0: 22 2d 78 74 65 72 6d 22 0a 09 09 20 20 20 20 20 "-xterm"...
1fb0: 20 20 20 22 2d 73 68 6f 77 6b 65 79 73 22 0a 09 "-showkeys"..
1fc0: 09 20 20 20 20 20 20 20 20 22 2d 74 65 73 74 2d . "-test-
1fd0: 73 74 61 74 75 73 22 0a 09 09 09 22 2d 73 65 74 status"...."-set
1fe0: 2d 76 61 6c 75 65 73 22 0a 09 09 09 22 2d 6c 6f -values"...."-lo
1ff0: 61 64 2d 74 65 73 74 2d 64 61 74 61 22 0a 09 09 ad-test-data"...
2000: 09 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 ."-summarize-ite
2010: 6d 73 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d ms"... "-
2020: 67 75 69 22 0a 09 09 09 22 2d 64 61 65 6d 6f 6e gui"...."-daemon
2030: 69 7a 65 22 0a 09 09 09 3b 3b 20 6d 69 73 63 0a ize"....;; misc.
2040: 09 09 09 22 2d 61 72 63 68 69 76 65 22 0a 09 09 ..."-archive"...
2050: 09 22 2d 72 65 70 6c 22 0a 09 09 09 22 2d 6c 6f ."-repl"...."-lo
2060: 63 6b 22 0a 09 09 09 22 2d 75 6e 6c 6f 63 6b 22 ck"...."-unlock"
2070: 0a 09 09 09 22 2d 6c 69 73 74 2d 73 65 72 76 65 ...."-list-serve
2080: 72 73 22 0a 09 09 09 3b 3b 20 6d 69 73 74 20 71 rs"....;; mist q
2090: 75 65 72 69 65 73 0a 09 09 09 22 2d 6c 69 73 74 ueries...."-list
20a0: 2d 64 69 73 6b 73 22 0a 09 09 09 22 2d 6c 69 73 -disks"...."-lis
20b0: 74 2d 74 61 72 67 65 74 73 22 0a 09 09 09 22 2d t-targets"...."-
20c0: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 list-db-targets"
20d0: 0a 09 09 09 22 2d 73 68 6f 77 2d 72 75 6e 63 6f ...."-show-runco
20e0: 6e 66 69 67 22 0a 09 09 09 22 2d 73 68 6f 77 2d nfig"...."-show-
20f0: 63 6f 6e 66 69 67 22 0a 09 09 09 22 2d 73 68 6f config"...."-sho
2100: 77 2d 63 6d 64 69 6e 66 6f 22 0a 09 09 09 3b 3b w-cmdinfo"....;;
2110: 20 71 75 65 72 69 65 73 0a 09 09 09 22 2d 74 65 queries...."-te
2120: 73 74 2d 70 61 74 68 73 22 20 3b 3b 20 67 65 74 st-paths" ;; get
2130: 20 70 61 74 68 28 73 29 20 74 6f 20 61 20 74 65 path(s) to a te
2140: 73 74 2c 20 6f 72 64 65 72 65 64 20 62 79 20 79 st, ordered by y
2150: 6f 75 6e 67 65 73 74 20 66 69 72 73 74 0a 0a 09 oungest first...
2160: 09 09 22 2d 72 75 6e 61 6c 6c 22 20 20 20 20 3b .."-runall" ;
2170: 3b 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 0a ; run all tests.
2180: 09 09 09 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 ..."-remove-runs
2190: 22 0a 09 09 09 22 2d 72 65 62 75 69 6c 64 2d 64 "...."-rebuild-d
21a0: 62 22 0a 09 09 09 22 2d 72 6f 6c 6c 75 70 22 0a b"...."-rollup".
21b0: 09 09 09 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 ..."-update-meta
21c0: 22 0a 09 09 09 22 2d 67 65 6e 2d 6d 65 67 61 74 "...."-gen-megat
21d0: 65 73 74 2d 61 72 65 61 22 0a 0a 09 09 09 22 2d est-area"....."-
21e0: 6c 6f 67 67 69 6e 67 22 0a 09 09 09 22 2d 76 22 logging"...."-v"
21f0: 20 3b 3b 20 76 65 72 62 6f 73 65 20 32 2c 20 6d ;; verbose 2, m
2200: 6f 72 65 20 74 68 61 6e 20 6e 6f 72 6d 61 6c 20 ore than normal
2210: 28 6e 6f 72 6d 61 6c 20 69 73 20 31 29 0a 09 09 (normal is 1)...
2220: 09 22 2d 71 22 20 3b 3b 20 71 75 69 65 74 20 30 ."-q" ;; quiet 0
2230: 2c 20 65 72 72 6f 72 73 2f 77 61 72 6e 69 6e 67 , errors/warning
2240: 73 20 6f 6e 6c 79 0a 09 09 20 20 20 20 20 20 20 s only...
2250: 29 0a 09 09 20 61 72 67 73 3a 61 72 67 2d 68 61 )... args:arg-ha
2260: 73 68 0a 09 09 20 30 29 29 0a 0a 28 69 66 20 28 sh... 0))..(if (
2270: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 args:get-arg "-h
2280: 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
2290: 20 20 20 20 28 70 72 69 6e 74 20 68 65 6c 70 29 (print help)
22a0: 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a . (exit))).
22b0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
22c0: 72 67 20 22 2d 76 65 72 73 69 6f 6e 22 29 0a 20 rg "-version").
22d0: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
22e0: 28 70 72 69 6e 74 20 6d 65 67 61 74 65 73 74 2d (print megatest-
22f0: 76 65 72 73 69 6f 6e 29 0a 20 20 20 20 20 20 28 version). (
2300: 65 78 69 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 exit)))..(define
2310: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
2320: 23 66 29 0a 0a 28 69 66 20 28 61 6e 64 20 28 6f #f)..(if (and (o
2330: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
2340: 22 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 22 29 "-list-targets")
2350: 0a 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 .. (args:get
2360: 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 -arg "-list-db-t
2370: 61 72 67 65 74 73 22 29 29 0a 09 20 28 6e 6f 74 argets")).. (not
2380: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
2390: 2d 74 72 61 6e 73 70 6f 72 74 22 29 29 29 0a 20 -transport"))).
23a0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
23b0: 65 74 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 et! args:arg-has
23c0: 68 20 22 2d 74 72 61 6e 73 70 6f 72 74 22 20 22 h "-transport" "
23d0: 66 73 22 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d fs"))..;;=======
23e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
2420: 3b 3b 20 4d 69 73 63 20 73 65 74 75 70 20 73 74 ;; Misc setup st
2430: 75 66 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d uff.;;==========
2440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
2480: 65 62 75 67 3a 73 65 74 75 70 29 0a 0a 28 69 66 ebug:setup)..(if
2490: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
24a0: 2d 6c 6f 67 67 69 6e 67 22 29 28 73 65 74 21 20 -logging")(set!
24b0: 2a 6c 6f 67 67 69 6e 67 2a 20 23 74 29 29 0a 0a *logging* #t))..
24c0: 28 69 66 20 28 64 65 62 75 67 3a 64 65 62 75 67 (if (debug:debug
24d0: 2d 6d 6f 64 65 20 33 29 20 3b 3b 20 77 65 20 61 -mode 3) ;; we a
24e0: 72 65 20 6f 62 76 69 6f 75 73 6c 79 20 64 65 62 re obviously deb
24f0: 75 67 67 69 6e 67 0a 20 20 20 20 28 73 65 74 21 ugging. (set!
2500: 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 open-run-close
2510: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e open-run-close-n
2520: 6f 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 o-exception-hand
2530: 6c 69 6e 67 29 29 0a 0a 28 69 66 20 28 61 72 67 ling))..(if (arg
2540: 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d s:get-arg "-item
2550: 70 61 74 74 22 29 0a 20 20 20 20 28 6c 65 74 20 patt"). (let
2560: 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e 63 20 28 ((newval (conc (
2570: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
2580: 65 73 74 70 61 74 74 22 29 20 22 2f 22 20 28 61 estpatt") "/" (a
2590: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 rgs:get-arg "-it
25a0: 65 6d 70 61 74 74 22 29 29 29 29 0a 20 20 20 20 empatt")))).
25b0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
25c0: 20 22 57 41 52 4e 49 4e 47 3a 20 2d 69 74 65 6d "WARNING: -item
25d0: 70 61 74 74 20 68 61 73 20 62 65 65 6e 20 64 65 patt has been de
25e0: 70 72 65 63 61 74 65 64 2c 20 70 6c 65 61 73 65 precated, please
25f0: 20 75 73 65 20 2d 74 65 73 74 70 61 74 74 20 74 use -testpatt t
2600: 65 73 74 70 61 74 74 2f 69 74 65 6d 70 61 74 74 estpatt/itempatt
2610: 20 6d 65 74 68 6f 64 2c 20 6e 65 77 20 74 65 73 method, new tes
2620: 74 70 61 74 74 20 69 73 20 22 6e 65 77 76 61 6c tpatt is "newval
2630: 29 0a 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 ). (hash-ta
2640: 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 ble-set! args:ar
2650: 67 2d 68 61 73 68 20 22 2d 74 65 73 74 70 61 74 g-hash "-testpat
2660: 74 22 20 6e 65 77 76 61 6c 29 0a 20 20 20 20 20 t" newval).
2670: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c (hash-table-del
2680: 65 74 65 21 20 61 72 67 73 3a 61 72 67 2d 68 61 ete! args:arg-ha
2690: 73 68 20 22 2d 69 74 65 6d 70 61 74 74 22 29 29 sh "-itempatt"))
26a0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
26b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d ===========.;; M
26f0: 69 73 63 20 67 65 6e 65 72 61 6c 20 63 61 6c 6c isc general call
2700: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
2710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
2750: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
2760: 65 6e 76 32 66 69 6c 65 22 29 0a 20 20 20 20 28 env2file"). (
2770: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 73 61 76 begin. (sav
2780: 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 e-environment-as
2790: 2d 66 69 6c 65 73 20 28 61 72 67 73 3a 67 65 74 -files (args:get
27a0: 2d 61 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 -arg "-env2file"
27b0: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
27c0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
27d0: 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
27e0: 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 69 et-arg "-list-di
27f0: 73 6b 73 22 29 0a 20 20 20 20 28 62 65 67 69 6e sks"). (begin
2800: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 0a 20 . (print .
2810: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e (string-in
2820: 74 65 72 73 70 65 72 73 65 20 0a 09 28 6d 61 70 tersperse ..(map
2830: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 20 (lambda (x)..
2840: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 (string-int
2850: 65 72 73 70 65 72 73 65 20 0a 09 09 78 0a 09 09 ersperse ...x...
2860: 22 20 3d 3e 20 22 29 29 0a 09 20 20 20 20 20 28 " => ")).. (
2870: 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 64 69 73 6b 73 common:get-disks
2880: 29 20 29 0a 09 22 5c 6e 22 29 29 0a 20 20 20 20 ) ).."\n")).
2890: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
28a0: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
28b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
28c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
28d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
28e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
28f0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 ======.;; Start
2900: 74 68 65 20 73 65 72 76 65 72 20 2d 20 63 61 6e the server - can
2910: 20 62 65 20 64 6f 6e 65 20 69 6e 20 63 6f 6e 6a be done in conj
2920: 75 6e 63 74 69 6f 6e 20 77 69 74 68 20 2d 72 75 unction with -ru
2930: 6e 61 6c 6c 20 6f 72 20 2d 72 75 6e 74 65 73 74 nall or -runtest
2940: 73 20 28 6f 6e 65 20 64 61 79 2e 2e 2e 29 0a 3b s (one day...).;
2950: 3b 20 20 20 77 65 20 73 74 61 72 74 20 74 68 65 ; we start the
2960: 20 73 65 72 76 65 72 20 69 66 20 6e 6f 74 20 72 server if not r
2970: 75 6e 6e 69 6e 67 20 65 6c 73 65 20 73 74 61 72 unning else star
2980: 74 20 74 68 65 20 63 6c 69 65 6e 74 20 74 68 72 t the client thr
2990: 65 61 64 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ead.;;==========
29a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
29e0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
29f0: 22 2d 73 65 72 76 65 72 22 29 0a 20 20 20 20 28 "-server"). (
2a00: 6c 65 74 20 28 28 74 72 61 6e 73 70 6f 72 74 20 let ((transport
2a10: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
2a20: 74 72 61 6e 73 70 6f 72 74 22 20 22 68 74 74 70 transport" "http
2a30: 22 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 "))). (debu
2a40: 67 3a 70 72 69 6e 74 20 32 20 22 4c 61 75 6e 63 g:print 2 "Launc
2a50: 68 69 6e 67 20 73 65 72 76 65 72 20 75 73 69 6e hing server usin
2a60: 67 20 74 72 61 6e 73 70 6f 72 74 20 22 20 74 72 g transport " tr
2a70: 61 6e 73 70 6f 72 74 29 0a 20 20 20 20 20 20 28 ansport). (
2a80: 73 65 72 76 65 72 3a 6c 61 75 6e 63 68 20 28 73 server:launch (s
2a90: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 74 72 tring->symbol tr
2aa0: 61 6e 73 70 6f 72 74 29 29 29 0a 20 20 20 20 28 ansport))). (
2ab0: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 28 if (not (null? (
2ac0: 6c 73 65 74 2d 69 6e 74 65 72 73 65 63 74 69 6f lset-intersectio
2ad0: 6e 20 0a 09 09 20 20 20 20 20 65 71 75 61 6c 3f n ... equal?
2ae0: 0a 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 ... (hash-ta
2af0: 62 6c 65 2d 6b 65 79 73 20 61 72 67 73 3a 61 72 ble-keys args:ar
2b00: 67 2d 68 61 73 68 29 0a 09 09 20 20 20 20 20 27 g-hash)... '
2b10: 28 22 2d 72 75 6e 74 65 73 74 73 22 20 20 20 20 ("-runtests"
2b20: 22 2d 6c 69 73 74 2d 72 75 6e 73 22 20 20 20 22 "-list-runs" "
2b30: 2d 72 6f 6c 6c 75 70 22 0a 09 09 20 20 20 20 20 -rollup"...
2b40: 20 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 "-remove-runs"
2b50: 20 22 2d 6c 6f 63 6b 22 20 20 20 20 20 20 20 20 "-lock"
2b60: 22 2d 75 6e 6c 6f 63 6b 22 0a 09 09 20 20 20 20 "-unlock"...
2b70: 20 20 20 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 "-update-meta
2b80: 22 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 " "-extract-ods"
2b90: 29 29 29 29 0a 09 28 69 66 20 28 73 65 74 75 70 ))))..(if (setup
2ba0: 2d 66 6f 72 2d 72 75 6e 29 0a 09 20 20 20 20 28 -for-run).. (
2bb0: 6c 65 74 20 6c 6f 6f 70 20 28 28 73 65 72 76 65 let loop ((serve
2bc0: 72 73 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c rs (open-run-cl
2bd0: 6f 73 65 20 74 61 73 6b 73 3a 67 65 74 2d 62 65 ose tasks:get-be
2be0: 73 74 2d 73 65 72 76 65 72 20 74 61 73 6b 73 3a st-server tasks:
2bf0: 6f 70 65 6e 2d 64 62 29 29 0a 09 09 20 20 20 20 open-db))...
2c00: 20 20 20 28 74 72 79 63 6f 75 6e 74 20 30 29 29 (trycount 0))
2c10: 0a 09 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 .. (if (or
2c20: 28 6e 6f 74 20 73 65 72 76 65 72 73 29 0a 09 09 (not servers)...
2c30: 20 20 20 20 20 20 28 6e 75 6c 6c 3f 20 73 65 72 (null? ser
2c40: 76 65 72 73 29 29 0a 09 09 20 20 28 62 65 67 69 vers))... (begi
2c50: 6e 0a 09 09 20 20 20 20 28 69 66 20 28 65 76 65 n... (if (eve
2c60: 6e 3f 20 74 72 79 63 6f 75 6e 74 29 20 3b 3b 20 n? trycount) ;;
2c70: 6a 75 73 74 20 64 6f 20 74 68 65 20 73 65 72 76 just do the serv
2c80: 65 72 20 73 74 61 72 74 20 65 76 65 72 79 20 6f er start every o
2c90: 74 68 65 72 20 74 69 6d 65 20 74 68 72 6f 75 67 ther time throug
2ca0: 68 20 74 68 69 73 20 6c 6f 6f 70 20 28 65 76 65 h this loop (eve
2cb0: 72 79 20 38 20 73 65 63 6f 6e 64 73 29 0a 09 09 ry 8 seconds)...
2cc0: 09 28 62 65 67 69 6e 0a 09 09 09 20 20 28 64 65 .(begin.... (de
2cd0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 49 4e 46 bug:print 0 "INF
2ce0: 4f 3a 20 53 74 61 72 74 69 6e 67 20 73 65 72 76 O: Starting serv
2cf0: 65 72 20 61 73 20 6e 6f 6e 65 20 72 75 6e 6e 69 er as none runni
2d00: 6e 67 20 2e 2e 2e 22 29 0a 09 09 09 20 20 3b 3b ng ...").... ;;
2d10: 20 28 73 65 72 76 65 72 3a 6c 61 75 6e 63 68 20 (server:launch
2d20: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
2d30: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
2d40: 74 72 61 6e 73 70 6f 72 74 22 20 22 68 74 74 70 transport" "http
2d50: 22 29 29 29 29 0a 09 09 09 20 20 3b 3b 20 28 70 ")))).... ;; (p
2d60: 72 6f 63 65 73 73 2d 72 75 6e 20 28 63 61 72 20 rocess-run (car
2d70: 28 61 72 67 76 29 29 20 28 6c 69 73 74 20 22 2d (argv)) (list "-
2d80: 73 65 72 76 65 72 22 20 22 2d 22 20 22 2d 64 61 server" "-" "-da
2d90: 65 6d 6f 6e 69 7a 65 22 20 22 2d 74 72 61 6e 73 emonize" "-trans
2da0: 70 6f 72 74 22 20 28 61 72 67 73 3a 67 65 74 2d port" (args:get-
2db0: 61 72 67 20 22 2d 74 72 61 6e 73 70 6f 72 74 22 arg "-transport"
2dc0: 20 22 68 74 74 70 22 29 29 29 0a 09 09 09 20 20 "http")))....
2dd0: 28 73 79 73 74 65 6d 20 22 6d 65 67 61 74 65 73 (system "megates
2de0: 74 20 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 20 t -list-servers
2df0: 7c 20 67 72 65 70 20 61 6c 69 76 65 20 7c 7c 20 | grep alive ||
2e00: 6d 65 67 61 74 65 73 74 20 2d 73 65 72 76 65 72 megatest -server
2e10: 20 2d 20 2d 64 61 65 6d 6f 6e 69 7a 65 20 26 26 - -daemonize &&
2e20: 20 73 6c 65 65 70 20 33 22 29 0a 09 09 09 20 20 sleep 3")....
2e30: 3b 3b 20 28 70 72 6f 63 65 73 73 2d 66 6f 72 6b ;; (process-fork
2e40: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 (lambda ()....
2e50: 20 3b 3b 20 20 20 20 20 20 20 09 20 20 28 64 61 ;; . (da
2e60: 65 6d 6f 6e 3a 69 7a 65 29 0a 09 09 09 20 20 3b emon:ize).... ;
2e70: 3b 20 20 20 20 20 20 20 09 20 20 28 73 65 72 76 ; . (serv
2e80: 65 72 3a 6c 61 75 6e 63 68 20 28 73 74 72 69 6e er:launch (strin
2e90: 67 2d 3e 73 79 6d 62 6f 6c 20 28 61 72 67 73 3a g->symbol (args:
2ea0: 67 65 74 2d 61 72 67 20 22 2d 74 72 61 6e 73 70 get-arg "-transp
2eb0: 6f 72 74 22 20 22 68 74 74 70 22 29 29 29 29 29 ort" "http")))))
2ec0: 0a 09 09 09 20 20 3b 3b 20 28 74 68 72 65 61 64 .... ;; (thread
2ed0: 2d 73 6c 65 65 70 21 20 33 29 0a 09 09 09 20 20 -sleep! 3)....
2ee0: 29 0a 09 09 09 28 62 65 67 69 6e 0a 09 09 09 20 )....(begin....
2ef0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
2f00: 66 6f 20 30 20 22 57 61 69 74 69 6e 67 20 66 6f fo 0 "Waiting fo
2f10: 72 20 73 65 72 76 65 72 20 74 6f 20 73 74 61 72 r server to star
2f20: 74 22 29 0a 09 09 09 20 20 28 74 68 72 65 61 64 t").... (thread
2f30: 2d 73 6c 65 65 70 21 20 34 29 29 29 0a 09 09 20 -sleep! 4)))...
2f40: 20 20 20 28 69 66 20 28 3c 20 74 72 79 63 6f 75 (if (< trycou
2f50: 6e 74 20 31 30 29 0a 09 09 09 28 6c 6f 6f 70 20 nt 10)....(loop
2f60: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
2f70: 74 61 73 6b 73 3a 67 65 74 2d 62 65 73 74 2d 73 tasks:get-best-s
2f80: 65 72 76 65 72 20 74 61 73 6b 73 3a 6f 70 65 6e erver tasks:open
2f90: 2d 64 62 29 20 0a 09 09 09 20 20 20 20 20 20 28 -db) .... (
2fa0: 2b 20 74 72 79 63 6f 75 6e 74 20 31 29 29 0a 09 + trycount 1))..
2fb0: 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ..(debug:print 0
2fc0: 20 22 57 41 52 4e 49 4e 47 3a 20 43 6f 75 6c 64 "WARNING: Could
2fd0: 6e 27 74 20 73 74 61 72 74 20 6f 72 20 66 69 6e n't start or fin
2fe0: 64 20 61 20 73 65 72 76 65 72 2e 22 29 29 29 0a d a server."))).
2ff0: 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
3000: 20 30 20 22 49 4e 46 4f 3a 20 53 65 72 76 65 72 0 "INFO: Server
3010: 28 73 29 20 72 75 6e 6e 69 6e 67 20 22 20 73 65 (s) running " se
3020: 72 76 65 72 73 29 0a 09 09 20 20 29 29 29 29 29 rvers)... )))))
3030: 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a ..(if (or (args:
3040: 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 73 get-arg "-list-s
3050: 65 72 76 65 72 73 22 29 0a 09 28 61 72 67 73 3a ervers")..(args:
3060: 67 65 74 2d 61 72 67 20 22 2d 73 74 6f 70 2d 73 get-arg "-stop-s
3070: 65 72 76 65 72 22 29 29 0a 20 20 20 20 28 6c 65 erver")). (le
3080: 74 20 28 28 74 6c 20 28 73 65 74 75 70 2d 66 6f t ((tl (setup-fo
3090: 72 2d 72 75 6e 29 29 29 0a 20 20 20 20 20 20 28 r-run))). (
30a0: 69 66 20 74 6c 20 0a 09 20 20 28 6c 65 74 2a 20 if tl .. (let*
30b0: 28 28 73 65 72 76 65 72 73 20 28 6f 70 65 6e 2d ((servers (open-
30c0: 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a run-close tasks:
30d0: 67 65 74 2d 61 6c 6c 2d 73 65 72 76 65 72 73 20 get-all-servers
30e0: 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 29 0a tasks:open-db)).
30f0: 09 09 20 28 66 6d 74 73 74 72 20 20 22 7e 35 61 .. (fmtstr "~5a
3100: 7e 38 61 7e 38 61 7e 32 30 61 7e 32 30 61 7e 31 ~8a~8a~20a~20a~1
3110: 30 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 0a~10a~10a~10a~1
3120: 30 61 5c 6e 22 29 0a 09 09 20 28 73 65 72 76 65 0a\n")... (serve
3130: 72 73 2d 74 6f 2d 6b 69 6c 6c 20 27 28 29 29 0a rs-to-kill '()).
3140: 09 09 20 28 6b 69 6c 6c 69 6e 66 6f 20 20 20 28 .. (killinfo (
3150: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
3160: 74 6f 70 2d 73 65 72 76 65 72 22 29 29 0a 09 09 top-server"))...
3170: 20 28 6b 68 6f 73 74 2d 70 6f 72 74 20 28 69 66 (khost-port (if
3180: 20 6b 69 6c 6c 69 6e 66 6f 20 28 69 66 20 28 73 killinfo (if (s
3190: 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 ubstring-index "
31a0: 3a 22 20 6b 69 6c 6c 69 6e 66 6f 29 28 73 74 72 :" killinfo)(str
31b0: 69 6e 67 2d 73 70 6c 69 74 20 22 3a 22 29 20 23 ing-split ":") #
31c0: 66 29 20 23 66 29 29 0a 09 09 20 28 73 69 64 20 f) #f))... (sid
31d0: 20 20 20 20 20 20 20 28 69 66 20 6b 69 6c 6c 69 (if killi
31e0: 6e 66 6f 20 28 69 66 20 28 73 75 62 73 74 72 69 nfo (if (substri
31f0: 6e 67 2d 69 6e 64 65 78 20 22 3a 22 20 6b 69 6c ng-index ":" kil
3200: 6c 69 6e 66 6f 29 20 23 66 20 28 73 74 72 69 6e linfo) #f (strin
3210: 67 2d 3e 6e 75 6d 62 65 72 20 6b 69 6c 6c 69 6e g->number killin
3220: 66 6f 29 29 20 23 66 29 29 29 0a 09 20 20 20 20 fo)) #f)))..
3230: 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 74 (format #t fmtst
3240: 72 20 22 49 64 22 20 22 4d 54 76 65 72 22 20 22 r "Id" "MTver" "
3250: 50 69 64 22 20 22 48 6f 73 74 22 20 22 49 6e 74 Pid" "Host" "Int
3260: 65 72 66 61 63 65 22 20 22 4f 75 74 50 6f 72 74 erface" "OutPort
3270: 22 20 22 49 6e 50 6f 72 74 22 20 22 4c 61 73 74 " "InPort" "Last
3280: 42 65 61 74 22 20 22 53 74 61 74 65 22 20 22 54 Beat" "State" "T
3290: 72 61 6e 73 70 6f 72 74 22 29 0a 09 20 20 20 20 ransport")..
32a0: 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 74 (format #t fmtst
32b0: 72 20 22 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 r "==" "=====" "
32c0: 3d 3d 3d 22 20 22 3d 3d 3d 3d 22 20 22 3d 3d 3d ===" "====" "===
32d0: 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d ======" "=======
32e0: 22 20 22 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d " "======" "====
32f0: 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d ====" "=====" "=
3300: 3d 3d 3d 3d 3d 3d 3d 3d 22 29 0a 09 20 20 20 20 ========")..
3310: 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 20 (for-each ..
3320: 20 28 6c 61 6d 62 64 61 20 28 73 65 72 76 65 72 (lambda (server
3330: 29 0a 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 ).. (let*
3340: 28 28 69 64 20 20 20 20 20 20 20 20 20 28 76 65 ((id (ve
3350: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
3360: 30 29 29 0a 09 09 20 20 20 20 20 20 28 70 69 64 0))... (pid
3370: 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d (vector-
3380: 72 65 66 20 73 65 72 76 65 72 20 31 29 29 0a 09 ref server 1))..
3390: 09 20 20 20 20 20 20 28 68 6f 73 74 6e 61 6d 65 . (hostname
33a0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
33b0: 65 72 76 65 72 20 32 29 29 0a 09 09 20 20 20 20 erver 2))...
33c0: 20 20 28 69 6e 74 65 72 66 61 63 65 20 20 28 76 (interface (v
33d0: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
33e0: 20 33 29 29 0a 09 09 20 20 20 20 20 20 28 70 75 3))... (pu
33f0: 6c 6c 70 6f 72 74 20 20 20 28 76 65 63 74 6f 72 llport (vector
3400: 2d 72 65 66 20 73 65 72 76 65 72 20 34 29 29 0a -ref server 4)).
3410: 09 09 20 20 20 20 20 20 28 70 75 62 70 6f 72 74 .. (pubport
3420: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
3430: 73 65 72 76 65 72 20 35 29 29 0a 09 09 20 20 20 server 5))...
3440: 20 20 20 28 73 74 61 72 74 2d 74 69 6d 65 20 28 (start-time (
3450: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
3460: 72 20 36 29 29 0a 09 09 20 20 20 20 20 20 28 70 r 6))... (p
3470: 72 69 6f 72 69 74 79 20 20 20 28 76 65 63 74 6f riority (vecto
3480: 72 2d 72 65 66 20 73 65 72 76 65 72 20 37 29 29 r-ref server 7))
3490: 0a 09 09 20 20 20 20 20 20 28 73 74 61 74 65 20 ... (state
34a0: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref
34b0: 20 73 65 72 76 65 72 20 38 29 29 0a 09 09 20 20 server 8))...
34c0: 20 20 20 20 28 6d 74 2d 76 65 72 20 20 20 20 20 (mt-ver
34d0: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 (vector-ref serv
34e0: 65 72 20 39 29 29 0a 09 09 20 20 20 20 20 20 28 er 9))... (
34f0: 6c 61 73 74 2d 75 70 64 61 74 65 20 28 76 65 63 last-update (vec
3500: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 tor-ref server 1
3510: 30 29 29 20 3b 3b 20 20 20 28 6f 70 65 6e 2d 72 0)) ;; (open-r
3520: 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 73 un-close tasks:s
3530: 65 72 76 65 72 2d 61 6c 69 76 65 3f 20 74 61 73 erver-alive? tas
3540: 6b 73 3a 6f 70 65 6e 2d 64 62 20 23 66 20 68 6f ks:open-db #f ho
3550: 73 74 6e 61 6d 65 3a 20 68 6f 73 74 6e 61 6d 65 stname: hostname
3560: 20 70 6f 72 74 3a 20 70 6f 72 74 29 29 0a 09 09 port: port))...
3570: 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 (transport
3580: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
3590: 72 76 65 72 20 31 31 29 29 0a 09 09 20 20 20 20 rver 11))...
35a0: 20 20 28 6b 69 6c 6c 65 64 20 20 20 20 20 23 66 (killed #f
35b0: 29 0a 09 09 20 20 20 20 20 20 28 73 74 61 74 75 )... (statu
35c0: 73 20 20 20 20 20 28 3c 20 6c 61 73 74 2d 75 70 s (< last-up
35d0: 64 61 74 65 20 32 30 29 29 29 0a 09 09 20 3b 3b date 20)))... ;;
35e0: 20 20 20 28 7a 6d 71 2d 73 6f 63 6b 65 74 73 20 (zmq-sockets
35f0: 28 69 66 20 73 74 61 74 75 73 20 28 73 65 72 76 (if status (serv
3600: 65 72 3a 63 6c 69 65 6e 74 2d 63 6f 6e 6e 65 63 er:client-connec
3610: 74 20 68 6f 73 74 6e 61 6d 65 20 70 6f 72 74 29 t hostname port)
3620: 20 23 66 29 29 29 0a 09 09 20 3b 3b 20 6e 6f 20 #f)))... ;; no
3630: 6e 65 65 64 20 74 6f 20 6c 6f 67 69 6e 20 61 73 need to login as
3640: 20 73 74 61 74 75 73 20 6f 66 20 23 74 20 69 6e status of #t in
3650: 64 69 63 61 74 65 73 20 77 65 20 61 72 65 20 63 dicates we are c
3660: 6f 6e 6e 65 63 74 69 6e 67 20 74 6f 20 63 6f 72 onnecting to cor
3670: 72 65 63 74 20 0a 09 09 20 3b 3b 20 73 65 72 76 rect ... ;; serv
3680: 65 72 0a 09 09 20 28 69 66 20 28 65 71 75 61 6c er... (if (equal
3690: 3f 20 73 74 61 74 65 20 22 64 65 61 64 22 29 0a ? state "dead").
36a0: 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 6c 61 .. (if (> la
36b0: 73 74 2d 75 70 64 61 74 65 20 28 2a 20 32 35 20 st-update (* 25
36c0: 36 30 20 36 30 29 29 20 3b 3b 20 6b 65 65 70 20 60 60)) ;; keep
36d0: 72 65 63 6f 72 64 73 20 61 72 6f 75 6e 64 20 66 records around f
36e0: 6f 72 20 73 6c 69 67 68 6c 79 20 6f 76 65 72 20 or slighly over
36f0: 61 20 64 61 79 2e 0a 09 09 09 20 28 6f 70 65 6e a day..... (open
3700: 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 -run-close tasks
3710: 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 :server-deregist
3720: 65 72 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 er tasks:open-db
3730: 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 6f hostname pullpo
3740: 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 70 69 64 rt: pullport pid
3750: 3a 20 70 69 64 20 61 63 74 69 6f 6e 3a 20 27 64 : pid action: 'd
3760: 65 6c 65 74 65 29 29 0a 09 09 20 20 20 20 20 28 elete))... (
3770: 69 66 20 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 if (> last-updat
3780: 65 20 32 30 29 20 20 20 20 20 20 20 20 3b 3b 20 e 20) ;;
3790: 4d 61 72 6b 20 61 73 20 64 65 61 64 20 69 66 20 Mark as dead if
37a0: 6e 6f 74 20 75 70 64 61 74 65 64 20 69 6e 20 6c not updated in l
37b0: 61 73 74 20 32 30 20 73 65 63 6f 6e 64 73 0a 09 ast 20 seconds..
37c0: 09 09 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f .. (open-run-clo
37d0: 73 65 20 74 61 73 6b 73 3a 73 65 72 76 65 72 2d se tasks:server-
37e0: 64 65 72 65 67 69 73 74 65 72 20 74 61 73 6b 73 deregister tasks
37f0: 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 74 6e 61 6d :open-db hostnam
3800: 65 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 6c 6c e pullport: pull
3810: 70 6f 72 74 20 70 69 64 3a 20 70 69 64 29 29 29 port pid: pid)))
3820: 0a 09 09 20 28 66 6f 72 6d 61 74 20 23 74 20 66 ... (format #t f
3830: 6d 74 73 74 72 20 69 64 20 6d 74 2d 76 65 72 20 mtstr id mt-ver
3840: 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 69 6e 74 pid hostname int
3850: 65 72 66 61 63 65 20 70 75 6c 6c 70 6f 72 74 20 erface pullport
3860: 70 75 62 70 6f 72 74 20 6c 61 73 74 2d 75 70 64 pubport last-upd
3870: 61 74 65 0a 09 09 09 20 28 69 66 20 73 74 61 74 ate.... (if stat
3880: 75 73 20 22 61 6c 69 76 65 22 20 22 64 65 61 64 us "alive" "dead
3890: 22 29 20 74 72 61 6e 73 70 6f 72 74 29 0a 09 09 ") transport)...
38a0: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 64 20 (if (equal? id
38b0: 73 69 64 29 0a 09 09 20 20 20 20 20 28 62 65 67 sid)... (beg
38c0: 69 6e 0a 09 09 20 20 20 20 20 20 20 28 64 65 62 in... (deb
38d0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
38e0: 22 41 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 73 "Attempting to s
38f0: 74 6f 70 20 73 65 72 76 65 72 20 77 69 74 68 20 top server with
3900: 70 69 64 20 22 20 70 69 64 29 0a 09 09 20 20 20 pid " pid)...
3910: 20 20 20 20 28 74 61 73 6b 73 3a 6b 69 6c 6c 2d (tasks:kill-
3920: 73 65 72 76 65 72 20 73 74 61 74 75 73 20 68 6f server status ho
3930: 73 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 74 20 stname pullport
3940: 70 69 64 20 74 72 61 6e 73 70 6f 72 74 29 29 29 pid transport)))
3950: 29 29 0a 09 20 20 20 20 20 73 65 72 76 65 72 73 )).. servers
3960: 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ).. (debug:pr
3970: 69 6e 74 2d 69 6e 66 6f 20 31 20 22 44 6f 6e 65 int-info 1 "Done
3980: 20 77 69 74 68 20 6c 69 73 74 73 65 72 76 65 72 with listserver
3990: 73 22 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a s").. (set! *
39a0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
39b0: 29 0a 09 20 20 20 20 28 65 78 69 74 29 29 20 3b ).. (exit)) ;
39c0: 3b 20 6d 75 73 74 20 64 6f 2c 20 77 6f 75 6c 64 ; must do, would
39d0: 20 68 61 76 65 20 74 6f 20 61 64 64 20 63 68 65 have to add che
39e0: 63 6b 73 20 74 6f 20 6d 61 6e 79 2f 61 6c 6c 20 cks to many/all
39f0: 63 61 6c 6c 73 20 62 65 6c 6f 77 0a 09 20 20 28 calls below.. (
3a00: 65 78 69 74 29 29 29 0a 20 20 20 20 3b 3b 20 69 exit))). ;; i
3a10: 66 20 6e 6f 74 20 6c 69 73 74 20 6f 72 20 6b 69 f not list or ki
3a20: 6c 6c 20 74 68 65 6e 20 73 74 61 72 74 20 61 20 ll then start a
3a30: 63 6c 69 65 6e 74 20 28 69 66 20 61 70 70 72 6f client (if appro
3a40: 70 72 69 61 74 65 29 0a 20 20 20 20 28 69 66 20 priate). (if
3a50: 28 6f 72 20 28 61 72 67 73 2d 64 65 66 69 6e 65 (or (args-define
3a60: 64 3f 20 22 2d 68 22 20 22 2d 76 65 72 73 69 6f d? "-h" "-versio
3a70: 6e 22 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 n" "-gen-megates
3a80: 74 2d 61 72 65 61 22 20 22 2d 67 65 6e 2d 6d 65 t-area" "-gen-me
3a90: 67 61 74 65 73 74 2d 74 65 73 74 22 29 0a 09 20 gatest-test")..
3aa0: 20 20 20 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 (eq? (length
3ab0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
3ac0: 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 args:arg-hash))
3ad0: 20 30 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 0))..(debug:pri
3ae0: 6e 74 2d 69 6e 66 6f 20 31 20 22 53 65 72 76 65 nt-info 1 "Serve
3af0: 72 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 6e 6f 74 r connection not
3b00: 20 6e 65 65 64 65 64 22 29 0a 09 3b 3b 20 6f 6b needed")..;; ok
3b10: 2c 20 73 6f 20 6c 65 74 73 20 63 6f 6e 6e 65 63 , so lets connec
3b20: 74 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 0a t to the server.
3b30: 09 28 63 6c 69 65 6e 74 3a 6c 61 75 6e 63 68 29 .(client:launch)
3b40: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
3b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
3b90: 57 65 69 72 64 20 73 70 65 63 69 61 6c 20 63 61 Weird special ca
3ba0: 6c 6c 73 20 74 68 61 74 20 6e 65 65 64 20 74 6f lls that need to
3bb0: 20 72 75 6e 20 2a 61 66 74 65 72 2a 20 74 68 65 run *after* the
3bc0: 20 73 65 72 76 65 72 20 68 61 73 20 73 74 61 72 server has star
3bd0: 74 65 64 3f 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ted?.;;=========
3be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
3c20: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
3c30: 20 22 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 22 "-list-targets"
3c40: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 61 72 ). (let ((tar
3c50: 67 65 74 73 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 gets (common:get
3c60: 2d 72 75 6e 63 6f 6e 66 69 67 2d 74 61 72 67 65 -runconfig-targe
3c70: 74 73 29 29 29 0a 20 20 20 20 20 20 28 70 72 69 ts))). (pri
3c80: 6e 74 20 22 46 6f 75 6e 64 20 22 28 6c 65 6e 67 nt "Found "(leng
3c90: 74 68 20 74 61 72 67 65 74 73 29 20 22 20 74 61 th targets) " ta
3ca0: 72 67 65 74 73 22 29 0a 20 20 20 20 20 20 28 66 rgets"). (f
3cb0: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
3cc0: 28 78 29 0a 09 09 20 20 3b 3b 20 28 70 72 69 6e (x)... ;; (prin
3cd0: 74 20 22 5b 22 20 78 20 22 5d 22 29 29 0a 09 09 t "[" x "]"))...
3ce0: 20 20 28 70 72 69 6e 74 20 78 29 29 0a 09 09 74 (print x))...t
3cf0: 61 72 67 65 74 73 29 0a 20 20 20 20 20 20 28 73 argets). (s
3d00: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
3d10: 67 2a 20 23 74 29 29 29 0a 0a 28 64 65 66 69 6e g* #t)))..(defin
3d20: 65 20 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e 66 69 e (full-runconfi
3d30: 67 73 2d 72 65 61 64 29 0a 20 20 28 6c 65 74 2a gs-read). (let*
3d40: 20 28 28 6b 65 79 73 20 20 20 28 63 64 62 3a 72 ((keys (cdb:r
3d50: 65 6d 6f 74 65 2d 72 75 6e 20 67 65 74 2d 6b 65 emote-run get-ke
3d60: 79 73 20 23 66 29 29 0a 09 20 28 74 61 72 67 65 ys #f)).. (targe
3d70: 74 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d t (if (args:get-
3d80: 61 72 67 20 22 2d 72 65 71 74 61 72 67 22 29 0a arg "-reqtarg").
3d90: 09 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 .. (args:get
3da0: 2d 61 72 67 20 22 2d 72 65 71 74 61 72 67 22 29 -arg "-reqtarg")
3db0: 0a 09 09 20 20 20 20 20 28 69 66 20 28 61 72 67 ... (if (arg
3dc0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 s:get-arg "-targ
3dd0: 65 74 22 29 0a 09 09 09 20 28 61 72 67 73 3a 67 et").... (args:g
3de0: 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 et-arg "-target"
3df0: 29 0a 09 09 09 20 23 66 29 29 29 0a 09 20 28 6b ).... #f))).. (k
3e00: 65 79 2d 76 61 6c 73 20 28 69 66 20 74 61 72 67 ey-vals (if targ
3e10: 65 74 20 28 6b 65 79 73 3a 74 61 72 67 65 74 2d et (keys:target-
3e20: 3e 6b 65 79 76 61 6c 20 6b 65 79 73 20 74 61 72 >keyval keys tar
3e30: 67 65 74 29 20 23 66 29 29 0a 09 20 28 73 65 63 get) #f)).. (sec
3e40: 74 69 6f 6e 73 20 28 69 66 20 74 61 72 67 65 74 tions (if target
3e50: 20 28 6c 69 73 74 20 22 64 65 66 61 75 6c 74 22 (list "default"
3e60: 20 74 61 72 67 65 74 29 20 23 66 29 29 0a 09 20 target) #f))..
3e70: 28 64 61 74 61 20 20 20 20 20 28 62 65 67 69 6e (data (begin
3e80: 0a 09 09 20 20 20 20 20 28 73 65 74 65 6e 76 20 ... (setenv
3e90: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
3ea0: 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 09 E" *toppath*)...
3eb0: 20 20 20 20 20 28 69 66 20 6b 65 79 2d 76 61 6c (if key-val
3ec0: 73 0a 09 09 09 20 28 66 6f 72 2d 65 61 63 68 20 s.... (for-each
3ed0: 28 6c 61 6d 62 64 61 20 28 6b 74 29 0a 09 09 09 (lambda (kt)....
3ee0: 09 20 20 20 20 20 28 73 65 74 65 6e 76 20 28 63 . (setenv (c
3ef0: 61 72 20 6b 74 29 20 28 63 61 64 72 20 6b 74 29 ar kt) (cadr kt)
3f00: 29 29 0a 09 09 09 09 20 20 20 6b 65 79 2d 76 61 ))..... key-va
3f10: 6c 73 29 29 0a 09 09 20 20 20 20 20 28 72 65 61 ls))... (rea
3f20: 64 2d 63 6f 6e 66 69 67 20 22 72 75 6e 63 6f 6e d-config "runcon
3f30: 66 69 67 73 2e 63 6f 6e 66 69 67 22 20 23 66 20 figs.config" #f
3f40: 23 74 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 #t sections: sec
3f50: 74 69 6f 6e 73 29 29 29 29 0a 20 20 20 20 64 61 tions)))). da
3f60: 74 61 29 29 0a 0a 0a 28 69 66 20 28 61 72 67 73 ta))...(if (args
3f70: 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d :get-arg "-show-
3f80: 72 75 6e 63 6f 6e 66 69 67 22 29 0a 20 20 20 20 runconfig").
3f90: 28 6c 65 74 20 28 28 64 61 74 61 20 28 66 75 6c (let ((data (ful
3fa0: 6c 2d 72 75 6e 63 6f 6e 66 69 67 73 2d 72 65 61 l-runconfigs-rea
3fb0: 64 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6b 65 d))). ;; ke
3fc0: 65 70 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 ep this one loca
3fd0: 6c 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 l. (cond.
3fe0: 20 20 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 ((not (args
3ff0: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
4000: 6f 64 65 22 29 29 0a 09 28 70 70 20 28 68 61 73 ode"))..(pp (has
4010: 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 64 h-table->alist d
4020: 61 74 61 29 29 29 0a 20 20 20 20 20 20 20 28 28 ata))). ((
4030: 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 string=? (args:g
4040: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
4050: 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 28 6a 73 e") "json")..(js
4060: 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 29 29 0a on-write data)).
4070: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 64 (else..(d
4080: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
4090: 52 4f 52 3a 20 2d 64 75 6d 70 6d 6f 64 65 20 6f ROR: -dumpmode o
40a0: 66 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 f " (args:get-ar
40b0: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
40c0: 20 6e 6f 74 20 72 65 63 6f 67 6e 69 73 65 64 22 not recognised"
40d0: 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ))). (set!
40e0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
40f0: 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a t)))..(if (args:
4100: 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 get-arg "-show-c
4110: 6f 6e 66 69 67 22 29 0a 20 20 20 20 28 6c 65 74 onfig"). (let
4120: 20 28 28 64 61 74 61 20 2a 63 6f 6e 66 69 67 64 ((data *configd
4130: 61 74 2a 29 29 20 3b 3b 20 28 72 65 61 64 2d 63 at*)) ;; (read-c
4140: 6f 6e 66 69 67 20 22 6d 65 67 61 74 65 73 74 2e onfig "megatest.
4150: 63 6f 6e 66 69 67 22 20 23 66 20 23 74 29 29 29 config" #f #t)))
4160: 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 . ;; keep t
4170: 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 his one local.
4180: 20 20 20 20 28 63 6f 6e 64 20 0a 20 20 20 20 20 (cond .
4190: 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 ((not (args:ge
41a0: 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 t-arg "-dumpmode
41b0: 22 29 29 0a 09 28 70 70 20 28 68 61 73 68 2d 74 "))..(pp (hash-t
41c0: 61 62 6c 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 able->alist data
41d0: 29 29 29 0a 20 20 20 20 20 20 20 28 28 73 74 72 ))). ((str
41e0: 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d ing=? (args:get-
41f0: 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 arg "-dumpmode")
4200: 20 22 6a 73 6f 6e 22 29 0a 09 28 6a 73 6f 6e 2d "json")..(json-
4210: 77 72 69 74 65 20 64 61 74 61 29 29 0a 20 20 20 write data)).
4220: 20 20 20 20 28 65 6c 73 65 0a 09 28 64 65 62 75 (else..(debu
4230: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
4240: 3a 20 2d 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 : -dumpmode of "
4250: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4260: 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f -dumpmode") " no
4270: 74 20 72 65 63 6f 67 6e 69 73 65 64 22 29 29 29 t recognised")))
4280: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
4290: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
42a0: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
42b0: 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 6d 64 69 -arg "-show-cmdi
42c0: 6e 66 6f 22 29 0a 20 20 20 20 28 6c 65 74 20 28 nfo"). (let (
42d0: 28 64 61 74 61 20 28 72 65 61 64 20 28 6f 70 65 (data (read (ope
42e0: 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 n-input-string (
42f0: 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 base64:base64-de
4300: 63 6f 64 65 20 28 67 65 74 65 6e 76 20 22 4d 54 code (getenv "MT
4310: 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 29 0a _CMDINFO")))))).
4320: 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c (if (equal
4330: 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ? (args:get-arg
4340: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 "-dumpmode") "js
4350: 6f 6e 22 29 0a 09 20 20 28 6a 73 6f 6e 2d 77 72 on").. (json-wr
4360: 69 74 65 20 64 61 74 61 29 0a 09 20 20 28 70 70 ite data).. (pp
4370: 20 64 61 74 61 29 29 0a 20 20 20 20 20 20 28 73 data)). (s
4380: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
4390: 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d g* #t)))..;;====
43a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
43b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
43c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
43d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
43e0: 3d 3d 0a 3b 3b 20 52 65 6d 6f 76 65 20 6f 6c 64 ==.;; Remove old
43f0: 20 72 75 6e 28 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d run(s).;;======
4400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4440: 0a 0a 3b 3b 20 73 69 6e 63 65 20 73 65 76 65 72 ..;; since sever
4450: 61 6c 20 61 63 74 69 6f 6e 73 20 63 61 6e 20 62 al actions can b
4460: 65 20 73 70 65 63 69 66 69 65 64 20 6f 6e 20 74 e specified on t
4470: 68 65 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 he command line
4480: 74 68 65 20 72 65 6d 6f 76 61 6c 0a 3b 3b 20 69 the removal.;; i
4490: 73 20 64 6f 6e 65 20 66 69 72 73 74 0a 28 64 65 s done first.(de
44a0: 66 69 6e 65 20 28 6f 70 65 72 61 74 65 2d 6f 6e fine (operate-on
44b0: 20 61 63 74 69 6f 6e 29 0a 20 20 28 63 6f 6e 64 action). (cond
44c0: 0a 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a . ((not (args:
44d0: 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d get-arg ":runnam
44e0: 65 22 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a e")). (debug:
44f0: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
4500: 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 Missing required
4510: 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 parameter for "
4520: 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d action ", you m
4530: 75 73 74 20 73 70 65 63 69 66 79 20 74 68 65 20 ust specify the
4540: 72 75 6e 20 6e 61 6d 65 20 70 61 74 74 65 72 6e run name pattern
4550: 20 77 69 74 68 20 3a 72 75 6e 6e 61 6d 65 20 70 with :runname p
4560: 61 74 74 22 29 0a 20 20 20 20 28 65 78 69 74 20 att"). (exit
4570: 32 29 29 0a 20 20 20 28 28 6e 6f 74 20 28 61 72 2)). ((not (ar
4580: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
4590: 74 70 61 74 74 22 29 29 0a 20 20 20 20 28 64 65 tpatt")). (de
45a0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
45b0: 4f 52 3a 20 4d 69 73 73 69 6e 67 20 72 65 71 75 OR: Missing requ
45c0: 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 ired parameter f
45d0: 6f 72 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 or " action ", y
45e0: 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 ou must specify
45f0: 74 68 65 20 74 65 73 74 20 70 61 74 74 65 72 6e the test pattern
4600: 20 77 69 74 68 20 2d 74 65 73 74 70 61 74 74 22 with -testpatt"
4610: 29 0a 20 20 20 20 28 65 78 69 74 20 33 29 29 0a ). (exit 3)).
4620: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 28 69 66 (else. (if
4630: 20 28 6e 6f 74 20 28 63 61 72 20 2a 63 6f 6e 66 (not (car *conf
4640: 69 67 69 6e 66 6f 2a 29 29 0a 09 28 62 65 67 69 iginfo*))..(begi
4650: 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e n.. (debug:prin
4660: 74 20 30 20 22 45 52 52 4f 52 3a 20 41 74 74 65 t 0 "ERROR: Atte
4670: 6d 70 74 65 64 20 22 20 61 63 74 69 6f 6e 20 22 mpted " action "
4680: 6f 6e 20 74 65 73 74 28 73 29 20 62 75 74 20 72 on test(s) but r
4690: 75 6e 20 61 72 65 61 20 63 6f 6e 66 69 67 20 66 un area config f
46a0: 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a ile not found").
46b0: 09 20 20 28 65 78 69 74 20 31 29 29 0a 09 3b 3b . (exit 1))..;;
46c0: 20 70 75 74 20 74 65 73 74 20 70 61 72 61 6d 65 put test parame
46d0: 74 65 72 73 20 69 6e 74 6f 20 63 6f 6e 76 65 6e ters into conven
46e0: 69 65 6e 74 20 76 61 72 69 61 62 6c 65 73 0a 09 ient variables..
46f0: 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e (runs:operate-on
4700: 20 20 61 63 74 69 6f 6e 0a 09 09 09 20 20 28 61 action.... (a
4710: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 rgs:get-arg ":ru
4720: 6e 6e 61 6d 65 22 29 0a 09 09 09 20 20 28 61 72 nname").... (ar
4730: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
4740: 74 70 61 74 74 22 29 0a 09 09 09 20 20 73 74 61 tpatt").... sta
4750: 74 65 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 te: (args:get-ar
4760: 67 20 22 3a 73 74 61 74 65 22 29 20 0a 09 09 09 g ":state") ....
4770: 20 20 73 74 61 74 75 73 3a 20 28 61 72 67 73 3a status: (args:
4780: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 get-arg ":status
4790: 22 29 0a 09 09 09 20 20 6e 65 77 2d 73 74 61 74 ").... new-stat
47a0: 65 2d 73 74 61 74 75 73 3a 20 28 61 72 67 73 3a e-status: (args:
47b0: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 74 get-arg "-set-st
47c0: 61 74 65 2d 73 74 61 74 75 73 22 29 29 29 0a 20 ate-status"))).
47d0: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
47e0: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 09 ething* #t))))..
47f0: 20 20 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 .(if (args:get
4800: 2d 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d 72 75 -arg "-remove-ru
4810: 6e 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 ns"). (genera
4820: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 l-run-call .
4830: 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 0a "-remove-runs".
4840: 20 20 20 20 20 22 72 65 6d 6f 76 65 20 72 75 6e "remove run
4850: 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 s". (lambda
4860: 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 (target runname
4870: 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 keys keynames ke
4880: 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 20 20 20 yvallst).
4890: 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 72 65 6d (operate-on 'rem
48a0: 6f 76 65 2d 72 75 6e 73 29 29 29 29 0a 0a 28 69 ove-runs))))..(i
48b0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
48c0: 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 "-set-state-stat
48d0: 75 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 us"). (genera
48e0: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 l-run-call .
48f0: 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 "-set-state-sta
4900: 74 75 73 22 0a 20 20 20 20 20 22 73 65 74 20 73 tus". "set s
4910: 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 73 22 tate and status"
4920: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 . (lambda (t
4930: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 arget runname ke
4940: 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 ys keynames keyv
4950: 61 6c 6c 73 74 29 0a 20 20 20 20 20 20 20 28 6f allst). (o
4960: 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 perate-on 'set-s
4970: 74 61 74 65 2d 73 74 61 74 75 73 29 29 29 29 0a tate-status)))).
4980: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
4990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
49a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
49b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
49c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 75 65 =========.;; Que
49d0: 72 79 20 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d ry runs.;;======
49e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
49f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4a20: 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a ..(if (or (args:
4a30: 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 get-arg "-list-r
4a40: 75 6e 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 uns")..(args:get
4a50: 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 -arg "-list-db-t
4a60: 61 72 67 65 74 73 22 29 29 0a 20 20 20 20 28 69 argets")). (i
4a70: 66 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e f (setup-for-run
4a80: 29 0a 09 28 6c 65 74 2a 20 28 28 64 62 20 20 20 )..(let* ((db
4a90: 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 #f)..
4aa0: 28 72 75 6e 70 61 74 74 20 20 28 61 72 67 73 3a (runpatt (args:
4ab0: 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 get-arg "-list-r
4ac0: 75 6e 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 uns")).. (
4ad0: 74 65 73 74 70 61 74 74 20 28 69 66 20 28 61 72 testpatt (if (ar
4ae0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
4af0: 74 70 61 74 74 22 29 20 0a 09 09 09 20 20 20 20 tpatt") ....
4b00: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4b10: 2d 74 65 73 74 70 61 74 74 22 29 20 0a 09 09 09 -testpatt") ....
4b20: 20 20 20 20 20 22 25 22 29 29 0a 09 20 20 20 20 "%"))..
4b30: 20 20 20 28 72 75 6e 73 64 61 74 20 20 28 63 64 (runsdat (cd
4b40: 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a b:remote-run db:
4b50: 67 65 74 2d 72 75 6e 73 20 23 66 20 72 75 6e 70 get-runs #f runp
4b60: 61 74 74 20 23 66 20 23 66 20 27 28 29 29 29 0a att #f #f '())).
4b70: 09 20 20 20 20 20 20 20 28 72 75 6e 73 20 20 20 . (runs
4b80: 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 (db:get-rows r
4b90: 75 6e 73 64 61 74 29 29 0a 09 20 20 20 20 20 20 unsdat))..
4ba0: 20 28 68 65 61 64 65 72 20 20 20 28 64 62 3a 67 (header (db:g
4bb0: 65 74 2d 68 65 61 64 65 72 20 72 75 6e 73 64 61 et-header runsda
4bc0: 74 29 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 t)).. (key
4bd0: 73 20 20 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 s (cdb:remot
4be0: 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 79 e-run db:get-key
4bf0: 73 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 s #f)).. (
4c00: 6b 65 79 6e 61 6d 65 73 20 28 6d 61 70 20 6b 65 keynames (map ke
4c10: 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 y:get-fieldname
4c20: 6b 65 79 73 29 29 0a 09 20 20 20 20 20 20 20 28 keys)).. (
4c30: 64 62 2d 74 61 72 67 65 74 73 20 28 61 72 67 73 db-targets (args
4c40: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d :get-arg "-list-
4c50: 64 62 2d 74 61 72 67 65 74 73 22 29 29 0a 09 20 db-targets"))..
4c60: 20 20 20 20 20 20 28 73 65 65 6e 20 20 20 20 20 (seen
4c70: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
4c80: 29 29 29 0a 09 20 20 3b 3b 20 45 61 63 68 20 72 ))).. ;; Each r
4c90: 75 6e 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 20 un.. (for-each
4ca0: 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 .. (lambda (ru
4cb0: 6e 29 0a 09 20 20 20 20 20 28 6c 65 74 20 28 28 n).. (let ((
4cc0: 74 61 72 67 65 74 73 74 72 20 28 73 74 72 69 6e targetstr (strin
4cd0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m
4ce0: 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 ap (lambda (x)..
4cf0: 09 09 09 09 09 09 20 28 64 62 3a 67 65 74 2d 76 ...... (db:get-v
4d00: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
4d10: 75 6e 20 68 65 61 64 65 72 20 78 29 29 0a 09 09 un header x))...
4d20: 09 09 09 09 20 20 20 20 20 20 20 6b 65 79 6e 61 .... keyna
4d30: 6d 65 73 29 20 22 2f 22 29 29 29 0a 09 20 20 20 mes) "/")))..
4d40: 20 20 20 20 28 69 66 20 64 62 2d 74 61 72 67 65 (if db-targe
4d50: 74 73 0a 09 09 20 20 20 28 69 66 20 28 6e 6f 74 ts... (if (not
4d60: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
4d70: 2f 64 65 66 61 75 6c 74 20 73 65 65 6e 20 74 61 /default seen ta
4d80: 72 67 65 74 73 74 72 20 23 66 29 29 0a 09 09 20 rgetstr #f))...
4d90: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 (begin....
4da0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
4db0: 21 20 73 65 65 6e 20 74 61 72 67 65 74 73 74 72 ! seen targetstr
4dc0: 20 23 74 29 0a 09 09 09 20 3b 3b 20 28 70 72 69 #t).... ;; (pri
4dd0: 6e 74 20 22 5b 22 20 74 61 72 67 65 74 73 74 72 nt "[" targetstr
4de0: 20 22 5d 22 29 29 29 29 0a 09 09 09 20 28 70 72 "]")))).... (pr
4df0: 69 6e 74 20 74 61 72 67 65 74 73 74 72 29 29 29 int targetstr)))
4e00: 29 0a 09 20 20 20 20 20 20 20 28 69 66 20 28 6e ).. (if (n
4e10: 6f 74 20 64 62 2d 74 61 72 67 65 74 73 29 0a 09 ot db-targets)..
4e20: 09 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 2d . (let* ((run-
4e30: 69 64 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 id (db:get-value
4e40: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
4e50: 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 09 09 eader "id"))....
4e60: 20 20 28 74 65 73 74 73 20 20 28 63 64 62 3a 72 (tests (cdb:r
4e70: 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 emote-run db:get
4e80: 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 23 -tests-for-run #
4e90: 66 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 74 f run-id testpat
4ea0: 74 20 27 28 29 20 27 28 29 29 29 29 0a 09 09 20 t '() '())))...
4eb0: 20 20 20 20 28 70 72 69 6e 74 20 22 52 75 6e 3a (print "Run:
4ec0: 20 22 20 74 61 72 67 65 74 73 74 72 20 22 2f 22 " targetstr "/"
4ed0: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
4ee0: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
4ef0: 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 20 0a der "runname") .
4f00: 09 09 09 20 20 20 20 22 20 73 74 61 74 75 73 3a ... " status:
4f10: 20 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 " (db:get-value
4f20: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
4f30: 65 61 64 65 72 20 22 73 74 61 74 65 22 29 0a 09 eader "state")..
4f40: 09 09 20 20 20 20 22 20 72 75 6e 2d 69 64 3a 20 .. " run-id:
4f50: 22 20 72 75 6e 2d 69 64 20 22 2c 20 6e 75 6d 62 " run-id ", numb
4f60: 65 72 20 74 65 73 74 73 3a 20 22 20 28 6c 65 6e er tests: " (len
4f70: 67 74 68 20 74 65 73 74 73 29 29 0a 09 09 20 20 gth tests))...
4f80: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 (for-each ...
4f90: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 (lambda (t
4fa0: 65 73 74 29 0a 09 09 09 28 66 6f 72 6d 61 74 20 est)....(format
4fb0: 23 74 0a 09 09 09 09 22 20 20 54 65 73 74 3a 20 #t....." Test:
4fc0: 7e 32 35 61 20 53 74 61 74 65 3a 20 7e 31 35 61 ~25a State: ~15a
4fd0: 20 53 74 61 74 75 73 3a 20 7e 31 35 61 20 52 75 Status: ~15a Ru
4fe0: 6e 74 69 6d 65 3a 20 7e 35 40 61 73 20 54 69 6d ntime: ~5@as Tim
4ff0: 65 3a 20 7e 32 32 61 20 48 6f 73 74 3a 20 7e 31 e: ~22a Host: ~1
5000: 30 61 5c 6e 22 0a 09 09 09 09 28 63 6f 6e 63 20 0a\n".....(conc
5010: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 (db:test-get-tes
5020: 74 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 09 09 tname test).....
5030: 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c (if (equal
5040: 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 ? (db:test-get-i
5050: 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 20 22 tem-path test) "
5060: 22 29 0a 09 09 09 09 09 20 20 22 22 20 0a 09 09 ")...... "" ...
5070: 09 09 09 20 20 28 63 6f 6e 63 20 22 28 22 20 28 ... (conc "(" (
5080: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d db:test-get-item
5090: 2d 70 61 74 68 20 74 65 73 74 29 20 22 29 22 29 -path test) ")")
50a0: 29 29 0a 09 09 09 09 28 64 62 3a 74 65 73 74 2d )).....(db:test-
50b0: 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 29 0a get-state test).
50c0: 09 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65 74 ....(db:test-get
50d0: 2d 73 74 61 74 75 73 20 74 65 73 74 29 0a 09 09 -status test)...
50e0: 09 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 ..(db:test-get-r
50f0: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 un_duration test
5100: 29 0a 09 09 09 09 28 64 62 3a 74 65 73 74 2d 67 ).....(db:test-g
5110: 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 et-event_time te
5120: 73 74 29 0a 09 09 09 09 28 64 62 3a 74 65 73 74 st).....(db:test
5130: 2d 67 65 74 2d 68 6f 73 74 20 74 65 73 74 29 29 -get-host test))
5140: 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 28 6f 72 ....(if (not (or
5150: 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 (equal? (db:tes
5160: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t-get-status tes
5170: 74 29 20 22 50 41 53 53 22 29 0a 09 09 09 09 20 t) "PASS").....
5180: 20 20 20 20 28 65 71 75 61 6c 3f 20 28 64 62 3a (equal? (db:
5190: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 test-get-status
51a0: 74 65 73 74 29 20 22 57 41 52 4e 22 29 0a 09 09 test) "WARN")...
51b0: 09 09 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 .. (equal? (
51c0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
51d0: 65 20 74 65 73 74 29 20 20 22 4e 4f 54 5f 53 54 e test) "NOT_ST
51e0: 41 52 54 45 44 22 29 29 29 0a 09 09 09 20 20 20 ARTED")))....
51f0: 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 (begin....
5200: 20 28 70 72 69 6e 74 20 22 20 20 20 20 20 20 20 (print "
5210: 20 20 63 70 75 6c 6f 61 64 3a 20 20 22 20 28 64 cpuload: " (d
5220: 62 3a 74 65 73 74 2d 67 65 74 2d 63 70 75 6c 6f b:test-get-cpulo
5230: 61 64 20 74 65 73 74 29 0a 09 09 09 09 20 20 20 ad test).....
5240: 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 64 69 "\n di
5250: 73 6b 66 72 65 65 3a 20 22 20 28 64 62 3a 74 65 skfree: " (db:te
5260: 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 65 20 st-get-diskfree
5270: 74 65 73 74 29 0a 09 09 09 09 20 20 20 20 20 22 test)..... "
5280: 5c 6e 20 20 20 20 20 20 20 20 20 75 6e 61 6d 65 \n uname
5290: 3a 20 20 20 20 22 20 28 64 62 3a 74 65 73 74 2d : " (db:test-
52a0: 67 65 74 2d 75 6e 61 6d 65 20 74 65 73 74 29 0a get-uname test).
52b0: 09 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 .... "\n
52c0: 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 20 22 rundir: "
52d0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru
52e0: 6e 64 69 72 20 74 65 73 74 29 0a 09 09 09 09 20 ndir test).....
52f0: 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 20 3b ).... ;
5300: 3b 20 45 61 63 68 20 74 65 73 74 0a 09 09 09 20 ; Each test....
5310: 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 ;; DO NOT r
5320: 65 6d 6f 74 65 20 72 75 6e 0a 09 09 09 20 20 20 emote run....
5330: 20 20 20 28 6c 65 74 20 28 28 73 74 65 70 73 20 (let ((steps
5340: 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f (db:get-steps-fo
5350: 72 2d 74 65 73 74 20 23 66 20 28 64 62 3a 74 65 r-test #f (db:te
5360: 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 29 29 st-get-id test))
5370: 29 29 0a 09 09 09 09 28 66 6f 72 2d 65 61 63 68 )).....(for-each
5380: 20 0a 09 09 09 09 20 28 6c 61 6d 62 64 61 20 28 ..... (lambda (
5390: 73 74 65 70 29 0a 09 09 09 09 20 20 20 28 66 6f step)..... (fo
53a0: 72 6d 61 74 20 23 74 20 0a 09 09 09 09 09 20 20 rmat #t ......
53b0: 20 22 20 20 20 20 53 74 65 70 3a 20 7e 32 30 61 " Step: ~20a
53c0: 20 53 74 61 74 65 3a 20 7e 31 30 61 20 53 74 61 State: ~10a Sta
53d0: 74 75 73 3a 20 7e 31 30 61 20 54 69 6d 65 20 7e tus: ~10a Time ~
53e0: 32 32 61 5c 6e 22 0a 09 09 09 09 09 20 20 20 28 22a\n"...... (
53f0: 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 70 db:step-get-step
5400: 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 09 09 09 name step)......
5410: 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d (db:step-get-
5420: 73 74 61 74 65 20 73 74 65 70 29 0a 09 09 09 09 state step).....
5430: 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 . (db:step-get
5440: 2d 73 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 -status step)...
5450: 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 ... (db:step-g
5460: 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 et-event_time st
5470: 65 70 29 29 29 0a 09 09 09 09 20 73 74 65 70 73 ep)))..... steps
5480: 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 74 65 )))))... te
5490: 73 74 73 29 29 29 29 29 0a 09 20 20 20 20 20 72 sts))))).. r
54a0: 75 6e 73 29 0a 09 20 20 20 28 73 65 74 21 20 2a uns).. (set! *
54b0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
54c0: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
54d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
54e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b ==============.;
5510: 3b 20 66 75 6c 6c 20 72 75 6e 0a 3b 3b 3d 3d 3d ; full run.;;===
5520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5560: 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 20 6c 6f 63 6b ===..;; get lock
5570: 20 69 6e 20 64 62 20 66 6f 72 20 66 75 6c 6c 20 in db for full
5580: 72 75 6e 20 66 6f 72 20 74 68 69 73 20 64 69 72 run for this dir
5590: 65 63 74 6f 72 79 0a 3b 3b 20 66 6f 72 20 61 6c ectory.;; for al
55a0: 6c 20 74 65 73 74 73 20 77 69 74 68 20 64 65 70 l tests with dep
55b0: 73 0a 3b 3b 20 20 20 77 61 6c 6b 20 74 72 65 65 s.;; walk tree
55c0: 20 6f 66 20 74 65 73 74 73 20 74 6f 20 66 69 6e of tests to fin
55d0: 64 20 68 65 61 64 20 74 61 73 6b 73 0a 3b 3b 20 d head tasks.;;
55e0: 20 20 61 64 64 20 68 65 61 64 20 74 61 73 6b 73 add head tasks
55f0: 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 0a 3b to task queue.;
5600: 3b 20 20 20 61 64 64 20 64 65 70 65 6e 64 61 6e ; add dependan
5610: 74 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 t tasks to task
5620: 71 75 65 75 65 20 0a 3b 3b 20 20 20 61 64 64 20 queue .;; add
5630: 72 65 6d 61 69 6e 69 6e 67 20 74 61 73 6b 73 20 remaining tasks
5640: 74 6f 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b to task queue.;;
5650: 20 66 6f 72 20 65 61 63 68 20 74 61 73 6b 20 69 for each task i
5660: 6e 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 n task queue.;;
5670: 20 20 69 66 20 68 61 76 65 20 61 64 65 71 75 61 if have adequa
5680: 74 65 20 72 65 73 6f 75 72 63 65 73 0a 3b 3b 20 te resources.;;
5690: 20 20 20 20 6c 61 75 6e 63 68 20 74 61 73 6b 0a launch task.
56a0: 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b 20 20 20 20 ;; else.;;
56b0: 20 70 75 74 20 74 61 73 6b 20 69 6e 20 64 65 66 put task in def
56c0: 65 72 72 65 64 20 71 75 65 75 65 0a 3b 3b 20 69 erred queue.;; i
56d0: 66 20 73 74 69 6c 6c 20 6f 6b 20 74 6f 20 72 75 f still ok to ru
56e0: 6e 20 74 61 73 6b 73 0a 3b 3b 20 20 20 70 72 6f n tasks.;; pro
56f0: 63 65 73 73 20 64 65 66 65 72 72 65 64 20 74 61 cess deferred ta
5700: 73 6b 73 20 70 65 72 20 61 62 6f 76 65 20 73 74 sks per above st
5710: 65 70 73 0a 0a 3b 3b 20 72 75 6e 20 61 6c 6c 20 eps..;; run all
5720: 74 65 73 74 73 20 61 72 65 20 61 72 65 20 4e 6f tests are are No
5730: 74 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 t COMPLETED and
5740: 50 41 53 53 20 6f 72 20 43 48 45 43 4b 0a 28 69 PASS or CHECK.(i
5750: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
5760: 22 2d 72 75 6e 61 6c 6c 22 29 0a 20 20 20 20 28 "-runall"). (
5770: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
5780: 20 0a 20 20 20 20 20 22 2d 72 75 6e 61 6c 6c 22 . "-runall"
5790: 0a 20 20 20 20 20 22 72 75 6e 20 61 6c 6c 20 74 . "run all t
57a0: 65 73 74 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 ests". (lamb
57b0: 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 da (target runna
57c0: 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 me keys keynames
57d0: 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 keyvallst).
57e0: 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 (runs:run-tes
57f0: 74 73 20 74 61 72 67 65 74 0a 09 09 20 20 20 20 ts target...
5800: 20 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 20 runname...
5810: 20 20 20 20 22 25 22 0a 09 09 20 20 20 20 20 20 "%"...
5820: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5830: 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 20 20 -testpatt")...
5840: 20 20 20 20 20 75 73 65 72 0a 09 09 20 20 20 20 user...
5850: 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 args:arg-hash
5860: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
5870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
58a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
58b0: 3b 20 72 75 6e 20 6f 6e 65 20 74 65 73 74 0a 3b ; run one test.;
58c0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
58d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
58e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
58f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5900: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e 20 66 =======..;; 1. f
5910: 69 6e 64 20 74 68 65 20 63 6f 6e 66 69 67 20 66 ind the config f
5920: 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 61 6e 67 65 ile.;; 2. change
5930: 20 74 6f 20 74 68 65 20 74 65 73 74 20 64 69 72 to the test dir
5940: 65 63 74 6f 72 79 0a 3b 3b 20 33 2e 20 75 70 64 ectory.;; 3. upd
5950: 61 74 65 20 74 68 65 20 64 62 20 77 69 74 68 20 ate the db with
5960: 22 74 65 73 74 20 73 74 61 72 74 65 64 22 20 73 "test started" s
5970: 74 61 74 75 73 2c 20 73 65 74 20 72 75 6e 6e 69 tatus, set runni
5980: 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 2e 20 70 72 ng host.;; 4. pr
5990: 6f 63 65 73 73 20 6c 61 75 6e 63 68 20 74 68 65 ocess launch the
59a0: 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 6d 6f test.;; - mo
59b0: 6e 69 74 6f 72 20 74 68 65 20 70 72 6f 63 65 73 nitor the proces
59c0: 73 2c 20 75 70 64 61 74 65 20 73 74 61 74 73 20 s, update stats
59d0: 69 6e 20 74 68 65 20 64 62 20 65 76 65 72 79 20 in the db every
59e0: 32 5e 6e 20 6d 69 6e 75 74 65 73 0a 3b 3b 20 35 2^n minutes.;; 5
59f0: 2e 20 61 73 20 74 68 65 20 74 65 73 74 20 70 72 . as the test pr
5a00: 6f 63 65 65 64 73 20 69 6e 74 65 72 6e 61 6c 6c oceeds internall
5a10: 79 20 69 74 20 63 61 6c 6c 73 20 6d 65 67 61 74 y it calls megat
5a20: 65 73 74 20 61 73 20 65 61 63 68 20 73 74 65 70 est as each step
5a30: 20 69 73 0a 3b 3b 20 20 20 20 73 74 61 72 74 65 is.;; starte
5a40: 64 20 61 6e 64 20 63 6f 6d 70 6c 65 74 65 64 0a d and completed.
5a50: 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 73 74 61 ;; - step sta
5a60: 72 74 65 64 2c 20 74 69 6d 65 73 74 61 6d 70 0a rted, timestamp.
5a70: 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 63 6f 6d ;; - step com
5a80: 70 6c 65 74 65 64 2c 20 65 78 69 74 20 73 74 61 pleted, exit sta
5a90: 74 75 73 2c 20 74 69 6d 65 73 74 61 6d 70 0a 3b tus, timestamp.;
5aa0: 3b 20 36 2e 20 74 65 73 74 20 70 68 6f 6e 65 20 ; 6. test phone
5ab0: 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d 20 69 66 20 home.;; - if
5ac0: 74 65 73 74 20 72 75 6e 20 74 69 6d 65 20 3e 20 test run time >
5ad0: 61 6c 6c 6f 77 65 64 20 72 75 6e 20 74 69 6d 65 allowed run time
5ae0: 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 3b then kill job.;
5af0: 3b 20 20 20 20 2d 20 69 66 20 63 61 6e 6e 6f 74 ; - if cannot
5b00: 20 61 63 63 65 73 73 20 64 62 20 3e 20 61 6c 6c access db > all
5b10: 6f 77 65 64 20 64 69 73 63 6f 6e 6e 65 63 74 20 owed disconnect
5b20: 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a time then kill j
5b30: 6f 62 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ob..(if (args:ge
5b40: 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 t-arg "-runtests
5b50: 22 29 0a 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 "). (general-ru
5b60: 6e 2d 63 61 6c 6c 20 0a 20 20 20 22 2d 72 75 6e n-call . "-run
5b70: 74 65 73 74 73 22 20 0a 20 20 20 22 72 75 6e 20 tests" . "run
5b80: 61 20 74 65 73 74 22 20 0a 20 20 20 28 6c 61 6d a test" . (lam
5b90: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
5ba0: 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 ame keys keyname
5bb0: 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 s keyvallst).
5bc0: 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 (runs:run-test
5bd0: 73 20 74 61 72 67 65 74 0a 09 09 20 20 20 20 20 s target...
5be0: 72 75 6e 6e 61 6d 65 0a 09 09 20 20 20 20 20 28 runname... (
5bf0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
5c00: 75 6e 74 65 73 74 73 22 29 0a 09 09 20 20 20 20 untests")...
5c10: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5c20: 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 09 20 20 -runtests")...
5c30: 20 20 20 75 73 65 72 0a 09 09 20 20 20 20 20 61 user... a
5c40: 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 29 rgs:arg-hash))))
5c50: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
5c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 6f ==========.;; Ro
5ca0: 6c 6c 75 70 20 69 6e 74 6f 20 61 20 72 75 6e 0a llup into a run.
5cb0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
5cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5cf0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
5d00: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 6f rgs:get-arg "-ro
5d10: 6c 6c 75 70 22 29 0a 20 20 20 20 28 62 65 67 69 llup"). (begi
5d20: 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 n. (debug:p
5d30: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 52 rint 0 "ERROR: R
5d40: 6f 6c 6c 75 70 20 69 73 20 63 75 72 72 65 6e 74 ollup is current
5d50: 6c 79 20 6e 6f 74 20 77 6f 72 6b 69 6e 67 2e 20 ly not working.
5d60: 49 66 20 79 6f 75 20 6e 65 65 64 20 69 74 20 70 If you need it p
5d70: 6c 65 61 73 65 20 73 75 62 6d 69 74 20 61 20 74 lease submit a t
5d80: 69 63 6b 65 74 20 61 74 20 68 74 74 70 3a 2f 2f icket at http://
5d90: 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 www.kiatoa.com/f
5da0: 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 22 ossils/megatest"
5db0: 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 34 29 ). (exit 4)
5dc0: 29 29 0a 3b 3b 20 20 20 20 20 28 67 65 6e 65 72 )).;; (gener
5dd0: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 3b 3b 20 al-run-call .;;
5de0: 20 20 20 20 20 22 2d 72 6f 6c 6c 75 70 22 20 0a "-rollup" .
5df0: 3b 3b 20 20 20 20 20 20 22 72 6f 6c 6c 75 70 20 ;; "rollup
5e00: 74 65 73 74 73 22 20 0a 3b 3b 20 20 20 20 20 20 tests" .;;
5e10: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
5e20: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
5e30: 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 names keyvallst)
5e40: 0a 3b 3b 20 20 20 20 20 20 20 20 28 72 75 6e 73 .;; (runs
5e50: 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 6b 65 79 73 :rollup-run keys
5e60: 0a 3b 3b 20 09 09 09 28 6b 65 79 73 2d 3e 61 6c .;; ...(keys->al
5e70: 69 73 74 20 6b 65 79 73 20 22 6e 61 22 29 0a 3b ist keys "na").;
5e80: 3b 20 09 09 09 28 61 72 67 73 3a 67 65 74 2d 61 ; ...(args:get-a
5e90: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 0a rg ":runname") .
5ea0: 3b 3b 20 09 09 09 75 73 65 72 29 29 29 29 0a 0a ;; ...user))))..
5eb0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
5ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ef0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 6f 63 6b ========.;; Lock
5f00: 20 6f 72 20 75 6e 6c 6f 63 6b 20 61 20 72 75 6e or unlock a run
5f10: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
5f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
5f60: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
5f70: 20 22 2d 6c 6f 63 6b 22 29 28 61 72 67 73 3a 67 "-lock")(args:g
5f80: 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b 22 et-arg "-unlock"
5f90: 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d )). (general-
5fa0: 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 28 run-call . (
5fb0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
5fc0: 20 22 2d 6c 6f 63 6b 22 29 20 22 2d 6c 6f 63 6b "-lock") "-lock
5fd0: 22 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 20 20 " "-unlock").
5fe0: 20 20 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 20 74 "lock/unlock t
5ff0: 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c 61 6d ests" . (lam
6000: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
6010: 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 ame keys keyname
6020: 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 s keyvallst).
6030: 20 20 20 20 28 72 75 6e 73 3a 68 61 6e 64 6c 65 (runs:handle
6040: 2d 6c 6f 63 6b 69 6e 67 20 0a 09 09 20 20 74 61 -locking ... ta
6050: 72 67 65 74 0a 09 09 20 20 6b 65 79 73 0a 09 09 rget... keys...
6060: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
6070: 22 3a 72 75 6e 6e 61 6d 65 22 29 20 0a 09 09 20 ":runname") ...
6080: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6090: 2d 6c 6f 63 6b 22 29 0a 09 09 20 20 28 61 72 67 -lock")... (arg
60a0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f s:get-arg "-unlo
60b0: 63 6b 22 29 0a 09 09 20 20 75 73 65 72 29 29 29 ck")... user)))
60c0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
60d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
60e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
60f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 ===========.;; G
6110: 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 74 et paths to test
6120: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
6130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 65 ==========.;; Ge
6170: 74 20 74 65 73 74 20 70 61 74 68 73 20 6d 61 74 t test paths mat
6180: 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 75 ching target, ru
6190: 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 65 73 74 70 nname, and testp
61a0: 61 74 74 0a 28 69 66 20 28 6f 72 20 28 61 72 67 att.(if (or (arg
61b0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
61c0: 2d 66 69 6c 65 73 22 29 28 61 72 67 73 3a 67 65 -files")(args:ge
61d0: 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 70 61 74 t-arg "-test-pat
61e0: 68 73 22 29 29 0a 20 20 20 20 3b 3b 20 69 66 20 hs")). ;; if
61f0: 77 65 20 61 72 65 20 69 6e 20 61 20 74 65 73 74 we are in a test
6200: 20 75 73 65 20 74 68 65 20 4d 54 5f 43 4d 44 49 use the MT_CMDI
6210: 4e 46 4f 20 64 61 74 61 0a 20 20 20 20 28 69 66 NFO data. (if
6220: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
6230: 49 4e 46 4f 22 29 0a 09 28 6c 65 74 2a 20 28 28 INFO")..(let* ((
6240: 73 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 72 startingdir (cur
6250: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 rent-directory))
6260: 0a 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 .. (cmdinf
6270: 6f 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d o (read (open-
6280: 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 input-string (ba
6290: 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f se64:base64-deco
62a0: 64 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 de (getenv "MT_C
62b0: 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 MDINFO")))))..
62c0: 20 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 6d 6f ;; (runremo
62d0: 74 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c te (assoc/defaul
62e0: 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 6d 64 t 'runremote cmd
62f0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
6300: 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 transport (assoc
6310: 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 /default 'transp
6320: 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ort cmdinfo))..
6330: 20 20 20 20 20 20 28 74 65 73 74 70 61 74 68 20 (testpath
6340: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
6350: 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 'testpath cmdin
6360: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 fo)).. (te
6370: 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 st-name (assoc/d
6380: 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d efault 'test-nam
6390: 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 e cmdinfo))..
63a0: 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 (runscript (
63b0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
63c0: 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f unscript cmdinfo
63d0: 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 )).. (db-h
63e0: 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 ost (assoc/def
63f0: 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 ault 'db-host
6400: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
6410: 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 (run-id (as
6420: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
6430: 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 -id cmdinfo))
6440: 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 .. (itemda
6450: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
6460: 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d lt 'itemdat cm
6470: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
6480: 28 64 62 20 20 20 20 20 20 20 20 23 66 29 0a 09 (db #f)..
6490: 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 (state
64a0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
64b0: 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 ":state"))..
64c0: 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 61 (status (a
64d0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
64e0: 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 atus"))..
64f0: 28 74 61 72 67 65 74 20 20 20 20 28 61 72 67 73 (target (args
6500: 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 :get-arg "-targe
6510: 74 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 6f t")).. (to
6520: 70 70 61 74 68 20 20 20 28 61 73 73 6f 63 2f 64 ppath (assoc/d
6530: 65 66 61 75 6c 74 20 27 74 6f 70 70 61 74 68 20 efault 'toppath
6540: 20 20 63 6d 64 69 6e 66 6f 29 29 29 0a 09 20 20 cmdinfo)))..
6550: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
6560: 79 20 74 6f 70 70 61 74 68 29 0a 09 20 20 3b 3b y toppath).. ;;
6570: 20 28 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f 74 (set! *runremot
6580: 65 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 20 e* runremote)..
6590: 20 28 73 65 74 21 20 2a 74 72 61 6e 73 70 6f 72 (set! *transpor
65a0: 74 2d 74 79 70 65 2a 20 28 73 74 72 69 6e 67 2d t-type* (string-
65b0: 3e 73 79 6d 62 6f 6c 20 74 72 61 6e 73 70 6f 72 >symbol transpor
65c0: 74 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 t)).. (if (not
65d0: 74 61 72 67 65 74 29 0a 09 20 20 20 20 20 20 28 target).. (
65e0: 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 begin...(debug:p
65f0: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 2d rint 0 "ERROR: -
6600: 74 61 72 67 65 74 20 69 73 20 72 65 71 75 69 72 target is requir
6610: 65 64 2e 22 29 0a 09 09 28 65 78 69 74 20 31 29 ed.")...(exit 1)
6620: 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 )).. (if (not (
6630: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
6640: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
6650: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
6660: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
6670: 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 2d 74 giving up on -t
6680: 65 73 74 2d 70 61 74 68 73 20 6f 72 20 2d 74 65 est-paths or -te
6690: 73 74 2d 66 69 6c 65 73 2c 20 65 78 69 74 69 6e st-files, exitin
66a0: 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 g")...(exit 1)))
66b0: 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 .. (let* ((keys
66c0: 20 20 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 (cdb:remote
66d0: 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 79 73 -run db:get-keys
66e0: 20 64 62 29 29 0a 09 09 20 28 6b 65 79 6e 61 6d db))... (keynam
66f0: 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d es (map key:get-
6700: 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 fieldname keys))
6710: 0a 09 09 20 3b 3b 20 64 62 3a 74 65 73 74 2d 67 ... ;; db:test-g
6720: 65 74 2d 70 61 74 68 73 20 6d 75 73 74 20 6e 6f et-paths must no
6730: 74 20 62 65 20 72 75 6e 20 72 65 6d 6f 74 65 0a t be run remote.
6740: 09 09 20 28 70 61 74 68 73 20 20 20 20 28 64 62 .. (paths (db
6750: 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d :test-get-paths-
6760: 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e matching db keyn
6770: 61 6d 65 73 20 74 61 72 67 65 74 20 28 61 72 67 ames target (arg
6780: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
6790: 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 20 20 -files"))))..
67a0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
67b0: 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 28 hing* #t).. (
67c0: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
67d0: 20 28 70 61 74 68 29 0a 09 09 09 28 70 72 69 6e (path)....(prin
67e0: 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 t path))...
67f0: 20 70 61 74 68 73 29 29 29 0a 09 3b 3b 20 65 6c paths)))..;; el
6800: 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 6c 2d se do a general-
6810: 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 72 run-call..(gener
6820: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 22 al-run-call .. "
6830: 2d 74 65 73 74 2d 66 69 6c 65 73 22 0a 09 20 22 -test-files".. "
6840: 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 Get paths to tes
6850: 74 22 0a 09 20 28 6c 61 6d 62 64 61 20 28 74 61 t".. (lambda (ta
6860: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
6870: 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 s keynames keyva
6880: 6c 6c 73 74 29 0a 09 20 20 20 28 6c 65 74 2a 20 llst).. (let*
6890: 28 28 64 62 20 20 20 20 20 20 20 23 66 29 0a 09 ((db #f)..
68a0: 09 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e . ;; DO NOT run
68b0: 20 72 65 6d 6f 74 65 0a 09 09 20 20 28 70 61 74 remote... (pat
68c0: 68 73 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 hs (db:test-g
68d0: 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e et-paths-matchin
68e0: 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 g db keynames ta
68f0: 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d 61 rget (args:get-a
6900: 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 rg "-test-files"
6910: 29 29 29 29 0a 09 20 20 20 20 20 28 66 6f 72 2d )))).. (for-
6920: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 each (lambda (pa
6930: 74 68 29 0a 09 09 09 20 28 70 72 69 6e 74 20 70 th).... (print p
6940: 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 20 70 ath))... p
6950: 61 74 68 73 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d aths))))))..;;==
6960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
69a0: 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 20 ====.;; Archive
69b0: 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d tests.;;========
69c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
69d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
69e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
69f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
6a00: 3b 20 41 72 63 68 69 76 65 20 74 65 73 74 73 20 ; Archive tests
6a10: 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c matching target,
6a20: 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 65 runname, and te
6a30: 73 74 70 61 74 74 0a 28 69 66 20 28 61 72 67 73 stpatt.(if (args
6a40: 3a 67 65 74 2d 61 72 67 20 22 2d 61 72 63 68 69 :get-arg "-archi
6a50: 76 65 22 29 0a 20 20 20 20 3b 3b 20 69 66 20 77 ve"). ;; if w
6a60: 65 20 61 72 65 20 69 6e 20 61 20 74 65 73 74 20 e are in a test
6a70: 75 73 65 20 74 68 65 20 4d 54 5f 43 4d 44 49 4e use the MT_CMDIN
6a80: 46 4f 20 64 61 74 61 0a 20 20 20 20 28 69 66 20 FO data. (if
6a90: 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (getenv "MT_CMDI
6aa0: 4e 46 4f 22 29 0a 09 28 6c 65 74 2a 20 28 28 73 NFO")..(let* ((s
6ab0: 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 tartingdir (curr
6ac0: 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a ent-directory)).
6ad0: 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f . (cmdinfo
6ae0: 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 (read (open-i
6af0: 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 nput-string (bas
6b00: 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 e64:base64-decod
6b10: 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d e (getenv "MT_CM
6b20: 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 20 DINFO")))))..
6b30: 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 6d 6f 74 ;; (runremot
6b40: 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 e (assoc/default
6b50: 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 6d 64 69 'runremote cmdi
6b60: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
6b70: 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f ransport (assoc/
6b80: 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f default 'transpo
6b90: 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 rt cmdinfo))..
6ba0: 20 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 (testpath
6bb0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
6bc0: 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 testpath cmdinf
6bd0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 o)).. (tes
6be0: 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 t-name (assoc/de
6bf0: 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 fault 'test-name
6c00: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
6c10: 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 (runscript (a
6c20: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
6c30: 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 nscript cmdinfo)
6c40: 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f ).. (db-ho
6c50: 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 st (assoc/defa
6c60: 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 ult 'db-host c
6c70: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
6c80: 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 (run-id (ass
6c90: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d oc/default 'run-
6ca0: 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a id cmdinfo)).
6cb0: 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 . (itemdat
6cc0: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
6cd0: 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 t 'itemdat cmd
6ce0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
6cf0: 64 62 20 20 20 20 20 20 20 20 23 66 29 0a 09 20 db #f)..
6d00: 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 (state
6d10: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6d20: 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 :state"))..
6d30: 20 20 28 73 74 61 74 75 73 20 20 20 20 28 61 72 (status (ar
6d40: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
6d50: 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 tus")).. (
6d60: 74 61 72 67 65 74 20 20 20 20 28 61 72 67 73 3a target (args:
6d70: 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 get-arg "-target
6d80: 22 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d "))).. (change-
6d90: 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 directory testpa
6da0: 74 68 29 0a 09 20 20 3b 3b 20 28 73 65 74 21 20 th).. ;; (set!
6db0: 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e 72 *runremote* runr
6dc0: 65 6d 6f 74 65 29 0a 09 20 20 28 73 65 74 21 20 emote).. (set!
6dd0: 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 2a *transport-type*
6de0: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
6df0: 20 74 72 61 6e 73 70 6f 72 74 29 29 0a 09 20 20 transport))..
6e00: 28 69 66 20 28 6e 6f 74 20 74 61 72 67 65 74 29 (if (not target)
6e10: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
6e20: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
6e30: 22 45 52 52 4f 52 3a 20 2d 74 61 72 67 65 74 20 "ERROR: -target
6e40: 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 0a 09 is required.")..
6e50: 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 .(exit 1))).. (
6e60: 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 if (not (setup-f
6e70: 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 or-run))..
6e80: 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a (begin...(debug:
6e90: 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 print 0 "Failed
6ea0: 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 6e 67 to setup, giving
6eb0: 20 75 70 20 6f 6e 20 2d 61 72 63 68 69 76 65 2c up on -archive,
6ec0: 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 exiting")...(ex
6ed0: 69 74 20 31 29 29 29 0a 09 20 20 28 6c 65 74 2a it 1))).. (let*
6ee0: 20 28 28 6b 65 79 73 20 20 20 20 20 28 63 64 62 ((keys (cdb
6ef0: 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 :remote-run db:g
6f00: 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 09 20 et-keys db))...
6f10: 28 6b 65 79 6e 61 6d 65 73 20 28 6d 61 70 20 6b (keynames (map k
6f20: 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 ey:get-fieldname
6f30: 20 6b 65 79 73 29 29 0a 09 09 20 3b 3b 20 44 4f keys))... ;; DO
6f40: 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a NOT run remote.
6f50: 09 09 20 28 70 61 74 68 73 20 20 20 20 28 64 62 .. (paths (db
6f60: 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d :test-get-paths-
6f70: 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e matching db keyn
6f80: 61 6d 65 73 20 74 61 72 67 65 74 29 29 29 0a 09 ames target)))..
6f90: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
6fa0: 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 mething* #t)..
6fb0: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
6fc0: 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 28 70 bda (path)....(p
6fd0: 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 20 20 rint path))...
6fe0: 20 20 20 20 70 61 74 68 73 29 29 29 0a 09 3b 3b paths)))..;;
6ff0: 20 65 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 72 else do a gener
7000: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 al-run-call..(ge
7010: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
7020: 09 20 22 2d 74 65 73 74 2d 70 61 74 68 73 22 0a . "-test-paths".
7030: 09 20 22 47 65 74 20 70 61 74 68 73 20 74 6f 20 . "Get paths to
7040: 74 65 73 74 73 22 0a 09 20 28 6c 61 6d 62 64 61 tests".. (lambda
7050: 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 (target runname
7060: 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b keys keynames k
7070: 65 79 76 61 6c 6c 73 74 29 0a 09 20 20 20 28 6c eyvallst).. (l
7080: 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 23 et* ((db #
7090: 66 29 0a 09 09 20 20 3b 3b 20 44 4f 20 4e 4f 54 f)... ;; DO NOT
70a0: 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 20 run remote...
70b0: 28 70 61 74 68 73 20 20 20 20 28 64 62 3a 74 65 (paths (db:te
70c0: 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 st-get-paths-mat
70d0: 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 ching db keyname
70e0: 73 20 74 61 72 67 65 74 29 29 29 0a 09 20 20 20 s target)))..
70f0: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
7100: 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 20 28 bda (path).... (
7110: 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 20 print path))...
7120: 20 20 20 20 20 20 70 61 74 68 73 29 29 29 29 29 paths)))))
7130: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
7140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 ===========.;; E
7180: 78 74 72 61 63 74 20 61 20 73 70 72 65 61 64 73 xtract a spreads
7190: 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 72 75 heet from the ru
71a0: 6e 73 20 64 61 74 61 62 61 73 65 0a 3b 3b 3d 3d ns database.;;==
71b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71f0: 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
7200: 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 61 63 get-arg "-extrac
7210: 74 2d 6f 64 73 22 29 0a 20 20 20 20 28 67 65 6e t-ods"). (gen
7220: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 eral-run-call.
7230: 20 20 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 "-extract-ods
7240: 22 0a 20 20 20 20 20 22 4d 61 6b 65 20 6f 64 73 ". "Make ods
7250: 20 73 70 72 65 61 64 73 68 65 65 74 22 0a 20 20 spreadsheet".
7260: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
7270: 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
7280: 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c keynames keyvall
7290: 73 74 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 st). (let
72a0: 28 28 64 62 20 20 20 20 20 20 20 20 20 23 66 29 ((db #f)
72b0: 0a 09 20 20 20 20 20 28 6f 75 74 70 75 74 66 69 .. (outputfi
72c0: 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 le (args:get-arg
72d0: 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 "-extract-ods")
72e0: 29 0a 09 20 20 20 20 20 28 72 75 6e 73 70 61 74 ).. (runspat
72f0: 74 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 t (args:get-ar
7300: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g ":runname"))..
7310: 20 20 20 20 20 28 70 61 74 68 6d 6f 64 20 20 20 (pathmod
7320: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7330: 2d 70 61 74 68 6d 6f 64 22 29 29 0a 09 20 20 20 -pathmod"))..
7340: 20 20 28 6b 65 79 76 61 6c 61 6c 69 73 74 20 28 (keyvalalist (
7350: 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 79 73 keys->alist keys
7360: 20 22 25 22 29 29 29 0a 09 20 28 64 65 62 75 67 "%"))).. (debug
7370: 3a 70 72 69 6e 74 20 32 20 22 45 78 74 72 61 63 :print 2 "Extrac
7380: 74 20 6f 64 73 2c 20 6f 75 74 70 75 74 66 69 6c t ods, outputfil
7390: 65 3a 20 22 20 6f 75 74 70 75 74 66 69 6c 65 20 e: " outputfile
73a0: 22 20 72 75 6e 73 70 61 74 74 3a 20 22 20 72 75 " runspatt: " ru
73b0: 6e 73 70 61 74 74 20 22 20 6b 65 79 76 61 6c 61 nspatt " keyvala
73c0: 6c 69 73 74 3a 20 22 20 6b 65 79 76 61 6c 61 6c list: " keyvalal
73d0: 69 73 74 29 0a 09 20 28 63 64 62 3a 72 65 6d 6f ist).. (cdb:remo
73e0: 74 65 2d 72 75 6e 20 64 62 3a 65 78 74 72 61 63 te-run db:extrac
73f0: 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 20 6f 75 t-ods-file db ou
7400: 74 70 75 74 66 69 6c 65 20 6b 65 79 76 61 6c 61 tputfile keyvala
7410: 6c 69 73 74 20 28 69 66 20 72 75 6e 73 70 61 74 list (if runspat
7420: 74 20 72 75 6e 73 70 61 74 74 20 22 25 22 29 20 t runspatt "%")
7430: 70 61 74 68 6d 6f 64 29 29 29 29 29 0a 0a 3b 3b pathmod)))))..;;
7440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7460: 3d 3d 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 0a 3b 3b 20 65 78 65 63 75 74 ======.;; execut
7490: 65 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 e the test.;;
74a0: 20 2d 20 67 65 74 73 20 63 61 6c 6c 65 64 20 6f - gets called o
74b0: 6e 20 72 65 6d 6f 74 65 20 68 6f 73 74 0a 3b 3b n remote host.;;
74c0: 20 20 20 20 2d 20 72 65 63 65 69 76 65 73 20 69 - receives i
74d0: 6e 66 6f 20 66 72 6f 6d 20 74 68 65 20 2d 65 78 nfo from the -ex
74e0: 65 63 75 74 65 20 70 61 72 61 6d 0a 3b 3b 20 20 ecute param.;;
74f0: 20 20 2d 20 70 61 73 73 65 73 20 69 6e 66 6f 20 - passes info
7500: 74 6f 20 73 74 65 70 73 20 76 69 61 20 4d 54 5f to steps via MT_
7510: 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 CMDINFO env var
7520: 28 66 75 74 75 72 65 20 69 73 20 74 6f 20 75 73 (future is to us
7530: 65 20 61 20 64 6f 74 20 66 69 6c 65 29 0a 3b 3b e a dot file).;;
7540: 20 20 20 20 2d 20 67 61 74 68 65 72 73 20 68 6f - gathers ho
7550: 73 74 20 69 6e 66 6f 20 61 6e 64 20 0a 3b 3b 3d st info and .;;=
7560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
75a0: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
75b0: 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 :get-arg "-execu
75c0: 74 65 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a te"). (begin.
75d0: 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 65 78 (launch:ex
75e0: 65 63 75 74 65 20 28 61 72 67 73 3a 67 65 74 2d ecute (args:get-
75f0: 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 29 arg "-execute"))
7600: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
7610: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
7620: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
7630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 ===========.;; T
7670: 65 73 74 20 63 6f 6d 6d 61 6e 64 73 20 28 69 2e est commands (i.
7680: 65 2e 20 66 6f 72 20 75 73 65 20 69 6e 73 69 64 e. for use insid
7690: 65 20 74 65 73 74 73 29 0a 3b 3b 3d 3d 3d 3d 3d e tests).;;=====
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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76e0: 3d 0a 0a 28 64 65 66 69 6e 65 20 28 6d 65 67 61 =..(define (mega
76f0: 74 65 73 74 3a 73 74 65 70 20 73 74 65 70 20 73 test:step step s
7700: 74 61 74 65 20 73 74 61 74 75 73 20 6c 6f 67 66 tate status logf
7710: 69 6c 65 20 6d 73 67 29 0a 20 20 28 69 66 20 28 ile msg). (if (
7720: 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f not (getenv "MT_
7730: 43 4d 44 49 4e 46 4f 22 29 29 0a 20 20 20 20 20 CMDINFO")).
7740: 20 28 62 65 67 69 6e 0a 09 28 64 65 62 75 67 3a (begin..(debug:
7750: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
7760: 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 MT_CMDINFO env v
7770: 61 72 20 6e 6f 74 20 73 65 74 2c 20 2d 73 74 65 ar not set, -ste
7780: 70 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 p must be called
7790: 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 *inside* a mega
77a0: 74 65 73 74 20 69 6e 76 6f 6b 65 64 20 65 6e 76 test invoked env
77b0: 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 28 65 78 ironment!")..(ex
77c0: 69 74 20 35 29 29 0a 20 20 20 20 20 20 28 6c 65 it 5)). (le
77d0: 74 2a 20 28 28 63 6d 64 69 6e 66 6f 20 20 20 28 t* ((cmdinfo (
77e0: 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 read (open-input
77f0: 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a -string (base64:
7800: 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 base64-decode (g
7810: 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
7820: 4f 22 29 29 29 29 29 0a 09 20 20 20 20 20 3b 3b O"))))).. ;;
7830: 20 28 72 75 6e 72 65 6d 6f 74 65 20 28 61 73 73 (runremote (ass
7840: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 72 oc/default 'runr
7850: 65 6d 6f 74 65 20 63 6d 64 69 6e 66 6f 29 29 0a emote cmdinfo)).
7860: 09 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 . (transport
7870: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
7880: 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 'transport cmdin
7890: 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 fo)).. (test
78a0: 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 path (assoc/def
78b0: 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 ault 'testpath
78c0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
78d0: 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f (test-name (asso
78e0: 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d c/default 'test-
78f0: 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 name cmdinfo))..
7900: 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 (runscript
7910: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
7920: 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 runscript cmdinf
7930: 6f 29 29 0a 09 20 20 20 20 20 28 64 62 2d 68 6f o)).. (db-ho
7940: 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 st (assoc/defa
7950: 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 ult 'db-host c
7960: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 mdinfo)).. (
7970: 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 run-id (assoc
7980: 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 /default 'run-id
7990: 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 cmdinfo))..
79a0: 20 20 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 (test-id (
79b0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
79c0: 65 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f est-id cmdinfo
79d0: 29 29 0a 09 20 20 20 20 20 28 69 74 65 6d 64 61 )).. (itemda
79e0: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
79f0: 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d lt 'itemdat cm
7a00: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 77 dinfo)).. (w
7a10: 6f 72 6b 2d 61 72 65 61 20 28 61 73 73 6f 63 2f ork-area (assoc/
7a20: 64 65 66 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 default 'work-ar
7a30: 65 61 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 ea cmdinfo))..
7a40: 20 20 20 28 64 62 20 20 20 20 20 20 20 20 23 66 (db #f
7a50: 29 29 0a 09 28 63 68 61 6e 67 65 2d 64 69 72 65 ))..(change-dire
7a60: 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a ctory testpath).
7a70: 09 3b 3b 20 28 73 65 74 21 20 2a 72 75 6e 72 65 .;; (set! *runre
7a80: 6d 6f 74 65 2a 20 72 75 6e 72 65 6d 6f 74 65 29 mote* runremote)
7a90: 0a 09 28 73 65 74 21 20 2a 74 72 61 6e 73 70 6f ..(set! *transpo
7aa0: 72 74 2d 74 79 70 65 2a 20 28 73 74 72 69 6e 67 rt-type* (string
7ab0: 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 6e 73 70 6f ->symbol transpo
7ac0: 72 74 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 rt))..(if (not (
7ad0: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
7ae0: 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 . (begin..
7af0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
7b00: 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 0 "Failed to set
7b10: 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 up, exiting")..
7b20: 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a (exit 1))).
7b30: 09 28 69 66 20 28 61 6e 64 20 73 74 61 74 65 20 .(if (and state
7b40: 73 74 61 74 75 73 29 0a 09 20 20 20 20 3b 3b 20 status).. ;;
7b50: 44 4f 20 4e 4f 54 20 72 65 6d 6f 74 65 20 72 75 DO NOT remote ru
7b60: 6e 2c 20 6d 61 6b 65 73 20 63 61 6c 6c 73 20 74 n, makes calls t
7b70: 6f 20 74 68 65 20 74 65 73 74 64 61 74 2e 64 62 o the testdat.db
7b80: 20 74 65 73 74 20 64 62 2e 0a 09 20 20 20 20 28 test db... (
7b90: 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d db:teststep-set-
7ba0: 73 74 61 74 75 73 21 20 64 62 20 74 65 73 74 2d status! db test-
7bb0: 69 64 20 73 74 65 70 20 73 74 61 74 65 20 73 74 id step state st
7bc0: 61 74 75 73 20 6d 73 67 20 6c 6f 67 66 69 6c 65 atus msg logfile
7bd0: 20 77 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b work-area: work
7be0: 2d 61 72 65 61 29 0a 09 20 20 20 20 28 62 65 67 -area).. (beg
7bf0: 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 in.. (debug
7c00: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
7c10: 20 59 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 You must specif
7c20: 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 y :state and :st
7c30: 61 74 75 73 20 77 69 74 68 20 65 76 65 72 79 20 atus with every
7c40: 63 61 6c 6c 20 74 6f 20 2d 73 74 65 70 22 29 0a call to -step").
7c50: 09 20 20 20 20 20 20 28 65 78 69 74 20 36 29 29 . (exit 6))
7c60: 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a ))))..(if (args:
7c70: 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 get-arg "-step")
7c80: 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
7c90: 20 20 28 6d 65 67 61 74 65 73 74 3a 73 74 65 70 (megatest:step
7ca0: 20 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 . (args:g
7cb0: 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a et-arg "-step").
7cc0: 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 (args:get
7cd0: 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 0a 20 -arg ":state").
7ce0: 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
7cf0: 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 0a 20 arg ":status").
7d00: 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
7d10: 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a 20 arg "-setlog").
7d20: 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
7d30: 61 72 67 20 22 2d 6d 22 29 29 0a 20 20 20 20 20 arg "-m")).
7d40: 20 3b 3b 20 28 69 66 20 64 62 20 28 73 71 6c 69 ;; (if db (sqli
7d50: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
7d60: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
7d70: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
7d80: 29 29 29 0a 20 20 20 20 0a 28 69 66 20 28 6f 72 ))). .(if (or
7d90: 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d (and (args:get-
7da0: 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 20 20 arg "-setlog")
7db0: 20 20 20 20 20 3b 3b 20 73 69 6e 63 65 20 73 65 ;; since se
7dc0: 74 74 69 6e 67 20 75 70 20 69 73 20 73 6f 20 63 tting up is so c
7dd0: 6f 73 74 6c 79 20 6c 65 74 73 20 70 69 67 67 79 ostly lets piggy
7de0: 62 61 63 6b 20 6f 6e 20 2d 74 65 73 74 2d 73 74 back on -test-st
7df0: 61 74 75 73 0a 09 20 20 20 20 20 28 6e 6f 74 20 atus.. (not
7e00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7e10: 73 74 65 70 22 29 29 29 20 20 3b 3b 20 2d 73 65 step"))) ;; -se
7e20: 74 6c 6f 67 20 6d 61 79 20 68 61 76 65 20 62 65 tlog may have be
7e30: 65 6e 20 70 72 6f 63 65 73 73 65 64 20 61 6c 72 en processed alr
7e40: 65 61 64 79 20 69 6e 20 74 68 65 20 22 2d 73 74 eady in the "-st
7e50: 65 70 22 20 70 72 65 76 69 6f 75 73 0a 09 28 61 ep" previous..(a
7e60: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
7e70: 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 28 61 72 67 t-toplog")..(arg
7e80: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
7e90: 2d 73 74 61 74 75 73 22 29 0a 09 28 61 72 67 73 -status")..(args
7ea0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 :get-arg "-set-v
7eb0: 61 6c 75 65 73 22 29 0a 09 28 61 72 67 73 3a 67 alues")..(args:g
7ec0: 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d 74 65 et-arg "-load-te
7ed0: 73 74 2d 64 61 74 61 22 29 0a 09 28 61 72 67 73 st-data")..(args
7ee0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 :get-arg "-runst
7ef0: 65 70 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d ep")..(args:get-
7f00: 61 72 67 20 22 2d 73 75 6d 6d 61 72 69 7a 65 2d arg "-summarize-
7f10: 69 74 65 6d 73 22 29 29 0a 20 20 20 20 28 69 66 items")). (if
7f20: 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 4d (not (getenv "M
7f30: 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 28 62 T_CMDINFO"))..(b
7f40: 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 egin.. (debug:p
7f50: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4d rint 0 "ERROR: M
7f60: 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 T_CMDINFO env va
7f70: 72 20 6e 6f 74 20 73 65 74 2c 20 63 6f 6d 6d 61 r not set, comma
7f80: 6e 64 73 20 2d 74 65 73 74 2d 73 74 61 74 75 73 nds -test-status
7f90: 2c 20 2d 72 75 6e 73 74 65 70 20 61 6e 64 20 2d , -runstep and -
7fa0: 73 65 74 6c 6f 67 20 6d 75 73 74 20 62 65 20 63 setlog must be c
7fb0: 61 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 alled *inside* a
7fc0: 20 6d 65 67 61 74 65 73 74 20 65 6e 76 69 72 6f megatest enviro
7fd0: 6e 6d 65 6e 74 21 22 29 0a 09 20 20 28 65 78 69 nment!").. (exi
7fe0: 74 20 35 29 29 0a 09 28 6c 65 74 2a 20 28 28 73 t 5))..(let* ((s
7ff0: 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 tartingdir (curr
8000: 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a ent-directory)).
8010: 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f . (cmdinfo
8020: 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 (read (open-i
8030: 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 nput-string (bas
8040: 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 e64:base64-decod
8050: 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d e (getenv "MT_CM
8060: 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 20 DINFO")))))..
8070: 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 6d 6f 74 ;; (runremot
8080: 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 e (assoc/default
8090: 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 6d 64 69 'runremote cmdi
80a0: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
80b0: 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f ransport (assoc/
80c0: 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f default 'transpo
80d0: 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 rt cmdinfo))..
80e0: 20 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 (testpath
80f0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
8100: 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 testpath cmdinf
8110: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 o)).. (tes
8120: 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 t-name (assoc/de
8130: 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 fault 'test-name
8140: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
8150: 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 (runscript (a
8160: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
8170: 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 nscript cmdinfo)
8180: 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f ).. (db-ho
8190: 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 st (assoc/defa
81a0: 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 ult 'db-host c
81b0: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
81c0: 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 (run-id (ass
81d0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d oc/default 'run-
81e0: 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a id cmdinfo)).
81f0: 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 64 . (test-id
8200: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
8210: 74 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 t 'test-id cmd
8220: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
8230: 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 itemdat (assoc
8240: 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 /default 'itemda
8250: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
8260: 20 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 (work-area
8270: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
8280: 27 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 'work-area cmdin
8290: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 fo)).. (db
82a0: 20 20 20 20 20 20 20 20 23 66 29 20 3b 3b 20 28 #f) ;; (
82b0: 6f 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 20 open-db))..
82c0: 20 20 28 73 74 61 74 65 20 20 20 20 20 28 61 72 (state (ar
82d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
82e0: 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 te")).. (s
82f0: 74 61 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 tatus (args:g
8300: 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 et-arg ":status"
8310: 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 ))).. (change-d
8320: 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
8330: 68 29 0a 09 20 20 3b 3b 20 28 73 65 74 21 20 2a h).. ;; (set! *
8340: 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e 72 65 runremote* runre
8350: 6d 6f 74 65 29 0a 09 20 20 28 73 65 74 21 20 2a mote).. (set! *
8360: 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 2a 20 transport-type*
8370: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
8380: 74 72 61 6e 73 70 6f 72 74 29 29 0a 09 20 20 28 transport)).. (
8390: 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 if (not (setup-f
83a0: 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 or-run))..
83b0: 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a (begin...(debug:
83c0: 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 print 0 "Failed
83d0: 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
83e0: 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 g")...(exit 1)))
83f0: 0a 0a 09 20 20 3b 3b 20 63 61 6e 20 73 65 74 75 ... ;; can setu
8400: 70 20 61 73 20 63 6c 69 65 6e 74 20 66 6f 72 20 p as client for
8410: 73 65 72 76 65 72 20 6d 6f 64 65 20 6e 6f 77 0a server mode now.
8420: 09 20 20 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 65 . ;; (client:se
8430: 74 75 70 29 0a 0a 09 20 20 28 69 66 20 28 61 72 tup)... (if (ar
8440: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 61 gs:get-arg "-loa
8450: 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a 09 20 d-test-data")..
8460: 20 20 20 20 20 3b 3b 20 68 61 73 20 73 75 62 20 ;; has sub
8470: 63 6f 6d 6d 61 6e 64 73 20 74 68 61 74 20 61 72 commands that ar
8480: 65 20 72 64 62 3a 0a 09 20 20 20 20 20 20 3b 3b e rdb:.. ;;
8490: 20 44 4f 20 4e 4f 54 20 70 75 74 20 74 68 69 73 DO NOT put this
84a0: 20 6f 6e 65 20 69 6e 74 6f 20 65 69 74 68 65 72 one into either
84b0: 20 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 cdb:remote-run
84c0: 6f 72 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 or open-run-clos
84d0: 65 0a 09 20 20 20 20 20 20 28 64 62 3a 6c 6f 61 e.. (db:loa
84e0: 64 2d 74 65 73 74 2d 64 61 74 61 20 64 62 20 74 d-test-data db t
84f0: 65 73 74 2d 69 64 20 77 6f 72 6b 2d 61 72 65 61 est-id work-area
8500: 3a 20 77 6f 72 6b 2d 61 72 65 61 29 29 0a 09 20 : work-area))..
8510: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
8520: 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a 09 20 rg "-setlog")..
8530: 20 20 20 20 20 28 6c 65 74 20 28 28 6c 6f 67 66 (let ((logf
8540: 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 name (args:get-a
8550: 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 29 29 0a rg "-setlog"))).
8560: 09 09 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d ..(cdb:test-set-
8570: 6c 6f 67 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a log! *runremote*
8580: 20 74 65 73 74 2d 69 64 20 6c 6f 67 66 6e 61 6d test-id logfnam
8590: 65 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 e))).. (if (arg
85a0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
85b0: 74 6f 70 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 toplog")..
85c0: 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 ;; DO NOT run re
85d0: 6d 6f 74 65 0a 09 20 20 20 20 20 20 28 74 65 73 mote.. (tes
85e0: 74 73 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c ts:test-set-topl
85f0: 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 og! db run-id te
8600: 73 74 2d 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 st-name (args:ge
8610: 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c t-arg "-set-topl
8620: 6f 67 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 og"))).. (if (a
8630: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 rgs:get-arg "-su
8640: 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 0a mmarize-items").
8650: 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 . ;; DO NOT
8660: 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 run remote..
8670: 20 20 20 28 74 65 73 74 73 3a 73 75 6d 6d 61 72 (tests:summar
8680: 69 7a 65 2d 69 74 65 6d 73 20 64 62 20 72 75 6e ize-items db run
8690: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 74 -id test-name #t
86a0: 29 29 20 3b 3b 20 64 6f 20 66 6f 72 63 65 20 68 )) ;; do force h
86b0: 65 72 65 0a 09 20 20 28 69 66 20 28 61 72 67 73 ere.. (if (args
86c0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 :get-arg "-runst
86d0: 65 70 22 29 0a 09 20 20 20 20 20 20 28 69 66 20 ep").. (if
86e0: 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 0a (null? remargs).
86f0: 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 .. (begin...
8700: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
8710: 22 45 52 52 4f 52 3a 20 6e 6f 74 68 69 6e 67 20 "ERROR: nothing
8720: 73 70 65 63 69 66 69 65 64 20 74 6f 20 72 75 6e specified to run
8730: 21 22 29 0a 09 09 20 20 20 20 28 69 66 20 64 62 !")... (if db
8740: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
8750: 7a 65 21 20 64 62 29 29 0a 09 09 20 20 20 20 28 ze! db))... (
8760: 65 78 69 74 20 36 29 29 0a 09 09 20 20 28 6c 65 exit 6))... (le
8770: 74 2a 20 28 28 73 74 65 70 6e 61 6d 65 20 20 20 t* ((stepname
8780: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8790: 72 75 6e 73 74 65 70 22 29 29 0a 09 09 09 20 28 runstep")).... (
87a0: 6c 6f 67 70 72 6f 66 69 6c 65 20 28 61 72 67 73 logprofile (args
87b0: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 70 72 :get-arg "-logpr
87c0: 6f 22 29 29 0a 09 09 09 20 28 6c 6f 67 66 69 6c o")).... (logfil
87d0: 65 20 20 20 20 28 63 6f 6e 63 20 73 74 65 70 6e e (conc stepn
87e0: 61 6d 65 20 22 2e 6c 6f 67 22 29 29 0a 09 09 09 ame ".log"))....
87f0: 20 28 63 6d 64 20 20 20 20 20 20 20 20 28 69 66 (cmd (if
8800: 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 (null? remargs)
8810: 20 23 66 20 28 63 61 72 20 72 65 6d 61 72 67 73 #f (car remargs
8820: 29 29 29 0a 09 09 09 20 28 70 61 72 61 6d 73 20 ))).... (params
8830: 20 20 20 20 28 69 66 20 63 6d 64 20 28 63 64 72 (if cmd (cdr
8840: 20 72 65 6d 61 72 67 73 29 20 27 28 29 29 29 0a remargs) '())).
8850: 09 09 09 20 28 65 78 69 74 73 74 61 74 20 20 20 ... (exitstat
8860: 23 66 29 0a 09 09 09 20 28 73 68 65 6c 6c 20 20 #f).... (shell
8870: 20 20 20 20 28 6c 61 73 74 20 28 73 74 72 69 6e (last (strin
8880: 67 2d 73 70 6c 69 74 20 28 67 65 74 2d 65 6e 76 g-split (get-env
8890: 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c ironment-variabl
88a0: 65 20 22 53 48 45 4c 4c 22 29 20 22 2f 22 29 29 e "SHELL") "/"))
88b0: 29 0a 09 09 09 20 28 72 65 64 69 72 20 20 20 20 ).... (redir
88c0: 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d (case (string-
88d0: 3e 73 79 6d 62 6f 6c 20 73 68 65 6c 6c 29 0a 09 >symbol shell)..
88e0: 09 09 09 20 20 20 20 20 20 20 28 28 74 63 73 68 ... ((tcsh
88f0: 20 63 73 68 20 6b 73 68 29 20 20 20 20 22 3e 26 csh ksh) ">&
8900: 22 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 ")..... ((
8910: 7a 73 68 20 62 61 73 68 20 73 68 20 61 73 68 29 zsh bash sh ash)
8920: 20 22 32 3e 26 31 20 3e 22 29 0a 09 09 09 09 20 "2>&1 >").....
8930: 20 20 20 20 20 20 28 65 6c 73 65 20 22 3e 26 22 (else ">&"
8940: 29 29 29 0a 09 09 09 20 28 66 75 6c 6c 63 6d 64 ))).... (fullcmd
8950: 20 20 20 20 28 63 6f 6e 63 20 22 28 22 20 28 73 (conc "(" (s
8960: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
8970: 65 20 0a 09 09 09 09 09 09 28 63 6f 6e 73 20 63 e .......(cons c
8980: 6d 64 20 70 61 72 61 6d 73 29 20 22 20 22 29 0a md params) " ").
8990: 09 09 09 09 09 20 20 20 22 29 20 22 20 72 65 64 ..... ") " red
89a0: 69 72 20 22 20 22 20 6c 6f 67 66 69 6c 65 29 29 ir " " logfile))
89b0: 29 0a 09 09 20 20 20 20 3b 3b 20 6d 61 72 6b 20 )... ;; mark
89c0: 74 68 65 20 73 74 61 72 74 20 6f 66 20 74 68 65 the start of the
89d0: 20 74 65 73 74 0a 09 09 20 20 20 20 3b 3b 20 44 test... ;; D
89e0: 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 O NOT run remote
89f0: 0a 09 09 20 20 20 20 28 64 62 3a 74 65 73 74 73 ... (db:tests
8a00: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 tep-set-status!
8a10: 64 62 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e db test-id stepn
8a20: 61 6d 65 20 22 73 74 61 72 74 22 20 22 6e 2f 61 ame "start" "n/a
8a30: 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 " (args:get-arg
8a40: 22 2d 6d 22 29 20 6c 6f 67 66 69 6c 65 20 77 6f "-m") logfile wo
8a50: 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 rk-area: work-ar
8a60: 65 61 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e ea)... ;; run
8a70: 20 74 68 65 20 74 65 73 74 20 73 74 65 70 0a 09 the test step..
8a80: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
8a90: 74 2d 69 6e 66 6f 20 32 20 22 52 75 6e 6e 69 6e t-info 2 "Runnin
8aa0: 67 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 5c g \"" fullcmd "\
8ab0: 22 22 29 0a 09 09 20 20 20 20 28 63 68 61 6e 67 "")... (chang
8ac0: 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 e-directory star
8ad0: 74 69 6e 67 64 69 72 29 0a 09 09 20 20 20 20 28 tingdir)... (
8ae0: 73 65 74 21 20 65 78 69 74 73 74 61 74 20 28 73 set! exitstat (s
8af0: 79 73 74 65 6d 20 66 75 6c 6c 63 6d 64 29 29 20 ystem fullcmd))
8b00: 3b 3b 20 63 6d 64 20 70 61 72 61 6d 73 29 29 0a ;; cmd params)).
8b10: 09 09 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f .. (set! *glo
8b20: 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 65 balexitstatus* e
8b30: 78 69 74 73 74 61 74 29 0a 09 09 20 20 20 20 28 xitstat)... (
8b40: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
8b50: 20 74 65 73 74 70 61 74 68 29 0a 09 09 20 20 20 testpath)...
8b60: 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 ;; run logpro i
8b70: 66 20 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b 20 f applicable ;;
8b80: 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c 73 (process-run "ls
8b90: 22 20 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20 22 " (list "/foo" "
8ba0: 32 3e 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67 22 2>&1" "blah.log"
8bb0: 29 29 0a 09 09 20 20 20 20 28 69 66 20 6c 6f 67 ))... (if log
8bc0: 70 72 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74 2a profile....(let*
8bd0: 20 28 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 28 ((htmllogfile (
8be0: 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e conc stepname ".
8bf0: 68 74 6d 6c 22 29 29 0a 09 09 09 20 20 20 20 20 html"))....
8c00: 20 20 28 6f 6c 64 65 78 69 74 73 74 61 74 20 65 (oldexitstat e
8c10: 78 69 74 73 74 61 74 29 0a 09 09 09 20 20 20 20 xitstat)....
8c20: 20 20 20 28 63 6d 64 20 20 20 20 20 20 20 20 20 (cmd
8c30: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
8c40: 72 73 65 20 28 6c 69 73 74 20 22 6c 6f 67 70 72 rse (list "logpr
8c50: 6f 22 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68 74 o" logprofile ht
8c60: 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c 6f mllogfile "<" lo
8c70: 67 66 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63 20 gfile ">" (conc
8c80: 73 74 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70 72 stepname "_logpr
8c90: 6f 2e 6c 6f 67 22 29 29 20 22 20 22 29 29 29 0a o.log")) " "))).
8ca0: 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
8cb0: 74 2d 69 6e 66 6f 20 32 20 22 72 75 6e 6e 69 6e t-info 2 "runnin
8cc0: 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 29 0a g \"" cmd "\"").
8cd0: 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 ... (change-dir
8ce0: 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 64 ectory startingd
8cf0: 69 72 29 0a 09 09 09 20 20 28 73 65 74 21 20 65 ir).... (set! e
8d00: 78 69 74 73 74 61 74 20 28 73 79 73 74 65 6d 20 xitstat (system
8d10: 63 6d 64 29 29 0a 09 09 09 20 20 28 73 65 74 21 cmd)).... (set!
8d20: 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 *globalexitstat
8d30: 75 73 2a 20 65 78 69 74 73 74 61 74 29 20 3b 3b us* exitstat) ;;
8d40: 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 0a 09 09 no necessary...
8d50: 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
8d60: 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
8d70: 09 09 20 20 28 63 64 62 3a 74 65 73 74 2d 73 65 .. (cdb:test-se
8d80: 74 2d 6c 6f 67 21 20 2a 72 75 6e 72 65 6d 6f 74 t-log! *runremot
8d90: 65 2a 20 74 65 73 74 2d 69 64 20 68 74 6d 6c 6c e* test-id htmll
8da0: 6f 67 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 ogfile)))...
8db0: 28 6c 65 74 20 28 28 6d 73 67 20 28 61 72 67 73 (let ((msg (args
8dc0: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 29 :get-arg "-m")))
8dd0: 0a 09 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e ... ;; DO N
8de0: 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 OT run remote...
8df0: 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 73 74 (db:testst
8e00: 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 ep-set-status! d
8e10: 62 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 b test-id stepna
8e20: 6d 65 20 22 65 6e 64 22 20 65 78 69 74 73 74 61 me "end" exitsta
8e30: 74 20 6d 73 67 20 6c 6f 67 66 69 6c 65 20 77 6f t msg logfile wo
8e40: 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 rk-area: work-ar
8e50: 65 61 29 29 0a 09 09 20 20 20 20 29 29 29 0a 09 ea))... )))..
8e60: 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a (if (or (args:
8e70: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 get-arg "-test-s
8e80: 74 61 74 75 73 22 29 0a 09 09 20 20 28 61 72 67 tatus")... (arg
8e90: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
8ea0: 76 61 6c 75 65 73 22 29 29 0a 09 20 20 20 20 20 values"))..
8eb0: 20 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 75 (let ((newstatu
8ec0: 73 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e 75 s (cond.....((nu
8ed0: 6d 62 65 72 3f 20 73 74 61 74 75 73 29 20 20 20 mber? status)
8ee0: 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 (if (equal?
8ef0: 73 74 61 74 75 73 20 30 29 20 22 50 41 53 53 22 status 0) "PASS"
8f00: 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 28 "FAIL")).....((
8f10: 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 74 61 and (string? sta
8f20: 74 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 28 tus)..... (
8f30: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 string->number s
8f40: 74 61 74 75 73 29 29 28 69 66 20 28 65 71 75 61 tatus))(if (equa
8f50: 6c 3f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 l? (string->numb
8f60: 65 72 20 73 74 61 74 75 73 29 20 30 29 20 22 50 er status) 0) "P
8f70: 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 09 ASS" "FAIL"))...
8f80: 09 09 28 65 6c 73 65 20 73 74 61 74 75 73 29 29 ..(else status))
8f90: 29 0a 09 09 20 20 20 20 3b 3b 20 74 72 61 6e 73 )... ;; trans
8fa0: 66 65 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 79 fer relevant key
8fb0: 73 20 69 6e 74 6f 20 61 20 68 61 73 68 20 74 6f s into a hash to
8fc0: 20 62 65 20 70 61 73 73 65 64 20 74 6f 20 74 65 be passed to te
8fd0: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a 09 st-set-status!..
8fe0: 09 20 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 73 . ;; could us
8ff0: 65 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 20 e an assoc list
9000: 49 20 67 75 65 73 73 2e 20 0a 09 09 20 20 20 20 I guess. ...
9010: 28 6f 74 68 65 72 64 61 74 61 20 28 6c 65 74 20 (otherdata (let
9020: 28 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 68 ((res (make-hash
9030: 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 09 20 28 -table)))..... (
9040: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
9050: 20 28 6b 65 79 29 0a 09 09 09 09 09 20 20 20 20 (key)......
9060: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
9070: 72 67 20 6b 65 79 29 0a 09 09 09 09 09 09 20 28 rg key)....... (
9080: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
9090: 72 65 73 20 6b 65 79 20 28 61 72 67 73 3a 67 65 res key (args:ge
90a0: 74 2d 61 72 67 20 6b 65 79 29 29 29 29 0a 09 09 t-arg key))))...
90b0: 09 09 09 20 20 20 28 6c 69 73 74 20 22 3a 76 61 ... (list ":va
90c0: 6c 75 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 78 lue" ":tol" ":ex
90d0: 70 65 63 74 65 64 22 20 22 3a 66 69 72 73 74 5f pected" ":first_
90e0: 65 72 72 22 20 22 3a 66 69 72 73 74 5f 77 61 72 err" ":first_war
90f0: 6e 22 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 61 n" ":units" ":ca
9100: 74 65 67 6f 72 79 22 20 22 3a 76 61 72 69 61 62 tegory" ":variab
9110: 6c 65 22 29 29 0a 09 09 09 09 20 72 65 73 29 29 le"))..... res))
9120: 29 0a 09 09 28 69 66 20 28 61 6e 64 20 28 61 72 )...(if (and (ar
9130: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
9140: 74 2d 73 74 61 74 75 73 22 29 0a 09 09 09 20 28 t-status").... (
9150: 6f 72 20 28 6e 6f 74 20 73 74 61 74 65 29 0a 09 or (not state)..
9160: 09 09 20 20 20 20 20 28 6e 6f 74 20 73 74 61 74 .. (not stat
9170: 75 73 29 29 29 0a 09 09 20 20 20 20 28 62 65 67 us)))... (beg
9180: 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 in... (debu
9190: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
91a0: 3a 20 59 6f 75 20 6d 75 73 74 20 73 70 65 63 69 : You must speci
91b0: 66 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 fy :state and :s
91c0: 74 61 74 75 73 20 77 69 74 68 20 65 76 65 72 79 tatus with every
91d0: 20 63 61 6c 6c 20 74 6f 20 2d 74 65 73 74 2d 73 call to -test-s
91e0: 74 61 74 75 73 5c 6e 22 20 68 65 6c 70 29 0a 09 tatus\n" help)..
91f0: 09 20 20 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 . ;; (sqlit
9200: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
9210: 0a 09 09 20 20 20 20 20 20 28 65 78 69 74 20 36 ... (exit 6
9220: 29 29 29 0a 09 09 28 6c 65 74 2a 20 28 28 6d 73 )))...(let* ((ms
9230: 67 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 g (args:get-a
9240: 72 67 20 22 2d 6d 22 29 29 0a 09 09 20 20 20 20 rg "-m"))...
9250: 20 20 20 28 6e 75 6d 6f 74 68 20 28 6c 65 6e 67 (numoth (leng
9260: 74 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b th (hash-table-k
9270: 65 79 73 20 6f 74 68 65 72 64 61 74 61 29 29 29 eys otherdata)))
9280: 29 0a 09 09 20 20 3b 3b 20 43 6f 6e 76 65 72 74 )... ;; Convert
9290: 20 74 6f 20 72 70 63 20 69 6e 73 69 64 65 20 74 to rpc inside t
92a0: 68 65 20 74 65 73 74 73 3a 74 65 73 74 2d 73 65 he tests:test-se
92b0: 74 2d 73 74 61 74 75 73 21 20 63 61 6c 6c 2c 20 t-status! call,
92c0: 6e 6f 74 20 68 65 72 65 0a 09 09 20 20 28 74 65 not here... (te
92d0: 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 sts:test-set-sta
92e0: 74 75 73 21 20 74 65 73 74 2d 69 64 20 73 74 61 tus! test-id sta
92f0: 74 65 20 6e 65 77 73 74 61 74 75 73 20 6d 73 67 te newstatus msg
9300: 20 6f 74 68 65 72 64 61 74 61 20 77 6f 72 6b 2d otherdata work-
9310: 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 61 29 area: work-area)
9320: 29 29 29 0a 09 20 20 28 69 66 20 64 62 20 28 73 ))).. (if db (s
9330: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
9340: 20 64 62 29 29 0a 09 20 20 28 73 65 74 21 20 2a db)).. (set! *
9350: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
9360: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
9370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
93a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
93b0: 3b 20 56 61 72 69 6f 75 73 20 68 65 6c 70 65 72 ; Various helper
93c0: 20 63 6f 6d 6d 61 6e 64 73 20 63 61 6e 20 67 6f commands can go
93d0: 20 62 65 6c 6f 77 20 68 65 72 65 0a 3b 3b 3d 3d below here.;;==
93e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
93f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9420: 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a ====..(if (args:
9430: 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 6b 65 get-arg "-showke
9440: 79 73 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 ys"). (let ((
9450: 64 62 20 23 66 29 0a 09 20 20 28 6b 65 79 73 20 db #f).. (keys
9460: 23 66 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 #f)). (if (
9470: 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 not (setup-for-r
9480: 75 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 un)).. (begin..
9490: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
94a0: 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 0 "Failed to se
94b0: 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 tup, exiting")..
94c0: 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
94d0: 20 20 20 20 20 28 73 65 74 21 20 6b 65 79 73 20 (set! keys
94e0: 28 63 62 64 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 (cbd:remote-run
94f0: 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 db:get-keys db))
9500: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
9510: 69 6e 74 20 31 20 22 4b 65 79 73 3a 20 22 20 28 int 1 "Keys: " (
9520: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
9530: 73 65 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d se (map key:get-
9540: 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 20 fieldname keys)
9550: 22 2c 20 22 29 29 0a 20 20 20 20 20 20 28 69 66 ", ")). (if
9560: 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e db (sqlite3:fin
9570: 61 6c 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 alize! db)).
9580: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
9590: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
95a0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
95b0: 22 2d 67 75 69 22 29 0a 20 20 20 20 28 62 65 67 "-gui"). (beg
95c0: 69 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a in. (debug:
95d0: 70 72 69 6e 74 20 30 20 22 4c 6f 6f 6b 20 61 74 print 0 "Look at
95e0: 20 74 68 65 20 64 61 73 68 62 6f 61 72 64 20 66 the dashboard f
95f0: 6f 72 20 6e 6f 77 22 29 0a 20 20 20 20 20 20 3b or now"). ;
9600: 3b 20 28 6d 65 67 61 74 65 73 74 2d 67 75 69 29 ; (megatest-gui)
9610: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
9620: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
9630: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
9640: 2d 61 72 67 20 22 2d 67 65 6e 2d 6d 65 67 61 74 -arg "-gen-megat
9650: 65 73 74 2d 61 72 65 61 22 29 0a 20 20 20 20 28 est-area"). (
9660: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 67 65 6e begin. (gen
9670: 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 example:mk-megat
9680: 65 73 74 2e 63 6f 6e 66 69 67 29 0a 20 20 20 20 est.config).
9690: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
96a0: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
96b0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
96c0: 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 74 "-gen-megatest-t
96d0: 65 73 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 est"). (let (
96e0: 28 74 65 73 74 6e 61 6d 65 20 28 61 72 67 73 3a (testname (args:
96f0: 67 65 74 2d 61 72 67 20 22 2d 67 65 6e 2d 6d 65 get-arg "-gen-me
9700: 67 61 74 65 73 74 2d 74 65 73 74 22 29 29 29 0a gatest-test"))).
9710: 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c (genexampl
9720: 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2d 74 65 e:mk-megatest-te
9730: 73 74 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 20 st testname).
9740: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
9750: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b ething* #t)))..;
9760: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
9770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97a0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 =======.;; Updat
97b0: 65 20 74 68 65 20 64 61 74 61 62 61 73 65 20 73 e the database s
97c0: 63 68 65 6d 61 20 6f 6e 20 72 65 71 75 65 73 74 chema on request
97d0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
97e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
9820: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
9830: 65 62 75 69 6c 64 2d 64 62 22 29 0a 20 20 20 20 ebuild-db").
9840: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 (begin. (if
9850: 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 (not (setup-for
9860: 2d 72 75 6e 29 29 0a 09 20 20 28 62 65 67 69 6e -run)).. (begin
9870: 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
9880: 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 nt 0 "Failed to
9890: 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 setup, exiting")
98a0: 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 .. (exit 1))
98b0: 29 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 ). ;; keep
98c0: 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 this one local.
98d0: 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
98e0: 6c 6f 73 65 20 70 61 74 63 68 2d 64 62 20 23 66 lose patch-db #f
98f0: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
9900: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
9910: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
9920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
9960: 55 70 64 61 74 65 20 74 68 65 20 74 65 73 74 73 Update the tests
9970: 20 6d 65 74 61 20 64 61 74 61 20 66 72 6f 6d 20 meta data from
9980: 74 68 65 20 74 65 73 74 63 6f 6e 66 69 67 20 66 the testconfig f
9990: 69 6c 65 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d iles.;;=========
99a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
99e0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
99f0: 20 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 22 29 "-update-meta")
9a00: 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
9a10: 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 (if (not (setu
9a20: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 p-for-run)).. (
9a30: 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 begin.. (debu
9a40: 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 g:print 0 "Faile
9a50: 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit
9a60: 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 ing") .. (exi
9a70: 74 20 31 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 t 1))). ;;
9a80: 6e 6f 77 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 now can find our
9a90: 20 64 62 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 db. ;; kee
9aa0: 70 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c p this one local
9ab0: 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e . (open-run
9ac0: 2d 63 6c 6f 73 65 20 72 75 6e 73 3a 75 70 64 61 -close runs:upda
9ad0: 74 65 2d 61 6c 6c 2d 74 65 73 74 5f 6d 65 74 61 te-all-test_meta
9ae0: 20 64 62 29 0a 20 20 20 20 20 20 28 73 65 74 21 db). (set!
9af0: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
9b00: 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d #t)))..;;=======
9b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
9b50: 3b 3b 20 53 74 61 72 74 20 61 20 72 65 70 6c 0a ;; Start a repl.
9b60: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
9b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ba0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f ========..(if (o
9bb0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
9bc0: 22 2d 72 65 70 6c 22 29 0a 09 28 61 72 67 73 3a "-repl")..(args:
9bd0: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 22 29 get-arg "-load")
9be0: 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f ). (let* ((to
9bf0: 70 70 61 74 68 20 28 73 65 74 75 70 2d 66 6f 72 ppath (setup-for
9c00: 2d 72 75 6e 29 29 0a 09 20 20 20 28 64 62 20 20 -run)).. (db
9c10: 20 20 20 20 28 69 66 20 74 6f 70 70 61 74 68 20 (if toppath
9c20: 28 6f 70 65 6e 2d 64 62 29 20 23 66 29 29 29 0a (open-db) #f))).
9c30: 20 20 20 20 20 20 28 69 66 20 64 62 0a 09 20 20 (if db..
9c40: 28 62 65 67 69 6e 0a 09 20 20 20 20 28 73 65 74 (begin.. (set
9c50: 21 20 2a 64 62 2a 20 64 62 29 0a 09 20 20 20 20 ! *db* db)..
9c60: 28 73 65 74 21 20 2a 63 6c 69 65 6e 74 2d 6e 6f (set! *client-no
9c70: 6e 2d 62 6c 6f 63 6b 69 6e 67 2d 6d 6f 64 65 2a n-blocking-mode*
9c80: 20 23 74 29 0a 09 20 20 20 20 3b 3b 20 28 63 6c #t).. ;; (cl
9c90: 69 65 6e 74 3a 73 65 74 75 70 29 0a 09 20 20 20 ient:setup)..
9ca0: 20 3b 3b 20 28 63 6c 69 65 6e 74 3a 6c 61 75 6e ;; (client:laun
9cb0: 63 68 29 0a 09 20 20 20 20 28 69 6d 70 6f 72 74 ch).. (import
9cc0: 20 72 65 61 64 6c 69 6e 65 29 0a 09 20 20 20 20 readline)..
9cd0: 28 69 6d 70 6f 72 74 20 61 70 72 6f 70 6f 73 29 (import apropos)
9ce0: 0a 09 20 20 20 20 28 67 6e 75 2d 68 69 73 74 6f .. (gnu-histo
9cf0: 72 79 2d 69 6e 73 74 61 6c 6c 2d 66 69 6c 65 2d ry-install-file-
9d00: 6d 61 6e 61 67 65 72 0a 09 20 20 20 20 20 28 73 manager.. (s
9d10: 74 72 69 6e 67 2d 61 70 70 65 6e 64 0a 09 20 20 tring-append..
9d20: 20 20 20 20 28 6f 72 20 28 67 65 74 2d 65 6e 76 (or (get-env
9d30: 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c ironment-variabl
9d40: 65 20 22 48 4f 4d 45 22 29 20 22 2e 22 29 20 22 e "HOME") ".") "
9d50: 2f 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 74 6f /.megatest_histo
9d60: 72 79 22 29 29 0a 09 20 20 20 20 28 63 75 72 72 ry")).. (curr
9d70: 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 20 28 ent-input-port (
9d80: 6d 61 6b 65 2d 67 6e 75 2d 72 65 61 64 6c 69 6e make-gnu-readlin
9d90: 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 65 73 74 e-port "megatest
9da0: 3e 20 22 29 29 0a 09 20 20 20 20 28 69 66 20 28 > ")).. (if (
9db0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
9dc0: 65 70 6c 22 29 0a 09 09 28 72 65 70 6c 29 0a 09 epl")...(repl)..
9dd0: 09 28 6c 6f 61 64 20 28 61 72 67 73 3a 67 65 74 .(load (args:get
9de0: 2d 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 29 29 -arg "-load"))))
9df0: 0a 09 20 20 28 65 78 69 74 29 29 0a 20 20 20 20 .. (exit)).
9e00: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
9e10: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
9e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e60: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 69 74 20 61 ======.;; Exit a
9e70: 6e 64 20 63 6c 65 61 6e 20 75 70 0a 3b 3b 3d 3d nd clean up.;;==
9e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ec0: 3d 3d 3d 3d 0a 0a 28 69 66 20 2a 72 75 6e 72 65 ====..(if *runre
9ed0: 6d 6f 74 65 2a 20 28 63 6c 6f 73 65 2d 61 6c 6c mote* (close-all
9ee0: 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 21 29 29 0a -connections!)).
9ef0: 0a 3b 3b 20 74 68 69 73 20 69 73 20 74 68 65 20 .;; this is the
9f00: 73 6f 63 6b 65 74 20 69 66 20 77 65 20 61 72 65 socket if we are
9f10: 20 61 20 63 6c 69 65 6e 74 0a 3b 3b 20 28 69 66 a client.;; (if
9f20: 20 28 61 6e 64 20 2a 72 75 6e 72 65 6d 6f 74 65 (and *runremote
9f30: 2a 0a 3b 3b 20 09 20 28 73 6f 63 6b 65 74 3f 20 *.;; . (socket?
9f40: 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 29 0a 3b 3b *runremote*)).;;
9f50: 20 20 20 20 20 28 63 6c 6f 73 65 2d 73 6f 63 6b (close-sock
9f60: 65 74 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 29 et *runremote*))
9f70: 0a 0a 28 69 66 20 28 6e 6f 74 20 2a 64 69 64 73 ..(if (not *dids
9f80: 6f 6d 65 74 68 69 6e 67 2a 29 0a 20 20 20 20 28 omething*). (
9f90: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 68 65 debug:print 0 he
9fa0: 6c 70 29 29 0a 0a 3b 3b 20 28 69 66 20 2a 72 75 lp))..;; (if *ru
9fb0: 6e 72 65 6d 6f 74 65 2a 20 28 72 70 63 3a 63 6c nremote* (rpc:cl
9fc0: 6f 73 65 2d 61 6c 6c 2d 63 6f 6e 6e 65 63 74 69 ose-all-connecti
9fd0: 6f 6e 73 21 29 29 0a 20 20 20 20 0a 28 69 66 20 ons!)). .(if
9fe0: 28 6e 6f 74 20 28 65 71 3f 20 2a 67 6c 6f 62 61 (not (eq? *globa
9ff0: 6c 65 78 69 74 73 74 61 74 75 73 2a 20 30 29 29 lexitstatus* 0))
a000: 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 61 72 . (if (or (ar
a010: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
a020: 74 65 73 74 73 22 29 28 61 72 67 73 3a 67 65 74 tests")(args:get
a030: 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 29 -arg "-runall"))
a040: 0a 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a . (begin.
a050: 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 (debu
a060: 67 3a 70 72 69 6e 74 20 30 20 22 4e 4f 54 45 3a g:print 0 "NOTE:
a070: 20 53 75 62 70 72 6f 63 65 73 73 65 73 20 77 69 Subprocesses wi
a080: 74 68 20 6e 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 th non-zero exit
a090: 20 63 6f 64 65 20 64 65 74 65 63 74 65 64 3a 20 code detected:
a0a0: 22 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 " *globalexitsta
a0b0: 74 75 73 2a 29 0a 20 20 20 20 20 20 20 20 20 20 tus*).
a0c0: 20 28 65 78 69 74 20 30 29 29 0a 20 20 20 20 20 (exit 0)).
a0d0: 20 20 20 28 63 61 73 65 20 2a 67 6c 6f 62 61 6c (case *global
a0e0: 65 78 69 74 73 74 61 74 75 73 2a 0a 20 20 20 20 exitstatus*.
a0f0: 20 20 20 20 20 28 28 30 29 28 65 78 69 74 20 30 ((0)(exit 0
a100: 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 31 29 )). ((1)
a110: 28 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 20 (exit 1)).
a120: 20 20 20 28 28 32 29 28 65 78 69 74 20 32 29 29 ((2)(exit 2))
a130: 0a 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 . (else
a140: 28 65 78 69 74 20 33 29 29 29 29 29 0a (exit 3))))).