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 20 64 69 72 65 http-client dire
01f0: 63 74 6f 72 79 2d 75 74 69 6c 73 29 20 3b 3b 20 ctory-utils) ;;
0200: 28 73 72 66 69 20 31 38 29 20 65 78 74 72 61 73 (srfi 18) extras
0210: 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 ).(import (prefi
0220: 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 x sqlite3 sqlite
0230: 33 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 3:)).(import (pr
0240: 65 66 69 78 20 62 61 73 65 36 34 20 62 61 73 65 efix base64 base
0250: 36 34 3a 29 29 0a 0a 3b 3b 20 28 75 73 65 20 7a 64:))..;; (use z
0260: 6d 71 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 mq)..(declare (u
0270: 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 ses common)).(de
0280: 63 6c 61 72 65 20 28 75 73 65 73 20 6d 65 67 61 clare (uses mega
0290: 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 29 0a 28 test-version)).(
02a0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d 61 declare (uses ma
02b0: 72 67 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 rgs)).(declare (
02c0: 75 73 65 73 20 72 75 6e 73 29 29 0a 28 64 65 63 uses runs)).(dec
02d0: 6c 61 72 65 20 28 75 73 65 73 20 6c 61 75 6e 63 lare (uses launc
02e0: 68 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 h)).(declare (us
02f0: 65 73 20 73 65 72 76 65 72 29 29 0a 28 64 65 63 es server)).(dec
0300: 6c 61 72 65 20 28 75 73 65 73 20 63 6c 69 65 6e lare (uses clien
0310: 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 t)).(declare (us
0320: 65 73 20 74 65 73 74 73 29 29 0a 28 64 65 63 6c es tests)).(decl
0330: 61 72 65 20 28 75 73 65 73 20 67 65 6e 65 78 61 are (uses genexa
0340: 6d 70 6c 65 29 29 0a 28 64 65 63 6c 61 72 65 20 mple)).(declare
0350: 28 75 73 65 73 20 64 61 65 6d 6f 6e 29 29 0a 28 (uses daemon)).(
0360: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 declare (uses db
0370: 29 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 )).;; (declare (
0380: 75 73 65 73 20 73 64 62 29 29 0a 3b 3b 20 28 64 uses sdb)).;; (d
0390: 65 63 6c 61 72 65 20 28 75 73 65 73 20 66 69 6c eclare (uses fil
03a0: 65 64 62 29 29 0a 28 64 65 63 6c 61 72 65 20 28 edb)).(declare (
03b0: 75 73 65 73 20 74 64 62 29 29 0a 28 64 65 63 6c uses tdb)).(decl
03c0: 61 72 65 20 28 75 73 65 73 20 6d 74 29 29 0a 28 are (uses mt)).(
03d0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 61 70 declare (uses ap
03e0: 69 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 i)).(declare (us
03f0: 65 73 20 74 61 73 6b 73 29 29 20 3b 3b 20 6f 6e es tasks)) ;; on
0400: 6c 79 20 75 73 65 64 20 66 6f 72 20 64 65 62 75 ly used for debu
0410: 67 67 69 6e 67 2e 0a 0a 28 64 65 66 69 6e 65 20 gging...(define
0420: 2a 64 62 2a 20 23 66 29 20 3b 3b 20 74 68 69 73 *db* #f) ;; this
0430: 20 69 73 20 6f 6e 6c 79 20 66 6f 72 20 74 68 65 is only for the
0440: 20 72 65 70 6c 2c 20 64 6f 20 6e 6f 74 20 75 73 repl, do not us
0450: 65 20 69 6e 20 67 65 6e 65 72 61 6c 21 21 21 21 e in general!!!!
0460: 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d ..(include "comm
0470: 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 on_records.scm")
0480: 0a 28 69 6e 63 6c 75 64 65 20 22 6b 65 79 5f 72 .(include "key_r
0490: 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e ecords.scm").(in
04a0: 63 6c 75 64 65 20 22 64 62 5f 72 65 63 6f 72 64 clude "db_record
04b0: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
04c0: 20 22 72 75 6e 5f 72 65 63 6f 72 64 73 2e 73 63 "run_records.sc
04d0: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 6d 65 m").(include "me
04e0: 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 gatest-fossil-ha
04f0: 73 68 2e 73 63 6d 22 29 0a 0a 28 6c 65 74 20 28 sh.scm")..(let (
0500: 28 64 65 62 75 67 63 6f 6e 74 72 6f 6c 66 20 28 (debugcontrolf (
0510: 63 6f 6e 63 20 28 67 65 74 2d 65 6e 76 69 72 6f conc (get-enviro
0520: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
0530: 48 4f 4d 45 22 29 20 22 2f 2e 6d 65 67 61 74 65 HOME") "/.megate
0540: 73 74 72 63 22 29 29 29 0a 20 20 28 69 66 20 28 strc"))). (if (
0550: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 65 62 file-exists? deb
0560: 75 67 63 6f 6e 74 72 6f 6c 66 29 0a 20 20 20 20 ugcontrolf).
0570: 20 20 28 6c 6f 61 64 20 64 65 62 75 67 63 6f 6e (load debugcon
0580: 74 72 6f 6c 66 29 29 29 0a 0a 3b 3b 20 44 69 73 trolf)))..;; Dis
0590: 61 62 6c 65 64 20 68 65 6c 70 20 69 74 65 6d 73 abled help items
05a0: 0a 3b 3b 20 20 2d 72 6f 6c 6c 75 70 20 20 20 20 .;; -rollup
05b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 28 : (
05c0: 63 75 72 72 65 6e 74 6c 79 20 64 69 73 61 62 6c currently disabl
05d0: 65 64 29 20 66 69 6c 6c 20 72 75 6e 20 28 73 65 ed) fill run (se
05e0: 74 20 62 79 20 3a 72 75 6e 6e 61 6d 65 29 20 20 t by :runname)
05f0: 77 69 74 68 20 6c 61 74 65 73 74 20 74 65 73 74 with latest test
0600: 28 73 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 (s).;;
0610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0620: 20 20 66 72 6f 6d 20 70 72 69 6f 72 20 72 75 6e from prior run
0630: 73 20 77 69 74 68 20 73 61 6d 65 20 6b 65 79 73 s with same keys
0640: 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 28 ..(define help (
0650: 63 6f 6e 63 20 22 0a 4d 65 67 61 74 65 73 74 2c conc ".Megatest,
0660: 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20 61 documentation a
0670: 74 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 t http://www.kia
0680: 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f toa.com/fossils/
0690: 6d 65 67 61 74 65 73 74 0a 20 20 76 65 72 73 69 megatest. versi
06a0: 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 on " megatest-ve
06b0: 72 73 69 6f 6e 20 22 0a 20 20 6c 69 63 65 6e 73 rsion ". licens
06c0: 65 20 47 50 4c 2c 20 43 6f 70 79 72 69 67 68 74 e GPL, Copyright
06d0: 20 4d 61 74 74 20 57 65 6c 6c 61 6e 64 20 32 30 Matt Welland 20
06e0: 30 36 2d 32 30 31 32 0a 0a 55 73 61 67 65 3a 20 06-2012..Usage:
06f0: 6d 65 67 61 74 65 73 74 20 5b 6f 70 74 69 6f 6e megatest [option
0700: 73 5d 0a 20 20 2d 68 20 20 20 20 20 20 20 20 20 s]. -h
0710: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 74 : t
0720: 68 69 73 20 68 65 6c 70 0a 20 20 2d 76 65 72 73 his help. -vers
0730: 69 6f 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 ion
0740: 20 20 20 3a 20 70 72 69 6e 74 20 6d 65 67 61 74 : print megat
0750: 65 73 74 20 76 65 72 73 69 6f 6e 20 28 63 75 72 est version (cur
0760: 72 65 6e 74 6c 79 20 22 20 6d 65 67 61 74 65 73 rently " megates
0770: 74 2d 76 65 72 73 69 6f 6e 20 22 29 0a 0a 4c 61 t-version ")..La
0780: 75 6e 63 68 69 6e 67 20 61 6e 64 20 6d 61 6e 61 unching and mana
0790: 67 69 6e 67 20 72 75 6e 73 0a 20 20 2d 72 75 6e ging runs. -run
07a0: 61 6c 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 all
07b0: 20 20 20 20 3a 20 72 75 6e 20 61 6c 6c 20 74 65 : run all te
07c0: 73 74 73 20 74 68 61 74 20 61 72 65 20 6e 6f 74 sts that are not
07d0: 20 73 74 61 74 65 20 43 4f 4d 50 4c 45 54 45 44 state COMPLETED
07e0: 20 61 6e 64 20 73 74 61 74 75 73 20 50 41 53 53 and status PASS
07f0: 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 , .
0800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 43 C
0810: 48 45 43 4b 20 6f 72 20 4b 49 4c 4c 45 44 0a 20 HECK or KILLED.
0820: 20 2d 72 75 6e 74 65 73 74 73 20 74 73 74 31 2c -runtests tst1,
0830: 74 73 74 32 20 2e 2e 2e 20 3a 20 72 75 6e 20 74 tst2 ... : run t
0840: 65 73 74 73 0a 20 20 2d 72 65 6d 6f 76 65 2d 72 ests. -remove-r
0850: 75 6e 73 20 20 20 20 20 20 20 20 20 20 20 20 3a uns :
0860: 20 72 65 6d 6f 76 65 20 74 68 65 20 64 61 74 61 remove the data
0870: 20 66 6f 72 20 61 20 72 75 6e 2c 20 72 65 71 75 for a run, requ
0880: 69 72 65 73 20 2d 72 75 6e 6e 61 6d 65 20 61 6e ires -runname an
0890: 64 20 2d 74 65 73 74 70 61 74 74 0a 20 20 20 20 d -testpatt.
08a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
08b0: 20 20 20 20 20 20 20 20 4f 70 74 69 6f 6e 61 6c Optional
08c0: 6c 79 20 75 73 65 20 3a 73 74 61 74 65 20 61 6e ly use :state an
08d0: 64 20 3a 73 74 61 74 75 73 0a 20 20 2d 73 65 74 d :status. -set
08e0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 58 2c -state-status X,
08f0: 59 20 20 20 3a 20 73 65 74 20 73 74 61 74 65 20 Y : set state
0900: 74 6f 20 58 20 61 6e 64 20 73 74 61 74 75 73 20 to X and status
0910: 74 6f 20 59 2c 20 72 65 71 75 69 72 65 73 20 63 to Y, requires c
0920: 6f 6e 74 72 6f 6c 73 20 70 65 72 20 2d 72 65 6d ontrols per -rem
0930: 6f 76 65 2d 72 75 6e 73 0a 20 20 2d 72 65 72 75 ove-runs. -reru
0940: 6e 20 46 41 49 4c 2c 57 41 52 4e 2e 2e 2e 20 20 n FAIL,WARN...
0950: 20 20 20 3a 20 66 6f 72 63 65 20 72 65 2d 72 75 : force re-ru
0960: 6e 20 66 6f 72 20 74 65 73 74 73 20 77 69 74 68 n for tests with
0970: 20 73 70 65 63 69 66 69 63 65 64 20 73 74 61 74 specificed stat
0980: 75 73 28 73 29 0a 20 20 2d 6c 6f 63 6b 20 20 20 us(s). -lock
0990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09a0: 3a 20 6c 6f 63 6b 20 72 75 6e 20 73 70 65 63 69 : lock run speci
09b0: 66 69 65 64 20 62 79 20 74 61 72 67 65 74 20 61 fied by target a
09c0: 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 20 2d 75 6e nd runname. -un
09d0: 6c 6f 63 6b 20 20 20 20 20 20 20 20 20 20 20 20 lock
09e0: 20 20 20 20 20 3a 20 75 6e 6c 6f 63 6b 20 72 75 : unlock ru
09f0: 6e 20 73 70 65 63 69 66 69 65 64 20 62 79 20 74 n specified by t
0a00: 61 72 67 65 74 20 61 6e 64 20 72 75 6e 6e 61 6d arget and runnam
0a10: 65 0a 20 20 2d 73 65 74 2d 72 75 6e 2d 73 74 61 e. -set-run-sta
0a20: 74 75 73 20 73 74 61 74 75 73 20 20 3a 20 73 65 tus status : se
0a30: 74 73 20 73 74 61 74 75 73 20 66 6f 72 20 72 75 ts status for ru
0a40: 6e 20 74 6f 20 73 74 61 74 75 73 2c 20 72 65 71 n to status, req
0a50: 75 69 72 65 73 20 2d 74 61 72 67 65 74 20 61 6e uires -target an
0a60: 64 20 2d 72 75 6e 6e 61 6d 65 0a 20 20 2d 67 65 d -runname. -ge
0a70: 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 20 20 20 t-run-status
0a80: 20 20 20 20 20 3a 20 67 65 74 73 20 73 74 61 74 : gets stat
0a90: 75 73 20 66 6f 72 20 72 75 6e 20 73 70 65 63 69 us for run speci
0aa0: 66 69 65 64 20 62 79 20 74 61 72 67 65 74 20 61 fied by target a
0ab0: 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 20 2d 72 75 nd runname. -ru
0ac0: 6e 2d 77 61 69 74 20 20 20 20 20 20 20 20 20 20 n-wait
0ad0: 20 20 20 20 20 3a 20 77 61 69 74 20 6f 6e 20 72 : wait on r
0ae0: 75 6e 20 73 70 65 63 69 66 69 65 64 20 62 79 20 un specified by
0af0: 74 61 72 67 65 74 20 61 6e 64 20 72 75 6e 6e 61 target and runna
0b00: 6d 65 0a 20 20 2d 70 72 65 63 6c 65 61 6e 20 20 me. -preclean
0b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 : r
0b20: 65 6d 6f 76 65 20 74 68 65 20 65 78 69 73 74 69 emove the existi
0b30: 6e 67 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 ng test director
0b40: 79 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 6e 67 y before running
0b50: 20 74 68 65 20 74 65 73 74 0a 0a 53 65 6c 65 63 the test..Selec
0b60: 74 6f 72 73 20 28 65 2e 67 2e 20 75 73 65 20 66 tors (e.g. use f
0b70: 6f 72 20 2d 72 75 6e 74 65 73 74 73 2c 20 2d 72 or -runtests, -r
0b80: 65 6d 6f 76 65 2d 72 75 6e 73 2c 20 2d 73 65 74 emove-runs, -set
0b90: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2c 20 2d -state-status, -
0ba0: 6c 69 73 74 2d 72 75 6e 73 20 65 74 63 2e 29 0a list-runs etc.).
0bb0: 20 20 2d 74 61 72 67 65 74 20 6b 65 79 31 2f 6b -target key1/k
0bc0: 65 79 32 2f 2e 2e 2e 20 20 20 3a 20 72 75 6e 20 ey2/... : run
0bd0: 66 6f 72 20 6b 65 79 31 2c 20 6b 65 79 32 2c 20 for key1, key2,
0be0: 65 74 63 2e 0a 20 20 2d 72 65 71 74 61 72 67 20 etc.. -reqtarg
0bf0: 6b 65 79 31 2f 6b 65 79 32 2f 2e 2e 2e 20 20 3a key1/key2/... :
0c00: 20 72 75 6e 20 66 6f 72 20 6b 65 79 31 2c 20 6b run for key1, k
0c10: 65 79 32 2c 20 65 74 63 2e 20 62 75 74 20 6b 65 ey2, etc. but ke
0c20: 79 31 2f 6b 65 79 32 20 6d 75 73 74 20 62 65 20 y1/key2 must be
0c30: 69 6e 20 72 75 6e 63 6f 6e 66 69 67 0a 20 20 2d in runconfig. -
0c40: 74 65 73 74 70 61 74 74 20 70 61 74 74 31 2f 70 testpatt patt1/p
0c50: 61 74 74 32 2c 70 61 74 74 33 2f 2e 2e 2e 20 20 att2,patt3/...
0c60: 3a 20 25 20 69 73 20 77 69 6c 64 63 61 72 64 0a : % is wildcard.
0c70: 20 20 2d 72 75 6e 6e 61 6d 65 20 20 20 20 20 20 -runname
0c80: 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 71 75 : requ
0c90: 69 72 65 64 2c 20 6e 61 6d 65 20 66 6f 72 20 74 ired, name for t
0ca0: 68 69 73 20 70 61 72 74 69 63 75 6c 61 72 20 74 his particular t
0cb0: 65 73 74 20 72 75 6e 0a 20 20 2d 73 74 61 74 65 est run. -state
0cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0cd0: 20 20 3a 20 41 70 70 6c 69 65 73 20 74 6f 20 72 : Applies to r
0ce0: 75 6e 73 2c 20 74 65 73 74 73 20 6f 72 20 73 74 uns, tests or st
0cf0: 65 70 73 20 64 65 70 65 6e 64 69 6e 67 20 6f 6e eps depending on
0d00: 20 63 6f 6e 74 65 78 74 0a 20 20 2d 73 74 61 74 context. -stat
0d10: 75 73 20 20 20 20 20 20 20 20 20 20 20 20 20 20 us
0d20: 20 20 20 3a 20 41 70 70 6c 69 65 73 20 74 6f 20 : Applies to
0d30: 72 75 6e 73 2c 20 74 65 73 74 73 20 6f 72 20 73 runs, tests or s
0d40: 74 65 70 73 20 64 65 70 65 6e 64 69 6e 67 20 6f teps depending o
0d50: 6e 20 63 6f 6e 74 65 78 74 0a 0a 54 65 73 74 20 n context..Test
0d60: 68 65 6c 70 65 72 73 20 28 66 6f 72 20 75 73 65 helpers (for use
0d70: 20 69 6e 73 69 64 65 20 74 65 73 74 73 29 0a 20 inside tests).
0d80: 20 2d 73 74 65 70 20 73 74 65 70 6e 61 6d 65 0a -step stepname.
0d90: 20 20 2d 74 65 73 74 2d 73 74 61 74 75 73 20 20 -test-status
0da0: 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 : set
0db0: 74 68 65 20 73 74 61 74 65 20 61 6e 64 20 73 74 the state and st
0dc0: 61 74 75 73 20 6f 66 20 61 20 74 65 73 74 20 28 atus of a test (
0dd0: 75 73 65 20 3a 73 74 61 74 65 20 61 6e 64 20 3a use :state and :
0de0: 73 74 61 74 75 73 29 0a 20 20 2d 73 65 74 6c 6f status). -setlo
0df0: 67 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 20 20 g logfname
0e00: 20 20 3a 20 73 65 74 20 74 68 65 20 70 61 74 68 : set the path
0e10: 2f 66 69 6c 65 6e 61 6d 65 20 74 6f 20 74 68 65 /filename to the
0e20: 20 66 69 6e 61 6c 20 6c 6f 67 20 72 65 6c 61 74 final log relat
0e30: 69 76 65 20 74 6f 20 74 68 65 20 74 65 73 74 0a ive to the test.
0e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e50: 20 20 20 20 20 20 20 20 20 20 20 20 64 69 72 65 dire
0e60: 63 74 6f 72 79 2e 20 6d 61 79 20 62 65 20 75 73 ctory. may be us
0e70: 65 64 20 77 69 74 68 20 2d 74 65 73 74 2d 73 74 ed with -test-st
0e80: 61 74 75 73 0a 20 20 2d 73 65 74 2d 74 6f 70 6c atus. -set-topl
0e90: 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 3a og logfname :
0ea0: 20 73 65 74 20 74 68 65 20 6f 76 65 72 61 6c 6c set the overall
0eb0: 20 6c 6f 67 20 66 6f 72 20 61 20 73 75 69 74 65 log for a suite
0ec0: 20 6f 66 20 73 75 62 2d 74 65 73 74 73 0a 20 20 of sub-tests.
0ed0: 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 -summarize-items
0ee0: 20 20 20 20 20 20 20 20 3a 20 66 6f 72 20 61 6e : for an
0ef0: 20 69 74 65 6d 69 7a 65 64 20 74 65 73 74 20 63 itemized test c
0f00: 72 65 61 74 65 20 61 20 73 75 6d 6d 61 72 79 20 reate a summary
0f10: 68 74 6d 6c 20 0a 20 20 2d 6d 20 63 6f 6d 6d 65 html . -m comme
0f20: 6e 74 20 20 20 20 20 20 20 20 20 20 20 20 20 20 nt
0f30: 3a 20 69 6e 73 65 72 74 20 61 20 63 6f 6d 6d 65 : insert a comme
0f40: 6e 74 20 66 6f 72 20 74 68 69 73 20 74 65 73 74 nt for this test
0f50: 0a 0a 54 65 73 74 20 64 61 74 61 20 63 61 70 74 ..Test data capt
0f60: 75 72 65 0a 20 20 2d 73 65 74 2d 76 61 6c 75 65 ure. -set-value
0f70: 73 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 s :
0f80: 75 70 64 61 74 65 20 6f 72 20 73 65 74 20 76 61 update or set va
0f90: 6c 75 65 73 20 69 6e 20 74 68 65 20 74 65 73 74 lues in the test
0fa0: 64 61 74 61 20 74 61 62 6c 65 0a 20 20 3a 63 61 data table. :ca
0fb0: 74 65 67 6f 72 79 20 20 20 20 20 20 20 20 20 20 tegory
0fc0: 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 63 : set the c
0fd0: 61 74 65 67 6f 72 79 20 66 69 65 6c 64 20 28 6f ategory field (o
0fe0: 70 74 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 72 69 ptional). :vari
0ff0: 61 62 6c 65 20 20 20 20 20 20 20 20 20 20 20 20 able
1000: 20 20 20 3a 20 73 65 74 20 74 68 65 20 76 61 72 : set the var
1010: 69 61 62 6c 65 20 6e 61 6d 65 20 28 6f 70 74 69 iable name (opti
1020: 6f 6e 61 6c 29 0a 20 20 3a 76 61 6c 75 65 20 20 onal). :value
1030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1040: 3a 20 76 61 6c 75 65 20 6d 65 61 73 75 72 65 64 : value measured
1050: 20 28 72 65 71 75 69 72 65 64 29 0a 20 20 3a 65 (required). :e
1060: 78 70 65 63 74 65 64 20 20 20 20 20 20 20 20 20 xpected
1070: 20 20 20 20 20 20 3a 20 76 61 6c 75 65 20 65 78 : value ex
1080: 70 65 63 74 65 64 20 28 72 65 71 75 69 72 65 64 pected (required
1090: 29 0a 20 20 3a 74 6f 6c 20 20 20 20 20 20 20 20 ). :tol
10a0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 7c 76 : |v
10b0: 61 6c 75 65 2d 65 78 70 65 63 74 7c 20 3c 3d 20 alue-expect| <=
10c0: 74 6f 6c 20 28 72 65 71 75 69 72 65 64 2c 20 63 tol (required, c
10d0: 61 6e 20 62 65 20 3c 2c 20 3e 2c 20 3e 3d 2c 20 an be <, >, >=,
10e0: 3c 3d 20 6f 72 20 6e 75 6d 62 65 72 29 0a 20 20 <= or number).
10f0: 3a 75 6e 69 74 73 20 20 20 20 20 20 20 20 20 20 :units
1100: 20 20 20 20 20 20 20 20 3a 20 6e 61 6d 65 20 6f : name o
1110: 66 20 74 68 65 20 75 6e 69 74 73 20 66 6f 72 20 f the units for
1120: 76 61 6c 75 65 2c 20 65 78 70 65 63 74 65 64 5f value, expected_
1130: 76 61 6c 75 65 20 65 74 63 2e 20 28 6f 70 74 69 value etc. (opti
1140: 6f 6e 61 6c 29 0a 20 20 2d 6c 6f 61 64 2d 74 65 onal). -load-te
1150: 73 74 2d 64 61 74 61 20 20 20 20 20 20 20 20 20 st-data
1160: 3a 20 72 65 61 64 20 74 65 73 74 20 73 70 65 63 : read test spec
1170: 69 66 69 63 20 64 61 74 61 20 66 6f 72 20 73 74 ific data for st
1180: 6f 72 61 67 65 20 69 6e 20 74 68 65 20 74 65 73 orage in the tes
1190: 74 5f 64 61 74 61 20 74 61 62 6c 65 0a 20 20 20 t_data table.
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 20 20 66 72 6f 6d 20 73 74 from st
11c0: 61 6e 64 61 72 64 20 69 6e 2e 20 45 61 63 68 20 andard in. Each
11d0: 6c 69 6e 65 20 69 73 20 63 6f 6d 6d 61 20 64 65 line is comma de
11e0: 6c 69 6d 69 74 65 64 20 77 69 74 68 20 66 6f 75 limited with fou
11f0: 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r.
1200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 69 fi
1210: 65 6c 64 73 20 63 61 74 65 67 6f 72 79 2c 76 61 elds category,va
1220: 72 69 61 62 6c 65 2c 76 61 6c 75 65 2c 63 6f 6d riable,value,com
1230: 6d 65 6e 74 0a 0a 51 75 65 72 69 65 73 0a 20 20 ment..Queries.
1240: 2d 6c 69 73 74 2d 72 75 6e 73 20 70 61 74 74 20 -list-runs patt
1250: 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 72 : list r
1260: 75 6e 73 20 6d 61 74 63 68 69 6e 67 20 70 61 74 uns matching pat
1270: 74 65 72 6e 20 5c 22 70 61 74 74 5c 22 2c 20 25 tern \"patt\", %
1280: 20 69 73 20 74 68 65 20 77 69 6c 64 63 61 72 64 is the wildcard
1290: 0a 20 20 2d 73 68 6f 77 2d 6b 65 79 73 20 20 20 . -show-keys
12a0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 68 6f : sho
12b0: 77 20 74 68 65 20 6b 65 79 73 20 75 73 65 64 20 w the keys used
12c0: 69 6e 20 74 68 69 73 20 6d 65 67 61 74 65 73 74 in this megatest
12d0: 20 73 65 74 75 70 0a 20 20 2d 74 65 73 74 2d 66 setup. -test-f
12e0: 69 6c 65 73 20 74 61 72 67 70 61 74 74 20 20 20 iles targpatt
12f0: 20 3a 20 67 65 74 20 74 68 65 20 6d 6f 73 74 20 : get the most
1300: 72 65 63 65 6e 74 20 74 65 73 74 20 70 61 74 68 recent test path
1310: 2f 66 69 6c 65 20 6d 61 74 63 68 69 6e 67 20 74 /file matching t
1320: 61 72 67 70 61 74 74 20 65 2e 67 2e 20 25 2f 25 argpatt e.g. %/%
1330: 2e 2e 2e 20 0a 20 20 20 20 20 20 20 20 20 20 20 ... .
1340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1350: 20 72 65 74 75 72 6e 73 20 6c 69 73 74 20 73 6f returns list so
1360: 72 74 65 64 20 62 79 20 61 67 65 20 61 73 63 65 rted by age asce
1370: 6e 64 69 6e 67 2c 20 73 65 65 20 65 78 61 6d 70 nding, see examp
1380: 6c 65 73 20 62 65 6c 6f 77 0a 20 20 2d 74 65 73 les below. -tes
1390: 74 2d 70 61 74 68 73 20 20 20 20 20 20 20 20 20 t-paths
13a0: 20 20 20 20 3a 20 67 65 74 20 74 68 65 20 74 65 : get the te
13b0: 73 74 20 70 61 74 68 73 20 6d 61 74 63 68 69 6e st paths matchin
13c0: 67 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d g target, runnam
13d0: 65 2c 20 69 74 65 6d 20 61 6e 64 20 74 65 73 74 e, item and test
13e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
13f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 61 74 pat
1400: 74 65 72 6e 73 2e 0a 20 20 2d 6c 69 73 74 2d 64 terns.. -list-d
1410: 69 73 6b 73 20 20 20 20 20 20 20 20 20 20 20 20 isks
1420: 20 3a 20 6c 69 73 74 20 74 68 65 20 64 69 73 6b : list the disk
1430: 73 20 61 76 61 69 6c 61 62 6c 65 20 66 6f 72 20 s available for
1440: 73 74 6f 72 69 6e 67 20 72 75 6e 73 0a 20 20 2d storing runs. -
1450: 6c 69 73 74 2d 74 61 72 67 65 74 73 20 20 20 20 list-targets
1460: 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 : list th
1470: 65 20 74 61 72 67 65 74 73 20 69 6e 20 72 75 6e e targets in run
1480: 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 0a 20 configs.config.
1490: 20 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 -list-db-target
14a0: 73 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 s : list
14b0: 74 68 65 20 74 61 72 67 65 74 20 63 6f 6d 62 69 the target combi
14c0: 6e 61 74 69 6f 6e 73 20 75 73 65 64 20 69 6e 20 nations used in
14d0: 74 68 65 20 64 62 0a 20 20 2d 73 68 6f 77 2d 63 the db. -show-c
14e0: 6f 6e 66 69 67 20 20 20 20 20 20 20 20 20 20 20 onfig
14f0: 20 3a 20 64 75 6d 70 20 74 68 65 20 69 6e 74 65 : dump the inte
1500: 72 6e 61 6c 20 72 65 70 72 65 73 65 6e 74 61 74 rnal representat
1510: 69 6f 6e 20 6f 66 20 74 68 65 20 6d 65 67 61 74 ion of the megat
1520: 65 73 74 2e 63 6f 6e 66 69 67 20 66 69 6c 65 0a est.config file.
1530: 20 20 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 -show-runconfi
1540: 67 20 20 20 20 20 20 20 20 20 3a 20 64 75 6d 70 g : dump
1550: 20 74 68 65 20 69 6e 74 65 72 6e 61 6c 20 72 65 the internal re
1560: 70 72 65 73 65 6e 74 61 74 69 6f 6e 20 6f 66 20 presentation of
1570: 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 the runconfigs.c
1580: 6f 6e 66 69 67 20 66 69 6c 65 0a 20 20 2d 64 75 onfig file. -du
1590: 6d 70 6d 6f 64 65 20 6a 73 6f 6e 20 20 20 20 20 mpmode json
15a0: 20 20 20 20 20 3a 20 64 75 6d 70 20 69 6e 20 6a : dump in j
15b0: 73 6f 6e 20 66 6f 72 6d 61 74 20 69 6e 73 74 65 son format inste
15c0: 61 64 20 6f 66 20 73 65 78 70 72 0a 20 20 2d 73 ad of sexpr. -s
15d0: 68 6f 77 2d 63 6d 64 69 6e 66 6f 20 20 20 20 20 how-cmdinfo
15e0: 20 20 20 20 20 20 3a 20 64 75 6d 70 20 74 68 65 : dump the
15f0: 20 63 6f 6d 6d 61 6e 64 20 69 6e 66 6f 20 66 6f command info fo
1600: 72 20 61 20 74 65 73 74 20 28 72 75 6e 20 69 6e r a test (run in
1610: 20 74 65 73 74 20 65 6e 76 69 72 6f 6e 6d 65 6e test environmen
1620: 74 29 0a 20 20 2d 73 65 63 74 69 6f 6e 20 73 65 t). -section se
1630: 63 74 69 6f 6e 4e 61 6d 65 0a 20 20 2d 76 61 72 ctionName. -var
1640: 20 76 61 72 4e 61 6d 65 20 20 20 20 20 20 20 20 varName
1650: 20 20 20 20 3a 20 66 6f 72 20 63 6f 6e 66 69 67 : for config
1660: 20 61 6e 64 20 72 75 6e 63 6f 6e 66 69 67 20 6c and runconfig l
1670: 6f 6f 6b 75 70 20 76 61 6c 75 65 20 66 6f 72 20 ookup value for
1680: 73 65 63 74 69 6f 6e 4e 61 6d 65 20 76 61 72 4e sectionName varN
1690: 61 6d 65 0a 0a 4d 69 73 63 20 0a 20 20 2d 73 74 ame..Misc . -st
16a0: 61 72 74 2d 64 69 72 20 70 61 74 68 20 20 20 20 art-dir path
16b0: 20 20 20 20 20 3a 20 73 77 69 74 63 68 20 74 6f : switch to
16c0: 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 20 this directory
16d0: 62 65 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 6d before running m
16e0: 65 67 61 74 65 73 74 0a 20 20 2d 72 65 62 75 69 egatest. -rebui
16f0: 6c 64 2d 64 62 20 20 20 20 20 20 20 20 20 20 20 ld-db
1700: 20 20 3a 20 62 72 69 6e 67 20 74 68 65 20 64 61 : bring the da
1710: 74 61 62 61 73 65 20 73 63 68 65 6d 61 20 75 70 tabase schema up
1720: 20 74 6f 20 64 61 74 65 0a 20 20 2d 63 6c 65 61 to date. -clea
1730: 6e 75 70 2d 64 62 20 20 20 20 20 20 20 20 20 20 nup-db
1740: 20 20 20 3a 20 72 65 6d 6f 76 65 20 61 6e 79 20 : remove any
1750: 6f 72 70 68 61 6e 20 72 65 63 6f 72 64 73 2c 20 orphan records,
1760: 76 61 63 75 75 6d 20 74 68 65 20 64 62 0a 20 20 vacuum the db.
1770: 2d 69 6d 70 6f 72 74 2d 6d 65 67 61 74 65 73 74 -import-megatest
1780: 2e 64 62 20 20 20 20 20 3a 20 6d 69 67 72 61 74 .db : migrat
1790: 65 20 61 20 64 61 74 61 62 61 73 65 20 66 72 6f e a database fro
17a0: 6d 20 76 31 2e 35 35 20 73 65 72 69 65 73 20 74 m v1.55 series t
17b0: 6f 20 76 31 2e 36 30 20 73 65 72 69 65 73 0a 20 o v1.60 series.
17c0: 20 2d 75 70 64 61 74 65 2d 6d 65 74 61 20 20 20 -update-meta
17d0: 20 20 20 20 20 20 20 20 20 3a 20 75 70 64 61 74 : updat
17e0: 65 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 61 e the tests meta
17f0: 64 61 74 61 20 66 6f 72 20 61 6c 6c 20 74 65 73 data for all tes
1800: 74 73 0a 20 20 2d 73 65 74 76 61 72 73 20 56 41 ts. -setvars VA
1810: 52 31 3d 76 61 6c 31 2c 56 41 52 32 3d 76 61 6c R1=val1,VAR2=val
1820: 32 20 3a 20 41 64 64 20 65 6e 76 69 72 6f 6e 6d 2 : Add environm
1830: 65 6e 74 20 76 61 72 69 61 62 6c 65 73 20 74 6f ent variables to
1840: 20 61 20 72 75 6e 20 4e 42 2f 2f 20 74 68 65 73 a run NB// thes
1850: 65 20 61 72 65 0a 20 20 20 20 20 20 20 20 20 20 e are.
1860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1870: 20 20 20 20 20 20 20 6f 76 65 72 77 72 69 74 74 overwritt
1880: 65 6e 20 62 79 20 76 61 6c 75 65 73 20 73 65 74 en by values set
1890: 20 69 6e 20 63 6f 6e 66 69 67 20 66 69 6c 65 73 in config files
18a0: 2e 0a 20 20 2d 73 65 72 76 65 72 20 2d 7c 68 6f .. -server -|ho
18b0: 73 74 6e 61 6d 65 20 20 20 20 20 20 3a 20 73 74 stname : st
18c0: 61 72 74 20 74 68 65 20 73 65 72 76 65 72 20 28 art the server (
18d0: 72 65 64 75 63 65 73 20 63 6f 6e 74 65 6e 74 69 reduces contenti
18e0: 6f 6e 20 6f 6e 20 6d 65 67 61 74 65 73 74 2e 64 on on megatest.d
18f0: 62 29 2c 20 75 73 65 0a 20 20 20 20 20 20 20 20 b), use.
1900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1910: 20 20 20 20 2d 20 74 6f 20 61 75 74 6f 6d 61 74 - to automat
1920: 69 63 61 6c 6c 79 20 66 69 67 75 72 65 20 6f 75 ically figure ou
1930: 74 20 68 6f 73 74 6e 61 6d 65 0a 20 20 2d 64 61 t hostname. -da
1940: 65 6d 6f 6e 69 7a 65 20 20 20 20 20 20 20 20 20 emonize
1950: 20 20 20 20 20 3a 20 66 6f 72 6b 20 69 6e 74 6f : fork into
1960: 20 62 61 63 6b 67 72 6f 75 6e 64 20 61 6e 64 20 background and
1970: 64 69 73 63 6f 6e 6e 65 63 74 20 66 72 6f 6d 20 disconnect from
1980: 73 74 64 69 6e 2f 6f 75 74 0a 20 20 2d 6c 6f 67 stdin/out. -log
1990: 20 6c 6f 67 66 69 6c 65 20 20 20 20 20 20 20 20 logfile
19a0: 20 20 20 20 3a 20 73 65 6e 64 20 73 74 64 6f 75 : send stdou
19b0: 74 20 61 6e 64 20 73 74 64 65 72 72 20 74 6f 20 t and stderr to
19c0: 6c 6f 67 66 69 6c 65 0a 20 20 2d 6c 69 73 74 2d logfile. -list-
19d0: 73 65 72 76 65 72 73 20 20 20 20 20 20 20 20 20 servers
19e0: 20 20 3a 20 6c 69 73 74 20 74 68 65 20 73 65 72 : list the ser
19f0: 76 65 72 73 20 0a 20 20 2d 73 74 6f 70 2d 73 65 vers . -stop-se
1a00: 72 76 65 72 20 69 64 20 20 20 20 20 20 20 20 20 rver id
1a10: 3a 20 73 74 6f 70 20 73 65 72 76 65 72 20 73 70 : stop server sp
1a20: 65 63 69 66 69 65 64 20 62 79 20 69 64 20 28 73 ecified by id (s
1a30: 65 65 20 6f 75 74 70 75 74 20 6f 66 20 2d 6c 69 ee output of -li
1a40: 73 74 2d 73 65 72 76 65 72 73 29 2c 20 75 73 65 st-servers), use
1a50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 30 20 74 0 t
1a70: 6f 20 6b 69 6c 6c 20 61 6c 6c 0a 20 20 2d 72 65 o kill all. -re
1a80: 70 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 20 pl
1a90: 20 20 20 20 20 3a 20 73 74 61 72 74 20 61 20 72 : start a r
1aa0: 65 70 6c 20 28 75 73 65 66 75 6c 20 66 6f 72 20 epl (useful for
1ab0: 65 78 74 65 6e 64 69 6e 67 20 6d 65 67 61 74 65 extending megate
1ac0: 73 74 29 0a 20 20 2d 6c 6f 61 64 20 66 69 6c 65 st). -load file
1ad0: 2e 73 63 6d 20 20 20 20 20 20 20 20 20 20 3a 20 .scm :
1ae0: 6c 6f 61 64 20 61 6e 64 20 72 75 6e 20 66 69 6c load and run fil
1af0: 65 2e 73 63 6d 0a 20 20 2d 6d 61 72 6b 2d 69 6e e.scm. -mark-in
1b00: 63 6f 6d 70 6c 65 74 65 73 20 20 20 20 20 20 20 completes
1b10: 3a 20 66 69 6e 64 20 61 6e 64 20 6d 61 72 6b 20 : find and mark
1b20: 69 6e 63 6f 6d 70 6c 65 74 65 20 74 65 73 74 73 incomplete tests
1b30: 0a 20 20 2d 70 69 6e 67 20 72 75 6e 2d 69 64 7c . -ping run-id|
1b40: 68 6f 73 74 3a 70 6f 72 74 20 20 3a 20 70 69 6e host:port : pin
1b50: 67 20 73 65 72 76 65 72 2c 20 65 78 69 74 20 77 g server, exit w
1b60: 69 74 68 20 30 20 69 66 20 66 6f 75 6e 64 0a 0a ith 0 if found..
1b70: 55 74 69 6c 69 74 69 65 73 0a 20 20 2d 65 6e 76 Utilities. -env
1b80: 32 66 69 6c 65 20 66 6e 61 6d 65 20 20 20 20 20 2file fname
1b90: 20 20 20 20 3a 20 77 72 69 74 65 20 74 68 65 20 : write the
1ba0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 74 6f 20 66 environment to f
1bb0: 6e 61 6d 65 2e 63 73 68 20 61 6e 64 20 66 6e 61 name.csh and fna
1bc0: 6d 65 2e 73 68 0a 20 20 2d 72 65 66 64 62 32 64 me.sh. -refdb2d
1bd0: 61 74 20 72 65 66 64 62 20 20 20 20 20 20 20 20 at refdb
1be0: 3a 20 63 6f 6e 76 65 72 74 20 72 65 66 64 62 20 : convert refdb
1bf0: 74 6f 20 73 65 78 70 20 6f 72 20 74 6f 20 66 6f to sexp or to fo
1c00: 72 6d 61 74 20 73 70 65 63 69 66 69 65 64 20 62 rmat specified b
1c10: 79 20 2d 64 75 6d 70 6d 6f 64 65 0a 20 20 20 20 y -dumpmode.
1c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c30: 20 20 20 20 20 20 20 20 66 6f 72 6d 61 74 73 3a formats:
1c40: 20 70 65 72 6c 2c 20 72 75 62 79 2c 20 73 71 6c perl, ruby, sql
1c50: 69 74 65 33 0a 20 20 2d 6f 20 20 20 20 20 20 20 ite3. -o
1c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
1c70: 20 6f 75 74 70 75 74 20 66 69 6c 65 20 66 6f 72 output file for
1c80: 20 72 65 66 64 62 32 64 61 74 20 28 64 65 66 61 refdb2dat (defa
1c90: 75 6c 74 73 20 74 6f 20 73 74 64 6f 75 74 29 0a ults to stdout).
1ca0: 0a 53 70 72 65 61 64 73 68 65 65 74 20 67 65 6e .Spreadsheet gen
1cb0: 65 72 61 74 69 6f 6e 0a 20 20 2d 65 78 74 72 61 eration. -extra
1cc0: 63 74 2d 6f 64 73 20 66 6e 61 6d 65 2e 6f 64 73 ct-ods fname.ods
1cd0: 20 20 3a 20 65 78 74 72 61 63 74 20 61 6e 20 6f : extract an o
1ce0: 70 65 6e 20 64 6f 63 75 6d 65 6e 74 20 73 70 72 pen document spr
1cf0: 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 74 68 eadsheet from th
1d00: 65 20 64 61 74 61 62 61 73 65 0a 20 20 2d 70 61 e database. -pa
1d10: 74 68 6d 6f 64 20 70 61 74 68 20 20 20 20 20 20 thmod path
1d20: 20 20 20 20 20 3a 20 69 6e 73 65 72 74 20 70 61 : insert pa
1d30: 74 68 2c 20 69 2e 65 2e 20 70 61 74 68 2f 72 75 th, i.e. path/ru
1d40: 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f name/itempath/lo
1d50: 67 66 69 6c 65 2e 68 74 6d 6c 0a 20 20 20 20 20 gfile.html.
1d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d70: 20 20 20 20 20 20 20 77 69 6c 6c 20 63 6c 65 61 will clea
1d80: 72 20 74 68 65 20 66 69 65 6c 64 20 69 66 20 6e r the field if n
1d90: 6f 20 72 75 6e 64 69 72 2f 74 65 73 74 6e 61 6d o rundir/testnam
1da0: 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 69 e/itempath/logfi
1db0: 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 le.
1dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 i
1dd0: 66 20 69 74 20 63 6f 6e 74 61 69 6e 73 20 66 6f f it contains fo
1de0: 72 77 61 72 64 20 73 6c 61 73 68 65 73 20 74 68 rward slashes th
1df0: 65 20 70 61 74 68 20 77 69 6c 6c 20 62 65 20 63 e path will be c
1e00: 6f 6e 76 65 72 74 65 64 0a 20 20 20 20 20 20 20 onverted.
1e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e20: 20 20 20 20 20 74 6f 20 77 69 6e 64 6f 77 73 20 to windows
1e30: 73 74 79 6c 65 0a 47 65 74 74 69 6e 67 20 73 74 style.Getting st
1e40: 61 72 74 65 64 0a 20 20 2d 67 65 6e 2d 6d 65 67 arted. -gen-meg
1e50: 61 74 65 73 74 2d 61 72 65 61 20 20 20 20 20 20 atest-area
1e60: 20 3a 20 63 72 65 61 74 65 20 61 20 73 6b 65 6c : create a skel
1e70: 65 74 6f 6e 20 6d 65 67 61 74 65 73 74 20 61 72 eton megatest ar
1e80: 65 61 2e 20 59 6f 75 20 77 69 6c 6c 20 62 65 20 ea. You will be
1e90: 70 72 6f 6d 70 74 65 64 20 66 6f 72 20 70 61 74 prompted for pat
1ea0: 68 73 0a 20 20 2d 67 65 6e 2d 6d 65 67 61 74 65 hs. -gen-megate
1eb0: 73 74 2d 74 65 73 74 20 74 6e 61 6d 65 20 3a 20 st-test tname :
1ec0: 63 72 65 61 74 65 20 61 20 73 6b 65 6c 65 74 6f create a skeleto
1ed0: 6e 20 6d 65 67 61 74 65 73 74 20 74 65 73 74 2e n megatest test.
1ee0: 20 59 6f 75 20 77 69 6c 6c 20 62 65 20 70 72 6f You will be pro
1ef0: 6d 70 74 65 64 20 66 6f 72 20 69 6e 66 6f 0a 0a mpted for info..
1f00: 45 78 61 6d 70 6c 65 73 0a 0a 23 20 47 65 74 20 Examples..# Get
1f10: 74 65 73 74 20 70 61 74 68 2c 20 75 73 65 20 27 test path, use '
1f20: 2e 27 20 74 6f 20 67 65 74 20 61 20 73 69 6e 67 .' to get a sing
1f30: 6c 65 20 70 61 74 68 20 6f 72 20 61 20 73 70 65 le path or a spe
1f40: 63 69 66 69 63 20 70 61 74 68 2f 66 69 6c 65 20 cific path/file
1f50: 70 61 74 74 65 72 6e 0a 6d 65 67 61 74 65 73 74 pattern.megatest
1f60: 20 2d 74 65 73 74 2d 66 69 6c 65 73 20 27 6c 6f -test-files 'lo
1f70: 67 73 2f 2a 2e 6c 6f 67 27 20 2d 74 61 72 67 65 gs/*.log' -targe
1f80: 74 20 75 62 75 6e 74 75 2f 6e 25 2f 6e 6f 25 20 t ubuntu/n%/no%
1f90: 2d 72 75 6e 6e 61 6d 65 20 77 34 39 25 20 2d 74 -runname w49% -t
1fa0: 65 73 74 70 61 74 74 20 74 65 73 74 5f 6d 74 25 estpatt test_mt%
1fb0: 0a 0a 43 61 6c 6c 65 64 20 61 73 20 22 20 28 73 ..Called as " (s
1fc0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
1fd0: 65 20 28 61 72 67 76 29 20 22 20 22 29 20 22 0a e (argv) " ") ".
1fe0: 56 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 Version " megate
1ff0: 73 74 2d 76 65 72 73 69 6f 6e 20 22 2c 20 62 75 st-version ", bu
2000: 69 6c 74 20 66 72 6f 6d 20 22 20 6d 65 67 61 74 ilt from " megat
2010: 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 20 est-fossil-hash
2020: 29 29 0a 0a 3b 3b 20 20 2d 67 75 69 20 20 20 20 ))..;; -gui
2030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2040: 3a 20 73 74 61 72 74 20 61 20 67 75 69 20 69 6e : start a gui in
2050: 74 65 72 66 61 63 65 0a 3b 3b 20 20 2d 63 6f 6e terface.;; -con
2060: 66 69 67 20 66 6e 61 6d 65 20 20 20 20 20 20 20 fig fname
2070: 20 20 20 20 3a 20 6f 76 65 72 72 69 64 65 20 74 : override t
2080: 68 65 20 72 75 6e 63 6f 6e 66 69 67 20 66 69 6c he runconfig fil
2090: 65 20 77 69 74 68 20 66 6e 61 6d 65 0a 0a 3b 3b e with fname..;;
20a0: 20 70 72 6f 63 65 73 73 20 61 72 67 73 0a 28 64 process args.(d
20b0: 65 66 69 6e 65 20 72 65 6d 61 72 67 73 20 28 61 efine remargs (a
20c0: 72 67 73 3a 67 65 74 2d 61 72 67 73 20 0a 09 09 rgs:get-args ...
20d0: 20 28 61 72 67 76 29 0a 09 09 20 28 6c 69 73 74 (argv)... (list
20e0: 20 20 22 2d 72 75 6e 74 65 73 74 73 22 20 20 3b "-runtests" ;
20f0: 3b 20 72 75 6e 20 61 20 73 70 65 63 69 66 69 63 ; run a specific
2100: 20 74 65 73 74 0a 09 09 09 22 2d 63 6f 6e 66 69 test...."-confi
2110: 67 22 20 20 20 20 3b 3b 20 6f 76 65 72 72 69 64 g" ;; overrid
2120: 65 20 74 68 65 20 63 6f 6e 66 69 67 20 66 69 6c e the config fil
2130: 65 20 6e 61 6d 65 0a 09 09 09 22 2d 65 78 65 63 e name...."-exec
2140: 75 74 65 22 20 20 20 3b 3b 20 72 75 6e 20 74 68 ute" ;; run th
2150: 65 20 63 6f 6d 6d 61 6e 64 20 65 6e 63 6f 64 65 e command encode
2160: 64 20 69 6e 20 74 68 65 20 62 61 73 65 36 34 20 d in the base64
2170: 70 61 72 61 6d 65 74 65 72 0a 09 09 09 22 2d 73 parameter...."-s
2180: 74 65 70 22 0a 09 09 09 22 2d 74 61 72 67 65 74 tep"...."-target
2190: 22 0a 09 09 09 22 2d 72 65 71 74 61 72 67 22 0a "...."-reqtarg".
21a0: 09 09 09 22 3a 72 75 6e 6e 61 6d 65 22 0a 09 09 ...":runname"...
21b0: 09 22 2d 72 75 6e 6e 61 6d 65 22 0a 09 09 09 22 ."-runname"...."
21c0: 3a 73 74 61 74 65 22 20 20 0a 09 09 09 22 2d 73 :state" ...."-s
21d0: 74 61 74 65 22 0a 09 09 09 22 3a 73 74 61 74 75 tate"....":statu
21e0: 73 22 0a 09 09 09 22 2d 73 74 61 74 75 73 22 0a s"...."-status".
21f0: 09 09 09 22 2d 6c 69 73 74 2d 72 75 6e 73 22 0a ..."-list-runs".
2200: 09 09 09 22 2d 74 65 73 74 70 61 74 74 22 20 0a ..."-testpatt" .
2210: 09 09 09 22 2d 69 74 65 6d 70 61 74 74 22 0a 09 ..."-itempatt"..
2220: 09 09 22 2d 73 65 74 6c 6f 67 22 0a 09 09 09 22 .."-setlog"...."
2230: 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 0a 09 09 09 -set-toplog"....
2240: 22 2d 72 75 6e 73 74 65 70 22 0a 09 09 09 22 2d "-runstep"...."-
2250: 6c 6f 67 70 72 6f 22 0a 09 09 09 22 2d 6d 22 0a logpro"...."-m".
2260: 09 09 09 22 2d 72 65 72 75 6e 22 0a 09 09 09 22 ..."-rerun"...."
2270: 2d 64 61 79 73 22 0a 09 09 09 22 2d 72 65 6e 61 -days"...."-rena
2280: 6d 65 2d 72 75 6e 22 0a 09 09 09 22 2d 74 6f 22 me-run"...."-to"
2290: 0a 09 09 09 3b 3b 20 76 61 6c 75 65 73 20 61 6e ....;; values an
22a0: 64 20 6d 65 73 73 61 67 65 73 0a 09 09 09 22 3a d messages....":
22b0: 63 61 74 65 67 6f 72 79 22 0a 09 09 09 22 3a 76 category"....":v
22c0: 61 72 69 61 62 6c 65 22 0a 09 09 09 22 3a 76 61 ariable"....":va
22d0: 6c 75 65 22 0a 09 09 09 22 3a 65 78 70 65 63 74 lue"....":expect
22e0: 65 64 22 0a 09 09 09 22 3a 74 6f 6c 22 0a 09 09 ed"....":tol"...
22f0: 09 22 3a 75 6e 69 74 73 22 0a 09 09 09 3b 3b 20 .":units"....;;
2300: 6d 69 73 63 0a 09 09 09 22 2d 73 74 61 72 74 2d misc...."-start-
2310: 64 69 72 22 0a 09 09 09 22 2d 73 65 72 76 65 72 dir"...."-server
2320: 22 0a 09 09 09 22 2d 73 74 6f 70 2d 73 65 72 76 "...."-stop-serv
2330: 65 72 22 0a 09 09 09 22 2d 70 6f 72 74 22 0a 09 er"...."-port"..
2340: 09 09 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 .."-extract-ods"
2350: 0a 09 09 09 22 2d 70 61 74 68 6d 6f 64 22 0a 09 ...."-pathmod"..
2360: 09 09 22 2d 65 6e 76 32 66 69 6c 65 22 0a 09 09 .."-env2file"...
2370: 09 22 2d 73 65 74 76 61 72 73 22 0a 09 09 09 22 ."-setvars"...."
2380: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
2390: 73 22 0a 09 09 09 22 2d 73 65 74 2d 72 75 6e 2d s"...."-set-run-
23a0: 73 74 61 74 75 73 22 0a 09 09 09 22 2d 64 65 62 status"...."-deb
23b0: 75 67 22 20 3b 3b 20 66 6f 72 20 2a 76 65 72 62 ug" ;; for *verb
23c0: 6f 73 69 74 79 2a 20 3e 20 32 0a 09 09 09 22 2d osity* > 2...."-
23d0: 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 gen-megatest-tes
23e0: 74 22 0a 09 09 09 22 2d 6f 76 65 72 72 69 64 65 t"...."-override
23f0: 2d 74 69 6d 65 6f 75 74 22 0a 09 09 09 22 2d 74 -timeout"...."-t
2400: 65 73 74 2d 66 69 6c 65 73 22 20 20 3b 3b 20 2d est-files" ;; -
2410: 74 65 73 74 2d 70 61 74 68 73 20 69 73 20 66 6f test-paths is fo
2420: 72 20 6c 69 73 74 69 6e 67 20 61 6c 6c 0a 09 09 r listing all...
2430: 09 22 2d 6c 6f 61 64 22 20 20 20 20 20 20 20 20 ."-load"
2440: 3b 3b 20 6c 6f 61 64 20 61 6e 64 20 65 78 65 63 ;; load and exec
2450: 74 75 74 65 20 61 20 73 63 68 65 6d 65 20 66 69 tute a scheme fi
2460: 6c 65 0a 09 09 09 22 2d 73 65 63 74 69 6f 6e 22 le...."-section"
2470: 0a 09 09 09 22 2d 76 61 72 22 0a 09 09 09 22 2d ...."-var"...."-
2480: 64 75 6d 70 6d 6f 64 65 22 0a 09 09 09 22 2d 72 dumpmode"...."-r
2490: 75 6e 2d 69 64 22 0a 09 09 09 22 2d 70 69 6e 67 un-id"...."-ping
24a0: 22 0a 09 09 09 22 2d 72 65 66 64 62 32 64 61 74 "...."-refdb2dat
24b0: 22 0a 09 09 09 22 2d 6f 22 0a 09 09 09 22 2d 6c "...."-o"...."-l
24c0: 6f 67 22 0a 09 09 09 29 20 0a 09 09 20 28 6c 69 og"....) ... (li
24d0: 73 74 20 20 22 2d 68 22 20 22 2d 68 65 6c 70 22 st "-h" "-help"
24e0: 20 22 2d 2d 68 65 6c 70 22 0a 09 09 09 22 2d 76 "--help"...."-v
24f0: 65 72 73 69 6f 6e 22 0a 09 09 20 20 20 20 20 20 ersion"...
2500: 20 20 22 2d 66 6f 72 63 65 22 0a 09 09 20 20 20 "-force"...
2510: 20 20 20 20 20 22 2d 78 74 65 72 6d 22 0a 09 09 "-xterm"...
2520: 20 20 20 20 20 20 20 20 22 2d 73 68 6f 77 6b 65 "-showke
2530: 79 73 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d ys"... "-
2540: 73 68 6f 77 2d 6b 65 79 73 22 0a 09 09 20 20 20 show-keys"...
2550: 20 20 20 20 20 22 2d 74 65 73 74 2d 73 74 61 74 "-test-stat
2560: 75 73 22 0a 09 09 09 22 2d 73 65 74 2d 76 61 6c us"...."-set-val
2570: 75 65 73 22 0a 09 09 09 22 2d 6c 6f 61 64 2d 74 ues"...."-load-t
2580: 65 73 74 2d 64 61 74 61 22 0a 09 09 09 22 2d 73 est-data"...."-s
2590: 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 0a ummarize-items".
25a0: 09 09 20 20 20 20 20 20 20 20 22 2d 67 75 69 22 .. "-gui"
25b0: 0a 09 09 09 22 2d 64 61 65 6d 6f 6e 69 7a 65 22 ...."-daemonize"
25c0: 0a 09 09 09 22 2d 70 72 65 63 6c 65 61 6e 22 0a ...."-preclean".
25d0: 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 09 22 2d ...;; misc...."-
25e0: 61 72 63 68 69 76 65 22 0a 09 09 09 22 2d 72 65 archive"...."-re
25f0: 70 6c 22 0a 09 09 09 22 2d 6c 6f 63 6b 22 0a 09 pl"...."-lock"..
2600: 09 09 22 2d 75 6e 6c 6f 63 6b 22 0a 09 09 09 22 .."-unlock"...."
2610: 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 0a 20 -list-servers".
2620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2630: 20 20 20 20 20 20 20 22 2d 72 75 6e 2d 77 61 69 "-run-wai
2640: 74 22 20 20 20 20 20 20 3b 3b 20 77 61 69 74 20 t" ;; wait
2650: 6f 6e 20 61 20 72 75 6e 20 74 6f 20 63 6f 6d 70 on a run to comp
2660: 6c 65 74 65 20 28 69 2e 65 2e 20 6e 6f 20 52 55 lete (i.e. no RU
2670: 4e 4e 49 4e 47 29 0a 0a 09 09 09 3b 3b 20 6d 69 NNING).....;; mi
2680: 73 63 20 71 75 65 72 69 65 73 0a 09 09 09 22 2d sc queries...."-
2690: 6c 69 73 74 2d 64 69 73 6b 73 22 0a 09 09 09 22 list-disks"...."
26a0: 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 22 0a 09 -list-targets"..
26b0: 09 09 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 .."-list-db-targ
26c0: 65 74 73 22 0a 09 09 09 22 2d 73 68 6f 77 2d 72 ets"...."-show-r
26d0: 75 6e 63 6f 6e 66 69 67 22 0a 09 09 09 22 2d 73 unconfig"...."-s
26e0: 68 6f 77 2d 63 6f 6e 66 69 67 22 0a 09 09 09 22 how-config"...."
26f0: 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 6f 22 0a 09 -show-cmdinfo"..
2700: 09 09 22 2d 67 65 74 2d 72 75 6e 2d 73 74 61 74 .."-get-run-stat
2710: 75 73 22 0a 0a 09 09 09 3b 3b 20 71 75 65 72 69 us".....;; queri
2720: 65 73 0a 09 09 09 22 2d 74 65 73 74 2d 70 61 74 es...."-test-pat
2730: 68 73 22 20 3b 3b 20 67 65 74 20 70 61 74 68 28 hs" ;; get path(
2740: 73 29 20 74 6f 20 61 20 74 65 73 74 2c 20 6f 72 s) to a test, or
2750: 64 65 72 65 64 20 62 79 20 79 6f 75 6e 67 65 73 dered by younges
2760: 74 20 66 69 72 73 74 0a 0a 09 09 09 22 2d 72 75 t first....."-ru
2770: 6e 61 6c 6c 22 20 20 20 20 3b 3b 20 72 75 6e 20 nall" ;; run
2780: 61 6c 6c 20 74 65 73 74 73 0a 09 09 09 22 2d 72 all tests...."-r
2790: 65 6d 6f 76 65 2d 72 75 6e 73 22 0a 09 09 09 22 emove-runs"...."
27a0: 2d 72 65 62 75 69 6c 64 2d 64 62 22 0a 09 09 09 -rebuild-db"....
27b0: 22 2d 63 6c 65 61 6e 75 70 2d 64 62 22 0a 09 09 "-cleanup-db"...
27c0: 09 22 2d 72 6f 6c 6c 75 70 22 0a 09 09 09 22 2d ."-rollup"...."-
27d0: 75 70 64 61 74 65 2d 6d 65 74 61 22 0a 09 09 09 update-meta"....
27e0: 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 61 "-gen-megatest-a
27f0: 72 65 61 22 0a 09 09 09 22 2d 6d 61 72 6b 2d 69 rea"...."-mark-i
2800: 6e 63 6f 6d 70 6c 65 74 65 73 22 0a 0a 09 09 09 ncompletes".....
2810: 22 2d 63 6f 6e 76 65 72 74 2d 74 6f 2d 6e 6f 72 "-convert-to-nor
2820: 6d 22 0a 09 09 09 22 2d 63 6f 6e 76 65 72 74 2d m"...."-convert-
2830: 74 6f 2d 6f 6c 64 22 0a 09 09 09 22 2d 69 6d 70 to-old"...."-imp
2840: 6f 72 74 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 ort-megatest.db"
2850: 0a 0a 09 09 09 22 2d 6c 6f 67 67 69 6e 67 22 0a ....."-logging".
2860: 09 09 09 22 2d 76 22 20 3b 3b 20 76 65 72 62 6f ..."-v" ;; verbo
2870: 73 65 20 32 2c 20 6d 6f 72 65 20 74 68 61 6e 20 se 2, more than
2880: 6e 6f 72 6d 61 6c 20 28 6e 6f 72 6d 61 6c 20 69 normal (normal i
2890: 73 20 31 29 0a 09 09 09 22 2d 71 22 20 3b 3b 20 s 1)...."-q" ;;
28a0: 71 75 69 65 74 20 30 2c 20 65 72 72 6f 72 73 2f quiet 0, errors/
28b0: 77 61 72 6e 69 6e 67 73 20 6f 6e 6c 79 0a 09 09 warnings only...
28c0: 20 20 20 20 20 20 20 29 0a 09 09 20 61 72 67 73 )... args
28d0: 3a 61 72 67 2d 68 61 73 68 0a 09 09 20 30 29 29 :arg-hash... 0))
28e0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
28f0: 61 72 67 20 22 2d 6c 6f 67 22 29 0a 20 20 20 20 arg "-log").
2900: 28 6c 65 74 20 28 28 6f 75 70 20 28 6f 70 65 6e (let ((oup (open
2910: 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 28 61 72 -output-file (ar
2920: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 gs:get-arg "-log
2930: 22 29 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 ")))). (deb
2940: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
2950: 22 53 65 6e 64 69 6e 67 20 6c 6f 67 20 6f 75 74 "Sending log out
2960: 70 75 74 20 74 6f 20 22 20 28 61 72 67 73 3a 67 put to " (args:g
2970: 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 29 0a et-arg "-log")).
2980: 20 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 65 (current-e
2990: 72 72 6f 72 2d 70 6f 72 74 20 6f 75 70 29 0a 20 rror-port oup).
29a0: 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 6f 75 (current-ou
29b0: 74 70 75 74 2d 70 6f 72 74 20 6f 75 70 29 29 29 tput-port oup)))
29c0: 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a ..(if (or (args:
29d0: 67 65 74 2d 61 72 67 20 22 2d 68 22 29 0a 09 28 get-arg "-h")..(
29e0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 args:get-arg "-h
29f0: 65 6c 70 22 29 0a 09 28 61 72 67 73 3a 67 65 74 elp")..(args:get
2a00: 2d 61 72 67 20 22 2d 2d 68 65 6c 70 22 29 29 0a -arg "--help")).
2a10: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
2a20: 20 28 70 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 (print help).
2a30: 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a 28 69 (exit)))..(i
2a40: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
2a50: 22 2d 73 74 61 72 74 2d 64 69 72 22 29 0a 20 20 "-start-dir").
2a60: 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 (if (file-exis
2a70: 74 73 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ts? (args:get-ar
2a80: 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 g "-start-dir"))
2a90: 0a 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 ..(change-direct
2aa0: 6f 72 79 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ory (args:get-ar
2ab0: 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 g "-start-dir"))
2ac0: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 ..(begin.. (deb
2ad0: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
2ae0: 52 3a 20 6e 6f 6e 2d 65 78 69 73 74 61 6e 74 20 R: non-existant
2af0: 73 74 61 72 74 20 64 69 72 20 22 20 28 61 72 67 start dir " (arg
2b00: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 s:get-arg "-star
2b10: 74 2d 64 69 72 22 29 20 22 20 73 70 65 63 69 66 t-dir") " specif
2b20: 69 65 64 2c 20 65 78 69 74 69 6e 67 2e 22 29 0a ied, exiting.").
2b30: 09 20 20 28 65 78 69 74 20 31 29 29 29 29 0a 0a . (exit 1))))..
2b40: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
2b50: 67 20 22 2d 76 65 72 73 69 6f 6e 22 29 0a 20 20 g "-version").
2b60: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
2b70: 70 72 69 6e 74 20 6d 65 67 61 74 65 73 74 2d 76 print megatest-v
2b80: 65 72 73 69 6f 6e 29 0a 20 20 20 20 20 20 28 65 ersion). (e
2b90: 78 69 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 xit)))..(define
2ba0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
2bb0: 66 29 0a 0a 3b 3b 20 4f 76 65 72 61 6c 6c 20 65 f)..;; Overall e
2bc0: 78 69 74 20 68 61 6e 64 6c 69 6e 67 20 73 65 74 xit handling set
2bd0: 75 70 20 69 6d 6d 65 64 69 61 74 65 6c 79 0a 3b up immediately.;
2be0: 3b 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a ;.(if (or (args:
2bf0: 67 65 74 2d 61 72 67 20 22 2d 70 72 6f 63 65 73 get-arg "-proces
2c00: 73 2d 72 65 61 70 22 29 29 0a 20 20 20 20 20 20 s-reap")).
2c10: 20 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 ;; (args:get-a
2c20: 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a rg "-runtests").
2c30: 09 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 .;; (args:get-ar
2c40: 67 20 22 2d 65 78 65 63 75 74 65 22 29 0a 09 3b g "-execute")..;
2c50: 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ; (args:get-arg
2c60: 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a "-remove-runs").
2c70: 09 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 .;; (args:get-ar
2c80: 67 20 22 2d 72 75 6e 73 74 65 70 22 29 29 0a 20 g "-runstep")).
2c90: 20 20 20 28 6c 65 74 20 28 28 6f 72 69 67 69 6e (let ((origin
2ca0: 61 6c 2d 65 78 69 74 20 28 65 78 69 74 2d 68 61 al-exit (exit-ha
2cb0: 6e 64 6c 65 72 29 29 29 0a 20 20 20 20 20 20 28 ndler))). (
2cc0: 65 78 69 74 2d 68 61 6e 64 6c 65 72 20 28 6c 61 exit-handler (la
2cd0: 6d 62 64 61 20 28 23 21 6f 70 74 69 6f 6e 61 6c mbda (#!optional
2ce0: 20 28 65 78 69 74 2d 63 6f 64 65 20 30 29 29 0a (exit-code 0)).
2cf0: 09 09 20 20 20 20 20 20 28 70 72 69 6e 74 66 20 .. (printf
2d00: 22 50 72 65 70 61 72 69 6e 67 20 74 6f 20 65 78 "Preparing to ex
2d10: 69 74 20 77 69 74 68 20 65 78 69 74 20 63 6f 64 it with exit cod
2d20: 65 20 7e 41 20 2e 2e 2e 5c 6e 22 20 65 78 69 74 e ~A ...\n" exit
2d30: 2d 63 6f 64 65 29 0a 09 09 20 20 20 20 20 20 28 -code)... (
2d40: 66 6f 72 2d 65 61 63 68 20 0a 09 09 20 20 20 20 for-each ...
2d50: 20 20 20 28 6c 61 6d 62 64 61 20 28 70 69 64 29 (lambda (pid)
2d60: 0a 09 09 09 20 28 68 61 6e 64 6c 65 2d 65 78 63 .... (handle-exc
2d70: 65 70 74 69 6f 6e 73 0a 09 09 09 20 20 65 78 6e eptions.... exn
2d80: 0a 09 09 09 20 20 23 74 0a 09 09 09 20 20 28 6c .... #t.... (l
2d90: 65 74 2d 76 61 6c 75 65 73 20 28 28 28 70 69 64 et-values (((pid
2da0: 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 75 73 -val exit-status
2db0: 20 65 78 69 74 2d 63 6f 64 65 29 20 28 70 72 6f exit-code) (pro
2dc0: 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 74 cess-wait pid #t
2dd0: 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 69 )))..... (i
2de0: 66 20 28 6f 72 20 28 65 71 3f 20 70 69 64 2d 76 f (or (eq? pid-v
2df0: 61 6c 20 70 69 64 29 0a 09 09 09 09 09 20 20 20 al pid)......
2e00: 20 20 20 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 (eq? pid-val
2e10: 30 29 29 0a 09 09 09 09 09 20 20 28 62 65 67 69 0))...... (begi
2e20: 6e 0a 09 09 09 09 09 20 20 20 20 28 70 72 69 6e n...... (prin
2e30: 74 66 20 22 53 65 6e 64 69 6e 67 20 73 69 67 6e tf "Sending sign
2e40: 61 6c 2f 74 65 72 6d 20 74 6f 20 7e 41 5c 6e 22 al/term to ~A\n"
2e50: 20 70 69 64 29 0a 09 09 09 09 09 20 20 20 20 28 pid)...... (
2e60: 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 process-signal p
2e70: 69 64 20 73 69 67 6e 61 6c 2f 74 65 72 6d 29 29 id signal/term))
2e80: 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 70 ))))... (p
2e90: 72 6f 63 65 73 73 3a 63 68 69 6c 64 72 65 6e 20 rocess:children
2ea0: 23 66 29 29 0a 09 09 20 20 20 20 20 20 28 6f 72 #f))... (or
2eb0: 69 67 69 6e 61 6c 2d 65 78 69 74 20 65 78 69 74 iginal-exit exit
2ec0: 2d 63 6f 64 65 29 29 29 29 29 0a 0a 3b 3b 3d 3d -code)))))..;;==
2ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f10: 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 20 73 65 74 ====.;; Misc set
2f20: 75 70 20 73 74 75 66 66 0a 3b 3b 3d 3d 3d 3d 3d up stuff.;;=====
2f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f70: 3d 0a 0a 28 64 65 62 75 67 3a 73 65 74 75 70 29 =..(debug:setup)
2f80: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
2f90: 61 72 67 20 22 2d 6c 6f 67 67 69 6e 67 22 29 28 arg "-logging")(
2fa0: 73 65 74 21 20 2a 6c 6f 67 67 69 6e 67 2a 20 23 set! *logging* #
2fb0: 74 29 29 0a 0a 28 69 66 20 28 64 65 62 75 67 3a t))..(if (debug:
2fc0: 64 65 62 75 67 2d 6d 6f 64 65 20 33 29 20 3b 3b debug-mode 3) ;;
2fd0: 20 77 65 20 61 72 65 20 6f 62 76 69 6f 75 73 6c we are obviousl
2fe0: 79 20 64 65 62 75 67 67 69 6e 67 0a 20 20 20 20 y debugging.
2ff0: 28 73 65 74 21 20 6f 70 65 6e 2d 72 75 6e 2d 63 (set! open-run-c
3000: 6c 6f 73 65 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c lose open-run-cl
3010: 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e ose-no-exception
3020: 2d 68 61 6e 64 6c 69 6e 67 29 29 0a 0a 28 69 66 -handling))..(if
3030: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3040: 2d 69 74 65 6d 70 61 74 74 22 29 0a 20 20 20 20 -itempatt").
3050: 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 28 63 (let ((newval (c
3060: 6f 6e 63 20 28 61 72 67 73 3a 67 65 74 2d 61 72 onc (args:get-ar
3070: 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 20 22 g "-testpatt") "
3080: 2f 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 /" (args:get-arg
3090: 20 22 2d 69 74 65 6d 70 61 74 74 22 29 29 29 29 "-itempatt"))))
30a0: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
30b0: 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 int 0 "WARNING:
30c0: 2d 69 74 65 6d 70 61 74 74 20 68 61 73 20 62 65 -itempatt has be
30d0: 65 6e 20 64 65 70 72 65 63 61 74 65 64 2c 20 70 en deprecated, p
30e0: 6c 65 61 73 65 20 75 73 65 20 2d 74 65 73 74 70 lease use -testp
30f0: 61 74 74 20 74 65 73 74 70 61 74 74 2f 69 74 65 att testpatt/ite
3100: 6d 70 61 74 74 20 6d 65 74 68 6f 64 2c 20 6e 65 mpatt method, ne
3110: 77 20 74 65 73 74 70 61 74 74 20 69 73 20 22 6e w testpatt is "n
3120: 65 77 76 61 6c 29 0a 20 20 20 20 20 20 28 68 61 ewval). (ha
3130: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 72 sh-table-set! ar
3140: 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 74 65 gs:arg-hash "-te
3150: 73 74 70 61 74 74 22 20 6e 65 77 76 61 6c 29 0a stpatt" newval).
3160: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
3170: 65 2d 64 65 6c 65 74 65 21 20 61 72 67 73 3a 61 e-delete! args:a
3180: 72 67 2d 68 61 73 68 20 22 2d 69 74 65 6d 70 61 rg-hash "-itempa
3190: 74 74 22 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d tt")))..;;======
31a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
31b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
31c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
31d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
31e0: 0a 3b 3b 20 4d 69 73 63 20 67 65 6e 65 72 61 6c .;; Misc general
31f0: 20 63 61 6c 6c 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d calls.;;=======
3200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
3240: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
3250: 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 29 0a rg "-env2file").
3260: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
3270: 20 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 (save-environme
3280: 6e 74 2d 61 73 2d 66 69 6c 65 73 20 28 61 72 67 nt-as-files (arg
3290: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 32 s:get-arg "-env2
32a0: 66 69 6c 65 22 29 29 0a 20 20 20 20 20 20 28 73 file")). (s
32b0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
32c0: 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
32d0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
32e0: 73 74 2d 64 69 73 6b 73 22 29 0a 20 20 20 20 28 st-disks"). (
32f0: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 69 begin. (pri
3300: 6e 74 20 0a 20 20 20 20 20 20 20 28 73 74 72 69 nt . (stri
3310: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a ng-intersperse .
3320: 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 .(map (lambda (x
3330: 29 0a 09 20 20 20 20 20 20 20 28 73 74 72 69 6e ).. (strin
3340: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 g-intersperse ..
3350: 09 78 0a 09 09 22 20 3d 3e 20 22 29 29 0a 09 20 .x..." => "))..
3360: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d (common:get-
3370: 64 69 73 6b 73 29 20 29 0a 09 22 5c 6e 22 29 29 disks) ).."\n"))
3380: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
3390: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
33a0: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
33b0: 2d 61 72 67 20 22 2d 72 65 66 64 62 32 64 61 74 -arg "-refdb2dat
33c0: 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 69 "). (let* ((i
33d0: 6e 70 75 74 2d 64 62 20 28 61 72 67 73 3a 67 65 nput-db (args:ge
33e0: 74 2d 61 72 67 20 22 2d 72 65 66 64 62 32 64 61 t-arg "-refdb2da
33f0: 74 22 29 29 0a 09 20 20 20 28 6f 75 74 2d 66 69 t")).. (out-fi
3400: 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 le (args:get-arg
3410: 20 22 2d 6f 22 29 29 0a 09 20 20 20 28 6f 75 74 "-o")).. (out
3420: 2d 66 6d 74 20 20 28 6f 72 20 28 61 72 67 73 3a -fmt (or (args:
3430: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
3440: 64 65 22 29 20 22 73 63 68 65 6d 65 22 29 29 0a de") "scheme")).
3450: 09 20 20 20 28 6f 75 74 2d 70 6f 72 74 20 28 69 . (out-port (i
3460: 66 20 28 61 6e 64 20 6f 75 74 2d 66 69 6c 65 20 f (and out-file
3470: 0a 09 09 09 20 20 20 20 20 20 28 6e 6f 74 20 28 .... (not (
3480: 65 71 75 61 6c 3f 20 6f 75 74 2d 66 6d 74 20 22 equal? out-fmt "
3490: 73 71 6c 69 74 65 33 22 29 29 29 0a 09 09 09 20 sqlite3")))....
34a0: 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c (open-output-fil
34b0: 65 20 6f 75 74 2d 66 69 6c 65 29 0a 09 09 09 20 e out-file)....
34c0: 28 63 75 72 72 65 6e 74 2d 6f 75 74 70 75 74 2d (current-output-
34d0: 70 6f 72 74 29 29 29 0a 09 20 20 20 28 72 65 73 port))).. (res
34e0: 2d 64 61 74 61 20 28 63 6f 6e 66 69 67 66 3a 72 -data (configf:r
34f0: 65 61 64 2d 72 65 66 64 62 20 69 6e 70 75 74 2d ead-refdb input-
3500: 64 62 29 29 0a 09 20 20 20 28 64 61 74 61 20 20 db)).. (data
3510: 20 20 20 28 63 61 72 20 72 65 73 2d 64 61 74 61 (car res-data
3520: 29 29 0a 09 20 20 20 28 6d 73 67 20 20 20 20 20 )).. (msg
3530: 20 28 63 61 64 72 20 72 65 73 2d 64 61 74 61 29 (cadr res-data)
3540: 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f )). (if (no
3550: 74 20 64 61 74 61 29 0a 09 20 20 28 64 65 62 75 t data).. (debu
3560: 67 3a 70 72 69 6e 74 20 30 20 64 61 74 61 29 20 g:print 0 data)
3570: 3b 3b 20 73 6f 6d 65 20 65 72 72 6f 72 20 6f 63 ;; some error oc
3580: 63 75 72 72 65 64 0a 09 20 20 28 77 69 74 68 2d curred.. (with-
3590: 6f 75 74 70 75 74 2d 74 6f 2d 70 6f 72 74 20 6f output-to-port o
35a0: 75 74 2d 70 6f 72 74 0a 09 20 20 20 20 28 6c 61 ut-port.. (la
35b0: 6d 62 64 61 20 28 29 0a 09 20 20 20 20 20 20 28 mbda ().. (
35c0: 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy
35d0: 6d 62 6f 6c 20 6f 75 74 2d 66 6d 74 29 0a 09 09 mbol out-fmt)...
35e0: 28 28 73 63 68 65 6d 65 29 28 70 70 20 64 61 74 ((scheme)(pp dat
35f0: 61 29 29 0a 09 09 28 28 70 65 72 6c 29 0a 09 09 a))...((perl)...
3600: 20 3b 3b 20 28 70 72 69 6e 74 20 22 25 68 61 73 ;; (print "%has
3610: 68 20 3d 20 28 22 29 0a 09 09 20 3b 3b 20 20 20 h = (")... ;;
3620: 20 20 20 20 20 6b 65 79 31 20 3d 3e 20 27 76 61 key1 => 'va
3630: 6c 75 65 31 27 2c 0a 09 09 20 3b 3b 20 20 20 20 lue1',... ;;
3640: 20 20 20 20 6b 65 79 32 20 3d 3e 20 27 76 61 6c key2 => 'val
3650: 75 65 32 27 2c 0a 09 09 20 3b 3b 20 20 20 20 20 ue2',... ;;
3660: 20 20 20 6b 65 79 33 20 3d 3e 20 27 76 61 6c 75 key3 => 'valu
3670: 65 33 27 2c 0a 09 09 20 3b 3b 20 29 3b 0a 09 09 e3',... ;; );...
3680: 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c (configf:map-al
3690: 6c 2d 68 69 65 72 2d 61 6c 69 73 74 20 0a 09 09 l-hier-alist ...
36a0: 20 20 64 61 74 61 20 0a 09 09 20 20 28 6c 61 6d data ... (lam
36b0: 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 bda (sheetname s
36c0: 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 ectionname varna
36d0: 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 28 70 me val)... (p
36e0: 72 69 6e 74 20 22 24 64 61 74 61 7b 5c 22 22 20 rint "$data{\""
36f0: 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 7d 7b 5c sheetname "\"}{\
3700: 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 "" sectionname "
3710: 5c 22 7d 7b 5c 22 22 20 76 61 72 6e 61 6d 65 20 \"}{\"" varname
3720: 22 5c 22 7d 20 3d 20 5c 22 22 20 76 61 6c 20 22 "\"} = \"" val "
3730: 5c 22 3b 22 29 29 29 29 0a 09 09 28 28 70 79 74 \";"))))...((pyt
3740: 68 6f 6e 20 72 75 62 79 29 0a 09 09 20 28 70 72 hon ruby)... (pr
3750: 69 6e 74 20 22 64 61 74 61 3d 7b 7d 22 29 0a 09 int "data={}")..
3760: 09 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 . (configf:map-a
3770: 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 0a 09 09 ll-hier-alist...
3780: 20 20 64 61 74 61 0a 09 09 20 20 28 6c 61 6d 62 data... (lamb
3790: 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 65 da (sheetname se
37a0: 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d ctionname varnam
37b0: 65 20 76 61 6c 29 0a 09 09 20 20 20 20 28 70 72 e val)... (pr
37c0: 69 6e 74 20 22 64 61 74 61 5b 5c 22 22 20 73 68 int "data[\"" sh
37d0: 65 65 74 6e 61 6d 65 20 22 5c 22 5d 5b 5c 22 22 eetname "\"][\""
37e0: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 5c 22 sectionname "\"
37f0: 5d 5b 5c 22 22 20 76 61 72 6e 61 6d 65 20 22 5c ][\"" varname "\
3800: 22 5d 20 3d 20 5c 22 22 20 76 61 6c 20 22 5c 22 "] = \"" val "\"
3810: 22 29 29 0a 09 09 20 20 69 6e 69 74 70 72 6f 63 "))... initproc
3820: 31 3a 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 28 1:... (lambda (
3830: 73 68 65 65 74 6e 61 6d 65 29 0a 09 09 20 20 20 sheetname)...
3840: 20 28 70 72 69 6e 74 20 22 64 61 74 61 5b 5c 22 (print "data[\"
3850: 22 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 5d " sheetname "\"]
3860: 20 3d 20 7b 7d 22 29 29 0a 09 09 20 20 69 6e 69 = {}"))... ini
3870: 74 70 72 6f 63 32 3a 0a 09 09 20 20 28 6c 61 6d tproc2:... (lam
3880: 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 20 73 bda (sheetname s
3890: 65 63 74 69 6f 6e 6e 61 6d 65 29 0a 09 09 20 20 ectionname)...
38a0: 20 20 28 70 72 69 6e 74 20 22 64 61 74 61 5b 5c (print "data[\
38b0: 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 "" sheetname "\"
38c0: 5d 5b 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d ][\"" sectionnam
38d0: 65 20 22 5c 22 5d 20 3d 20 7b 7d 22 29 29 29 29 e "\"] = {}"))))
38e0: 0a 09 09 28 28 73 71 6c 69 74 65 33 29 0a 09 09 ...((sqlite3)...
38f0: 20 28 6c 65 74 2a 20 28 28 64 62 2d 66 69 6c 65 (let* ((db-file
3900: 20 20 20 28 6f 72 20 6f 75 74 2d 66 69 6c 65 20 (or out-file
3910: 28 70 61 74 68 6e 61 6d 65 2d 66 69 6c 65 20 69 (pathname-file i
3920: 6e 70 75 74 2d 64 62 29 29 29 0a 09 09 09 28 64 nput-db)))....(d
3930: 62 2d 65 78 69 73 74 73 20 28 66 69 6c 65 2d 65 b-exists (file-e
3940: 78 69 73 74 73 3f 20 64 62 2d 66 69 6c 65 29 29 xists? db-file))
3950: 0a 09 09 09 28 64 62 20 20 20 20 20 20 20 20 28 ....(db (
3960: 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 74 sqlite3:open-dat
3970: 61 62 61 73 65 20 64 62 2d 66 69 6c 65 29 29 29 abase db-file)))
3980: 0a 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 64 ... (if (not d
3990: 62 2d 65 78 69 73 74 73 29 28 73 71 6c 69 74 65 b-exists)(sqlite
39a0: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 52 3:execute db "CR
39b0: 45 41 54 45 20 54 41 42 4c 45 20 64 61 74 61 20 EATE TABLE data
39c0: 28 73 68 65 65 74 2c 73 65 63 74 69 6f 6e 2c 76 (sheet,section,v
39d0: 61 72 2c 76 61 6c 29 3b 22 29 29 0a 09 09 20 20 ar,val);"))...
39e0: 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c (configf:map-al
39f0: 6c 2d 68 69 65 72 2d 61 6c 69 73 74 0a 09 09 20 l-hier-alist...
3a00: 20 20 20 64 61 74 61 0a 09 09 20 20 20 20 28 6c data... (l
3a10: 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 ambda (sheetname
3a20: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 sectionname var
3a30: 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 name val)...
3a40: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
3a50: 74 65 20 64 62 0a 09 09 09 09 20 20 20 20 20 20 te db.....
3a60: 20 22 49 4e 53 45 52 54 20 4f 52 20 52 45 50 4c "INSERT OR REPL
3a70: 41 43 45 20 49 4e 54 4f 20 64 61 74 61 20 28 73 ACE INTO data (s
3a80: 68 65 65 74 2c 73 65 63 74 69 6f 6e 2c 76 61 72 heet,section,var
3a90: 2c 76 61 6c 29 20 56 41 4c 55 45 53 20 28 3f 2c ,val) VALUES (?,
3aa0: 3f 2c 3f 2c 3f 29 3b 22 0a 09 09 09 09 20 20 20 ?,?,?);".....
3ab0: 20 20 20 20 73 68 65 65 74 6e 61 6d 65 20 73 65 sheetname se
3ac0: 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d ctionname varnam
3ad0: 65 20 76 61 6c 29 29 29 0a 09 09 20 20 20 28 73 e val)))... (s
3ae0: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
3af0: 20 64 62 29 29 29 0a 09 09 28 65 6c 73 65 0a 09 db)))...(else..
3b00: 09 20 28 70 70 20 64 61 74 61 29 29 29 29 29 29 . (pp data))))))
3b10: 0a 20 20 20 20 20 20 28 69 66 20 6f 75 74 2d 66 . (if out-f
3b20: 69 6c 65 20 28 63 6c 6f 73 65 2d 6f 75 74 70 75 ile (close-outpu
3b30: 74 2d 70 6f 72 74 20 6f 75 74 2d 70 6f 72 74 29 t-port out-port)
3b40: 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 20 3b ). (exit) ;
3b50: 3b 20 79 65 73 2c 20 62 65 6e 64 69 6e 67 20 74 ; yes, bending t
3b60: 68 65 20 72 75 6c 65 73 20 68 65 72 65 20 2d 20 he rules here -
3b70: 6e 65 65 64 20 74 6f 20 65 78 69 74 20 73 69 6e need to exit sin
3b80: 63 65 20 74 68 69 73 20 69 73 20 61 20 75 74 69 ce this is a uti
3b90: 6c 69 74 79 0a 20 20 20 20 20 20 29 29 0a 0a 28 lity. ))..(
3ba0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
3bb0: 20 22 2d 70 69 6e 67 22 29 0a 20 20 20 20 28 6c "-ping"). (l
3bc0: 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 20 20 20 et* ((run-id
3bd0: 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d (string->num
3be0: 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ber (args:get-ar
3bf0: 67 20 22 2d 72 75 6e 2d 69 64 22 29 29 29 0a 09 g "-run-id")))..
3c00: 20 20 20 28 68 6f 73 74 3a 70 6f 72 74 20 20 20 (host:port
3c10: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
3c20: 22 2d 70 69 6e 67 22 29 29 29 0a 20 20 20 20 20 "-ping"))).
3c30: 20 28 73 65 72 76 65 72 3a 70 69 6e 67 20 72 75 (server:ping ru
3c40: 6e 2d 69 64 20 68 6f 73 74 3a 70 6f 72 74 29 29 n-id host:port))
3c50: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
3c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 ===========.;; S
3ca0: 74 61 72 74 20 74 68 65 20 73 65 72 76 65 72 20 tart the server
3cb0: 2d 20 63 61 6e 20 62 65 20 64 6f 6e 65 20 69 6e - can be done in
3cc0: 20 63 6f 6e 6a 75 6e 63 74 69 6f 6e 20 77 69 74 conjunction wit
3cd0: 68 20 2d 72 75 6e 61 6c 6c 20 6f 72 20 2d 72 75 h -runall or -ru
3ce0: 6e 74 65 73 74 73 20 28 6f 6e 65 20 64 61 79 2e ntests (one day.
3cf0: 2e 2e 29 0a 3b 3b 20 20 20 77 65 20 73 74 61 72 ..).;; we star
3d00: 74 20 74 68 65 20 73 65 72 76 65 72 20 69 66 20 t the server if
3d10: 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 65 6c 73 65 not running else
3d20: 20 73 74 61 72 74 20 74 68 65 20 63 6c 69 65 6e start the clien
3d30: 74 20 74 68 72 65 61 64 0a 3b 3b 3d 3d 3d 3d 3d t thread.;;=====
3d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d80: 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 =..(if (args:get
3d90: 2d 61 72 67 20 22 2d 73 65 72 76 65 72 22 29 0a -arg "-server").
3da0: 0a 20 20 20 20 3b 3b 20 53 65 72 76 65 72 3f 20 . ;; Server?
3db0: 53 74 61 72 74 20 75 70 20 68 65 72 65 2e 0a 20 Start up here..
3dc0: 20 20 20 3b 3b 0a 20 20 20 20 28 6c 65 74 20 28 ;;. (let (
3dd0: 28 74 6c 20 20 20 20 20 20 20 20 28 6c 61 75 6e (tl (laun
3de0: 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e ch:setup-for-run
3df0: 29 29 0a 09 20 20 28 72 75 6e 2d 69 64 20 20 20 )).. (run-id
3e00: 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d (and (args:get-
3e10: 61 72 67 20 22 2d 72 75 6e 2d 69 64 22 29 0a 09 arg "-run-id")..
3e20: 09 09 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d .. (string->num
3e30: 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ber (args:get-ar
3e40: 67 20 22 2d 72 75 6e 2d 69 64 22 29 29 29 29 29 g "-run-id")))))
3e50: 0a 20 20 20 20 20 20 28 69 66 20 72 75 6e 2d 69 . (if run-i
3e60: 64 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 d.. (begin..
3e70: 20 28 73 65 72 76 65 72 3a 6c 61 75 6e 63 68 20 (server:launch
3e80: 72 75 6e 2d 69 64 29 0a 09 20 20 20 20 28 73 65 run-id).. (se
3e90: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
3ea0: 2a 20 23 74 29 29 0a 09 20 20 28 64 65 62 75 67 * #t)).. (debug
3eb0: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
3ec0: 20 73 65 72 76 65 72 20 72 65 71 75 69 72 65 73 server requires
3ed0: 20 72 75 6e 2d 69 64 20 62 65 20 73 70 65 63 69 run-id be speci
3ee0: 66 69 65 64 20 77 69 74 68 20 2d 72 75 6e 2d 69 fied with -run-i
3ef0: 64 22 29 29 29 0a 0a 20 20 20 20 3b 3b 20 4e 6f d"))).. ;; No
3f00: 74 20 61 20 73 65 72 76 65 72 3f 20 54 68 69 73 t a server? This
3f10: 20 73 65 63 74 69 6f 6e 20 77 69 6c 6c 20 64 65 section will de
3f20: 63 69 64 65 20 68 6f 77 20 74 6f 20 63 6f 6d 6d cide how to comm
3f30: 75 6e 69 63 61 74 65 0a 20 20 20 20 3b 3b 0a 20 unicate. ;;.
3f40: 20 20 20 3b 3b 20 20 53 65 74 75 70 20 63 6c 69 ;; Setup cli
3f50: 65 6e 74 20 66 6f 72 20 61 6c 6c 20 65 78 70 65 ent for all expe
3f60: 63 74 20 6c 69 73 74 65 64 20 68 65 72 65 0a 20 ct listed here.
3f70: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 28 6c (if (null? (l
3f80: 73 65 74 2d 69 6e 74 65 72 73 65 63 74 69 6f 6e set-intersection
3f90: 20 0a 09 09 20 20 20 20 20 65 71 75 61 6c 3f 0a ... equal?.
3fa0: 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 .. (hash-tab
3fb0: 6c 65 2d 6b 65 79 73 20 61 72 67 73 3a 61 72 67 le-keys args:arg
3fc0: 2d 68 61 73 68 29 0a 09 09 20 20 20 20 20 27 28 -hash)... '(
3fd0: 22 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 0a "-list-servers".
3fe0: 09 09 20 20 20 20 20 20 20 22 2d 73 74 6f 70 2d .. "-stop-
3ff0: 73 65 72 76 65 72 22 0a 09 09 20 20 20 20 20 20 server"...
4000: 20 22 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 6f 22 "-show-cmdinfo"
4010: 0a 09 09 20 20 20 20 20 20 20 22 2d 6c 69 73 74 ... "-list
4020: 2d 72 75 6e 73 22 29 29 29 0a 09 28 69 66 20 28 -runs")))..(if (
4030: 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 launch:setup-for
4040: 2d 72 75 6e 29 0a 09 20 20 20 20 28 6c 65 74 20 -run).. (let
4050: 28 28 72 75 6e 2d 69 64 20 20 20 20 28 61 6e 64 ((run-id (and
4060: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4070: 2d 72 75 6e 2d 69 64 22 29 0a 09 09 09 09 20 20 -run-id").....
4080: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
4090: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
40a0: 72 75 6e 2d 69 64 22 29 29 29 29 29 0a 09 20 20 run-id")))))..
40b0: 20 20 20 20 3b 3b 20 28 73 65 74 21 20 2a 66 64 ;; (set! *fd
40c0: 62 2a 20 20 20 28 66 69 6c 65 64 62 3a 6f 70 65 b* (filedb:ope
40d0: 6e 2d 64 62 20 28 63 6f 6e 63 20 2a 74 6f 70 70 n-db (conc *topp
40e0: 61 74 68 2a 20 22 2f 64 62 2f 70 61 74 68 73 2e ath* "/db/paths.
40f0: 64 62 22 29 29 29 0a 09 20 20 20 20 20 20 3b 3b db"))).. ;;
4100: 20 69 66 20 6e 6f 74 20 6c 69 73 74 20 6f 72 20 if not list or
4110: 6b 69 6c 6c 20 74 68 65 6e 20 73 74 61 72 74 20 kill then start
4120: 61 20 63 6c 69 65 6e 74 20 28 69 66 20 61 70 70 a client (if app
4130: 72 6f 70 72 69 61 74 65 29 0a 09 20 20 20 20 20 ropriate)..
4140: 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 2d 64 (if (or (args-d
4150: 65 66 69 6e 65 64 3f 20 22 2d 68 22 20 22 2d 76 efined? "-h" "-v
4160: 65 72 73 69 6f 6e 22 20 22 2d 67 65 6e 2d 6d 65 ersion" "-gen-me
4170: 67 61 74 65 73 74 2d 61 72 65 61 22 20 22 2d 67 gatest-area" "-g
4180: 65 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 en-megatest-test
4190: 22 29 0a 09 09 20 20 20 20 20 20 28 65 71 3f 20 ")... (eq?
41a0: 28 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 (length (hash-ta
41b0: 62 6c 65 2d 6b 65 79 73 20 61 72 67 73 3a 61 72 ble-keys args:ar
41c0: 67 2d 68 61 73 68 29 29 20 30 29 29 0a 09 09 20 g-hash)) 0))...
41d0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
41e0: 66 6f 20 31 20 22 53 65 72 76 65 72 20 63 6f 6e fo 1 "Server con
41f0: 6e 65 63 74 69 6f 6e 20 6e 6f 74 20 6e 65 65 64 nection not need
4200: 65 64 22 29 0a 09 09 20 20 28 62 65 67 69 6e 0a ed")... (begin.
4210: 09 09 20 20 20 20 3b 3b 20 28 69 66 20 72 75 6e .. ;; (if run
4220: 2d 69 64 20 0a 09 09 20 20 20 20 3b 3b 20 20 20 -id ... ;;
4230: 20 20 28 63 6c 69 65 6e 74 3a 6c 61 75 6e 63 68 (client:launch
4240: 20 72 75 6e 2d 69 64 29 20 0a 09 09 20 20 20 20 run-id) ...
4250: 3b 3b 20 20 20 20 20 28 63 6c 69 65 6e 74 3a 6c ;; (client:l
4260: 61 75 6e 63 68 20 30 29 20 20 20 20 20 20 3b 3b aunch 0) ;;
4270: 20 77 69 74 68 6f 75 74 20 72 75 6e 2d 69 64 20 without run-id
4280: 77 65 27 6c 6c 20 73 74 61 72 74 20 61 20 73 65 we'll start a se
4290: 72 76 65 72 20 66 6f 72 20 22 30 22 0a 09 09 20 rver for "0"...
42a0: 20 20 20 23 74 0a 09 09 20 20 20 20 29 29 29 29 #t... ))))
42b0: 29 29 0a 0a 3b 3b 20 4d 41 59 20 53 54 49 4c 4c ))..;; MAY STILL
42c0: 20 4e 45 45 44 20 54 48 49 53 0a 3b 3b 09 09 20 NEED THIS.;;..
42d0: 20 20 20 20 20 20 28 73 65 74 21 20 2a 6d 65 67 (set! *meg
42e0: 61 74 65 73 74 2d 64 62 2a 20 28 6d 61 6b 65 2d atest-db* (make-
42f0: 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 74 dbr:dbstruct pat
4300: 68 3a 20 2a 74 6f 70 70 61 74 68 2a 20 6c 6f 63 h: *toppath* loc
4310: 61 6c 3a 20 23 74 29 29 29 29 29 29 29 29 29 29 al: #t))))))))))
4320: 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a ..(if (or (args:
4330: 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 73 get-arg "-list-s
4340: 65 72 76 65 72 73 22 29 0a 09 28 61 72 67 73 3a ervers")..(args:
4350: 67 65 74 2d 61 72 67 20 22 2d 73 74 6f 70 2d 73 get-arg "-stop-s
4360: 65 72 76 65 72 22 29 29 0a 20 20 20 20 28 6c 65 erver")). (le
4370: 74 20 28 28 74 6c 20 28 6c 61 75 6e 63 68 3a 73 t ((tl (launch:s
4380: 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 29 0a etup-for-run))).
4390: 20 20 20 20 20 20 28 69 66 20 74 6c 20 0a 09 20 (if tl ..
43a0: 20 28 6c 65 74 2a 20 28 28 73 65 72 76 65 72 73 (let* ((servers
43b0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
43c0: 20 74 61 73 6b 73 3a 67 65 74 2d 61 6c 6c 2d 73 tasks:get-all-s
43d0: 65 72 76 65 72 73 20 74 61 73 6b 73 3a 6f 70 65 ervers tasks:ope
43e0: 6e 2d 64 62 29 29 0a 09 09 20 28 66 6d 74 73 74 n-db))... (fmtst
43f0: 72 20 20 22 7e 35 61 7e 31 32 61 7e 38 61 7e 32 r "~5a~12a~8a~2
4400: 30 61 7e 32 34 61 7e 31 30 61 7e 31 30 61 7e 31 0a~24a~10a~10a~1
4410: 30 61 7e 31 30 61 5c 6e 22 29 0a 09 09 20 28 73 0a~10a\n")... (s
4420: 65 72 76 65 72 73 2d 74 6f 2d 6b 69 6c 6c 20 27 ervers-to-kill '
4430: 28 29 29 0a 09 09 20 28 6b 69 6c 6c 69 6e 66 6f ())... (killinfo
4440: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
4450: 20 22 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 29 "-stop-server")
4460: 29 0a 09 09 20 28 6b 68 6f 73 74 2d 70 6f 72 74 )... (khost-port
4470: 20 28 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 69 (if killinfo (i
4480: 66 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 f (substring-ind
4490: 65 78 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f 29 ex ":" killinfo)
44a0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 22 3a (string-split ":
44b0: 22 29 20 23 66 29 20 23 66 29 29 0a 09 09 20 28 ") #f) #f))... (
44c0: 73 69 64 20 20 20 20 20 20 20 20 28 69 66 20 6b sid (if k
44d0: 69 6c 6c 69 6e 66 6f 20 28 69 66 20 28 73 75 62 illinfo (if (sub
44e0: 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 3a 22 string-index ":"
44f0: 20 6b 69 6c 6c 69 6e 66 6f 29 20 23 66 20 28 73 killinfo) #f (s
4500: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 6b 69 tring->number ki
4510: 6c 6c 69 6e 66 6f 29 29 20 23 66 29 29 29 0a 09 llinfo)) #f)))..
4520: 20 20 20 20 28 66 6f 72 6d 61 74 20 23 74 20 66 (format #t f
4530: 6d 74 73 74 72 20 22 49 64 22 20 22 4d 54 76 65 mtstr "Id" "MTve
4540: 72 22 20 22 50 69 64 22 20 22 48 6f 73 74 22 20 r" "Pid" "Host"
4550: 22 49 6e 74 65 72 66 61 63 65 3a 4f 75 74 50 6f "Interface:OutPo
4560: 72 74 22 20 22 49 6e 50 6f 72 74 22 20 22 4c 61 rt" "InPort" "La
4570: 73 74 42 65 61 74 22 20 22 53 74 61 74 65 22 20 stBeat" "State"
4580: 22 54 72 61 6e 73 70 6f 72 74 22 29 0a 09 20 20 "Transport")..
4590: 20 20 28 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 (format #t fmt
45a0: 73 74 72 20 22 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 str "==" "====="
45b0: 20 22 3d 3d 3d 22 20 22 3d 3d 3d 3d 22 20 22 3d "===" "====" "=
45c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
45d0: 22 20 22 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d " "======" "====
45e0: 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d ====" "=====" "=
45f0: 3d 3d 3d 3d 3d 3d 3d 3d 22 29 0a 09 20 20 20 20 ========")..
4600: 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 20 (for-each ..
4610: 20 28 6c 61 6d 62 64 61 20 28 73 65 72 76 65 72 (lambda (server
4620: 29 0a 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 ).. (let*
4630: 28 28 69 64 20 20 20 20 20 20 20 20 20 28 76 65 ((id (ve
4640: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
4650: 30 29 29 0a 09 09 20 20 20 20 20 20 28 70 69 64 0))... (pid
4660: 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d (vector-
4670: 72 65 66 20 73 65 72 76 65 72 20 31 29 29 0a 09 ref server 1))..
4680: 09 20 20 20 20 20 20 28 68 6f 73 74 6e 61 6d 65 . (hostname
4690: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
46a0: 65 72 76 65 72 20 32 29 29 0a 09 09 20 20 20 20 erver 2))...
46b0: 20 20 28 69 6e 74 65 72 66 61 63 65 20 20 28 76 (interface (v
46c0: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
46d0: 20 33 29 29 20 0a 09 09 20 20 20 20 20 20 28 70 3)) ... (p
46e0: 75 6c 6c 70 6f 72 74 20 20 20 28 76 65 63 74 6f ullport (vecto
46f0: 72 2d 72 65 66 20 73 65 72 76 65 72 20 34 29 29 r-ref server 4))
4700: 0a 09 09 20 20 20 20 20 20 28 70 75 62 70 6f 72 ... (pubpor
4710: 74 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 t (vector-ref
4720: 20 73 65 72 76 65 72 20 35 29 29 0a 09 09 20 20 server 5))...
4730: 20 20 20 20 28 73 74 61 72 74 2d 74 69 6d 65 20 (start-time
4740: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 (vector-ref serv
4750: 65 72 20 36 29 29 0a 09 09 20 20 20 20 20 20 28 er 6))... (
4760: 70 72 69 6f 72 69 74 79 20 20 20 28 76 65 63 74 priority (vect
4770: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 37 29 or-ref server 7)
4780: 29 0a 09 09 20 20 20 20 20 20 28 73 74 61 74 65 )... (state
4790: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re
47a0: 66 20 73 65 72 76 65 72 20 38 29 29 0a 09 09 20 f server 8))...
47b0: 20 20 20 20 20 28 6d 74 2d 76 65 72 20 20 20 20 (mt-ver
47c0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
47d0: 76 65 72 20 39 29 29 0a 09 09 20 20 20 20 20 20 ver 9))...
47e0: 28 6c 61 73 74 2d 75 70 64 61 74 65 20 28 76 65 (last-update (ve
47f0: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
4800: 31 30 29 29 20 0a 09 09 20 20 20 20 20 20 28 74 10)) ... (t
4810: 72 61 6e 73 70 6f 72 74 20 20 28 76 65 63 74 6f ransport (vecto
4820: 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 31 29 r-ref server 11)
4830: 29 0a 09 09 20 20 20 20 20 20 28 6b 69 6c 6c 65 )... (kille
4840: 64 20 20 20 20 20 23 66 29 0a 09 09 20 20 20 20 d #f)...
4850: 20 20 28 73 74 61 74 75 73 20 20 20 20 20 28 3c (status (<
4860: 20 6c 61 73 74 2d 75 70 64 61 74 65 20 32 30 29 last-update 20)
4870: 29 29 0a 09 09 20 3b 3b 20 20 20 28 7a 6d 71 2d ))... ;; (zmq-
4880: 73 6f 63 6b 65 74 73 20 28 69 66 20 73 74 61 74 sockets (if stat
4890: 75 73 20 28 73 65 72 76 65 72 3a 63 6c 69 65 6e us (server:clien
48a0: 74 2d 63 6f 6e 6e 65 63 74 20 68 6f 73 74 6e 61 t-connect hostna
48b0: 6d 65 20 70 6f 72 74 29 20 23 66 29 29 29 0a 09 me port) #f)))..
48c0: 09 20 3b 3b 20 6e 6f 20 6e 65 65 64 20 74 6f 20 . ;; no need to
48d0: 6c 6f 67 69 6e 20 61 73 20 73 74 61 74 75 73 20 login as status
48e0: 6f 66 20 23 74 20 69 6e 64 69 63 61 74 65 73 20 of #t indicates
48f0: 77 65 20 61 72 65 20 63 6f 6e 6e 65 63 74 69 6e we are connectin
4900: 67 20 74 6f 20 63 6f 72 72 65 63 74 20 0a 09 09 g to correct ...
4910: 20 3b 3b 20 73 65 72 76 65 72 0a 09 09 20 28 69 ;; server... (i
4920: 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 65 20 f (equal? state
4930: 22 64 65 61 64 22 29 0a 09 09 20 20 20 20 20 28 "dead")... (
4940: 69 66 20 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 if (> last-updat
4950: 65 20 28 2a 20 32 35 20 36 30 20 36 30 29 29 20 e (* 25 60 60))
4960: 3b 3b 20 6b 65 65 70 20 72 65 63 6f 72 64 73 20 ;; keep records
4970: 61 72 6f 75 6e 64 20 66 6f 72 20 73 6c 69 67 68 around for sligh
4980: 6c 79 20 6f 76 65 72 20 61 20 64 61 79 2e 0a 09 ly over a day...
4990: 09 09 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f .. (open-run-clo
49a0: 73 65 20 74 61 73 6b 73 3a 73 65 72 76 65 72 2d se tasks:server-
49b0: 64 65 72 65 67 69 73 74 65 72 20 74 61 73 6b 73 deregister tasks
49c0: 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 74 6e 61 6d :open-db hostnam
49d0: 65 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 6c 6c e pullport: pull
49e0: 70 6f 72 74 20 70 69 64 3a 20 70 69 64 20 61 63 port pid: pid ac
49f0: 74 69 6f 6e 3a 20 27 64 65 6c 65 74 65 29 29 0a tion: 'delete)).
4a00: 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 6c 61 .. (if (> la
4a10: 73 74 2d 75 70 64 61 74 65 20 32 30 29 20 20 20 st-update 20)
4a20: 20 20 20 20 20 3b 3b 20 4d 61 72 6b 20 61 73 20 ;; Mark as
4a30: 64 65 61 64 20 69 66 20 6e 6f 74 20 75 70 64 61 dead if not upda
4a40: 74 65 64 20 69 6e 20 6c 61 73 74 20 32 30 20 73 ted in last 20 s
4a50: 65 63 6f 6e 64 73 0a 09 09 09 20 28 6f 70 65 6e econds.... (open
4a60: 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 -run-close tasks
4a70: 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 :server-deregist
4a80: 65 72 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 er tasks:open-db
4a90: 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 6f hostname pullpo
4aa0: 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 70 69 64 rt: pullport pid
4ab0: 3a 20 70 69 64 29 29 29 0a 09 09 20 28 66 6f 72 : pid)))... (for
4ac0: 6d 61 74 20 23 74 20 66 6d 74 73 74 72 20 69 64 mat #t fmtstr id
4ad0: 20 6d 74 2d 76 65 72 20 70 69 64 20 68 6f 73 74 mt-ver pid host
4ae0: 6e 61 6d 65 20 28 63 6f 6e 63 20 69 6e 74 65 72 name (conc inter
4af0: 66 61 63 65 20 22 3a 22 20 70 75 6c 6c 70 6f 72 face ":" pullpor
4b00: 74 29 20 70 75 62 70 6f 72 74 20 6c 61 73 74 2d t) pubport last-
4b10: 75 70 64 61 74 65 0a 09 09 09 20 28 69 66 20 73 update.... (if s
4b20: 74 61 74 75 73 20 22 61 6c 69 76 65 22 20 22 64 tatus "alive" "d
4b30: 65 61 64 22 29 20 74 72 61 6e 73 70 6f 72 74 29 ead") transport)
4b40: 0a 09 09 20 28 69 66 20 28 6f 72 20 28 65 71 75 ... (if (or (equ
4b50: 61 6c 3f 20 69 64 20 73 69 64 29 0a 09 09 09 20 al? id sid)....
4b60: 28 65 71 75 61 6c 3f 20 73 69 64 20 30 29 29 20 (equal? sid 0))
4b70: 3b 3b 20 6b 69 6c 6c 20 61 6c 6c 2f 61 6e 79 0a ;; kill all/any.
4b80: 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 .. (begin...
4b90: 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
4ba0: 69 6e 74 2d 69 6e 66 6f 20 30 20 22 41 74 74 65 int-info 0 "Atte
4bb0: 6d 70 74 69 6e 67 20 74 6f 20 73 74 6f 70 20 73 mpting to stop s
4bc0: 65 72 76 65 72 20 77 69 74 68 20 70 69 64 20 22 erver with pid "
4bd0: 20 70 69 64 29 0a 09 09 20 20 20 20 20 20 20 28 pid)... (
4be0: 74 61 73 6b 73 3a 6b 69 6c 6c 2d 73 65 72 76 65 tasks:kill-serve
4bf0: 72 20 73 74 61 74 75 73 20 68 6f 73 74 6e 61 6d r status hostnam
4c00: 65 20 70 75 6c 6c 70 6f 72 74 20 70 69 64 20 74 e pullport pid t
4c10: 72 61 6e 73 70 6f 72 74 29 29 29 29 29 0a 09 20 ransport)))))..
4c20: 20 20 20 20 73 65 72 76 65 72 73 29 0a 09 20 20 servers)..
4c30: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
4c40: 6e 66 6f 20 31 20 22 44 6f 6e 65 20 77 69 74 68 nfo 1 "Done with
4c50: 20 6c 69 73 74 73 65 72 76 65 72 73 22 29 0a 09 listservers")..
4c60: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
4c70: 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 mething* #t)..
4c80: 20 20 28 65 78 69 74 29 29 20 3b 3b 20 6d 75 73 (exit)) ;; mus
4c90: 74 20 64 6f 2c 20 77 6f 75 6c 64 20 68 61 76 65 t do, would have
4ca0: 20 74 6f 20 61 64 64 20 63 68 65 63 6b 73 20 74 to add checks t
4cb0: 6f 20 6d 61 6e 79 2f 61 6c 6c 20 63 61 6c 6c 73 o many/all calls
4cc0: 20 62 65 6c 6f 77 0a 09 20 20 28 65 78 69 74 29 below.. (exit)
4cd0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
4ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
4d20: 20 57 65 69 72 64 20 73 70 65 63 69 61 6c 20 63 Weird special c
4d30: 61 6c 6c 73 20 74 68 61 74 20 6e 65 65 64 20 74 alls that need t
4d40: 6f 20 72 75 6e 20 2a 61 66 74 65 72 2a 20 74 68 o run *after* th
4d50: 65 20 73 65 72 76 65 72 20 68 61 73 20 73 74 61 e server has sta
4d60: 72 74 65 64 3f 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d rted?.;;========
4d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
4db0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
4dc0: 67 20 22 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 g "-list-targets
4dd0: 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 61 "). (let ((ta
4de0: 72 67 65 74 73 20 28 63 6f 6d 6d 6f 6e 3a 67 65 rgets (common:ge
4df0: 74 2d 72 75 6e 63 6f 6e 66 69 67 2d 74 61 72 67 t-runconfig-targ
4e00: 65 74 73 29 29 29 0a 20 20 20 20 20 20 28 70 72 ets))). (pr
4e10: 69 6e 74 20 22 46 6f 75 6e 64 20 22 28 6c 65 6e int "Found "(len
4e20: 67 74 68 20 74 61 72 67 65 74 73 29 20 22 20 74 gth targets) " t
4e30: 61 72 67 65 74 73 22 29 0a 20 20 20 20 20 20 28 argets"). (
4e40: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
4e50: 20 28 78 29 0a 09 09 20 20 3b 3b 20 28 70 72 69 (x)... ;; (pri
4e60: 6e 74 20 22 5b 22 20 78 20 22 5d 22 29 29 0a 09 nt "[" x "]"))..
4e70: 09 20 20 28 70 72 69 6e 74 20 78 29 29 0a 09 09 . (print x))...
4e80: 74 61 72 67 65 74 73 29 0a 20 20 20 20 20 20 28 targets). (
4e90: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
4ea0: 6e 67 2a 20 23 74 29 29 29 0a 0a 28 64 65 66 69 ng* #t)))..(defi
4eb0: 6e 65 20 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e 66 ne (full-runconf
4ec0: 69 67 73 2d 72 65 61 64 29 0a 20 20 28 6c 65 74 igs-read). (let
4ed0: 2a 20 28 28 6b 65 79 73 20 20 20 28 72 6d 74 3a * ((keys (rmt:
4ee0: 67 65 74 2d 6b 65 79 73 29 29 0a 09 20 28 74 61 get-keys)).. (ta
4ef0: 72 67 65 74 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 rget (common:arg
4f00: 73 2d 67 65 74 2d 74 61 72 67 65 74 29 29 0a 09 s-get-target))..
4f10: 20 28 6b 65 79 2d 76 61 6c 73 20 28 69 66 20 74 (key-vals (if t
4f20: 61 72 67 65 74 20 28 6b 65 79 73 3a 74 61 72 67 arget (keys:targ
4f30: 65 74 2d 3e 6b 65 79 76 61 6c 20 6b 65 79 73 20 et->keyval keys
4f40: 74 61 72 67 65 74 29 20 23 66 29 29 0a 09 20 28 target) #f)).. (
4f50: 73 65 63 74 69 6f 6e 73 20 28 69 66 20 74 61 72 sections (if tar
4f60: 67 65 74 20 28 6c 69 73 74 20 22 64 65 66 61 75 get (list "defau
4f70: 6c 74 22 20 74 61 72 67 65 74 29 20 23 66 29 29 lt" target) #f))
4f80: 0a 09 20 28 64 61 74 61 20 20 20 20 20 28 62 65 .. (data (be
4f90: 67 69 6e 0a 09 09 20 20 20 20 20 28 73 65 74 65 gin... (sete
4fa0: 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f nv "MT_RUN_AREA_
4fb0: 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 HOME" *toppath*)
4fc0: 0a 09 09 20 20 20 20 20 28 69 66 20 6b 65 79 2d ... (if key-
4fd0: 76 61 6c 73 0a 09 09 09 20 28 66 6f 72 2d 65 61 vals.... (for-ea
4fe0: 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 74 29 0a ch (lambda (kt).
4ff0: 09 09 09 09 20 20 20 20 20 28 73 65 74 65 6e 76 .... (setenv
5000: 20 28 63 61 72 20 6b 74 29 20 28 63 61 64 72 20 (car kt) (cadr
5010: 6b 74 29 29 29 0a 09 09 09 09 20 20 20 6b 65 79 kt)))..... key
5020: 2d 76 61 6c 73 29 29 0a 09 09 20 20 20 20 20 28 -vals))... (
5030: 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 6f 6e read-config (con
5040: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 c *toppath* "/ru
5050: 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 nconfigs.config"
5060: 29 20 23 66 20 23 74 20 73 65 63 74 69 6f 6e 73 ) #f #t sections
5070: 3a 20 73 65 63 74 69 6f 6e 73 29 29 29 29 0a 20 : sections)))).
5080: 20 20 20 64 61 74 61 29 29 0a 0a 0a 28 69 66 20 data))...(if
5090: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
50a0: 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 22 29 show-runconfig")
50b0: 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 28 . (let ((tl (
50c0: 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 launch:setup-for
50d0: 2d 72 75 6e 29 29 29 0a 20 20 20 20 20 20 28 70 -run))). (p
50e0: 75 73 68 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 ush-directory *t
50f0: 6f 70 70 61 74 68 2a 29 0a 20 20 20 20 20 20 28 oppath*). (
5100: 6c 65 74 20 28 28 64 61 74 61 20 28 66 75 6c 6c let ((data (full
5110: 2d 72 75 6e 63 6f 6e 66 69 67 73 2d 72 65 61 64 -runconfigs-read
5120: 29 29 29 0a 09 3b 3b 20 6b 65 65 70 20 74 68 69 )))..;; keep thi
5130: 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 09 28 63 6f s one local..(co
5140: 6e 64 0a 09 20 28 28 61 6e 64 20 28 61 72 67 73 nd.. ((and (args
5150: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 :get-arg "-secti
5160: 6f 6e 22 29 0a 09 20 20 20 20 20 20 20 28 61 72 on").. (ar
5170: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 gs:get-arg "-var
5180: 22 29 29 0a 09 20 20 28 6c 65 74 20 28 28 76 61 ")).. (let ((va
5190: 6c 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 l (configf:looku
51a0: 70 20 64 61 74 61 20 28 61 72 67 73 3a 67 65 74 p data (args:get
51b0: 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 -arg "-section")
51c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
51d0: 76 61 72 22 29 29 29 29 0a 09 20 20 20 20 28 69 var")))).. (i
51e0: 66 20 76 61 6c 20 28 70 72 69 6e 74 20 76 61 6c f val (print val
51f0: 29 29 29 29 0a 09 20 28 28 6e 6f 74 20 28 61 72 )))).. ((not (ar
5200: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d gs:get-arg "-dum
5210: 70 6d 6f 64 65 22 29 29 0a 09 20 20 28 70 70 20 pmode")).. (pp
5220: 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 (hash-table->ali
5230: 73 74 20 64 61 74 61 29 29 29 0a 09 20 28 28 73 st data))).. ((s
5240: 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 tring=? (args:ge
5250: 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 t-arg "-dumpmode
5260: 22 29 20 22 6a 73 6f 6e 22 29 0a 09 28 6a 73 6f ") "json")..(jso
5270: 6e 2d 77 72 69 74 65 20 64 61 74 61 29 29 0a 09 n-write data))..
5280: 20 28 65 6c 73 65 0a 09 20 20 28 64 65 62 75 67 (else.. (debug
5290: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
52a0: 20 2d 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 20 -dumpmode of "
52b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
52c0: 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f 74 dumpmode") " not
52d0: 20 72 65 63 6f 67 6e 69 73 65 64 22 29 29 29 0a recognised"))).
52e0: 09 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 .(set! *didsomet
52f0: 68 69 6e 67 2a 20 23 74 29 29 0a 20 20 20 20 20 hing* #t)).
5300: 20 28 70 6f 70 2d 64 69 72 65 63 74 6f 72 79 29 (pop-directory)
5310: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
5320: 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 6f 6e t-arg "-show-con
5330: 66 69 67 22 29 0a 20 20 20 20 28 6c 65 74 20 28 fig"). (let (
5340: 28 74 6c 20 20 20 28 6c 61 75 6e 63 68 3a 73 65 (tl (launch:se
5350: 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 tup-for-run))..
5360: 20 28 64 61 74 61 20 2a 63 6f 6e 66 69 67 64 61 (data *configda
5370: 74 2a 29 29 20 3b 3b 20 28 72 65 61 64 2d 63 6f t*)) ;; (read-co
5380: 6e 66 69 67 20 22 6d 65 67 61 74 65 73 74 2e 63 nfig "megatest.c
5390: 6f 6e 66 69 67 22 20 23 66 20 23 74 29 29 29 0a onfig" #f #t))).
53a0: 20 20 20 20 20 20 28 70 75 73 68 2d 64 69 72 65 (push-dire
53b0: 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 ctory *toppath*)
53c0: 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 . ;; keep t
53d0: 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 his one local.
53e0: 20 20 20 20 28 63 6f 6e 64 20 0a 20 20 20 20 20 (cond .
53f0: 20 20 28 28 61 6e 64 20 28 61 72 67 73 3a 67 65 ((and (args:ge
5400: 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f 6e 22 t-arg "-section"
5410: 29 0a 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 ).. (args:ge
5420: 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 0a 09 t-arg "-var"))..
5430: 28 6c 65 74 20 28 28 76 61 6c 20 28 63 6f 6e 66 (let ((val (conf
5440: 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 61 20 igf:lookup data
5450: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5460: 73 65 63 74 69 6f 6e 22 29 28 61 72 67 73 3a 67 section")(args:g
5470: 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 29 et-arg "-var")))
5480: 29 0a 09 20 20 28 69 66 20 76 61 6c 20 28 70 72 ).. (if val (pr
5490: 69 6e 74 20 76 61 6c 29 29 29 29 0a 20 20 20 20 int val)))).
54a0: 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 ((not (args:g
54b0: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
54c0: 65 22 29 29 0a 09 28 70 70 20 28 68 61 73 68 2d e"))..(pp (hash-
54d0: 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 64 61 74 table->alist dat
54e0: 61 29 29 29 0a 20 20 20 20 20 20 20 28 28 73 74 a))). ((st
54f0: 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 ring=? (args:get
5500: 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 -arg "-dumpmode"
5510: 29 20 22 6a 73 6f 6e 22 29 0a 09 28 6a 73 6f 6e ) "json")..(json
5520: 2d 77 72 69 74 65 20 64 61 74 61 29 29 0a 20 20 -write data)).
5530: 20 20 20 20 20 28 65 6c 73 65 0a 09 28 64 65 62 (else..(deb
5540: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
5550: 52 3a 20 2d 64 75 6d 70 6d 6f 64 65 20 6f 66 20 R: -dumpmode of
5560: 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 " (args:get-arg
5570: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e "-dumpmode") " n
5580: 6f 74 20 72 65 63 6f 67 6e 69 73 65 64 22 29 29 ot recognised"))
5590: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
55a0: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
55b0: 0a 20 20 20 20 20 20 28 70 6f 70 2d 64 69 72 65 . (pop-dire
55c0: 63 74 6f 72 79 29 29 29 0a 0a 28 69 66 20 28 61 ctory)))..(if (a
55d0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 rgs:get-arg "-sh
55e0: 6f 77 2d 63 6d 64 69 6e 66 6f 22 29 0a 20 20 20 ow-cmdinfo").
55f0: 20 28 69 66 20 28 67 65 74 65 6e 76 20 22 4d 54 (if (getenv "MT
5600: 5f 43 4d 44 49 4e 46 4f 22 29 0a 09 28 6c 65 74 _CMDINFO")..(let
5610: 20 28 28 64 61 74 61 20 28 72 65 61 64 20 28 6f ((data (read (o
5620: 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 pen-input-string
5630: 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d (base64:base64-
5640: 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 22 decode (getenv "
5650: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 MT_CMDINFO")))))
5660: 29 0a 09 20 20 28 69 66 20 28 65 71 75 61 6c 3f ).. (if (equal?
5670: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5680: 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f -dumpmode") "jso
5690: 6e 22 29 0a 09 20 20 20 20 20 20 28 6a 73 6f 6e n").. (json
56a0: 2d 77 72 69 74 65 20 64 61 74 61 29 0a 09 20 20 -write data)..
56b0: 20 20 20 20 28 70 70 20 64 61 74 61 29 29 0a 09 (pp data))..
56c0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
56d0: 74 68 69 6e 67 2a 20 23 74 29 29 0a 09 28 64 65 thing* #t))..(de
56e0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
56f0: 20 22 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 "environment va
5700: 72 69 61 62 6c 65 20 4d 54 5f 43 4d 44 49 4e 46 riable MT_CMDINF
5710: 4f 20 69 73 20 6e 6f 74 20 73 65 74 22 29 29 29 O is not set")))
5720: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
5730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 65 ==========.;; Re
5770: 6d 6f 76 65 20 6f 6c 64 20 72 75 6e 28 73 29 0a move old run(s).
5780: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
5790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
57c0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 69 6e ========..;; sin
57d0: 63 65 20 73 65 76 65 72 61 6c 20 61 63 74 69 6f ce several actio
57e0: 6e 73 20 63 61 6e 20 62 65 20 73 70 65 63 69 66 ns can be specif
57f0: 69 65 64 20 6f 6e 20 74 68 65 20 63 6f 6d 6d 61 ied on the comma
5800: 6e 64 20 6c 69 6e 65 20 74 68 65 20 72 65 6d 6f nd line the remo
5810: 76 61 6c 0a 3b 3b 20 69 73 20 64 6f 6e 65 20 66 val.;; is done f
5820: 69 72 73 74 0a 28 64 65 66 69 6e 65 20 28 6f 70 irst.(define (op
5830: 65 72 61 74 65 2d 6f 6e 20 61 63 74 69 6f 6e 29 erate-on action)
5840: 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 72 65 . (let* ((runre
5850: 63 20 28 72 75 6e 73 3a 72 75 6e 72 65 63 2d 6d c (runs:runrec-m
5860: 61 6b 65 2d 72 65 63 6f 72 64 29 29 0a 09 20 28 ake-record)).. (
5870: 74 61 72 67 65 74 20 28 63 6f 6d 6d 6f 6e 3a 61 target (common:a
5880: 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 29 rgs-get-target))
5890: 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 ). (cond.
58a0: 20 28 28 6e 6f 74 20 74 61 72 67 65 74 29 0a 20 ((not target).
58b0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
58c0: 74 20 30 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 t 0 "ERROR: Miss
58d0: 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 ing required par
58e0: 61 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 ameter for " act
58f0: 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 ion ", you must
5900: 73 70 65 63 69 66 79 20 2d 74 61 72 67 65 74 20 specify -target
5910: 6f 72 20 2d 72 65 71 74 61 72 67 22 29 0a 20 20 or -reqtarg").
5920: 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 20 20 (exit 1)).
5930: 20 20 20 28 28 6e 6f 74 20 28 6f 72 20 28 61 72 ((not (or (ar
5940: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
5950: 6e 61 6d 65 22 29 0a 09 20 20 20 20 20 20 20 28 name").. (
5960: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
5970: 75 6e 6e 61 6d 65 22 29 29 29 0a 20 20 20 20 20 unname"))).
5980: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
5990: 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 20 "ERROR: Missing
59a0: 72 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 74 required paramet
59b0: 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f 6e 20 er for " action
59c0: 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 ", you must spec
59d0: 69 66 79 20 74 68 65 20 72 75 6e 20 6e 61 6d 65 ify the run name
59e0: 20 70 61 74 74 65 72 6e 20 77 69 74 68 20 2d 72 pattern with -r
59f0: 75 6e 6e 61 6d 65 20 70 61 74 74 22 29 0a 20 20 unname patt").
5a00: 20 20 20 20 28 65 78 69 74 20 32 29 29 0a 20 20 (exit 2)).
5a10: 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 ((not (args:g
5a20: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
5a30: 74 22 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 t")). (debu
5a40: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
5a50: 3a 20 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 : Missing requir
5a60: 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 ed parameter for
5a70: 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 " action ", you
5a80: 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 74 68 must specify th
5a90: 65 20 74 65 73 74 20 70 61 74 74 65 72 6e 20 77 e test pattern w
5aa0: 69 74 68 20 2d 74 65 73 74 70 61 74 74 22 29 0a ith -testpatt").
5ab0: 20 20 20 20 20 20 28 65 78 69 74 20 33 29 29 0a (exit 3)).
5ac0: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
5ad0: 20 28 69 66 20 28 6e 6f 74 20 28 63 61 72 20 2a (if (not (car *
5ae0: 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 29 0a 09 20 configinfo*))..
5af0: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 (begin.. (de
5b00: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
5b10: 4f 52 3a 20 41 74 74 65 6d 70 74 65 64 20 22 20 OR: Attempted "
5b20: 61 63 74 69 6f 6e 20 22 6f 6e 20 74 65 73 74 28 action "on test(
5b30: 73 29 20 62 75 74 20 72 75 6e 20 61 72 65 61 20 s) but run area
5b40: 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e 6f 74 20 config file not
5b50: 66 6f 75 6e 64 22 29 0a 09 20 20 20 20 28 65 78 found").. (ex
5b60: 69 74 20 31 29 29 0a 09 20 20 3b 3b 20 70 75 74 it 1)).. ;; put
5b70: 20 74 65 73 74 20 70 61 72 61 6d 65 74 65 72 73 test parameters
5b80: 20 69 6e 74 6f 20 63 6f 6e 76 65 6e 69 65 6e 74 into convenient
5b90: 20 76 61 72 69 61 62 6c 65 73 0a 09 20 20 28 72 variables.. (r
5ba0: 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 20 uns:operate-on
5bb0: 61 63 74 69 6f 6e 0a 09 09 09 20 20 20 20 74 61 action.... ta
5bc0: 72 67 65 74 0a 09 09 09 20 20 20 20 28 6f 72 20 rget.... (or
5bd0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5be0: 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 runname")(args:g
5bf0: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
5c00: 22 29 29 0a 09 09 09 20 20 20 20 28 61 72 67 73 ")).... (args
5c10: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 :get-arg "-testp
5c20: 61 74 74 22 29 0a 09 09 09 20 20 20 20 73 74 61 att").... sta
5c30: 74 65 3a 20 28 6f 72 20 28 61 72 67 73 3a 67 65 te: (or (args:ge
5c40: 74 2d 61 72 67 20 22 2d 73 74 61 74 65 22 29 28 t-arg "-state")(
5c50: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 args:get-arg ":s
5c60: 74 61 74 65 22 29 20 29 0a 09 09 09 20 20 20 20 tate") )....
5c70: 73 74 61 74 75 73 3a 20 28 6f 72 20 28 61 72 67 status: (or (arg
5c80: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 s:get-arg "-stat
5c90: 75 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 us")(args:get-ar
5ca0: 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a 09 09 g ":status"))...
5cb0: 09 20 20 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 . new-state-s
5cc0: 74 61 74 75 73 3a 20 28 61 72 67 73 3a 67 65 74 tatus: (args:get
5cd0: 2d 61 72 67 20 22 2d 73 65 74 2d 73 74 61 74 65 -arg "-set-state
5ce0: 2d 73 74 61 74 75 73 22 29 29 29 0a 20 20 20 20 -status"))).
5cf0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
5d00: 74 68 69 6e 67 2a 20 23 74 29 29 29 29 29 0a 09 thing* #t)))))..
5d10: 20 20 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 .(if (args:get
5d20: 2d 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d 72 75 -arg "-remove-ru
5d30: 6e 73 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 ns"). (genera
5d40: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 l-run-call .
5d50: 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 0a "-remove-runs".
5d60: 20 20 20 20 20 22 72 65 6d 6f 76 65 20 72 75 6e "remove run
5d70: 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 s". (lambda
5d80: 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 (target runname
5d90: 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 keys keyvals).
5da0: 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e (operate-on
5db0: 20 27 72 65 6d 6f 76 65 2d 72 75 6e 73 29 29 29 'remove-runs)))
5dc0: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
5dd0: 2d 61 72 67 20 22 2d 73 65 74 2d 73 74 61 74 65 -arg "-set-state
5de0: 2d 73 74 61 74 75 73 22 29 0a 20 20 20 20 28 67 -status"). (g
5df0: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
5e00: 0a 20 20 20 20 20 22 2d 73 65 74 2d 73 74 61 74 . "-set-stat
5e10: 65 2d 73 74 61 74 75 73 22 0a 20 20 20 20 20 22 e-status". "
5e20: 73 65 74 20 73 74 61 74 65 20 61 6e 64 20 73 74 set state and st
5e30: 61 74 75 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 atus". (lamb
5e40: 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 da (target runna
5e50: 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 me keys keyvals)
5e60: 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 . (operate
5e70: 2d 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 -on 'set-state-s
5e80: 74 61 74 75 73 29 29 29 29 0a 0a 28 69 66 20 28 tatus))))..(if (
5e90: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
5ea0: 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 "-set-run-statu
5eb0: 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 s")..(args:get-a
5ec0: 72 67 20 22 2d 67 65 74 2d 72 75 6e 2d 73 74 61 rg "-get-run-sta
5ed0: 74 75 73 22 29 29 0a 20 20 20 20 28 67 65 6e 65 tus")). (gene
5ee0: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 20 20 ral-run-call.
5ef0: 20 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 "-set-run-stat
5f00: 75 73 22 0a 20 20 20 20 20 22 73 65 74 20 72 75 us". "set ru
5f10: 6e 20 73 74 61 74 75 73 22 0a 20 20 20 20 20 28 n status". (
5f20: 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 lambda (target r
5f30: 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 unname keys keyv
5f40: 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6c 65 74 als). (let
5f50: 2a 20 28 28 72 75 6e 73 64 61 74 20 20 28 63 64 * ((runsdat (cd
5f60: 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a b:remote-run db:
5f70: 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 get-runs-by-patt
5f80: 20 23 66 20 6b 65 79 73 20 72 75 6e 6e 61 6d 65 #f keys runname
5f90: 20 0a 09 09 09 09 09 28 63 6f 6d 6d 6f 6e 3a 61 ......(common:a
5fa0: 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 0a rgs-get-target).
5fb0: 09 09 09 09 09 23 66 20 23 66 29 29 0a 09 20 20 .....#f #f))..
5fc0: 20 20 20 20 28 68 65 61 64 65 72 20 20 20 28 76 (header (v
5fd0: 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 ector-ref runsda
5fe0: 74 20 30 29 29 0a 09 20 20 20 20 20 20 28 72 6f t 0)).. (ro
5ff0: 77 73 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 ws (vector-r
6000: 65 66 20 72 75 6e 73 64 61 74 20 31 29 29 29 0a ef runsdat 1))).
6010: 09 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 6f 77 . (if (null? row
6020: 73 29 0a 09 20 20 20 20 20 28 62 65 67 69 6e 0a s).. (begin.
6030: 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
6040: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 4e 6f 20 rint-info 0 "No
6050: 6d 61 74 63 68 69 6e 67 20 72 75 6e 20 66 6f 75 matching run fou
6060: 6e 64 2e 22 29 0a 09 20 20 20 20 20 20 20 28 65 nd.").. (e
6070: 78 69 74 20 31 29 29 0a 09 20 20 20 20 20 28 6c xit 1)).. (l
6080: 65 74 2a 20 28 28 72 6f 77 20 20 20 20 20 20 28 et* ((row (
6090: 63 61 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 car (vector-ref
60a0: 72 75 6e 73 64 61 74 20 31 29 29 29 0a 09 09 20 runsdat 1)))...
60b0: 20 20 20 28 72 75 6e 2d 69 64 20 20 20 28 64 62 (run-id (db
60c0: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
60d0: 61 64 65 72 20 72 6f 77 20 68 65 61 64 65 72 20 ader row header
60e0: 22 69 64 22 29 29 29 0a 09 20 20 20 20 20 20 20 "id")))..
60f0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
6100: 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 g "-set-run-stat
6110: 75 73 22 29 0a 09 09 20 20 20 28 63 64 62 3a 72 us")... (cdb:r
6120: 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 73 65 74 emote-run db:set
6130: 2d 72 75 6e 2d 73 74 61 74 75 73 20 23 66 20 72 -run-status #f r
6140: 75 6e 2d 69 64 20 28 61 72 67 73 3a 67 65 74 2d un-id (args:get-
6150: 61 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d 73 74 arg "-set-run-st
6160: 61 74 75 73 22 29 20 6d 73 67 3a 20 28 61 72 67 atus") msg: (arg
6170: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 s:get-arg "-m"))
6180: 0a 09 09 20 20 20 28 70 72 69 6e 74 20 28 6f 70 ... (print (op
6190: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a en-run-close db:
61a0: 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 23 get-run-status #
61b0: 66 20 72 75 6e 2d 69 64 29 29 0a 09 09 20 20 20 f run-id))...
61c0: 29 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d )))))))..;;=====
61d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
61e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
61f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6210: 3d 0a 3b 3b 20 51 75 65 72 79 20 72 75 6e 73 0a =.;; Query runs.
6220: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
6230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6260: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f 54 ========..;; NOT
6270: 45 3a 20 6c 69 73 74 2d 72 75 6e 73 20 61 6e 64 E: list-runs and
6280: 20 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 list-db-targets
6290: 20 6f 70 65 72 61 74 65 20 6f 6e 20 6c 6f 63 61 operate on loca
62a0: 6c 20 64 62 21 21 21 0a 3b 3b 0a 28 69 66 20 28 l db!!!.;;.(if (
62b0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
62c0: 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 0a 09 "-list-runs")..
62d0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
62e0: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 list-db-targets"
62f0: 29 29 0a 20 20 20 20 28 69 66 20 28 6c 61 75 6e )). (if (laun
6300: 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e ch:setup-for-run
6310: 29 0a 09 28 6c 65 74 2a 20 28 28 64 62 73 74 72 )..(let* ((dbstr
6320: 75 63 74 20 28 6d 61 6b 65 2d 64 62 72 3a 64 62 uct (make-dbr:db
6330: 73 74 72 75 63 74 20 70 61 74 68 3a 20 2a 74 6f struct path: *to
6340: 70 70 61 74 68 2a 20 6c 6f 63 61 6c 3a 20 23 74 ppath* local: #t
6350: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 70 )).. (runp
6360: 61 74 74 20 20 28 61 72 67 73 3a 67 65 74 2d 61 att (args:get-a
6370: 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 rg "-list-runs")
6380: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 ).. (testp
6390: 61 74 74 20 28 69 66 20 28 61 72 67 73 3a 67 65 att (if (args:ge
63a0: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
63b0: 22 29 20 0a 09 09 09 20 20 20 20 20 28 61 72 67 ") .... (arg
63c0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
63d0: 70 61 74 74 22 29 20 0a 09 09 09 20 20 20 20 20 patt") ....
63e0: 22 25 22 29 29 0a 09 20 20 20 20 20 20 20 28 6b "%")).. (k
63f0: 65 79 73 20 20 20 20 20 28 64 62 3a 67 65 74 2d eys (db:get-
6400: 6b 65 79 73 20 64 62 73 74 72 75 63 74 29 29 0a keys dbstruct)).
6410: 09 20 20 20 20 20 20 20 3b 3b 20 28 72 75 6e 73 . ;; (runs
6420: 64 61 74 20 20 28 64 62 3a 67 65 74 2d 72 75 6e dat (db:get-run
6430: 73 20 64 62 73 74 72 75 63 74 20 72 75 6e 70 61 s dbstruct runpa
6440: 74 74 20 23 66 20 23 66 20 27 28 29 29 29 0a 09 tt #f #f '()))..
6450: 20 20 20 20 20 20 20 28 72 75 6e 73 64 61 74 20 (runsdat
6460: 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 2d 62 79 (db:get-runs-by
6470: 2d 70 61 74 74 20 64 62 73 74 72 75 63 74 20 6b -patt dbstruct k
6480: 65 79 73 20 72 75 6e 70 61 74 74 20 28 63 6f 6d eys runpatt (com
6490: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 mon:args-get-tar
64a0: 67 65 74 29 0a 09 09 09 09 09 20 23 66 20 23 66 get)...... #f #f
64b0: 29 29 0a 09 09 3b 3b 20 28 63 64 62 3a 72 65 6d ))...;; (cdb:rem
64c0: 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 72 ote-run db:get-r
64d0: 75 6e 73 20 23 66 20 72 75 6e 70 61 74 74 20 23 uns #f runpatt #
64e0: 66 20 23 66 20 27 28 29 29 29 0a 09 20 20 20 20 f #f '()))..
64f0: 20 20 20 28 72 75 6e 73 20 20 20 20 20 28 64 62 (runs (db
6500: 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e 73 64 61 :get-rows runsda
6510: 74 29 29 0a 09 20 20 20 20 20 20 20 28 68 65 61 t)).. (hea
6520: 64 65 72 20 20 20 28 64 62 3a 67 65 74 2d 68 65 der (db:get-he
6530: 61 64 65 72 20 72 75 6e 73 64 61 74 29 29 0a 09 ader runsdat))..
6540: 20 20 20 20 20 20 20 28 64 62 2d 74 61 72 67 65 (db-targe
6550: 74 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ts (args:get-arg
6560: 20 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 "-list-db-targe
6570: 74 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 ts")).. (s
6580: 65 65 6e 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 een (make-ha
6590: 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 20 20 3b sh-table))).. ;
65a0: 3b 20 45 61 63 68 20 72 75 6e 0a 09 20 20 28 66 ; Each run.. (f
65b0: 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 28 6c 61 or-each .. (la
65c0: 6d 62 64 61 20 28 72 75 6e 29 0a 09 20 20 20 20 mbda (run)..
65d0: 20 28 6c 65 74 20 28 28 74 61 72 67 65 74 73 74 (let ((targetst
65e0: 72 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 r (string-inters
65f0: 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 perse (map (lamb
6600: 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 20 28 da (x)........ (
6610: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
6620: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
6630: 72 20 78 29 29 0a 09 09 09 09 09 09 20 20 20 20 r x)).......
6640: 20 20 20 6b 65 79 73 29 20 22 2f 22 29 29 29 0a keys) "/"))).
6650: 09 20 20 20 20 20 20 20 28 69 66 20 64 62 2d 74 . (if db-t
6660: 61 72 67 65 74 73 0a 09 09 20 20 20 28 69 66 20 argets... (if
6670: 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 (not (hash-table
6680: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 73 65 65 -ref/default see
6690: 6e 20 74 61 72 67 65 74 73 74 72 20 23 66 29 29 n targetstr #f))
66a0: 0a 09 09 20 20 20 20 20 20 20 28 62 65 67 69 6e ... (begin
66b0: 0a 09 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 .... (hash-table
66c0: 2d 73 65 74 21 20 73 65 65 6e 20 74 61 72 67 65 -set! seen targe
66d0: 74 73 74 72 20 23 74 29 0a 09 09 09 20 3b 3b 20 tstr #t).... ;;
66e0: 28 70 72 69 6e 74 20 22 5b 22 20 74 61 72 67 65 (print "[" targe
66f0: 74 73 74 72 20 22 5d 22 29 29 29 29 0a 09 09 09 tstr "]"))))....
6700: 20 28 70 72 69 6e 74 20 74 61 72 67 65 74 73 74 (print targetst
6710: 72 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 69 r)))).. (i
6720: 66 20 28 6e 6f 74 20 64 62 2d 74 61 72 67 65 74 f (not db-target
6730: 73 29 0a 09 09 20 20 20 28 6c 65 74 2a 20 28 28 s)... (let* ((
6740: 72 75 6e 2d 69 64 20 28 64 62 3a 67 65 74 2d 76 run-id (db:get-v
6750: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
6760: 75 6e 20 68 65 61 64 65 72 20 22 69 64 22 29 29 un header "id"))
6770: 0a 09 09 09 20 20 28 74 65 73 74 73 20 20 28 64 .... (tests (d
6780: 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d b:get-tests-for-
6790: 72 75 6e 20 64 62 73 74 72 75 63 74 20 72 75 6e run dbstruct run
67a0: 2d 69 64 20 74 65 73 74 70 61 74 74 20 27 28 29 -id testpatt '()
67b0: 20 27 28 29 20 23 66 20 23 66 20 23 66 20 27 74 '() #f #f #f 't
67c0: 65 73 74 6e 61 6d 65 20 27 61 73 63 20 23 66 29 estname 'asc #f)
67d0: 29 29 0a 09 09 20 20 20 20 20 28 70 72 69 6e 74 ))... (print
67e0: 20 22 52 75 6e 3a 20 22 20 74 61 72 67 65 74 73 "Run: " targets
67f0: 74 72 20 22 2f 22 20 28 64 62 3a 67 65 74 2d 76 tr "/" (db:get-v
6800: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
6810: 75 6e 20 68 65 61 64 65 72 20 22 72 75 6e 6e 61 un header "runna
6820: 6d 65 22 29 20 0a 09 09 09 20 20 20 20 22 20 73 me") .... " s
6830: 74 61 74 75 73 3a 20 22 20 28 64 62 3a 67 65 74 tatus: " (db:get
6840: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
6850: 20 72 75 6e 20 68 65 61 64 65 72 20 22 73 74 61 run header "sta
6860: 74 65 22 29 0a 09 09 09 20 20 20 20 22 20 72 75 te").... " ru
6870: 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 n-id: " run-id "
6880: 2c 20 6e 75 6d 62 65 72 20 74 65 73 74 73 3a 20 , number tests:
6890: 22 20 28 6c 65 6e 67 74 68 20 74 65 73 74 73 29 " (length tests)
68a0: 29 0a 09 09 20 20 20 20 20 28 66 6f 72 2d 65 61 )... (for-ea
68b0: 63 68 20 0a 09 09 20 20 20 20 20 20 28 6c 61 6d ch ... (lam
68c0: 62 64 61 20 28 74 65 73 74 29 0a 09 09 09 28 66 bda (test)....(f
68d0: 6f 72 6d 61 74 20 23 74 0a 09 09 09 09 22 20 20 ormat #t....."
68e0: 54 65 73 74 3a 20 7e 32 35 61 20 53 74 61 74 65 Test: ~25a State
68f0: 3a 20 7e 31 35 61 20 53 74 61 74 75 73 3a 20 7e : ~15a Status: ~
6900: 31 35 61 20 52 75 6e 74 69 6d 65 3a 20 7e 35 40 15a Runtime: ~5@
6910: 61 73 20 54 69 6d 65 3a 20 7e 32 32 61 20 48 6f as Time: ~22a Ho
6920: 73 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 09 09 st: ~10a\n".....
6930: 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 (conc (db:test-g
6940: 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 et-testname test
6950: 29 0a 09 09 09 09 20 20 20 20 20 20 28 69 66 20 )..... (if
6960: 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 (equal? (db:test
6970: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 -get-item-path t
6980: 65 73 74 29 20 22 22 29 0a 09 09 09 09 09 20 20 est) "")......
6990: 22 22 20 0a 09 09 09 09 09 20 20 28 63 6f 6e 63 "" ...... (conc
69a0: 20 22 28 22 20 28 64 62 3a 74 65 73 74 2d 67 65 "(" (db:test-ge
69b0: 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 t-item-path test
69c0: 29 20 22 29 22 29 29 29 0a 09 09 09 09 28 64 62 ) ")"))).....(db
69d0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
69e0: 74 65 73 74 29 0a 09 09 09 09 28 64 62 3a 74 65 test).....(db:te
69f0: 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 st-get-status te
6a00: 73 74 29 0a 09 09 09 09 28 64 62 3a 74 65 73 74 st).....(db:test
6a10: 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f -get-run_duratio
6a20: 6e 20 74 65 73 74 29 0a 09 09 09 09 28 64 62 3a n test).....(db:
6a30: 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 test-get-event_t
6a40: 69 6d 65 20 74 65 73 74 29 0a 09 09 09 09 28 64 ime test).....(d
6a50: 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 20 b:test-get-host
6a60: 74 65 73 74 29 29 0a 09 09 09 28 69 66 20 28 6e test))....(if (n
6a70: 6f 74 20 28 6f 72 20 28 65 71 75 61 6c 3f 20 28 ot (or (equal? (
6a80: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
6a90: 75 73 20 74 65 73 74 29 20 22 50 41 53 53 22 29 us test) "PASS")
6aa0: 0a 09 09 09 20 20 20 09 20 20 20 20 20 28 65 71 .... . (eq
6ab0: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
6ac0: 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 20 22 t-status test) "
6ad0: 57 41 52 4e 22 29 0a 09 09 09 09 20 20 20 20 20 WARN").....
6ae0: 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 (equal? (db:test
6af0: 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 29 -get-state test)
6b00: 20 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 "NOT_STARTED")
6b10: 29 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e )).... (begin
6b20: 0a 09 09 09 20 20 20 20 20 20 28 70 72 69 6e 74 .... (print
6b30: 20 20 20 22 20 20 20 20 20 20 20 20 20 63 70 75 " cpu
6b40: 6c 6f 61 64 3a 20 20 22 20 28 64 62 3a 74 65 73 load: " (db:tes
6b50: 74 2d 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 t-get-cpuload te
6b60: 73 74 29 0a 09 09 09 09 20 20 20 20 20 22 5c 6e st)..... "\n
6b70: 20 20 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 diskfre
6b80: 65 3a 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 e: " (db:test-ge
6b90: 74 2d 64 69 73 6b 66 72 65 65 20 74 65 73 74 29 t-diskfree test)
6ba0: 0a 09 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 ..... "\n
6bb0: 20 20 20 20 20 20 75 6e 61 6d 65 3a 20 20 20 20 uname:
6bc0: 22 20 3b 3b 20 28 73 64 62 3a 71 72 79 20 27 67 " ;; (sdb:qry 'g
6bd0: 65 74 73 74 72 20 0a 09 09 09 09 20 20 20 20 20 etstr .....
6be0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 75 6e 61 (db:test-get-una
6bf0: 6d 65 20 74 65 73 74 29 20 3b 3b 20 29 0a 09 09 me test) ;; )...
6c00: 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 20 .. "\n
6c10: 20 20 20 72 75 6e 64 69 72 3a 20 20 20 22 20 3b rundir: " ;
6c20: 3b 20 28 73 64 62 3a 71 72 79 20 27 67 65 74 73 ; (sdb:qry 'gets
6c30: 74 72 20 3b 3b 20 28 66 69 6c 65 64 62 3a 67 65 tr ;; (filedb:ge
6c40: 74 2d 70 61 74 68 20 2a 66 64 62 2a 20 0a 09 09 t-path *fdb* ...
6c50: 09 09 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d .. (db:test-
6c60: 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 get-rundir test)
6c70: 20 3b 3b 20 29 0a 09 09 09 09 20 20 20 20 20 29 ;; )..... )
6c80: 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 45 61 63 .... ;; Eac
6c90: 68 20 74 65 73 74 0a 09 09 09 20 20 20 20 20 20 h test....
6ca0: 3b 3b 20 44 4f 20 4e 4f 54 20 72 65 6d 6f 74 65 ;; DO NOT remote
6cb0: 20 72 75 6e 0a 09 09 09 20 20 20 20 20 20 28 6c run.... (l
6cc0: 65 74 20 28 28 73 74 65 70 73 20 28 64 62 3a 67 et ((steps (db:g
6cd0: 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 et-steps-for-tes
6ce0: 74 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 t dbstruct run-i
6cf0: 64 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 d (db:test-get-i
6d00: 64 20 74 65 73 74 29 29 29 29 0a 09 09 09 09 28 d test)))).....(
6d10: 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 20 28 for-each ..... (
6d20: 6c 61 6d 62 64 61 20 28 73 74 65 70 29 0a 09 09 lambda (step)...
6d30: 09 09 20 20 20 28 66 6f 72 6d 61 74 20 23 74 20 .. (format #t
6d40: 0a 09 09 09 09 09 20 20 20 22 20 20 20 20 53 74 ...... " St
6d50: 65 70 3a 20 7e 32 30 61 20 53 74 61 74 65 3a 20 ep: ~20a State:
6d60: 7e 31 30 61 20 53 74 61 74 75 73 3a 20 7e 31 30 ~10a Status: ~10
6d70: 61 20 54 69 6d 65 20 7e 32 32 61 5c 6e 22 0a 09 a Time ~22a\n"..
6d80: 09 09 09 09 20 20 20 28 74 64 62 3a 73 74 65 70 .... (tdb:step
6d90: 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 -get-stepname st
6da0: 65 70 29 0a 09 09 09 09 09 20 20 20 28 74 64 62 ep)...... (tdb
6db0: 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 :step-get-state
6dc0: 73 74 65 70 29 0a 09 09 09 09 09 20 20 20 28 74 step)...... (t
6dd0: 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 db:step-get-stat
6de0: 75 73 20 73 74 65 70 29 0a 09 09 09 09 09 20 20 us step)......
6df0: 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 (tdb:step-get-e
6e00: 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 29 vent_time step))
6e10: 29 0a 09 09 09 09 20 73 74 65 70 73 29 29 29 29 )..... steps))))
6e20: 29 0a 09 09 20 20 20 20 20 20 74 65 73 74 73 29 )... tests)
6e30: 29 29 29 29 0a 09 20 20 20 20 20 72 75 6e 73 29 )))).. runs)
6e40: 0a 09 20 20 28 64 62 3a 63 6c 6f 73 65 2d 61 6c .. (db:close-al
6e50: 6c 20 64 62 73 74 72 75 63 74 29 0a 09 20 20 28 l dbstruct).. (
6e60: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
6e70: 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d ng* #t))))..;;==
6e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ec0: 3d 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e ====.;; full run
6ed0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
6ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 =========..;; ge
6f20: 74 20 6c 6f 63 6b 20 69 6e 20 64 62 20 66 6f 72 t lock in db for
6f30: 20 66 75 6c 6c 20 72 75 6e 20 66 6f 72 20 74 68 full run for th
6f40: 69 73 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 is directory.;;
6f50: 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 20 77 69 for all tests wi
6f60: 74 68 20 64 65 70 73 0a 3b 3b 20 20 20 77 61 6c th deps.;; wal
6f70: 6b 20 74 72 65 65 20 6f 66 20 74 65 73 74 73 20 k tree of tests
6f80: 74 6f 20 66 69 6e 64 20 68 65 61 64 20 74 61 73 to find head tas
6f90: 6b 73 0a 3b 3b 20 20 20 61 64 64 20 68 65 61 64 ks.;; add head
6fa0: 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 tasks to task q
6fb0: 75 65 75 65 0a 3b 3b 20 20 20 61 64 64 20 64 65 ueue.;; add de
6fc0: 70 65 6e 64 61 6e 74 20 74 61 73 6b 73 20 74 6f pendant tasks to
6fd0: 20 74 61 73 6b 20 71 75 65 75 65 20 0a 3b 3b 20 task queue .;;
6fe0: 20 20 61 64 64 20 72 65 6d 61 69 6e 69 6e 67 20 add remaining
6ff0: 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 tasks to task qu
7000: 65 75 65 0a 3b 3b 20 66 6f 72 20 65 61 63 68 20 eue.;; for each
7010: 74 61 73 6b 20 69 6e 20 74 61 73 6b 20 71 75 65 task in task que
7020: 75 65 0a 3b 3b 20 20 20 69 66 20 68 61 76 65 20 ue.;; if have
7030: 61 64 65 71 75 61 74 65 20 72 65 73 6f 75 72 63 adequate resourc
7040: 65 73 0a 3b 3b 20 20 20 20 20 6c 61 75 6e 63 68 es.;; launch
7050: 20 74 61 73 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a task.;; else.
7060: 3b 3b 20 20 20 20 20 70 75 74 20 74 61 73 6b 20 ;; put task
7070: 69 6e 20 64 65 66 65 72 72 65 64 20 71 75 65 75 in deferred queu
7080: 65 0a 3b 3b 20 69 66 20 73 74 69 6c 6c 20 6f 6b e.;; if still ok
7090: 20 74 6f 20 72 75 6e 20 74 61 73 6b 73 0a 3b 3b to run tasks.;;
70a0: 20 20 20 70 72 6f 63 65 73 73 20 64 65 66 65 72 process defer
70b0: 72 65 64 20 74 61 73 6b 73 20 70 65 72 20 61 62 red tasks per ab
70c0: 6f 76 65 20 73 74 65 70 73 0a 0a 3b 3b 20 72 75 ove steps..;; ru
70d0: 6e 20 61 6c 6c 20 74 65 73 74 73 20 61 72 65 20 n all tests are
70e0: 61 72 65 20 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 are Not COMPLETE
70f0: 44 20 61 6e 64 20 50 41 53 53 20 6f 72 20 43 48 D and PASS or CH
7100: 45 43 4b 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ECK.(if (args:ge
7110: 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 t-arg "-runall")
7120: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
7130: 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 n-call . "-r
7140: 75 6e 61 6c 6c 22 0a 20 20 20 20 20 22 72 75 6e unall". "run
7150: 20 61 6c 6c 20 74 65 73 74 73 22 0a 20 20 20 20 all tests".
7160: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
7170: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
7180: 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 72 yvals). (r
7190: 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 uns:run-tests ta
71a0: 72 67 65 74 0a 09 09 20 20 20 20 20 20 20 72 75 rget... ru
71b0: 6e 6e 61 6d 65 0a 09 09 20 20 20 20 20 20 20 28 nname... (
71c0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
71d0: 65 73 74 70 61 74 74 22 29 0a 09 09 20 20 20 20 estpatt")...
71e0: 20 20 20 75 73 65 72 0a 09 09 20 20 20 20 20 20 user...
71f0: 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 args:arg-hash))
7200: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
7210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
7250: 72 75 6e 20 6f 6e 65 20 74 65 73 74 0a 3b 3b 3d run one test.;;=
7260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
72a0: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e 20 66 69 6e =====..;; 1. fin
72b0: 64 20 74 68 65 20 63 6f 6e 66 69 67 20 66 69 6c d the config fil
72c0: 65 0a 3b 3b 20 32 2e 20 63 68 61 6e 67 65 20 74 e.;; 2. change t
72d0: 6f 20 74 68 65 20 74 65 73 74 20 64 69 72 65 63 o the test direc
72e0: 74 6f 72 79 0a 3b 3b 20 33 2e 20 75 70 64 61 74 tory.;; 3. updat
72f0: 65 20 74 68 65 20 64 62 20 77 69 74 68 20 22 74 e the db with "t
7300: 65 73 74 20 73 74 61 72 74 65 64 22 20 73 74 61 est started" sta
7310: 74 75 73 2c 20 73 65 74 20 72 75 6e 6e 69 6e 67 tus, set running
7320: 20 68 6f 73 74 0a 3b 3b 20 34 2e 20 70 72 6f 63 host.;; 4. proc
7330: 65 73 73 20 6c 61 75 6e 63 68 20 74 68 65 20 74 ess launch the t
7340: 65 73 74 0a 3b 3b 20 20 20 20 2d 20 6d 6f 6e 69 est.;; - moni
7350: 74 6f 72 20 74 68 65 20 70 72 6f 63 65 73 73 2c tor the process,
7360: 20 75 70 64 61 74 65 20 73 74 61 74 73 20 69 6e update stats in
7370: 20 74 68 65 20 64 62 20 65 76 65 72 79 20 32 5e the db every 2^
7380: 6e 20 6d 69 6e 75 74 65 73 0a 3b 3b 20 35 2e 20 n minutes.;; 5.
7390: 61 73 20 74 68 65 20 74 65 73 74 20 70 72 6f 63 as the test proc
73a0: 65 65 64 73 20 69 6e 74 65 72 6e 61 6c 6c 79 20 eeds internally
73b0: 69 74 20 63 61 6c 6c 73 20 6d 65 67 61 74 65 73 it calls megates
73c0: 74 20 61 73 20 65 61 63 68 20 73 74 65 70 20 69 t as each step i
73d0: 73 0a 3b 3b 20 20 20 20 73 74 61 72 74 65 64 20 s.;; started
73e0: 61 6e 64 20 63 6f 6d 70 6c 65 74 65 64 0a 3b 3b and completed.;;
73f0: 20 20 20 20 2d 20 73 74 65 70 20 73 74 61 72 74 - step start
7400: 65 64 2c 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b ed, timestamp.;;
7410: 20 20 20 20 2d 20 73 74 65 70 20 63 6f 6d 70 6c - step compl
7420: 65 74 65 64 2c 20 65 78 69 74 20 73 74 61 74 75 eted, exit statu
7430: 73 2c 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 s, timestamp.;;
7440: 36 2e 20 74 65 73 74 20 70 68 6f 6e 65 20 68 6f 6. test phone ho
7450: 6d 65 0a 3b 3b 20 20 20 20 2d 20 69 66 20 74 65 me.;; - if te
7460: 73 74 20 72 75 6e 20 74 69 6d 65 20 3e 20 61 6c st run time > al
7470: 6c 6f 77 65 64 20 72 75 6e 20 74 69 6d 65 20 74 lowed run time t
7480: 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 hen kill job.;;
7490: 20 20 20 2d 20 69 66 20 63 61 6e 6e 6f 74 20 61 - if cannot a
74a0: 63 63 65 73 73 20 64 62 20 3e 20 61 6c 6c 6f 77 ccess db > allow
74b0: 65 64 20 64 69 73 63 6f 6e 6e 65 63 74 20 74 69 ed disconnect ti
74c0: 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 me then kill job
74d0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
74e0: 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
74f0: 0a 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d . (general-run-
7500: 63 61 6c 6c 20 0a 20 20 20 22 2d 72 75 6e 74 65 call . "-runte
7510: 73 74 73 22 20 0a 20 20 20 22 72 75 6e 20 61 20 sts" . "run a
7520: 74 65 73 74 22 20 0a 20 20 20 28 6c 61 6d 62 64 test" . (lambd
7530: 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
7540: 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a e keys keyvals).
7550: 20 20 20 20 20 3b 3b 0a 20 20 20 20 20 3b 3b 20 ;;. ;;
7560: 4d 61 79 20 6f 72 20 6d 61 79 20 6e 6f 74 20 69 May or may not i
7570: 6d 70 6c 65 6d 65 6e 74 20 69 74 20 74 68 69 73 mplement it this
7580: 20 77 61 79 20 2e 2e 2e 0a 20 20 20 20 20 3b 3b way .... ;;
7590: 0a 20 20 20 20 20 3b 3b 20 49 6e 73 65 72 74 20 . ;; Insert
75a0: 74 68 69 73 20 72 75 6e 20 69 6e 74 6f 20 74 68 this run into th
75b0: 65 20 74 61 73 6b 73 20 71 75 65 75 65 0a 20 20 e tasks queue.
75c0: 20 20 20 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d ;; (open-run-
75d0: 63 6c 6f 73 65 20 74 61 73 6b 73 3a 61 64 64 20 close tasks:add
75e0: 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 0a 20 tasks:open-db .
75f0: 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 ;; .
7600: 22 72 75 6e 74 65 73 74 73 22 20 0a 20 20 20 20 "runtests" .
7610: 20 3b 3b 20 20 20 20 09 20 20 20 20 20 75 73 65 ;; . use
7620: 72 0a 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 r. ;; .
7630: 20 20 20 74 61 72 67 65 74 0a 20 20 20 20 20 3b target. ;
7640: 3b 20 20 20 20 09 20 20 20 20 20 72 75 6e 6e 61 ; . runna
7650: 6d 65 0a 20 20 20 20 20 3b 3b 20 20 20 20 09 20 me. ;; .
7660: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
7670: 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 20 g "-runtests").
7680: 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 20 ;; .
7690: 23 66 29 29 29 29 0a 20 20 20 20 20 28 72 75 6e #f)))). (run
76a0: 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 72 67 s:run-tests targ
76b0: 65 74 0a 09 09 20 20 20 20 20 72 75 6e 6e 61 6d et... runnam
76c0: 65 0a 09 09 20 20 20 20 20 28 61 72 67 73 3a 67 e... (args:g
76d0: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
76e0: 73 22 29 0a 09 09 20 20 20 20 20 75 73 65 72 0a s")... user.
76f0: 09 09 20 20 20 20 20 61 72 67 73 3a 61 72 67 2d .. args:arg-
7700: 68 61 73 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d hash))))..;;====
7710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7750: 3d 3d 0a 3b 3b 20 52 6f 6c 6c 75 70 20 69 6e 74 ==.;; Rollup int
7760: 6f 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d o a run.;;======
7770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
77a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
77b0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
77c0: 61 72 67 20 22 2d 72 6f 6c 6c 75 70 22 29 0a 20 arg "-rollup").
77d0: 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
77e0: 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 6f 6c call . "-rol
77f0: 6c 75 70 22 20 0a 20 20 20 20 20 22 72 6f 6c 6c lup" . "roll
7800: 75 70 20 74 65 73 74 73 22 20 0a 20 20 20 20 20 up tests" .
7810: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
7820: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
7830: 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 72 75 vals). (ru
7840: 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 6b 65 ns:rollup-run ke
7850: 79 73 0a 09 09 09 6b 65 79 76 61 6c 73 0a 09 09 ys....keyvals...
7860: 09 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 .(or (args:get-a
7870: 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 rg "-runname")(a
7880: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 rgs:get-arg ":ru
7890: 6e 6e 61 6d 65 22 29 20 29 0a 09 09 09 75 73 65 nname") )....use
78a0: 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d r))))..;;=======
78b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
78f0: 3b 3b 20 4c 6f 63 6b 20 6f 72 20 75 6e 6c 6f 63 ;; Lock or unloc
7900: 6b 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d k a run.;;======
7910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7950: 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a ..(if (or (args:
7960: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 get-arg "-lock")
7970: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7980: 75 6e 6c 6f 63 6b 22 29 29 0a 20 20 20 20 28 67 unlock")). (g
7990: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
79a0: 0a 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a . (if (args:
79b0: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 get-arg "-lock")
79c0: 20 22 2d 6c 6f 63 6b 22 20 22 2d 75 6e 6c 6f 63 "-lock" "-unloc
79d0: 6b 22 29 0a 20 20 20 20 20 22 6c 6f 63 6b 2f 75 k"). "lock/u
79e0: 6e 6c 6f 63 6b 20 74 65 73 74 73 22 20 0a 20 20 nlock tests" .
79f0: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
7a00: 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
7a10: 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 keyvals).
7a20: 28 72 75 6e 73 3a 68 61 6e 64 6c 65 2d 6c 6f 63 (runs:handle-loc
7a30: 6b 69 6e 67 20 0a 09 09 20 20 74 61 72 67 65 74 king ... target
7a40: 0a 09 09 20 20 6b 65 79 73 0a 09 09 20 20 28 6f ... keys... (o
7a50: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
7a60: 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 "-runname")(args
7a70: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
7a80: 6d 65 22 29 20 29 0a 09 09 20 20 28 61 72 67 73 me") )... (args
7a90: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 :get-arg "-lock"
7aa0: 29 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d )... (args:get-
7ab0: 61 72 67 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 09 arg "-unlock")..
7ac0: 09 20 20 75 73 65 72 29 29 29 29 0a 0a 3b 3b 3d . user))))..;;=
7ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b10: 3d 3d 3d 3d 3d 0a 3b 3b 20 47 65 74 20 70 61 74 =====.;; Get pat
7b20: 68 73 20 74 6f 20 74 65 73 74 73 0a 3b 3b 3d 3d hs to tests.;;==
7b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b70: 3d 3d 3d 3d 0a 3b 3b 20 47 65 74 20 74 65 73 74 ====.;; Get test
7b80: 20 70 61 74 68 73 20 6d 61 74 63 68 69 6e 67 20 paths matching
7b90: 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c target, runname,
7ba0: 20 61 6e 64 20 74 65 73 74 70 61 74 74 0a 28 69 and testpatt.(i
7bb0: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
7bc0: 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 arg "-test-files
7bd0: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
7be0: 22 2d 74 65 73 74 2d 70 61 74 68 73 22 29 29 0a "-test-paths")).
7bf0: 20 20 20 20 3b 3b 20 69 66 20 77 65 20 61 72 65 ;; if we are
7c00: 20 69 6e 20 61 20 74 65 73 74 20 75 73 65 20 74 in a test use t
7c10: 68 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 61 he MT_CMDINFO da
7c20: 74 61 0a 20 20 20 20 28 69 66 20 28 67 65 74 65 ta. (if (gete
7c30: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
7c40: 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 ..(let* ((starti
7c50: 6e 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 ngdir (current-d
7c60: 69 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 irectory))..
7c70: 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 (cmdinfo (r
7c80: 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d ead (open-input-
7c90: 73 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 string (base64:b
7ca0: 61 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 ase64-decode (ge
7cb0: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
7cc0: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 "))))).. (
7cd0: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
7ce0: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
7cf0: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
7d00: 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
7d10: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
7d20: 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
7d30: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
7d40: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
7d50: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
7d60: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
7d70: 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 (db-host (
7d80: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 assoc/default 'd
7d90: 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f b-host cmdinfo
7da0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
7db0: 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 id (assoc/def
7dc0: 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 ault 'run-id
7dd0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
7de0: 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
7df0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
7e00: 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
7e10: 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 65 20 .. (state
7e20: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
7e30: 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 g ":state"))..
7e40: 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 (status
7e50: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
7e60: 73 74 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 status"))..
7e70: 20 20 28 74 61 72 67 65 74 20 20 20 20 28 61 72 (target (ar
7e80: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 gs:get-arg "-tar
7e90: 67 65 74 22 29 29 0a 09 20 20 20 20 20 20 20 28 get")).. (
7ea0: 74 6f 70 70 61 74 68 20 20 20 28 61 73 73 6f 63 toppath (assoc
7eb0: 2f 64 65 66 61 75 6c 74 20 27 74 6f 70 70 61 74 /default 'toppat
7ec0: 68 20 20 20 63 6d 64 69 6e 66 6f 29 29 29 0a 09 h cmdinfo)))..
7ed0: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
7ee0: 6f 72 79 20 74 6f 70 70 61 74 68 29 0a 09 20 20 ory toppath)..
7ef0: 28 69 66 20 28 6e 6f 74 20 74 61 72 67 65 74 29 (if (not target)
7f00: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
7f10: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
7f20: 22 45 52 52 4f 52 3a 20 2d 74 61 72 67 65 74 20 "ERROR: -target
7f30: 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 0a 09 is required.")..
7f40: 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 .(exit 1))).. (
7f50: 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a if (not (launch:
7f60: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
7f70: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
7f80: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
7f90: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
7fa0: 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 2d 74 giving up on -t
7fb0: 65 73 74 2d 70 61 74 68 73 20 6f 72 20 2d 74 65 est-paths or -te
7fc0: 73 74 2d 66 69 6c 65 73 2c 20 65 78 69 74 69 6e st-files, exitin
7fd0: 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 g")...(exit 1)))
7fe0: 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 .. (let* ((keys
7ff0: 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 (rmt:get-ke
8000: 79 73 29 29 0a 09 09 20 3b 3b 20 64 62 3a 74 65 ys))... ;; db:te
8010: 73 74 2d 67 65 74 2d 70 61 74 68 73 20 6d 75 73 st-get-paths mus
8020: 74 20 6e 6f 74 20 62 65 20 72 75 6e 20 72 65 6d t not be run rem
8030: 6f 74 65 0a 09 09 20 28 70 61 74 68 73 20 20 20 ote... (paths
8040: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 67 65 74 (tests:test-get
8050: 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 -paths-matching
8060: 6b 65 79 73 20 74 61 72 67 65 74 20 28 61 72 67 keys target (arg
8070: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
8080: 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 20 20 -files"))))..
8090: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
80a0: 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 28 hing* #t).. (
80b0: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
80c0: 20 28 70 61 74 68 29 0a 09 09 09 28 70 72 69 6e (path)....(prin
80d0: 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 t path))...
80e0: 20 70 61 74 68 73 29 29 29 0a 09 3b 3b 20 65 6c paths)))..;; el
80f0: 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 6c 2d se do a general-
8100: 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 72 run-call..(gener
8110: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 22 al-run-call .. "
8120: 2d 74 65 73 74 2d 66 69 6c 65 73 22 0a 09 20 22 -test-files".. "
8130: 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 Get paths to tes
8140: 74 22 0a 09 20 28 6c 61 6d 62 64 61 20 28 74 61 t".. (lambda (ta
8150: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
8160: 73 20 6b 65 79 76 61 6c 73 29 0a 09 20 20 20 28 s keyvals).. (
8170: 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 let* ((db
8180: 23 66 29 0a 09 09 20 20 3b 3b 20 44 4f 20 4e 4f #f)... ;; DO NO
8190: 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 T run remote...
81a0: 20 28 70 61 74 68 73 20 20 20 20 28 74 65 73 74 (paths (test
81b0: 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 s:test-get-paths
81c0: 2d 6d 61 74 63 68 69 6e 67 20 6b 65 79 73 20 74 -matching keys t
81d0: 61 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d arget (args:get-
81e0: 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 arg "-test-files
81f0: 22 29 29 29 29 0a 09 20 20 20 20 20 28 66 6f 72 ")))).. (for
8200: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 -each (lambda (p
8210: 61 74 68 29 0a 09 09 09 20 28 70 72 69 6e 74 20 ath).... (print
8220: 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 20 path))...
8230: 70 61 74 68 73 29 29 29 29 29 29 0a 0a 3b 3b 3d paths))))))..;;=
8240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8280: 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 =====.;; Archive
8290: 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d tests.;;=======
82a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
82e0: 3b 3b 20 41 72 63 68 69 76 65 20 74 65 73 74 73 ;; Archive tests
82f0: 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 74 matching target
8300: 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 , runname, and t
8310: 65 73 74 70 61 74 74 0a 28 69 66 20 28 61 72 67 estpatt.(if (arg
8320: 73 3a 67 65 74 2d 61 72 67 20 22 2d 61 72 63 68 s:get-arg "-arch
8330: 69 76 65 22 29 0a 20 20 20 20 3b 3b 20 69 66 20 ive"). ;; if
8340: 77 65 20 61 72 65 20 69 6e 20 61 20 74 65 73 74 we are in a test
8350: 20 75 73 65 20 74 68 65 20 4d 54 5f 43 4d 44 49 use the MT_CMDI
8360: 4e 46 4f 20 64 61 74 61 0a 20 20 20 20 28 69 66 NFO data. (if
8370: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
8380: 49 4e 46 4f 22 29 0a 09 28 6c 65 74 2a 20 28 28 INFO")..(let* ((
8390: 73 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 72 startingdir (cur
83a0: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 rent-directory))
83b0: 0a 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 .. (cmdinf
83c0: 6f 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d o (read (open-
83d0: 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 input-string (ba
83e0: 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f se64:base64-deco
83f0: 64 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 de (getenv "MT_C
8400: 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 MDINFO")))))..
8410: 20 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 (testpath
8420: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
8430: 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 testpath cmdinf
8440: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 o)).. (tes
8450: 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 t-name (assoc/de
8460: 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 fault 'test-name
8470: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
8480: 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 (runscript (a
8490: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
84a0: 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 nscript cmdinfo)
84b0: 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f ).. (db-ho
84c0: 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 st (assoc/defa
84d0: 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 ult 'db-host c
84e0: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
84f0: 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 (run-id (ass
8500: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d oc/default 'run-
8510: 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a id cmdinfo)).
8520: 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 . (itemdat
8530: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
8540: 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 t 'itemdat cmd
8550: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
8560: 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 3a state (args:
8570: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 get-arg ":state"
8580: 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 )).. (stat
8590: 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d us (args:get-
85a0: 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a arg ":status")).
85b0: 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 20 . (target
85c0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
85d0: 20 22 2d 74 61 72 67 65 74 22 29 29 29 0a 09 20 "-target")))..
85e0: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
85f0: 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 20 20 ry testpath)..
8600: 28 69 66 20 28 6e 6f 74 20 74 61 72 67 65 74 29 (if (not target)
8610: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
8620: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
8630: 22 45 52 52 4f 52 3a 20 2d 74 61 72 67 65 74 20 "ERROR: -target
8640: 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 0a 09 is required.")..
8650: 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 .(exit 1))).. (
8660: 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a if (not (launch:
8670: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
8680: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
8690: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
86a0: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
86b0: 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 2d 61 giving up on -a
86c0: 72 63 68 69 76 65 2c 20 65 78 69 74 69 6e 67 22 rchive, exiting"
86d0: 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 )...(exit 1)))..
86e0: 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 (let* ((keys
86f0: 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 (rmt:get-keys
8700: 29 29 0a 09 09 20 28 70 61 74 68 73 20 20 20 20 ))... (paths
8710: 28 74 65 73 74 73 3a 74 65 73 74 2d 67 65 74 2d (tests:test-get-
8720: 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 6b paths-matching k
8730: 65 79 73 20 74 61 72 67 65 74 29 29 29 0a 09 20 eys target)))..
8740: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
8750: 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 ething* #t)..
8760: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
8770: 64 61 20 28 70 61 74 68 29 0a 09 09 09 28 70 72 da (path)....(pr
8780: 69 6e 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 int path))...
8790: 20 20 20 70 61 74 68 73 29 29 0a 09 20 20 3b 3b paths)).. ;;
87a0: 20 28 69 66 20 28 73 71 6c 69 74 65 33 3a 64 61 (if (sqlite3:da
87b0: 74 61 62 61 73 65 3f 20 64 62 29 28 73 71 6c 69 tabase? db)(sqli
87c0: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
87d0: 29 29 0a 09 20 20 29 0a 09 3b 3b 20 65 6c 73 65 )).. )..;; else
87e0: 20 64 6f 20 61 20 67 65 6e 65 72 61 6c 2d 72 75 do a general-ru
87f0: 6e 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 72 61 6c n-call..(general
8800: 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 22 2d 74 -run-call .. "-t
8810: 65 73 74 2d 70 61 74 68 73 22 0a 09 20 22 47 65 est-paths".. "Ge
8820: 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 74 73 t paths to tests
8830: 22 0a 09 20 28 6c 61 6d 62 64 61 20 28 74 61 72 ".. (lambda (tar
8840: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
8850: 20 6b 65 79 76 61 6c 73 29 0a 09 20 20 20 28 6c keyvals).. (l
8860: 65 74 2a 20 28 28 70 61 74 68 73 20 20 20 20 28 et* ((paths (
8870: 74 65 73 74 73 3a 74 65 73 74 2d 67 65 74 2d 70 tests:test-get-p
8880: 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 6b 65 aths-matching ke
8890: 79 73 20 74 61 72 67 65 74 29 29 29 0a 09 20 20 ys target)))..
88a0: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
88b0: 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 20 mbda (path)....
88c0: 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 (print path))...
88d0: 20 20 20 20 20 20 20 70 61 74 68 73 29 29 29 29 paths))))
88e0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
88f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
8930: 45 78 74 72 61 63 74 20 61 20 73 70 72 65 61 64 Extract a spread
8940: 73 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 72 sheet from the r
8950: 75 6e 73 20 64 61 74 61 62 61 73 65 0a 3b 3b 3d uns database.;;=
8960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
89a0: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
89b0: 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 61 :get-arg "-extra
89c0: 63 74 2d 6f 64 73 22 29 0a 20 20 20 20 28 67 65 ct-ods"). (ge
89d0: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 20 neral-run-call.
89e0: 20 20 20 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 "-extract-od
89f0: 73 22 0a 20 20 20 20 20 22 4d 61 6b 65 20 6f 64 s". "Make od
8a00: 73 20 73 70 72 65 61 64 73 68 65 65 74 22 0a 20 s spreadsheet".
8a10: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
8a20: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
8a30: 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 keyvals).
8a40: 20 28 6c 65 74 20 28 28 64 62 73 74 72 75 63 74 (let ((dbstruct
8a50: 20 20 20 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 (make-dbr:dbs
8a60: 74 72 75 63 74 20 70 61 74 68 3a 20 2a 74 6f 70 truct path: *top
8a70: 70 61 74 68 2a 20 6c 6f 63 61 6c 3a 20 23 74 29 path* local: #t)
8a80: 29 0a 09 20 20 20 20 20 28 6f 75 74 70 75 74 66 ).. (outputf
8a90: 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ile (args:get-ar
8aa0: 67 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 g "-extract-ods"
8ab0: 29 29 0a 09 20 20 20 20 20 28 72 75 6e 73 70 61 )).. (runspa
8ac0: 74 74 20 20 20 28 6f 72 20 28 61 72 67 73 3a 67 tt (or (args:g
8ad0: 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 et-arg "-runname
8ae0: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
8af0: 22 3a 72 75 6e 6e 61 6d 65 22 29 29 29 0a 09 20 ":runname")))..
8b00: 20 20 20 20 28 70 61 74 68 6d 6f 64 20 20 20 20 (pathmod
8b10: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8b20: 70 61 74 68 6d 6f 64 22 29 29 29 0a 09 20 20 20 pathmod")))..
8b30: 20 20 3b 3b 20 28 6b 65 79 76 61 6c 61 6c 69 73 ;; (keyvalalis
8b40: 74 20 28 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b t (keys->alist k
8b50: 65 79 73 20 22 25 22 29 29 29 0a 09 20 28 64 65 eys "%"))).. (de
8b60: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 45 78 74 bug:print 2 "Ext
8b70: 72 61 63 74 20 6f 64 73 2c 20 6f 75 74 70 75 74 ract ods, output
8b80: 66 69 6c 65 3a 20 22 20 6f 75 74 70 75 74 66 69 file: " outputfi
8b90: 6c 65 20 22 20 72 75 6e 73 70 61 74 74 3a 20 22 le " runspatt: "
8ba0: 20 72 75 6e 73 70 61 74 74 20 22 20 6b 65 79 76 runspatt " keyv
8bb0: 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 29 0a als: " keyvals).
8bc0: 09 20 28 64 62 3a 65 78 74 72 61 63 74 2d 6f 64 . (db:extract-od
8bd0: 73 2d 66 69 6c 65 20 64 62 73 74 72 75 63 74 20 s-file dbstruct
8be0: 6f 75 74 70 75 74 66 69 6c 65 20 6b 65 79 76 61 outputfile keyva
8bf0: 6c 73 20 28 69 66 20 72 75 6e 73 70 61 74 74 20 ls (if runspatt
8c00: 72 75 6e 73 70 61 74 74 20 22 25 22 29 20 70 61 runspatt "%") pa
8c10: 74 68 6d 6f 64 29 0a 09 20 28 64 62 3a 63 6c 6f thmod).. (db:clo
8c20: 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 29 se-all dbstruct)
8c30: 0a 09 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d .. (set! *didsom
8c40: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 29 0a ething* #t))))).
8c50: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
8c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 =========.;; exe
8ca0: 63 75 74 65 20 74 68 65 20 74 65 73 74 0a 3b 3b cute the test.;;
8cb0: 20 20 20 20 2d 20 67 65 74 73 20 63 61 6c 6c 65 - gets calle
8cc0: 64 20 6f 6e 20 72 65 6d 6f 74 65 20 68 6f 73 74 d on remote host
8cd0: 0a 3b 3b 20 20 20 20 2d 20 72 65 63 65 69 76 65 .;; - receive
8ce0: 73 20 69 6e 66 6f 20 66 72 6f 6d 20 74 68 65 20 s info from the
8cf0: 2d 65 78 65 63 75 74 65 20 70 61 72 61 6d 0a 3b -execute param.;
8d00: 3b 20 20 20 20 2d 20 70 61 73 73 65 73 20 69 6e ; - passes in
8d10: 66 6f 20 74 6f 20 73 74 65 70 73 20 76 69 61 20 fo to steps via
8d20: 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 MT_CMDINFO env v
8d30: 61 72 20 28 66 75 74 75 72 65 20 69 73 20 74 6f ar (future is to
8d40: 20 75 73 65 20 61 20 64 6f 74 20 66 69 6c 65 29 use a dot file)
8d50: 0a 3b 3b 20 20 20 20 2d 20 67 61 74 68 65 72 73 .;; - gathers
8d60: 20 68 6f 73 74 20 69 6e 66 6f 20 61 6e 64 20 0a host info and .
8d70: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
8d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8db0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
8dc0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 rgs:get-arg "-ex
8dd0: 65 63 75 74 65 22 29 0a 20 20 20 20 28 62 65 67 ecute"). (beg
8de0: 69 6e 0a 20 20 20 20 20 20 28 6c 61 75 6e 63 68 in. (launch
8df0: 3a 65 78 65 63 75 74 65 20 28 61 72 67 73 3a 67 :execute (args:g
8e00: 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 65 et-arg "-execute
8e10: 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ")). (set!
8e20: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
8e30: 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
8e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
8e80: 3b 20 54 65 73 74 20 63 6f 6d 6d 61 6e 64 73 20 ; Test commands
8e90: 28 69 2e 65 2e 20 66 6f 72 20 75 73 65 20 69 6e (i.e. for use in
8ea0: 73 69 64 65 20 74 65 73 74 73 29 0a 3b 3b 3d 3d side tests).;;==
8eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ef0: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 6d ====..(define (m
8f00: 65 67 61 74 65 73 74 3a 73 74 65 70 20 73 74 65 egatest:step ste
8f10: 70 20 73 74 61 74 65 20 73 74 61 74 75 73 20 6c p state status l
8f20: 6f 67 66 69 6c 65 20 6d 73 67 29 0a 20 20 28 69 ogfile msg). (i
8f30: 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 f (not (getenv "
8f40: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 20 20 MT_CMDINFO")).
8f50: 20 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 62 (begin..(deb
8f60: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
8f70: 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e R: MT_CMDINFO en
8f80: 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 2d v var not set, -
8f90: 73 74 65 70 20 6d 75 73 74 20 62 65 20 63 61 6c step must be cal
8fa0: 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d led *inside* a m
8fb0: 65 67 61 74 65 73 74 20 69 6e 76 6f 6b 65 64 20 egatest invoked
8fc0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 environment!")..
8fd0: 28 65 78 69 74 20 35 29 29 0a 20 20 20 20 20 20 (exit 5)).
8fe0: 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e 66 6f 20 (let* ((cmdinfo
8ff0: 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e (read (open-in
9000: 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 put-string (base
9010: 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 64:base64-decode
9020: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
9030: 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 20 20 INFO")))))..
9040: 20 28 74 65 73 74 70 61 74 68 20 20 28 61 73 73 (testpath (ass
9050: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
9060: 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a path cmdinfo)).
9070: 09 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 . (test-name
9080: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
9090: 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
90a0: 66 6f 29 29 0a 09 20 20 20 20 20 28 72 75 6e 73 fo)).. (runs
90b0: 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 cript (assoc/def
90c0: 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 ault 'runscript
90d0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
90e0: 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f (db-host (asso
90f0: 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f c/default 'db-ho
9100: 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 st cmdinfo))..
9110: 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 (run-id
9120: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
9130: 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 run-id cmdinf
9140: 6f 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 2d o)).. (test-
9150: 69 64 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 id (assoc/defa
9160: 75 6c 74 20 27 74 65 73 74 2d 69 64 20 20 20 63 ult 'test-id c
9170: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 mdinfo)).. (
9180: 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 itemdat (assoc
9190: 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 /default 'itemda
91a0: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
91b0: 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 28 (work-area (
91c0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 77 assoc/default 'w
91d0: 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 66 6f ork-area cmdinfo
91e0: 29 29 0a 09 20 20 20 20 20 28 64 62 20 20 20 20 )).. (db
91f0: 20 20 20 20 23 66 29 29 0a 09 28 63 68 61 6e 67 #f))..(chang
9200: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test
9210: 70 61 74 68 29 0a 09 28 69 66 20 28 6e 6f 74 20 path)..(if (not
9220: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 66 6f (launch:setup-fo
9230: 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 28 62 65 r-run)).. (be
9240: 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 gin.. (debu
9250: 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 g:print 0 "Faile
9260: 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit
9270: 69 6e 67 22 29 0a 09 20 20 20 20 20 20 28 65 78 ing").. (ex
9280: 69 74 20 31 29 29 29 0a 09 28 69 66 20 28 61 6e it 1)))..(if (an
9290: 64 20 73 74 61 74 65 20 73 74 61 74 75 73 29 0a d state status).
92a0: 09 20 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 . (rmt:testst
92b0: 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 ep-set-status! r
92c0: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 un-id test-id st
92d0: 65 70 20 73 74 61 74 65 20 73 74 61 74 75 73 20 ep state status
92e0: 6d 73 67 20 6c 6f 67 66 69 6c 65 29 0a 09 20 20 msg logfile)..
92f0: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
9300: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
9310: 45 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 20 ERROR: You must
9320: 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 specify :state a
9330: 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 nd :status with
9340: 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 73 every call to -s
9350: 74 65 70 22 29 0a 09 20 20 20 20 20 20 28 65 78 tep").. (ex
9360: 69 74 20 36 29 29 29 29 29 29 0a 0a 28 69 66 20 it 6))))))..(if
9370: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
9380: 73 74 65 70 22 29 0a 20 20 20 20 28 62 65 67 69 step"). (begi
9390: 6e 0a 20 20 20 20 20 20 28 6d 65 67 61 74 65 73 n. (megates
93a0: 74 3a 73 74 65 70 20 0a 20 20 20 20 20 20 20 28 t:step . (
93b0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
93c0: 74 65 70 22 29 0a 20 20 20 20 20 20 20 28 61 72 tep"). (ar
93d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
93e0: 74 65 22 29 0a 20 20 20 20 20 20 20 28 61 72 67 te"). (arg
93f0: 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
9400: 75 73 22 29 0a 20 20 20 20 20 20 20 28 61 72 67 us"). (arg
9410: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c s:get-arg "-setl
9420: 6f 67 22 29 0a 20 20 20 20 20 20 20 28 61 72 67 og"). (arg
9430: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 s:get-arg "-m"))
9440: 0a 20 20 20 20 20 20 3b 3b 20 28 69 66 20 64 62 . ;; (if db
9450: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
9460: 7a 65 21 20 64 62 29 29 0a 20 20 20 20 20 20 28 ze! db)). (
9470: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
9480: 6e 67 2a 20 23 74 29 29 29 0a 20 20 20 20 0a 28 ng* #t))). .(
9490: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
94a0: 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 20 -arg "-setlog")
94b0: 20 20 20 20 20 20 3b 3b 20 73 69 6e 63 65 20 73 ;; since s
94c0: 65 74 74 69 6e 67 20 75 70 20 69 73 20 73 6f 20 etting up is so
94d0: 63 6f 73 74 6c 79 20 6c 65 74 73 20 70 69 67 67 costly lets pigg
94e0: 79 62 61 63 6b 20 6f 6e 20 2d 74 65 73 74 2d 73 yback on -test-s
94f0: 74 61 74 75 73 0a 09 3b 3b 20 20 20 20 20 28 6e tatus..;; (n
9500: 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
9510: 20 22 2d 73 74 65 70 22 29 29 29 20 20 3b 3b 20 "-step"))) ;;
9520: 2d 73 65 74 6c 6f 67 20 6d 61 79 20 68 61 76 65 -setlog may have
9530: 20 62 65 65 6e 20 70 72 6f 63 65 73 73 65 64 20 been processed
9540: 61 6c 72 65 61 64 79 20 69 6e 20 74 68 65 20 22 already in the "
9550: 2d 73 74 65 70 22 20 70 72 65 76 69 6f 75 73 0a -step" previous.
9560: 09 3b 3b 20 20 20 20 20 4e 45 57 20 50 4f 4c 49 .;; NEW POLI
9570: 43 59 20 2d 20 2d 73 65 74 6c 6f 67 20 73 65 74 CY - -setlog set
9580: 73 20 74 65 73 74 20 6f 76 65 72 61 6c 6c 20 6c s test overall l
9590: 6f 67 20 6f 6e 20 65 76 65 72 79 20 63 61 6c 6c og on every call
95a0: 2e 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ...(args:get-arg
95b0: 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a "-set-toplog").
95c0: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
95d0: 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a 09 -test-status")..
95e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
95f0: 73 65 74 2d 76 61 6c 75 65 73 22 29 0a 09 28 61 set-values")..(a
9600: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
9610: 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a 09 ad-test-data")..
9620: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
9630: 72 75 6e 73 74 65 70 22 29 0a 09 28 61 72 67 73 runstep")..(args
9640: 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d 6d 61 :get-arg "-summa
9650: 72 69 7a 65 2d 69 74 65 6d 73 22 29 29 0a 20 20 rize-items")).
9660: 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 65 (if (not (gete
9670: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
9680: 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 )..(begin.. (de
9690: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
96a0: 4f 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 OR: MT_CMDINFO e
96b0: 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 nv var not set,
96c0: 63 6f 6d 6d 61 6e 64 73 20 2d 74 65 73 74 2d 73 commands -test-s
96d0: 74 61 74 75 73 2c 20 2d 72 75 6e 73 74 65 70 20 tatus, -runstep
96e0: 61 6e 64 20 2d 73 65 74 6c 6f 67 20 6d 75 73 74 and -setlog must
96f0: 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 be called *insi
9700: 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 65 de* a megatest e
9710: 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 20 nvironment!")..
9720: 20 28 65 78 69 74 20 35 29 29 0a 09 28 6c 65 74 (exit 5))..(let
9730: 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 20 * ((startingdir
9740: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
9750: 72 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 6d ry)).. (cm
9760: 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 6f dinfo (read (o
9770: 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 pen-input-string
9780: 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d (base64:base64-
9790: 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 22 decode (getenv "
97a0: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 MT_CMDINFO")))))
97b0: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 61 .. (testpa
97c0: 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 th (assoc/defau
97d0: 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 6d lt 'testpath cm
97e0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
97f0: 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f (test-name (asso
9800: 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d c/default 'test-
9810: 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 name cmdinfo))..
9820: 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 (runscrip
9830: 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
9840: 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 'runscript cmdi
9850: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 nfo)).. (d
9860: 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f b-host (assoc/
9870: 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 default 'db-host
9880: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
9890: 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 (run-id
98a0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
98b0: 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 run-id cmdinf
98c0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 o)).. (tes
98d0: 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 65 t-id (assoc/de
98e0: 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 20 fault 'test-id
98f0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
9900: 20 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 (itemdat (a
9910: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 ssoc/default 'it
9920: 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 emdat cmdinfo)
9930: 29 0a 09 20 20 20 20 20 20 20 28 77 6f 72 6b 2d ).. (work-
9940: 61 72 65 61 20 28 61 73 73 6f 63 2f 64 65 66 61 area (assoc/defa
9950: 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 63 ult 'work-area c
9960: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
9970: 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 20 (db #f)
9980: 3b 3b 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 20 ;; (open-db))..
9990: 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 (state
99a0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
99b0: 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 :state"))..
99c0: 20 20 28 73 74 61 74 75 73 20 20 20 20 28 61 72 (status (ar
99d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
99e0: 74 75 73 22 29 29 29 0a 09 20 20 28 69 66 20 28 tus"))).. (if (
99f0: 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 not (launch:setu
9a00: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 p-for-run))..
9a10: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 (begin...(deb
9a20: 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c ug:print 0 "Fail
9a30: 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
9a40: 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 ting")...(exit 1
9a50: 29 29 29 0a 0a 09 20 20 28 69 66 20 28 61 72 67 )))... (if (arg
9a60: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 s:get-arg "-runs
9a70: 74 65 70 22 29 28 64 65 62 75 67 3a 70 72 69 6e tep")(debug:prin
9a80: 74 2d 69 6e 66 6f 20 31 20 22 52 75 6e 6e 69 6e t-info 1 "Runnin
9a90: 67 20 2d 72 75 6e 73 74 65 70 2c 20 66 69 72 73 g -runstep, firs
9aa0: 74 20 63 68 61 6e 67 65 20 74 6f 20 64 69 72 65 t change to dire
9ab0: 63 74 6f 72 79 20 22 20 77 6f 72 6b 2d 61 72 65 ctory " work-are
9ac0: 61 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 a)).. (change-d
9ad0: 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 irectory work-ar
9ae0: 65 61 29 0a 09 20 20 3b 3b 20 63 61 6e 20 73 65 ea).. ;; can se
9af0: 74 75 70 20 61 73 20 63 6c 69 65 6e 74 20 66 6f tup as client fo
9b00: 72 20 73 65 72 76 65 72 20 6d 6f 64 65 20 6e 6f r server mode no
9b10: 77 0a 09 20 20 3b 3b 20 28 63 6c 69 65 6e 74 3a w.. ;; (client:
9b20: 73 65 74 75 70 29 0a 0a 09 20 20 28 69 66 20 28 setup)... (if (
9b30: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
9b40: 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a oad-test-data").
9b50: 09 20 20 20 20 20 20 3b 3b 20 68 61 73 20 73 75 . ;; has su
9b60: 62 20 63 6f 6d 6d 61 6e 64 73 20 74 68 61 74 20 b commands that
9b70: 61 72 65 20 72 64 62 3a 0a 09 20 20 20 20 20 20 are rdb:..
9b80: 3b 3b 20 44 4f 20 4e 4f 54 20 70 75 74 20 74 68 ;; DO NOT put th
9b90: 69 73 20 6f 6e 65 20 69 6e 74 6f 20 65 69 74 68 is one into eith
9ba0: 65 72 20 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 er cdb:remote-ru
9bb0: 6e 20 6f 72 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c n or open-run-cl
9bc0: 6f 73 65 0a 09 20 20 20 20 20 20 28 74 64 62 3a ose.. (tdb:
9bd0: 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 20 72 load-test-data r
9be0: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a un-id test-id)).
9bf0: 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 . (if (args:get
9c00: 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a -arg "-setlog").
9c10: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 6f . (let ((lo
9c20: 67 66 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 gfname (args:get
9c30: 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 29 -arg "-setlog"))
9c40: 29 0a 09 09 28 72 6d 74 3a 74 65 73 74 2d 73 65 )...(rmt:test-se
9c50: 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 t-log! run-id te
9c60: 73 74 2d 69 64 20 6c 6f 67 66 6e 61 6d 65 29 29 st-id logfname))
9c70: 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 ).. (if (args:g
9c80: 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 et-arg "-set-top
9c90: 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 log").. ;;
9ca0: 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 DO NOT run remot
9cb0: 65 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 3a e.. (tests:
9cc0: 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 21 test-set-toplog!
9cd0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
9ce0: 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 e (args:get-arg
9cf0: 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 29 29 "-set-toplog")))
9d00: 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 .. (if (args:ge
9d10: 74 2d 61 72 67 20 22 2d 73 75 6d 6d 61 72 69 7a t-arg "-summariz
9d20: 65 2d 69 74 65 6d 73 22 29 0a 09 20 20 20 20 20 e-items")..
9d30: 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 ;; DO NOT run r
9d40: 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 28 74 65 emote.. (te
9d50: 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 sts:summarize-it
9d60: 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ems run-id test-
9d70: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 74 29 id test-name #t)
9d80: 29 20 3b 3b 20 64 6f 20 66 6f 72 63 65 20 68 65 ) ;; do force he
9d90: 72 65 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a re.. (if (args:
9da0: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 get-arg "-runste
9db0: 70 22 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 p").. (if (
9dc0: 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 0a 09 null? remargs)..
9dd0: 09 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 . (begin...
9de0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
9df0: 45 52 52 4f 52 3a 20 6e 6f 74 68 69 6e 67 20 73 ERROR: nothing s
9e00: 70 65 63 69 66 69 65 64 20 74 6f 20 72 75 6e 21 pecified to run!
9e10: 22 29 0a 09 09 20 20 20 20 28 69 66 20 64 62 20 ")... (if db
9e20: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
9e30: 65 21 20 64 62 29 29 0a 09 09 20 20 20 20 28 65 e! db))... (e
9e40: 78 69 74 20 36 29 29 0a 09 09 20 20 28 6c 65 74 xit 6))... (let
9e50: 2a 20 28 28 73 74 65 70 6e 61 6d 65 20 20 20 28 * ((stepname (
9e60: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
9e70: 75 6e 73 74 65 70 22 29 29 0a 09 09 09 20 28 6c unstep")).... (l
9e80: 6f 67 70 72 6f 66 69 6c 65 20 28 61 72 67 73 3a ogprofile (args:
9e90: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 70 72 6f get-arg "-logpro
9ea0: 22 29 29 0a 09 09 09 20 28 6c 6f 67 66 69 6c 65 ")).... (logfile
9eb0: 20 20 20 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 (conc stepna
9ec0: 6d 65 20 22 2e 6c 6f 67 22 29 29 0a 09 09 09 20 me ".log"))....
9ed0: 28 63 6d 64 20 20 20 20 20 20 20 20 28 69 66 20 (cmd (if
9ee0: 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 (null? remargs)
9ef0: 23 66 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 #f (car remargs)
9f00: 29 29 0a 09 09 09 20 28 70 61 72 61 6d 73 20 20 )).... (params
9f10: 20 20 20 28 69 66 20 63 6d 64 20 28 63 64 72 20 (if cmd (cdr
9f20: 72 65 6d 61 72 67 73 29 20 27 28 29 29 29 0a 09 remargs) '()))..
9f30: 09 09 20 28 65 78 69 74 73 74 61 74 20 20 20 23 .. (exitstat #
9f40: 66 29 0a 09 09 09 20 28 73 68 65 6c 6c 20 20 20 f).... (shell
9f50: 20 20 20 28 6c 65 74 20 28 28 73 68 20 28 67 65 (let ((sh (ge
9f60: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
9f70: 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 20 riable "SHELL")
9f80: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 ))..... (i
9f90: 66 20 73 68 20 0a 09 09 09 09 09 20 20 20 28 6c f sh ...... (l
9fa0: 61 73 74 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 ast (string-spli
9fb0: 74 20 73 68 20 22 2f 22 29 29 0a 09 09 09 09 09 t sh "/"))......
9fc0: 20 20 20 22 62 61 73 68 22 29 29 29 0a 09 09 09 "bash")))....
9fd0: 20 28 72 65 64 69 72 20 20 20 20 20 20 28 63 61 (redir (ca
9fe0: 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 se (string->symb
9ff0: 6f 6c 20 73 68 65 6c 6c 29 0a 09 09 09 09 20 20 ol shell).....
a000: 20 20 20 20 20 28 28 74 63 73 68 20 63 73 68 20 ((tcsh csh
a010: 6b 73 68 29 20 20 20 20 22 3e 26 22 29 0a 09 09 ksh) ">&")...
a020: 09 09 20 20 20 20 20 20 20 28 28 7a 73 68 20 62 .. ((zsh b
a030: 61 73 68 20 73 68 20 61 73 68 29 20 22 32 3e 26 ash sh ash) "2>&
a040: 31 20 3e 22 29 0a 09 09 09 09 20 20 20 20 20 20 1 >").....
a050: 20 28 65 6c 73 65 20 22 3e 26 22 29 29 29 0a 09 (else ">&")))..
a060: 09 09 20 28 66 75 6c 6c 63 6d 64 20 20 20 20 28 .. (fullcmd (
a070: 63 6f 6e 63 20 22 28 22 20 28 73 74 72 69 6e 67 conc "(" (string
a080: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 09 -intersperse ...
a090: 09 09 09 09 28 63 6f 6e 73 20 63 6d 64 20 70 61 ....(cons cmd pa
a0a0: 72 61 6d 73 29 20 22 20 22 29 0a 09 09 09 09 09 rams) " ")......
a0b0: 20 20 20 22 29 20 22 20 72 65 64 69 72 20 22 20 ") " redir "
a0c0: 22 20 6c 6f 67 66 69 6c 65 29 29 29 0a 09 09 20 " logfile)))...
a0d0: 20 20 20 3b 3b 20 6d 61 72 6b 20 74 68 65 20 73 ;; mark the s
a0e0: 74 61 72 74 20 6f 66 20 74 68 65 20 74 65 73 74 tart of the test
a0f0: 0a 09 09 20 20 20 20 28 72 6d 74 3a 74 65 73 74 ... (rmt:test
a100: 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
a110: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
a120: 73 74 65 70 6e 61 6d 65 20 22 73 74 61 72 74 22 stepname "start"
a130: 20 22 6e 2f 61 22 20 28 61 72 67 73 3a 67 65 74 "n/a" (args:get
a140: 2d 61 72 67 20 22 2d 6d 22 29 20 6c 6f 67 66 69 -arg "-m") logfi
a150: 6c 65 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e le)... ;; run
a160: 20 74 68 65 20 74 65 73 74 20 73 74 65 70 0a 09 the test step..
a170: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
a180: 74 2d 69 6e 66 6f 20 32 20 22 52 75 6e 6e 69 6e t-info 2 "Runnin
a190: 67 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 5c g \"" fullcmd "\
a1a0: 22 20 69 6e 20 64 69 72 65 63 74 6f 72 79 20 5c " in directory \
a1b0: 22 22 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a "" startingdir).
a1c0: 09 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 .. (change-di
a1d0: 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 rectory starting
a1e0: 64 69 72 29 0a 09 09 20 20 20 20 28 73 65 74 21 dir)... (set!
a1f0: 20 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65 exitstat (syste
a200: 6d 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 20 20 m fullcmd))...
a210: 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 (set! *globale
a220: 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 74 73 xitstatus* exits
a230: 74 61 74 29 0a 09 09 20 20 20 20 3b 3b 20 28 63 tat)... ;; (c
a240: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
a250: 74 65 73 74 70 61 74 68 29 0a 09 09 20 20 20 20 testpath)...
a260: 3b 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 66 ;; run logpro if
a270: 20 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b 20 28 applicable ;; (
a280: 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c 73 22 process-run "ls"
a290: 20 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20 22 32 (list "/foo" "2
a2a0: 3e 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67 22 29 >&1" "blah.log")
a2b0: 29 0a 09 09 20 20 20 20 28 69 66 20 6c 6f 67 70 )... (if logp
a2c0: 72 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74 2a 20 rofile....(let*
a2d0: 28 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 28 63 ((htmllogfile (c
a2e0: 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 onc stepname ".h
a2f0: 74 6d 6c 22 29 29 0a 09 09 09 20 20 20 20 20 20 tml"))....
a300: 20 28 6f 6c 64 65 78 69 74 73 74 61 74 20 65 78 (oldexitstat ex
a310: 69 74 73 74 61 74 29 0a 09 09 09 20 20 20 20 20 itstat)....
a320: 20 20 28 63 6d 64 20 20 20 20 20 20 20 20 20 28 (cmd (
a330: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
a340: 73 65 20 28 6c 69 73 74 20 22 6c 6f 67 70 72 6f se (list "logpro
a350: 22 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68 74 6d " logprofile htm
a360: 6c 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c 6f 67 llogfile "<" log
a370: 66 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63 20 73 file ">" (conc s
a380: 74 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70 72 6f tepname "_logpro
a390: 2e 6c 6f 67 22 29 29 20 22 20 22 29 29 29 0a 09 .log")) " ")))..
a3a0: 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
a3b0: 2d 69 6e 66 6f 20 32 20 22 72 75 6e 6e 69 6e 67 -info 2 "running
a3c0: 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 29 0a 09 \"" cmd "\"")..
a3d0: 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 .. (change-dire
a3e0: 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 64 69 ctory startingdi
a3f0: 72 29 0a 09 09 09 20 20 28 73 65 74 21 20 65 78 r).... (set! ex
a400: 69 74 73 74 61 74 20 28 73 79 73 74 65 6d 20 63 itstat (system c
a410: 6d 64 29 29 0a 09 09 09 20 20 28 73 65 74 21 20 md)).... (set!
a420: 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 *globalexitstatu
a430: 73 2a 20 65 78 69 74 73 74 61 74 29 20 3b 3b 20 s* exitstat) ;;
a440: 6e 6f 20 6e 65 63 65 73 73 61 72 79 0a 09 09 09 no necessary....
a450: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
a460: 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 09 ory testpath)...
a470: 09 20 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 . (rmt:test-set
a480: 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 73 -log! run-id tes
a490: 74 2d 69 64 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 t-id htmllogfile
a4a0: 29 29 29 0a 09 09 20 20 20 20 28 6c 65 74 20 28 )))... (let (
a4b0: 28 6d 73 67 20 28 61 72 67 73 3a 67 65 74 2d 61 (msg (args:get-a
a4c0: 72 67 20 22 2d 6d 22 29 29 29 0a 09 09 20 20 20 rg "-m")))...
a4d0: 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 65 70 (rmt:teststep
a4e0: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
a4f0: 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 -id test-id step
a500: 6e 61 6d 65 20 22 65 6e 64 22 20 65 78 69 74 73 name "end" exits
a510: 74 61 74 20 6d 73 67 20 6c 6f 67 66 69 6c 65 29 tat msg logfile)
a520: 29 0a 09 09 20 20 20 20 29 29 29 0a 09 20 20 28 )... ))).. (
a530: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
a540: 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 -arg "-test-stat
a550: 75 73 22 29 0a 09 09 20 20 28 61 72 67 73 3a 67 us")... (args:g
a560: 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 6c et-arg "-set-val
a570: 75 65 73 22 29 29 0a 09 20 20 20 20 20 20 28 6c ues")).. (l
a580: 65 74 20 28 28 6e 65 77 73 74 61 74 75 73 20 28 et ((newstatus (
a590: 63 6f 6e 64 0a 09 09 09 09 28 28 6e 75 6d 62 65 cond.....((numbe
a5a0: 72 3f 20 73 74 61 74 75 73 29 20 20 20 20 20 20 r? status)
a5b0: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 (if (equal? sta
a5c0: 74 75 73 20 30 29 20 22 50 41 53 53 22 20 22 46 tus 0) "PASS" "F
a5d0: 41 49 4c 22 29 29 0a 09 09 09 09 28 28 61 6e 64 AIL")).....((and
a5e0: 20 28 73 74 72 69 6e 67 3f 20 73 74 61 74 75 73 (string? status
a5f0: 29 0a 09 09 09 09 20 20 20 20 20 20 28 73 74 72 )..... (str
a600: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 61 74 ing->number stat
a610: 75 73 29 29 28 69 66 20 28 65 71 75 61 6c 3f 20 us))(if (equal?
a620: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
a630: 73 74 61 74 75 73 29 20 30 29 20 22 50 41 53 53 status) 0) "PASS
a640: 22 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 " "FAIL")).....(
a650: 65 6c 73 65 20 73 74 61 74 75 73 29 29 29 0a 09 else status)))..
a660: 09 20 20 20 20 3b 3b 20 74 72 61 6e 73 66 65 72 . ;; transfer
a670: 20 72 65 6c 65 76 61 6e 74 20 6b 65 79 73 20 69 relevant keys i
a680: 6e 74 6f 20 61 20 68 61 73 68 20 74 6f 20 62 65 nto a hash to be
a690: 20 70 61 73 73 65 64 20 74 6f 20 74 65 73 74 2d passed to test-
a6a0: 73 65 74 2d 73 74 61 74 75 73 21 0a 09 09 20 20 set-status!...
a6b0: 20 20 3b 3b 20 63 6f 75 6c 64 20 75 73 65 20 61 ;; could use a
a6c0: 6e 20 61 73 73 6f 63 20 6c 69 73 74 20 49 20 67 n assoc list I g
a6d0: 75 65 73 73 2e 20 0a 09 09 20 20 20 20 28 6f 74 uess. ... (ot
a6e0: 68 65 72 64 61 74 61 20 28 6c 65 74 20 28 28 72 herdata (let ((r
a6f0: 65 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 es (make-hash-ta
a700: 62 6c 65 29 29 29 0a 09 09 09 09 20 28 66 6f 72 ble)))..... (for
a710: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b -each (lambda (k
a720: 65 79 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 ey)...... (i
a730: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
a740: 6b 65 79 29 0a 09 09 09 09 09 09 20 28 68 61 73 key)....... (has
a750: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 h-table-set! res
a760: 20 6b 65 79 20 28 61 72 67 73 3a 67 65 74 2d 61 key (args:get-a
a770: 72 67 20 6b 65 79 29 29 29 29 0a 09 09 09 09 09 rg key))))......
a780: 20 20 20 28 6c 69 73 74 20 22 3a 76 61 6c 75 65 (list ":value
a790: 22 20 22 3a 74 6f 6c 22 20 22 3a 65 78 70 65 63 " ":tol" ":expec
a7a0: 74 65 64 22 20 22 3a 66 69 72 73 74 5f 65 72 72 ted" ":first_err
a7b0: 22 20 22 3a 66 69 72 73 74 5f 77 61 72 6e 22 20 " ":first_warn"
a7c0: 22 3a 75 6e 69 74 73 22 20 22 3a 63 61 74 65 67 ":units" ":categ
a7d0: 6f 72 79 22 20 22 3a 76 61 72 69 61 62 6c 65 22 ory" ":variable"
a7e0: 29 29 0a 09 09 09 09 20 72 65 73 29 29 29 0a 09 ))..... res)))..
a7f0: 09 28 69 66 20 28 61 6e 64 20 28 61 72 67 73 3a .(if (and (args:
a800: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 get-arg "-test-s
a810: 74 61 74 75 73 22 29 0a 09 09 09 20 28 6f 72 20 tatus").... (or
a820: 28 6e 6f 74 20 73 74 61 74 65 29 0a 09 09 09 20 (not state)....
a830: 20 20 20 20 28 6e 6f 74 20 73 74 61 74 75 73 29 (not status)
a840: 29 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a ))... (begin.
a850: 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
a860: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 59 rint 0 "ERROR: Y
a870: 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 ou must specify
a880: 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 :state and :stat
a890: 75 73 20 77 69 74 68 20 65 76 65 72 79 20 63 61 us with every ca
a8a0: 6c 6c 20 74 6f 20 2d 74 65 73 74 2d 73 74 61 74 ll to -test-stat
a8b0: 75 73 5c 6e 22 20 68 65 6c 70 29 0a 09 09 20 20 us\n" help)...
a8c0: 20 20 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 (if (sqlite3
a8d0: 3a 64 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 :database? db)(s
a8e0: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
a8f0: 20 64 62 29 29 0a 09 09 20 20 20 20 20 20 28 65 db))... (e
a900: 78 69 74 20 36 29 29 29 0a 09 09 28 6c 65 74 2a xit 6)))...(let*
a910: 20 28 28 6d 73 67 20 20 20 20 28 61 72 67 73 3a ((msg (args:
a920: 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 get-arg "-m"))..
a930: 09 20 20 20 20 20 20 20 28 6e 75 6d 6f 74 68 20 . (numoth
a940: 28 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 (length (hash-ta
a950: 62 6c 65 2d 6b 65 79 73 20 6f 74 68 65 72 64 61 ble-keys otherda
a960: 74 61 29 29 29 29 0a 09 09 20 20 3b 3b 20 43 6f ta))))... ;; Co
a970: 6e 76 65 72 74 20 74 6f 20 72 70 63 20 69 6e 73 nvert to rpc ins
a980: 69 64 65 20 74 68 65 20 74 65 73 74 73 3a 74 65 ide the tests:te
a990: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 63 st-set-status! c
a9a0: 61 6c 6c 2c 20 6e 6f 74 20 68 65 72 65 0a 09 09 all, not here...
a9b0: 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 (tests:test-se
a9c0: 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 t-status! run-id
a9d0: 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 6e test-id state n
a9e0: 65 77 73 74 61 74 75 73 20 6d 73 67 20 6f 74 68 ewstatus msg oth
a9f0: 65 72 64 61 74 61 20 77 6f 72 6b 2d 61 72 65 61 erdata work-area
aa00: 3a 20 77 6f 72 6b 2d 61 72 65 61 29 29 29 29 0a : work-area)))).
aa10: 09 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 3a . (if (sqlite3:
aa20: 64 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 71 database? db)(sq
aa30: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
aa40: 64 62 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 db)).. (set! *d
aa50: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
aa60: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
aa70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aa80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aa90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aaa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
aab0: 20 56 61 72 69 6f 75 73 20 68 65 6c 70 65 72 20 Various helper
aac0: 63 6f 6d 6d 61 6e 64 73 20 63 61 6e 20 67 6f 20 commands can go
aad0: 62 65 6c 6f 77 20 68 65 72 65 0a 3b 3b 3d 3d 3d below here.;;===
aae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aaf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab20: 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 ===..(if (or (ar
ab30: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f gs:get-arg "-sho
ab40: 77 6b 65 79 73 22 29 0a 20 20 20 20 20 20 20 20 wkeys").
ab50: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
ab60: 73 68 6f 77 2d 6b 65 79 73 22 29 29 0a 20 20 20 show-keys")).
ab70: 20 28 6c 65 74 20 28 28 64 62 20 23 66 29 0a 09 (let ((db #f)..
ab80: 20 20 28 6b 65 79 73 20 23 66 29 29 0a 20 20 20 (keys #f)).
ab90: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 (if (not (lau
aba0: 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d 72 75 nch:setup-for-ru
abb0: 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 n)).. (begin..
abc0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
abd0: 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 0 "Failed to set
abe0: 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 up, exiting")..
abf0: 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))).
ac00: 20 20 20 20 28 73 65 74 21 20 6b 65 79 73 20 28 (set! keys (
ac10: 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 cdb:remote-run d
ac20: 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a b:get-keys db)).
ac30: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
ac40: 6e 74 20 31 20 22 4b 65 79 73 3a 20 22 20 28 73 nt 1 "Keys: " (s
ac50: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
ac60: 65 20 6b 65 79 73 20 22 2c 20 22 29 29 0a 20 20 e keys ", ")).
ac70: 20 20 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 (if (sqlite3
ac80: 3a 64 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 :database? db)(s
ac90: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
aca0: 20 64 62 29 29 0a 20 20 20 20 20 20 28 73 65 74 db)). (set
acb0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
acc0: 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
acd0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 75 69 22 s:get-arg "-gui"
ace0: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
acf0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
ad00: 30 20 22 4c 6f 6f 6b 20 61 74 20 74 68 65 20 64 0 "Look at the d
ad10: 61 73 68 62 6f 61 72 64 20 66 6f 72 20 6e 6f 77 ashboard for now
ad20: 22 29 0a 20 20 20 20 20 20 3b 3b 20 28 6d 65 67 "). ;; (meg
ad30: 61 74 65 73 74 2d 67 75 69 29 0a 20 20 20 20 20 atest-gui).
ad40: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
ad50: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 hing* #t)))..(if
ad60: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
ad70: 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 -gen-megatest-ar
ad80: 65 61 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ea"). (begin.
ad90: 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c (genexampl
ada0: 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2e 63 6f e:mk-megatest.co
adb0: 6e 66 69 67 29 0a 20 20 20 20 20 20 28 73 65 74 nfig). (set
adc0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
add0: 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
ade0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 6e 2d s:get-arg "-gen-
adf0: 6d 65 67 61 74 65 73 74 2d 74 65 73 74 22 29 0a megatest-test").
ae00: 20 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 6e (let ((testn
ae10: 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ame (args:get-ar
ae20: 67 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 g "-gen-megatest
ae30: 2d 74 65 73 74 22 29 29 29 0a 20 20 20 20 20 20 -test"))).
ae40: 28 67 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d (genexample:mk-m
ae50: 65 67 61 74 65 73 74 2d 74 65 73 74 20 74 65 73 egatest-test tes
ae60: 74 6e 61 6d 65 29 0a 20 20 20 20 20 20 28 73 65 tname). (se
ae70: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
ae80: 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d * #t)))..;;=====
ae90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aeb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aed0: 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 =.;; Update the
aee0: 64 61 74 61 62 61 73 65 20 73 63 68 65 6d 61 2c database schema,
aef0: 20 63 6c 65 61 6e 20 75 70 20 74 68 65 20 64 62 clean up the db
af00: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
af10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
af20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
af30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
af40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
af50: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
af60: 65 62 75 69 6c 64 2d 64 62 22 29 0a 20 20 20 20 ebuild-db").
af70: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 (begin. (if
af80: 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
af90: 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 tup-for-run))..
afa0: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 (begin.. (de
afb0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 bug:print 0 "Fai
afc0: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
afd0: 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 iting") .. (e
afe0: 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 3b xit 1))). ;
aff0: 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 ; keep this one
b000: 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 6f 70 65 local. (ope
b010: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 70 61 74 63 n-run-close patc
b020: 68 2d 64 62 20 23 66 29 0a 20 20 20 20 20 20 28 h-db #f). (
b030: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
b040: 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 ng* #t)))..(if (
b050: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 args:get-arg "-c
b060: 6c 65 61 6e 75 70 2d 64 62 22 29 0a 20 20 20 20 leanup-db").
b070: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 (begin. (if
b080: 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
b090: 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 tup-for-run))..
b0a0: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 (begin.. (de
b0b0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 bug:print 0 "Fai
b0c0: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
b0d0: 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 iting") .. (e
b0e0: 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 3b xit 1))). ;
b0f0: 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 ; keep this one
b100: 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 6f 70 65 local. (ope
b110: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 63 n-run-close db:c
b120: 6c 65 61 6e 2d 75 70 20 23 66 29 0a 20 20 20 20 lean-up #f).
b130: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
b140: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
b150: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
b160: 22 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 "-mark-incomplet
b170: 65 73 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a es"). (begin.
b180: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
b190: 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 launch:setup-for
b1a0: 2d 72 75 6e 29 29 0a 09 20 20 28 62 65 67 69 6e -run)).. (begin
b1b0: 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
b1c0: 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 nt 0 "Failed to
b1d0: 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 setup, exiting")
b1e0: 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 .. (exit 1))
b1f0: 29 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 ). (open-ru
b200: 6e 2d 63 6c 6f 73 65 20 64 62 3a 66 69 6e 64 2d n-close db:find-
b210: 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c and-mark-incompl
b220: 65 74 65 20 23 66 29 0a 20 20 20 20 20 20 28 73 ete #f). (s
b230: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
b240: 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d g* #t)))..;;====
b250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b290: 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 ==.;; Update the
b2a0: 20 74 65 73 74 73 20 6d 65 74 61 20 64 61 74 61 tests meta data
b2b0: 20 66 72 6f 6d 20 74 68 65 20 74 65 73 74 63 6f from the testco
b2c0: 6e 66 69 67 20 66 69 6c 65 73 0a 3b 3b 3d 3d 3d nfig files.;;===
b2d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b2e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b2f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b310: 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
b320: 65 74 2d 61 72 67 20 22 2d 75 70 64 61 74 65 2d et-arg "-update-
b330: 6d 65 74 61 22 29 0a 20 20 20 20 28 62 65 67 69 meta"). (begi
b340: 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 n. (if (not
b350: 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 66 (launch:setup-f
b360: 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 62 65 67 or-run)).. (beg
b370: 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 in.. (debug:p
b380: 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 rint 0 "Failed t
b390: 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
b3a0: 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 ") .. (exit 1
b3b0: 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6e 6f 77 ))). ;; now
b3c0: 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 64 62 can find our db
b3d0: 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 . ;; keep t
b3e0: 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 his one local.
b3f0: 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c (open-run-cl
b400: 6f 73 65 20 72 75 6e 73 3a 75 70 64 61 74 65 2d ose runs:update-
b410: 61 6c 6c 2d 74 65 73 74 5f 6d 65 74 61 20 23 66 all-test_meta #f
b420: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
b430: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
b440: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
b450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
b490: 53 74 61 72 74 20 61 20 72 65 70 6c 0a 3b 3b 3d Start a repl.;;=
b4a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b4b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b4c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b4d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b4e0: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 =====..(if (or (
b4f0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
b500: 65 70 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 epl")..(args:get
b510: 2d 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 0a 20 -arg "-load")).
b520: 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 (let* ((toppa
b530: 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 th (launch:setup
b540: 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 28 -for-run)).. (
b550: 64 62 73 74 72 75 63 74 20 28 69 66 20 74 6f 70 dbstruct (if top
b560: 70 61 74 68 20 28 6d 61 6b 65 2d 64 62 72 3a 64 path (make-dbr:d
b570: 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 74 6f bstruct path: to
b580: 70 70 61 74 68 20 6c 6f 63 61 6c 3a 20 23 74 29 ppath local: #t)
b590: 20 23 66 29 29 29 0a 20 20 20 20 20 20 28 69 66 #f))). (if
b5a0: 20 64 62 73 74 72 75 63 74 0a 09 20 20 28 62 65 dbstruct.. (be
b5b0: 67 69 6e 0a 09 20 20 20 20 28 73 65 74 21 20 2a gin.. (set! *
b5c0: 64 62 2a 20 64 62 73 74 72 75 63 74 29 0a 09 20 db* dbstruct)..
b5d0: 20 20 20 28 73 65 74 21 20 2a 63 6c 69 65 6e 74 (set! *client
b5e0: 2d 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 2d 6d 6f -non-blocking-mo
b5f0: 64 65 2a 20 23 74 29 0a 09 20 20 20 20 28 69 6d de* #t).. (im
b600: 70 6f 72 74 20 72 65 61 64 6c 69 6e 65 29 0a 09 port readline)..
b610: 20 20 20 20 28 69 6d 70 6f 72 74 20 61 70 72 6f (import apro
b620: 70 6f 73 29 0a 09 20 20 20 20 3b 3b 20 28 69 6d pos).. ;; (im
b630: 70 6f 72 74 20 28 70 72 65 66 69 78 20 73 71 6c port (prefix sql
b640: 69 74 65 33 20 73 71 6c 69 74 65 33 3a 29 29 20 ite3 sqlite3:))
b650: 3b 3b 20 64 6f 65 73 6e 27 74 20 77 6f 72 6b 20 ;; doesn't work
b660: 2e 2e 2e 0a 09 20 20 20 20 28 67 6e 75 2d 68 69 ..... (gnu-hi
b670: 73 74 6f 72 79 2d 69 6e 73 74 61 6c 6c 2d 66 69 story-install-fi
b680: 6c 65 2d 6d 61 6e 61 67 65 72 0a 09 20 20 20 20 le-manager..
b690: 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 0a (string-append.
b6a0: 09 20 20 20 20 20 20 28 6f 72 20 28 67 65 74 2d . (or (get-
b6b0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
b6c0: 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2e 22 able "HOME") "."
b6d0: 29 20 22 2f 2e 6d 65 67 61 74 65 73 74 5f 68 69 ) "/.megatest_hi
b6e0: 73 74 6f 72 79 22 29 29 0a 09 20 20 20 20 28 63 story")).. (c
b6f0: 75 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 urrent-input-por
b700: 74 20 28 6d 61 6b 65 2d 67 6e 75 2d 72 65 61 64 t (make-gnu-read
b710: 6c 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 61 74 line-port "megat
b720: 65 73 74 3e 20 22 29 29 0a 09 20 20 20 20 28 69 est> ")).. (i
b730: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
b740: 22 2d 72 65 70 6c 22 29 0a 09 09 28 72 65 70 6c "-repl")...(repl
b750: 29 0a 09 09 28 6c 6f 61 64 20 28 61 72 67 73 3a )...(load (args:
b760: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 22 29 get-arg "-load")
b770: 29 29 0a 09 20 20 20 20 28 64 62 3a 63 6c 6f 73 )).. (db:clos
b780: 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 74 29 29 e-all dbstruct))
b790: 0a 09 20 20 28 65 78 69 74 29 29 0a 20 20 20 20 .. (exit)).
b7a0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
b7b0: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
b7c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b7d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b7e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b7f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b800: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 57 61 69 74 20 6f ======.;; Wait o
b810: 6e 20 61 20 72 75 6e 20 74 6f 20 63 6f 6d 70 6c n a run to compl
b820: 65 74 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ete.;;==========
b830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
b870: 66 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 f (and (args:get
b880: 2d 61 72 67 20 22 2d 72 75 6e 2d 77 61 69 74 22 -arg "-run-wait"
b890: 29 0a 09 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 ).. (not (args:g
b8a0: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
b8b0: 73 22 29 29 29 20 3b 3b 20 72 75 6e 2d 77 61 69 s"))) ;; run-wai
b8c0: 74 20 69 73 20 62 75 69 6c 74 20 69 6e 74 6f 20 t is built into
b8d0: 72 75 6e 74 65 73 74 73 20 6e 6f 77 0a 20 20 20 runtests now.
b8e0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 (begin. (i
b8f0: 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
b900: 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 etup-for-run))..
b910: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 (begin.. (d
b920: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 ebug:print 0 "Fa
b930: 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 iled to setup, e
b940: 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 xiting") .. (
b950: 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 exit 1))).
b960: 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 72 75 6e (operate-on 'run
b970: 2d 77 61 69 74 29 0a 20 20 20 20 20 20 28 73 65 -wait). (se
b980: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
b990: 2a 20 23 74 29 29 29 0a 0a 3b 3b 20 3b 3b 20 3b * #t)))..;; ;; ;
b9a0: 3b 20 72 65 64 6f 20 6d 65 20 3b 3b 20 4e 6f 74 ; redo me ;; Not
b9b0: 20 63 6f 6e 76 65 72 74 65 64 20 74 6f 20 75 73 converted to us
b9c0: 65 20 64 62 73 74 72 75 63 74 20 79 65 74 0a 3b e dbstruct yet.;
b9d0: 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
b9e0: 3b 3b 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f ;;.;; ;; ;; redo
b9f0: 20 6d 65 20 28 69 66 20 28 61 72 67 73 3a 67 65 me (if (args:ge
ba00: 74 2d 61 72 67 20 22 2d 63 6f 6e 76 65 72 74 2d t-arg "-convert-
ba10: 74 6f 2d 6e 6f 72 6d 22 29 0a 3b 3b 20 3b 3b 20 to-norm").;; ;;
ba20: 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 28 ;; redo me (
ba30: 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 let* ((toppath (
ba40: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
ba50: 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
ba60: 20 09 20 20 20 28 64 62 73 74 72 75 63 74 20 28 . (dbstruct (
ba70: 69 66 20 74 6f 70 70 61 74 68 20 28 6d 61 6b 65 if toppath (make
ba80: 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 61 -dbr:dbstruct pa
ba90: 74 68 3a 20 74 6f 70 70 61 74 68 20 6c 6f 63 61 th: toppath loca
baa0: 6c 3a 20 23 74 29 29 29 29 0a 3b 3b 20 3b 3b 20 l: #t)))).;; ;;
bab0: 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 20 ;; redo me
bac0: 20 28 66 6f 72 2d 65 61 63 68 20 0a 3b 3b 20 3b (for-each .;; ;
bad0: 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 ; ;; redo me
bae0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 69 65 (lambda (fie
baf0: 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ld).;; ;; ;; red
bb00: 6f 20 6d 65 20 09 20 28 6c 65 74 20 28 28 64 61 o me . (let ((da
bb10: 74 20 27 28 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b t '())).;; ;; ;;
bb20: 20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 64 65 redo me . (de
bb30: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
bb40: 20 22 47 65 74 74 69 6e 67 20 64 61 74 61 20 66 "Getting data f
bb50: 6f 72 20 66 69 65 6c 64 20 22 20 66 69 65 6c 64 or field " field
bb60: 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
bb70: 6d 65 20 09 20 20 20 28 73 71 6c 69 74 65 33 3a me . (sqlite3:
bb80: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 3b 3b 20 for-each-row.;;
bb90: 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 ;; ;; redo me .
bba0: 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 76 (lambda (id v
bbb0: 61 6c 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 al).;; ;; ;; red
bbc0: 6f 20 6d 65 20 09 20 20 20 20 20 20 28 73 65 74 o me . (set
bbd0: 21 20 64 61 74 20 28 63 6f 6e 73 20 28 6c 69 73 ! dat (cons (lis
bbe0: 74 20 69 64 20 76 61 6c 29 20 64 61 74 29 29 29 t id val) dat)))
bbf0: 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
bc00: 65 20 09 20 20 20 20 28 64 62 3a 67 65 74 2d 64 e . (db:get-d
bc10: 62 20 64 62 20 72 75 6e 2d 69 64 29 0a 3b 3b 20 b db run-id).;;
bc20: 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 ;; ;; redo me .
bc30: 20 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 (conc "SELECT
bc40: 20 69 64 2c 22 20 66 69 65 6c 64 20 22 20 46 52 id," field " FR
bc50: 4f 4d 20 74 65 73 74 73 3b 22 29 29 0a 3b 3b 20 OM tests;")).;;
bc60: 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 ;; ;; redo me .
bc70: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
bc80: 6e 66 6f 20 30 20 22 66 6f 75 6e 64 20 22 20 28 nfo 0 "found " (
bc90: 6c 65 6e 67 74 68 20 64 61 74 29 20 22 20 69 74 length dat) " it
bca0: 65 6d 73 20 66 6f 72 20 66 69 65 6c 64 20 22 20 ems for field "
bcb0: 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 field).;; ;; ;;
bcc0: 72 65 64 6f 20 6d 65 20 09 20 20 20 28 6c 65 74 redo me . (let
bcd0: 20 28 28 71 72 79 20 28 73 71 6c 69 74 65 33 3a ((qry (sqlite3:
bce0: 70 72 65 70 61 72 65 20 64 62 20 28 63 6f 6e 63 prepare db (conc
bcf0: 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 "UPDATE tests S
bd00: 45 54 20 22 20 66 69 65 6c 64 20 22 3d 3f 20 57 ET " field "=? W
bd10: 48 45 52 45 20 69 64 3d 3f 3b 22 29 29 29 29 0a HERE id=?;")))).
bd20: 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
bd30: 20 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 . (for-each
bd40: 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
bd50: 65 20 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 e . (lambda
bd60: 20 28 69 74 65 6d 29 0a 3b 3b 20 3b 3b 20 3b 3b (item).;; ;; ;;
bd70: 20 72 65 64 6f 20 6d 65 20 09 09 28 6c 65 74 20 redo me ..(let
bd80: 28 28 6e 65 77 76 61 6c 20 3b 3b 20 28 73 64 62 ((newval ;; (sdb
bd90: 3a 71 72 79 20 27 67 65 74 69 64 20 0a 3b 3b 20 :qry 'getid .;;
bda0: 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 ;; ;; redo me ..
bdb0: 20 20 20 20 20 20 20 28 63 61 64 72 20 69 74 65 (cadr ite
bdc0: 6d 29 29 29 20 3b 3b 20 29 0a 3b 3b 20 3b 3b 20 m))) ;; ).;; ;;
bdd0: 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 20 20 28 ;; redo me .. (
bde0: 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 if (not (equal?
bdf0: 6e 65 77 76 61 6c 20 28 63 61 64 72 20 69 74 65 newval (cadr ite
be00: 6d 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 m))).;; ;; ;; re
be10: 64 6f 20 6d 65 20 09 09 20 20 20 20 20 20 28 64 do me .. (d
be20: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
be30: 30 20 22 43 6f 6e 76 65 72 74 69 6e 67 20 22 20 0 "Converting "
be40: 28 63 61 64 72 20 69 74 65 6d 29 20 22 20 74 6f (cadr item) " to
be50: 20 22 20 6e 65 77 76 61 6c 20 22 20 66 6f 72 20 " newval " for
be60: 74 65 73 74 20 23 22 20 28 63 61 72 20 69 74 65 test #" (car ite
be70: 6d 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 m))).;; ;; ;; re
be80: 64 6f 20 6d 65 20 09 09 20 20 28 73 71 6c 69 74 do me .. (sqlit
be90: 65 33 3a 65 78 65 63 75 74 65 20 71 72 79 20 6e e3:execute qry n
bea0: 65 77 76 61 6c 20 28 63 61 72 20 69 74 65 6d 29 ewval (car item)
beb0: 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ))).;; ;; ;; red
bec0: 6f 20 6d 65 20 09 20 20 20 20 20 20 64 61 74 29 o me . dat)
bed0: 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
bee0: 65 20 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 e . (sqlite3
bef0: 3a 66 69 6e 61 6c 69 7a 65 21 20 71 72 79 29 29 :finalize! qry))
bf00: 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f )).;; ;; ;; redo
bf10: 20 6d 65 20 20 20 20 20 20 20 20 28 64 62 3a 63 me (db:c
bf20: 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 lose-all dbstruc
bf30: 74 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f t).;; ;; ;; redo
bf40: 20 6d 65 20 20 20 20 20 20 20 20 28 6c 69 73 74 me (list
bf50: 20 22 75 6e 61 6d 65 22 20 22 72 75 6e 64 69 72 "uname" "rundir
bf60: 22 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 22 " "final_logf" "
bf70: 63 6f 6d 6d 65 6e 74 22 29 29 0a 3b 3b 20 3b 3b comment")).;; ;;
bf80: 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 ;; redo me
bf90: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
bfa0: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
bfb0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
bfc0: 22 2d 69 6d 70 6f 72 74 2d 6d 65 67 61 74 65 73 "-import-megates
bfd0: 74 2e 64 62 22 29 0a 20 20 20 20 28 6c 65 74 2a t.db"). (let*
bfe0: 20 28 28 74 6f 70 70 61 74 68 20 20 28 6c 61 75 ((toppath (lau
bff0: 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d 72 75 nch:setup-for-ru
c000: 6e 29 29 0a 09 20 20 20 28 64 62 73 74 72 75 63 n)).. (dbstruc
c010: 74 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 6d t (if toppath (m
c020: 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 ake-dbr:dbstruct
c030: 20 70 61 74 68 3a 20 74 6f 70 70 61 74 68 29 20 path: toppath)
c040: 23 66 29 29 0a 09 20 20 20 28 6d 74 64 62 20 20 #f)).. (mtdb
c050: 20 20 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 (if toppath (
c060: 64 62 3a 6f 70 65 6e 2d 6d 65 67 61 74 65 73 74 db:open-megatest
c070: 2d 64 62 29 29 29 0a 09 20 20 20 28 72 75 6e 2d -db))).. (run-
c080: 69 64 73 20 20 28 69 66 20 74 6f 70 70 61 74 68 ids (if toppath
c090: 20 28 64 62 3a 67 65 74 2d 61 6c 6c 2d 72 75 6e (db:get-all-run
c0a0: 2d 69 64 73 20 6d 74 64 62 29 29 29 0a 09 20 20 -ids mtdb)))..
c0b0: 20 28 6d 64 62 20 20 20 20 20 28 74 61 73 6b 73 (mdb (tasks
c0c0: 3a 6f 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 28 :open-db)).. (
c0d0: 73 65 72 76 65 72 73 20 28 74 61 73 6b 73 3a 67 servers (tasks:g
c0e0: 65 74 2d 61 6c 6c 2d 73 65 72 76 65 72 73 20 6d et-all-servers m
c0f0: 64 62 29 29 29 0a 20 20 20 20 20 20 0a 20 20 20 db))). .
c100: 20 20 20 3b 3b 20 6b 69 6c 6c 20 73 65 72 76 65 ;; kill serve
c110: 72 73 0a 20 20 20 20 20 20 28 66 6f 72 2d 65 61 rs. (for-ea
c120: 63 68 0a 20 20 20 20 20 20 20 28 6c 61 6d 62 64 ch. (lambd
c130: 61 20 28 73 65 72 76 65 72 29 0a 09 20 28 74 61 a (server).. (ta
c140: 73 6b 73 3a 73 65 72 76 65 72 2d 64 65 6c 65 74 sks:server-delet
c150: 65 2d 72 65 63 6f 72 64 20 6d 64 62 20 28 76 65 e-record mdb (ve
c160: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
c170: 30 29 20 22 64 62 6d 69 67 72 61 74 69 6f 6e 22 0) "dbmigration"
c180: 29 0a 09 20 28 74 61 73 6b 73 3a 6b 69 6c 6c 2d ).. (tasks:kill-
c190: 73 65 72 76 65 72 20 28 76 65 63 74 6f 72 2d 72 server (vector-r
c1a0: 65 66 20 73 65 72 76 65 72 20 32 29 28 76 65 63 ef server 2)(vec
c1b0: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 tor-ref server 1
c1c0: 29 29 29 0a 20 20 20 20 20 20 20 73 65 72 76 65 ))). serve
c1d0: 72 73 29 0a 20 20 20 20 20 20 28 73 71 6c 69 74 rs). (sqlit
c1e0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 6d 64 62 e3:finalize! mdb
c1f0: 29 0a 0a 20 20 20 20 20 20 3b 3b 20 63 6c 65 61 ).. ;; clea
c200: 72 20 6f 75 74 20 6a 75 6e 6b 20 72 65 63 6f 72 r out junk recor
c210: 64 73 0a 20 20 20 20 20 20 3b 3b 0a 20 20 20 20 ds. ;;.
c220: 20 20 28 64 62 3a 63 6c 65 61 6e 2d 75 70 20 6d (db:clean-up m
c230: 74 64 62 29 0a 0a 20 20 20 20 20 20 3b 3b 20 61 tdb).. ;; a
c240: 64 6a 75 73 74 20 74 65 73 74 2d 69 64 73 20 74 djust test-ids t
c250: 6f 20 66 69 74 20 69 6e 74 6f 20 70 72 6f 70 65 o fit into prope
c260: 72 20 72 61 6e 67 65 0a 20 20 20 20 20 20 3b 3b r range. ;;
c270: 0a 20 20 20 20 20 20 28 64 62 3a 70 72 65 70 2d . (db:prep-
c280: 6d 65 67 61 74 65 73 74 2e 64 62 2d 66 6f 72 2d megatest.db-for-
c290: 6d 69 67 72 61 74 69 6f 6e 20 6d 74 64 62 29 0a migration mtdb).
c2a0: 0a 20 20 20 20 20 20 3b 3b 20 73 79 6e 63 20 72 . ;; sync r
c2b0: 75 6e 73 2c 20 74 65 73 74 5f 6d 65 74 61 20 65 uns, test_meta e
c2c0: 74 63 2e 0a 20 20 20 20 20 20 3b 3b 0a 20 20 20 tc.. ;;.
c2d0: 20 20 20 28 64 62 3a 73 79 6e 63 2d 74 61 62 6c (db:sync-tabl
c2e0: 65 73 20 28 64 62 3a 73 79 6e 63 2d 6d 61 69 6e es (db:sync-main
c2f0: 2d 6c 69 73 74 20 6d 74 64 62 29 20 6d 74 64 62 -list mtdb) mtdb
c300: 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 73 74 (db:get-db dbst
c310: 72 75 63 74 20 23 66 29 29 0a 20 20 20 20 20 20 ruct #f)).
c320: 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 (for-each .
c330: 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 (lambda (run-i
c340: 64 29 0a 09 20 28 6c 65 74 20 28 28 74 65 73 74 d).. (let ((test
c350: 72 65 63 73 20 28 64 62 3a 67 65 74 2d 61 6c 6c recs (db:get-all
c360: 2d 74 65 73 74 73 2d 69 6e 66 6f 2d 62 79 2d 72 -tests-info-by-r
c370: 75 6e 2d 69 64 20 6d 74 64 62 20 72 75 6e 2d 69 un-id mtdb run-i
c380: 64 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 73 d)).. (dbs
c390: 74 72 75 63 74 20 28 69 66 20 74 6f 70 70 61 74 truct (if toppat
c3a0: 68 20 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 h (make-dbr:dbst
c3b0: 72 75 63 74 20 70 61 74 68 3a 20 74 6f 70 70 61 ruct path: toppa
c3c0: 74 68 20 6c 6f 63 61 6c 3a 20 23 74 29 20 23 66 th local: #t) #f
c3d0: 29 29 29 0a 09 20 20 20 28 64 65 62 75 67 3a 70 ))).. (debug:p
c3e0: 72 69 6e 74 20 30 20 22 49 4e 46 4f 3a 20 50 72 rint 0 "INFO: Pr
c3f0: 6f 70 61 67 61 74 69 6e 67 20 22 20 28 6c 65 6e opagating " (len
c400: 67 74 68 20 74 65 73 74 72 65 63 73 29 20 22 20 gth testrecs) "
c410: 72 65 63 6f 72 64 73 20 66 6f 72 20 72 75 6e 2d records for run-
c420: 69 64 3d 22 20 72 75 6e 2d 69 64 20 22 20 74 6f id=" run-id " to
c430: 20 72 75 6e 20 73 70 65 63 69 66 69 63 20 64 62 run specific db
c440: 22 29 0a 09 20 20 20 28 64 62 3a 72 65 70 6c 61 ").. (db:repla
c450: 63 65 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 20 ce-test-records
c460: 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 dbstruct run-id
c470: 74 65 73 74 72 65 63 73 29 0a 09 20 20 20 28 73 testrecs).. (s
c480: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
c490: 20 28 64 62 72 3a 64 62 73 74 72 75 63 74 2d 67 (dbr:dbstruct-g
c4a0: 65 74 2d 72 75 6e 64 62 20 64 62 73 74 72 75 63 et-rundb dbstruc
c4b0: 74 29 29 29 29 0a 20 20 20 20 20 20 20 72 75 6e t)))). run
c4c0: 2d 69 64 73 29 0a 20 20 20 20 20 20 28 73 65 74 -ids). (set
c4d0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
c4e0: 20 23 74 29 0a 20 20 20 20 20 20 28 64 62 3a 63 #t). (db:c
c4f0: 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 lose-all dbstruc
c500: 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
c510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
c550: 3b 20 45 78 69 74 20 61 6e 64 20 63 6c 65 61 6e ; Exit and clean
c560: 20 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d up.;;==========
c570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c5a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
c5b0: 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 28 63 f *runremote* (c
c5c0: 6c 6f 73 65 2d 61 6c 6c 2d 63 6f 6e 6e 65 63 74 lose-all-connect
c5d0: 69 6f 6e 73 21 29 29 0a 0a 28 69 66 20 28 6e 6f ions!))..(if (no
c5e0: 74 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a t *didsomething*
c5f0: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
c600: 6e 74 20 30 20 68 65 6c 70 29 29 0a 0a 28 69 66 nt 0 help))..(if
c610: 20 28 6e 6f 74 20 28 65 71 3f 20 2a 67 6c 6f 62 (not (eq? *glob
c620: 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 30 29 alexitstatus* 0)
c630: 29 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 61 ). (if (or (a
c640: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
c650: 6e 74 65 73 74 73 22 29 28 61 72 67 73 3a 67 65 ntests")(args:ge
c660: 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 t-arg "-runall")
c670: 29 0a 20 20 20 20 20 20 20 20 28 62 65 67 69 6e ). (begin
c680: 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 . (deb
c690: 75 67 3a 70 72 69 6e 74 20 30 20 22 4e 4f 54 45 ug:print 0 "NOTE
c6a0: 3a 20 53 75 62 70 72 6f 63 65 73 73 65 73 20 77 : Subprocesses w
c6b0: 69 74 68 20 6e 6f 6e 2d 7a 65 72 6f 20 65 78 69 ith non-zero exi
c6c0: 74 20 63 6f 64 65 20 64 65 74 65 63 74 65 64 3a t code detected:
c6d0: 20 22 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 " *globalexitst
c6e0: 61 74 75 73 2a 29 0a 20 20 20 20 20 20 20 20 20 atus*).
c6f0: 20 20 28 65 78 69 74 20 30 29 29 0a 20 20 20 20 (exit 0)).
c700: 20 20 20 20 28 63 61 73 65 20 2a 67 6c 6f 62 61 (case *globa
c710: 6c 65 78 69 74 73 74 61 74 75 73 2a 0a 20 20 20 lexitstatus*.
c720: 20 20 20 20 20 20 28 28 30 29 28 65 78 69 74 20 ((0)(exit
c730: 30 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 31 0)). ((1
c740: 29 28 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 )(exit 1)).
c750: 20 20 20 20 28 28 32 29 28 65 78 69 74 20 32 29 ((2)(exit 2)
c760: 29 0a 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 ). (else
c770: 20 28 65 78 69 74 20 33 29 29 29 29 29 0a (exit 3))))).