Artifact
1d8e12b57ca2c3581cd8795ad5c6e4001b9b3323
File
megatest.scm
— part of check-in
[ae6dbecf17]
at
2011-05-01 23:05:22
on branch trunk
— Importing 1.0.1 version of megatest, (nb// work in progress, please wait for next release)
(user:
matt
size: 17524)
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 31 2c 20 4d 61 74 74 68 65 77 20 6-2011, 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 28 69 6e 63 6c 75 PURPOSE...(inclu
0150: 64 65 20 22 63 6f 6d 6d 6f 6e 2e 73 63 6d 22 29 de "common.scm")
0160: 0a 28 64 65 66 69 6e 65 20 6d 65 67 61 74 65 73 .(define megates
0170: 74 2d 76 65 72 73 69 6f 6e 20 31 2e 30 29 0a 0a t-version 1.0)..
0180: 28 64 65 66 69 6e 65 20 68 65 6c 70 20 28 63 6f (define help (co
0190: 6e 63 20 22 0a 4d 65 67 61 74 65 73 74 2c 20 64 nc ".Megatest, d
01a0: 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20 61 74 20 ocumentation at
01b0: 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f http://www.kiato
01c0: 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f 6f 70 a.com/fossils/op
01d0: 65 6e 73 72 63 0a 20 20 76 65 72 73 69 6f 6e 20 ensrc. version
01e0: 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 " megatest-versi
01f0: 6f 6e 20 22 0a 20 20 6c 69 63 65 6e 73 65 20 47 on ". license G
0200: 50 4c 2c 20 43 6f 70 79 72 69 67 68 74 20 4d 61 PL, Copyright Ma
0210: 74 74 20 57 65 6c 6c 61 6e 64 20 32 30 30 36 2d tt Welland 2006-
0220: 32 30 31 31 0a 0a 55 73 61 67 65 3a 20 6d 65 67 2011..Usage: meg
0230: 61 74 65 73 74 20 5b 6f 70 74 69 6f 6e 73 5d 0a atest [options].
0240: 20 20 2d 68 20 20 20 20 20 20 20 20 20 20 20 20 -h
0250: 20 20 20 20 20 20 20 20 20 20 3a 20 74 68 69 73 : this
0260: 20 68 65 6c 70 0a 0a 50 72 6f 63 65 73 73 20 61 help..Process a
0270: 6e 64 20 74 65 73 74 20 72 75 6e 6e 69 6e 67 0a nd test running.
0280: 20 20 2d 72 75 6e 61 6c 6c 20 20 20 20 20 20 20 -runall
0290: 20 20 20 20 20 20 20 20 20 20 3a 20 72 75 6e 20 : run
02a0: 61 6c 6c 20 74 65 73 74 73 20 74 68 61 74 20 61 all tests that a
02b0: 72 65 20 6e 6f 74 20 73 74 61 74 65 20 43 4f 4d re not state COM
02c0: 50 4c 45 54 45 44 20 61 6e 64 20 73 74 61 74 75 PLETED and statu
02d0: 73 20 50 41 53 53 0a 20 20 2d 72 75 6e 74 65 73 s PASS. -runtes
02e0: 74 73 20 74 73 74 31 2c 74 73 74 32 20 2e 2e 2e ts tst1,tst2 ...
02f0: 20 3a 20 72 75 6e 20 74 65 73 74 73 0a 0a 52 75 : run tests..Ru
0300: 6e 20 73 74 61 74 75 73 20 75 70 64 61 74 65 73 n status updates
0310: 20 28 74 68 65 73 65 20 72 65 71 75 69 72 65 20 (these require
0320: 74 68 61 74 20 79 6f 75 20 61 72 65 20 69 6e 20 that you are in
0330: 61 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 79 a test directory
0340: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0350: 20 20 20 20 20 61 6e 64 20 79 6f 75 20 68 61 76 and you hav
0360: 65 20 73 6f 75 72 63 65 64 20 74 68 65 20 5c 22 e sourced the \"
0370: 6d 65 67 61 74 65 73 74 2e 63 73 68 5c 22 20 6f megatest.csh\" o
0380: 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r.
0390: 20 20 20 20 20 20 5c 22 6d 65 67 61 74 65 73 74 \"megatest
03a0: 2e 73 68 5c 22 20 66 69 6c 65 2e 29 0a 20 20 2d .sh\" file.). -
03b0: 73 74 65 70 20 73 74 65 70 6e 61 6d 65 0a 20 20 step stepname.
03c0: 2d 74 65 73 74 2d 73 74 61 74 75 73 20 20 20 20 -test-status
03d0: 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 : set th
03e0: 65 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 e state and stat
03f0: 75 73 20 6f 66 20 61 20 74 65 73 74 20 28 75 73 us of a test (us
0400: 65 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 e :state and :st
0410: 61 74 75 73 29 0a 20 20 2d 73 65 74 6c 6f 67 20 atus). -setlog
0420: 6c 6f 67 66 6e 61 6d 65 20 20 20 20 20 20 20 20 logfname
0430: 3a 20 73 65 74 20 74 68 65 20 70 61 74 68 2f 66 : set the path/f
0440: 69 6c 65 6e 61 6d 65 20 74 6f 20 74 68 65 20 66 ilename to the f
0450: 69 6e 61 6c 20 6c 6f 67 20 72 65 6c 61 74 69 76 inal log relativ
0460: 65 20 74 6f 20 74 68 65 20 74 65 73 74 0a 20 20 e to the test.
0470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0480: 20 20 20 20 20 20 20 20 20 20 64 69 72 65 63 74 direct
0490: 6f 72 79 2e 20 6d 61 79 20 62 65 20 75 73 65 64 ory. may be used
04a0: 20 77 69 74 68 20 2d 74 65 73 74 2d 73 74 61 74 with -test-stat
04b0: 75 73 0a 20 20 2d 6d 20 63 6f 6d 6d 65 6e 74 20 us. -m comment
04c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 69 : i
04d0: 6e 73 65 72 74 20 61 20 63 6f 6d 6d 65 6e 74 20 nsert a comment
04e0: 66 6f 72 20 74 68 69 73 20 74 65 73 74 0a 0a 52 for this test..R
04f0: 75 6e 20 64 61 74 61 3a 0a 0a 20 20 3a 72 75 6e un data:.. :run
0500: 6e 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 20 name
0510: 20 20 20 20 3a 20 72 65 71 75 69 72 65 64 2c 20 : required,
0520: 6e 61 6d 65 20 66 6f 72 20 74 68 69 73 20 70 61 name for this pa
0530: 72 74 69 63 75 6c 61 72 20 74 65 73 74 20 72 75 rticular test ru
0540: 6e 0a 20 20 3a 73 74 61 74 65 20 20 20 20 20 20 n. :state
0550: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 : re
0560: 71 75 69 72 65 64 20 69 66 20 75 70 64 61 74 69 quired if updati
0570: 6e 67 20 73 74 65 70 20 73 74 61 74 65 3b 20 65 ng step state; e
0580: 2e 67 2e 20 73 74 61 72 74 2c 20 65 6e 64 2c 20 .g. start, end,
0590: 63 6f 6d 70 6c 65 74 65 64 0a 20 20 3a 73 74 61 completed. :sta
05a0: 74 75 73 20 20 20 20 20 20 20 20 20 20 20 20 20 tus
05b0: 20 20 20 20 3a 20 72 65 71 75 69 72 65 64 20 69 : required i
05c0: 66 20 75 70 64 61 74 69 6e 67 20 73 74 65 70 20 f updating step
05d0: 73 74 61 74 75 73 3b 20 65 2e 67 2e 20 70 61 73 status; e.g. pas
05e0: 73 2c 20 66 61 69 6c 2c 20 6e 2f 61 0a 0a 51 75 s, fail, n/a..Qu
05f0: 65 72 69 65 73 0a 20 20 2d 6c 69 73 74 2d 72 75 eries. -list-ru
0600: 6e 73 20 70 61 74 74 20 20 20 20 20 20 20 20 20 ns patt
0610: 3a 20 6c 69 73 74 20 72 75 6e 73 20 6d 61 74 63 : list runs matc
0620: 68 69 6e 67 20 70 61 74 74 65 72 6e 20 5c 22 70 hing pattern \"p
0630: 61 74 74 5c 22 2c 20 25 20 69 73 20 74 68 65 20 att\", % is the
0640: 77 69 6c 64 63 61 72 64 0a 20 20 2d 73 68 6f 77 wildcard. -show
0650: 6b 65 79 73 20 20 20 20 20 20 20 20 20 20 20 20 keys
0660: 20 20 20 3a 20 73 68 6f 77 20 74 68 65 20 6b 65 : show the ke
0670: 79 73 20 75 73 65 64 20 69 6e 20 74 68 69 73 20 ys used in this
0680: 6d 65 67 61 74 65 73 74 20 73 65 74 75 70 0a 0a megatest setup..
0690: 4d 69 73 63 20 28 6e 6f 74 65 3a 20 74 68 65 72 Misc (note: ther
06a0: 65 20 69 73 20 61 20 62 75 67 20 69 6e 20 61 72 e is a bug in ar
06b0: 67 75 6d 65 6e 74 20 70 72 6f 63 65 73 73 69 6e gument processin
06c0: 67 2c 20 70 75 74 20 74 68 65 73 65 20 61 74 20 g, put these at
06d0: 74 68 65 20 62 65 67 69 6e 6e 69 6e 67 0a 20 20 the beginning.
06e0: 20 20 20 20 20 20 20 20 20 20 6f 66 20 74 68 65 of the
06f0: 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 6f 72 command line or
0700: 20 69 74 20 6d 61 79 20 66 61 69 6c 29 0a 20 20 it may fail).
0710: 2d 66 6f 72 63 65 20 20 20 20 20 20 20 20 20 20 -force
0720: 20 20 20 20 20 20 20 20 3a 20 6f 76 65 72 72 69 : overri
0730: 64 65 20 73 6f 6d 65 20 63 68 65 63 6b 73 0a 20 de some checks.
0740: 20 2d 78 74 65 72 6d 20 20 20 20 20 20 20 20 20 -xterm
0750: 20 20 20 20 20 20 20 20 20 3a 20 73 74 61 72 74 : start
0760: 20 61 6e 20 78 74 65 72 6d 20 69 6e 73 74 65 61 an xterm instea
0770: 64 20 6f 66 20 6c 61 75 6e 63 68 69 6e 67 20 74 d of launching t
0780: 68 65 20 74 65 73 74 0a 0a 48 65 6c 70 65 72 73 he test..Helpers
0790: 0a 0a 20 20 2d 72 75 6e 73 74 65 70 20 73 74 65 .. -runstep ste
07a0: 70 6e 61 6d 65 20 20 2e 2e 2e 20 20 3a 20 74 61 pname ... : ta
07b0: 6b 65 20 6c 65 66 74 6f 76 65 72 20 70 61 72 61 ke leftover para
07c0: 6d 73 20 61 73 20 63 6f 6d 61 6e 64 20 61 6e 64 ms as comand and
07d0: 20 65 78 65 63 75 74 65 20 61 73 20 73 74 65 70 execute as step
07e0: 6e 61 6d 65 0a 20 20 20 20 20 20 20 20 20 20 20 name.
07f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0800: 20 6c 6f 67 20 77 69 6c 6c 20 62 65 20 69 6e 20 log will be in
0810: 73 74 65 70 6e 61 6d 65 2e 6c 6f 67 0a 20 20 2d stepname.log. -
0820: 6c 6f 67 70 72 6f 20 66 69 6c 65 20 20 20 20 20 logpro file
0830: 20 20 20 20 20 20 20 3a 20 77 69 74 68 20 2d 65 : with -e
0840: 78 65 63 20 61 70 70 6c 79 20 6c 6f 67 70 72 6f xec apply logpro
0850: 20 66 69 6c 65 20 74 6f 20 73 74 65 70 6e 61 6d file to stepnam
0860: 65 2e 6c 6f 67 2c 20 63 72 65 61 74 65 73 0a 20 e.log, creates.
0870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0880: 20 20 20 20 20 20 20 20 20 20 20 73 74 65 70 6e stepn
0890: 61 6d 65 2e 68 74 6d 6c 20 61 6e 64 20 73 65 74 ame.html and set
08a0: 73 20 6c 6f 67 20 74 6f 20 73 61 6d 65 0a 0a 43 s log to same..C
08b0: 61 6c 6c 65 64 20 61 73 20 22 20 28 73 74 72 69 alled as " (stri
08c0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
08d0: 61 72 67 76 29 20 22 20 22 29 29 29 0a 0a 3b 3b argv) " ")))..;;
08e0: 20 20 2d 67 75 69 20 20 20 20 20 20 20 20 20 20 -gui
08f0: 20 20 20 20 20 20 20 20 20 20 3a 20 73 74 61 72 : star
0900: 74 20 61 20 67 75 69 20 69 6e 74 65 72 66 61 63 t a gui interfac
0910: 65 0a 3b 3b 20 20 2d 63 6f 6e 66 69 67 20 66 6e e.;; -config fn
0920: 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 3a 20 ame :
0930: 6f 76 65 72 72 69 64 65 20 74 68 65 20 72 75 6e override the run
0940: 63 6f 6e 66 69 67 20 66 69 6c 65 20 77 69 74 68 config file with
0950: 20 66 6e 61 6d 65 0a 0a 3b 3b 20 70 72 6f 63 65 fname..;; proce
0960: 73 73 20 61 72 67 73 0a 28 64 65 66 69 6e 65 20 ss args.(define
0970: 72 65 6d 61 72 67 73 20 28 61 72 67 73 3a 67 65 remargs (args:ge
0980: 74 2d 61 72 67 73 20 0a 09 09 20 28 61 72 67 76 t-args ... (argv
0990: 29 0a 09 09 20 28 6c 69 73 74 20 20 22 2d 72 75 )... (list "-ru
09a0: 6e 74 65 73 74 73 22 20 20 3b 3b 20 72 75 6e 20 ntests" ;; run
09b0: 61 20 73 70 65 63 69 66 69 63 20 74 65 73 74 0a a specific test.
09c0: 09 09 09 22 2d 63 6f 6e 66 69 67 22 20 20 20 20 ..."-config"
09d0: 3b 3b 20 6f 76 65 72 72 69 64 65 20 74 68 65 20 ;; override the
09e0: 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e 61 6d 65 config file name
09f0: 0a 09 09 09 22 2d 65 78 65 63 75 74 65 22 20 20 ...."-execute"
0a00: 20 3b 3b 20 72 75 6e 20 74 68 65 20 63 6f 6d 6d ;; run the comm
0a10: 61 6e 64 20 65 6e 63 6f 64 65 64 20 69 6e 20 74 and encoded in t
0a20: 68 65 20 62 61 73 65 36 34 20 70 61 72 61 6d 65 he base64 parame
0a30: 74 65 72 0a 09 09 09 22 2d 73 74 65 70 22 0a 09 ter...."-step"..
0a40: 09 09 22 3a 72 75 6e 6e 61 6d 65 22 20 20 20 0a ..":runname" .
0a50: 09 09 09 22 3a 69 74 65 6d 22 0a 09 09 09 22 3a ...":item"....":
0a60: 72 75 6e 6e 61 6d 65 22 20 20 20 0a 09 09 09 22 runname" ...."
0a70: 3a 73 74 61 74 65 22 20 20 0a 09 09 09 22 3a 73 :state" ....":s
0a80: 74 61 74 75 73 22 0a 09 09 09 22 2d 6c 69 73 74 tatus"...."-list
0a90: 2d 72 75 6e 73 22 0a 09 09 09 22 2d 73 65 74 6c -runs"...."-setl
0aa0: 6f 67 22 0a 09 09 09 22 2d 72 75 6e 73 74 65 70 og"...."-runstep
0ab0: 22 0a 09 09 09 22 2d 6c 6f 67 70 72 6f 22 0a 09 "...."-logpro"..
0ac0: 09 09 29 20 0a 09 09 20 28 6c 69 73 74 20 20 22 ..) ... (list "
0ad0: 2d 68 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d -h"... "-
0ae0: 66 6f 72 63 65 22 0a 09 09 20 20 20 20 20 20 20 force"...
0af0: 20 22 2d 78 74 65 72 6d 22 0a 09 09 20 20 20 20 "-xterm"...
0b00: 20 20 20 20 22 2d 73 68 6f 77 6b 65 79 73 22 0a "-showkeys".
0b10: 09 09 20 20 20 20 20 20 20 20 22 2d 74 65 73 74 .. "-test
0b20: 2d 73 74 61 74 75 73 22 0a 09 09 20 20 20 20 20 -status"...
0b30: 20 20 20 22 2d 67 75 69 22 0a 09 09 09 22 2d 72 "-gui"...."-r
0b40: 75 6e 61 6c 6c 22 20 20 20 20 3b 3b 20 72 75 6e unall" ;; run
0b50: 20 61 6c 6c 20 74 65 73 74 73 0a 20 20 20 20 20 all tests.
0b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b70: 20 20 20 0a 09 09 20 20 20 20 20 20 20 29 0a 09 ... )..
0b80: 09 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 0a . args:arg-hash.
0b90: 09 09 20 30 29 29 0a 0a 28 69 66 20 28 61 72 67 .. 0))..(if (arg
0ba0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 22 29 0a s:get-arg "-h").
0bb0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
0bc0: 20 28 70 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 (print help).
0bd0: 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a 28 69 (exit)))..(i
0be0: 6e 63 6c 75 64 65 20 22 6b 65 79 73 2e 73 63 6d nclude "keys.scm
0bf0: 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 69 74 65 ").(include "ite
0c00: 6d 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 ms.scm").(includ
0c10: 65 20 22 64 62 2e 73 63 6d 22 29 0a 28 69 6e 63 e "db.scm").(inc
0c20: 6c 75 64 65 20 22 63 6f 6e 66 69 67 66 2e 73 63 lude "configf.sc
0c30: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 70 72 m").(include "pr
0c40: 6f 63 65 73 73 2e 73 63 6d 22 29 0a 28 69 6e 63 ocess.scm").(inc
0c50: 6c 75 64 65 20 22 6c 61 75 6e 63 68 2e 73 63 6d lude "launch.scm
0c60: 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 75 6e ").(include "run
0c70: 73 2e 73 63 6d 22 29 0a 3b 3b 20 28 69 6e 63 6c s.scm").;; (incl
0c80: 75 64 65 20 22 67 75 69 2e 73 63 6d 22 29 0a 0a ude "gui.scm")..
0c90: 28 64 65 66 69 6e 65 20 2a 64 69 64 73 6f 6d 65 (define *didsome
0ca0: 74 68 69 6e 67 2a 20 23 66 29 0a 0a 3b 3b 3d 3d thing* #f)..;;==
0cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0cf0: 3d 3d 3d 3d 0a 3b 3b 20 51 75 65 72 79 20 72 75 ====.;; Query ru
0d00: 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ns.;;===========
0d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
0d50: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
0d60: 2d 6c 69 73 74 2d 72 75 6e 73 22 29 0a 20 20 20 -list-runs").
0d70: 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 (let* ((db
0d80: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 (begin...
0d90: 20 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e (setup-for-run
0da0: 29 0a 09 09 20 20 20 20 20 20 20 28 6f 70 65 6e )... (open
0db0: 2d 64 62 29 29 29 0a 09 20 20 20 28 72 75 6e 70 -db))).. (runp
0dc0: 61 74 74 20 20 28 61 72 67 73 3a 67 65 74 2d 61 att (args:get-a
0dd0: 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 rg "-list-runs")
0de0: 29 0a 09 20 20 20 28 72 75 6e 73 64 61 74 20 20 ).. (runsdat
0df0: 28 64 62 2d 67 65 74 2d 72 75 6e 73 20 64 62 20 (db-get-runs db
0e00: 72 75 6e 70 61 74 74 29 29 0a 09 20 20 20 28 72 runpatt)).. (r
0e10: 75 6e 73 20 20 20 20 20 28 64 62 3a 67 65 74 2d uns (db:get-
0e20: 72 6f 77 73 20 72 75 6e 73 64 61 74 29 29 0a 09 rows runsdat))..
0e30: 20 20 20 28 68 65 61 64 65 72 20 20 20 28 64 62 (header (db
0e40: 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 73 :get-header runs
0e50: 64 61 74 29 29 0a 09 20 20 20 28 6b 65 79 73 20 dat)).. (keys
0e60: 20 20 20 20 28 64 62 2d 67 65 74 2d 6b 65 79 73 (db-get-keys
0e70: 20 64 62 29 29 0a 09 20 20 20 28 6b 65 79 6e 61 db)).. (keyna
0e80: 6d 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 mes (map key:get
0e90: 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 -fieldname keys)
0ea0: 29 29 0a 20 20 20 20 20 20 3b 3b 20 45 61 63 68 )). ;; Each
0eb0: 20 72 75 6e 0a 20 20 20 20 20 20 28 66 6f 72 2d run. (for-
0ec0: 65 61 63 68 20 0a 20 20 20 20 20 20 20 28 6c 61 each . (la
0ed0: 6d 62 64 61 20 28 72 75 6e 29 0a 09 20 28 70 72 mbda (run).. (pr
0ee0: 69 6e 74 20 22 52 75 6e 3a 20 22 0a 09 09 28 73 int "Run: "...(s
0ef0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
0f00: 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 e (map (lambda (
0f10: 78 29 0a 09 09 09 09 09 20 20 20 28 64 62 2d 67 x)...... (db-g
0f20: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
0f30: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 78 29 er run header x)
0f40: 29 0a 09 09 09 09 09 20 6b 65 79 6e 61 6d 65 73 )...... keynames
0f50: 29 20 22 2f 22 29 0a 09 09 22 2f 22 0a 09 09 28 ) "/")..."/"...(
0f60: 64 62 2d 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db-get-value-by-
0f70: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
0f80: 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 20 r "runname"))..
0f90: 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 28 64 (let ((run-id (d
0fa0: 62 2d 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b-get-value-by-h
0fb0: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
0fc0: 20 22 69 64 22 29 29 29 0a 09 20 20 20 28 6c 65 "id"))).. (le
0fd0: 74 20 28 28 74 65 73 74 73 20 28 64 62 2d 67 65 t ((tests (db-ge
0fe0: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
0ff0: 64 62 20 72 75 6e 2d 69 64 29 29 29 0a 09 20 20 db run-id)))..
1000: 20 20 20 3b 3b 20 45 61 63 68 20 74 65 73 74 0a ;; Each test.
1010: 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 . (for-each
1020: 0a 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
1030: 28 74 65 73 74 29 0a 09 09 28 66 6f 72 6d 61 74 (test)...(format
1040: 20 23 74 0a 09 09 09 22 20 20 54 65 73 74 3a 20 #t...." Test:
1050: 7e 32 35 61 20 53 74 61 74 65 3a 20 7e 31 35 61 ~25a State: ~15a
1060: 20 53 74 61 74 75 73 3a 20 7e 31 35 61 20 52 75 Status: ~15a Ru
1070: 6e 74 69 6d 65 3a 20 7e 35 40 61 73 20 54 69 6d ntime: ~5@as Tim
1080: 65 3a 20 7e 32 32 61 20 48 6f 73 74 3a 20 7e 31 e: ~22a Host: ~1
1090: 30 61 5c 6e 22 0a 09 09 09 28 63 6f 6e 63 20 28 0a\n"....(conc (
10a0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 db:test-get-test
10b0: 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 09 20 20 name test)....
10c0: 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 (if (equal?
10d0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 (db:test-get-ite
10e0: 6d 2d 70 61 74 68 20 74 65 73 74 29 20 22 22 29 m-path test) "")
10f0: 0a 09 09 09 09 20 20 22 22 20 0a 09 09 09 09 20 ..... "" .....
1100: 20 28 63 6f 6e 63 20 22 28 22 20 28 64 62 3a 74 (conc "(" (db:t
1110: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
1120: 68 20 74 65 73 74 29 20 22 29 22 29 29 29 0a 09 h test) ")")))..
1130: 09 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ..(db:test-get-s
1140: 74 61 74 65 20 74 65 73 74 29 0a 09 09 09 28 64 tate test)....(d
1150: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 b:test-get-statu
1160: 73 20 74 65 73 74 29 0a 09 09 09 28 64 62 3a 74 s test)....(db:t
1170: 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 est-get-run_dura
1180: 74 69 6f 6e 20 74 65 73 74 29 0a 09 09 09 28 64 tion test)....(d
1190: 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 b:test-get-event
11a0: 5f 74 69 6d 65 20 74 65 73 74 29 0a 09 09 09 28 _time test)....(
11b0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 db:test-get-host
11c0: 20 74 65 73 74 29 29 0a 20 09 09 28 69 66 20 28 test)). ..(if (
11d0: 6e 6f 74 20 28 6f 72 20 28 65 71 75 61 6c 3f 20 not (or (equal?
11e0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
11f0: 74 75 73 20 74 65 73 74 29 20 22 50 41 53 53 22 tus test) "PASS"
1200: 29 0a 09 09 09 20 20 20 20 20 28 65 71 75 61 6c ).... (equal
1210: 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ? (db:test-get-s
1220: 74 61 74 65 20 74 65 73 74 29 20 22 4e 4f 54 5f tate test) "NOT_
1230: 53 54 41 52 54 45 44 22 29 29 29 0a 09 09 20 20 STARTED")))...
1240: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 (begin...
1250: 20 28 70 72 69 6e 74 20 22 20 20 20 20 20 20 20 (print "
1260: 20 20 63 70 75 6c 6f 61 64 3a 20 20 22 20 28 64 cpuload: " (d
1270: 62 3a 74 65 73 74 2d 67 65 74 2d 63 70 75 6c 6f b:test-get-cpulo
1280: 61 64 20 74 65 73 74 29 0a 09 09 09 20 20 20 20 ad test)....
1290: 20 22 5c 6e 20 20 20 20 20 20 20 20 20 64 69 73 "\n dis
12a0: 6b 66 72 65 65 3a 20 22 20 28 64 62 3a 74 65 73 kfree: " (db:tes
12b0: 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 65 20 74 t-get-diskfree t
12c0: 65 73 74 29 0a 09 09 09 20 20 20 20 20 22 5c 6e est).... "\n
12d0: 20 20 20 20 20 20 20 20 20 75 6e 61 6d 65 3a 20 uname:
12e0: 20 20 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 " (db:test-ge
12f0: 74 2d 75 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 t-uname test)...
1300: 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 20 20 . "\n
1310: 20 20 72 75 6e 64 69 72 3a 20 20 20 22 20 28 64 rundir: " (d
1320: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 b:test-get-rundi
1330: 72 20 74 65 73 74 29 0a 09 09 09 20 20 20 20 20 r test)....
1340: 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 45 61 63 )... ;; Eac
1350: 68 20 74 65 73 74 0a 09 09 20 20 20 20 20 20 28 h test... (
1360: 6c 65 74 20 28 28 73 74 65 70 73 20 28 64 62 2d let ((steps (db-
1370: 67 65 74 2d 74 65 73 74 2d 73 74 65 70 73 2d 66 get-test-steps-f
1380: 6f 72 2d 72 75 6e 20 64 62 20 28 64 62 3a 74 65 or-run db (db:te
1390: 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 29 29 st-get-id test))
13a0: 29 29 0a 09 09 09 28 66 6f 72 2d 65 61 63 68 20 ))....(for-each
13b0: 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 73 74 .... (lambda (st
13c0: 65 70 29 0a 09 09 09 20 20 20 28 66 6f 72 6d 61 ep).... (forma
13d0: 74 20 23 74 20 0a 09 09 09 09 20 20 20 22 20 20 t #t ..... "
13e0: 20 20 53 74 65 70 3a 20 7e 32 30 61 20 53 74 61 Step: ~20a Sta
13f0: 74 65 3a 20 7e 31 30 61 20 53 74 61 74 75 73 3a te: ~10a Status:
1400: 20 7e 31 30 61 20 54 69 6d 65 20 7e 32 32 61 5c ~10a Time ~22a\
1410: 6e 22 0a 09 09 09 09 20 20 20 28 64 62 3a 73 74 n"..... (db:st
1420: 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 ep-get-stepname
1430: 73 74 65 70 29 0a 09 09 09 09 20 20 20 28 64 62 step)..... (db
1440: 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 :step-get-state
1450: 73 74 65 70 29 0a 09 09 09 09 20 20 20 28 64 62 step)..... (db
1460: 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 :step-get-status
1470: 20 73 74 65 70 29 0a 09 09 09 09 20 20 20 28 64 step)..... (d
1480: 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 b:step-get-event
1490: 5f 74 69 6d 65 20 73 74 65 70 29 29 29 0a 09 09 _time step)))...
14a0: 09 3b 3b 20 20 20 20 28 70 72 69 6e 74 20 22 20 .;; (print "
14b0: 20 20 20 53 74 65 70 3a 20 22 20 28 64 62 3a 73 Step: " (db:s
14c0: 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
14d0: 20 73 74 65 70 29 0a 09 09 09 3b 3b 20 09 20 20 step)....;; .
14e0: 22 20 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 " " (db:step-get
14f0: 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 09 09 -state step)....
1500: 3b 3b 20 09 20 20 22 20 22 20 28 64 62 3a 73 74 ;; . " " (db:st
1510: 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 ep-get-status st
1520: 65 70 29 0a 09 09 09 3b 3b 20 09 20 20 22 20 22 ep)....;; . " "
1530: 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 (db:step-get-ev
1540: 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 ent_time step)))
1550: 0a 09 09 09 20 73 74 65 70 73 29 29 29 29 29 0a .... steps))))).
1560: 09 09 74 65 73 74 73 29 29 29 29 0a 20 20 20 20 ..tests)))).
1570: 20 20 20 72 75 6e 73 29 0a 20 20 20 20 20 20 28 runs). (
1580: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
1590: 6e 67 2a 20 23 74 29 0a 20 20 20 20 20 20 29 29 ng* #t). ))
15a0: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
15b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 66 75 ==========.;; fu
15f0: 6c 6c 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d ll run.;;=======
1600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
1640: 0a 3b 3b 20 67 65 74 20 6c 6f 63 6b 20 69 6e 20 .;; get lock in
1650: 64 62 20 66 6f 72 20 66 75 6c 6c 20 72 75 6e 20 db for full run
1660: 66 6f 72 20 74 68 69 73 20 64 69 72 65 63 74 6f for this directo
1670: 72 79 0a 3b 3b 20 66 6f 72 20 61 6c 6c 20 74 65 ry.;; for all te
1680: 73 74 73 20 77 69 74 68 20 64 65 70 73 0a 3b 3b sts with deps.;;
1690: 20 20 20 77 61 6c 6b 20 74 72 65 65 20 6f 66 20 walk tree of
16a0: 74 65 73 74 73 20 74 6f 20 66 69 6e 64 20 68 65 tests to find he
16b0: 61 64 20 74 61 73 6b 73 0a 3b 3b 20 20 20 61 64 ad tasks.;; ad
16c0: 64 20 68 65 61 64 20 74 61 73 6b 73 20 74 6f 20 d head tasks to
16d0: 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 20 20 task queue.;;
16e0: 61 64 64 20 64 65 70 65 6e 64 61 6e 74 20 74 61 add dependant ta
16f0: 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 sks to task queu
1700: 65 20 0a 3b 3b 20 20 20 61 64 64 20 72 65 6d 61 e .;; add rema
1710: 69 6e 69 6e 67 20 74 61 73 6b 73 20 74 6f 20 74 ining tasks to t
1720: 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 66 6f 72 ask queue.;; for
1730: 20 65 61 63 68 20 74 61 73 6b 20 69 6e 20 74 61 each task in ta
1740: 73 6b 20 71 75 65 75 65 0a 3b 3b 20 20 20 69 66 sk queue.;; if
1750: 20 68 61 76 65 20 61 64 65 71 75 61 74 65 20 72 have adequate r
1760: 65 73 6f 75 72 63 65 73 0a 3b 3b 20 20 20 20 20 esources.;;
1770: 6c 61 75 6e 63 68 20 74 61 73 6b 0a 3b 3b 20 20 launch task.;;
1780: 20 65 6c 73 65 0a 3b 3b 20 20 20 20 20 70 75 74 else.;; put
1790: 20 74 61 73 6b 20 69 6e 20 64 65 66 65 72 72 65 task in deferre
17a0: 64 20 71 75 65 75 65 0a 3b 3b 20 69 66 20 73 74 d queue.;; if st
17b0: 69 6c 6c 20 6f 6b 20 74 6f 20 72 75 6e 20 74 61 ill ok to run ta
17c0: 73 6b 73 0a 3b 3b 20 20 20 70 72 6f 63 65 73 73 sks.;; process
17d0: 20 64 65 66 65 72 72 65 64 20 74 61 73 6b 73 20 deferred tasks
17e0: 70 65 72 20 61 62 6f 76 65 20 73 74 65 70 73 0a per above steps.
17f0: 0a 3b 3b 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 .;; run all test
1800: 73 20 61 72 65 20 61 72 65 20 4e 6f 74 20 43 4f s are are Not CO
1810: 4d 50 4c 45 54 45 44 20 61 6e 64 20 50 41 53 53 MPLETED and PASS
1820: 20 6f 72 20 43 48 45 43 4b 0a 28 69 66 20 28 61 or CHECK.(if (a
1830: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
1840: 6e 61 6c 6c 22 29 0a 20 20 20 20 28 69 66 20 28 nall"). (if (
1850: 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 not (args:get-ar
1860: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g ":runname"))..
1870: 28 62 65 67 69 6e 0a 09 20 20 28 70 72 69 6e 74 (begin.. (print
1880: 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 "ERROR: Missing
1890: 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 required parame
18a0: 74 65 72 20 66 6f 72 20 2d 72 75 6e 74 65 73 74 ter for -runtest
18b0: 73 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 s, you must spec
18c0: 69 66 79 20 74 68 65 20 72 75 6e 20 6e 61 6d 65 ify the run name
18d0: 20 77 69 74 68 20 3a 72 75 6e 6e 61 6d 65 20 72 with :runname r
18e0: 75 6e 6e 61 6d 65 22 29 0a 09 20 20 28 65 78 69 unname").. (exi
18f0: 74 20 32 29 29 0a 09 28 6c 65 74 2a 20 28 28 64 t 2))..(let* ((d
1900: 62 20 20 20 20 20 20 28 69 66 20 28 73 65 74 75 b (if (setu
1910: 70 2d 66 6f 72 2d 72 75 6e 29 0a 09 09 09 20 20 p-for-run)....
1920: 20 20 28 6f 70 65 6e 2d 64 62 29 0a 09 09 09 20 (open-db)....
1930: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 (begin....
1940: 20 20 20 28 70 72 69 6e 74 20 22 46 61 69 6c 65 (print "Faile
1950: 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit
1960: 69 6e 67 22 29 0a 09 09 09 20 20 20 20 20 20 28 ing").... (
1970: 65 78 69 74 20 31 29 29 29 29 29 0a 09 20 20 28 exit 1))))).. (
1980: 69 66 20 28 6e 6f 74 20 28 63 61 72 20 2a 63 6f if (not (car *co
1990: 6e 66 69 67 69 6e 66 6f 2a 29 29 0a 09 20 20 20 nfiginfo*))..
19a0: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 70 72 69 (begin...(pri
19b0: 6e 74 20 22 45 52 52 4f 52 3a 20 41 74 74 65 6d nt "ERROR: Attem
19c0: 70 74 65 64 20 74 6f 20 72 75 6e 20 61 20 74 65 pted to run a te
19d0: 73 74 20 62 75 74 20 72 75 6e 20 61 72 65 61 20 st but run area
19e0: 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e 6f 74 20 config file not
19f0: 66 6f 75 6e 64 22 29 0a 09 09 28 65 78 69 74 20 found")...(exit
1a00: 31 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 70 75 1)).. ;; pu
1a10: 74 20 74 65 73 74 20 70 61 72 61 6d 65 74 65 72 t test parameter
1a20: 73 20 69 6e 74 6f 20 63 6f 6e 76 65 6e 69 65 6e s into convenien
1a30: 74 20 76 61 72 69 61 62 6c 65 73 0a 09 20 20 20 t variables..
1a40: 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d (let* ((test-
1a50: 6e 61 6d 65 73 20 28 67 65 74 2d 61 6c 6c 2d 6c names (get-all-l
1a60: 65 67 61 6c 2d 74 65 73 74 73 29 29 29 20 3b 3b egal-tests))) ;;
1a70: 20 22 50 52 4f 44 22 20 69 73 20 69 67 6e 6f 72 "PROD" is ignor
1a80: 65 64 20 66 6f 72 20 6e 6f 77 0a 09 09 28 70 72 ed for now...(pr
1a90: 69 6e 74 20 22 49 4e 46 4f 3a 20 41 74 74 65 6d int "INFO: Attem
1aa0: 70 74 69 6e 67 20 74 6f 20 73 74 61 72 74 20 74 pting to start t
1ab0: 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 74 65 73 he following tes
1ac0: 74 73 2e 2e 2e 22 29 0a 09 09 28 70 72 69 6e 74 ts...")...(print
1ad0: 20 22 20 20 20 20 20 22 20 28 73 74 72 69 6e 67 " " (string
1ae0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 74 65 73 -intersperse tes
1af0: 74 2d 6e 61 6d 65 73 20 22 2c 22 29 29 0a 09 09 t-names ","))...
1b00: 28 72 75 6e 2d 74 65 73 74 73 20 64 62 20 74 65 (run-tests db te
1b10: 73 74 2d 6e 61 6d 65 73 29 29 29 0a 09 20 20 28 st-names))).. (
1b20: 72 75 6e 2d 77 61 69 74 69 6e 67 2d 74 65 73 74 run-waiting-test
1b30: 73 20 64 62 29 0a 09 20 20 28 73 71 6c 69 74 65 s db).. (sqlite
1b40: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
1b50: 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d . (set! *didsom
1b60: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a ething* #t))))..
1b70: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
1b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1bb0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e 20 ========.;; run
1bc0: 6f 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d one test.;;=====
1bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c10: 3d 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 20 74 68 =..;; 1. find th
1c20: 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b e config file.;;
1c30: 20 32 2e 20 63 68 61 6e 67 65 20 74 6f 20 74 68 2. change to th
1c40: 65 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 79 e test directory
1c50: 0a 3b 3b 20 33 2e 20 75 70 64 61 74 65 20 74 68 .;; 3. update th
1c60: 65 20 64 62 20 77 69 74 68 20 22 74 65 73 74 20 e db with "test
1c70: 73 74 61 72 74 65 64 22 20 73 74 61 74 75 73 2c started" status,
1c80: 20 73 65 74 20 72 75 6e 6e 69 6e 67 20 68 6f 73 set running hos
1c90: 74 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 73 73 20 t.;; 4. process
1ca0: 6c 61 75 6e 63 68 20 74 68 65 20 74 65 73 74 0a launch the test.
1cb0: 3b 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 6f 72 20 ;; - monitor
1cc0: 74 68 65 20 70 72 6f 63 65 73 73 2c 20 75 70 64 the process, upd
1cd0: 61 74 65 20 73 74 61 74 73 20 69 6e 20 74 68 65 ate stats in the
1ce0: 20 64 62 20 65 76 65 72 79 20 32 5e 6e 20 6d 69 db every 2^n mi
1cf0: 6e 75 74 65 73 0a 3b 3b 20 35 2e 20 61 73 20 74 nutes.;; 5. as t
1d00: 68 65 20 74 65 73 74 20 70 72 6f 63 65 65 64 73 he test proceeds
1d10: 20 69 6e 74 65 72 6e 61 6c 6c 79 20 69 74 20 63 internally it c
1d20: 61 6c 6c 73 20 6d 65 67 61 74 65 73 74 20 61 73 alls megatest as
1d30: 20 65 61 63 68 20 73 74 65 70 20 69 73 0a 3b 3b each step is.;;
1d40: 20 20 20 20 73 74 61 72 74 65 64 20 61 6e 64 20 started and
1d50: 63 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 20 20 20 completed.;;
1d60: 2d 20 73 74 65 70 20 73 74 61 72 74 65 64 2c 20 - step started,
1d70: 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 20 20 20 timestamp.;;
1d80: 2d 20 73 74 65 70 20 63 6f 6d 70 6c 65 74 65 64 - step completed
1d90: 2c 20 65 78 69 74 20 73 74 61 74 75 73 2c 20 74 , exit status, t
1da0: 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 2e 20 74 imestamp.;; 6. t
1db0: 65 73 74 20 70 68 6f 6e 65 20 68 6f 6d 65 0a 3b est phone home.;
1dc0: 3b 20 20 20 20 2d 20 69 66 20 74 65 73 74 20 72 ; - if test r
1dd0: 75 6e 20 74 69 6d 65 20 3e 20 61 6c 6c 6f 77 65 un time > allowe
1de0: 64 20 72 75 6e 20 74 69 6d 65 20 74 68 65 6e 20 d run time then
1df0: 6b 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 20 20 2d kill job.;; -
1e00: 20 69 66 20 63 61 6e 6e 6f 74 20 61 63 63 65 73 if cannot acces
1e10: 73 20 64 62 20 3e 20 61 6c 6c 6f 77 65 64 20 64 s db > allowed d
1e20: 69 73 63 6f 6e 6e 65 63 74 20 74 69 6d 65 20 74 isconnect time t
1e30: 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 0a 28 64 hen kill job..(d
1e40: 65 66 69 6e 65 20 28 72 75 6e 74 65 73 74 73 29 efine (runtests)
1e50: 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 61 72 67 . (if (not (arg
1e60: 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e s:get-arg ":runn
1e70: 61 6d 65 22 29 29 0a 20 20 20 20 20 20 28 62 65 ame")). (be
1e80: 67 69 6e 0a 09 28 70 72 69 6e 74 20 22 45 52 52 gin..(print "ERR
1e90: 4f 52 3a 20 4d 69 73 73 69 6e 67 20 72 65 71 75 OR: Missing requ
1ea0: 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 ired parameter f
1eb0: 6f 72 20 2d 72 75 6e 74 65 73 74 73 2c 20 79 6f or -runtests, yo
1ec0: 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 74 u must specify t
1ed0: 68 65 20 72 75 6e 20 6e 61 6d 65 20 77 69 74 68 he run name with
1ee0: 20 3a 72 75 6e 6e 61 6d 65 20 72 75 6e 6e 61 6d :runname runnam
1ef0: 65 22 29 0a 09 28 65 78 69 74 20 32 29 29 0a 20 e")..(exit 2)).
1f00: 20 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 23 (let ((db #
1f10: 66 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 73 f))..(if (not (s
1f20: 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 etup-for-run))..
1f30: 20 20 20 20 28 62 65 67 69 6e 20 0a 09 20 20 20 (begin ..
1f40: 20 20 20 28 70 72 69 6e 74 20 22 46 61 69 6c 65 (print "Faile
1f50: 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit
1f60: 69 6e 67 22 29 0a 09 20 20 20 20 20 20 28 65 78 ing").. (ex
1f70: 69 74 20 31 29 29 29 0a 09 28 73 65 74 21 20 64 it 1)))..(set! d
1f80: 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 28 69 b (open-db))..(i
1f90: 66 20 28 6e 6f 74 20 28 63 61 72 20 2a 63 6f 6e f (not (car *con
1fa0: 66 69 67 69 6e 66 6f 2a 29 29 0a 09 20 20 20 20 figinfo*))..
1fb0: 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 70 (begin.. (p
1fc0: 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 41 74 74 rint "ERROR: Att
1fd0: 65 6d 70 74 65 64 20 74 6f 20 72 75 6e 20 61 20 empted to run a
1fe0: 74 65 73 74 20 62 75 74 20 72 75 6e 20 61 72 65 test but run are
1ff0: 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e 6f a config file no
2000: 74 20 66 6f 75 6e 64 22 29 0a 09 20 20 20 20 20 t found")..
2010: 20 28 65 78 69 74 20 31 29 29 0a 09 20 20 20 20 (exit 1))..
2020: 3b 3b 20 70 75 74 20 74 65 73 74 20 70 61 72 61 ;; put test para
2030: 6d 65 74 65 72 73 20 69 6e 74 6f 20 63 6f 6e 76 meters into conv
2040: 65 6e 69 65 6e 74 20 76 61 72 69 61 62 6c 65 73 enient variables
2050: 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 .. (let* ((te
2060: 73 74 2d 6e 61 6d 65 73 20 20 20 28 73 74 72 69 st-names (stri
2070: 6e 67 2d 73 70 6c 69 74 20 28 61 72 67 73 3a 67 ng-split (args:g
2080: 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
2090: 73 22 29 20 22 2c 22 29 29 29 0a 09 20 20 20 20 s") ",")))..
20a0: 20 20 28 72 75 6e 2d 74 65 73 74 73 20 64 62 20 (run-tests db
20b0: 74 65 73 74 2d 6e 61 6d 65 73 29 29 29 0a 09 3b test-names)))..;
20c0: 3b 20 72 75 6e 2d 77 61 69 74 69 6e 67 2d 74 65 ; run-waiting-te
20d0: 73 74 73 20 64 62 29 0a 09 28 73 71 6c 69 74 65 sts db)..(sqlite
20e0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
20f0: 09 28 72 75 6e 2d 77 61 69 74 69 6e 67 2d 74 65 .(run-waiting-te
2100: 73 74 73 20 23 66 29 0a 09 28 73 65 74 21 20 2a sts #f)..(set! *
2110: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
2120: 29 29 29 29 0a 09 20 20 0a 28 69 66 20 28 61 72 )))).. .(if (ar
2130: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
2140: 74 65 73 74 73 22 29 0a 20 20 20 20 28 72 75 6e tests"). (run
2150: 74 65 73 74 73 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d tests))..;;=====
2160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
21a0: 3d 0a 3b 3b 20 65 78 65 63 75 74 65 20 74 68 65 =.;; execute the
21b0: 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 67 65 test.;; - ge
21c0: 74 73 20 63 61 6c 6c 65 64 20 6f 6e 20 72 65 6d ts called on rem
21d0: 6f 74 65 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d ote host.;; -
21e0: 20 72 65 63 65 69 76 65 73 20 69 6e 66 6f 20 66 receives info f
21f0: 72 6f 6d 20 74 68 65 20 2d 65 78 65 63 75 74 65 rom the -execute
2200: 20 70 61 72 61 6d 0a 3b 3b 20 20 20 20 2d 20 70 param.;; - p
2210: 61 73 73 65 73 20 69 6e 66 6f 20 74 6f 20 73 74 asses info to st
2220: 65 70 73 20 76 69 61 20 4d 54 5f 43 4d 44 49 4e eps via MT_CMDIN
2230: 46 4f 20 65 6e 76 20 76 61 72 20 28 66 75 74 75 FO env var (futu
2240: 72 65 20 69 73 20 74 6f 20 75 73 65 20 61 20 64 re is to use a d
2250: 6f 74 20 66 69 6c 65 29 0a 3b 3b 20 20 20 20 2d ot file).;; -
2260: 20 67 61 74 68 65 72 73 20 68 6f 73 74 20 69 6e gathers host in
2270: 66 6f 20 61 6e 64 20 0a 3b 3b 3d 3d 3d 3d 3d 3d fo and .;;======
2280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22c0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
22d0: 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 0a arg "-execute").
22e0: 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 69 (let* ((cmdi
22f0: 6e 66 6f 20 20 20 28 72 65 61 64 20 28 6f 70 65 nfo (read (ope
2300: 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 n-input-string (
2310: 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 base64:base64-de
2320: 63 6f 64 65 20 28 61 72 67 73 3a 67 65 74 2d 61 code (args:get-a
2330: 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 29 29 rg "-execute")))
2340: 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 65 6e ))). (seten
2350: 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 20 28 v "MT_CMDINFO" (
2360: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
2370: 78 65 63 75 74 65 22 29 29 0a 20 20 20 20 20 20 xecute")).
2380: 28 69 66 20 28 6c 69 73 74 3f 20 63 6d 64 69 6e (if (list? cmdin
2390: 66 6f 29 20 3b 3b 20 28 28 74 65 73 74 70 61 74 fo) ;; ((testpat
23a0: 68 20 2f 74 6d 70 2f 6d 72 77 65 6c 6c 61 6e 2f h /tmp/mrwellan/
23b0: 6a 61 7a 7a 6d 69 6e 64 2f 73 72 63 2f 65 78 61 jazzmind/src/exa
23c0: 6d 70 6c 65 5f 72 75 6e 2f 74 65 73 74 73 2f 73 mple_run/tests/s
23d0: 71 6c 69 74 65 73 70 65 65 64 29 20 28 74 65 73 qlitespeed) (tes
23e0: 74 2d 6e 61 6d 65 20 73 71 6c 69 74 65 73 70 65 t-name sqlitespe
23f0: 65 64 29 20 28 72 75 6e 73 63 72 69 70 74 20 72 ed) (runscript r
2400: 75 6e 73 63 72 69 70 74 2e 72 62 29 20 28 64 62 unscript.rb) (db
2410: 2d 68 6f 73 74 20 6c 6f 63 61 6c 68 6f 73 74 29 -host localhost)
2420: 20 28 72 75 6e 2d 69 64 20 31 29 29 0a 09 20 20 (run-id 1))..
2430: 28 6c 65 74 2a 20 28 28 74 65 73 74 70 61 74 68 (let* ((testpath
2440: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
2450: 20 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 'testpath cmdi
2460: 6e 66 6f 29 29 0a 09 09 20 28 77 6f 72 6b 2d 61 nfo))... (work-a
2470: 72 65 61 20 28 61 73 73 6f 63 2f 64 65 66 61 75 rea (assoc/defau
2480: 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 63 6d lt 'work-area cm
2490: 64 69 6e 66 6f 29 29 0a 09 09 20 28 74 65 73 74 dinfo))... (test
24a0: 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 -name (assoc/def
24b0: 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 ault 'test-name
24c0: 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 72 75 cmdinfo))... (ru
24d0: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
24e0: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
24f0: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 t cmdinfo))... (
2500: 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 db-host (assoc
2510: 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 /default 'db-hos
2520: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 t cmdinfo))...
2530: 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 (run-id (ass
2540: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d oc/default 'run-
2550: 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a id cmdinfo)).
2560: 09 09 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 .. (itemdat (a
2570: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 ssoc/default 'it
2580: 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 emdat cmdinfo)
2590: 29 0a 09 09 20 28 66 75 6c 6c 72 75 6e 73 63 72 )... (fullrunscr
25a0: 69 70 74 20 28 63 6f 6e 63 20 74 65 73 74 70 61 ipt (conc testpa
25b0: 74 68 20 22 2f 22 20 72 75 6e 73 63 72 69 70 74 th "/" runscript
25c0: 29 29 0a 09 09 20 28 64 62 20 20 20 20 20 20 20 ))... (db
25d0: 20 23 66 29 29 0a 09 20 20 20 20 28 70 72 69 6e #f)).. (prin
25e0: 74 20 22 45 78 65 63 74 75 69 6e 67 20 22 20 74 t "Exectuing " t
25f0: 65 73 74 2d 6e 61 6d 65 20 22 20 6f 6e 20 22 20 est-name " on "
2600: 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 (get-host-name))
2610: 0a 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 .. (change-di
2620: 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 rectory testpath
2630: 29 0a 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 ).. (if (not
2640: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
2650: 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 70 ...(begin... (p
2660: 72 69 6e 74 20 22 46 61 69 6c 65 64 20 74 6f 20 rint "Failed to
2670: 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 setup, exiting")
2680: 20 0a 09 09 20 20 28 65 78 69 74 20 31 29 29 29 ... (exit 1)))
2690: 0a 09 20 20 20 20 3b 3b 20 6e 6f 77 20 63 61 6e .. ;; now can
26a0: 20 66 69 6e 64 20 6f 75 72 20 64 62 0a 09 20 20 find our db..
26b0: 20 20 28 73 65 74 21 20 64 62 20 28 6f 70 65 6e (set! db (open
26c0: 2d 64 62 29 29 0a 09 20 20 20 20 28 63 68 61 6e -db)).. (chan
26d0: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 ge-directory wor
26e0: 6b 2d 61 72 65 61 29 20 0a 09 20 20 20 20 28 6c k-area) .. (l
26f0: 65 74 20 28 28 72 75 6e 63 6f 6e 66 69 67 66 20 et ((runconfigf
2700: 28 63 6f 6e 63 20 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
2710: 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f "/runconfigs.co
2720: 6e 66 69 67 22 29 29 29 0a 09 20 20 20 20 20 20 nfig")))..
2730: 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 (if (file-exists
2740: 3f 20 72 75 6e 63 6f 6e 66 69 67 66 29 0a 09 09 ? runconfigf)...
2750: 20 20 28 73 65 74 75 70 2d 65 6e 76 2d 64 65 66 (setup-env-def
2760: 61 75 6c 74 73 20 64 62 20 72 75 6e 63 6f 6e 66 aults db runconf
2770: 69 67 66 20 72 75 6e 2d 69 64 29 0a 09 09 20 20 igf run-id)...
2780: 28 70 72 69 6e 74 20 22 57 41 52 4e 49 4e 47 3a (print "WARNING:
2790: 20 59 6f 75 20 64 6f 20 6e 6f 74 20 68 61 76 65 You do not have
27a0: 20 61 20 72 75 6e 20 63 6f 6e 66 69 67 20 66 69 a run config fi
27b0: 6c 65 3a 20 22 20 72 75 6e 63 6f 6e 66 69 67 66 le: " runconfigf
27c0: 29 29 29 0a 09 20 20 20 20 28 73 65 74 2d 6d 65 ))).. (set-me
27d0: 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 gatest-env-vars
27e0: 64 62 20 72 75 6e 2d 69 64 29 0a 09 20 20 20 20 db run-id)..
27f0: 28 73 65 74 2d 69 74 65 6d 2d 65 6e 76 2d 76 61 (set-item-env-va
2800: 72 73 20 69 74 65 6d 64 61 74 29 0a 20 20 20 20 rs itemdat).
2810: 20 20 20 20 20 20 20 20 28 73 61 76 65 2d 65 6e (save-en
2820: 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c vironment-as-fil
2830: 65 73 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 es "megatest")..
2840: 20 20 20 20 28 74 65 73 74 2d 73 65 74 2d 6d 65 (test-set-me
2850: 74 61 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 ta-info db run-i
2860: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
2870: 64 61 74 29 0a 09 20 20 20 20 28 74 65 73 74 2d dat).. (test-
2880: 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 72 set-status! db r
2890: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
28a0: 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 "REMOTEHOSTSTART
28b0: 22 20 22 6e 2f 61 22 20 69 74 65 6d 64 61 74 20 " "n/a" itemdat
28c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
28d0: 6d 22 29 29 0a 09 20 20 20 20 28 69 66 20 28 61 m")).. (if (a
28e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 78 74 rgs:get-arg "-xt
28f0: 65 72 6d 22 29 0a 09 09 28 73 65 74 21 20 66 75 erm")...(set! fu
2900: 6c 6c 72 75 6e 73 63 72 69 70 74 20 22 78 74 65 llrunscript "xte
2910: 72 6d 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 rm").
2920: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 (if (not (f
2930: 69 6c 65 2d 65 78 65 63 75 74 65 2d 61 63 63 65 ile-execute-acce
2940: 73 73 3f 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 ss? fullrunscrip
2950: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
2960: 20 20 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 (system
2970: 28 63 6f 6e 63 20 22 63 68 6d 6f 64 20 75 67 2b (conc "chmod ug+
2980: 78 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 x " fullrunscrip
2990: 74 29 29 29 29 0a 09 20 20 20 20 3b 3b 20 57 65 t)))).. ;; We
29a0: 20 61 72 65 20 61 62 6f 75 74 20 74 6f 20 61 63 are about to ac
29b0: 74 75 61 6c 6c 79 20 6b 69 63 6b 20 6f 66 66 20 tually kick off
29c0: 74 68 65 20 74 65 73 74 0a 09 20 20 20 20 3b 3b the test.. ;;
29d0: 20 73 6f 20 74 68 69 73 20 69 73 20 61 20 67 6f so this is a go
29e0: 6f 64 20 70 6c 61 63 65 20 74 6f 20 72 65 6d 6f od place to remo
29f0: 76 65 20 74 68 65 20 72 65 63 6f 72 64 73 20 66 ve the records f
2a00: 6f 72 20 0a 09 20 20 20 20 3b 3b 20 61 6e 79 20 or .. ;; any
2a10: 70 72 65 76 69 6f 75 73 20 72 75 6e 73 0a 09 20 previous runs..
2a20: 20 20 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 72 ;; (db:test-r
2a30: 65 6d 6f 76 65 2d 73 74 65 70 73 20 64 62 20 72 emove-steps db r
2a40: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 un-id testname i
2a50: 74 65 6d 64 61 74 29 0a 09 20 20 20 20 0a 09 20 temdat).. ..
2a60: 20 20 20 3b 3b 20 66 72 6f 6d 20 68 65 72 65 20 ;; from here
2a70: 6f 6e 20 6f 75 74 20 77 65 20 77 69 6c 6c 20 6f on out we will o
2a80: 70 65 6e 20 61 6e 64 20 63 6c 6f 73 65 20 74 68 pen and close th
2a90: 65 20 64 62 0a 09 20 20 20 20 3b 3b 20 6f 6e 20 e db.. ;; on
2aa0: 65 76 65 72 79 20 61 63 63 65 73 73 20 74 6f 20 every access to
2ab0: 72 65 64 75 63 65 20 74 68 65 20 70 72 6f 62 61 reduce the proba
2ac0: 62 6c 69 74 69 79 20 6f 66 20 0a 09 20 20 20 20 blitiy of ..
2ad0: 3b 3b 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 6f 72 ;; contention or
2ae0: 20 73 74 75 63 6b 20 61 63 63 65 73 73 20 6f 6e stuck access on
2af0: 20 6e 66 73 2e 0a 09 20 20 20 20 28 73 71 6c 69 nfs... (sqli
2b00: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
2b10: 29 0a 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 )... (let* ((
2b20: 6d 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 m (ma
2b30: 6b 65 2d 6d 75 74 65 78 29 29 0a 09 09 20 20 20 ke-mutex))...
2b40: 28 6b 69 6c 6c 2d 6a 6f 62 3f 20 20 20 20 23 66 (kill-job? #f
2b50: 29 0a 09 09 20 20 20 28 65 78 69 74 2d 69 6e 66 )... (exit-inf
2b60: 6f 20 20 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f o (make-vecto
2b70: 72 20 33 29 29 0a 09 09 20 20 20 28 72 75 6e 69 r 3))... (runi
2b80: 74 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 t (lambda
2b90: 20 28 29 0a 09 09 09 09 20 20 20 28 6c 65 74 2d ()..... (let-
2ba0: 76 61 6c 75 65 73 0a 09 09 09 09 20 20 20 20 28 values..... (
2bb0: 28 28 70 69 64 20 65 78 69 74 2d 73 74 61 74 75 ((pid exit-statu
2bc0: 73 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 s exit-code)....
2bd0: 09 20 20 20 20 20 20 28 72 75 6e 2d 6e 2d 77 61 . (run-n-wa
2be0: 69 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 it fullrunscript
2bf0: 29 29 29 0a 09 09 09 09 20 20 20 20 28 6d 75 74 )))..... (mut
2c00: 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 ex-lock! m).....
2c10: 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set!
2c20: 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 64 exit-info 0 pid
2c30: 29 0a 09 09 09 09 20 20 20 20 28 76 65 63 74 6f )..... (vecto
2c40: 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f r-set! exit-info
2c50: 20 31 20 65 78 69 74 2d 73 74 61 74 75 73 29 0a 1 exit-status).
2c60: 09 09 09 09 20 20 20 20 28 76 65 63 74 6f 72 2d .... (vector-
2c70: 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 set! exit-info 2
2c80: 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 09 exit-code).....
2c90: 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 (mutex-unloc
2ca0: 6b 21 20 6d 29 29 29 29 0a 09 09 20 20 20 28 6d k! m))))... (m
2cb0: 6f 6e 69 74 6f 72 6a 6f 62 20 20 20 28 6c 61 6d onitorjob (lam
2cc0: 62 64 61 20 28 29 0a 09 09 09 09 20 20 20 28 6c bda ()..... (l
2cd0: 65 74 2a 20 28 28 73 74 61 72 74 2d 73 65 63 6f et* ((start-seco
2ce0: 6e 64 73 20 28 63 75 72 72 65 6e 74 2d 73 65 63 nds (current-sec
2cf0: 6f 6e 64 73 29 29 0a 09 09 09 09 09 20 20 28 63 onds))...... (c
2d00: 61 6c 63 2d 6d 69 6e 75 74 65 73 20 20 28 6c 61 alc-minutes (la
2d10: 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 09 20 mbda ()........
2d20: 20 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 63 (inexact->exac
2d30: 74 20 0a 09 09 09 09 09 09 09 20 20 20 20 28 72 t ........ (r
2d40: 6f 75 6e 64 20 0a 09 09 09 09 09 09 09 20 20 20 ound ........
2d50: 20 20 28 2d 20 0a 09 09 09 09 09 09 09 20 20 20 (- ........
2d60: 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (current-seco
2d70: 6e 64 73 29 20 0a 09 09 09 09 09 09 09 20 20 20 nds) ........
2d80: 20 20 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 start-seconds
2d90: 29 29 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 )))))).....
2da0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6d 69 6e 75 (let loop ((minu
2db0: 74 65 73 20 20 20 28 63 61 6c 63 2d 6d 69 6e 75 tes (calc-minu
2dc0: 74 65 73 29 29 29 0a 09 09 09 09 20 20 20 20 20 tes))).....
2dd0: 20 20 28 6c 65 74 20 28 28 64 62 20 20 20 20 28 (let ((db (
2de0: 6f 70 65 6e 2d 64 62 29 29 29 0a 09 09 09 09 09 open-db)))......
2df0: 20 28 73 65 74 21 20 6b 69 6c 6c 2d 6a 6f 62 3f (set! kill-job?
2e00: 20 28 74 65 73 74 2d 67 65 74 2d 6b 69 6c 6c 2d (test-get-kill-
2e10: 72 65 71 75 65 73 74 20 64 62 20 72 75 6e 2d 69 request db run-i
2e20: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
2e30: 64 61 74 29 29 0a 09 09 09 09 09 20 28 74 65 73 dat))...... (tes
2e40: 74 2d 75 70 64 61 74 65 2d 6d 65 74 61 2d 69 6e t-update-meta-in
2e50: 66 6f 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 fo db run-id tes
2e60: 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 20 6d t-name itemdat m
2e70: 69 6e 75 74 65 73 29 0a 09 09 09 09 09 20 28 69 inutes)...... (i
2e80: 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 28 70 72 6f f kill-job? (pro
2e90: 63 65 73 73 2d 73 69 67 6e 61 6c 20 28 76 65 63 cess-signal (vec
2ea0: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
2eb0: 6f 20 30 29 20 73 69 67 6e 61 6c 2f 74 65 72 6d o 0) signal/term
2ec0: 29 29 0a 09 09 09 09 09 20 28 73 71 6c 69 74 65 ))...... (sqlite
2ed0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
2ee0: 09 09 09 09 09 20 28 74 68 72 65 61 64 2d 73 6c ..... (thread-sl
2ef0: 65 65 70 21 20 28 2b 20 38 20 28 72 61 6e 64 6f eep! (+ 8 (rando
2f00: 6d 20 34 29 29 29 20 3b 3b 20 61 64 64 20 73 6f m 4))) ;; add so
2f10: 6d 65 20 6a 69 74 74 65 72 20 74 6f 20 74 68 65 me jitter to the
2f20: 20 63 61 6c 6c 20 68 6f 6d 65 20 74 69 6d 65 20 call home time
2f30: 74 6f 20 73 70 72 65 61 64 20 6f 75 74 20 74 68 to spread out th
2f40: 65 20 64 62 20 61 63 63 65 73 73 65 73 0a 09 09 e db accesses...
2f50: 09 09 09 20 28 6c 6f 6f 70 20 28 63 61 6c 63 2d ... (loop (calc-
2f60: 6d 69 6e 75 74 65 73 29 29 29 29 29 29 29 0a 09 minutes)))))))..
2f70: 09 20 20 20 28 74 68 31 20 20 20 20 20 20 20 20 . (th1
2f80: 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 6d (make-thread m
2f90: 6f 6e 69 74 6f 72 6a 6f 62 29 29 0a 09 09 20 20 onitorjob))...
2fa0: 20 28 74 68 32 20 20 20 20 20 20 20 20 20 20 28 (th2 (
2fb0: 6d 61 6b 65 2d 74 68 72 65 61 64 20 72 75 6e 69 make-thread runi
2fc0: 74 29 29 29 0a 09 20 20 20 20 20 20 28 74 68 72 t))).. (thr
2fd0: 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 0a ead-start! th1).
2fe0: 09 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 . (thread-s
2ff0: 74 61 72 74 21 20 74 68 32 29 0a 09 20 20 20 20 tart! th2)..
3000: 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 (thread-join!
3010: 74 68 32 29 0a 09 20 20 20 20 20 20 28 6d 75 74 th2).. (mut
3020: 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 ex-lock! m)..
3030: 20 20 20 28 73 65 74 21 20 64 62 20 28 6f 70 65 (set! db (ope
3040: 6e 2d 64 62 29 29 0a 09 20 20 20 20 20 20 28 6c n-db)).. (l
3050: 65 74 2a 20 28 28 74 65 73 74 69 6e 66 6f 20 28 et* ((testinfo (
3060: 72 75 6e 73 3a 67 65 74 2d 74 65 73 74 2d 69 6e runs:get-test-in
3070: 66 6f 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 fo db run-id tes
3080: 74 2d 6e 61 6d 65 20 28 69 74 65 6d 2d 6c 69 73 t-name (item-lis
3090: 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 t->path itemdat)
30a0: 29 29 29 0a 09 09 28 69 66 20 28 6e 6f 74 20 28 )))...(if (not (
30b0: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d equal? (db:test-
30c0: 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e get-state testin
30d0: 66 6f 29 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 fo) "COMPLETED")
30e0: 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 )... (begin..
30f0: 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 54 . (print "T
3100: 65 73 74 20 4e 4f 54 20 6c 6f 67 67 65 64 20 61 est NOT logged a
3110: 73 20 43 4f 4d 50 4c 45 54 45 44 2c 20 28 73 74 s COMPLETED, (st
3120: 61 74 65 3d 22 20 28 64 62 3a 74 65 73 74 2d 67 ate=" (db:test-g
3130: 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 et-state testinf
3140: 6f 29 20 22 29 2c 20 75 70 64 61 74 69 6e 67 20 o) "), updating
3150: 72 65 73 75 6c 74 22 29 0a 09 09 20 20 20 20 20 result")...
3160: 20 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 (test-set-statu
3170: 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 s! db run-id tes
3180: 74 2d 6e 61 6d 65 0a 09 09 09 09 09 28 69 66 20 t-name......(if
3190: 6b 69 6c 6c 2d 6a 6f 62 3f 20 22 4b 49 4c 4c 45 kill-job? "KILLE
31a0: 44 22 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a D" "COMPLETED").
31b0: 09 09 09 09 09 28 69 66 20 28 76 65 63 74 6f 72 .....(if (vector
31c0: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 -ref exit-info 1
31d0: 29 20 3b 3b 20 6c 6f 6f 6b 20 61 74 20 74 68 65 ) ;; look at the
31e0: 20 65 78 69 74 2d 73 74 61 74 75 73 0a 09 09 09 exit-status....
31f0: 09 09 20 20 20 20 28 69 66 20 28 65 71 3f 20 28 .. (if (eq? (
3200: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
3210: 69 6e 66 6f 20 32 29 20 30 29 0a 09 09 09 09 09 info 2) 0)......
3220: 09 22 50 41 53 53 22 0a 09 09 09 09 09 09 22 46 ."PASS"......."F
3230: 41 49 4c 22 29 0a 09 09 09 09 09 20 20 20 20 22 AIL")...... "
3240: 46 41 49 4c 22 29 20 69 74 65 6d 64 61 74 20 28 FAIL") itemdat (
3250: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
3260: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 6d "))))).. (m
3270: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a utex-unlock! m).
3280: 09 20 20 20 20 20 20 3b 3b 20 28 65 78 65 63 2d . ;; (exec-
3290: 72 65 73 75 6c 74 73 20 28 63 6d 64 2d 72 75 6e results (cmd-run
32a0: 2d 3e 6c 69 73 74 20 66 75 6c 6c 72 75 6e 73 63 ->list fullrunsc
32b0: 72 69 70 74 29 29 20 3b 3b 20 20 28 6c 69 73 74 ript)) ;; (list
32c0: 20 22 3e 22 20 28 63 6f 6e 63 20 74 65 73 74 2d ">" (conc test-
32d0: 6e 61 6d 65 20 22 2d 72 75 6e 2e 6c 6f 67 22 29 name "-run.log")
32e0: 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 73 ))).. ;; (s
32f0: 75 63 63 65 73 73 20 20 20 20 20 20 65 78 65 63 uccess exec
3300: 2d 72 65 73 75 6c 74 73 29 29 20 3b 3b 20 28 65 -results)) ;; (e
3310: 71 3f 20 28 63 61 64 72 20 65 78 65 63 2d 72 65 q? (cadr exec-re
3320: 73 75 6c 74 73 29 20 30 29 29 29 0a 09 20 20 20 sults) 0)))..
3330: 20 20 20 28 70 72 69 6e 74 20 22 4f 75 74 70 75 (print "Outpu
3340: 74 20 66 72 6f 6d 20 72 75 6e 6e 69 6e 67 20 22 t from running "
3350: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 22 fullrunscript "
3360: 2c 20 70 69 64 20 22 20 28 76 65 63 74 6f 72 2d , pid " (vector-
3370: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 ref exit-info 0)
3380: 20 22 20 69 6e 20 77 6f 72 6b 20 61 72 65 61 20 " in work area
3390: 22 20 0a 09 09 20 20 20 20 20 77 6f 72 6b 2d 61 " ... work-a
33a0: 72 65 61 20 22 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 65 rea ":\n====\n e
33b0: 78 69 74 20 63 6f 64 65 20 22 20 28 76 65 63 74 xit code " (vect
33c0: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
33d0: 20 32 29 20 22 5c 6e 22 20 22 3d 3d 3d 3d 5c 6e 2) "\n" "====\n
33e0: 22 29 0a 09 20 20 20 20 20 20 28 73 71 6c 69 74 ").. (sqlit
33f0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
3400: 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not
3410: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
3420: 74 2d 69 6e 66 6f 20 31 29 29 0a 09 09 20 20 28 t-info 1))... (
3430: 65 78 69 74 20 34 29 29 29 29 29 0a 20 20 20 20 exit 4))))).
3440: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
3450: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
3460: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
3470: 22 2d 73 74 65 70 22 29 0a 20 20 20 20 28 69 66 "-step"). (if
3480: 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 4d (not (getenv "M
3490: 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 28 62 T_CMDINFO"))..(b
34a0: 65 67 69 6e 0a 09 20 20 28 70 72 69 6e 74 20 22 egin.. (print "
34b0: 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 ERROR: MT_CMDINF
34c0: 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 O env var not se
34d0: 74 2c 20 2d 73 74 65 70 20 6d 75 73 74 20 62 65 t, -step must be
34e0: 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a called *inside*
34f0: 20 61 20 6d 65 67 61 74 65 73 74 20 69 6e 76 6f a megatest invo
3500: 6b 65 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 ked environment!
3510: 22 29 0a 09 20 20 28 65 78 69 74 20 35 29 29 0a ").. (exit 5)).
3520: 09 28 6c 65 74 2a 20 28 28 73 74 65 70 20 20 20 .(let* ((step
3530: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
3540: 20 22 2d 73 74 65 70 22 29 29 0a 09 20 20 20 20 "-step"))..
3550: 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 (cmdinfo (r
3560: 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d ead (open-input-
3570: 73 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 string (base64:b
3580: 61 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 ase64-decode (ge
3590: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
35a0: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 "))))).. (
35b0: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
35c0: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
35d0: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
35e0: 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
35f0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
3600: 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
3610: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
3620: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
3630: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
3640: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
3650: 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 (db-host (
3660: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 assoc/default 'd
3670: 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f b-host cmdinfo
3680: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
3690: 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 id (assoc/def
36a0: 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 ault 'run-id
36b0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
36c0: 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
36d0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
36e0: 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
36f0: 0a 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 .. (db
3700: 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 #f)..
3710: 28 73 74 61 74 65 20 20 20 20 28 61 72 67 73 3a (state (args:
3720: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 get-arg ":state"
3730: 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 )).. (stat
3740: 75 73 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 us (args:get-a
3750: 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 29 0a rg ":status"))).
3760: 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
3770: 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
3780: 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 (if (not (setu
3790: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 p-for-run))..
37a0: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 70 72 69 (begin...(pri
37b0: 6e 74 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 nt "Failed to se
37c0: 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 tup, exiting")..
37d0: 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 .(exit 1))).. (
37e0: 73 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 set! db (open-db
37f0: 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 73 )).. (if (and s
3800: 74 61 74 65 20 73 74 61 74 75 73 29 0a 09 20 20 tate status)..
3810: 20 20 20 20 28 74 65 73 74 73 74 65 70 2d 73 65 (teststep-se
3820: 74 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 6e t-status! db run
3830: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 73 74 -id test-name st
3840: 65 70 20 73 74 61 74 65 20 73 74 61 74 75 73 20 ep state status
3850: 69 74 65 6d 64 61 74 29 0a 09 20 20 20 20 20 20 itemdat)..
3860: 28 62 65 67 69 6e 0a 09 09 28 70 72 69 6e 74 20 (begin...(print
3870: 22 45 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 "ERROR: You must
3880: 20 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 specify :state
3890: 61 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 and :status with
38a0: 20 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d every call to -
38b0: 73 74 65 70 22 29 0a 09 09 28 65 78 69 74 20 36 step")...(exit 6
38c0: 29 29 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a ))).. (sqlite3:
38d0: 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 finalize! db)..
38e0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
38f0: 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 28 69 hing* #t))))..(i
3900: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
3910: 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 20 20 arg "-setlog")
3920: 20 20 20 20 20 3b 3b 20 73 69 6e 63 65 20 73 65 ;; since se
3930: 74 74 69 6e 67 20 75 70 20 69 73 20 73 6f 20 63 tting up is so c
3940: 6f 73 74 6c 79 20 6c 65 74 73 20 70 69 67 67 79 ostly lets piggy
3950: 62 61 63 6b 20 6f 6e 20 2d 74 65 73 74 2d 73 74 back on -test-st
3960: 61 74 75 73 0a 09 28 61 72 67 73 3a 67 65 74 2d atus..(args:get-
3970: 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 arg "-test-statu
3980: 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 s")..(args:get-a
3990: 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 29 0a rg "-runstep")).
39a0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 (if (not (ge
39b0: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
39c0: 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 "))..(begin.. (
39d0: 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 4d 54 print "ERROR: MT
39e0: 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 _CMDINFO env var
39f0: 20 6e 6f 74 20 73 65 74 2c 20 63 6f 6d 6d 61 6e not set, comman
3a00: 64 73 20 2d 74 65 73 74 2d 73 74 61 74 75 73 2c ds -test-status,
3a10: 20 2d 72 75 6e 73 74 65 70 20 61 6e 64 20 2d 73 -runstep and -s
3a20: 65 74 6c 6f 67 20 6d 75 73 74 20 62 65 20 63 61 etlog must be ca
3a30: 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 lled *inside* a
3a40: 6d 65 67 61 74 65 73 74 20 65 6e 76 69 72 6f 6e megatest environ
3a50: 6d 65 6e 74 21 22 29 0a 09 20 20 28 65 78 69 74 ment!").. (exit
3a60: 20 35 29 29 0a 09 28 6c 65 74 2a 20 28 28 63 6d 5))..(let* ((cm
3a70: 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 6f dinfo (read (o
3a80: 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 pen-input-string
3a90: 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d (base64:base64-
3aa0: 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 22 decode (getenv "
3ab0: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 MT_CMDINFO")))))
3ac0: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 61 .. (testpa
3ad0: 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 th (assoc/defau
3ae0: 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 6d lt 'testpath cm
3af0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
3b00: 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f (test-name (asso
3b10: 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d c/default 'test-
3b20: 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 name cmdinfo))..
3b30: 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 (runscrip
3b40: 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
3b50: 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 'runscript cmdi
3b60: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 nfo)).. (d
3b70: 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f b-host (assoc/
3b80: 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 default 'db-host
3b90: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
3ba0: 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 (run-id
3bb0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
3bc0: 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 run-id cmdinf
3bd0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 o)).. (ite
3be0: 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 mdat (assoc/de
3bf0: 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 fault 'itemdat
3c00: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
3c10: 20 20 20 28 64 62 20 20 20 20 20 20 20 20 23 66 (db #f
3c20: 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 65 ).. (state
3c30: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
3c40: 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 rg ":state"))..
3c50: 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 (status
3c60: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3c70: 3a 73 74 61 74 75 73 22 29 29 29 0a 09 20 20 28 :status"))).. (
3c80: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
3c90: 20 74 65 73 74 70 61 74 68 29 0a 09 20 20 28 69 testpath).. (i
3ca0: 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f f (not (setup-fo
3cb0: 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 28 r-run)).. (
3cc0: 62 65 67 69 6e 0a 09 09 28 70 72 69 6e 74 20 22 begin...(print "
3cd0: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
3ce0: 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 exiting")...(ex
3cf0: 69 74 20 31 29 29 29 0a 09 20 20 28 73 65 74 21 it 1))).. (set!
3d00: 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 db (open-db))..
3d10: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
3d20: 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a 09 arg "-setlog")..
3d30: 20 20 20 20 20 20 28 74 65 73 74 2d 73 65 74 2d (test-set-
3d40: 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 74 log! db run-id t
3d50: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 est-name itemdat
3d60: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3d70: 2d 73 65 74 6c 6f 67 22 29 29 29 0a 09 20 20 28 -setlog"))).. (
3d80: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
3d90: 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 "-test-status")
3da0: 0a 09 20 20 20 20 20 20 28 74 65 73 74 2d 73 65 .. (test-se
3db0: 74 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 6e t-status! db run
3dc0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 73 74 -id test-name st
3dd0: 61 74 65 20 73 74 61 74 75 73 20 69 74 65 6d 64 ate status itemd
3de0: 61 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 at (args:get-arg
3df0: 20 22 2d 6d 22 29 29 0a 09 20 20 20 20 20 20 28 "-m")).. (
3e00: 69 66 20 28 61 6e 64 20 73 74 61 74 65 20 73 74 if (and state st
3e10: 61 74 75 73 29 0a 09 09 20 20 28 69 66 20 28 6e atus)... (if (n
3e20: 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
3e30: 20 22 2d 73 65 74 6c 6f 67 22 29 29 0a 09 09 20 "-setlog"))...
3e40: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 28 (begin....(
3e50: 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 59 6f print "ERROR: Yo
3e60: 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 3a u must specify :
3e70: 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 state and :statu
3e80: 73 20 77 69 74 68 20 65 76 65 72 79 20 63 61 6c s with every cal
3e90: 6c 20 74 6f 20 2d 74 65 73 74 2d 73 74 61 74 75 l to -test-statu
3ea0: 73 5c 6e 22 20 68 65 6c 70 29 0a 09 09 09 28 73 s\n" help)....(s
3eb0: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
3ec0: 20 64 62 29 0a 09 09 09 28 65 78 69 74 20 36 29 db)....(exit 6)
3ed0: 29 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 )))).. (if (arg
3ee0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 2d s:get-arg "-run-
3ef0: 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 28 69 step").. (i
3f00: 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 f (null? remargs
3f10: 29 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 )... (begin...
3f20: 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 (print "ERROR
3f30: 3a 20 6e 6f 74 68 69 6e 67 20 73 70 65 63 69 66 : nothing specif
3f40: 69 65 64 20 74 6f 20 72 75 6e 21 22 29 0a 09 09 ied to run!")...
3f50: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e (sqlite3:fin
3f60: 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 20 20 20 alize! db)...
3f70: 20 28 65 78 69 74 20 36 29 29 0a 09 09 20 20 28 (exit 6))... (
3f80: 6c 65 74 2a 20 28 28 6c 6f 67 70 72 6f 66 69 6c let* ((logprofil
3f90: 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 e (args:get-arg
3fa0: 22 2d 6c 6f 67 70 72 6f 22 29 29 0a 09 09 09 20 "-logpro"))....
3fb0: 28 63 6d 64 20 20 20 20 20 20 20 20 28 69 66 20 (cmd (if
3fc0: 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 (null? remargs)
3fd0: 23 66 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 #f (car remargs)
3fe0: 29 29 0a 09 09 09 20 28 70 61 72 61 6d 73 20 20 )).... (params
3ff0: 20 20 20 28 69 66 20 63 6d 64 20 28 63 64 72 20 (if cmd (cdr
4000: 72 65 6d 61 72 67 73 29 20 23 66 29 29 0a 09 09 remargs) #f))...
4010: 09 20 28 65 78 69 74 73 74 61 74 20 20 20 23 66 . (exitstat #f
4020: 29 29 0a 09 09 20 20 20 20 3b 3b 20 6d 61 72 6b ))... ;; mark
4030: 20 74 68 65 20 73 74 61 72 74 20 6f 66 20 74 68 the start of th
4040: 65 20 74 65 73 74 0a 09 09 20 20 20 20 28 74 65 e test... (te
4050: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 st-set-status! d
4060: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
4070: 6d 65 20 22 73 74 61 72 74 22 20 22 6e 2f 61 22 me "start" "n/a"
4080: 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67 itemdat (args:g
4090: 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 et-arg "-m"))...
40a0: 20 20 20 20 3b 3b 20 63 6c 6f 73 65 20 74 68 65 ;; close the
40b0: 20 64 62 0a 09 09 20 20 20 20 28 73 71 6c 69 74 db... (sqlit
40c0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
40d0: 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 74 68 ... ;; run th
40e0: 65 20 74 65 73 74 20 73 74 65 70 0a 09 09 20 20 e test step...
40f0: 20 20 28 73 65 74 21 20 65 78 69 74 73 74 61 74 (set! exitstat
4100: 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 63 6d (process-run cm
4110: 64 20 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20 d params))...
4120: 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 ;; run logpro i
4130: 66 20 61 70 70 6c 69 63 61 62 6c 65 0a 09 09 20 f applicable...
4140: 20 20 20 28 69 66 20 6c 6f 67 70 72 6f 0a 09 09 (if logpro...
4150: 09 28 73 65 74 21 20 65 78 69 74 73 74 61 74 20 .(set! exitstat
4160: 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c 6f (process-run "lo
4170: 67 70 72 6f 22 20 6c 6f 67 70 72 6f 20 28 63 6f gpro" logpro (co
4180: 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 2e 68 nc test-name ".h
4190: 74 6d 6c 22 29 29 29 29 0a 09 09 20 20 20 20 28 tml"))))... (
41a0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
41b0: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d db run-id test-
41c0: 6e 61 6d 65 20 22 65 6e 64 22 20 46 49 4e 49 53 name "end" FINIS
41d0: 48 20 4d 45 45 45 45 45 21 21 21 21 21 21 0a 09 H MEEEEE!!!!!!..
41e0: 09 20 20 20 20 3b 3b 20 6f 70 65 6e 20 74 68 65 . ;; open the
41f0: 20 64 62 0a 09 09 3b 3b 20 6d 61 72 6b 20 74 68 db...;; mark th
4200: 65 20 65 6e 64 20 6f 66 20 74 68 65 20 74 65 73 e end of the tes
4210: 74 0a 09 09 29 29 0a 09 20 20 28 73 71 6c 69 74 t...)).. (sqlit
4220: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
4230: 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f .. (set! *didso
4240: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a mething* #t)))).
4250: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
4260: 72 67 20 22 2d 73 68 6f 77 6b 65 79 73 22 29 0a rg "-showkeys").
4270: 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 23 66 (let ((db #f
4280: 29 0a 09 20 20 28 6b 65 79 73 20 23 66 29 29 0a ).. (keys #f)).
4290: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
42a0: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
42b0: 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
42c0: 70 72 69 6e 74 20 22 46 61 69 6c 65 64 20 74 6f print "Failed to
42d0: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
42e0: 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 ).. (exit 1))
42f0: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 64 62 ). (set! db
4300: 20 28 6f 70 65 6e 2d 64 62 29 29 0a 20 20 20 20 (open-db)).
4310: 20 20 28 73 65 74 21 20 6b 65 79 73 20 28 64 62 (set! keys (db
4320: 2d 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 20 -get-keys db)).
4330: 20 20 20 20 20 28 70 72 69 6e 74 20 22 4b 65 79 (print "Key
4340: 73 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 s: " (string-int
4350: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 6b 65 ersperse (map ke
4360: 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 y:get-fieldname
4370: 6b 65 79 73 29 20 22 2c 20 22 29 29 0a 20 20 20 keys) ", ")).
4380: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 (sqlite3:fina
4390: 6c 69 7a 65 21 20 64 62 29 0a 20 20 20 20 20 20 lize! db).
43a0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
43b0: 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
43c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
43d0: 67 75 69 22 29 0a 20 20 20 20 28 62 65 67 69 6e gui"). (begin
43e0: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 4c . (print "L
43f0: 6f 6f 6b 20 61 74 20 74 68 65 20 64 61 73 68 62 ook at the dashb
4400: 6f 61 72 64 20 66 6f 72 20 6e 6f 77 22 29 0a 20 oard for now").
4410: 20 20 20 20 20 3b 3b 20 28 6d 65 67 61 74 65 73 ;; (megates
4420: 74 2d 67 75 69 29 0a 20 20 20 20 20 20 28 73 65 t-gui). (se
4430: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
4440: 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 6e 6f * #t)))..(if (no
4450: 74 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a t *didsomething*
4460: 29 0a 20 20 20 20 28 70 72 69 6e 74 20 68 65 6c ). (print hel
4470: 70 29 29 0a p)).