0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 20 6-2012, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 made available
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 .;; greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 ng file COPYING
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 for details..;;
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 .;; This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c ven the.;; impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 ied warranty of
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 PARTICULAR.;;
0140: 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 20 28 69 6e PURPOSE...;; (in
0150: 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 2e 73 63 clude "common.sc
0160: 6d 22 29 0a 3b 3b 20 28 69 6e 63 6c 75 64 65 20 m").;; (include
0170: 22 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f "megatest-versio
0180: 6e 2e 73 63 6d 22 29 0a 0a 28 75 73 65 20 73 71 n.scm")..(use sq
0190: 6c 69 74 65 33 20 73 72 66 69 2d 31 20 70 6f 73 lite3 srfi-1 pos
01a0: 69 78 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 ix regex regex-c
01b0: 61 73 65 20 73 72 66 69 2d 36 39 20 62 61 73 65 ase srfi-69 base
01c0: 36 34 20 66 6f 72 6d 61 74 20 72 65 61 64 6c 69 64 format readli
01d0: 6e 65 20 61 70 72 6f 70 6f 73 29 20 3b 3b 20 28 ne apropos) ;; (
01e0: 73 72 66 69 20 31 38 29 20 65 78 74 72 61 73 29 srfi 18) extras)
01f0: 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 .(import (prefix
0200: 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 sqlite3 sqlite3
0210: 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 :)).(import (pre
0220: 66 69 78 20 62 61 73 65 36 34 20 62 61 73 65 36 fix base64 base6
0230: 34 3a 29 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 4:))..(declare (
0240: 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 uses common)).(d
0250: 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d 65 67 eclare (uses meg
0260: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 29 0a atest-version)).
0270: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
0280: 61 72 67 73 29 29 0a 28 64 65 63 6c 61 72 65 20 args)).(declare
0290: 28 75 73 65 73 20 72 75 6e 73 29 29 0a 28 64 65 (uses runs)).(de
02a0: 63 6c 61 72 65 20 28 75 73 65 73 20 6c 61 75 6e clare (uses laun
02b0: 63 68 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 ch)).(declare (u
02c0: 73 65 73 20 73 65 72 76 65 72 29 29 0a 28 64 65 ses server)).(de
02d0: 63 6c 61 72 65 20 28 75 73 65 73 20 74 65 73 74 clare (uses test
02e0: 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 s)).(declare (us
02f0: 65 73 20 67 65 6e 65 78 61 6d 70 6c 65 29 29 0a es genexample)).
0300: 0a 28 64 65 66 69 6e 65 20 2a 64 62 2a 20 23 66 .(define *db* #f
0310: 29 20 3b 3b 20 74 68 69 73 20 69 73 20 6f 6e 6c ) ;; this is onl
0320: 79 20 66 6f 72 20 74 68 65 20 72 65 70 6c 2c 20 y for the repl,
0330: 64 6f 20 6e 6f 74 20 75 73 65 20 69 6e 20 67 65 do not use in ge
0340: 6e 65 72 61 6c 21 21 21 21 0a 0a 28 69 6e 63 6c neral!!!!..(incl
0350: 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f ude "common_reco
0360: 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 rds.scm").(inclu
0370: 64 65 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e de "key_records.
0380: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
0390: 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 db_records.scm")
03a0: 0a 28 69 6e 63 6c 75 64 65 20 22 6d 65 67 61 74 .(include "megat
03b0: 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 2e est-fossil-hash.
03c0: 73 63 6d 22 29 0a 0a 28 64 65 66 69 6e 65 20 68 scm")..(define h
03d0: 65 6c 70 20 28 63 6f 6e 63 20 22 0a 4d 65 67 61 elp (conc ".Mega
03e0: 74 65 73 74 2c 20 64 6f 63 75 6d 65 6e 74 61 74 test, documentat
03f0: 69 6f 6e 20 61 74 20 68 74 74 70 3a 2f 2f 77 77 ion at http://ww
0400: 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 w.kiatoa.com/fos
0410: 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 0a 20 20 sils/megatest.
0420: 76 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 version " megate
0430: 73 74 2d 76 65 72 73 69 6f 6e 20 22 0a 20 20 6c st-version ". l
0440: 69 63 65 6e 73 65 20 47 50 4c 2c 20 43 6f 70 79 icense GPL, Copy
0450: 72 69 67 68 74 20 4d 61 74 74 20 57 65 6c 6c 61 right Matt Wella
0460: 6e 64 20 32 30 30 36 2d 32 30 31 32 0a 0a 55 73 nd 2006-2012..Us
0470: 61 67 65 3a 20 6d 65 67 61 74 65 73 74 20 5b 6f age: megatest [o
0480: 70 74 69 6f 6e 73 5d 0a 20 20 2d 68 20 20 20 20 ptions]. -h
0490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
04a0: 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a 0a 4c : this help..L
04b0: 61 75 6e 63 68 69 6e 67 20 61 6e 64 20 6d 61 6e aunching and man
04c0: 61 67 69 6e 67 20 72 75 6e 73 0a 20 20 2d 72 75 aging runs. -ru
04d0: 6e 61 6c 6c 20 20 20 20 20 20 20 20 20 20 20 20 nall
04e0: 20 20 20 20 20 3a 20 72 75 6e 20 61 6c 6c 20 74 : run all t
04f0: 65 73 74 73 20 74 68 61 74 20 61 72 65 20 6e 6f ests that are no
0500: 74 20 73 74 61 74 65 20 43 4f 4d 50 4c 45 54 45 t state COMPLETE
0510: 44 20 61 6e 64 20 73 74 61 74 75 73 20 50 41 53 D and status PAS
0520: 53 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 S, .
0530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0540: 43 48 45 43 4b 20 6f 72 20 4b 49 4c 4c 45 44 0a CHECK or KILLED.
0550: 20 20 2d 72 75 6e 74 65 73 74 73 20 74 73 74 31 -runtests tst1
0560: 2c 74 73 74 32 20 2e 2e 2e 20 3a 20 72 75 6e 20 ,tst2 ... : run
0570: 74 65 73 74 73 0a 20 20 2d 72 65 6d 6f 76 65 2d tests. -remove-
0580: 72 75 6e 73 20 20 20 20 20 20 20 20 20 20 20 20 runs
0590: 3a 20 72 65 6d 6f 76 65 20 74 68 65 20 64 61 74 : remove the dat
05a0: 61 20 66 6f 72 20 61 20 72 75 6e 2c 20 72 65 71 a for a run, req
05b0: 75 69 72 65 73 20 3a 72 75 6e 6e 61 6d 65 2c 20 uires :runname,
05c0: 2d 74 65 73 74 70 61 74 74 20 61 6e 64 0a 20 20 -testpatt and.
05d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05e0: 20 20 20 20 20 20 20 20 20 20 2d 69 74 65 6d 70 -itemp
05f0: 61 74 74 20 62 65 20 73 65 74 2e 20 4f 70 74 69 att be set. Opti
0600: 6f 6e 61 6c 6c 79 20 75 73 65 20 3a 73 74 61 74 onally use :stat
0610: 65 20 61 6e 64 20 3a 73 74 61 74 75 73 0a 20 20 e and :status.
0620: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
0630: 73 20 58 2c 59 20 20 20 3a 20 73 65 74 20 73 74 s X,Y : set st
0640: 61 74 65 20 74 6f 20 58 20 61 6e 64 20 73 74 61 ate to X and sta
0650: 74 75 73 20 74 6f 20 59 2c 20 72 65 71 75 69 72 tus to Y, requir
0660: 65 73 20 63 6f 6e 74 72 6f 6c 73 20 70 65 72 20 es controls per
0670: 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 0a 20 20 2d -remove-runs. -
0680: 72 65 72 75 6e 20 46 41 49 4c 2c 57 41 52 4e 2e rerun FAIL,WARN.
0690: 2e 2e 20 20 20 20 20 3a 20 66 6f 72 63 65 20 72 .. : force r
06a0: 65 2d 72 75 6e 20 66 6f 72 20 74 65 73 74 73 20 e-run for tests
06b0: 77 69 74 68 20 73 70 65 63 69 66 69 63 65 64 20 with specificed
06c0: 73 74 61 74 75 73 28 73 29 0a 20 20 2d 72 6f 6c status(s). -rol
06d0: 6c 75 70 20 20 20 20 20 20 20 20 20 20 20 20 20 lup
06e0: 20 20 20 20 3a 20 66 69 6c 6c 20 72 75 6e 20 28 : fill run (
06f0: 73 65 74 20 62 79 20 3a 72 75 6e 6e 61 6d 65 29 set by :runname)
0700: 20 20 77 69 74 68 20 6c 61 74 65 73 74 20 74 65 with latest te
0710: 73 74 28 73 29 20 66 72 6f 6d 0a 20 20 20 20 20 st(s) from.
0720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0730: 20 20 20 20 20 20 20 70 72 69 6f 72 20 72 75 6e prior run
0740: 73 20 77 69 74 68 20 73 61 6d 65 20 6b 65 79 73 s with same keys
0750: 0a 20 20 2d 6c 6f 63 6b 20 20 20 20 20 20 20 20 . -lock
0760: 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 6f 63 : loc
0770: 6b 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 20 k run specified
0780: 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 75 by target and ru
0790: 6e 6e 61 6d 65 0a 20 20 2d 75 6e 6c 6f 63 6b 20 nname. -unlock
07a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
07b0: 3a 20 75 6e 6c 6f 63 6b 20 72 75 6e 20 73 70 65 : unlock run spe
07c0: 63 69 66 69 65 64 20 62 79 20 74 61 72 67 65 74 cified by target
07d0: 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 0a 53 65 and runname..Se
07e0: 6c 65 63 74 6f 72 73 20 28 65 2e 67 2e 20 75 73 lectors (e.g. us
07f0: 65 20 66 6f 72 20 2d 72 75 6e 74 65 73 74 73 2c e for -runtests,
0800: 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 2c 20 2d -remove-runs, -
0810: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
0820: 2c 20 2d 6c 69 73 74 2d 72 75 6e 73 20 65 74 63 , -list-runs etc
0830: 2e 29 0a 20 20 2d 74 61 72 67 65 74 20 6b 65 79 .). -target key
0840: 31 2f 6b 65 79 32 2f 2e 2e 2e 20 20 20 3a 20 72 1/key2/... : r
0850: 75 6e 20 66 6f 72 20 6b 65 79 31 2c 20 6b 65 79 un for key1, key
0860: 32 2c 20 65 74 63 2e 0a 20 20 2d 72 65 71 74 61 2, etc.. -reqta
0870: 72 67 20 6b 65 79 31 2f 6b 65 79 32 2f 2e 2e 2e rg key1/key2/...
0880: 20 20 3a 20 72 75 6e 20 66 6f 72 20 6b 65 79 31 : run for key1
0890: 2c 20 6b 65 79 32 2c 20 65 74 63 2e 20 62 75 74 , key2, etc. but
08a0: 20 6b 65 79 31 2f 6b 65 79 32 20 6d 75 73 74 20 key1/key2 must
08b0: 62 65 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 0a be in runconfig.
08c0: 20 20 2d 74 65 73 74 70 61 74 74 20 70 61 74 74 -testpatt patt
08d0: 20 20 20 20 20 20 20 20 20 20 3a 20 25 20 69 73 : % is
08e0: 20 77 69 6c 64 63 61 72 64 0a 20 20 2d 69 74 65 wildcard. -ite
08f0: 6d 70 61 74 74 20 70 61 74 74 20 20 20 20 20 20 mpatt patt
0900: 20 20 20 20 3a 20 25 20 69 73 20 77 69 6c 64 63 : % is wildc
0910: 61 72 64 0a 20 20 3a 72 75 6e 6e 61 6d 65 20 20 ard. :runname
0920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
0930: 72 65 71 75 69 72 65 64 2c 20 6e 61 6d 65 20 66 required, name f
0940: 6f 72 20 74 68 69 73 20 70 61 72 74 69 63 75 6c or this particul
0950: 61 72 20 74 65 73 74 20 72 75 6e 0a 20 20 3a 73 ar test run. :s
0960: 74 61 74 65 20 20 20 20 20 20 20 20 20 20 20 20 tate
0970: 20 20 20 20 20 20 3a 20 41 70 70 6c 69 65 73 20 : Applies
0980: 74 6f 20 72 75 6e 73 2c 20 74 65 73 74 73 20 6f to runs, tests o
0990: 72 20 73 74 65 70 73 20 64 65 70 65 6e 64 69 6e r steps dependin
09a0: 67 20 6f 6e 20 63 6f 6e 74 65 78 74 0a 20 20 3a g on context. :
09b0: 73 74 61 74 75 73 20 20 20 20 20 20 20 20 20 20 status
09c0: 20 20 20 20 20 20 20 3a 20 41 70 70 6c 69 65 73 : Applies
09d0: 20 74 6f 20 72 75 6e 73 2c 20 74 65 73 74 73 20 to runs, tests
09e0: 6f 72 20 73 74 65 70 73 20 64 65 70 65 6e 64 69 or steps dependi
09f0: 6e 67 20 6f 6e 20 63 6f 6e 74 65 78 74 0a 0a 54 ng on context..T
0a00: 65 73 74 20 68 65 6c 70 65 72 73 20 28 66 6f 72 est helpers (for
0a10: 20 75 73 65 20 69 6e 73 69 64 65 20 74 65 73 74 use inside test
0a20: 73 29 0a 20 20 2d 73 74 65 70 20 73 74 65 70 6e s). -step stepn
0a30: 61 6d 65 0a 20 20 2d 74 65 73 74 2d 73 74 61 74 ame. -test-stat
0a40: 75 73 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 us :
0a50: 73 65 74 20 74 68 65 20 73 74 61 74 65 20 61 6e set the state an
0a60: 64 20 73 74 61 74 75 73 20 6f 66 20 61 20 74 65 d status of a te
0a70: 73 74 20 28 75 73 65 20 3a 73 74 61 74 65 20 61 st (use :state a
0a80: 6e 64 20 3a 73 74 61 74 75 73 29 0a 20 20 2d 73 nd :status). -s
0a90: 65 74 6c 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 20 etlog logfname
0aa0: 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 : set the
0ab0: 70 61 74 68 2f 66 69 6c 65 6e 61 6d 65 20 74 6f path/filename to
0ac0: 20 74 68 65 20 66 69 6e 61 6c 20 6c 6f 67 20 72 the final log r
0ad0: 65 6c 61 74 69 76 65 20 74 6f 20 74 68 65 20 74 elative to the t
0ae0: 65 73 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 est.
0af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b00: 64 69 72 65 63 74 6f 72 79 2e 20 6d 61 79 20 62 directory. may b
0b10: 65 20 75 73 65 64 20 77 69 74 68 20 2d 74 65 73 e used with -tes
0b20: 74 2d 73 74 61 74 75 73 0a 20 20 2d 73 65 74 2d t-status. -set-
0b30: 74 6f 70 6c 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 toplog logfname
0b40: 20 20 20 3a 20 73 65 74 20 74 68 65 20 6f 76 65 : set the ove
0b50: 72 61 6c 6c 20 6c 6f 67 20 66 6f 72 20 61 20 73 rall log for a s
0b60: 75 69 74 65 20 6f 66 20 73 75 62 2d 74 65 73 74 uite of sub-test
0b70: 73 0a 20 20 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 s. -summarize-i
0b80: 74 65 6d 73 20 20 20 20 20 20 20 20 3a 20 66 6f tems : fo
0b90: 72 20 61 6e 20 69 74 65 6d 69 7a 65 64 20 74 65 r an itemized te
0ba0: 73 74 20 63 72 65 61 74 65 20 61 20 73 75 6d 6d st create a summ
0bb0: 61 72 79 20 68 74 6d 6c 20 0a 20 20 2d 6d 20 63 ary html . -m c
0bc0: 6f 6d 6d 65 6e 74 20 20 20 20 20 20 20 20 20 20 omment
0bd0: 20 20 20 20 3a 20 69 6e 73 65 72 74 20 61 20 63 : insert a c
0be0: 6f 6d 6d 65 6e 74 20 66 6f 72 20 74 68 69 73 20 omment for this
0bf0: 74 65 73 74 0a 0a 54 65 73 74 20 64 61 74 61 20 test..Test data
0c00: 63 61 70 74 75 72 65 0a 20 20 2d 73 65 74 2d 76 capture. -set-v
0c10: 61 6c 75 65 73 20 20 20 20 20 20 20 20 20 20 20 alues
0c20: 20 20 3a 20 75 70 64 61 74 65 20 6f 72 20 73 65 : update or se
0c30: 74 20 76 61 6c 75 65 73 20 69 6e 20 74 68 65 20 t values in the
0c40: 74 65 73 74 64 61 74 61 20 74 61 62 6c 65 0a 20 testdata table.
0c50: 20 3a 63 61 74 65 67 6f 72 79 20 20 20 20 20 20 :category
0c60: 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 : set t
0c70: 68 65 20 63 61 74 65 67 6f 72 79 20 66 69 65 6c he category fiel
0c80: 64 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a d (optional). :
0c90: 76 61 72 69 61 62 6c 65 20 20 20 20 20 20 20 20 variable
0ca0: 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 : set the
0cb0: 20 76 61 72 69 61 62 6c 65 20 6e 61 6d 65 20 28 variable name (
0cc0: 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 6c optional). :val
0cd0: 75 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ue
0ce0: 20 20 20 20 3a 20 76 61 6c 75 65 20 6d 65 61 73 : value meas
0cf0: 75 72 65 64 20 28 72 65 71 75 69 72 65 64 29 0a ured (required).
0d00: 20 20 3a 65 78 70 65 63 74 65 64 20 20 20 20 20 :expected
0d10: 20 20 20 20 20 20 20 20 20 20 3a 20 76 61 6c 75 : valu
0d20: 65 20 65 78 70 65 63 74 65 64 20 28 72 65 71 75 e expected (requ
0d30: 69 72 65 64 29 0a 20 20 3a 74 6f 6c 20 20 20 20 ired). :tol
0d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d50: 3a 20 7c 76 61 6c 75 65 2d 65 78 70 65 63 74 7c : |value-expect|
0d60: 20 3c 3d 20 74 6f 6c 20 28 72 65 71 75 69 72 65 <= tol (require
0d70: 64 2c 20 63 61 6e 20 62 65 20 3c 2c 20 3e 2c 20 d, can be <, >,
0d80: 3e 3d 2c 20 3c 3d 20 6f 72 20 6e 75 6d 62 65 72 >=, <= or number
0d90: 29 0a 20 20 3a 75 6e 69 74 73 20 20 20 20 20 20 ). :units
0da0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6e 61 : na
0db0: 6d 65 20 6f 66 20 74 68 65 20 75 6e 69 74 73 20 me of the units
0dc0: 66 6f 72 20 76 61 6c 75 65 2c 20 65 78 70 65 63 for value, expec
0dd0: 74 65 64 5f 76 61 6c 75 65 20 65 74 63 2e 20 28 ted_value etc. (
0de0: 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 2d 6c 6f 61 optional). -loa
0df0: 64 2d 74 65 73 74 2d 64 61 74 61 20 20 20 20 20 d-test-data
0e00: 20 20 20 20 3a 20 72 65 61 64 20 74 65 73 74 20 : read test
0e10: 73 70 65 63 69 66 69 63 20 64 61 74 61 20 66 6f specific data fo
0e20: 72 20 73 74 6f 72 61 67 65 20 69 6e 20 74 68 65 r storage in the
0e30: 20 74 65 73 74 5f 64 61 74 61 20 74 61 62 6c 65 test_data table
0e40: 0a 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 20 66 72 6f fro
0e60: 6d 20 73 74 61 6e 64 61 72 64 20 69 6e 2e 20 45 m standard in. E
0e70: 61 63 68 20 6c 69 6e 65 20 69 73 20 63 6f 6d 6d ach line is comm
0e80: 61 20 64 65 6c 69 6d 69 74 65 64 20 77 69 74 68 a delimited with
0e90: 20 66 6f 75 72 0a 20 20 20 20 20 20 20 20 20 20 four.
0ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0eb0: 20 20 66 69 65 6c 64 73 20 63 61 74 65 67 6f 72 fields categor
0ec0: 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 6c 75 65 y,variable,value
0ed0: 2c 63 6f 6d 6d 65 6e 74 0a 0a 51 75 65 72 69 65 ,comment..Querie
0ee0: 73 0a 20 20 2d 6c 69 73 74 2d 72 75 6e 73 20 70 s. -list-runs p
0ef0: 61 74 74 20 20 20 20 20 20 20 20 20 3a 20 6c 69 att : li
0f00: 73 74 20 72 75 6e 73 20 6d 61 74 63 68 69 6e 67 st runs matching
0f10: 20 70 61 74 74 65 72 6e 20 5c 22 70 61 74 74 5c pattern \"patt\
0f20: 22 2c 20 25 20 69 73 20 74 68 65 20 77 69 6c 64 ", % is the wild
0f30: 63 61 72 64 0a 20 20 2d 73 68 6f 77 6b 65 79 73 card. -showkeys
0f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0f50: 20 73 68 6f 77 20 74 68 65 20 6b 65 79 73 20 75 show the keys u
0f60: 73 65 64 20 69 6e 20 74 68 69 73 20 6d 65 67 61 sed in this mega
0f70: 74 65 73 74 20 73 65 74 75 70 0a 20 20 2d 74 65 test setup. -te
0f80: 73 74 2d 66 69 6c 65 73 20 74 61 72 67 70 61 74 st-files targpat
0f90: 74 20 20 20 20 20 3a 20 67 65 74 20 74 68 65 20 t : get the
0fa0: 6d 6f 73 74 20 72 65 63 65 6e 74 20 74 65 73 74 most recent test
0fb0: 20 70 61 74 68 2f 66 69 6c 65 20 6d 61 74 63 68 path/file match
0fc0: 69 6e 67 20 74 61 72 67 70 61 74 74 20 65 2e 67 ing targpatt e.g
0fd0: 2e 20 25 2f 25 2e 2e 2e 20 0a 20 20 20 20 20 20 . %/%... .
0fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ff0: 20 20 20 20 20 20 72 65 74 75 72 6e 73 20 6c 69 returns li
1000: 73 74 20 73 6f 72 74 65 64 20 62 79 20 61 67 65 st sorted by age
1010: 20 61 73 63 65 6e 64 69 6e 67 2c 20 73 65 65 20 ascending, see
1020: 65 78 61 6d 70 6c 65 73 20 62 65 6c 6f 77 0a 20 examples below.
1030: 20 2d 74 65 73 74 2d 70 61 74 68 73 20 20 20 20 -test-paths
1040: 20 20 20 20 20 20 20 20 20 3a 20 67 65 74 20 74 : get t
1050: 68 65 20 74 65 73 74 20 70 61 74 68 73 20 6d 61 he test paths ma
1060: 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 tching target, r
1070: 75 6e 6e 61 6d 65 2c 20 69 74 65 6d 20 61 6e 64 unname, item and
1080: 20 74 65 73 74 0a 20 20 20 20 20 20 20 20 20 20 test.
1090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10a0: 20 20 70 61 74 74 65 72 6e 73 2e 0a 0a 4d 69 73 patterns...Mis
10b0: 63 20 0a 20 20 2d 72 65 62 75 69 6c 64 2d 64 62 c . -rebuild-db
10c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 62 : b
10d0: 72 69 6e 67 20 74 68 65 20 64 61 74 61 62 61 73 ring the databas
10e0: 65 20 73 63 68 65 6d 61 20 75 70 20 74 6f 20 64 e schema up to d
10f0: 61 74 65 0a 20 20 2d 75 70 64 61 74 65 2d 6d 65 ate. -update-me
1100: 74 61 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 ta :
1110: 75 70 64 61 74 65 20 74 68 65 20 74 65 73 74 73 update the tests
1120: 20 6d 65 74 61 64 61 74 61 20 66 6f 72 20 61 6c metadata for al
1130: 6c 20 74 65 73 74 73 0a 20 20 2d 65 6e 76 32 66 l tests. -env2f
1140: 69 6c 65 20 66 6e 61 6d 65 20 20 20 20 20 20 20 ile fname
1150: 20 20 3a 20 77 72 69 74 65 20 74 68 65 20 65 6e : write the en
1160: 76 69 72 6f 6e 6d 65 6e 74 20 74 6f 20 66 6e 61 vironment to fna
1170: 6d 65 2e 63 73 68 20 61 6e 64 20 66 6e 61 6d 65 me.csh and fname
1180: 2e 73 68 0a 20 20 2d 73 65 74 76 61 72 73 20 56 .sh. -setvars V
1190: 41 52 31 3d 76 61 6c 31 2c 56 41 52 32 3d 76 61 AR1=val1,VAR2=va
11a0: 6c 32 20 3a 20 41 64 64 20 65 6e 76 69 72 6f 6e l2 : Add environ
11b0: 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 20 74 ment variables t
11c0: 6f 20 61 20 72 75 6e 20 4e 42 2f 2f 20 74 68 65 o a run NB// the
11d0: 73 65 20 61 72 65 0a 20 20 20 20 20 20 20 20 20 se are.
11e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11f0: 20 20 20 20 20 20 20 20 6f 76 65 72 77 72 69 74 overwrit
1200: 74 65 6e 20 62 79 20 76 61 6c 75 65 73 20 73 65 ten by values se
1210: 74 20 69 6e 20 63 6f 6e 66 69 67 20 66 69 6c 65 t in config file
1220: 73 2e 0a 20 20 2d 73 65 72 76 65 72 20 2d 7c 68 s.. -server -|h
1230: 6f 73 74 6e 61 6d 65 20 20 20 20 20 20 3a 20 73 ostname : s
1240: 74 61 72 74 20 74 68 65 20 73 65 72 76 65 72 20 tart the server
1250: 28 72 65 64 75 63 65 73 20 63 6f 6e 74 65 6e 74 (reduces content
1260: 69 6f 6e 20 6f 6e 20 6d 65 67 61 74 65 73 74 2e ion on megatest.
1270: 64 62 29 2c 20 75 73 65 0a 20 20 20 20 20 20 20 db), use.
1280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1290: 20 20 20 20 20 2d 20 74 6f 20 61 75 74 6f 6d 61 - to automa
12a0: 74 69 63 61 6c 6c 79 20 66 69 67 75 72 65 20 6f tically figure o
12b0: 75 74 20 68 6f 73 74 6e 61 6d 65 0a 20 20 2d 72 ut hostname. -r
12c0: 65 70 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 epl
12d0: 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 61 20 : start a
12e0: 72 65 70 6c 20 28 75 73 65 66 75 6c 20 66 6f 72 repl (useful for
12f0: 20 65 78 74 65 6e 64 69 6e 67 20 6d 65 67 61 74 extending megat
1300: 65 73 74 29 0a 0a 53 70 72 65 61 64 73 68 65 65 est)..Spreadshee
1310: 74 20 67 65 6e 65 72 61 74 69 6f 6e 0a 20 20 2d t generation. -
1320: 65 78 74 72 61 63 74 2d 6f 64 73 20 66 6e 61 6d extract-ods fnam
1330: 65 2e 6f 64 73 20 20 3a 20 65 78 74 72 61 63 74 e.ods : extract
1340: 20 61 6e 20 6f 70 65 6e 20 64 6f 63 75 6d 65 6e an open documen
1350: 74 20 73 70 72 65 61 64 73 68 65 65 74 20 66 72 t spreadsheet fr
1360: 6f 6d 20 74 68 65 20 64 61 74 61 62 61 73 65 0a om the database.
1370: 20 20 2d 70 61 74 68 6d 6f 64 20 70 61 74 68 20 -pathmod path
1380: 20 20 20 20 20 20 20 20 20 20 3a 20 69 6e 73 65 : inse
1390: 72 74 20 70 61 74 68 2c 20 69 2e 65 2e 20 70 61 rt path, i.e. pa
13a0: 74 68 2f 72 75 6e 61 6d 65 2f 69 74 65 6d 70 61 th/runame/itempa
13b0: 74 68 2f 6c 6f 67 66 69 6c 65 2e 68 74 6d 6c 0a th/logfile.html.
13c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13d0: 20 20 20 20 20 20 20 20 20 20 20 20 77 69 6c 6c will
13e0: 20 63 6c 65 61 72 20 74 68 65 20 66 69 65 6c 64 clear the field
13f0: 20 69 66 20 6e 6f 20 72 75 6e 64 69 72 2f 74 65 if no rundir/te
1400: 73 74 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f stname/itempath/
1410: 6c 6f 67 66 69 6c 65 0a 20 20 20 20 20 20 20 20 logfile.
1420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1430: 20 20 20 20 69 66 20 69 74 20 63 6f 6e 74 61 69 if it contai
1440: 6e 73 20 66 6f 72 77 61 72 64 20 73 6c 61 73 68 ns forward slash
1450: 65 73 20 74 68 65 20 70 61 74 68 20 77 69 6c 6c es the path will
1460: 20 62 65 20 63 6f 6e 76 65 72 74 65 64 0a 20 20 be converted.
1470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1480: 20 20 20 20 20 20 20 20 20 20 74 6f 20 77 69 6e to win
1490: 64 6f 77 73 20 73 74 79 6c 65 0a 47 65 74 74 69 dows style.Getti
14a0: 6e 67 20 73 74 61 72 74 65 64 0a 20 20 2d 67 65 ng started. -ge
14b0: 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 20 n-megatest-area
14c0: 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 61 20 : create a
14d0: 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 skeleton megates
14e0: 74 20 61 72 65 61 2e 20 59 6f 75 20 77 69 6c 6c t area. You will
14f0: 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 be prompted for
1500: 20 70 61 74 68 73 0a 20 20 2d 67 65 6e 2d 6d 65 paths. -gen-me
1510: 67 61 74 65 73 74 2d 74 65 73 74 20 20 20 20 20 gatest-test
1520: 20 3a 20 63 72 65 61 74 65 20 61 20 73 6b 65 6c : create a skel
1530: 65 74 6f 6e 20 6d 65 67 61 74 65 73 74 20 74 65 eton megatest te
1540: 73 74 2e 20 59 6f 75 20 77 69 6c 6c 20 62 65 20 st. You will be
1550: 70 72 6f 6d 70 74 65 64 20 66 6f 72 20 69 6e 66 prompted for inf
1560: 6f 0a 0a 45 78 61 6d 70 6c 65 73 0a 0a 23 20 47 o..Examples..# G
1570: 65 74 20 74 65 73 74 20 70 61 74 68 2c 20 75 73 et test path, us
1580: 65 20 27 2e 27 20 74 6f 20 67 65 74 20 61 20 73 e '.' to get a s
1590: 69 6e 67 6c 65 20 70 61 74 68 20 6f 72 20 61 20 ingle path or a
15a0: 73 70 65 63 69 66 69 63 20 70 61 74 68 2f 66 69 specific path/fi
15b0: 6c 65 20 70 61 74 74 65 72 6e 0a 6d 65 67 61 74 le pattern.megat
15c0: 65 73 74 20 2d 74 65 73 74 2d 66 69 6c 65 73 20 est -test-files
15d0: 27 6c 6f 67 73 2f 2a 2e 6c 6f 67 27 20 2d 74 61 'logs/*.log' -ta
15e0: 72 67 65 74 20 75 62 75 6e 74 75 2f 6e 25 2f 6e rget ubuntu/n%/n
15f0: 6f 25 20 3a 72 75 6e 6e 61 6d 65 20 77 34 39 25 o% :runname w49%
1600: 20 2d 74 65 73 74 70 61 74 74 20 74 65 73 74 5f -testpatt test_
1610: 6d 74 25 0a 0a 43 61 6c 6c 65 64 20 61 73 20 22 mt%..Called as "
1620: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
1630: 65 72 73 65 20 28 61 72 67 76 29 20 22 20 22 29 erse (argv) " ")
1640: 20 22 0a 42 75 69 6c 74 20 66 72 6f 6d 20 22 20 ".Built from "
1650: 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d megatest-fossil-
1660: 68 61 73 68 20 29 29 0a 0a 3b 3b 20 20 2d 67 75 hash ))..;; -gu
1670: 69 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 i
1680: 20 20 20 20 20 3a 20 73 74 61 72 74 20 61 20 67 : start a g
1690: 75 69 20 69 6e 74 65 72 66 61 63 65 0a 3b 3b 20 ui interface.;;
16a0: 20 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 20 -config fname
16b0: 20 20 20 20 20 20 20 20 20 3a 20 6f 76 65 72 72 : overr
16c0: 69 64 65 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 ide the runconfi
16d0: 67 20 66 69 6c 65 20 77 69 74 68 20 66 6e 61 6d g file with fnam
16e0: 65 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 20 61 72 e..;; process ar
16f0: 67 73 0a 28 64 65 66 69 6e 65 20 72 65 6d 61 72 gs.(define remar
1700: 67 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 gs (args:get-arg
1710: 73 20 0a 09 09 20 28 61 72 67 76 29 0a 09 09 20 s ... (argv)...
1720: 28 6c 69 73 74 20 20 22 2d 72 75 6e 74 65 73 74 (list "-runtest
1730: 73 22 20 20 3b 3b 20 72 75 6e 20 61 20 73 70 65 s" ;; run a spe
1740: 63 69 66 69 63 20 74 65 73 74 0a 09 09 09 22 2d cific test...."-
1750: 63 6f 6e 66 69 67 22 20 20 20 20 3b 3b 20 6f 76 config" ;; ov
1760: 65 72 72 69 64 65 20 74 68 65 20 63 6f 6e 66 69 erride the confi
1770: 67 20 66 69 6c 65 20 6e 61 6d 65 0a 09 09 09 22 g file name...."
1780: 2d 65 78 65 63 75 74 65 22 20 20 20 3b 3b 20 72 -execute" ;; r
1790: 75 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 65 un the command e
17a0: 6e 63 6f 64 65 64 20 69 6e 20 74 68 65 20 62 61 ncoded in the ba
17b0: 73 65 36 34 20 70 61 72 61 6d 65 74 65 72 0a 09 se64 parameter..
17c0: 09 09 22 2d 73 74 65 70 22 0a 09 09 09 22 3a 72 .."-step"....":r
17d0: 75 6e 6e 61 6d 65 22 20 20 20 0a 09 09 09 22 2d unname" ...."-
17e0: 74 61 72 67 65 74 22 0a 09 09 09 22 2d 72 65 71 target"...."-req
17f0: 74 61 72 67 22 0a 09 09 09 22 3a 69 74 65 6d 22 targ"....":item"
1800: 0a 09 09 09 22 3a 72 75 6e 6e 61 6d 65 22 20 20 ....":runname"
1810: 20 0a 09 09 09 22 3a 73 74 61 74 65 22 20 20 0a ....":state" .
1820: 09 09 09 22 3a 73 74 61 74 75 73 22 0a 09 09 09 ...":status"....
1830: 22 2d 6c 69 73 74 2d 72 75 6e 73 22 0a 09 09 09 "-list-runs"....
1840: 22 2d 74 65 73 74 70 61 74 74 22 20 0a 09 09 09 "-testpatt" ....
1850: 22 2d 69 74 65 6d 70 61 74 74 22 0a 09 09 09 22 "-itempatt"...."
1860: 2d 73 65 74 6c 6f 67 22 0a 09 09 09 22 2d 73 65 -setlog"...."-se
1870: 74 2d 74 6f 70 6c 6f 67 22 0a 09 09 09 22 2d 72 t-toplog"...."-r
1880: 75 6e 73 74 65 70 22 0a 09 09 09 22 2d 6c 6f 67 unstep"...."-log
1890: 70 72 6f 22 0a 09 09 09 22 2d 6d 22 0a 09 09 09 pro"...."-m"....
18a0: 22 2d 72 65 72 75 6e 22 0a 09 09 09 22 2d 64 61 "-rerun"...."-da
18b0: 79 73 22 0a 09 09 09 22 2d 72 65 6e 61 6d 65 2d ys"...."-rename-
18c0: 72 75 6e 22 0a 09 09 09 22 2d 74 6f 22 0a 09 09 run"...."-to"...
18d0: 09 3b 3b 20 76 61 6c 75 65 73 20 61 6e 64 20 6d .;; values and m
18e0: 65 73 73 61 67 65 73 0a 09 09 09 22 3a 63 61 74 essages....":cat
18f0: 65 67 6f 72 79 22 0a 09 09 09 22 3a 76 61 72 69 egory"....":vari
1900: 61 62 6c 65 22 0a 09 09 09 22 3a 76 61 6c 75 65 able"....":value
1910: 22 0a 09 09 09 22 3a 65 78 70 65 63 74 65 64 22 "....":expected"
1920: 0a 09 09 09 22 3a 74 6f 6c 22 0a 09 09 09 22 3a ....":tol"....":
1930: 75 6e 69 74 73 22 0a 09 09 09 3b 3b 20 6d 69 73 units"....;; mis
1940: 63 0a 09 09 09 22 2d 73 65 72 76 65 72 22 0a 09 c...."-server"..
1950: 09 09 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 .."-extract-ods"
1960: 0a 09 09 09 22 2d 70 61 74 68 6d 6f 64 22 0a 09 ...."-pathmod"..
1970: 09 09 22 2d 65 6e 76 32 66 69 6c 65 22 0a 09 09 .."-env2file"...
1980: 09 22 2d 73 65 74 76 61 72 73 22 0a 09 09 09 22 ."-setvars"...."
1990: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
19a0: 73 22 0a 09 09 09 22 2d 64 65 62 75 67 22 20 3b s"...."-debug" ;
19b0: 3b 20 66 6f 72 20 2a 76 65 72 62 6f 73 69 74 79 ; for *verbosity
19c0: 2a 20 3e 20 32 0a 09 09 09 22 2d 67 65 6e 2d 6d * > 2...."-gen-m
19d0: 65 67 61 74 65 73 74 2d 74 65 73 74 22 0a 09 09 egatest-test"...
19e0: 09 22 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 ."-override-time
19f0: 6f 75 74 22 0a 09 09 09 22 2d 74 65 73 74 2d 66 out"...."-test-f
1a00: 69 6c 65 73 22 20 20 3b 3b 20 2d 74 65 73 74 2d iles" ;; -test-
1a10: 70 61 74 68 73 20 69 73 20 66 6f 72 20 6c 69 73 paths is for lis
1a20: 74 69 6e 67 20 61 6c 6c 0a 09 09 09 29 20 0a 09 ting all....) ..
1a30: 09 20 28 6c 69 73 74 20 20 22 2d 68 22 0a 09 09 . (list "-h"...
1a40: 20 20 20 20 20 20 20 20 22 2d 66 6f 72 63 65 22 "-force"
1a50: 0a 09 09 20 20 20 20 20 20 20 20 22 2d 78 74 65 ... "-xte
1a60: 72 6d 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d rm"... "-
1a70: 73 68 6f 77 6b 65 79 73 22 0a 09 09 20 20 20 20 showkeys"...
1a80: 20 20 20 20 22 2d 74 65 73 74 2d 73 74 61 74 75 "-test-statu
1a90: 73 22 0a 09 09 09 22 2d 73 65 74 2d 76 61 6c 75 s"...."-set-valu
1aa0: 65 73 22 0a 09 09 09 22 2d 6c 6f 61 64 2d 74 65 es"...."-load-te
1ab0: 73 74 2d 64 61 74 61 22 0a 09 09 09 22 2d 73 75 st-data"...."-su
1ac0: 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 0a 09 mmarize-items"..
1ad0: 09 20 20 20 20 20 20 20 20 22 2d 67 75 69 22 0a . "-gui".
1ae0: 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 09 22 2d ...;; misc...."-
1af0: 61 72 63 68 69 76 65 22 0a 09 09 09 22 2d 72 65 archive"...."-re
1b00: 70 6c 22 0a 09 09 09 22 2d 6c 6f 63 6b 22 0a 09 pl"...."-lock"..
1b10: 09 09 22 2d 75 6e 6c 6f 63 6b 22 0a 09 09 09 3b .."-unlock"....;
1b20: 3b 20 71 75 65 72 69 65 73 0a 09 09 09 22 2d 74 ; queries...."-t
1b30: 65 73 74 2d 70 61 74 68 73 22 20 3b 3b 20 67 65 est-paths" ;; ge
1b40: 74 20 70 61 74 68 28 73 29 20 74 6f 20 61 20 74 t path(s) to a t
1b50: 65 73 74 2c 20 6f 72 64 65 72 65 64 20 62 79 20 est, ordered by
1b60: 79 6f 75 6e 67 65 73 74 20 66 69 72 73 74 0a 0a youngest first..
1b70: 09 09 09 22 2d 72 75 6e 61 6c 6c 22 20 20 20 20 ..."-runall"
1b80: 3b 3b 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 ;; run all tests
1b90: 0a 09 09 09 22 2d 72 65 6d 6f 76 65 2d 72 75 6e ...."-remove-run
1ba0: 73 22 0a 09 09 09 22 2d 75 73 65 71 75 65 75 65 s"...."-usequeue
1bb0: 22 0a 09 09 09 22 2d 72 65 62 75 69 6c 64 2d 64 "...."-rebuild-d
1bc0: 62 22 0a 09 09 09 22 2d 72 6f 6c 6c 75 70 22 0a b"...."-rollup".
1bd0: 09 09 09 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 ..."-update-meta
1be0: 22 0a 09 09 09 22 2d 67 65 6e 2d 6d 65 67 61 74 "...."-gen-megat
1bf0: 65 73 74 2d 61 72 65 61 22 0a 0a 09 09 09 22 2d est-area"....."-
1c00: 76 22 20 3b 3b 20 76 65 72 62 6f 73 65 20 32 2c v" ;; verbose 2,
1c10: 20 6d 6f 72 65 20 74 68 61 6e 20 6e 6f 72 6d 61 more than norma
1c20: 6c 20 28 6e 6f 72 6d 61 6c 20 69 73 20 31 29 0a l (normal is 1).
1c30: 09 09 09 22 2d 71 22 20 3b 3b 20 71 75 69 65 74 ..."-q" ;; quiet
1c40: 20 30 2c 20 65 72 72 6f 72 73 2f 77 61 72 6e 69 0, errors/warni
1c50: 6e 67 73 20 6f 6e 6c 79 0a 09 09 20 20 20 20 20 ngs only...
1c60: 20 20 29 0a 09 09 20 61 72 67 73 3a 61 72 67 2d )... args:arg-
1c70: 68 61 73 68 0a 09 09 20 30 29 29 0a 0a 28 69 66 hash... 0))..(if
1c80: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
1c90: 2d 68 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a -h"). (begin.
1ca0: 20 20 20 20 20 20 28 70 72 69 6e 74 20 68 65 6c (print hel
1cb0: 70 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 p). (exit))
1cc0: 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 69 64 73 )..(define *dids
1cd0: 6f 6d 65 74 68 69 6e 67 2a 20 23 66 29 0a 0a 3b omething* #f)..;
1ce0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
1cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1d20: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 20 =======.;; Misc
1d30: 73 65 74 75 70 20 73 74 75 66 66 0a 3b 3b 3d 3d setup stuff.;;==
1d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1d80: 3d 3d 3d 3d 0a 0a 28 73 65 74 21 20 2a 76 65 72 ====..(set! *ver
1d90: 62 6f 73 69 74 79 2a 20 28 63 6f 6e 64 0a 09 09 bosity* (cond...
1da0: 20 20 20 28 28 61 72 67 73 3a 67 65 74 2d 61 72 ((args:get-ar
1db0: 67 20 22 2d 64 65 62 75 67 22 29 28 73 74 72 69 g "-debug")(stri
1dc0: 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 ng->number (args
1dd0: 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 :get-arg "-debug
1de0: 22 29 29 29 0a 09 09 20 20 20 28 28 61 72 67 73 ")))... ((args
1df0: 3a 67 65 74 2d 61 72 67 20 22 2d 76 22 29 20 20 :get-arg "-v")
1e00: 20 20 32 29 0a 09 09 20 20 20 28 28 61 72 67 73 2)... ((args
1e10: 3a 67 65 74 2d 61 72 67 20 22 2d 71 22 29 20 20 :get-arg "-q")
1e20: 20 20 30 29 0a 09 09 20 20 20 28 65 6c 73 65 20 0)... (else
1e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e40: 20 20 31 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 1)))..;;======
1e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e90: 0a 3b 3b 20 4d 69 73 63 20 67 65 6e 65 72 61 6c .;; Misc general
1ea0: 20 63 61 6c 6c 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d calls.;;=======
1eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
1ef0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
1f00: 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 29 0a rg "-env2file").
1f10: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
1f20: 20 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 (save-environme
1f30: 6e 74 2d 61 73 2d 66 69 6c 65 73 20 28 61 72 67 nt-as-files (arg
1f40: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 32 s:get-arg "-env2
1f50: 66 69 6c 65 22 29 29 0a 20 20 20 20 20 20 28 73 file")). (s
1f60: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
1f70: 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d g* #t)))..;;====
1f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1fc0: 3d 3d 0a 3b 3b 20 52 65 6d 6f 76 65 20 6f 6c 64 ==.;; Remove old
1fd0: 20 72 75 6e 28 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d run(s).;;======
1fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2020: 0a 0a 3b 3b 20 73 69 6e 63 65 20 73 65 76 65 72 ..;; since sever
2030: 61 6c 20 61 63 74 69 6f 6e 73 20 63 61 6e 20 62 al actions can b
2040: 65 20 73 70 65 63 69 66 69 65 64 20 6f 6e 20 74 e specified on t
2050: 68 65 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 he command line
2060: 74 68 65 20 72 65 6d 6f 76 61 6c 0a 3b 3b 20 69 the removal.;; i
2070: 73 20 64 6f 6e 65 20 66 69 72 73 74 0a 28 64 65 s done first.(de
2080: 66 69 6e 65 20 28 6f 70 65 72 61 74 65 2d 6f 6e fine (operate-on
2090: 20 64 62 20 61 63 74 69 6f 6e 29 0a 20 20 28 63 db action). (c
20a0: 6f 6e 64 0a 20 20 20 28 28 6e 6f 74 20 28 61 72 ond. ((not (ar
20b0: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
20c0: 6e 61 6d 65 22 29 29 0a 20 20 20 20 28 64 65 62 name")). (deb
20d0: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
20e0: 52 3a 20 4d 69 73 73 69 6e 67 20 72 65 71 75 69 R: Missing requi
20f0: 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 6f red parameter fo
2100: 72 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f r " action ", yo
2110: 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 74 u must specify t
2120: 68 65 20 72 75 6e 20 6e 61 6d 65 20 70 61 74 74 he run name patt
2130: 65 72 6e 20 77 69 74 68 20 3a 72 75 6e 6e 61 6d ern with :runnam
2140: 65 20 70 61 74 74 22 29 0a 20 20 20 20 28 65 78 e patt"). (ex
2150: 69 74 20 32 29 29 0a 20 20 20 28 28 6e 6f 74 20 it 2)). ((not
2160: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
2170: 74 65 73 74 70 61 74 74 22 29 29 0a 20 20 20 20 testpatt")).
2180: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
2190: 45 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 20 72 ERROR: Missing r
21a0: 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 74 65 equired paramete
21b0: 72 20 66 6f 72 20 22 20 61 63 74 69 6f 6e 20 22 r for " action "
21c0: 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 69 , you must speci
21d0: 66 79 20 74 68 65 20 74 65 73 74 20 70 61 74 74 fy the test patt
21e0: 65 72 6e 20 77 69 74 68 20 2d 74 65 73 74 70 61 ern with -testpa
21f0: 74 74 22 29 0a 20 20 20 20 28 65 78 69 74 20 33 tt"). (exit 3
2200: 29 29 0a 20 20 20 28 28 6e 6f 74 20 28 61 72 67 )). ((not (arg
2210: 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d s:get-arg "-item
2220: 70 61 74 74 22 29 29 0a 20 20 20 20 28 70 72 69 patt")). (pri
2230: 6e 74 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 nt "ERROR: Missi
2240: 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 ng required para
2250: 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 meter for " acti
2260: 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 on ", you must s
2270: 70 65 63 69 66 79 20 74 68 65 20 69 74 65 6d 73 pecify the items
2280: 20 77 69 74 68 20 2d 69 74 65 6d 70 61 74 74 22 with -itempatt"
2290: 29 0a 20 20 20 20 28 65 78 69 74 20 34 29 29 0a ). (exit 4)).
22a0: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 28 69 66 (else. (if
22b0: 20 28 6e 6f 74 20 28 63 61 72 20 2a 63 6f 6e 66 (not (car *conf
22c0: 69 67 69 6e 66 6f 2a 29 29 0a 09 28 62 65 67 69 iginfo*))..(begi
22d0: 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e n.. (debug:prin
22e0: 74 20 30 20 22 45 52 52 4f 52 3a 20 41 74 74 65 t 0 "ERROR: Atte
22f0: 6d 70 74 65 64 20 22 20 61 63 74 69 6f 6e 20 22 mpted " action "
2300: 6f 6e 20 74 65 73 74 28 73 29 20 62 75 74 20 72 on test(s) but r
2310: 75 6e 20 61 72 65 61 20 63 6f 6e 66 69 67 20 66 un area config f
2320: 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a ile not found").
2330: 09 20 20 28 65 78 69 74 20 31 29 29 0a 09 3b 3b . (exit 1))..;;
2340: 20 70 75 74 20 74 65 73 74 20 70 61 72 61 6d 65 put test parame
2350: 74 65 72 73 20 69 6e 74 6f 20 63 6f 6e 76 65 6e ters into conven
2360: 69 65 6e 74 20 76 61 72 69 61 62 6c 65 73 0a 09 ient variables..
2370: 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e (runs:operate-on
2380: 20 20 64 62 0a 09 09 09 20 20 61 63 74 69 6f 6e db.... action
2390: 0a 09 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d .... (args:get-
23a0: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 0a arg ":runname").
23b0: 09 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ... (args:get-a
23c0: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a rg "-testpatt").
23d0: 09 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ... (args:get-a
23e0: 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 29 0a rg "-itempatt").
23f0: 09 09 09 20 20 73 74 61 74 65 3a 20 28 61 72 67 ... state: (arg
2400: 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
2410: 65 22 29 20 0a 09 09 09 20 20 73 74 61 74 75 73 e") .... status
2420: 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 : (args:get-arg
2430: 22 3a 73 74 61 74 75 73 22 29 0a 09 09 09 20 20 ":status")....
2440: 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 new-state-status
2450: 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 : (args:get-arg
2460: 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 "-set-state-stat
2470: 75 73 22 29 29 29 0a 20 20 20 20 28 73 71 6c 69 us"))). (sqli
2480: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
2490: 29 0a 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 ). (set! *did
24a0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
24b0: 29 0a 09 20 20 0a 28 69 66 20 28 61 72 67 73 3a ).. .(if (args:
24c0: 67 65 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 65 get-arg "-remove
24d0: 2d 72 75 6e 73 22 29 0a 20 20 20 20 28 67 65 6e -runs"). (gen
24e0: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 eral-run-call .
24f0: 20 20 20 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e "-remove-run
2500: 73 22 0a 20 20 20 20 20 22 72 65 6d 6f 76 65 20 s". "remove
2510: 72 75 6e 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 runs". (lamb
2520: 64 61 20 28 64 62 20 74 61 72 67 65 74 20 72 75 da (db target ru
2530: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 nname keys keyna
2540: 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 mes keyvallst).
2550: 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d 6f (operate-o
2560: 6e 20 64 62 20 27 72 65 6d 6f 76 65 2d 72 75 6e n db 'remove-run
2570: 73 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 s))))..(if (args
2580: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 :get-arg "-set-s
2590: 74 61 74 65 2d 73 74 61 74 75 73 22 29 0a 20 20 tate-status").
25a0: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
25b0: 61 6c 6c 20 0a 20 20 20 20 20 22 2d 73 65 74 2d all . "-set-
25c0: 73 74 61 74 65 2d 73 74 61 74 75 73 22 0a 20 20 state-status".
25d0: 20 20 20 22 73 65 74 20 73 74 61 74 65 20 61 6e "set state an
25e0: 64 20 73 74 61 74 75 73 22 0a 20 20 20 20 20 28 d status". (
25f0: 6c 61 6d 62 64 61 20 28 64 62 20 74 61 72 67 65 lambda (db targe
2600: 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
2610: 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 eynames keyvalls
2620: 74 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 t). (opera
2630: 74 65 2d 6f 6e 20 64 62 20 27 73 65 74 2d 73 74 te-on db 'set-st
2640: 61 74 65 2d 73 74 61 74 75 73 29 29 29 29 0a 0a ate-status))))..
2650: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
2660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2690: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 75 65 72 ========.;; Quer
26a0: 79 20 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d y runs.;;=======
26b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
26f0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
2700: 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 rg "-list-runs")
2710: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 64 62 20 . (let* ((db
2720: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 (begin...
2730: 20 20 20 20 20 20 28 73 65 74 75 70 2d 66 6f 72 (setup-for
2740: 2d 72 75 6e 29 0a 09 09 20 20 20 20 20 20 20 28 -run)... (
2750: 6f 70 65 6e 2d 64 62 29 29 29 0a 09 20 20 20 28 open-db))).. (
2760: 72 75 6e 70 61 74 74 20 20 28 61 72 67 73 3a 67 runpatt (args:g
2770: 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 et-arg "-list-ru
2780: 6e 73 22 29 29 0a 09 20 20 20 28 74 65 73 74 70 ns")).. (testp
2790: 61 74 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 att (args:get-ar
27a0: 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 29 0a g "-testpatt")).
27b0: 09 20 20 20 28 69 74 65 6d 70 61 74 74 20 28 61 . (itempatt (a
27c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 rgs:get-arg "-it
27d0: 65 6d 70 61 74 74 22 29 29 0a 09 20 20 20 28 72 empatt")).. (r
27e0: 75 6e 73 64 61 74 20 20 28 72 64 62 3a 67 65 74 unsdat (rdb:get
27f0: 2d 72 75 6e 73 20 64 62 20 72 75 6e 70 61 74 74 -runs db runpatt
2800: 20 23 66 20 23 66 20 27 28 29 29 29 0a 09 20 20 #f #f '()))..
2810: 20 28 72 75 6e 73 20 20 20 20 20 28 64 62 3a 67 (runs (db:g
2820: 65 74 2d 72 6f 77 73 20 72 75 6e 73 64 61 74 29 et-rows runsdat)
2830: 29 0a 09 20 20 20 28 68 65 61 64 65 72 20 20 20 ).. (header
2840: 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 (db:get-header r
2850: 75 6e 73 64 61 74 29 29 0a 09 20 20 20 28 6b 65 unsdat)).. (ke
2860: 79 73 20 20 20 20 20 28 72 64 62 3a 67 65 74 2d ys (rdb:get-
2870: 6b 65 79 73 20 64 62 29 29 0a 09 20 20 20 28 6b keys db)).. (k
2880: 65 79 6e 61 6d 65 73 20 28 6d 61 70 20 6b 65 79 eynames (map key
2890: 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b :get-fieldname k
28a0: 65 79 73 29 29 29 0a 20 20 20 20 20 20 28 69 66 eys))). (if
28b0: 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d (not (args:get-
28c0: 61 72 67 20 22 2d 73 65 72 76 65 72 22 29 29 0a arg "-server")).
28d0: 09 20 20 28 73 65 72 76 65 72 3a 63 6c 69 65 6e . (server:clien
28e0: 74 2d 73 65 74 75 70 20 64 62 29 29 0a 20 20 20 t-setup db)).
28f0: 20 20 20 3b 3b 20 45 61 63 68 20 72 75 6e 0a 20 ;; Each run.
2900: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
2910: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
2920: 72 75 6e 29 0a 09 20 28 64 65 62 75 67 3a 70 72 run).. (debug:pr
2930: 69 6e 74 20 31 20 22 52 75 6e 3a 20 22 0a 09 09 int 1 "Run: "...
2940: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
2950: 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 rse (map (lambda
2960: 20 28 78 29 0a 09 09 09 09 09 20 20 20 28 64 62 (x)...... (db
2970: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
2980: 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 ader run header
2990: 78 29 29 0a 09 09 09 09 09 20 6b 65 79 6e 61 6d x))...... keynam
29a0: 65 73 29 20 22 2f 22 29 0a 09 09 22 2f 22 0a 09 es) "/")..."/"..
29b0: 09 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 .(db:get-value-b
29c0: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
29d0: 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 0a 09 der "runname")..
29e0: 09 22 20 73 74 61 74 75 73 3a 20 22 20 28 64 62 ." status: " (db
29f0: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
2a00: 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 ader run header
2a10: 22 73 74 61 74 65 22 29 29 0a 09 20 28 6c 65 74 "state")).. (let
2a20: 20 28 28 72 75 6e 2d 69 64 20 28 64 62 3a 67 65 ((run-id (db:ge
2a30: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
2a40: 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 64 r run header "id
2a50: 22 29 29 29 0a 09 20 20 20 28 6c 65 74 20 28 28 "))).. (let ((
2a60: 74 65 73 74 73 20 28 72 64 62 3a 67 65 74 2d 74 tests (rdb:get-t
2a70: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 20 ests-for-run db
2a80: 72 75 6e 2d 69 64 20 74 65 73 74 70 61 74 74 20 run-id testpatt
2a90: 69 74 65 6d 70 61 74 74 20 27 28 29 20 27 28 29 itempatt '() '()
2aa0: 29 29 29 0a 09 20 20 20 20 20 3b 3b 20 45 61 63 ))).. ;; Eac
2ab0: 68 20 74 65 73 74 0a 09 20 20 20 20 20 28 66 6f h test.. (fo
2ac0: 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 20 28 r-each .. (
2ad0: 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 lambda (test)...
2ae0: 28 66 6f 72 6d 61 74 20 23 74 0a 09 09 09 22 20 (format #t...."
2af0: 20 54 65 73 74 3a 20 7e 32 35 61 20 53 74 61 74 Test: ~25a Stat
2b00: 65 3a 20 7e 31 35 61 20 53 74 61 74 75 73 3a 20 e: ~15a Status:
2b10: 7e 31 35 61 20 52 75 6e 74 69 6d 65 3a 20 7e 35 ~15a Runtime: ~5
2b20: 40 61 73 20 54 69 6d 65 3a 20 7e 32 32 61 20 48 @as Time: ~22a H
2b30: 6f 73 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 09 ost: ~10a\n"....
2b40: 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 (conc (db:test-g
2b50: 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 et-testname test
2b60: 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 ).... (if (
2b70: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d equal? (db:test-
2b80: 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 get-item-path te
2b90: 73 74 29 20 22 22 29 0a 09 09 09 09 20 20 22 22 st) "")..... ""
2ba0: 20 0a 09 09 09 09 20 20 28 63 6f 6e 63 20 22 28 ..... (conc "(
2bb0: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 " (db:test-get-i
2bc0: 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 20 22 tem-path test) "
2bd0: 29 22 29 29 29 0a 09 09 09 28 64 62 3a 74 65 73 )")))....(db:tes
2be0: 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 t-get-state test
2bf0: 29 0a 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65 )....(db:test-ge
2c00: 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 0a 09 t-status test)..
2c10: 09 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 ..(db:test-get-r
2c20: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 un_duration test
2c30: 29 0a 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65 )....(db:test-ge
2c40: 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 t-event_time tes
2c50: 74 29 0a 09 09 09 28 64 62 3a 74 65 73 74 2d 67 t)....(db:test-g
2c60: 65 74 2d 68 6f 73 74 20 74 65 73 74 29 29 0a 20 et-host test)).
2c70: 09 09 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 ..(if (not (or (
2c80: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d equal? (db:test-
2c90: 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 get-status test)
2ca0: 20 22 50 41 53 53 22 29 0a 09 09 09 20 20 20 20 "PASS")....
2cb0: 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 (equal? (db:tes
2cc0: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t-get-status tes
2cd0: 74 29 20 22 57 41 52 4e 22 29 0a 09 09 09 20 20 t) "WARN")....
2ce0: 20 20 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 (equal? (db:t
2cf0: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 est-get-state te
2d00: 73 74 29 20 20 22 4e 4f 54 5f 53 54 41 52 54 45 st) "NOT_STARTE
2d10: 44 22 29 29 29 0a 09 09 20 20 20 20 28 62 65 67 D")))... (beg
2d20: 69 6e 0a 09 09 20 20 20 20 20 20 28 70 72 69 6e in... (prin
2d30: 74 20 22 20 20 20 20 20 20 20 20 20 63 70 75 6c t " cpul
2d40: 6f 61 64 3a 20 20 22 20 28 64 62 3a 74 65 73 74 oad: " (db:test
2d50: 2d 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 73 -get-cpuload tes
2d60: 74 29 0a 09 09 09 20 20 20 20 20 22 5c 6e 20 20 t).... "\n
2d70: 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 3a diskfree:
2d80: 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d " (db:test-get-
2d90: 64 69 73 6b 66 72 65 65 20 74 65 73 74 29 0a 09 diskfree test)..
2da0: 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 20 .. "\n
2db0: 20 20 20 75 6e 61 6d 65 3a 20 20 20 20 22 20 28 uname: " (
2dc0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 75 6e 61 6d db:test-get-unam
2dd0: 65 20 74 65 73 74 29 0a 09 09 09 20 20 20 20 20 e test)....
2de0: 22 5c 6e 20 20 20 20 20 20 20 20 20 72 75 6e 64 "\n rund
2df0: 69 72 3a 20 20 20 22 20 28 64 62 3a 74 65 73 74 ir: " (db:test
2e00: 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 -get-rundir test
2e10: 29 0a 09 09 09 20 20 20 20 20 29 0a 09 09 20 20 ).... )...
2e20: 20 20 20 20 3b 3b 20 45 61 63 68 20 74 65 73 74 ;; Each test
2e30: 0a 09 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 ... (let ((
2e40: 73 74 65 70 73 20 28 64 62 3a 67 65 74 2d 73 74 steps (db:get-st
2e50: 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 eps-for-test db
2e60: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 (db:test-get-id
2e70: 74 65 73 74 29 29 29 29 0a 09 09 09 28 66 6f 72 test))))....(for
2e80: 2d 65 61 63 68 20 0a 09 09 09 20 28 6c 61 6d 62 -each .... (lamb
2e90: 64 61 20 28 73 74 65 70 29 0a 09 09 09 20 20 20 da (step)....
2ea0: 28 66 6f 72 6d 61 74 20 23 74 20 0a 09 09 09 09 (format #t .....
2eb0: 20 20 20 22 20 20 20 20 53 74 65 70 3a 20 7e 32 " Step: ~2
2ec0: 30 61 20 53 74 61 74 65 3a 20 7e 31 30 61 20 53 0a State: ~10a S
2ed0: 74 61 74 75 73 3a 20 7e 31 30 61 20 54 69 6d 65 tatus: ~10a Time
2ee0: 20 7e 32 32 61 5c 6e 22 0a 09 09 09 09 20 20 20 ~22a\n".....
2ef0: 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 (db:step-get-ste
2f00: 70 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 09 09 pname step).....
2f10: 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d (db:step-get-
2f20: 73 74 61 74 65 20 73 74 65 70 29 0a 09 09 09 09 state step).....
2f30: 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d (db:step-get-
2f40: 73 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 status step)....
2f50: 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 . (db:step-get
2f60: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 -event_time step
2f70: 29 29 29 0a 09 09 09 20 73 74 65 70 73 29 29 29 ))).... steps)))
2f80: 29 29 0a 09 09 74 65 73 74 73 29 29 29 29 0a 20 ))...tests)))).
2f90: 20 20 20 20 20 20 72 75 6e 73 29 0a 20 20 20 20 runs).
2fa0: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
2fb0: 74 68 69 6e 67 2a 20 23 74 29 0a 20 20 20 20 20 thing* #t).
2fc0: 20 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;=========
2fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
3010: 20 53 74 61 72 74 20 74 68 65 20 73 65 72 76 65 Start the serve
3020: 72 20 2d 20 63 61 6e 20 62 65 20 64 6f 6e 65 20 r - can be done
3030: 69 6e 20 63 6f 6e 6a 75 6e 63 74 69 6f 6e 20 77 in conjunction w
3040: 69 74 68 20 2d 72 75 6e 61 6c 6c 20 6f 72 20 2d ith -runall or -
3050: 72 75 6e 74 65 73 74 73 20 28 6f 6e 65 20 64 61 runtests (one da
3060: 79 2e 2e 2e 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d y...).;;========
3070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 ==============.(
30b0: 69 66 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 if (and (args:ge
30c0: 74 2d 61 72 67 20 22 2d 73 65 72 76 65 72 22 29 t-arg "-server")
30d0: 0a 09 20 28 6e 6f 74 20 28 6f 72 20 28 61 72 67 .. (not (or (arg
30e0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 s:get-arg "-runa
30f0: 6c 6c 22 29 0a 09 09 20 20 28 61 72 67 73 3a 67 ll")... (args:g
3100: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
3110: 73 22 29 29 29 29 0a 20 20 20 20 28 6c 65 74 2a s")))). (let*
3120: 20 28 28 74 6f 70 70 61 74 68 20 28 73 65 74 75 ((toppath (setu
3130: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 p-for-run))..
3140: 28 64 62 20 20 20 20 20 20 28 69 66 20 74 6f 70 (db (if top
3150: 70 61 74 68 20 28 6f 70 65 6e 2d 64 62 29 20 23 path (open-db) #
3160: 66 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 f))). (debu
3170: 67 3a 70 72 69 6e 74 20 30 20 22 49 4e 46 4f 3a g:print 0 "INFO:
3180: 20 53 74 61 72 74 69 6e 67 20 74 68 65 20 73 74 Starting the st
3190: 61 6e 64 61 6c 6f 6e 65 20 73 65 72 76 65 72 22 andalone server"
31a0: 29 0a 20 20 20 20 20 20 28 69 66 20 64 62 20 0a ). (if db .
31b0: 09 20 20 28 6c 65 74 2a 20 28 28 68 6f 73 74 3a . (let* ((host:
31c0: 70 6f 72 74 20 28 64 62 3a 67 65 74 2d 76 61 72 port (db:get-var
31d0: 20 64 62 20 22 53 45 52 56 45 52 22 29 29 20 3b db "SERVER")) ;
31e0: 3b 20 74 68 69 73 20 64 6f 65 6e 27 74 20 73 75 ; this doen't su
31f0: 70 70 6f 72 74 20 6d 75 6c 74 69 70 6c 65 20 73 pport multiple s
3200: 65 72 76 65 72 73 20 42 55 47 21 21 21 21 0a 09 ervers BUG!!!!..
3210: 09 20 28 74 68 32 20 28 73 65 72 76 65 72 3a 73 . (th2 (server:s
3220: 74 61 72 74 20 64 62 20 28 61 72 67 73 3a 67 65 tart db (args:ge
3230: 74 2d 61 72 67 20 22 2d 73 65 72 76 65 72 22 29 t-arg "-server")
3240: 29 29 0a 09 09 20 28 74 68 33 20 28 6d 61 6b 65 ))... (th3 (make
3250: 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 64 61 20 -thread (lambda
3260: 28 29 0a 09 09 09 09 20 20 20 20 20 20 28 73 65 ()..... (se
3270: 72 76 65 72 3a 6b 65 65 70 2d 72 75 6e 6e 69 6e rver:keep-runnin
3280: 67 20 64 62 29 29 29 29 29 0a 09 20 20 20 20 28 g db))))).. (
3290: 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 thread-start! th
32a0: 33 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 3).. (thread-
32b0: 6a 6f 69 6e 21 20 74 68 33 29 29 0a 09 20 20 28 join! th3)).. (
32c0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
32d0: 52 52 4f 52 3a 20 46 61 69 6c 65 64 20 74 6f 20 RROR: Failed to
32e0: 73 65 74 75 70 20 66 6f 72 20 6d 65 67 61 74 65 setup for megate
32f0: 73 74 22 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d st"))))..;;=====
3300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3340: 3d 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e 0a 3b 3b =.;; full run.;;
3350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3390: 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 20 6c ======..;; get l
33a0: 6f 63 6b 20 69 6e 20 64 62 20 66 6f 72 20 66 75 ock in db for fu
33b0: 6c 6c 20 72 75 6e 20 66 6f 72 20 74 68 69 73 20 ll run for this
33c0: 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 66 6f 72 directory.;; for
33d0: 20 61 6c 6c 20 74 65 73 74 73 20 77 69 74 68 20 all tests with
33e0: 64 65 70 73 0a 3b 3b 20 20 20 77 61 6c 6b 20 74 deps.;; walk t
33f0: 72 65 65 20 6f 66 20 74 65 73 74 73 20 74 6f 20 ree of tests to
3400: 66 69 6e 64 20 68 65 61 64 20 74 61 73 6b 73 0a find head tasks.
3410: 3b 3b 20 20 20 61 64 64 20 68 65 61 64 20 74 61 ;; add head ta
3420: 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 sks to task queu
3430: 65 0a 3b 3b 20 20 20 61 64 64 20 64 65 70 65 6e e.;; add depen
3440: 64 61 6e 74 20 74 61 73 6b 73 20 74 6f 20 74 61 dant tasks to ta
3450: 73 6b 20 71 75 65 75 65 20 0a 3b 3b 20 20 20 61 sk queue .;; a
3460: 64 64 20 72 65 6d 61 69 6e 69 6e 67 20 74 61 73 dd remaining tas
3470: 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 ks to task queue
3480: 0a 3b 3b 20 66 6f 72 20 65 61 63 68 20 74 61 73 .;; for each tas
3490: 6b 20 69 6e 20 74 61 73 6b 20 71 75 65 75 65 0a k in task queue.
34a0: 3b 3b 20 20 20 69 66 20 68 61 76 65 20 61 64 65 ;; if have ade
34b0: 71 75 61 74 65 20 72 65 73 6f 75 72 63 65 73 0a quate resources.
34c0: 3b 3b 20 20 20 20 20 6c 61 75 6e 63 68 20 74 61 ;; launch ta
34d0: 73 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b 20 sk.;; else.;;
34e0: 20 20 20 20 70 75 74 20 74 61 73 6b 20 69 6e 20 put task in
34f0: 64 65 66 65 72 72 65 64 20 71 75 65 75 65 0a 3b deferred queue.;
3500: 3b 20 69 66 20 73 74 69 6c 6c 20 6f 6b 20 74 6f ; if still ok to
3510: 20 72 75 6e 20 74 61 73 6b 73 0a 3b 3b 20 20 20 run tasks.;;
3520: 70 72 6f 63 65 73 73 20 64 65 66 65 72 72 65 64 process deferred
3530: 20 74 61 73 6b 73 20 70 65 72 20 61 62 6f 76 65 tasks per above
3540: 20 73 74 65 70 73 0a 0a 3b 3b 20 72 75 6e 20 61 steps..;; run a
3550: 6c 6c 20 74 65 73 74 73 20 61 72 65 20 61 72 65 ll tests are are
3560: 20 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 44 20 61 Not COMPLETED a
3570: 6e 64 20 50 41 53 53 20 6f 72 20 43 48 45 43 4b nd PASS or CHECK
3580: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
3590: 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 0a 20 20 rg "-runall").
35a0: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
35b0: 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 75 6e 61 all . "-runa
35c0: 6c 6c 22 0a 20 20 20 20 20 22 72 75 6e 20 61 6c ll". "run al
35d0: 6c 20 74 65 73 74 73 22 0a 20 20 20 20 20 28 6c l tests". (l
35e0: 61 6d 62 64 61 20 28 64 62 20 74 61 72 67 65 74 ambda (db target
35f0: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
3600: 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 ynames keyvallst
3610: 29 0a 3b 3b 20 20 20 20 20 20 20 28 6c 65 74 20 ).;; (let
3620: 28 28 66 6c 61 67 73 20 28 6d 61 6b 65 2d 68 61 ((flags (make-ha
3630: 73 68 2d 74 61 62 6c 65 29 29 29 0a 3b 3b 09 20 sh-table))).;;.
3640: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
3650: 61 20 28 70 61 72 6d 29 0a 3b 3b 09 09 20 20 20 a (parm).;;..
3660: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
3670: 74 21 20 66 6c 61 67 73 20 70 61 72 6d 20 28 61 t! flags parm (a
3680: 72 67 73 3a 67 65 74 2d 61 72 67 20 70 61 72 6d rgs:get-arg parm
3690: 29 29 29 0a 3b 3b 09 09 20 20 20 28 6c 69 73 74 ))).;;.. (list
36a0: 20 22 2d 72 65 72 75 6e 22 20 22 2d 66 6f 72 63 "-rerun" "-forc
36b0: 65 22 20 22 2d 69 74 65 6d 70 61 74 74 22 29 29 e" "-itempatt"))
36c0: 0a 09 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 .. (runs:run-tes
36d0: 74 73 20 64 62 0a 09 09 09 20 74 61 72 67 65 74 ts db.... target
36e0: 0a 09 09 09 20 72 75 6e 6e 61 6d 65 0a 09 09 09 .... runname....
36f0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3700: 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 09 09 20 -runtests")....
3710: 75 73 65 72 0a 09 09 09 20 61 72 67 73 3a 61 72 user.... args:ar
3720: 67 2d 68 61 73 68 29 29 29 29 20 3b 3b 20 29 0a g-hash)))) ;; ).
3730: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
3740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e =========.;; run
3780: 20 6f 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d 3d 3d one test.;;====
3790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37d0: 3d 3d 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 20 74 ==..;; 1. find t
37e0: 68 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b he config file.;
37f0: 3b 20 32 2e 20 63 68 61 6e 67 65 20 74 6f 20 74 ; 2. change to t
3800: 68 65 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 he test director
3810: 79 0a 3b 3b 20 33 2e 20 75 70 64 61 74 65 20 74 y.;; 3. update t
3820: 68 65 20 64 62 20 77 69 74 68 20 22 74 65 73 74 he db with "test
3830: 20 73 74 61 72 74 65 64 22 20 73 74 61 74 75 73 started" status
3840: 2c 20 73 65 74 20 72 75 6e 6e 69 6e 67 20 68 6f , set running ho
3850: 73 74 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 73 73 st.;; 4. process
3860: 20 6c 61 75 6e 63 68 20 74 68 65 20 74 65 73 74 launch the test
3870: 0a 3b 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 6f 72 .;; - monitor
3880: 20 74 68 65 20 70 72 6f 63 65 73 73 2c 20 75 70 the process, up
3890: 64 61 74 65 20 73 74 61 74 73 20 69 6e 20 74 68 date stats in th
38a0: 65 20 64 62 20 65 76 65 72 79 20 32 5e 6e 20 6d e db every 2^n m
38b0: 69 6e 75 74 65 73 0a 3b 3b 20 35 2e 20 61 73 20 inutes.;; 5. as
38c0: 74 68 65 20 74 65 73 74 20 70 72 6f 63 65 65 64 the test proceed
38d0: 73 20 69 6e 74 65 72 6e 61 6c 6c 79 20 69 74 20 s internally it
38e0: 63 61 6c 6c 73 20 6d 65 67 61 74 65 73 74 20 61 calls megatest a
38f0: 73 20 65 61 63 68 20 73 74 65 70 20 69 73 0a 3b s each step is.;
3900: 3b 20 20 20 20 73 74 61 72 74 65 64 20 61 6e 64 ; started and
3910: 20 63 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 20 20 completed.;;
3920: 20 2d 20 73 74 65 70 20 73 74 61 72 74 65 64 2c - step started,
3930: 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 20 20 timestamp.;;
3940: 20 2d 20 73 74 65 70 20 63 6f 6d 70 6c 65 74 65 - step complete
3950: 64 2c 20 65 78 69 74 20 73 74 61 74 75 73 2c 20 d, exit status,
3960: 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 2e 20 timestamp.;; 6.
3970: 74 65 73 74 20 70 68 6f 6e 65 20 68 6f 6d 65 0a test phone home.
3980: 3b 3b 20 20 20 20 2d 20 69 66 20 74 65 73 74 20 ;; - if test
3990: 72 75 6e 20 74 69 6d 65 20 3e 20 61 6c 6c 6f 77 run time > allow
39a0: 65 64 20 72 75 6e 20 74 69 6d 65 20 74 68 65 6e ed run time then
39b0: 20 6b 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 20 20 kill job.;;
39c0: 2d 20 69 66 20 63 61 6e 6e 6f 74 20 61 63 63 65 - if cannot acce
39d0: 73 73 20 64 62 20 3e 20 61 6c 6c 6f 77 65 64 20 ss db > allowed
39e0: 64 69 73 63 6f 6e 6e 65 63 74 20 74 69 6d 65 20 disconnect time
39f0: 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 0a 28 then kill job..(
3a00: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
3a10: 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 20 20 "-runtests").
3a20: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
3a30: 6c 20 0a 20 20 20 22 2d 72 75 6e 74 65 73 74 73 l . "-runtests
3a40: 22 20 0a 20 20 20 22 72 75 6e 20 61 20 74 65 73 " . "run a tes
3a50: 74 22 20 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 t" . (lambda (
3a60: 64 62 20 74 61 72 67 65 74 20 72 75 6e 6e 61 6d db target runnam
3a70: 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 e keys keynames
3a80: 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 20 keyvallst).
3a90: 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 (runs:run-tests
3aa0: 64 62 0a 09 09 20 20 20 20 20 74 61 72 67 65 74 db... target
3ab0: 0a 09 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a ... runname.
3ac0: 09 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 .. (args:get
3ad0: 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 -arg "-runtests"
3ae0: 29 0a 09 09 20 20 20 20 20 75 73 65 72 0a 09 09 )... user...
3af0: 20 20 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 args:arg-ha
3b00: 73 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d sh))))..;;======
3b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b50: 0a 3b 3b 20 52 6f 6c 6c 75 70 20 69 6e 74 6f 20 .;; Rollup into
3b60: 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d a run.;;========
3b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
3bb0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
3bc0: 67 20 22 2d 72 6f 6c 6c 75 70 22 29 0a 20 20 20 g "-rollup").
3bd0: 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 (general-run-ca
3be0: 6c 6c 20 0a 20 20 20 20 20 22 2d 72 6f 6c 6c 75 ll . "-rollu
3bf0: 70 22 20 0a 20 20 20 20 20 22 72 6f 6c 6c 75 70 p" . "rollup
3c00: 20 74 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c tests" . (l
3c10: 61 6d 62 64 61 20 28 64 62 20 74 61 72 67 65 74 ambda (db target
3c20: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
3c30: 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 ynames keyvallst
3c40: 29 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a 72 ). (runs:r
3c50: 6f 6c 6c 75 70 2d 72 75 6e 20 64 62 0a 09 09 09 ollup-run db....
3c60: 6b 65 79 73 0a 09 09 09 28 6b 65 79 73 2d 3e 61 keys....(keys->a
3c70: 6c 69 73 74 20 6b 65 79 73 20 22 6e 61 22 29 0a list keys "na").
3c80: 09 09 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ...(args:get-arg
3c90: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 0a 09 09 ":runname") ...
3ca0: 09 75 73 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d .user))))..;;===
3cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3cf0: 3d 3d 3d 0a 3b 3b 20 4c 6f 63 6b 20 6f 72 20 75 ===.;; Lock or u
3d00: 6e 6c 6f 63 6b 20 61 20 72 75 6e 0a 3b 3b 3d 3d nlock a run.;;==
3d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3d50: 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 ====..(if (or (a
3d60: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
3d70: 63 6b 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 ck")(args:get-ar
3d80: 67 20 22 2d 75 6e 6c 6f 63 6b 22 29 29 0a 20 20 g "-unlock")).
3d90: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
3da0: 61 6c 6c 20 0a 20 20 20 20 20 28 69 66 20 28 61 all . (if (a
3db0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
3dc0: 63 6b 22 29 20 22 2d 6c 6f 63 6b 22 20 22 2d 75 ck") "-lock" "-u
3dd0: 6e 6c 6f 63 6b 22 29 0a 20 20 20 20 20 22 6c 6f nlock"). "lo
3de0: 63 6b 2f 75 6e 6c 6f 63 6b 20 74 65 73 74 73 22 ck/unlock tests"
3df0: 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
3e00: 64 62 20 74 61 72 67 65 74 20 72 75 6e 6e 61 6d db target runnam
3e10: 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 e keys keynames
3e20: 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 20 keyvallst).
3e30: 20 20 28 72 75 6e 73 3a 68 61 6e 64 6c 65 2d 6c (runs:handle-l
3e40: 6f 63 6b 69 6e 67 20 64 62 0a 09 09 20 20 74 61 ocking db... ta
3e50: 72 67 65 74 0a 09 09 20 20 6b 65 79 73 0a 09 09 rget... keys...
3e60: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
3e70: 22 3a 72 75 6e 6e 61 6d 65 22 29 20 0a 09 09 20 ":runname") ...
3e80: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3e90: 2d 6c 6f 63 6b 22 29 0a 09 09 20 20 28 61 72 67 -lock")... (arg
3ea0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f s:get-arg "-unlo
3eb0: 63 6b 22 29 0a 09 09 20 20 75 73 65 72 29 29 29 ck")... user)))
3ec0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
3ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 ===========.;; G
3f10: 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 74 et paths to test
3f20: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
3f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 65 ==========.;; Ge
3f70: 74 20 74 65 73 74 20 70 61 74 68 73 20 6d 61 74 t test paths mat
3f80: 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 75 ching target, ru
3f90: 6e 6e 61 6d 65 2c 20 74 65 73 74 70 61 74 74 2c nname, testpatt,
3fa0: 20 61 6e 64 20 69 74 65 6d 70 61 74 74 0a 28 69 and itempatt.(i
3fb0: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
3fc0: 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 arg "-test-files
3fd0: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
3fe0: 22 2d 74 65 73 74 2d 70 61 74 68 73 22 29 29 0a "-test-paths")).
3ff0: 20 20 20 20 3b 3b 20 69 66 20 77 65 20 61 72 65 ;; if we are
4000: 20 69 6e 20 61 20 74 65 73 74 20 75 73 65 20 74 in a test use t
4010: 68 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 61 he MT_CMDINFO da
4020: 74 61 0a 20 20 20 20 28 69 66 20 28 67 65 74 65 ta. (if (gete
4030: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
4040: 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 ..(let* ((starti
4050: 6e 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 ngdir (current-d
4060: 69 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 irectory))..
4070: 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 (cmdinfo (r
4080: 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d ead (open-input-
4090: 73 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 string (base64:b
40a0: 61 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 ase64-decode (ge
40b0: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
40c0: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 "))))).. (
40d0: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
40e0: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
40f0: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
4100: 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
4110: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
4120: 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
4130: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
4140: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
4150: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
4160: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
4170: 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 (db-host (
4180: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 assoc/default 'd
4190: 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f b-host cmdinfo
41a0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
41b0: 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 id (assoc/def
41c0: 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 ault 'run-id
41d0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
41e0: 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
41f0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
4200: 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
4210: 0a 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 .. (db
4220: 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 #f)..
4230: 28 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 (state (args
4240: 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 :get-arg ":state
4250: 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 ")).. (sta
4260: 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 tus (args:get
4270: 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 -arg ":status"))
4280: 0a 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 .. (target
4290: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
42a0: 67 20 22 2d 74 61 72 67 65 74 22 29 29 0a 09 20 g "-target"))..
42b0: 20 20 20 20 20 20 28 74 6f 70 70 61 74 68 20 20 (toppath
42c0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
42d0: 27 74 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 'toppath cmdin
42e0: 66 6f 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 fo))).. (change
42f0: 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 70 61 -directory toppa
4300: 74 68 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 th).. (if (not
4310: 74 61 72 67 65 74 29 0a 09 20 20 20 20 20 20 28 target).. (
4320: 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 begin...(debug:p
4330: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 2d rint 0 "ERROR: -
4340: 74 61 72 67 65 74 20 69 73 20 72 65 71 75 69 72 target is requir
4350: 65 64 2e 22 29 0a 09 09 28 65 78 69 74 20 31 29 ed.")...(exit 1)
4360: 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 )).. (if (not (
4370: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
4380: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
4390: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
43a0: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
43b0: 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 2d 74 giving up on -t
43c0: 65 73 74 2d 70 61 74 68 73 20 6f 72 20 2d 74 65 est-paths or -te
43d0: 73 74 2d 66 69 6c 65 73 2c 20 65 78 69 74 69 6e st-files, exitin
43e0: 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 g")...(exit 1)))
43f0: 0a 09 20 20 28 73 65 74 21 20 64 62 20 28 6f 70 .. (set! db (op
4400: 65 6e 2d 64 62 29 29 20 20 20 20 0a 09 20 20 28 en-db)) .. (
4410: 69 66 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 if (not (args:ge
4420: 74 2d 61 72 67 20 22 2d 73 65 72 76 65 72 22 29 t-arg "-server")
4430: 29 0a 09 20 20 20 20 20 20 28 73 65 72 76 65 72 ).. (server
4440: 3a 63 6c 69 65 6e 74 2d 73 65 74 75 70 20 64 62 :client-setup db
4450: 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 69 74 )).. (let* ((it
4460: 65 6d 70 61 74 74 20 28 61 72 67 73 3a 67 65 74 empatt (args:get
4470: 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 -arg "-itempatt"
4480: 29 29 0a 09 09 20 28 6b 65 79 73 20 20 20 20 20 ))... (keys
4490: 28 72 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 (rdb:get-keys db
44a0: 29 29 0a 09 09 20 28 6b 65 79 6e 61 6d 65 73 20 ))... (keynames
44b0: 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 (map key:get-fie
44c0: 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 0a 09 09 ldname keys))...
44d0: 20 28 70 61 74 68 73 20 20 20 20 28 72 64 62 3a (paths (rdb:
44e0: 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d test-get-paths-m
44f0: 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 atching db keyna
4500: 6d 65 73 20 74 61 72 67 65 74 20 28 61 72 67 73 mes target (args
4510: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d :get-arg "-test-
4520: 66 69 6c 65 73 22 29 29 29 29 0a 09 20 20 20 20 files"))))..
4530: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
4540: 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 28 66 ing* #t).. (f
4550: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
4560: 28 70 61 74 68 29 0a 09 09 09 28 70 72 69 6e 74 (path)....(print
4570: 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 path))...
4580: 70 61 74 68 73 29 29 29 0a 09 3b 3b 20 65 6c 73 paths)))..;; els
4590: 65 20 64 6f 20 61 20 67 65 6e 65 72 61 6c 2d 72 e do a general-r
45a0: 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 72 61 un-call..(genera
45b0: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 22 2d l-run-call .. "-
45c0: 74 65 73 74 2d 66 69 6c 65 73 22 0a 09 20 22 47 test-files".. "G
45d0: 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 73 74 et paths to test
45e0: 22 0a 09 20 28 6c 61 6d 62 64 61 20 28 64 62 20 ".. (lambda (db
45f0: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
4600: 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 eys keynames key
4610: 76 61 6c 6c 73 74 29 0a 09 20 20 20 28 6c 65 74 vallst).. (let
4620: 2a 20 28 28 69 74 65 6d 70 61 74 74 20 28 61 72 * ((itempatt (ar
4630: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 gs:get-arg "-ite
4640: 6d 70 61 74 74 22 29 29 0a 09 09 20 20 28 70 61 mpatt"))... (pa
4650: 74 68 73 20 20 20 20 28 72 64 62 3a 74 65 73 74 ths (rdb:test
4660: 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 -get-paths-match
4670: 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 ing db keynames
4680: 74 61 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 target (args:get
4690: 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 -arg "-test-file
46a0: 73 22 29 29 29 29 0a 09 20 20 20 20 20 28 66 6f s")))).. (fo
46b0: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
46c0: 70 61 74 68 29 0a 09 09 09 20 28 70 72 69 6e 74 path).... (print
46d0: 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 path))...
46e0: 20 70 61 74 68 73 29 29 29 29 29 29 0a 0a 3b 3b paths))))))..;;
46f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4730: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 ======.;; Archiv
4740: 65 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d e tests.;;======
4750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4790: 0a 3b 3b 20 41 72 63 68 69 76 65 20 74 65 73 74 .;; Archive test
47a0: 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 s matching targe
47b0: 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 74 65 73 74 t, runname, test
47c0: 70 61 74 74 2c 20 61 6e 64 20 69 74 65 6d 70 61 patt, and itempa
47d0: 74 74 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 tt.(if (args:get
47e0: 2d 61 72 67 20 22 2d 61 72 63 68 69 76 65 22 29 -arg "-archive")
47f0: 0a 20 20 20 20 3b 3b 20 69 66 20 77 65 20 61 72 . ;; if we ar
4800: 65 20 69 6e 20 61 20 74 65 73 74 20 75 73 65 20 e in a test use
4810: 74 68 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 the MT_CMDINFO d
4820: 61 74 61 0a 20 20 20 20 28 69 66 20 28 67 65 74 ata. (if (get
4830: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
4840: 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 )..(let* ((start
4850: 69 6e 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d ingdir (current-
4860: 64 69 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 directory))..
4870: 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 (cmdinfo (
4880: 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 read (open-input
4890: 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a -string (base64:
48a0: 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 base64-decode (g
48b0: 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
48c0: 4f 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 O")))))..
48d0: 28 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f (testpath (asso
48e0: 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 c/default 'testp
48f0: 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 ath cmdinfo))..
4900: 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d (test-nam
4910: 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 e (assoc/default
4920: 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 'test-name cmdi
4930: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 nfo)).. (r
4940: 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f unscript (assoc/
4950: 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 default 'runscri
4960: 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 pt cmdinfo))..
4970: 20 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 (db-host
4980: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
4990: 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 db-host cmdinf
49a0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
49b0: 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 -id (assoc/de
49c0: 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 fault 'run-id
49d0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
49e0: 20 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 (itemdat (a
49f0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 ssoc/default 'it
4a00: 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 emdat cmdinfo)
4a10: 29 0a 09 20 20 20 20 20 20 20 28 64 62 20 20 20 ).. (db
4a20: 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 #f)..
4a30: 20 28 73 74 61 74 65 20 20 20 20 20 28 61 72 67 (state (arg
4a40: 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
4a50: 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 e")).. (st
4a60: 61 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 atus (args:ge
4a70: 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 t-arg ":status")
4a80: 29 0a 09 20 20 20 20 20 20 20 28 74 61 72 67 65 ).. (targe
4a90: 74 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 t (args:get-a
4aa0: 72 67 20 22 2d 74 61 72 67 65 74 22 29 29 29 0a rg "-target"))).
4ab0: 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
4ac0: 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
4ad0: 20 20 28 69 66 20 28 6e 6f 74 20 74 61 72 67 65 (if (not targe
4ae0: 74 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e t).. (begin
4af0: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
4b00: 30 20 22 45 52 52 4f 52 3a 20 2d 74 61 72 67 65 0 "ERROR: -targe
4b10: 74 20 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 t is required.")
4b20: 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 ...(exit 1)))..
4b30: 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 (if (not (setup
4b40: 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 -for-run))..
4b50: 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 (begin...(debu
4b60: 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 g:print 0 "Faile
4b70: 64 20 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 d to setup, givi
4b80: 6e 67 20 75 70 20 6f 6e 20 2d 61 72 63 68 69 76 ng up on -archiv
4b90: 65 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 e, exiting")...(
4ba0: 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 73 65 exit 1))).. (se
4bb0: 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 t! db (open-db))
4bc0: 20 20 20 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 .. (if (not
4bd0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4be0: 73 65 72 76 65 72 22 29 29 0a 09 20 20 20 20 20 server"))..
4bf0: 20 28 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d (server:client-
4c00: 73 65 74 75 70 20 64 62 29 29 0a 09 20 20 28 6c setup db)).. (l
4c10: 65 74 2a 20 28 28 69 74 65 6d 70 61 74 74 20 28 et* ((itempatt (
4c20: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 args:get-arg "-i
4c30: 74 65 6d 70 61 74 74 22 29 29 0a 09 09 20 28 6b tempatt"))... (k
4c40: 65 79 73 20 20 20 20 20 28 72 64 62 3a 67 65 74 eys (rdb:get
4c50: 2d 6b 65 79 73 20 64 62 29 29 0a 09 09 20 28 6b -keys db))... (k
4c60: 65 79 6e 61 6d 65 73 20 28 6d 61 70 20 6b 65 79 eynames (map key
4c70: 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b :get-fieldname k
4c80: 65 79 73 29 29 0a 09 09 20 28 70 61 74 68 73 20 eys))... (paths
4c90: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
4ca0: 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 64 paths-matching d
4cb0: 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 b keynames targe
4cc0: 74 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 20 t))).. (set!
4cd0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
4ce0: 74 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 t).. (for-eac
4cf0: 68 20 28 6c 61 6d 62 64 61 20 28 70 61 74 68 29 h (lambda (path)
4d00: 0a 09 09 09 28 70 72 69 6e 74 20 70 61 74 68 29 ....(print path)
4d10: 29 0a 09 09 20 20 20 20 20 20 70 61 74 68 73 29 )... paths)
4d20: 29 29 0a 09 3b 3b 20 65 6c 73 65 20 64 6f 20 61 ))..;; else do a
4d30: 20 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c general-run-cal
4d40: 6c 0a 09 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d l..(general-run-
4d50: 63 61 6c 6c 20 0a 09 20 22 2d 74 65 73 74 2d 70 call .. "-test-p
4d60: 61 74 68 73 22 0a 09 20 22 47 65 74 20 70 61 74 aths".. "Get pat
4d70: 68 73 20 74 6f 20 74 65 73 74 73 22 0a 09 20 28 hs to tests".. (
4d80: 6c 61 6d 62 64 61 20 28 64 62 20 74 61 72 67 65 lambda (db targe
4d90: 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
4da0: 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 eynames keyvalls
4db0: 74 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 69 t).. (let* ((i
4dc0: 74 65 6d 70 61 74 74 20 28 61 72 67 73 3a 67 65 tempatt (args:ge
4dd0: 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 t-arg "-itempatt
4de0: 22 29 29 0a 09 09 20 20 28 70 61 74 68 73 20 20 "))... (paths
4df0: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 (db:test-get-p
4e00: 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 64 62 aths-matching db
4e10: 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 keynames target
4e20: 29 29 29 0a 09 20 20 20 20 20 28 66 6f 72 2d 65 ))).. (for-e
4e30: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 74 ach (lambda (pat
4e40: 68 29 0a 09 09 09 20 28 70 72 69 6e 74 20 70 61 h).... (print pa
4e50: 74 68 29 29 0a 09 09 20 20 20 20 20 20 20 70 61 th))... pa
4e60: 74 68 73 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d ths))))))..;;===
4e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4eb0: 3d 3d 3d 0a 3b 3b 20 45 78 74 72 61 63 74 20 61 ===.;; Extract a
4ec0: 20 73 70 72 65 61 64 73 68 65 65 74 20 66 72 6f spreadsheet fro
4ed0: 6d 20 74 68 65 20 72 75 6e 73 20 64 61 74 61 62 m the runs datab
4ee0: 61 73 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ase.;;==========
4ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
4f30: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
4f40: 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 0a "-extract-ods").
4f50: 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e (general-run
4f60: 2d 63 61 6c 6c 0a 20 20 20 20 20 22 2d 65 78 74 -call. "-ext
4f70: 72 61 63 74 2d 6f 64 73 22 0a 20 20 20 20 20 22 ract-ods". "
4f80: 4d 61 6b 65 20 6f 64 73 20 73 70 72 65 61 64 73 Make ods spreads
4f90: 68 65 65 74 22 0a 20 20 20 20 20 28 6c 61 6d 62 heet". (lamb
4fa0: 64 61 20 28 64 62 20 74 61 72 67 65 74 20 72 75 da (db target ru
4fb0: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 nname keys keyna
4fc0: 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 mes keyvallst).
4fd0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6f 75 74 (let ((out
4fe0: 70 75 74 66 69 6c 65 20 28 61 72 67 73 3a 67 65 putfile (args:ge
4ff0: 74 2d 61 72 67 20 22 2d 65 78 74 72 61 63 74 2d t-arg "-extract-
5000: 6f 64 73 22 29 29 0a 09 20 20 20 20 20 28 72 75 ods")).. (ru
5010: 6e 73 70 61 74 74 20 20 20 28 61 72 67 73 3a 67 nspatt (args:g
5020: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
5030: 22 29 29 0a 09 20 20 20 20 20 28 70 61 74 68 6d ")).. (pathm
5040: 6f 64 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d od (args:get-
5050: 61 72 67 20 22 2d 70 61 74 68 6d 6f 64 22 29 29 arg "-pathmod"))
5060: 0a 09 20 20 20 20 20 28 6b 65 79 76 61 6c 61 6c .. (keyvalal
5070: 69 73 74 20 28 6b 65 79 73 2d 3e 61 6c 69 73 74 ist (keys->alist
5080: 20 6b 65 79 73 20 22 25 22 29 29 29 0a 09 20 28 keys "%"))).. (
5090: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 45 debug:print 2 "E
50a0: 78 74 72 61 63 74 20 6f 64 73 2c 20 6f 75 74 70 xtract ods, outp
50b0: 75 74 66 69 6c 65 3a 20 22 20 6f 75 74 70 75 74 utfile: " output
50c0: 66 69 6c 65 20 22 20 72 75 6e 73 70 61 74 74 3a file " runspatt:
50d0: 20 22 20 72 75 6e 73 70 61 74 74 20 22 20 6b 65 " runspatt " ke
50e0: 79 76 61 6c 61 6c 69 73 74 3a 20 22 20 6b 65 79 yvalalist: " key
50f0: 76 61 6c 61 6c 69 73 74 29 0a 09 20 28 64 62 3a valalist).. (db:
5100: 65 78 74 72 61 63 74 2d 6f 64 73 2d 66 69 6c 65 extract-ods-file
5110: 20 64 62 20 6f 75 74 70 75 74 66 69 6c 65 20 6b db outputfile k
5120: 65 79 76 61 6c 61 6c 69 73 74 20 28 69 66 20 72 eyvalalist (if r
5130: 75 6e 73 70 61 74 74 20 72 75 6e 73 70 61 74 74 unspatt runspatt
5140: 20 22 25 22 29 20 70 61 74 68 6d 6f 64 29 29 29 "%") pathmod)))
5150: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
5160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
51a0: 65 78 65 63 75 74 65 20 74 68 65 20 74 65 73 74 execute the test
51b0: 0a 3b 3b 20 20 20 20 2d 20 67 65 74 73 20 63 61 .;; - gets ca
51c0: 6c 6c 65 64 20 6f 6e 20 72 65 6d 6f 74 65 20 68 lled on remote h
51d0: 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 72 65 63 65 ost.;; - rece
51e0: 69 76 65 73 20 69 6e 66 6f 20 66 72 6f 6d 20 74 ives info from t
51f0: 68 65 20 2d 65 78 65 63 75 74 65 20 70 61 72 61 he -execute para
5200: 6d 0a 3b 3b 20 20 20 20 2d 20 70 61 73 73 65 73 m.;; - passes
5210: 20 69 6e 66 6f 20 74 6f 20 73 74 65 70 73 20 76 info to steps v
5220: 69 61 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e ia MT_CMDINFO en
5230: 76 20 76 61 72 20 28 66 75 74 75 72 65 20 69 73 v var (future is
5240: 20 74 6f 20 75 73 65 20 61 20 64 6f 74 20 66 69 to use a dot fi
5250: 6c 65 29 0a 3b 3b 20 20 20 20 2d 20 67 61 74 68 le).;; - gath
5260: 65 72 73 20 68 6f 73 74 20 69 6e 66 6f 20 61 6e ers host info an
5270: 64 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d d .;;===========
5280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
52c0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
52d0: 2d 65 78 65 63 75 74 65 22 29 0a 20 20 20 20 28 -execute"). (
52e0: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 6c 61 75 begin. (lau
52f0: 6e 63 68 3a 65 78 65 63 75 74 65 20 28 61 72 67 nch:execute (arg
5300: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 s:get-arg "-exec
5310: 75 74 65 22 29 29 0a 20 20 20 20 20 20 28 73 65 ute")). (se
5320: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
5330: 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d * #t)))..;;=====
5340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5380: 3d 0a 3b 3b 20 54 65 73 74 20 63 6f 6d 6d 61 6e =.;; Test comman
5390: 64 73 20 28 69 2e 65 2e 20 66 6f 72 20 75 73 65 ds (i.e. for use
53a0: 20 69 6e 73 69 64 65 20 74 65 73 74 73 29 0a 3b inside tests).;
53b0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
53c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53f0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
5400: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 gs:get-arg "-ste
5410: 70 22 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 p"). (if (not
5420: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
5430: 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e 0a INFO"))..(begin.
5440: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
5450: 30 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 0 "ERROR: MT_CMD
5460: 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 INFO env var not
5470: 20 73 65 74 2c 20 2d 73 74 65 70 20 6d 75 73 74 set, -step must
5480: 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 be called *insi
5490: 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 69 de* a megatest i
54a0: 6e 76 6f 6b 65 64 20 65 6e 76 69 72 6f 6e 6d 65 nvoked environme
54b0: 6e 74 21 22 29 0a 09 20 20 28 65 78 69 74 20 35 nt!").. (exit 5
54c0: 29 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 65 70 ))..(let* ((step
54d0: 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
54e0: 61 72 67 20 22 2d 73 74 65 70 22 29 29 0a 09 20 arg "-step"))..
54f0: 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 (cmdinfo
5500: 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 (read (open-inp
5510: 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 ut-string (base6
5520: 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 4:base64-decode
5530: 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (getenv "MT_CMDI
5540: 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 20 20 20 NFO")))))..
5550: 20 20 28 74 65 73 74 70 61 74 68 20 20 28 61 73 (testpath (as
5560: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
5570: 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 tpath cmdinfo))
5580: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e .. (test-n
5590: 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ame (assoc/defau
55a0: 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d lt 'test-name cm
55b0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
55c0: 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f (runscript (asso
55d0: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 c/default 'runsc
55e0: 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 ript cmdinfo))..
55f0: 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 74 20 (db-host
5600: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
5610: 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 'db-host cmdi
5620: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 nfo)).. (r
5630: 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f un-id (assoc/
5640: 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 default 'run-id
5650: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
5660: 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 20 20 (test-id
5670: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
5680: 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 test-id cmdinf
5690: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 o)).. (ite
56a0: 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 mdat (assoc/de
56b0: 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 fault 'itemdat
56c0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
56d0: 20 20 20 28 64 62 20 20 20 20 20 20 20 20 23 66 (db #f
56e0: 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 65 ).. (state
56f0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
5700: 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 g ":state"))..
5710: 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 28 (status (
5720: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 args:get-arg ":s
5730: 74 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 tatus"))..
5740: 20 28 6c 6f 67 66 69 6c 65 20 20 28 61 72 67 73 (logfile (args
5750: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f :get-arg "-setlo
5760: 67 22 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 g"))).. (change
5770: 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 -directory testp
5780: 61 74 68 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 ath).. (if (not
5790: 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 (setup-for-run)
57a0: 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ).. (begin.
57b0: 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ..(debug:print 0
57c0: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
57d0: 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 p, exiting")...(
57e0: 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 73 65 exit 1))).. (se
57f0: 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 t! db (open-db))
5800: 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 61 72 .. (if (not (ar
5810: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 72 gs:get-arg "-ser
5820: 76 65 72 22 29 29 0a 09 20 20 20 20 20 20 28 73 ver")).. (s
5830: 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d 73 65 74 erver:client-set
5840: 75 70 20 64 62 29 29 0a 09 20 20 28 69 66 20 28 up db)).. (if (
5850: 61 6e 64 20 73 74 61 74 65 20 73 74 61 74 75 73 and state status
5860: 29 0a 09 20 20 20 20 20 20 28 72 64 62 3a 74 65 ).. (rdb:te
5870: 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 ststep-set-statu
5880: 73 21 20 64 62 20 74 65 73 74 2d 69 64 20 73 74 s! db test-id st
5890: 65 70 20 73 74 61 74 65 20 73 74 61 74 75 73 20 ep state status
58a0: 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67 65 itemdat (args:ge
58b0: 74 2d 61 72 67 20 22 2d 6d 22 29 20 6c 6f 67 66 t-arg "-m") logf
58c0: 69 6c 65 29 0a 09 20 20 20 20 20 20 28 62 65 67 ile).. (beg
58d0: 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e in...(debug:prin
58e0: 74 20 30 20 22 45 52 52 4f 52 3a 20 59 6f 75 20 t 0 "ERROR: You
58f0: 6d 75 73 74 20 73 70 65 63 69 66 79 20 3a 73 74 must specify :st
5900: 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 20 ate and :status
5910: 77 69 74 68 20 65 76 65 72 79 20 63 61 6c 6c 20 with every call
5920: 74 6f 20 2d 73 74 65 70 22 29 0a 09 09 28 65 78 to -step")...(ex
5930: 69 74 20 36 29 29 29 0a 09 20 20 28 73 71 6c 69 it 6))).. (sqli
5940: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
5950: 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 ).. (set! *dids
5960: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 omething* #t))))
5970: 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a ..(if (or (args:
5980: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 get-arg "-setlog
5990: 22 29 20 20 20 20 20 20 20 3b 3b 20 73 69 6e 63 ") ;; sinc
59a0: 65 20 73 65 74 74 69 6e 67 20 75 70 20 69 73 20 e setting up is
59b0: 73 6f 20 63 6f 73 74 6c 79 20 6c 65 74 73 20 70 so costly lets p
59c0: 69 67 67 79 62 61 63 6b 20 6f 6e 20 2d 74 65 73 iggyback on -tes
59d0: 74 2d 73 74 61 74 75 73 0a 09 28 61 72 67 73 3a t-status..(args:
59e0: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f get-arg "-set-to
59f0: 70 6c 6f 67 22 29 0a 09 28 61 72 67 73 3a 67 65 plog")..(args:ge
5a00: 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 t-arg "-test-sta
5a10: 74 75 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 tus")..(args:get
5a20: 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 -arg "-set-value
5a30: 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 s")..(args:get-a
5a40: 72 67 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 rg "-load-test-d
5a50: 61 74 61 22 29 0a 09 28 61 72 67 73 3a 67 65 74 ata")..(args:get
5a60: 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 -arg "-runstep")
5a70: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
5a80: 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d "-summarize-item
5a90: 73 22 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f s")). (if (no
5aa0: 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d t (getenv "MT_CM
5ab0: 44 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e DINFO"))..(begin
5ac0: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
5ad0: 20 30 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 0 "ERROR: MT_CM
5ae0: 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f DINFO env var no
5af0: 74 20 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 73 20 t set, commands
5b00: 2d 74 65 73 74 2d 73 74 61 74 75 73 2c 20 2d 72 -test-status, -r
5b10: 75 6e 73 74 65 70 20 61 6e 64 20 2d 73 65 74 6c unstep and -setl
5b20: 6f 67 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 og must be calle
5b30: 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 d *inside* a meg
5b40: 61 74 65 73 74 20 65 6e 76 69 72 6f 6e 6d 65 6e atest environmen
5b50: 74 21 22 29 0a 09 20 20 28 65 78 69 74 20 35 29 t!").. (exit 5)
5b60: 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 )..(let* ((start
5b70: 69 6e 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d ingdir (current-
5b80: 64 69 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 directory))..
5b90: 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 (cmdinfo (
5ba0: 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 read (open-input
5bb0: 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a -string (base64:
5bc0: 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 base64-decode (g
5bd0: 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
5be0: 4f 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 O")))))..
5bf0: 28 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f (testpath (asso
5c00: 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 c/default 'testp
5c10: 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 ath cmdinfo))..
5c20: 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d (test-nam
5c30: 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 e (assoc/default
5c40: 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 'test-name cmdi
5c50: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 nfo)).. (r
5c60: 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f unscript (assoc/
5c70: 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 default 'runscri
5c80: 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 pt cmdinfo))..
5c90: 20 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 (db-host
5ca0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
5cb0: 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 db-host cmdinf
5cc0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
5cd0: 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 -id (assoc/de
5ce0: 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 fault 'run-id
5cf0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
5d00: 20 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 (test-id (a
5d10: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
5d20: 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 st-id cmdinfo)
5d30: 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 ).. (itemd
5d40: 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 at (assoc/defa
5d50: 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 ult 'itemdat c
5d60: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
5d70: 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 0a (db #f).
5d80: 09 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 . (state
5d90: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
5da0: 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 ":state"))..
5db0: 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 (status (
5dc0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 args:get-arg ":s
5dd0: 74 61 74 75 73 22 29 29 29 0a 09 20 20 28 63 68 tatus"))).. (ch
5de0: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
5df0: 65 73 74 70 61 74 68 29 0a 09 20 20 28 69 66 20 estpath).. (if
5e00: 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d (not (setup-for-
5e10: 72 75 6e 29 29 0a 09 20 20 20 20 20 20 28 62 65 run)).. (be
5e20: 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 gin...(debug:pri
5e30: 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 nt 0 "Failed to
5e40: 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 setup, exiting")
5e50: 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 ...(exit 1)))..
5e60: 20 28 73 65 74 21 20 64 62 20 28 6f 70 65 6e 2d (set! db (open-
5e70: 64 62 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 db)).. (if (not
5e80: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5e90: 2d 73 65 72 76 65 72 22 29 29 0a 09 20 20 20 20 -server"))..
5ea0: 20 20 28 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 (server:client
5eb0: 2d 73 65 74 75 70 20 64 62 29 29 0a 09 20 20 28 -setup db)).. (
5ec0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
5ed0: 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 "-load-test-dat
5ee0: 61 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 68 61 a").. ;; ha
5ef0: 73 20 73 75 62 20 63 6f 6d 6d 61 6e 64 73 20 74 s sub commands t
5f00: 68 61 74 20 61 72 65 20 72 64 62 3a 0a 09 20 20 hat are rdb:..
5f10: 20 20 20 20 28 64 62 3a 6c 6f 61 64 2d 74 65 73 (db:load-tes
5f20: 74 2d 64 61 74 61 20 64 62 20 74 65 73 74 2d 69 t-data db test-i
5f30: 64 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 d)).. (if (args
5f40: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f :get-arg "-setlo
5f50: 67 22 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 g").. (let
5f60: 28 28 6c 6f 67 66 6e 61 6d 65 20 28 61 72 67 73 ((logfname (args
5f70: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f :get-arg "-setlo
5f80: 67 22 29 29 29 0a 09 09 28 72 64 62 3a 74 65 73 g")))...(rdb:tes
5f90: 74 2d 73 65 74 2d 6c 6f 67 21 20 64 62 20 74 65 t-set-log! db te
5fa0: 73 74 2d 69 64 20 6c 6f 67 66 6e 61 6d 65 29 29 st-id logfname))
5fb0: 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 ).. (if (args:g
5fc0: 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 et-arg "-set-top
5fd0: 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 28 72 74 log").. (rt
5fe0: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 74 6f ests:test-set-to
5ff0: 70 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 plog! db run-id
6000: 74 65 73 74 2d 6e 61 6d 65 20 28 61 72 67 73 3a test-name (args:
6010: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f get-arg "-set-to
6020: 70 6c 6f 67 22 29 29 29 0a 09 20 20 28 69 66 20 plog"))).. (if
6030: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6040: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 summarize-items"
6050: 29 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 3a ).. (tests:
6060: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 summarize-items
6070: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
6080: 61 6d 65 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 ame #t)) ;; do f
6090: 6f 72 63 65 20 68 65 72 65 0a 09 20 20 28 69 66 orce here.. (if
60a0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
60b0: 2d 72 75 6e 73 74 65 70 22 29 0a 09 20 20 20 20 -runstep")..
60c0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d (if (null? rem
60d0: 61 72 67 73 29 0a 09 09 20 20 28 62 65 67 69 6e args)... (begin
60e0: 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
60f0: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 6e 6f int 0 "ERROR: no
6100: 74 68 69 6e 67 20 73 70 65 63 69 66 69 65 64 20 thing specified
6110: 74 6f 20 72 75 6e 21 22 29 0a 09 09 20 20 20 20 to run!")...
6120: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
6130: 65 21 20 64 62 29 0a 09 09 20 20 20 20 28 65 78 e! db)... (ex
6140: 69 74 20 36 29 29 0a 09 09 20 20 28 6c 65 74 2a it 6))... (let*
6150: 20 28 28 73 74 65 70 6e 61 6d 65 20 20 20 28 61 ((stepname (a
6160: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
6170: 6e 73 74 65 70 22 29 29 0a 09 09 09 20 28 6c 6f nstep")).... (lo
6180: 67 70 72 6f 66 69 6c 65 20 28 61 72 67 73 3a 67 gprofile (args:g
6190: 65 74 2d 61 72 67 20 22 2d 6c 6f 67 70 72 6f 22 et-arg "-logpro"
61a0: 29 29 0a 09 09 09 20 28 6c 6f 67 66 69 6c 65 20 )).... (logfile
61b0: 20 20 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d (conc stepnam
61c0: 65 20 22 2e 6c 6f 67 22 29 29 0a 09 09 09 20 28 e ".log")).... (
61d0: 63 6d 64 20 20 20 20 20 20 20 20 28 69 66 20 28 cmd (if (
61e0: 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 23 null? remargs) #
61f0: 66 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 f (car remargs))
6200: 29 0a 09 09 09 20 28 70 61 72 61 6d 73 20 20 20 ).... (params
6210: 20 20 28 69 66 20 63 6d 64 20 28 63 64 72 20 72 (if cmd (cdr r
6220: 65 6d 61 72 67 73 29 20 27 28 29 29 29 0a 09 09 emargs) '()))...
6230: 09 20 28 65 78 69 74 73 74 61 74 20 20 20 23 66 . (exitstat #f
6240: 29 0a 09 09 09 20 28 73 68 65 6c 6c 20 20 20 20 ).... (shell
6250: 20 20 28 6c 61 73 74 20 28 73 74 72 69 6e 67 2d (last (string-
6260: 73 70 6c 69 74 20 28 67 65 74 2d 65 6e 76 69 72 split (get-envir
6270: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
6280: 22 53 48 45 4c 4c 22 29 20 22 2f 22 29 29 29 0a "SHELL") "/"))).
6290: 09 09 09 20 28 72 65 64 69 72 20 20 20 20 20 20 ... (redir
62a0: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
62b0: 79 6d 62 6f 6c 20 73 68 65 6c 6c 29 0a 09 09 09 ymbol shell)....
62c0: 09 20 20 20 20 20 20 20 28 28 74 63 73 68 20 63 . ((tcsh c
62d0: 73 68 20 6b 73 68 29 20 20 20 20 22 3e 26 22 29 sh ksh) ">&")
62e0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 7a 73 ..... ((zs
62f0: 68 20 62 61 73 68 20 73 68 20 61 73 68 29 20 22 h bash sh ash) "
6300: 32 3e 26 31 20 3e 22 29 0a 09 09 09 09 20 20 20 2>&1 >").....
6310: 20 20 20 20 28 65 6c 73 65 20 22 3e 26 22 29 29 (else ">&"))
6320: 29 0a 09 09 09 20 28 66 75 6c 6c 63 6d 64 20 20 ).... (fullcmd
6330: 20 20 28 63 6f 6e 63 20 22 28 22 20 28 73 74 72 (conc "(" (str
6340: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
6350: 0a 09 09 09 09 09 09 28 63 6f 6e 73 20 63 6d 64 .......(cons cmd
6360: 20 70 61 72 61 6d 73 29 20 22 20 22 29 0a 09 09 params) " ")...
6370: 09 09 09 20 20 20 22 29 20 22 20 72 65 64 69 72 ... ") " redir
6380: 20 22 20 22 20 6c 6f 67 66 69 6c 65 29 29 29 0a " " logfile))).
6390: 09 09 20 20 20 20 3b 3b 20 6d 61 72 6b 20 74 68 .. ;; mark th
63a0: 65 20 73 74 61 72 74 20 6f 66 20 74 68 65 20 74 e start of the t
63b0: 65 73 74 0a 09 09 20 20 20 20 28 72 64 62 3a 74 est... (rdb:t
63c0: 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 eststep-set-stat
63d0: 75 73 21 20 64 62 20 74 65 73 74 2d 69 64 20 73 us! db test-id s
63e0: 74 65 70 6e 61 6d 65 20 22 73 74 61 72 74 22 20 tepname "start"
63f0: 22 6e 2f 61 22 20 69 74 65 6d 64 61 74 20 28 61 "n/a" itemdat (a
6400: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
6410: 29 20 6c 6f 67 66 69 6c 65 29 0a 09 09 20 20 20 ) logfile)...
6420: 20 3b 3b 20 63 6c 6f 73 65 20 74 68 65 20 64 62 ;; close the db
6430: 0a 09 09 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 ... ;; (sqlit
6440: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
6450: 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 74 68 ... ;; run th
6460: 65 20 74 65 73 74 20 73 74 65 70 0a 09 09 20 20 e test step...
6470: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
6480: 20 22 49 4e 46 4f 3a 20 52 75 6e 6e 69 6e 67 20 "INFO: Running
6490: 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 5c 22 22 \"" fullcmd "\""
64a0: 29 0a 09 09 20 20 20 20 28 63 68 61 6e 67 65 2d )... (change-
64b0: 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 directory starti
64c0: 6e 67 64 69 72 29 0a 09 09 20 20 20 20 28 73 65 ngdir)... (se
64d0: 74 21 20 65 78 69 74 73 74 61 74 20 28 73 79 73 t! exitstat (sys
64e0: 74 65 6d 20 66 75 6c 6c 63 6d 64 29 29 20 3b 3b tem fullcmd)) ;;
64f0: 20 63 6d 64 20 70 61 72 61 6d 73 29 29 0a 09 09 cmd params))...
6500: 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 (set! *globa
6510: 6c 65 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 lexitstatus* exi
6520: 74 73 74 61 74 29 0a 09 09 20 20 20 20 28 63 68 tstat)... (ch
6530: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
6540: 65 73 74 70 61 74 68 29 0a 09 09 20 20 20 20 3b estpath)... ;
6550: 3b 20 72 65 2d 6f 70 65 6e 20 74 68 65 20 64 62 ; re-open the db
6560: 0a 09 09 20 20 20 20 3b 3b 20 28 73 65 74 21 20 ... ;; (set!
6570: 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 09 db (open-db))...
6580: 20 20 20 20 3b 3b 20 28 69 66 20 28 6e 6f 74 20 ;; (if (not
6590: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
65a0: 73 65 72 76 65 72 22 29 29 0a 09 09 20 20 20 20 server"))...
65b0: 3b 3b 20 20 20 20 20 28 73 65 72 76 65 72 3a 63 ;; (server:c
65c0: 6c 69 65 6e 74 2d 73 65 74 75 70 20 64 62 29 29 lient-setup db))
65d0: 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 6c 6f ... ;; run lo
65e0: 67 70 72 6f 20 69 66 20 61 70 70 6c 69 63 61 62 gpro if applicab
65f0: 6c 65 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d 72 le ;; (process-r
6600: 75 6e 20 22 6c 73 22 20 28 6c 69 73 74 20 22 2f un "ls" (list "/
6610: 66 6f 6f 22 20 22 32 3e 26 31 22 20 22 62 6c 61 foo" "2>&1" "bla
6620: 68 2e 6c 6f 67 22 29 29 0a 09 09 20 20 20 20 28 h.log"))... (
6630: 69 66 20 6c 6f 67 70 72 6f 66 69 6c 65 0a 09 09 if logprofile...
6640: 09 28 6c 65 74 2a 20 28 28 68 74 6d 6c 6c 6f 67 .(let* ((htmllog
6650: 66 69 6c 65 20 28 63 6f 6e 63 20 73 74 65 70 6e file (conc stepn
6660: 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 09 ame ".html"))...
6670: 09 20 20 20 20 20 20 20 28 6f 6c 64 65 78 69 74 . (oldexit
6680: 73 74 61 74 20 65 78 69 74 73 74 61 74 29 0a 09 stat exitstat)..
6690: 09 09 20 20 20 20 20 20 20 28 63 6d 64 20 20 20 .. (cmd
66a0: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e (string-in
66b0: 74 65 72 73 70 65 72 73 65 20 28 6c 69 73 74 20 tersperse (list
66c0: 22 6c 6f 67 70 72 6f 22 20 6c 6f 67 70 72 6f 66 "logpro" logprof
66d0: 69 6c 65 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 ile htmllogfile
66e0: 22 3c 22 20 6c 6f 67 66 69 6c 65 20 22 3e 22 20 "<" logfile ">"
66f0: 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 (conc stepname "
6700: 5f 6c 6f 67 70 72 6f 2e 6c 6f 67 22 29 29 20 22 _logpro.log")) "
6710: 20 22 29 29 29 0a 09 09 09 20 20 28 64 65 62 75 "))).... (debu
6720: 67 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 4f 3a g:print 2 "INFO:
6730: 20 72 75 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 running \"" cmd
6740: 20 22 5c 22 22 29 0a 09 09 09 20 20 28 63 68 61 "\"").... (cha
6750: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 nge-directory st
6760: 61 72 74 69 6e 67 64 69 72 29 0a 09 09 09 20 20 artingdir)....
6770: 28 73 65 74 21 20 65 78 69 74 73 74 61 74 20 28 (set! exitstat (
6780: 73 79 73 74 65 6d 20 63 6d 64 29 29 0a 09 09 09 system cmd))....
6790: 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 (set! *globale
67a0: 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 74 73 xitstatus* exits
67b0: 74 61 74 29 20 3b 3b 20 6e 6f 20 6e 65 63 65 73 tat) ;; no neces
67c0: 73 61 72 79 0a 09 09 09 20 20 28 63 68 61 6e 67 sary.... (chang
67d0: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test
67e0: 70 61 74 68 29 0a 09 09 09 20 20 28 72 64 62 3a path).... (rdb:
67f0: 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 64 62 test-set-log! db
6800: 20 74 65 73 74 2d 69 64 20 68 74 6d 6c 6c 6f 67 test-id htmllog
6810: 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 28 6c file)))... (l
6820: 65 74 20 28 28 6d 73 67 20 28 61 72 67 73 3a 67 et ((msg (args:g
6830: 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 29 0a 09 et-arg "-m")))..
6840: 09 20 20 20 20 20 20 28 72 64 62 3a 74 65 73 74 . (rdb:test
6850: 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
6860: 20 64 62 20 74 65 73 74 2d 69 64 20 73 74 65 70 db test-id step
6870: 6e 61 6d 65 20 22 65 6e 64 22 20 65 78 69 74 73 name "end" exits
6880: 74 61 74 20 69 74 65 6d 64 61 74 20 6d 73 67 20 tat itemdat msg
6890: 6c 6f 67 66 69 6c 65 29 29 0a 09 09 20 20 20 20 logfile))...
68a0: 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 ;; (sqlite3:fina
68b0: 6c 69 7a 65 21 20 64 62 29 0a 09 09 20 20 20 20 lize! db)...
68c0: 3b 3b 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 ;;(if (not (eq?
68d0: 65 78 69 74 73 74 61 74 20 30 29 29 0a 09 09 20 exitstat 0))...
68e0: 20 20 20 3b 3b 09 28 65 78 69 74 20 32 35 34 29 ;;.(exit 254)
68f0: 29 20 3b 3b 20 28 65 78 69 74 20 65 78 69 74 73 ) ;; (exit exits
6900: 74 61 74 29 20 64 6f 65 73 6e 27 74 20 77 6f 72 tat) doesn't wor
6910: 6b 3f 21 3f 0a 09 09 20 20 3b 3b 20 6f 70 65 6e k?!?... ;; open
6920: 20 74 68 65 20 64 62 0a 09 09 20 20 3b 3b 20 6d the db... ;; m
6930: 61 72 6b 20 74 68 65 20 65 6e 64 20 6f 66 20 74 ark the end of t
6940: 68 65 20 74 65 73 74 0a 09 09 20 20 29 29 29 0a he test... ))).
6950: 09 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 . (if (or (args
6960: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d :get-arg "-test-
6970: 73 74 61 74 75 73 22 29 0a 09 09 20 20 28 61 72 status")... (ar
6980: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
6990: 2d 76 61 6c 75 65 73 22 29 29 0a 09 20 20 20 20 -values"))..
69a0: 20 20 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 (let ((newstat
69b0: 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e us (cond.....((n
69c0: 75 6d 62 65 72 3f 20 73 74 61 74 75 73 29 20 20 umber? status)
69d0: 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f (if (equal?
69e0: 20 73 74 61 74 75 73 20 30 29 20 22 50 41 53 53 status 0) "PASS
69f0: 22 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 " "FAIL")).....(
6a00: 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 74 (and (string? st
6a10: 61 74 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 atus).....
6a20: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
6a30: 73 74 61 74 75 73 29 29 28 69 66 20 28 65 71 75 status))(if (equ
6a40: 61 6c 3f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d al? (string->num
6a50: 62 65 72 20 73 74 61 74 75 73 29 20 30 29 20 22 ber status) 0) "
6a60: 50 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 PASS" "FAIL"))..
6a70: 09 09 09 28 65 6c 73 65 20 73 74 61 74 75 73 29 ...(else status)
6a80: 29 29 0a 09 09 20 20 20 20 3b 3b 20 74 72 61 6e ))... ;; tran
6a90: 73 66 65 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 sfer relevant ke
6aa0: 79 73 20 69 6e 74 6f 20 61 20 68 61 73 68 20 74 ys into a hash t
6ab0: 6f 20 62 65 20 70 61 73 73 65 64 20 74 6f 20 74 o be passed to t
6ac0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a est-set-status!.
6ad0: 09 09 20 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 .. ;; could u
6ae0: 73 65 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 se an assoc list
6af0: 20 49 20 67 75 65 73 73 2e 20 0a 09 09 20 20 20 I guess. ...
6b00: 20 28 6f 74 68 65 72 64 61 74 61 20 28 6c 65 74 (otherdata (let
6b10: 20 28 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 ((res (make-has
6b20: 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 09 20 h-table))).....
6b30: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
6b40: 61 20 28 6b 65 79 29 0a 09 09 09 09 09 20 20 20 a (key)......
6b50: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
6b60: 61 72 67 20 6b 65 79 29 0a 09 09 09 09 09 09 20 arg key).......
6b70: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
6b80: 20 72 65 73 20 6b 65 79 20 28 61 72 67 73 3a 67 res key (args:g
6b90: 65 74 2d 61 72 67 20 6b 65 79 29 29 29 29 0a 09 et-arg key))))..
6ba0: 09 09 09 09 20 20 20 28 6c 69 73 74 20 22 3a 76 .... (list ":v
6bb0: 61 6c 75 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 alue" ":tol" ":e
6bc0: 78 70 65 63 74 65 64 22 20 22 3a 66 69 72 73 74 xpected" ":first
6bd0: 5f 65 72 72 22 20 22 3a 66 69 72 73 74 5f 77 61 _err" ":first_wa
6be0: 72 6e 22 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 rn" ":units" ":c
6bf0: 61 74 65 67 6f 72 79 22 20 22 3a 76 61 72 69 61 ategory" ":varia
6c00: 62 6c 65 22 29 29 0a 09 09 09 09 20 72 65 73 29 ble"))..... res)
6c10: 29 29 0a 09 09 28 69 66 20 28 61 6e 64 20 28 61 ))...(if (and (a
6c20: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
6c30: 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 09 20 st-status")....
6c40: 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 65 29 0a (or (not state).
6c50: 09 09 09 20 20 20 20 20 28 6e 6f 74 20 73 74 61 ... (not sta
6c60: 74 75 73 29 29 29 0a 09 09 20 20 20 20 28 62 65 tus)))... (be
6c70: 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 gin... (deb
6c80: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
6c90: 52 3a 20 59 6f 75 20 6d 75 73 74 20 73 70 65 63 R: You must spec
6ca0: 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a ify :state and :
6cb0: 73 74 61 74 75 73 20 77 69 74 68 20 65 76 65 72 status with ever
6cc0: 79 20 63 61 6c 6c 20 74 6f 20 2d 74 65 73 74 2d y call to -test-
6cd0: 73 74 61 74 75 73 5c 6e 22 20 68 65 6c 70 29 0a status\n" help).
6ce0: 09 09 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 .. (sqlite3
6cf0: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 :finalize! db)..
6d00: 09 20 20 20 20 20 20 28 65 78 69 74 20 36 29 29 . (exit 6))
6d10: 29 0a 09 09 28 6c 65 74 20 28 28 6d 73 67 20 28 )...(let ((msg (
6d20: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
6d30: 22 29 29 29 0a 09 09 20 20 28 72 74 65 73 74 73 ")))... (rtests
6d40: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
6d50: 21 20 64 62 20 74 65 73 74 2d 69 64 20 73 74 61 ! db test-id sta
6d60: 74 65 20 6e 65 77 73 74 61 74 75 73 20 6d 73 67 te newstatus msg
6d70: 20 6f 74 68 65 72 64 61 74 61 29 29 29 29 0a 09 otherdata))))..
6d80: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
6d90: 69 7a 65 21 20 64 62 29 0a 09 20 20 28 73 65 74 ize! db).. (set
6da0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
6db0: 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d #t))))..;;=====
6dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e00: 3d 0a 3b 3b 20 56 61 72 69 6f 75 73 20 68 65 6c =.;; Various hel
6e10: 70 65 72 20 63 6f 6d 6d 61 6e 64 73 20 63 61 6e per commands can
6e20: 20 67 6f 20 62 65 6c 6f 77 20 68 65 72 65 0a 3b go below here.;
6e30: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
6e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e70: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
6e80: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f gs:get-arg "-sho
6e90: 77 6b 65 79 73 22 29 0a 20 20 20 20 28 6c 65 74 wkeys"). (let
6ea0: 20 28 28 64 62 20 23 66 29 0a 09 20 20 28 6b 65 ((db #f).. (ke
6eb0: 79 73 20 23 66 29 29 0a 20 20 20 20 20 20 28 69 ys #f)). (i
6ec0: 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f f (not (setup-fo
6ed0: 72 2d 72 75 6e 29 29 0a 09 20 20 28 62 65 67 69 r-run)).. (begi
6ee0: 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 n.. (debug:pr
6ef0: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f int 0 "Failed to
6f00: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
6f10: 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 ).. (exit 1))
6f20: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 64 62 ). (set! db
6f30: 20 28 6f 70 65 6e 2d 64 62 29 29 0a 20 20 20 20 (open-db)).
6f40: 20 20 28 69 66 20 28 6e 6f 74 20 28 61 72 67 73 (if (not (args
6f50: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 72 76 65 :get-arg "-serve
6f60: 72 22 29 29 0a 09 20 20 28 73 65 72 76 65 72 3a r")).. (server:
6f70: 63 6c 69 65 6e 74 2d 73 65 74 75 70 20 64 62 29 client-setup db)
6f80: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 6b 65 ). (set! ke
6f90: 79 73 20 28 72 64 62 3a 67 65 74 2d 6b 65 79 73 ys (rdb:get-keys
6fa0: 20 64 62 29 29 0a 20 20 20 20 20 20 28 64 65 62 db)). (deb
6fb0: 75 67 3a 70 72 69 6e 74 20 31 20 22 4b 65 79 73 ug:print 1 "Keys
6fc0: 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 : " (string-inte
6fd0: 72 73 70 65 72 73 65 20 28 6d 61 70 20 6b 65 79 rsperse (map key
6fe0: 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b :get-fieldname k
6ff0: 65 79 73 29 20 22 2c 20 22 29 29 0a 20 20 20 20 eys) ", ")).
7000: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
7010: 69 7a 65 21 20 64 62 29 0a 20 20 20 20 20 20 28 ize! db). (
7020: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
7030: 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 ng* #t)))..(if (
7040: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 args:get-arg "-g
7050: 75 69 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ui"). (begin.
7060: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
7070: 6e 74 20 30 20 22 4c 6f 6f 6b 20 61 74 20 74 68 nt 0 "Look at th
7080: 65 20 64 61 73 68 62 6f 61 72 64 20 66 6f 72 20 e dashboard for
7090: 6e 6f 77 22 29 0a 20 20 20 20 20 20 3b 3b 20 28 now"). ;; (
70a0: 6d 65 67 61 74 65 73 74 2d 67 75 69 29 0a 20 20 megatest-gui).
70b0: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
70c0: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
70d0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
70e0: 67 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 g "-gen-megatest
70f0: 2d 61 72 65 61 22 29 0a 20 20 20 20 28 62 65 67 -area"). (beg
7100: 69 6e 0a 20 20 20 20 20 20 28 67 65 6e 65 78 61 in. (genexa
7110: 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 mple:mk-megatest
7120: 2e 63 6f 6e 66 69 67 29 0a 20 20 20 20 20 20 28 .config). (
7130: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
7140: 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 ng* #t)))..(if (
7150: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 args:get-arg "-g
7160: 65 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 en-megatest-test
7170: 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 65 "). (let ((te
7180: 73 74 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 stname (args:get
7190: 2d 61 72 67 20 22 2d 67 65 6e 2d 6d 65 67 61 74 -arg "-gen-megat
71a0: 65 73 74 2d 74 65 73 74 22 29 29 29 0a 20 20 20 est-test"))).
71b0: 20 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 3a 6d (genexample:m
71c0: 6b 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 20 k-megatest-test
71d0: 74 65 73 74 6e 61 6d 65 29 0a 20 20 20 20 20 20 testname).
71e0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
71f0: 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d ing* #t)))..;;==
7200: 3d 3d 3d 3d 3d 3d 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 0a 3b 3b 20 55 70 64 61 74 65 20 74 ====.;; Update t
7250: 68 65 20 64 61 74 61 62 61 73 65 20 73 63 68 65 he database sche
7260: 6d 61 20 6f 6e 20 72 65 71 75 65 73 74 0a 3b 3b ma on request.;;
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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
72b0: 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 ======..(if (arg
72c0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 62 75 s:get-arg "-rebu
72d0: 69 6c 64 2d 64 62 22 29 0a 20 20 20 20 28 62 65 ild-db"). (be
72e0: 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e gin. (if (n
72f0: 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 ot (setup-for-ru
7300: 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 n)).. (begin..
7310: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
7320: 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 0 "Failed to set
7330: 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 up, exiting") ..
7340: 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
7350: 20 20 20 20 20 3b 3b 20 6e 6f 77 20 63 61 6e 20 ;; now can
7360: 66 69 6e 64 20 6f 75 72 20 64 62 0a 20 20 20 20 find our db.
7370: 20 20 28 73 65 74 21 20 64 62 20 28 6f 70 65 6e (set! db (open
7380: 2d 64 62 29 29 0a 20 20 20 20 20 20 28 70 61 74 -db)). (pat
7390: 63 68 2d 64 62 20 64 62 29 0a 20 20 20 20 20 20 ch-db db).
73a0: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
73b0: 65 21 20 64 62 29 0a 20 20 20 20 20 20 28 73 65 e! db). (se
73c0: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
73d0: 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d * #t)))..;;=====
73e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
73f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7420: 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 =.;; Update the
7430: 74 65 73 74 73 20 6d 65 74 61 20 64 61 74 61 20 tests meta data
7440: 66 72 6f 6d 20 74 68 65 20 74 65 73 74 63 6f 6e from the testcon
7450: 66 69 67 20 66 69 6c 65 73 0a 3b 3b 3d 3d 3d 3d fig files.;;====
7460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
74a0: 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ==..(if (args:ge
74b0: 74 2d 61 72 67 20 22 2d 75 70 64 61 74 65 2d 6d t-arg "-update-m
74c0: 65 74 61 22 29 0a 20 20 20 20 28 62 65 67 69 6e eta"). (begin
74d0: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
74e0: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
74f0: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
7500: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
7510: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
7520: 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 exiting") ..
7530: 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 (exit 1))).
7540: 20 20 3b 3b 20 6e 6f 77 20 63 61 6e 20 66 69 6e ;; now can fin
7550: 64 20 6f 75 72 20 64 62 0a 20 20 20 20 20 20 28 d our db. (
7560: 73 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 set! db (open-db
7570: 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f )). (if (no
7580: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
7590: 22 2d 73 65 72 76 65 72 22 29 29 0a 09 20 20 28 "-server")).. (
75a0: 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d 73 65 server:client-se
75b0: 74 75 70 20 64 62 29 29 0a 20 20 20 20 20 20 28 tup db)). (
75c0: 72 75 6e 73 3a 75 70 64 61 74 65 2d 61 6c 6c 2d runs:update-all-
75d0: 74 65 73 74 5f 6d 65 74 61 20 64 62 29 0a 20 20 test_meta db).
75e0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e (sqlite3:fin
75f0: 61 6c 69 7a 65 21 20 64 62 29 0a 20 20 20 20 20 alize! db).
7600: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
7610: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d hing* #t)))..;;=
7620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7660: 3d 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 61 =====.;; Start a
7670: 20 72 65 70 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d repl.;;========
7680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
76c0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
76d0: 67 20 22 2d 72 65 70 6c 22 29 0a 20 20 20 20 28 g "-repl"). (
76e0: 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 let* ((toppath (
76f0: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
7700: 09 20 20 20 28 64 62 20 20 20 20 20 20 28 69 66 . (db (if
7710: 20 74 6f 70 70 61 74 68 20 28 6f 70 65 6e 2d 64 toppath (open-d
7720: 62 29 20 23 66 29 29 29 0a 20 20 20 20 20 20 28 b) #f))). (
7730: 69 66 20 64 62 0a 09 20 20 28 62 65 67 69 6e 0a if db.. (begin.
7740: 09 20 20 20 20 28 73 65 74 21 20 2a 64 62 2a 20 . (set! *db*
7750: 64 62 29 0a 09 20 20 20 20 28 69 66 20 28 6e 6f db).. (if (no
7760: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
7770: 22 2d 73 65 72 76 65 72 22 29 29 0a 09 09 28 73 "-server"))...(s
7780: 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d 73 65 74 erver:client-set
7790: 75 70 20 64 62 29 29 0a 09 20 20 20 20 28 69 6d up db)).. (im
77a0: 70 6f 72 74 20 72 65 61 64 6c 69 6e 65 29 0a 09 port readline)..
77b0: 20 20 20 20 28 69 6d 70 6f 72 74 20 61 70 72 6f (import apro
77c0: 70 6f 73 29 0a 09 20 20 20 20 28 67 6e 75 2d 68 pos).. (gnu-h
77d0: 69 73 74 6f 72 79 2d 69 6e 73 74 61 6c 6c 2d 66 istory-install-f
77e0: 69 6c 65 2d 6d 61 6e 61 67 65 72 0a 09 20 20 20 ile-manager..
77f0: 20 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 (string-append
7800: 0a 09 20 20 20 20 20 20 28 6f 72 20 28 67 65 74 .. (or (get
7810: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
7820: 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2e iable "HOME") ".
7830: 22 29 20 22 2f 2e 6d 65 67 61 74 65 73 74 5f 68 ") "/.megatest_h
7840: 69 73 74 6f 72 79 22 29 29 0a 09 20 20 20 20 28 istory")).. (
7850: 63 75 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f current-input-po
7860: 72 74 20 28 6d 61 6b 65 2d 67 6e 75 2d 72 65 61 rt (make-gnu-rea
7870: 64 6c 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 61 dline-port "mega
7880: 74 65 73 74 3e 20 22 29 29 0a 09 20 20 20 20 28 test> ")).. (
7890: 72 65 70 6c 29 29 29 0a 20 20 20 20 20 20 28 73 repl))). (s
78a0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
78b0: 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d g* #t)))..;;====
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 3d ================
78f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7900: 3d 3d 0a 3b 3b 20 45 78 69 74 20 61 6e 64 20 63 ==.;; Exit and c
7910: 6c 65 61 6e 20 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d lean up.;;======
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: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7960: 0a 0a 28 69 66 20 28 6e 6f 74 20 2a 64 69 64 73 ..(if (not *dids
7970: 6f 6d 65 74 68 69 6e 67 2a 29 0a 20 20 20 20 28 omething*). (
7980: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 68 65 debug:print 0 he
7990: 6c 70 29 29 0a 0a 28 69 66 20 28 6e 6f 74 20 28 lp))..(if (not (
79a0: 65 71 3f 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 eq? *globalexits
79b0: 74 61 74 75 73 2a 20 30 29 29 0a 20 20 20 20 28 tatus* 0)). (
79c0: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
79d0: 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 -arg "-runtests"
79e0: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
79f0: 2d 72 75 6e 61 6c 6c 22 29 29 0a 20 20 20 20 20 -runall")).
7a00: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
7a10: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
7a20: 74 20 30 20 22 4e 4f 54 45 3a 20 53 75 62 70 72 t 0 "NOTE: Subpr
7a30: 6f 63 65 73 73 65 73 20 77 69 74 68 20 6e 6f 6e ocesses with non
7a40: 2d 7a 65 72 6f 20 65 78 69 74 20 63 6f 64 65 20 -zero exit code
7a50: 64 65 74 65 63 74 65 64 3a 20 22 20 2a 67 6c 6f detected: " *glo
7a60: 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 29 0a balexitstatus*).
7a70: 20 20 20 20 20 20 20 20 20 20 20 28 65 78 69 74 (exit
7a80: 20 30 29 29 0a 20 20 20 20 20 20 20 20 28 63 61 0)). (ca
7a90: 73 65 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 se *globalexitst
7aa0: 61 74 75 73 2a 0a 20 20 20 20 20 20 20 20 20 28 atus*. (
7ab0: 28 30 29 28 65 78 69 74 20 30 29 29 0a 20 20 20 (0)(exit 0)).
7ac0: 20 20 20 20 20 20 28 28 31 29 28 65 78 69 74 20 ((1)(exit
7ad0: 31 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 32 1)). ((2
7ae0: 29 28 65 78 69 74 20 32 29 29 0a 20 20 20 20 20 )(exit 2)).
7af0: 20 20 20 20 28 65 6c 73 65 20 28 65 78 69 74 20 (else (exit
7b00: 33 29 29 29 29 29 0a 3))))).