Artifact
6417d3c92bcce43bce098871d2d79b8e76905132:
- File
megatest.scm
— part of check-in
[bf70f7cd40]
at
2011-09-04 20:12:52
on branch rollup
— Added rollup.
(user:
matt
size: 28028)
[more...]
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 69 6e 63 6c 75 64 65 20 22 6d 65 67 61 74 .(include "megat
0170: 65 73 74 2d 76 65 72 73 69 6f 6e 2e 73 63 6d 22 est-version.scm"
0180: 29 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 )..(define help
0190: 28 63 6f 6e 63 20 22 0a 4d 65 67 61 74 65 73 74 (conc ".Megatest
01a0: 2c 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20 , documentation
01b0: 61 74 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 at http://www.ki
01c0: 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 atoa.com/fossils
01d0: 2f 6d 65 67 61 74 65 73 74 0a 20 20 76 65 72 73 /megatest. vers
01e0: 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 2d 76 ion " megatest-v
01f0: 65 72 73 69 6f 6e 20 22 0a 20 20 6c 69 63 65 6e ersion ". licen
0200: 73 65 20 47 50 4c 2c 20 43 6f 70 79 72 69 67 68 se GPL, Copyrigh
0210: 74 20 4d 61 74 74 20 57 65 6c 6c 61 6e 64 20 32 t Matt Welland 2
0220: 30 30 36 2d 32 30 31 31 0a 0a 55 73 61 67 65 3a 006-2011..Usage:
0230: 20 6d 65 67 61 74 65 73 74 20 5b 6f 70 74 69 6f megatest [optio
0240: 6e 73 5d 0a 20 20 2d 68 20 20 20 20 20 20 20 20 ns]. -h
0250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
0260: 74 68 69 73 20 68 65 6c 70 0a 0a 50 72 6f 63 65 this help..Proce
0270: 73 73 20 61 6e 64 20 74 65 73 74 20 72 75 6e 6e ss and test runn
0280: 69 6e 67 0a 20 20 2d 72 75 6e 61 6c 6c 20 20 20 ing. -runall
0290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
02a0: 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 74 68 run all tests th
02b0: 61 74 20 61 72 65 20 6e 6f 74 20 73 74 61 74 65 at are not state
02c0: 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 73 COMPLETED and s
02d0: 74 61 74 75 73 20 50 41 53 53 2c 20 0a 20 20 20 tatus PASS, .
02e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
02f0: 20 20 20 20 20 20 20 20 20 43 48 45 43 4b 20 6f CHECK o
0300: 72 20 4b 49 4c 4c 45 44 0a 20 20 2d 72 75 6e 74 r KILLED. -runt
0310: 65 73 74 73 20 74 73 74 31 2c 74 73 74 32 20 2e ests tst1,tst2 .
0320: 2e 2e 20 3a 20 72 75 6e 20 74 65 73 74 73 0a 0a .. : run tests..
0330: 52 75 6e 20 73 74 61 74 75 73 20 75 70 64 61 74 Run status updat
0340: 65 73 20 28 74 68 65 73 65 20 72 65 71 75 69 72 es (these requir
0350: 65 20 74 68 61 74 20 79 6f 75 20 61 72 65 20 69 e that you are i
0360: 6e 20 61 20 74 65 73 74 20 64 69 72 65 63 74 6f n a test directo
0370: 72 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ry.
0380: 20 20 20 20 20 20 20 61 6e 64 20 79 6f 75 20 68 and you h
0390: 61 76 65 20 73 6f 75 72 63 65 64 20 74 68 65 20 ave sourced the
03a0: 5c 22 6d 65 67 61 74 65 73 74 2e 63 73 68 5c 22 \"megatest.csh\"
03b0: 20 6f 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 or.
03c0: 20 20 20 20 20 20 20 20 5c 22 6d 65 67 61 74 65 \"megate
03d0: 73 74 2e 73 68 5c 22 20 66 69 6c 65 2e 29 0a 20 st.sh\" file.).
03e0: 20 2d 73 74 65 70 20 73 74 65 70 6e 61 6d 65 0a -step stepname.
03f0: 20 20 2d 74 65 73 74 2d 73 74 61 74 75 73 20 20 -test-status
0400: 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 : set
0410: 74 68 65 20 73 74 61 74 65 20 61 6e 64 20 73 74 the state and st
0420: 61 74 75 73 20 6f 66 20 61 20 74 65 73 74 20 28 atus of a test (
0430: 75 73 65 20 3a 73 74 61 74 65 20 61 6e 64 20 3a use :state and :
0440: 73 74 61 74 75 73 29 0a 20 20 2d 73 65 74 6c 6f status). -setlo
0450: 67 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 20 20 g logfname
0460: 20 20 3a 20 73 65 74 20 74 68 65 20 70 61 74 68 : set the path
0470: 2f 66 69 6c 65 6e 61 6d 65 20 74 6f 20 74 68 65 /filename to the
0480: 20 66 69 6e 61 6c 20 6c 6f 67 20 72 65 6c 61 74 final log relat
0490: 69 76 65 20 74 6f 20 74 68 65 20 74 65 73 74 0a ive to the test.
04a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
04b0: 20 20 20 20 20 20 20 20 20 20 20 20 64 69 72 65 dire
04c0: 63 74 6f 72 79 2e 20 6d 61 79 20 62 65 20 75 73 ctory. may be us
04d0: 65 64 20 77 69 74 68 20 2d 74 65 73 74 2d 73 74 ed with -test-st
04e0: 61 74 75 73 0a 20 20 2d 73 65 74 2d 74 6f 70 6c atus. -set-topl
04f0: 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 3a og logfname :
0500: 20 73 65 74 20 74 68 65 20 6f 76 65 72 61 6c 6c set the overall
0510: 20 6c 6f 67 20 66 6f 72 20 61 20 73 75 69 74 65 log for a suite
0520: 20 6f 66 20 73 75 62 2d 74 65 73 74 73 0a 20 20 of sub-tests.
0530: 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 -summarize-items
0540: 20 20 20 20 20 20 20 20 3a 20 66 6f 72 20 61 6e : for an
0550: 20 69 74 65 6d 69 7a 65 64 20 74 65 73 74 20 63 itemized test c
0560: 72 65 61 74 65 20 61 20 73 75 6d 6d 61 72 79 20 reate a summary
0570: 68 74 6d 6c 20 0a 20 20 2d 6d 20 63 6f 6d 6d 65 html . -m comme
0580: 6e 74 20 20 20 20 20 20 20 20 20 20 20 20 20 20 nt
0590: 3a 20 69 6e 73 65 72 74 20 61 20 63 6f 6d 6d 65 : insert a comme
05a0: 6e 74 20 66 6f 72 20 74 68 69 73 20 74 65 73 74 nt for this test
05b0: 0a 0a 52 75 6e 20 64 61 74 61 0a 20 20 3a 72 75 ..Run data. :ru
05c0: 6e 6e 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 nname
05d0: 20 20 20 20 20 3a 20 72 65 71 75 69 72 65 64 2c : required,
05e0: 20 6e 61 6d 65 20 66 6f 72 20 74 68 69 73 20 70 name for this p
05f0: 61 72 74 69 63 75 6c 61 72 20 74 65 73 74 20 72 articular test r
0600: 75 6e 0a 20 20 3a 73 74 61 74 65 20 20 20 20 20 un. :state
0610: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 : r
0620: 65 71 75 69 72 65 64 20 69 66 20 75 70 64 61 74 equired if updat
0630: 69 6e 67 20 73 74 65 70 20 73 74 61 74 65 3b 20 ing step state;
0640: 65 2e 67 2e 20 73 74 61 72 74 2c 20 65 6e 64 2c e.g. start, end,
0650: 20 63 6f 6d 70 6c 65 74 65 64 0a 20 20 3a 73 74 completed. :st
0660: 61 74 75 73 20 20 20 20 20 20 20 20 20 20 20 20 atus
0670: 20 20 20 20 20 3a 20 72 65 71 75 69 72 65 64 20 : required
0680: 69 66 20 75 70 64 61 74 69 6e 67 20 73 74 65 70 if updating step
0690: 20 73 74 61 74 75 73 3b 20 65 2e 67 2e 20 70 61 status; e.g. pa
06a0: 73 73 2c 20 66 61 69 6c 2c 20 6e 2f 61 0a 0a 56 ss, fail, n/a..V
06b0: 61 6c 75 65 73 20 61 6e 64 20 72 65 63 6f 72 64 alues and record
06c0: 20 65 72 72 6f 72 73 20 61 6e 64 20 77 61 72 6e errors and warn
06d0: 69 6e 67 73 0a 20 20 2d 73 65 74 2d 76 61 6c 75 ings. -set-valu
06e0: 65 73 20 20 20 20 20 20 20 20 20 20 20 20 20 3a es :
06f0: 20 75 70 64 61 74 65 20 6f 72 20 73 65 74 20 76 update or set v
0700: 61 6c 75 65 73 20 69 6e 20 74 68 65 20 6d 65 67 alues in the meg
0710: 61 74 65 73 74 20 64 62 20 0a 20 20 3a 76 61 6c atest db . :val
0720: 75 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ue
0730: 20 20 20 20 3a 20 76 61 6c 75 65 20 6d 65 61 73 : value meas
0740: 75 72 65 64 0a 20 20 3a 65 78 70 65 63 74 65 64 ured. :expected
0750: 5f 76 61 6c 75 65 20 20 20 20 20 20 20 20 20 3a _value :
0760: 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 0a value expected.
0770: 20 20 3a 74 6f 6c 20 20 20 20 20 20 20 20 20 20 :tol
0780: 20 20 20 20 20 20 20 20 20 20 3a 20 7c 76 61 6c : |val
0790: 75 65 2d 65 78 70 65 63 74 7c 20 3c 3d 20 74 6f ue-expect| <= to
07a0: 6c 0a 20 20 3a 75 6e 69 74 73 20 20 20 20 20 20 l. :units
07b0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6e 61 : na
07c0: 6d 65 20 6f 66 20 74 68 65 20 75 6e 69 74 73 20 me of the units
07d0: 66 6f 72 20 76 61 6c 75 65 2c 20 65 78 70 65 63 for value, expec
07e0: 74 65 64 5f 76 61 6c 75 65 20 61 6e 64 20 74 6f ted_value and to
07f0: 6c 0a 20 20 3a 66 69 72 73 74 5f 65 72 72 20 20 l. :first_err
0800: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 : re
0810: 63 6f 72 64 20 61 6e 20 65 72 72 6f 72 20 6d 65 cord an error me
0820: 73 73 61 67 65 0a 20 20 3a 66 69 72 73 74 5f 77 ssage. :first_w
0830: 61 72 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 arn
0840: 3a 20 72 65 63 6f 72 64 20 61 20 77 61 72 6e 69 : record a warni
0850: 6e 67 20 6d 65 73 73 61 67 65 0a 0a 51 75 65 72 ng message..Quer
0860: 69 65 73 0a 20 20 2d 6c 69 73 74 2d 72 75 6e 73 ies. -list-runs
0870: 20 70 61 74 74 20 20 20 20 20 20 20 20 20 3a 20 patt :
0880: 6c 69 73 74 20 72 75 6e 73 20 6d 61 74 63 68 69 list runs matchi
0890: 6e 67 20 70 61 74 74 65 72 6e 20 5c 22 70 61 74 ng pattern \"pat
08a0: 74 5c 22 2c 20 25 20 69 73 20 74 68 65 20 77 69 t\", % is the wi
08b0: 6c 64 63 61 72 64 0a 20 20 2d 74 65 73 74 70 61 ldcard. -testpa
08c0: 74 74 20 70 61 74 74 20 20 20 20 20 20 20 20 20 tt patt
08d0: 20 3a 20 69 6e 20 6c 69 73 74 2d 72 75 6e 73 20 : in list-runs
08e0: 73 68 6f 77 20 6f 6e 6c 79 20 74 68 65 73 65 20 show only these
08f0: 74 65 73 74 73 2c 20 25 20 69 73 20 74 68 65 20 tests, % is the
0900: 77 69 6c 64 63 61 72 64 0a 20 20 2d 69 74 65 6d wildcard. -item
0910: 70 61 74 74 20 70 61 74 74 20 20 20 20 20 20 20 patt patt
0920: 20 20 20 3a 20 69 6e 20 6c 69 73 74 2d 72 75 6e : in list-run
0930: 73 20 73 68 6f 77 20 6f 6e 6c 79 20 74 65 73 74 s show only test
0940: 73 20 77 69 74 68 20 69 74 65 6d 73 20 74 68 61 s with items tha
0950: 74 20 6d 61 74 63 68 20 70 61 74 74 0a 20 20 2d t match patt. -
0960: 73 68 6f 77 6b 65 79 73 20 20 20 20 20 20 20 20 showkeys
0970: 20 20 20 20 20 20 20 3a 20 73 68 6f 77 20 74 68 : show th
0980: 65 20 6b 65 79 73 20 75 73 65 64 20 69 6e 20 74 e keys used in t
0990: 68 69 73 20 6d 65 67 61 74 65 73 74 20 73 65 74 his megatest set
09a0: 75 70 0a 0a 4d 69 73 63 20 0a 20 20 2d 66 6f 72 up..Misc . -for
09b0: 63 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ce
09c0: 20 20 20 20 3a 20 6f 76 65 72 72 69 64 65 20 73 : override s
09d0: 6f 6d 65 20 63 68 65 63 6b 73 0a 20 20 2d 78 74 ome checks. -xt
09e0: 65 72 6d 20 20 20 20 20 20 20 20 20 20 20 20 20 erm
09f0: 20 20 20 20 20 3a 20 73 74 61 72 74 20 61 6e 20 : start an
0a00: 78 74 65 72 6d 20 69 6e 73 74 65 61 64 20 6f 66 xterm instead of
0a10: 20 6c 61 75 6e 63 68 69 6e 67 20 74 68 65 20 74 launching the t
0a20: 65 73 74 0a 20 20 2d 72 65 6d 6f 76 65 2d 72 75 est. -remove-ru
0a30: 6e 73 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 ns :
0a40: 72 65 6d 6f 76 65 20 74 68 65 20 64 61 74 61 20 remove the data
0a50: 66 6f 72 20 61 20 72 75 6e 2c 20 72 65 71 75 69 for a run, requi
0a60: 72 65 73 20 61 6c 6c 20 66 69 65 6c 64 73 20 62 res all fields b
0a70: 65 20 73 70 65 63 69 66 69 65 64 0a 20 20 20 20 e specified.
0a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a90: 20 20 20 20 20 20 20 20 61 6e 64 20 3a 72 75 6e and :run
0aa0: 6e 61 6d 65 20 2c 2d 74 65 73 74 70 61 74 74 20 name ,-testpatt
0ab0: 61 6e 64 20 2d 69 74 65 6d 70 61 74 74 0a 20 20 and -itempatt.
0ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ad0: 20 20 20 20 20 20 20 20 20 20 61 6e 64 20 2d 74 and -t
0ae0: 65 73 74 70 61 74 74 0a 20 20 2d 6b 65 65 70 67 estpatt. -keepg
0af0: 6f 69 6e 67 20 20 20 20 20 20 20 20 20 20 20 20 oing
0b00: 20 20 3a 20 63 6f 6e 74 69 6e 75 65 20 72 75 6e : continue run
0b10: 6e 69 6e 67 20 75 6e 74 69 6c 20 6e 6f 20 6a 6f ning until no jo
0b20: 62 73 20 61 72 65 20 5c 22 4c 41 55 4e 43 48 45 bs are \"LAUNCHE
0b30: 44 5c 22 20 6f 72 0a 20 20 20 20 20 20 20 20 20 D\" or.
0b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b50: 20 20 20 5c 22 4e 4f 54 5f 53 54 41 52 54 45 44 \"NOT_STARTED
0b60: 5c 22 0a 20 20 2d 72 65 72 75 6e 20 46 41 49 4c \". -rerun FAIL
0b70: 2c 57 41 52 4e 2e 2e 2e 20 20 20 20 20 3a 20 72 ,WARN... : r
0b80: 65 2d 72 75 6e 20 69 66 20 63 61 6c 6c 65 64 20 e-run if called
0b90: 6f 6e 20 61 20 74 65 73 74 20 74 68 61 74 20 70 on a test that p
0ba0: 72 65 76 69 6f 75 73 6c 79 20 72 61 6e 20 28 6e reviously ran (n
0bb0: 75 6c 6c 69 66 69 65 64 0a 20 20 20 20 20 20 20 ullified.
0bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0bd0: 20 20 20 20 20 69 66 20 2d 6b 65 65 70 67 6f 69 if -keepgoi
0be0: 6e 67 20 69 73 20 61 6c 73 6f 20 73 70 65 63 69 ng is also speci
0bf0: 66 69 65 64 29 0a 20 20 2d 72 65 62 75 69 6c 64 fied). -rebuild
0c00: 2d 64 62 20 20 20 20 20 20 20 20 20 20 20 20 20 -db
0c10: 3a 20 62 72 69 6e 67 20 74 68 65 20 64 61 74 61 : bring the data
0c20: 62 61 73 65 20 73 63 68 65 6d 61 20 75 70 20 74 base schema up t
0c30: 6f 20 64 61 74 65 0a 20 20 2d 72 6f 6c 6c 75 70 o date. -rollup
0c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c50: 20 3a 20 66 69 6c 6c 20 72 75 6e 20 28 73 65 74 : fill run (set
0c60: 20 62 79 20 3a 72 75 6e 6e 61 6d 65 29 20 20 77 by :runname) w
0c70: 69 74 68 20 6c 61 74 65 73 74 20 74 65 73 74 28 ith latest test(
0c80: 73 29 20 66 72 6f 6d 0a 20 20 20 20 20 20 20 20 s) from.
0c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ca0: 20 20 20 20 70 72 69 6f 72 20 72 75 6e 73 20 77 prior runs w
0cb0: 69 74 68 20 73 61 6d 65 20 6b 65 79 73 0a 20 20 ith same keys.
0cc0: 2d 72 65 6e 61 6d 65 2d 72 75 6e 20 3c 72 75 6e -rename-run <run
0cd0: 62 3e 20 20 20 20 20 20 3a 20 72 65 6e 61 6d 65 b> : rename
0ce0: 20 72 75 6e 20 28 73 65 74 20 62 79 20 3a 72 75 run (set by :ru
0cf0: 6e 6e 61 6d 65 29 20 74 6f 20 3c 72 75 6e 62 3e nname) to <runb>
0d00: 2c 20 72 65 71 75 69 72 65 73 20 6b 65 79 73 0a , requires keys.
0d10: 20 20 2d 75 70 64 61 74 65 2d 6d 65 74 61 20 20 -update-meta
0d20: 20 20 20 20 20 20 20 20 20 20 3a 20 75 70 64 61 : upda
0d30: 74 65 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 te the tests met
0d40: 61 64 61 74 61 20 66 6f 72 20 61 6c 6c 20 74 65 adata for all te
0d50: 73 74 73 0a 0a 48 65 6c 70 65 72 73 0a 20 20 2d sts..Helpers. -
0d60: 72 75 6e 73 74 65 70 20 73 74 65 70 6e 61 6d 65 runstep stepname
0d70: 20 20 2e 2e 2e 20 20 3a 20 74 61 6b 65 20 72 65 ... : take re
0d80: 6d 61 69 6e 69 6e 67 20 70 61 72 61 6d 73 20 61 maining params a
0d90: 73 20 63 6f 6d 61 6e 64 20 61 6e 64 20 65 78 65 s comand and exe
0da0: 63 75 74 65 20 61 73 20 73 74 65 70 6e 61 6d 65 cute as stepname
0db0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f 67 log
0dd0: 20 77 69 6c 6c 20 62 65 20 69 6e 20 73 74 65 70 will be in step
0de0: 6e 61 6d 65 2e 6c 6f 67 2e 20 42 65 73 74 20 74 name.log. Best t
0df0: 6f 20 70 75 74 20 63 6f 6d 6d 61 6e 64 20 69 6e o put command in
0e00: 20 71 75 6f 74 65 73 0a 20 20 2d 6c 6f 67 70 72 quotes. -logpr
0e10: 6f 20 66 69 6c 65 20 20 20 20 20 20 20 20 20 20 o file
0e20: 20 20 3a 20 77 69 74 68 20 2d 65 78 65 63 20 61 : with -exec a
0e30: 70 70 6c 79 20 6c 6f 67 70 72 6f 20 66 69 6c 65 pply logpro file
0e40: 20 74 6f 20 73 74 65 70 6e 61 6d 65 2e 6c 6f 67 to stepname.log
0e50: 2c 20 63 72 65 61 74 65 73 0a 20 20 20 20 20 20 , creates.
0e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e70: 20 20 20 20 20 20 73 74 65 70 6e 61 6d 65 2e 68 stepname.h
0e80: 74 6d 6c 20 61 6e 64 20 73 65 74 73 20 6c 6f 67 tml and sets log
0e90: 20 74 6f 20 73 61 6d 65 0a 20 20 20 20 20 20 20 to same.
0ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0eb0: 20 20 20 20 20 49 66 20 75 73 69 6e 67 20 6d 61 If using ma
0ec0: 6b 65 20 75 73 65 20 73 74 65 70 6e 61 6d 65 5f ke use stepname_
0ed0: 6c 6f 67 70 72 6f 2e 6c 6f 67 20 61 73 20 79 6f logpro.log as yo
0ee0: 75 72 20 74 61 72 67 65 74 0a 0a 43 61 6c 6c 65 ur target..Calle
0ef0: 64 20 61 73 20 22 20 28 73 74 72 69 6e 67 2d 69 d as " (string-i
0f00: 6e 74 65 72 73 70 65 72 73 65 20 28 61 72 67 76 ntersperse (argv
0f10: 29 20 22 20 22 29 29 29 0a 0a 3b 3b 20 20 2d 67 ) " ")))..;; -g
0f20: 75 69 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ui
0f30: 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 61 20 : start a
0f40: 67 75 69 20 69 6e 74 65 72 66 61 63 65 0a 3b 3b gui interface.;;
0f50: 20 20 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 -config fname
0f60: 20 20 20 20 20 20 20 20 20 20 3a 20 6f 76 65 72 : over
0f70: 72 69 64 65 20 74 68 65 20 72 75 6e 63 6f 6e 66 ride the runconf
0f80: 69 67 20 66 69 6c 65 20 77 69 74 68 20 66 6e 61 ig file with fna
0f90: 6d 65 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 20 61 me..;; process a
0fa0: 72 67 73 0a 28 64 65 66 69 6e 65 20 72 65 6d 61 rgs.(define rema
0fb0: 72 67 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 rgs (args:get-ar
0fc0: 67 73 20 0a 09 09 20 28 61 72 67 76 29 0a 09 09 gs ... (argv)...
0fd0: 20 28 6c 69 73 74 20 20 22 2d 72 75 6e 74 65 73 (list "-runtes
0fe0: 74 73 22 20 20 3b 3b 20 72 75 6e 20 61 20 73 70 ts" ;; run a sp
0ff0: 65 63 69 66 69 63 20 74 65 73 74 0a 09 09 09 22 ecific test...."
1000: 2d 63 6f 6e 66 69 67 22 20 20 20 20 3b 3b 20 6f -config" ;; o
1010: 76 65 72 72 69 64 65 20 74 68 65 20 63 6f 6e 66 verride the conf
1020: 69 67 20 66 69 6c 65 20 6e 61 6d 65 0a 09 09 09 ig file name....
1030: 22 2d 65 78 65 63 75 74 65 22 20 20 20 3b 3b 20 "-execute" ;;
1040: 72 75 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 run the command
1050: 65 6e 63 6f 64 65 64 20 69 6e 20 74 68 65 20 62 encoded in the b
1060: 61 73 65 36 34 20 70 61 72 61 6d 65 74 65 72 0a ase64 parameter.
1070: 09 09 09 22 2d 73 74 65 70 22 0a 09 09 09 22 3a ..."-step"....":
1080: 72 75 6e 6e 61 6d 65 22 20 20 20 0a 09 09 09 22 runname" ...."
1090: 3a 69 74 65 6d 22 0a 09 09 09 22 3a 72 75 6e 6e :item"....":runn
10a0: 61 6d 65 22 20 20 20 0a 09 09 09 22 3a 73 74 61 ame" ....":sta
10b0: 74 65 22 20 20 0a 09 09 09 22 3a 73 74 61 74 75 te" ....":statu
10c0: 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d 72 75 6e s"...."-list-run
10d0: 73 22 0a 09 09 09 22 2d 74 65 73 74 70 61 74 74 s"...."-testpatt
10e0: 22 20 0a 09 09 09 22 2d 69 74 65 6d 70 61 74 74 " ...."-itempatt
10f0: 22 0a 09 09 09 22 2d 73 65 74 6c 6f 67 22 0a 09 "...."-setlog"..
1100: 09 09 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 0a .."-set-toplog".
1110: 09 09 09 22 2d 72 75 6e 73 74 65 70 22 0a 09 09 ..."-runstep"...
1120: 09 22 2d 6c 6f 67 70 72 6f 22 0a 09 09 09 22 2d ."-logpro"...."-
1130: 6d 22 0a 09 09 09 22 2d 72 65 72 75 6e 22 0a 09 m"...."-rerun"..
1140: 09 09 22 2d 64 61 79 73 22 0a 09 09 09 22 2d 72 .."-days"...."-r
1150: 65 6e 61 6d 65 2d 72 75 6e 22 0a 09 09 09 22 2d ename-run"...."-
1160: 74 6f 22 0a 09 09 09 3b 3b 20 76 61 6c 75 65 73 to"....;; values
1170: 20 61 6e 64 20 6d 65 73 73 61 67 65 73 0a 09 09 and messages...
1180: 09 22 3a 66 69 72 73 74 5f 65 72 72 22 0a 09 09 .":first_err"...
1190: 09 22 3a 66 69 72 73 74 5f 77 61 72 6e 22 0a 09 .":first_warn"..
11a0: 09 09 22 3a 76 61 6c 75 65 22 0a 09 09 09 22 3a ..":value"....":
11b0: 65 78 70 65 63 74 65 64 5f 76 61 6c 75 65 22 0a expected_value".
11c0: 09 09 09 22 3a 74 6f 6c 22 0a 09 09 09 22 3a 75 ...":tol"....":u
11d0: 6e 69 74 73 22 0a 09 09 09 3b 3b 20 6d 69 73 63 nits"....;; misc
11e0: 0a 09 09 09 22 2d 64 65 62 75 67 22 20 3b 3b 20 ...."-debug" ;;
11f0: 66 6f 72 20 2a 76 65 72 62 6f 73 69 74 79 2a 20 for *verbosity*
1200: 3e 20 32 0a 09 09 09 29 20 0a 09 09 20 28 6c 69 > 2....) ... (li
1210: 73 74 20 20 22 2d 68 22 0a 09 09 20 20 20 20 20 st "-h"...
1220: 20 20 20 22 2d 66 6f 72 63 65 22 0a 09 09 20 20 "-force"...
1230: 20 20 20 20 20 20 22 2d 78 74 65 72 6d 22 0a 09 "-xterm"..
1240: 09 20 20 20 20 20 20 20 20 22 2d 73 68 6f 77 6b . "-showk
1250: 65 79 73 22 0a 09 09 20 20 20 20 20 20 20 20 22 eys"... "
1260: 2d 74 65 73 74 2d 73 74 61 74 75 73 22 0a 09 09 -test-status"...
1270: 09 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 0a 09 ."-set-values"..
1280: 09 09 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 .."-summarize-it
1290: 65 6d 73 22 0a 09 09 20 20 20 20 20 20 20 20 22 ems"... "
12a0: 2d 67 75 69 22 0a 09 09 09 22 2d 72 75 6e 61 6c -gui"...."-runal
12b0: 6c 22 20 20 20 20 3b 3b 20 72 75 6e 20 61 6c 6c l" ;; run all
12c0: 20 74 65 73 74 73 0a 09 09 09 22 2d 72 65 6d 6f tests...."-remo
12d0: 76 65 2d 72 75 6e 73 22 0a 09 09 09 22 2d 6b 65 ve-runs"...."-ke
12e0: 65 70 67 6f 69 6e 67 22 0a 09 09 09 22 2d 75 73 epgoing"...."-us
12f0: 65 71 75 65 75 65 22 0a 09 09 09 22 2d 72 65 62 equeue"...."-reb
1300: 75 69 6c 64 2d 64 62 22 0a 09 09 09 22 2d 72 6f uild-db"...."-ro
1310: 6c 6c 75 70 22 0a 09 09 09 22 2d 75 70 64 61 74 llup"...."-updat
1320: 65 2d 6d 65 74 61 22 0a 09 09 09 22 2d 76 22 20 e-meta"...."-v"
1330: 3b 3b 20 76 65 72 62 6f 73 65 20 32 2c 20 6d 6f ;; verbose 2, mo
1340: 72 65 20 74 68 61 6e 20 6e 6f 72 6d 61 6c 20 28 re than normal (
1350: 6e 6f 72 6d 61 6c 20 69 73 20 31 29 0a 09 09 09 normal is 1)....
1360: 22 2d 71 22 20 3b 3b 20 71 75 69 65 74 20 30 2c "-q" ;; quiet 0,
1370: 20 65 72 72 6f 72 73 2f 77 61 72 6e 69 6e 67 73 errors/warnings
1380: 20 6f 6e 6c 79 0a 09 09 20 20 20 20 20 20 20 29 only... )
1390: 0a 09 09 20 61 72 67 73 3a 61 72 67 2d 68 61 73 ... args:arg-has
13a0: 68 0a 09 09 20 30 29 29 0a 0a 28 69 66 20 28 61 h... 0))..(if (a
13b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 22 rgs:get-arg "-h"
13c0: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
13d0: 20 20 20 28 70 72 69 6e 74 20 68 65 6c 70 29 0a (print help).
13e0: 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a (exit)))..
13f0: 28 69 6e 63 6c 75 64 65 20 22 6b 65 79 73 2e 73 (include "keys.s
1400: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 69 cm").(include "i
1410: 74 65 6d 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c tems.scm").(incl
1420: 75 64 65 20 22 64 62 2e 73 63 6d 22 29 0a 28 69 ude "db.scm").(i
1430: 6e 63 6c 75 64 65 20 22 63 6f 6e 66 69 67 66 2e nclude "configf.
1440: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
1450: 70 72 6f 63 65 73 73 2e 73 63 6d 22 29 0a 28 69 process.scm").(i
1460: 6e 63 6c 75 64 65 20 22 6c 61 75 6e 63 68 2e 73 nclude "launch.s
1470: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 cm").(include "r
1480: 75 6e 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 uns.scm").(inclu
1490: 64 65 20 22 72 75 6e 63 6f 6e 66 69 67 2e 73 63 de "runconfig.sc
14a0: 6d 22 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 69 m")..(define *di
14b0: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 66 29 0a dsomething* #f).
14c0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
14d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 =========.;; Mis
1510: 63 20 73 65 74 75 70 20 73 74 75 66 66 0a 3b 3b c setup stuff.;;
1520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1560: 3d 3d 3d 3d 3d 3d 0a 0a 28 73 65 74 21 20 2a 76 ======..(set! *v
1570: 65 72 62 6f 73 69 74 79 2a 20 28 63 6f 6e 64 0a erbosity* (cond.
1580: 09 09 20 20 20 28 28 61 72 67 73 3a 67 65 74 2d .. ((args:get-
1590: 61 72 67 20 22 2d 64 65 62 75 67 22 29 28 73 74 arg "-debug")(st
15a0: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 ring->number (ar
15b0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 62 gs:get-arg "-deb
15c0: 75 67 22 29 29 29 0a 09 09 20 20 20 28 28 61 72 ug")))... ((ar
15d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 22 29 gs:get-arg "-v")
15e0: 20 20 20 20 32 29 0a 09 09 20 20 20 28 28 61 72 2)... ((ar
15f0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 71 22 29 gs:get-arg "-q")
1600: 20 20 20 20 30 29 0a 09 09 20 20 20 28 65 6c 73 0)... (els
1610: 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e
1620: 20 20 20 20 31 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 1)))..;;====
1630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1670: 3d 3d 0a 3b 3b 20 52 65 6d 6f 76 65 20 6f 6c 64 ==.;; Remove old
1680: 20 72 75 6e 28 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d run(s).;;======
1690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16d0: 0a 0a 3b 3b 20 73 69 6e 63 65 20 73 65 76 65 72 ..;; since sever
16e0: 61 6c 20 61 63 74 69 6f 6e 73 20 63 61 6e 20 62 al actions can b
16f0: 65 20 73 70 65 63 69 66 69 65 64 20 6f 6e 20 74 e specified on t
1700: 68 65 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 he command line
1710: 74 68 65 20 72 65 6d 6f 76 61 6c 0a 3b 3b 20 69 the removal.;; i
1720: 73 20 64 6f 6e 65 20 66 69 72 73 74 0a 28 64 65 s done first.(de
1730: 66 69 6e 65 20 28 72 65 6d 6f 76 65 2d 72 75 6e fine (remove-run
1740: 73 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 28 s). (cond. ((
1750: 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 not (args:get-ar
1760: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 20 g ":runname")).
1770: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
1780: 30 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 6e 0 "ERROR: Missin
1790: 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d g required param
17a0: 65 74 65 72 20 66 6f 72 20 2d 72 65 6d 6f 76 65 eter for -remove
17b0: 2d 72 75 6e 73 2c 20 79 6f 75 20 6d 75 73 74 20 -runs, you must
17c0: 73 70 65 63 69 66 79 20 74 68 65 20 72 75 6e 20 specify the run
17d0: 6e 61 6d 65 20 70 61 74 74 65 72 6e 20 77 69 74 name pattern wit
17e0: 68 20 3a 72 75 6e 6e 61 6d 65 20 70 61 74 74 22 h :runname patt"
17f0: 29 0a 20 20 20 20 28 65 78 69 74 20 32 29 29 0a ). (exit 2)).
1800: 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 ((not (args:g
1810: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
1820: 74 22 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a t")). (debug:
1830: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
1840: 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 Missing required
1850: 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 2d parameter for -
1860: 72 65 6d 6f 76 65 2d 72 75 6e 73 2c 20 79 6f 75 remove-runs, you
1870: 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 74 68 must specify th
1880: 65 20 74 65 73 74 20 70 61 74 74 65 72 6e 20 77 e test pattern w
1890: 69 74 68 20 2d 74 65 73 74 70 61 74 74 22 29 0a ith -testpatt").
18a0: 20 20 20 20 28 65 78 69 74 20 33 29 29 0a 20 20 (exit 3)).
18b0: 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 ((not (args:get
18c0: 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 -arg "-itempatt"
18d0: 29 29 0a 20 20 20 20 28 70 72 69 6e 74 20 22 45 )). (print "E
18e0: 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 20 72 65 RROR: Missing re
18f0: 71 75 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 quired parameter
1900: 20 66 6f 72 20 2d 72 65 6d 6f 76 65 2d 72 75 6e for -remove-run
1910: 73 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 s, you must spec
1920: 69 66 79 20 74 68 65 20 69 74 65 6d 73 20 77 69 ify the items wi
1930: 74 68 20 2d 69 74 65 6d 70 61 74 74 22 29 0a 20 th -itempatt").
1940: 20 20 20 28 65 78 69 74 20 34 29 29 0a 20 20 20 (exit 4)).
1950: 28 28 6c 65 74 20 28 28 64 62 20 23 66 29 29 0a ((let ((db #f)).
1960: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
1970: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
1980: 09 20 20 28 62 65 67 69 6e 20 0a 09 20 20 20 20 . (begin ..
1990: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 70 (debug:print 0 p
19a0: 72 69 6e 74 20 22 46 61 69 6c 65 64 20 74 6f 20 rint "Failed to
19b0: 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 setup, exiting")
19c0: 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 .. (exit 1)))
19d0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 64 62 20 . (set! db
19e0: 28 6f 70 65 6e 2d 64 62 29 29 0a 20 20 20 20 20 (open-db)).
19f0: 20 28 69 66 20 28 6e 6f 74 20 28 63 61 72 20 2a (if (not (car *
1a00: 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 29 0a 09 20 configinfo*))..
1a10: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 (begin.. (de
1a20: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
1a30: 4f 52 3a 20 41 74 74 65 6d 70 74 65 64 20 74 6f OR: Attempted to
1a40: 20 72 65 6d 6f 76 65 20 74 65 73 74 28 73 29 20 remove test(s)
1a50: 62 75 74 20 72 75 6e 20 61 72 65 61 20 63 6f 6e but run area con
1a60: 66 69 67 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 fig file not fou
1a70: 6e 64 22 29 0a 09 20 20 20 20 28 65 78 69 74 20 nd").. (exit
1a80: 31 29 29 0a 09 20 20 3b 3b 20 70 75 74 20 74 65 1)).. ;; put te
1a90: 73 74 20 70 61 72 61 6d 65 74 65 72 73 20 69 6e st parameters in
1aa0: 74 6f 20 63 6f 6e 76 65 6e 69 65 6e 74 20 76 61 to convenient va
1ab0: 72 69 61 62 6c 65 73 0a 09 20 20 28 72 75 6e 73 riables.. (runs
1ac0: 3a 72 65 6d 6f 76 65 2d 72 75 6e 73 20 64 62 0a :remove-runs db.
1ad0: 09 09 09 20 20 20 20 28 61 72 67 73 3a 67 65 74 ... (args:get
1ae0: 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 -arg ":runname")
1af0: 0a 09 09 09 20 20 20 20 28 61 72 67 73 3a 67 65 .... (args:ge
1b00: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
1b10: 22 29 0a 09 09 09 20 20 20 20 28 61 72 67 73 3a ").... (args:
1b20: 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 get-arg "-itempa
1b30: 74 74 22 29 29 29 0a 20 20 20 20 20 20 28 73 71 tt"))). (sq
1b40: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
1b50: 64 62 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 db). (set!
1b60: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
1b70: 74 29 29 29 29 29 0a 09 20 20 0a 28 69 66 20 28 t))))).. .(if (
1b80: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
1b90: 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a 20 20 20 emove-runs").
1ba0: 20 28 72 65 6d 6f 76 65 2d 72 75 6e 73 29 29 0a (remove-runs)).
1bb0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
1bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 51 75 65 =========.;; Que
1c00: 72 79 20 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d ry runs.;;======
1c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c50: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
1c60: 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 arg "-list-runs"
1c70: 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 64 62 ). (let* ((db
1c80: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 (begin...
1c90: 20 20 20 20 20 20 20 28 73 65 74 75 70 2d 66 6f (setup-fo
1ca0: 72 2d 72 75 6e 29 0a 09 09 20 20 20 20 20 20 20 r-run)...
1cb0: 28 6f 70 65 6e 2d 64 62 29 29 29 0a 09 20 20 20 (open-db)))..
1cc0: 28 72 75 6e 70 61 74 74 20 20 28 61 72 67 73 3a (runpatt (args:
1cd0: 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 get-arg "-list-r
1ce0: 75 6e 73 22 29 29 0a 09 20 20 20 28 74 65 73 74 uns")).. (test
1cf0: 70 61 74 74 20 28 61 72 67 73 3a 67 65 74 2d 61 patt (args:get-a
1d00: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 29 rg "-testpatt"))
1d10: 0a 09 20 20 20 28 69 74 65 6d 70 61 74 74 20 28 .. (itempatt (
1d20: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 args:get-arg "-i
1d30: 74 65 6d 70 61 74 74 22 29 29 0a 09 20 20 20 28 tempatt")).. (
1d40: 72 75 6e 73 64 61 74 20 20 28 64 62 2d 67 65 74 runsdat (db-get
1d50: 2d 72 75 6e 73 20 64 62 20 72 75 6e 70 61 74 74 -runs db runpatt
1d60: 29 29 0a 09 20 20 20 28 72 75 6e 73 20 20 20 20 )).. (runs
1d70: 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 (db:get-rows ru
1d80: 6e 73 64 61 74 29 29 0a 09 20 20 20 28 68 65 61 nsdat)).. (hea
1d90: 64 65 72 20 20 20 28 64 62 3a 67 65 74 2d 68 65 der (db:get-he
1da0: 61 64 65 72 20 72 75 6e 73 64 61 74 29 29 0a 09 ader runsdat))..
1db0: 20 20 20 28 6b 65 79 73 20 20 20 20 20 28 64 62 (keys (db
1dc0: 2d 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 -get-keys db))..
1dd0: 20 20 20 28 6b 65 79 6e 61 6d 65 73 20 28 6d 61 (keynames (ma
1de0: 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e p key:get-fieldn
1df0: 61 6d 65 20 6b 65 79 73 29 29 29 0a 20 20 20 20 ame keys))).
1e00: 20 20 3b 3b 20 45 61 63 68 20 72 75 6e 0a 20 20 ;; Each run.
1e10: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 (for-each .
1e20: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 (lambda (r
1e30: 75 6e 29 0a 09 20 28 64 65 62 75 67 3a 70 72 69 un).. (debug:pri
1e40: 6e 74 20 32 20 22 52 75 6e 3a 20 22 0a 09 09 28 nt 2 "Run: "...(
1e50: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
1e60: 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 se (map (lambda
1e70: 28 78 29 0a 09 09 09 09 09 20 20 20 28 64 62 3a (x)...... (db:
1e80: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
1e90: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 78 der run header x
1ea0: 29 29 0a 09 09 09 09 09 20 6b 65 79 6e 61 6d 65 ))...... keyname
1eb0: 73 29 20 22 2f 22 29 0a 09 09 22 2f 22 0a 09 09 s) "/")..."/"...
1ec0: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
1ed0: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
1ee0: 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 er "runname"))..
1ef0: 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 28 (let ((run-id (
1f00: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
1f10: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
1f20: 72 20 22 69 64 22 29 29 29 0a 09 20 20 20 28 6c r "id"))).. (l
1f30: 65 74 20 28 28 74 65 73 74 73 20 28 64 62 2d 67 et ((tests (db-g
1f40: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
1f50: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 70 db run-id testp
1f60: 61 74 74 20 69 74 65 6d 70 61 74 74 29 29 29 0a att itempatt))).
1f70: 09 20 20 20 20 20 3b 3b 20 45 61 63 68 20 74 65 . ;; Each te
1f80: 73 74 0a 09 20 20 20 20 20 28 66 6f 72 2d 65 61 st.. (for-ea
1f90: 63 68 20 0a 09 20 20 20 20 20 20 28 6c 61 6d 62 ch .. (lamb
1fa0: 64 61 20 28 74 65 73 74 29 0a 09 09 28 66 6f 72 da (test)...(for
1fb0: 6d 61 74 20 23 74 0a 09 09 09 22 20 20 54 65 73 mat #t...." Tes
1fc0: 74 3a 20 7e 32 35 61 20 53 74 61 74 65 3a 20 7e t: ~25a State: ~
1fd0: 31 35 61 20 53 74 61 74 75 73 3a 20 7e 31 35 61 15a Status: ~15a
1fe0: 20 52 75 6e 74 69 6d 65 3a 20 7e 35 40 61 73 20 Runtime: ~5@as
1ff0: 54 69 6d 65 3a 20 7e 32 32 61 20 48 6f 73 74 3a Time: ~22a Host:
2000: 20 7e 31 30 61 5c 6e 22 0a 09 09 09 28 63 6f 6e ~10a\n"....(con
2010: 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 c (db:test-get-t
2020: 65 73 74 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 estname test)...
2030: 09 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 . (if (equa
2040: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
2050: 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 20 item-path test)
2060: 22 22 29 0a 09 09 09 09 20 20 22 22 20 0a 09 09 "")..... "" ...
2070: 09 09 20 20 28 63 6f 6e 63 20 22 28 22 20 28 64 .. (conc "(" (d
2080: 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d b:test-get-item-
2090: 70 61 74 68 20 74 65 73 74 29 20 22 29 22 29 29 path test) ")"))
20a0: 29 0a 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65 )....(db:test-ge
20b0: 74 2d 73 74 61 74 65 20 74 65 73 74 29 0a 09 09 t-state test)...
20c0: 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 .(db:test-get-st
20d0: 61 74 75 73 20 74 65 73 74 29 0a 09 09 09 28 64 atus test)....(d
20e0: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 b:test-get-run_d
20f0: 75 72 61 74 69 6f 6e 20 74 65 73 74 29 0a 09 09 uration test)...
2100: 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 .(db:test-get-ev
2110: 65 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 0a 09 ent_time test)..
2120: 09 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 ..(db:test-get-h
2130: 6f 73 74 20 74 65 73 74 29 29 0a 20 09 09 28 69 ost test)). ..(i
2140: 66 20 28 6e 6f 74 20 28 6f 72 20 28 65 71 75 61 f (not (or (equa
2150: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
2160: 73 74 61 74 75 73 20 74 65 73 74 29 20 22 50 41 status test) "PA
2170: 53 53 22 29 0a 09 09 09 20 20 20 20 20 28 65 71 SS").... (eq
2180: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
2190: 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 20 22 t-status test) "
21a0: 57 41 52 4e 22 29 0a 09 09 09 20 20 20 20 20 28 WARN").... (
21b0: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d equal? (db:test-
21c0: 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 29 20 get-state test)
21d0: 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 29 "NOT_STARTED"))
21e0: 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 )... (begin..
21f0: 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 20 . (print "
2200: 20 20 20 20 20 20 20 20 63 70 75 6c 6f 61 64 3a cpuload:
2210: 20 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 " (db:test-get
2220: 2d 63 70 75 6c 6f 61 64 20 74 65 73 74 29 0a 09 -cpuload test)..
2230: 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 20 .. "\n
2240: 20 20 20 64 69 73 6b 66 72 65 65 3a 20 22 20 28 diskfree: " (
2250: 64 62 3a 74 65 73 74 2d 67 65 74 2d 64 69 73 6b db:test-get-disk
2260: 66 72 65 65 20 74 65 73 74 29 0a 09 09 09 20 20 free test)....
2270: 20 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 75 "\n u
2280: 6e 61 6d 65 3a 20 20 20 20 22 20 28 64 62 3a 74 name: " (db:t
2290: 65 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 74 65 est-get-uname te
22a0: 73 74 29 0a 09 09 09 20 20 20 20 20 22 5c 6e 20 st).... "\n
22b0: 20 20 20 20 20 20 20 20 72 75 6e 64 69 72 3a 20 rundir:
22c0: 20 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 " (db:test-get
22d0: 2d 72 75 6e 64 69 72 20 74 65 73 74 29 0a 09 09 -rundir test)...
22e0: 09 20 20 20 20 20 29 0a 09 09 20 20 20 20 20 20 . )...
22f0: 3b 3b 20 45 61 63 68 20 74 65 73 74 0a 09 09 20 ;; Each test...
2300: 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 65 70 (let ((step
2310: 73 20 28 64 62 2d 67 65 74 2d 74 65 73 74 2d 73 s (db-get-test-s
2320: 74 65 70 73 2d 66 6f 72 2d 72 75 6e 20 64 62 20 teps-for-run db
2330: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 (db:test-get-id
2340: 74 65 73 74 29 29 29 29 0a 09 09 09 28 66 6f 72 test))))....(for
2350: 2d 65 61 63 68 20 0a 09 09 09 20 28 6c 61 6d 62 -each .... (lamb
2360: 64 61 20 28 73 74 65 70 29 0a 09 09 09 20 20 20 da (step)....
2370: 28 66 6f 72 6d 61 74 20 23 74 20 0a 09 09 09 09 (format #t .....
2380: 20 20 20 22 20 20 20 20 53 74 65 70 3a 20 7e 32 " Step: ~2
2390: 30 61 20 53 74 61 74 65 3a 20 7e 31 30 61 20 53 0a State: ~10a S
23a0: 74 61 74 75 73 3a 20 7e 31 30 61 20 54 69 6d 65 tatus: ~10a Time
23b0: 20 7e 32 32 61 5c 6e 22 0a 09 09 09 09 20 20 20 ~22a\n".....
23c0: 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 (db:step-get-ste
23d0: 70 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 09 09 pname step).....
23e0: 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d (db:step-get-
23f0: 73 74 61 74 65 20 73 74 65 70 29 0a 09 09 09 09 state step).....
2400: 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d (db:step-get-
2410: 73 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 status step)....
2420: 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 . (db:step-get
2430: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 -event_time step
2440: 29 29 29 0a 09 09 09 20 73 74 65 70 73 29 29 29 ))).... steps)))
2450: 29 29 0a 09 09 74 65 73 74 73 29 29 29 29 0a 20 ))...tests)))).
2460: 20 20 20 20 20 20 72 75 6e 73 29 0a 20 20 20 20 runs).
2470: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
2480: 74 68 69 6e 67 2a 20 23 74 29 0a 20 20 20 20 20 thing* #t).
2490: 20 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;=========
24a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
24e0: 20 66 75 6c 6c 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d full run.;;====
24f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2530: 3d 3d 0a 0a 3b 3b 20 67 65 74 20 6c 6f 63 6b 20 ==..;; get lock
2540: 69 6e 20 64 62 20 66 6f 72 20 66 75 6c 6c 20 72 in db for full r
2550: 75 6e 20 66 6f 72 20 74 68 69 73 20 64 69 72 65 un for this dire
2560: 63 74 6f 72 79 0a 3b 3b 20 66 6f 72 20 61 6c 6c ctory.;; for all
2570: 20 74 65 73 74 73 20 77 69 74 68 20 64 65 70 73 tests with deps
2580: 0a 3b 3b 20 20 20 77 61 6c 6b 20 74 72 65 65 20 .;; walk tree
2590: 6f 66 20 74 65 73 74 73 20 74 6f 20 66 69 6e 64 of tests to find
25a0: 20 68 65 61 64 20 74 61 73 6b 73 0a 3b 3b 20 20 head tasks.;;
25b0: 20 61 64 64 20 68 65 61 64 20 74 61 73 6b 73 20 add head tasks
25c0: 74 6f 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b to task queue.;;
25d0: 20 20 20 61 64 64 20 64 65 70 65 6e 64 61 6e 74 add dependant
25e0: 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 tasks to task q
25f0: 75 65 75 65 20 0a 3b 3b 20 20 20 61 64 64 20 72 ueue .;; add r
2600: 65 6d 61 69 6e 69 6e 67 20 74 61 73 6b 73 20 74 emaining tasks t
2610: 6f 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 o task queue.;;
2620: 66 6f 72 20 65 61 63 68 20 74 61 73 6b 20 69 6e for each task in
2630: 20 74 61 73 6b 20 71 75 65 75 65 0a 3b 3b 20 20 task queue.;;
2640: 20 69 66 20 68 61 76 65 20 61 64 65 71 75 61 74 if have adequat
2650: 65 20 72 65 73 6f 75 72 63 65 73 0a 3b 3b 20 20 e resources.;;
2660: 20 20 20 6c 61 75 6e 63 68 20 74 61 73 6b 0a 3b launch task.;
2670: 3b 20 20 20 65 6c 73 65 0a 3b 3b 20 20 20 20 20 ; else.;;
2680: 70 75 74 20 74 61 73 6b 20 69 6e 20 64 65 66 65 put task in defe
2690: 72 72 65 64 20 71 75 65 75 65 0a 3b 3b 20 69 66 rred queue.;; if
26a0: 20 73 74 69 6c 6c 20 6f 6b 20 74 6f 20 72 75 6e still ok to run
26b0: 20 74 61 73 6b 73 0a 3b 3b 20 20 20 70 72 6f 63 tasks.;; proc
26c0: 65 73 73 20 64 65 66 65 72 72 65 64 20 74 61 73 ess deferred tas
26d0: 6b 73 20 70 65 72 20 61 62 6f 76 65 20 73 74 65 ks per above ste
26e0: 70 73 0a 0a 3b 3b 20 72 75 6e 20 61 6c 6c 20 74 ps..;; run all t
26f0: 65 73 74 73 20 61 72 65 20 61 72 65 20 4e 6f 74 ests are are Not
2700: 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 50 COMPLETED and P
2710: 41 53 53 20 6f 72 20 43 48 45 43 4b 0a 28 69 66 ASS or CHECK.(if
2720: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
2730: 2d 72 75 6e 61 6c 6c 22 29 0a 20 20 20 20 28 67 -runall"). (g
2740: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
2750: 0a 20 20 20 20 20 22 2d 72 75 6e 61 6c 6c 22 0a . "-runall".
2760: 20 20 20 20 20 22 72 75 6e 20 61 6c 6c 20 74 65 "run all te
2770: 73 74 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 sts". (lambd
2780: 61 20 28 64 62 20 6b 65 79 73 20 6b 65 79 6e 61 a (db keys keyna
2790: 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 mes keyvallst).
27a0: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 (let* ((te
27b0: 73 74 2d 6e 61 6d 65 73 20 28 67 65 74 2d 61 6c st-names (get-al
27c0: 6c 2d 6c 65 67 61 6c 2d 74 65 73 74 73 29 29 29 l-legal-tests)))
27d0: 20 3b 3b 20 22 50 52 4f 44 22 20 69 73 20 69 67 ;; "PROD" is ig
27e0: 6e 6f 72 65 64 20 66 6f 72 20 6e 6f 77 0a 09 20 nored for now..
27f0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 (debug:print 1 "
2800: 49 4e 46 4f 3a 20 41 74 74 65 6d 70 74 69 6e 67 INFO: Attempting
2810: 20 74 6f 20 73 74 61 72 74 20 74 68 65 20 66 6f to start the fo
2820: 6c 6c 6f 77 69 6e 67 20 74 65 73 74 73 2e 2e 2e llowing tests...
2830: 22 29 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e ").. (debug:prin
2840: 74 20 31 20 22 20 20 20 20 20 22 20 28 73 74 72 t 1 " " (str
2850: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
2860: 74 65 73 74 2d 6e 61 6d 65 73 20 22 2c 22 29 29 test-names ","))
2870: 0a 09 20 28 72 75 6e 2d 74 65 73 74 73 20 64 62 .. (run-tests db
2880: 20 74 65 73 74 2d 6e 61 6d 65 73 29 29 29 29 29 test-names)))))
2890: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
28a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
28b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
28c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
28d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 6f ==========.;; Ro
28e0: 6c 6c 75 70 20 69 6e 74 6f 20 61 20 72 75 6e 0a llup into a run.
28f0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
2900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2930: 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 69 66 20 28 61 72 ========.(if (ar
2940: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 6f 6c gs:get-arg "-rol
2950: 6c 75 70 22 29 0a 20 20 20 20 28 67 65 6e 65 72 lup"). (gener
2960: 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 al-run-call .
2970: 20 20 22 2d 72 6f 6c 6c 75 70 22 20 0a 20 20 20 "-rollup" .
2980: 20 20 22 72 6f 6c 6c 75 70 20 74 65 73 74 73 22 "rollup tests"
2990: 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
29a0: 64 62 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 db keys keynames
29b0: 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 keyvallst).
29c0: 20 20 20 28 6c 65 74 20 28 28 6e 20 28 61 72 67 (let ((n (arg
29d0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 6f 6c 6c s:get-arg "-roll
29e0: 75 70 22 29 29 29 0a 09 20 28 72 75 6e 73 3a 72 up"))).. (runs:r
29f0: 6f 6c 6c 75 70 2d 72 75 6e 20 64 62 20 6b 65 79 ollup-run db key
2a00: 73 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d s)))))..;;======
2a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a50: 0a 3b 3b 20 72 75 6e 20 6f 6e 65 20 74 65 73 74 .;; run one test
2a60: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
2a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e =========..;; 1.
2ab0: 20 66 69 6e 64 20 74 68 65 20 63 6f 6e 66 69 67 find the config
2ac0: 20 66 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 61 6e file.;; 2. chan
2ad0: 67 65 20 74 6f 20 74 68 65 20 74 65 73 74 20 64 ge to the test d
2ae0: 69 72 65 63 74 6f 72 79 0a 3b 3b 20 33 2e 20 75 irectory.;; 3. u
2af0: 70 64 61 74 65 20 74 68 65 20 64 62 20 77 69 74 pdate the db wit
2b00: 68 20 22 74 65 73 74 20 73 74 61 72 74 65 64 22 h "test started"
2b10: 20 73 74 61 74 75 73 2c 20 73 65 74 20 72 75 6e status, set run
2b20: 6e 69 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 2e 20 ning host.;; 4.
2b30: 70 72 6f 63 65 73 73 20 6c 61 75 6e 63 68 20 74 process launch t
2b40: 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 he test.;; -
2b50: 6d 6f 6e 69 74 6f 72 20 74 68 65 20 70 72 6f 63 monitor the proc
2b60: 65 73 73 2c 20 75 70 64 61 74 65 20 73 74 61 74 ess, update stat
2b70: 73 20 69 6e 20 74 68 65 20 64 62 20 65 76 65 72 s in the db ever
2b80: 79 20 32 5e 6e 20 6d 69 6e 75 74 65 73 0a 3b 3b y 2^n minutes.;;
2b90: 20 35 2e 20 61 73 20 74 68 65 20 74 65 73 74 20 5. as the test
2ba0: 70 72 6f 63 65 65 64 73 20 69 6e 74 65 72 6e 61 proceeds interna
2bb0: 6c 6c 79 20 69 74 20 63 61 6c 6c 73 20 6d 65 67 lly it calls meg
2bc0: 61 74 65 73 74 20 61 73 20 65 61 63 68 20 73 74 atest as each st
2bd0: 65 70 20 69 73 0a 3b 3b 20 20 20 20 73 74 61 72 ep is.;; star
2be0: 74 65 64 20 61 6e 64 20 63 6f 6d 70 6c 65 74 65 ted and complete
2bf0: 64 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 73 d.;; - step s
2c00: 74 61 72 74 65 64 2c 20 74 69 6d 65 73 74 61 6d tarted, timestam
2c10: 70 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 63 p.;; - step c
2c20: 6f 6d 70 6c 65 74 65 64 2c 20 65 78 69 74 20 73 ompleted, exit s
2c30: 74 61 74 75 73 2c 20 74 69 6d 65 73 74 61 6d 70 tatus, timestamp
2c40: 0a 3b 3b 20 36 2e 20 74 65 73 74 20 70 68 6f 6e .;; 6. test phon
2c50: 65 20 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d 20 69 e home.;; - i
2c60: 66 20 74 65 73 74 20 72 75 6e 20 74 69 6d 65 20 f test run time
2c70: 3e 20 61 6c 6c 6f 77 65 64 20 72 75 6e 20 74 69 > allowed run ti
2c80: 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 me then kill job
2c90: 0a 3b 3b 20 20 20 20 2d 20 69 66 20 63 61 6e 6e .;; - if cann
2ca0: 6f 74 20 61 63 63 65 73 73 20 64 62 20 3e 20 61 ot access db > a
2cb0: 6c 6c 6f 77 65 64 20 64 69 73 63 6f 6e 6e 65 63 llowed disconnec
2cc0: 74 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c t time then kill
2cd0: 20 6a 6f 62 0a 0a 28 69 66 20 28 61 72 67 73 3a job..(if (args:
2ce0: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 get-arg "-runtes
2cf0: 74 73 22 29 0a 20 20 28 67 65 6e 65 72 61 6c 2d ts"). (general-
2d00: 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 22 2d 72 run-call . "-r
2d10: 75 6e 74 65 73 74 73 22 20 0a 20 20 20 22 72 75 untests" . "ru
2d20: 6e 20 61 20 74 65 73 74 22 20 0a 20 20 20 28 6c n a test" . (l
2d30: 61 6d 62 64 61 20 28 64 62 20 6b 65 79 73 20 6b ambda (db keys k
2d40: 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 eynames keyvalls
2d50: 74 29 0a 20 20 20 20 20 28 6c 65 74 20 28 28 74 t). (let ((t
2d60: 65 73 74 2d 6e 61 6d 65 73 20 28 73 74 72 69 6e est-names (strin
2d70: 67 2d 73 70 6c 69 74 20 28 61 72 67 73 3a 67 65 g-split (args:ge
2d80: 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 t-arg "-runtests
2d90: 22 29 20 22 2c 22 29 29 29 0a 20 20 20 20 20 20 ") ","))).
2da0: 20 28 72 75 6e 2d 74 65 73 74 73 20 64 62 20 74 (run-tests db t
2db0: 65 73 74 2d 6e 61 6d 65 73 29 29 29 29 29 0a 0a est-names)))))..
2dc0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
2dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e00: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 63 ========.;; exec
2e10: 75 74 65 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 ute the test.;;
2e20: 20 20 20 2d 20 67 65 74 73 20 63 61 6c 6c 65 64 - gets called
2e30: 20 6f 6e 20 72 65 6d 6f 74 65 20 68 6f 73 74 0a on remote host.
2e40: 3b 3b 20 20 20 20 2d 20 72 65 63 65 69 76 65 73 ;; - receives
2e50: 20 69 6e 66 6f 20 66 72 6f 6d 20 74 68 65 20 2d info from the -
2e60: 65 78 65 63 75 74 65 20 70 61 72 61 6d 0a 3b 3b execute param.;;
2e70: 20 20 20 20 2d 20 70 61 73 73 65 73 20 69 6e 66 - passes inf
2e80: 6f 20 74 6f 20 73 74 65 70 73 20 76 69 61 20 4d o to steps via M
2e90: 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 T_CMDINFO env va
2ea0: 72 20 28 66 75 74 75 72 65 20 69 73 20 74 6f 20 r (future is to
2eb0: 75 73 65 20 61 20 64 6f 74 20 66 69 6c 65 29 0a use a dot file).
2ec0: 3b 3b 20 20 20 20 2d 20 67 61 74 68 65 72 73 20 ;; - gathers
2ed0: 68 6f 73 74 20 69 6e 66 6f 20 61 6e 64 20 0a 3b host info and .;
2ee0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
2ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f20: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
2f30: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 gs:get-arg "-exe
2f40: 63 75 74 65 22 29 0a 20 20 20 20 28 6c 65 74 2a cute"). (let*
2f50: 20 28 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 ((cmdinfo (re
2f60: 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 ad (open-input-s
2f70: 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 tring (base64:ba
2f80: 73 65 36 34 2d 64 65 63 6f 64 65 20 28 61 72 67 se64-decode (arg
2f90: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 s:get-arg "-exec
2fa0: 75 74 65 22 29 29 29 29 29 29 0a 20 20 20 20 20 ute")))))).
2fb0: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (setenv "MT_CMD
2fc0: 49 4e 46 4f 22 20 28 61 72 67 73 3a 67 65 74 2d INFO" (args:get-
2fd0: 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 29 arg "-execute"))
2fe0: 0a 20 20 20 20 20 20 28 69 66 20 28 6c 69 73 74 . (if (list
2ff0: 3f 20 63 6d 64 69 6e 66 6f 29 20 3b 3b 20 28 28 ? cmdinfo) ;; ((
3000: 74 65 73 74 70 61 74 68 20 2f 74 6d 70 2f 6d 72 testpath /tmp/mr
3010: 77 65 6c 6c 61 6e 2f 6a 61 7a 7a 6d 69 6e 64 2f wellan/jazzmind/
3020: 73 72 63 2f 65 78 61 6d 70 6c 65 5f 72 75 6e 2f src/example_run/
3030: 74 65 73 74 73 2f 73 71 6c 69 74 65 73 70 65 65 tests/sqlitespee
3040: 64 29 20 28 74 65 73 74 2d 6e 61 6d 65 20 73 71 d) (test-name sq
3050: 6c 69 74 65 73 70 65 65 64 29 20 28 72 75 6e 73 litespeed) (runs
3060: 63 72 69 70 74 20 72 75 6e 73 63 72 69 70 74 2e cript runscript.
3070: 72 62 29 20 28 64 62 2d 68 6f 73 74 20 6c 6f 63 rb) (db-host loc
3080: 61 6c 68 6f 73 74 29 20 28 72 75 6e 2d 69 64 20 alhost) (run-id
3090: 31 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 74 1)).. (let* ((t
30a0: 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f estpath (assoc/
30b0: 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 default 'testpat
30c0: 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 h cmdinfo))...
30d0: 28 77 6f 72 6b 2d 61 72 65 61 20 28 61 73 73 6f (work-area (asso
30e0: 63 2f 64 65 66 61 75 6c 74 20 27 77 6f 72 6b 2d c/default 'work-
30f0: 61 72 65 61 20 63 6d 64 69 6e 66 6f 29 29 0a 09 area cmdinfo))..
3100: 09 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 . (test-name (as
3110: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
3120: 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 t-name cmdinfo))
3130: 0a 09 09 20 28 72 75 6e 73 63 72 69 70 74 20 28 ... (runscript (
3140: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
3150: 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f unscript cmdinfo
3160: 29 29 0a 09 09 20 28 64 62 2d 68 6f 73 74 20 20 ))... (db-host
3170: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
3180: 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 'db-host cmdin
3190: 66 6f 29 29 0a 09 09 20 28 72 75 6e 2d 69 64 20 fo))... (run-id
31a0: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
31b0: 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 t 'run-id cmd
31c0: 69 6e 66 6f 29 29 0a 09 09 20 28 69 74 65 6d 64 info))... (itemd
31d0: 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 at (assoc/defa
31e0: 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 ult 'itemdat c
31f0: 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 65 6e 76 mdinfo))... (env
3200: 2d 6f 76 72 64 20 20 28 61 73 73 6f 63 2f 64 65 -ovrd (assoc/de
3210: 66 61 75 6c 74 20 27 65 6e 76 2d 6f 76 72 64 20 fault 'env-ovrd
3220: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 72 cmdinfo))... (r
3230: 75 6e 6e 61 6d 65 20 20 20 28 61 73 73 6f 63 2f unname (assoc/
3240: 64 65 66 61 75 6c 74 20 27 72 75 6e 6e 61 6d 65 default 'runname
3250: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 cmdinfo))...
3260: 28 6d 65 67 61 74 65 73 74 20 20 28 61 73 73 6f (megatest (asso
3270: 63 2f 64 65 66 61 75 6c 74 20 27 6d 65 67 61 74 c/default 'megat
3280: 65 73 74 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 est cmdinfo))..
3290: 09 20 28 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 . (mt-bindir-pat
32a0: 68 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 h (assoc/default
32b0: 20 27 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 'mt-bindir-path
32c0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 66 cmdinfo))... (f
32d0: 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 28 63 6f ullrunscript (co
32e0: 6e 63 20 74 65 73 74 70 61 74 68 20 22 2f 22 20 nc testpath "/"
32f0: 72 75 6e 73 63 72 69 70 74 29 29 0a 09 09 20 28 runscript))... (
3300: 64 62 20 20 20 20 20 20 20 20 23 66 29 29 0a 09 db #f))..
3310: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
3320: 20 32 20 22 45 78 65 63 74 75 69 6e 67 20 22 20 2 "Exectuing "
3330: 74 65 73 74 2d 6e 61 6d 65 20 22 20 6f 6e 20 22 test-name " on "
3340: 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 (get-host-name)
3350: 29 0a 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 ).. (change-d
3360: 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
3370: 68 29 0a 09 20 20 20 20 28 73 65 74 65 6e 76 20 h).. (setenv
3380: 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 "MT_TEST_RUN_DIR
3390: 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 " work-area)..
33a0: 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 (setenv "MT_TE
33b0: 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 ST_NAME" test-na
33c0: 6d 65 29 0a 09 20 20 20 20 28 73 65 74 65 6e 76 me).. (setenv
33d0: 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 "MT_ITEM_INFO"
33e0: 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 0a (conc itemdat)).
33f0: 09 20 20 20 20 28 73 65 74 65 6e 76 20 22 4d 54 . (setenv "MT
3400: 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e 6e _RUNNAME" runn
3410: 61 6d 65 29 0a 09 20 20 20 20 28 73 65 74 65 6e ame).. (seten
3420: 76 20 22 4d 54 5f 4d 45 47 41 54 45 53 54 22 20 v "MT_MEGATEST"
3430: 20 6d 65 67 61 74 65 73 74 29 0a 09 20 20 20 20 megatest)..
3440: 28 73 65 74 65 6e 76 20 22 50 41 54 48 22 20 28 (setenv "PATH" (
3450: 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 22 50 41 conc (getenv "PA
3460: 54 48 22 29 20 22 3a 22 20 6d 74 2d 62 69 6e 64 TH") ":" mt-bind
3470: 69 72 2d 70 61 74 68 29 29 0a 09 20 20 20 20 0a ir-path)).. .
3480: 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 73 . (if (not (s
3490: 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 etup-for-run))..
34a0: 09 28 62 65 67 69 6e 0a 09 09 20 20 28 64 65 62 .(begin... (deb
34b0: 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c ug:print 0 "Fail
34c0: 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
34d0: 74 69 6e 67 22 29 20 0a 09 09 20 20 28 65 78 69 ting") ... (exi
34e0: 74 20 31 29 29 29 0a 09 20 20 20 20 3b 3b 20 6e t 1))).. ;; n
34f0: 6f 77 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 ow can find our
3500: 64 62 0a 09 20 20 20 20 28 73 65 74 21 20 64 62 db.. (set! db
3510: 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 (open-db))..
3520: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
3530: 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 0a 09 ry work-area) ..
3540: 20 20 20 20 28 73 65 74 2d 72 75 6e 2d 63 6f 6e (set-run-con
3550: 66 69 67 2d 76 61 72 73 20 64 62 20 72 75 6e 2d fig-vars db run-
3560: 69 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 id).
3570: 3b 3b 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 6f ;; environment o
3580: 76 65 72 72 69 64 65 73 20 61 72 65 20 64 6f 6e verrides are don
3590: 65 20 2a 62 65 66 6f 72 65 2a 20 74 68 65 20 72 e *before* the r
35a0: 65 6d 61 69 6e 69 6e 67 20 63 72 69 74 69 63 61 emaining critica
35b0: 6c 20 65 6e 76 61 72 73 2e 0a 20 20 20 20 20 20 l envars..
35c0: 20 20 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e (alist->en
35d0: 76 2d 76 61 72 73 20 65 6e 76 2d 6f 76 72 64 29 v-vars env-ovrd)
35e0: 0a 09 20 20 20 20 28 73 65 74 2d 6d 65 67 61 74 .. (set-megat
35f0: 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 64 62 20 est-env-vars db
3600: 72 75 6e 2d 69 64 29 0a 09 20 20 20 20 28 73 65 run-id).. (se
3610: 74 2d 69 74 65 6d 2d 65 6e 76 2d 76 61 72 73 20 t-item-env-vars
3620: 69 74 65 6d 64 61 74 29 0a 20 20 20 20 20 20 20 itemdat).
3630: 20 20 20 20 20 28 73 61 76 65 2d 65 6e 76 69 72 (save-envir
3640: 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 onment-as-files
3650: 22 6d 65 67 61 74 65 73 74 22 29 0a 09 20 20 20 "megatest")..
3660: 20 28 74 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d (test-set-meta-
3670: 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 20 74 info db run-id t
3680: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 est-name itemdat
3690: 29 0a 09 20 20 20 20 28 74 65 73 74 2d 73 65 74 ).. (test-set
36a0: 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 6e 2d -status! db run-
36b0: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 22 52 45 id test-name "RE
36c0: 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 20 22 MOTEHOSTSTART" "
36d0: 6e 2f 61 22 20 69 74 65 6d 64 61 74 20 28 61 72 n/a" itemdat (ar
36e0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
36f0: 20 23 66 29 0a 09 20 20 20 20 28 69 66 20 28 61 #f).. (if (a
3700: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 78 74 rgs:get-arg "-xt
3710: 65 72 6d 22 29 0a 09 09 28 73 65 74 21 20 66 75 erm")...(set! fu
3720: 6c 6c 72 75 6e 73 63 72 69 70 74 20 22 78 74 65 llrunscript "xte
3730: 72 6d 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 rm").
3740: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 (if (not (f
3750: 69 6c 65 2d 65 78 65 63 75 74 65 2d 61 63 63 65 ile-execute-acce
3760: 73 73 3f 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 ss? fullrunscrip
3770: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
3780: 20 20 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 (system
3790: 28 63 6f 6e 63 20 22 63 68 6d 6f 64 20 75 67 2b (conc "chmod ug+
37a0: 78 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 x " fullrunscrip
37b0: 74 29 29 29 29 0a 09 20 20 20 20 3b 3b 20 57 65 t)))).. ;; We
37c0: 20 61 72 65 20 61 62 6f 75 74 20 74 6f 20 61 63 are about to ac
37d0: 74 75 61 6c 6c 79 20 6b 69 63 6b 20 6f 66 66 20 tually kick off
37e0: 74 68 65 20 74 65 73 74 0a 09 20 20 20 20 3b 3b the test.. ;;
37f0: 20 73 6f 20 74 68 69 73 20 69 73 20 61 20 67 6f so this is a go
3800: 6f 64 20 70 6c 61 63 65 20 74 6f 20 72 65 6d 6f od place to remo
3810: 76 65 20 74 68 65 20 72 65 63 6f 72 64 73 20 66 ve the records f
3820: 6f 72 20 0a 09 20 20 20 20 3b 3b 20 61 6e 79 20 or .. ;; any
3830: 70 72 65 76 69 6f 75 73 20 72 75 6e 73 0a 09 20 previous runs..
3840: 20 20 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 72 ;; (db:test-r
3850: 65 6d 6f 76 65 2d 73 74 65 70 73 20 64 62 20 72 emove-steps db r
3860: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 un-id testname i
3870: 74 65 6d 64 61 74 29 0a 09 20 20 20 20 0a 09 20 temdat).. ..
3880: 20 20 20 3b 3b 20 66 72 6f 6d 20 68 65 72 65 20 ;; from here
3890: 6f 6e 20 6f 75 74 20 77 65 20 77 69 6c 6c 20 6f on out we will o
38a0: 70 65 6e 20 61 6e 64 20 63 6c 6f 73 65 20 74 68 pen and close th
38b0: 65 20 64 62 0a 09 20 20 20 20 3b 3b 20 6f 6e 20 e db.. ;; on
38c0: 65 76 65 72 79 20 61 63 63 65 73 73 20 74 6f 20 every access to
38d0: 72 65 64 75 63 65 20 74 68 65 20 70 72 6f 62 61 reduce the proba
38e0: 62 6c 69 74 69 79 20 6f 66 20 0a 09 20 20 20 20 blitiy of ..
38f0: 3b 3b 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 6f 72 ;; contention or
3900: 20 73 74 75 63 6b 20 61 63 63 65 73 73 20 6f 6e stuck access on
3910: 20 6e 66 73 2e 0a 09 20 20 20 20 28 73 71 6c 69 nfs... (sqli
3920: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
3930: 29 0a 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 )... (let* ((
3940: 6d 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 m (ma
3950: 6b 65 2d 6d 75 74 65 78 29 29 0a 09 09 20 20 20 ke-mutex))...
3960: 28 6b 69 6c 6c 2d 6a 6f 62 3f 20 20 20 20 23 66 (kill-job? #f
3970: 29 0a 09 09 20 20 20 28 65 78 69 74 2d 69 6e 66 )... (exit-inf
3980: 6f 20 20 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f o (make-vecto
3990: 72 20 33 29 29 0a 09 09 20 20 20 28 6a 6f 62 2d r 3))... (job-
39a0: 74 68 72 65 61 64 20 20 20 23 66 29 0a 09 09 20 thread #f)...
39b0: 20 20 28 72 75 6e 69 74 20 20 20 20 20 20 20 20 (runit
39c0: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 20 (lambda ().....
39d0: 20 20 3b 3b 20 28 6c 65 74 2d 76 61 6c 75 65 73 ;; (let-values
39e0: 0a 09 09 09 09 20 20 20 3b 3b 20 20 28 28 28 70 ..... ;; (((p
39f0: 69 64 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 id exit-status e
3a00: 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 09 20 20 xit-code).....
3a10: 20 3b 3b 20 20 20 20 28 72 75 6e 2d 6e 2d 77 61 ;; (run-n-wa
3a20: 69 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 it fullrunscript
3a30: 29 29 29 0a 09 09 09 09 20 20 20 28 6c 65 74 20 )))..... (let
3a40: 28 28 70 69 64 20 28 70 72 6f 63 65 73 73 2d 72 ((pid (process-r
3a50: 75 6e 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 un fullrunscript
3a60: 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 6c 65 )))..... (le
3a70: 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 t loop ((i 0))..
3a80: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 2d 76 ... (let-v
3a90: 61 6c 75 65 73 0a 09 09 09 09 09 28 28 28 70 69 alues......(((pi
3aa0: 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 75 d-val exit-statu
3ab0: 73 20 65 78 69 74 2d 63 6f 64 65 29 20 28 70 72 s exit-code) (pr
3ac0: 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 ocess-wait pid #
3ad0: 74 29 29 29 0a 09 09 09 09 09 28 6d 75 74 65 78 t)))......(mutex
3ae0: 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 28 -lock! m)......(
3af0: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit
3b00: 2d 69 6e 66 6f 20 30 20 70 69 64 29 0a 09 09 09 -info 0 pid)....
3b10: 09 09 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 ..(vector-set! e
3b20: 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 74 2d xit-info 1 exit-
3b30: 73 74 61 74 75 73 29 0a 09 09 09 09 09 28 76 65 status)......(ve
3b40: 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 ctor-set! exit-i
3b50: 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f 64 65 29 nfo 2 exit-code)
3b60: 0a 09 09 09 09 09 28 6d 75 74 65 78 2d 75 6e 6c ......(mutex-unl
3b70: 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 28 69 66 ock! m)......(if
3b80: 20 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 (eq? pid-val 0)
3b90: 0a 09 09 09 09 09 20 20 20 20 28 62 65 67 69 6e ...... (begin
3ba0: 0a 09 09 09 09 09 20 20 20 20 20 20 28 74 68 72 ...... (thr
3bb0: 65 61 64 2d 73 6c 65 65 70 21 20 32 29 0a 09 09 ead-sleep! 2)...
3bc0: 09 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 ... (loop (
3bd0: 2b 20 69 20 31 29 29 29 0a 09 09 09 09 09 20 20 + i 1)))......
3be0: 20 20 29 29 29 29 29 29 0a 09 09 20 20 20 28 6d ))))))... (m
3bf0: 6f 6e 69 74 6f 72 6a 6f 62 20 20 20 28 6c 61 6d onitorjob (lam
3c00: 62 64 61 20 28 29 0a 09 09 09 09 20 20 20 28 6c bda ()..... (l
3c10: 65 74 2a 20 28 28 73 74 61 72 74 2d 73 65 63 6f et* ((start-seco
3c20: 6e 64 73 20 28 63 75 72 72 65 6e 74 2d 73 65 63 nds (current-sec
3c30: 6f 6e 64 73 29 29 0a 09 09 09 09 09 20 20 28 63 onds))...... (c
3c40: 61 6c 63 2d 6d 69 6e 75 74 65 73 20 20 28 6c 61 alc-minutes (la
3c50: 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 09 20 mbda ()........
3c60: 20 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 63 (inexact->exac
3c70: 74 20 0a 09 09 09 09 09 09 09 20 20 20 20 28 72 t ........ (r
3c80: 6f 75 6e 64 20 0a 09 09 09 09 09 09 09 20 20 20 ound ........
3c90: 20 20 28 2d 20 0a 09 09 09 09 09 09 09 20 20 20 (- ........
3ca0: 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (current-seco
3cb0: 6e 64 73 29 20 0a 09 09 09 09 09 09 09 20 20 20 nds) ........
3cc0: 20 20 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 start-seconds
3cd0: 29 29 29 29 29 0a 09 09 09 09 09 20 20 28 6b 69 )))))...... (ki
3ce0: 6c 6c 2d 74 72 69 65 73 20 30 29 29 0a 09 09 09 ll-tries 0))....
3cf0: 09 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 . (let loop
3d00: 28 28 6d 69 6e 75 74 65 73 20 20 20 28 63 61 6c ((minutes (cal
3d10: 63 2d 6d 69 6e 75 74 65 73 29 29 29 0a 09 09 09 c-minutes)))....
3d20: 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 . (let ((d
3d30: 62 20 20 20 20 28 6f 70 65 6e 2d 64 62 29 29 29 b (open-db)))
3d40: 0a 09 09 09 09 09 20 28 73 65 74 21 20 6b 69 6c ...... (set! kil
3d50: 6c 2d 6a 6f 62 3f 20 28 74 65 73 74 2d 67 65 74 l-job? (test-get
3d60: 2d 6b 69 6c 6c 2d 72 65 71 75 65 73 74 20 64 62 -kill-request db
3d70: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
3d80: 65 20 69 74 65 6d 64 61 74 29 29 0a 09 09 09 09 e itemdat)).....
3d90: 09 20 28 74 65 73 74 2d 75 70 64 61 74 65 2d 6d . (test-update-m
3da0: 65 74 61 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d eta-info db run-
3db0: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
3dc0: 6d 64 61 74 20 6d 69 6e 75 74 65 73 29 0a 09 09 mdat minutes)...
3dd0: 09 09 09 20 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 ... (if kill-job
3de0: 3f 20 0a 09 09 09 09 09 20 20 20 20 20 28 62 65 ? ...... (be
3df0: 67 69 6e 0a 09 09 09 09 09 20 20 20 20 20 20 20 gin......
3e00: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a (mutex-lock! m).
3e10: 09 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 ..... (let
3e20: 2a 20 28 28 70 69 64 20 28 76 65 63 74 6f 72 2d * ((pid (vector-
3e30: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 ref exit-info 0)
3e40: 29 29 0a 09 09 09 09 09 09 20 28 69 66 20 28 6e ))....... (if (n
3e50: 75 6d 62 65 72 3f 20 70 69 64 29 0a 09 09 09 09 umber? pid).....
3e60: 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 .. (begin...
3e70: 09 09 09 09 20 20 20 20 20 20 20 28 64 65 62 75 .... (debu
3e80: 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 g:print 0 "WARNI
3e90: 4e 47 3a 20 52 65 71 75 65 73 74 20 72 65 63 65 NG: Request rece
3ea0: 69 76 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 ived to kill job
3eb0: 20 28 61 74 74 65 6d 70 74 20 23 20 22 20 6b 69 (attempt # " ki
3ec0: 6c 6c 2d 74 72 69 65 73 20 22 29 22 29 0a 09 09 ll-tries ")")...
3ed0: 09 09 09 09 20 20 20 20 20 20 20 3b 3b 28 63 6f .... ;;(co
3ee0: 6e 64 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 nd.......
3ef0: 3b 3b 28 28 3e 20 20 20 6b 69 6c 6c 2d 74 72 69 ;;((> kill-tri
3f00: 65 73 20 30 29 20 3b 20 32 29 0a 09 09 09 09 09 es 0) ; 2)......
3f10: 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 70 . (let ((p
3f20: 72 6f 63 65 73 73 65 73 20 28 63 6d 64 2d 72 75 rocesses (cmd-ru
3f30: 6e 2d 3e 6c 69 73 74 20 28 63 6f 6e 63 20 22 70 n->list (conc "p
3f40: 67 72 65 70 20 2d 6c 20 2d 50 20 22 20 70 69 64 grep -l -P " pid
3f50: 29 29 29 29 0a 09 09 09 09 09 09 09 20 28 66 6f ))))........ (fo
3f60: 72 2d 65 61 63 68 20 0a 09 09 09 09 09 09 09 20 r-each ........
3f70: 20 28 6c 61 6d 62 64 61 20 28 70 29 0a 09 09 09 (lambda (p)....
3f80: 09 09 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 .... (let* ((
3f90: 70 61 72 74 73 20 20 28 73 74 72 69 6e 67 2d 73 parts (string-s
3fa0: 70 6c 69 74 20 70 29 29 0a 09 09 09 09 09 09 09 plit p))........
3fb0: 09 20 20 20 28 70 2d 69 64 20 20 20 28 69 66 20 . (p-id (if
3fc0: 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 72 74 73 (> (length parts
3fd0: 29 20 30 29 0a 09 09 09 09 09 09 09 09 09 20 20 ) 0)..........
3fe0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 (string->nu
3ff0: 6d 62 65 72 20 28 63 61 72 20 70 61 72 74 73 29 mber (car parts)
4000: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
4010: 20 20 23 66 29 29 29 0a 09 09 09 09 09 09 09 20 #f)))........
4020: 20 20 20 20 20 28 69 66 20 70 2d 69 64 0a 09 09 (if p-id...
4030: 09 09 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 ...... (begin..
4040: 09 09 09 09 09 09 09 20 20 20 20 28 64 65 62 75 ....... (debu
4050: 67 3a 70 72 69 6e 74 20 30 20 22 4b 69 6c 6c 69 g:print 0 "Killi
4060: 6e 67 20 22 20 28 63 61 64 72 20 70 61 72 74 73 ng " (cadr parts
4070: 29 20 22 3b 20 6b 69 6c 6c 20 2d 39 20 20 22 20 ) "; kill -9 "
4080: 70 2d 69 64 29 0a 09 09 09 09 09 09 09 09 20 20 p-id).........
4090: 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 (system (conc
40a0: 22 6b 69 6c 6c 20 2d 39 20 22 20 70 2d 69 64 29 "kill -9 " p-id)
40b0: 29 29 29 29 29 0a 09 09 09 09 09 09 09 20 20 28 )))))........ (
40c0: 63 61 72 20 70 72 6f 63 65 73 73 65 73 29 29 0a car processes)).
40d0: 09 09 09 09 09 09 09 20 28 73 79 73 74 65 6d 20 ....... (system
40e0: 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d 39 20 22 (conc "kill -9 "
40f0: 20 70 69 64 29 29 29 29 0a 09 09 09 09 09 09 20 pid)))).......
4100: 20 20 20 20 3b 3b 28 6c 65 74 2a 20 28 28 70 70 ;;(let* ((pp
4110: 69 64 20 28 70 72 6f 63 65 73 73 2d 67 72 6f 75 id (process-grou
4120: 70 2d 69 64 20 70 69 64 29 29 0a 09 09 09 09 09 p-id pid))......
4130: 09 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 28 . ;; (
4140: 6b 63 6d 64 20 28 63 6f 6e 63 20 22 70 6b 69 6c kcmd (conc "pkil
4150: 6c 20 2d 39 20 2d 67 20 22 20 70 70 69 64 29 29 l -9 -g " ppid))
4160: 29 0a 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 )....... ;;
4170: 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d 73 69 67 ;; (process-sig
4180: 6e 61 6c 20 70 69 64 20 73 69 67 6e 61 6c 2f 74 nal pid signal/t
4190: 65 72 6d 29 0a 09 09 09 09 09 09 20 20 20 20 20 erm).......
41a0: 3b 3b 20 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d ;; ;; (process-
41b0: 73 69 67 6e 61 6c 20 70 69 64 20 73 69 67 6e 61 signal pid signa
41c0: 6c 2f 6b 69 6c 6c 29 0a 09 09 09 09 09 09 20 20 l/kill).......
41d0: 20 20 20 3b 3b 20 20 28 64 65 62 75 67 3a 70 72 ;; (debug:pr
41e0: 69 6e 74 20 30 20 22 41 74 74 65 6d 70 74 69 6e int 0 "Attemptin
41f0: 67 20 74 6f 20 6b 69 6c 6c 20 70 69 64 20 22 20 g to kill pid "
4200: 70 69 64 20 22 20 61 6e 64 20 63 68 69 6c 64 72 pid " and childr
4210: 65 6e 20 69 6e 20 70 72 6f 63 65 73 73 20 67 72 en in process gr
4220: 6f 75 70 20 22 20 70 70 69 64 20 22 20 77 69 74 oup " ppid " wit
4230: 68 20 63 6f 6d 6d 61 6e 64 3a 5c 6e 20 20 20 20 h command:\n
4240: 22 20 6b 63 6d 64 29 0a 09 09 09 09 09 09 20 20 " kcmd).......
4250: 20 20 20 3b 3b 20 20 28 64 65 62 75 67 3a 70 72 ;; (debug:pr
4260: 69 6e 74 20 30 20 22 43 68 69 6c 64 72 65 6e 3a int 0 "Children:
4270: 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 3b 3b ")....... ;;
4280: 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 (system (conc
4290: 22 70 67 72 65 70 20 2d 67 20 2d 6c 20 22 20 70 "pgrep -g -l " p
42a0: 70 69 64 29 29 0a 09 09 09 09 09 09 20 20 20 20 pid)).......
42b0: 20 3b 3b 20 20 28 73 79 73 74 65 6d 20 6b 63 6d ;; (system kcm
42c0: 64 29 0a 09 09 09 09 09 09 20 20 20 20 20 3b 3b d)....... ;;
42d0: 20 20 28 73 6c 65 65 70 20 31 29 20 3b 3b 20 67 (sleep 1) ;; g
42e0: 69 76 65 20 69 74 20 61 20 72 65 73 74 0a 09 09 ive it a rest...
42f0: 09 09 09 09 20 20 20 20 20 3b 3b 20 20 28 74 65 .... ;; (te
4300: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 st-set-status! d
4310: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
4320: 6d 65 20 22 4b 49 4c 4c 45 44 22 20 20 22 46 41 me "KILLED" "FA
4330: 49 4c 22 0a 09 09 09 09 09 09 20 20 20 20 20 3b IL"....... ;
4340: 3b 20 20 20 20 20 20 20 09 20 20 20 20 20 69 74 ; . it
4350: 65 6d 64 61 74 20 28 61 72 67 73 3a 67 65 74 2d emdat (args:get-
4360: 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 09 09 09 arg "-m"))......
4370: 09 20 20 20 20 20 3b 3b 20 20 28 73 71 6c 69 74 . ;; (sqlit
4380: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
4390: 0a 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 20 ....... ;;
43a0: 28 65 78 69 74 20 31 29 29 29 29 29 0a 09 09 09 (exit 1)))))....
43b0: 09 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ... (begin..
43c0: 09 09 09 09 09 20 20 20 20 20 20 20 28 64 65 62 ..... (deb
43d0: 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e ug:print 0 "WARN
43e0: 49 4e 47 3a 20 52 65 71 75 65 73 74 20 72 65 63 ING: Request rec
43f0: 65 69 76 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f eived to kill jo
4400: 62 20 62 75 74 20 70 72 6f 62 6c 65 6d 20 77 69 b but problem wi
4410: 74 68 20 70 72 6f 63 65 73 73 2c 20 61 74 74 65 th process, atte
4420: 6d 70 74 69 6e 67 20 74 6f 20 6b 69 6c 6c 20 6d mpting to kill m
4430: 61 6e 61 67 65 72 20 70 72 6f 63 65 73 73 22 29 anager process")
4440: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 74 ....... (t
4450: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
4460: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
4470: 61 6d 65 20 22 4b 49 4c 4c 45 44 22 20 20 22 46 ame "KILLED" "F
4480: 41 49 4c 22 0a 09 09 09 09 09 09 09 09 09 20 69 AIL".......... i
4490: 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67 65 74 temdat (args:get
44a0: 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 -arg "-m") #f)..
44b0: 09 09 09 09 09 20 20 20 20 20 20 20 28 73 71 6c ..... (sql
44c0: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
44d0: 62 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 b).......
44e0: 28 65 78 69 74 20 31 29 29 29 29 0a 09 09 09 09 (exit 1)))).....
44f0: 09 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 28 . ;; (
4500: 74 68 72 65 61 64 2d 74 65 72 6d 69 6e 61 74 65 thread-terminate
4510: 21 20 6a 6f 62 2d 74 68 72 65 61 64 29 29 29 0a ! job-thread))).
4520: 09 09 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ..... (set
4530: 21 20 6b 69 6c 6c 2d 74 72 69 65 73 20 28 2b 20 ! kill-tries (+
4540: 31 20 6b 69 6c 6c 2d 74 72 69 65 73 29 29 0a 09 1 kill-tries))..
4550: 09 09 09 09 20 20 20 20 20 20 20 28 6d 75 74 65 .... (mute
4560: 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 29 29 0a 09 x-unlock! m)))..
4570: 09 09 09 09 20 3b 3b 20 28 68 61 6e 64 6c 65 2d .... ;; (handle-
4580: 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 09 09 exceptions......
4590: 20 20 20 20 20 20 20 3b 3b 20 20 65 78 6e 0a 09 ;; exn..
45a0: 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 20 28 .... ;; (
45b0: 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 20 20 begin......
45c0: 20 20 3b 3b 20 20 20 20 28 64 65 62 75 67 3a 70 ;; (debug:p
45d0: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 50 rint 0 "ERROR: P
45e0: 72 6f 62 6c 65 6d 20 6b 69 6c 6c 69 6e 67 20 70 roblem killing p
45f0: 72 6f 63 65 73 73 20 22 20 28 76 65 63 74 6f 72 rocess " (vector
4600: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 30 -ref exit-info 0
4610: 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 3b ))...... ;
4620: 3b 20 20 20 20 28 61 62 6f 72 74 20 65 78 6e 29 ; (abort exn)
4630: 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 3b 3b )...... ;;
4640: 20 20 28 6c 65 74 2a 20 28 28 70 69 64 20 20 20 (let* ((pid
4650: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
4660: 2d 69 6e 66 6f 20 30 29 29 0a 09 09 09 09 09 20 -info 0))......
4670: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 ;;
4680: 20 3b 3b 20 28 70 67 69 64 20 20 28 70 72 6f 63 ;; (pgid (proc
4690: 65 73 73 2d 67 72 6f 75 70 2d 69 64 20 70 69 64 ess-group-id pid
46a0: 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 3b ))...... ;
46b0: 3b 20 20 20 20 20 20 20 20 20 3b 3b 20 28 63 6d ; ;; (cm
46c0: 64 20 20 28 63 6f 6e 63 20 22 70 6b 69 6c 6c 20 d (conc "pkill
46d0: 2d 39 20 2d 50 20 22 20 70 67 69 64 29 29 0a 09 -9 -P " pgid))..
46e0: 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 20 20 .... ;;
46f0: 20 20 20 20 20 20 29 0a 09 09 09 09 09 20 20 20 )......
4700: 20 20 20 20 3b 3b 20 20 20 20 3b 3b 20 28 64 65 ;; ;; (de
4710: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 52 75 6e bug:print 0 "Run
4720: 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 ning \"" cmd "\"
4730: 22 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 3b ")...... ;
4740: 3b 20 20 20 20 3b 3b 20 28 73 79 73 74 65 6d 20 ; ;; (system
4750: 63 6d 64 29 0a 09 09 09 09 09 20 20 20 20 20 20 cmd)......
4760: 20 3b 3b 20 20 20 20 28 64 65 62 75 67 3a 70 72 ;; (debug:pr
4770: 69 6e 74 20 30 20 22 52 75 6e 6e 69 6e 67 20 5c int 0 "Running \
4780: 22 6b 69 6c 6c 20 2d 39 20 22 20 70 69 64 20 22 "kill -9 " pid "
4790: 5c 22 22 29 0a 09 09 09 09 09 20 20 20 20 20 20 \"")......
47a0: 20 3b 3b 20 20 20 20 28 73 79 73 74 65 6d 20 28 ;; (system (
47b0: 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d 39 20 22 20 conc "kill -9 "
47c0: 70 69 64 29 29 0a 09 09 09 09 09 20 20 20 20 20 pid))......
47d0: 20 20 3b 3b 20 20 20 20 3b 3b 20 28 70 72 6f 63 ;; ;; (proc
47e0: 65 73 73 2d 73 69 67 6e 61 6c 20 28 76 65 63 74 ess-signal (vect
47f0: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
4800: 20 30 29 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 0) signal/kill)
4810: 0a 09 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 ...... ;;
4820: 20 20 20 29 29 29 29 0a 09 09 09 09 09 20 28 73 ))))...... (s
4830: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
4840: 20 64 62 29 0a 09 09 09 09 09 20 28 74 68 72 65 db)...... (thre
4850: 61 64 2d 73 6c 65 65 70 21 20 28 2b 20 38 20 28 ad-sleep! (+ 8 (
4860: 72 61 6e 64 6f 6d 20 34 29 29 29 20 3b 3b 20 61 random 4))) ;; a
4870: 64 64 20 73 6f 6d 65 20 6a 69 74 74 65 72 20 74 dd some jitter t
4880: 6f 20 74 68 65 20 63 61 6c 6c 20 68 6f 6d 65 20 o the call home
4890: 74 69 6d 65 20 74 6f 20 73 70 72 65 61 64 20 6f time to spread o
48a0: 75 74 20 74 68 65 20 64 62 20 61 63 63 65 73 73 ut the db access
48b0: 65 73 0a 09 09 09 09 09 20 28 6c 6f 6f 70 20 28 es...... (loop (
48c0: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 29 calc-minutes))))
48d0: 29 29 29 0a 09 09 20 20 20 28 74 68 31 20 20 20 )))... (th1
48e0: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 (make-thr
48f0: 65 61 64 20 6d 6f 6e 69 74 6f 72 6a 6f 62 29 29 ead monitorjob))
4900: 0a 09 09 20 20 20 28 74 68 32 20 20 20 20 20 20 ... (th2
4910: 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 (make-thread
4920: 20 72 75 6e 69 74 29 29 29 0a 09 20 20 20 20 20 runit)))..
4930: 20 28 73 65 74 21 20 6a 6f 62 2d 74 68 72 65 61 (set! job-threa
4940: 64 20 74 68 32 29 0a 09 20 20 20 20 20 20 28 74 d th2).. (t
4950: 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 hread-start! th1
4960: 29 0a 09 20 20 20 20 20 20 28 74 68 72 65 61 64 ).. (thread
4970: 2d 73 74 61 72 74 21 20 74 68 32 29 0a 09 20 20 -start! th2)..
4980: 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e (thread-join
4990: 21 20 74 68 32 29 0a 09 20 20 20 20 20 20 28 6d ! th2).. (m
49a0: 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 20 utex-lock! m)..
49b0: 20 20 20 20 20 28 73 65 74 21 20 64 62 20 28 6f (set! db (o
49c0: 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 20 20 pen-db))..
49d0: 28 6c 65 74 2a 20 28 28 69 74 65 6d 2d 70 61 74 (let* ((item-pat
49e0: 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 h (item-list->pa
49f0: 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 09 20 th itemdat))...
4a00: 20 20 20 20 28 74 65 73 74 69 6e 66 6f 20 20 28 (testinfo (
4a10: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f db:get-test-info
4a20: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d db run-id test-
4a30: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 name item-path))
4a40: 29 0a 09 09 28 69 66 20 28 6e 6f 74 20 28 65 71 )...(if (not (eq
4a50: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
4a60: 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f t-state testinfo
4a70: 29 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 0a ) "COMPLETED")).
4a80: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 .. (begin...
4a90: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
4aa0: 74 20 32 20 22 54 65 73 74 20 4e 4f 54 20 6c 6f t 2 "Test NOT lo
4ab0: 67 67 65 64 20 61 73 20 43 4f 4d 50 4c 45 54 45 gged as COMPLETE
4ac0: 44 2c 20 28 73 74 61 74 65 3d 22 20 28 64 62 3a D, (state=" (db:
4ad0: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
4ae0: 65 73 74 69 6e 66 6f 29 20 22 29 2c 20 75 70 64 estinfo) "), upd
4af0: 61 74 69 6e 67 20 72 65 73 75 6c 74 22 29 0a 09 ating result")..
4b00: 09 20 20 20 20 20 20 28 74 65 73 74 2d 73 65 74 . (test-set
4b10: 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 6e 2d -status! db run-
4b20: 69 64 20 74 65 73 74 2d 6e 61 6d 65 0a 09 09 09 id test-name....
4b30: 09 09 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 ..(if kill-job?
4b40: 22 4b 49 4c 4c 45 44 22 20 22 43 4f 4d 50 4c 45 "KILLED" "COMPLE
4b50: 54 45 44 22 29 0a 09 09 09 09 09 28 69 66 20 28 TED")......(if (
4b60: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
4b70: 69 6e 66 6f 20 31 29 20 3b 3b 20 6c 6f 6f 6b 20 info 1) ;; look
4b80: 61 74 20 74 68 65 20 65 78 69 74 2d 73 74 61 74 at the exit-stat
4b90: 75 73 0a 09 09 09 09 09 20 20 20 20 28 69 66 20 us...... (if
4ba0: 28 61 6e 64 20 28 6e 6f 74 20 6b 69 6c 6c 2d 6a (and (not kill-j
4bb0: 6f 62 3f 29 20 0a 09 09 09 09 09 09 20 20 20 20 ob?) .......
4bc0: 20 28 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 65 (eq? (vector-re
4bd0: 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 30 f exit-info 2) 0
4be0: 29 29 0a 09 09 09 09 09 09 22 50 41 53 53 22 0a ))......."PASS".
4bf0: 09 09 09 09 09 09 22 46 41 49 4c 22 29 0a 09 09 ......"FAIL")...
4c00: 09 09 09 20 20 20 20 22 46 41 49 4c 22 29 20 69 ... "FAIL") i
4c10: 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67 65 74 temdat (args:get
4c20: 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 29 29 -arg "-m") #f)))
4c30: 0a 09 09 3b 3b 20 66 6f 72 20 61 75 74 6f 6d 61 ...;; for automa
4c40: 74 65 64 20 63 72 65 61 74 69 6f 6e 20 6f 66 20 ted creation of
4c50: 74 68 65 20 72 6f 6c 6c 75 70 20 68 74 6d 6c 20 the rollup html
4c60: 66 69 6c 65 20 74 68 69 73 20 69 73 20 61 20 67 file this is a g
4c70: 6f 6f 64 20 70 6c 61 63 65 2e 2e 2e 0a 09 09 28 ood place......(
4c80: 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 if (not (equal?
4c90: 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 0a 09 item-path ""))..
4ca0: 09 20 20 20 28 74 65 73 74 73 3a 73 75 6d 6d 61 . (tests:summa
4cb0: 72 69 7a 65 2d 69 74 65 6d 73 20 64 62 20 72 75 rize-items db ru
4cc0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 n-id test-name #
4cd0: 66 29 29 20 3b 3b 20 64 6f 6e 27 74 20 66 6f 72 f)) ;; don't for
4ce0: 63 65 20 2d 20 6a 75 73 74 20 75 70 64 61 74 65 ce - just update
4cf0: 20 69 66 20 6e 6f 0a 09 09 29 0a 09 20 20 20 20 if no...)..
4d00: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
4d10: 20 6d 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 65 m).. ;; (e
4d20: 78 65 63 2d 72 65 73 75 6c 74 73 20 28 63 6d 64 xec-results (cmd
4d30: 2d 72 75 6e 2d 3e 6c 69 73 74 20 66 75 6c 6c 72 -run->list fullr
4d40: 75 6e 73 63 72 69 70 74 29 29 20 3b 3b 20 20 28 unscript)) ;; (
4d50: 6c 69 73 74 20 22 3e 22 20 28 63 6f 6e 63 20 74 list ">" (conc t
4d60: 65 73 74 2d 6e 61 6d 65 20 22 2d 72 75 6e 2e 6c est-name "-run.l
4d70: 6f 67 22 29 29 29 29 0a 09 20 20 20 20 20 20 3b og")))).. ;
4d80: 3b 20 28 73 75 63 63 65 73 73 20 20 20 20 20 20 ; (success
4d90: 65 78 65 63 2d 72 65 73 75 6c 74 73 29 29 20 3b exec-results)) ;
4da0: 3b 20 28 65 71 3f 20 28 63 61 64 72 20 65 78 65 ; (eq? (cadr exe
4db0: 63 2d 72 65 73 75 6c 74 73 29 20 30 29 29 29 0a c-results) 0))).
4dc0: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
4dd0: 69 6e 74 20 32 20 22 4f 75 74 70 75 74 20 66 72 int 2 "Output fr
4de0: 6f 6d 20 72 75 6e 6e 69 6e 67 20 22 20 66 75 6c om running " ful
4df0: 6c 72 75 6e 73 63 72 69 70 74 20 22 2c 20 70 69 lrunscript ", pi
4e00: 64 20 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 d " (vector-ref
4e10: 65 78 69 74 2d 69 6e 66 6f 20 30 29 20 22 20 69 exit-info 0) " i
4e20: 6e 20 77 6f 72 6b 20 61 72 65 61 20 22 20 0a 09 n work area " ..
4e30: 09 20 20 20 20 20 77 6f 72 6b 2d 61 72 65 61 20 . work-area
4e40: 22 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 65 78 69 74 20 ":\n====\n exit
4e50: 63 6f 64 65 20 22 20 28 76 65 63 74 6f 72 2d 72 code " (vector-r
4e60: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 ef exit-info 2)
4e70: 22 5c 6e 22 20 22 3d 3d 3d 3d 5c 6e 22 29 0a 09 "\n" "====\n")..
4e80: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 (sqlite3:f
4e90: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 inalize! db)..
4ea0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 76 65 (if (not (ve
4eb0: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
4ec0: 66 6f 20 31 29 29 0a 09 09 20 20 28 65 78 69 74 fo 1))... (exit
4ed0: 20 34 29 29 29 29 29 0a 20 20 20 20 20 20 28 73 4))))). (s
4ee0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
4ef0: 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
4f00: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
4f10: 65 70 22 29 0a 20 20 20 20 28 69 66 20 28 6e 6f ep"). (if (no
4f20: 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d t (getenv "MT_CM
4f30: 44 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e DINFO"))..(begin
4f40: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
4f50: 20 30 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 0 "ERROR: MT_CM
4f60: 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f DINFO env var no
4f70: 74 20 73 65 74 2c 20 2d 73 74 65 70 20 6d 75 73 t set, -step mus
4f80: 74 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 t be called *ins
4f90: 69 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 ide* a megatest
4fa0: 69 6e 76 6f 6b 65 64 20 65 6e 76 69 72 6f 6e 6d invoked environm
4fb0: 65 6e 74 21 22 29 0a 09 20 20 28 65 78 69 74 20 ent!").. (exit
4fc0: 35 29 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 65 5))..(let* ((ste
4fd0: 70 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 p (args:get
4fe0: 2d 61 72 67 20 22 2d 73 74 65 70 22 29 29 0a 09 -arg "-step"))..
4ff0: 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 (cmdinfo
5000: 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e (read (open-in
5010: 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 put-string (base
5020: 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 64:base64-decode
5030: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
5040: 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 20 20 INFO")))))..
5050: 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 61 (testpath (a
5060: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
5070: 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 stpath cmdinfo)
5080: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d ).. (test-
5090: 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 name (assoc/defa
50a0: 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 ult 'test-name c
50b0: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
50c0: 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 73 (runscript (ass
50d0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 73 oc/default 'runs
50e0: 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a cript cmdinfo)).
50f0: 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 74 . (db-host
5100: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
5110: 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 t 'db-host cmd
5120: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
5130: 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 run-id (assoc
5140: 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 /default 'run-id
5150: 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 cmdinfo))..
5160: 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 (itemdat
5170: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
5180: 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 'itemdat cmdin
5190: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 fo)).. (db
51a0: 20 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 #f)..
51b0: 20 20 20 20 28 73 74 61 74 65 20 20 20 20 28 61 (state (a
51c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
51d0: 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 ate")).. (
51e0: 73 74 61 74 75 73 20 20 20 28 61 72 67 73 3a 67 status (args:g
51f0: 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 et-arg ":status"
5200: 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 ))).. (change-d
5210: 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
5220: 68 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 h).. (if (not (
5230: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
5240: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
5250: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
5260: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
5270: 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 exiting")...(ex
5280: 69 74 20 31 29 29 29 0a 09 20 20 28 73 65 74 21 it 1))).. (set!
5290: 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 db (open-db))..
52a0: 20 20 28 69 66 20 28 61 6e 64 20 73 74 61 74 65 (if (and state
52b0: 20 73 74 61 74 75 73 29 0a 09 20 20 20 20 20 20 status)..
52c0: 28 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 (teststep-set-st
52d0: 61 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 atus! db run-id
52e0: 74 65 73 74 2d 6e 61 6d 65 20 73 74 65 70 20 73 test-name step s
52f0: 74 61 74 65 20 73 74 61 74 75 73 20 69 74 65 6d tate status item
5300: 64 61 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 dat (args:get-ar
5310: 67 20 22 2d 6d 22 29 29 0a 09 20 20 20 20 20 20 g "-m"))..
5320: 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a (begin...(debug:
5330: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
5340: 59 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 You must specify
5350: 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 :state and :sta
5360: 74 75 73 20 77 69 74 68 20 65 76 65 72 79 20 63 tus with every c
5370: 61 6c 6c 20 74 6f 20 2d 73 74 65 70 22 29 0a 09 all to -step")..
5380: 09 28 65 78 69 74 20 36 29 29 29 0a 09 20 20 28 .(exit 6))).. (
5390: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
53a0: 21 20 64 62 29 0a 09 20 20 28 73 65 74 21 20 2a ! db).. (set! *
53b0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
53c0: 29 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 ))))..(if (or (a
53d0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
53e0: 74 6c 6f 67 22 29 20 20 20 20 20 20 20 3b 3b 20 tlog") ;;
53f0: 73 69 6e 63 65 20 73 65 74 74 69 6e 67 20 75 70 since setting up
5400: 20 69 73 20 73 6f 20 63 6f 73 74 6c 79 20 6c 65 is so costly le
5410: 74 73 20 70 69 67 67 79 62 61 63 6b 20 6f 6e 20 ts piggyback on
5420: 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 09 28 61 -test-status..(a
5430: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
5440: 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 28 61 72 67 t-toplog")..(arg
5450: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
5460: 2d 73 74 61 74 75 73 22 29 0a 09 28 61 72 67 73 -status")..(args
5470: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 :get-arg "-set-v
5480: 61 6c 75 65 73 22 29 0a 09 28 61 72 67 73 3a 67 alues")..(args:g
5490: 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 et-arg "-runstep
54a0: 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
54b0: 67 20 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 g "-summarize-it
54c0: 65 6d 73 22 29 29 0a 20 20 20 20 28 69 66 20 28 ems")). (if (
54d0: 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f not (getenv "MT_
54e0: 43 4d 44 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 CMDINFO"))..(beg
54f0: 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 in.. (debug:pri
5500: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4d 54 5f nt 0 "ERROR: MT_
5510: 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 CMDINFO env var
5520: 6e 6f 74 20 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 not set, command
5530: 73 20 2d 74 65 73 74 2d 73 74 61 74 75 73 2c 20 s -test-status,
5540: 2d 72 75 6e 73 74 65 70 20 61 6e 64 20 2d 73 65 -runstep and -se
5550: 74 6c 6f 67 20 6d 75 73 74 20 62 65 20 63 61 6c tlog must be cal
5560: 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d led *inside* a m
5570: 65 67 61 74 65 73 74 20 65 6e 76 69 72 6f 6e 6d egatest environm
5580: 65 6e 74 21 22 29 0a 09 20 20 28 65 78 69 74 20 ent!").. (exit
5590: 35 29 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 5))..(let* ((sta
55a0: 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 65 6e rtingdir (curren
55b0: 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 20 t-directory))..
55c0: 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 (cmdinfo
55d0: 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 (read (open-inp
55e0: 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 ut-string (base6
55f0: 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 4:base64-decode
5600: 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (getenv "MT_CMDI
5610: 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 20 20 20 NFO")))))..
5620: 20 20 28 74 65 73 74 70 61 74 68 20 20 28 61 73 (testpath (as
5630: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
5640: 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 tpath cmdinfo))
5650: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e .. (test-n
5660: 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ame (assoc/defau
5670: 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d lt 'test-name cm
5680: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
5690: 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f (runscript (asso
56a0: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 c/default 'runsc
56b0: 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 ript cmdinfo))..
56c0: 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 74 20 (db-host
56d0: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
56e0: 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 'db-host cmdi
56f0: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 nfo)).. (r
5700: 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f un-id (assoc/
5710: 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 default 'run-id
5720: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
5730: 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 20 (itemdat
5740: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
5750: 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 itemdat cmdinf
5760: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 20 o)).. (db
5770: 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 #f)..
5780: 20 20 20 28 73 74 61 74 65 20 20 20 20 20 28 61 (state (a
5790: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
57a0: 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 ate")).. (
57b0: 73 74 61 74 75 73 20 20 20 20 28 61 72 67 73 3a status (args:
57c0: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 get-arg ":status
57d0: 22 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d "))).. (change-
57e0: 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 directory testpa
57f0: 74 68 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 th).. (if (not
5800: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
5810: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
5820: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
5830: 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 "Failed to setup
5840: 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 , exiting")...(e
5850: 78 69 74 20 31 29 29 29 0a 09 20 20 28 73 65 74 xit 1))).. (set
5860: 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a ! db (open-db)).
5870: 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 . (if (args:get
5880: 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a -arg "-setlog").
5890: 09 20 20 20 20 20 20 28 74 65 73 74 2d 73 65 74 . (test-set
58a0: 2d 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 -log! db run-id
58b0: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 test-name itemda
58c0: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
58d0: 22 2d 73 65 74 6c 6f 67 22 29 29 29 0a 09 20 20 "-setlog")))..
58e0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
58f0: 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 g "-set-toplog")
5900: 0a 09 20 20 20 20 20 20 28 74 65 73 74 2d 73 65 .. (test-se
5910: 74 2d 74 6f 70 6c 6f 67 21 20 64 62 20 72 75 6e t-toplog! db run
5920: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 28 61 -id test-name (a
5930: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
5940: 74 2d 74 6f 70 6c 6f 67 22 29 29 29 0a 09 20 20 t-toplog")))..
5950: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
5960: 67 20 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 g "-summarize-it
5970: 65 6d 73 22 29 0a 09 20 20 20 20 20 20 28 74 65 ems").. (te
5980: 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 sts:summarize-it
5990: 65 6d 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 ems db run-id te
59a0: 73 74 2d 6e 61 6d 65 20 23 74 29 29 20 3b 3b 20 st-name #t)) ;;
59b0: 64 6f 20 66 6f 72 63 65 20 68 65 72 65 0a 09 20 do force here..
59c0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
59d0: 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 rg "-runstep")..
59e0: 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f (if (null?
59f0: 20 72 65 6d 61 72 67 73 29 0a 09 09 20 20 28 62 remargs)... (b
5a00: 65 67 69 6e 0a 09 09 20 20 20 20 28 64 65 62 75 egin... (debu
5a10: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
5a20: 3a 20 6e 6f 74 68 69 6e 67 20 73 70 65 63 69 66 : nothing specif
5a30: 69 65 64 20 74 6f 20 72 75 6e 21 22 29 0a 09 09 ied to run!")...
5a40: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e (sqlite3:fin
5a50: 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 20 20 20 alize! db)...
5a60: 20 28 65 78 69 74 20 36 29 29 0a 09 09 20 20 28 (exit 6))... (
5a70: 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 6d 65 20 let* ((stepname
5a80: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
5a90: 22 2d 72 75 6e 73 74 65 70 22 29 29 0a 09 09 09 "-runstep"))....
5aa0: 20 28 6c 6f 67 70 72 6f 66 69 6c 65 20 28 61 72 (logprofile (ar
5ab0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 gs:get-arg "-log
5ac0: 70 72 6f 22 29 29 0a 09 09 09 20 28 6c 6f 67 66 pro")).... (logf
5ad0: 69 6c 65 20 20 20 20 28 63 6f 6e 63 20 73 74 65 ile (conc ste
5ae0: 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 29 0a 09 pname ".log"))..
5af0: 09 09 20 28 63 6d 64 20 20 20 20 20 20 20 20 28 .. (cmd (
5b00: 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 if (null? remarg
5b10: 73 29 20 23 66 20 28 63 61 72 20 72 65 6d 61 72 s) #f (car remar
5b20: 67 73 29 29 29 0a 09 09 09 20 28 70 61 72 61 6d gs))).... (param
5b30: 73 20 20 20 20 20 28 69 66 20 63 6d 64 20 28 63 s (if cmd (c
5b40: 64 72 20 72 65 6d 61 72 67 73 29 20 27 28 29 29 dr remargs) '())
5b50: 29 0a 09 09 09 20 28 65 78 69 74 73 74 61 74 20 ).... (exitstat
5b60: 20 20 23 66 29 0a 09 09 09 20 28 73 68 65 6c 6c #f).... (shell
5b70: 20 20 20 20 20 20 28 6c 61 73 74 20 28 73 74 72 (last (str
5b80: 69 6e 67 2d 73 70 6c 69 74 20 28 67 65 74 2d 65 ing-split (get-e
5b90: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
5ba0: 62 6c 65 20 22 53 48 45 4c 4c 22 29 20 22 2f 22 ble "SHELL") "/"
5bb0: 29 29 29 0a 09 09 09 20 28 72 65 64 69 72 20 20 ))).... (redir
5bc0: 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e (case (strin
5bd0: 67 2d 3e 73 79 6d 62 6f 6c 20 73 68 65 6c 6c 29 g->symbol shell)
5be0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 74 63 ..... ((tc
5bf0: 73 68 20 63 73 68 20 6b 73 68 29 20 20 20 20 22 sh csh ksh) "
5c00: 3e 26 22 29 0a 09 09 09 09 20 20 20 20 20 20 20 >&").....
5c10: 28 28 7a 73 68 20 62 61 73 68 20 73 68 20 61 73 ((zsh bash sh as
5c20: 68 29 20 22 32 3e 26 31 20 3e 22 29 29 29 0a 09 h) "2>&1 >")))..
5c30: 09 09 20 28 66 75 6c 6c 63 6d 64 20 20 20 20 28 .. (fullcmd (
5c40: 63 6f 6e 63 20 22 28 22 20 28 73 74 72 69 6e 67 conc "(" (string
5c50: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 09 -intersperse ...
5c60: 09 09 09 09 28 63 6f 6e 73 20 63 6d 64 20 70 61 ....(cons cmd pa
5c70: 72 61 6d 73 29 20 22 20 22 29 0a 09 09 09 09 09 rams) " ")......
5c80: 20 20 20 22 29 20 22 20 72 65 64 69 72 20 22 20 ") " redir "
5c90: 22 20 6c 6f 67 66 69 6c 65 29 29 29 0a 09 09 20 " logfile)))...
5ca0: 20 20 20 3b 3b 20 6d 61 72 6b 20 74 68 65 20 73 ;; mark the s
5cb0: 74 61 72 74 20 6f 66 20 74 68 65 20 74 65 73 74 tart of the test
5cc0: 0a 09 09 20 20 20 20 28 74 65 73 74 73 74 65 70 ... (teststep
5cd0: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 -set-status! db
5ce0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
5cf0: 20 73 74 65 70 6e 61 6d 65 20 22 73 74 61 72 74 stepname "start
5d00: 22 20 22 6e 2f 61 22 20 69 74 65 6d 64 61 74 20 " "n/a" itemdat
5d10: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5d20: 6d 22 29 29 0a 09 09 20 20 20 20 3b 3b 20 63 6c m"))... ;; cl
5d30: 6f 73 65 20 74 68 65 20 64 62 0a 09 09 20 20 20 ose the db...
5d40: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
5d50: 7a 65 21 20 64 62 29 0a 09 09 20 20 20 20 3b 3b ze! db)... ;;
5d60: 20 72 75 6e 20 74 68 65 20 74 65 73 74 20 73 74 run the test st
5d70: 65 70 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a ep... (debug:
5d80: 70 72 69 6e 74 20 32 20 22 49 4e 46 4f 3a 20 52 print 2 "INFO: R
5d90: 75 6e 6e 69 6e 67 20 5c 22 22 20 66 75 6c 6c 63 unning \"" fullc
5da0: 6d 64 20 22 5c 22 22 29 0a 09 09 20 20 20 20 28 md "\"")... (
5db0: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
5dc0: 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 09 startingdir)...
5dd0: 20 20 20 20 28 73 65 74 21 20 65 78 69 74 73 74 (set! exitst
5de0: 61 74 20 28 73 79 73 74 65 6d 20 66 75 6c 6c 63 at (system fullc
5df0: 6d 64 29 29 20 3b 3b 20 63 6d 64 20 70 61 72 61 md)) ;; cmd para
5e00: 6d 73 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 ms))... (set!
5e10: 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 *globalexitstat
5e20: 75 73 2a 20 65 78 69 74 73 74 61 74 29 0a 09 09 us* exitstat)...
5e30: 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 (change-dire
5e40: 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a ctory testpath).
5e50: 09 09 20 20 20 20 3b 3b 20 72 65 2d 6f 70 65 6e .. ;; re-open
5e60: 20 74 68 65 20 64 62 0a 09 09 20 20 20 20 28 73 the db... (s
5e70: 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 et! db (open-db)
5e80: 29 20 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 ) ... ;; run
5e90: 6c 6f 67 70 72 6f 20 69 66 20 61 70 70 6c 69 63 logpro if applic
5ea0: 61 62 6c 65 20 3b 3b 20 28 70 72 6f 63 65 73 73 able ;; (process
5eb0: 2d 72 75 6e 20 22 6c 73 22 20 28 6c 69 73 74 20 -run "ls" (list
5ec0: 22 2f 66 6f 6f 22 20 22 32 3e 26 31 22 20 22 62 "/foo" "2>&1" "b
5ed0: 6c 61 68 2e 6c 6f 67 22 29 29 0a 09 09 20 20 20 lah.log"))...
5ee0: 20 28 69 66 20 6c 6f 67 70 72 6f 66 69 6c 65 0a (if logprofile.
5ef0: 09 09 09 28 6c 65 74 2a 20 28 28 68 74 6d 6c 6c ...(let* ((htmll
5f00: 6f 67 66 69 6c 65 20 28 63 6f 6e 63 20 73 74 65 ogfile (conc ste
5f10: 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 0a pname ".html")).
5f20: 09 09 09 20 20 20 20 20 20 20 28 6f 6c 64 65 78 ... (oldex
5f30: 69 74 73 74 61 74 20 65 78 69 74 73 74 61 74 29 itstat exitstat)
5f40: 0a 09 09 09 20 20 20 20 20 20 20 28 63 6d 64 20 .... (cmd
5f50: 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d (string-
5f60: 69 6e 74 65 72 73 70 65 72 73 65 20 28 6c 69 73 intersperse (lis
5f70: 74 20 22 6c 6f 67 70 72 6f 22 20 6c 6f 67 70 72 t "logpro" logpr
5f80: 6f 66 69 6c 65 20 68 74 6d 6c 6c 6f 67 66 69 6c ofile htmllogfil
5f90: 65 20 22 3c 22 20 6c 6f 67 66 69 6c 65 20 22 3e e "<" logfile ">
5fa0: 22 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 " (conc stepname
5fb0: 20 22 5f 6c 6f 67 70 72 6f 2e 6c 6f 67 22 29 29 "_logpro.log"))
5fc0: 20 22 20 22 29 29 29 0a 09 09 09 20 20 28 64 65 " "))).... (de
5fd0: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 bug:print 2 "INF
5fe0: 4f 3a 20 72 75 6e 6e 69 6e 67 20 5c 22 22 20 63 O: running \"" c
5ff0: 6d 64 20 22 5c 22 22 29 0a 09 09 09 20 20 28 63 md "\"").... (c
6000: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
6010: 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 09 09 startingdir)....
6020: 20 20 28 73 65 74 21 20 65 78 69 74 73 74 61 74 (set! exitstat
6030: 20 28 73 79 73 74 65 6d 20 63 6d 64 29 29 0a 09 (system cmd))..
6040: 09 09 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 .. (set! *globa
6050: 6c 65 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 lexitstatus* exi
6060: 74 73 74 61 74 29 20 3b 3b 20 6e 6f 20 6e 65 63 tstat) ;; no nec
6070: 65 73 73 61 72 79 0a 09 09 09 20 20 28 63 68 61 essary.... (cha
6080: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 nge-directory te
6090: 73 74 70 61 74 68 29 0a 09 09 09 20 20 28 74 65 stpath).... (te
60a0: 73 74 2d 73 65 74 2d 6c 6f 67 21 20 64 62 20 72 st-set-log! db r
60b0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
60c0: 69 74 65 6d 64 61 74 20 68 74 6d 6c 6c 6f 67 66 itemdat htmllogf
60d0: 69 6c 65 29 29 29 0a 09 09 20 20 20 20 28 74 65 ile)))... (te
60e0: 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 ststep-set-statu
60f0: 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 s! db run-id tes
6100: 74 2d 6e 61 6d 65 20 73 74 65 70 6e 61 6d 65 20 t-name stepname
6110: 22 65 6e 64 22 20 65 78 69 74 73 74 61 74 20 69 "end" exitstat i
6120: 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67 65 74 temdat (args:get
6130: 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 20 20 -arg "-m"))...
6140: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
6150: 69 7a 65 21 20 64 62 29 0a 09 09 20 20 20 20 28 ize! db)... (
6160: 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 65 78 69 if (not (eq? exi
6170: 74 73 74 61 74 20 30 29 29 0a 09 09 09 28 65 78 tstat 0))....(ex
6180: 69 74 20 32 35 34 29 29 20 3b 3b 20 28 65 78 69 it 254)) ;; (exi
6190: 74 20 65 78 69 74 73 74 61 74 29 20 64 6f 65 73 t exitstat) does
61a0: 6e 27 74 20 77 6f 72 6b 3f 21 3f 0a 09 09 20 20 n't work?!?...
61b0: 3b 3b 20 6f 70 65 6e 20 74 68 65 20 64 62 0a 09 ;; open the db..
61c0: 09 20 20 3b 3b 20 6d 61 72 6b 20 74 68 65 20 65 . ;; mark the e
61d0: 6e 64 20 6f 66 20 74 68 65 20 74 65 73 74 0a 09 nd of the test..
61e0: 09 20 20 29 29 29 0a 09 20 20 28 69 66 20 28 6f . ))).. (if (o
61f0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
6200: 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a "-test-status").
6210: 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 .. (args:get-ar
6220: 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 g "-set-values")
6230: 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 ).. (let ((
6240: 6e 65 77 73 74 61 74 75 73 20 28 63 6f 6e 64 0a newstatus (cond.
6250: 09 09 09 09 28 28 6e 75 6d 62 65 72 3f 20 73 74 ....((number? st
6260: 61 74 75 73 29 20 20 20 20 20 20 20 28 69 66 20 atus) (if
6270: 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 20 30 (equal? status 0
6280: 29 20 22 50 41 53 53 22 20 22 46 41 49 4c 22 29 ) "PASS" "FAIL")
6290: 29 0a 09 09 09 09 28 28 61 6e 64 20 28 73 74 72 ).....((and (str
62a0: 69 6e 67 3f 20 73 74 61 74 75 73 29 0a 09 09 09 ing? status)....
62b0: 09 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e . (string->
62c0: 6e 75 6d 62 65 72 20 73 74 61 74 75 73 29 29 28 number status))(
62d0: 69 66 20 28 65 71 75 61 6c 3f 20 28 73 74 72 69 if (equal? (stri
62e0: 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 ng->number statu
62f0: 73 29 20 30 29 20 22 50 41 53 53 22 20 22 46 41 s) 0) "PASS" "FA
6300: 49 4c 22 29 29 0a 09 09 09 09 28 65 6c 73 65 20 IL")).....(else
6310: 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 20 20 status)))...
6320: 3b 3b 20 74 72 61 6e 73 66 65 72 20 72 65 6c 65 ;; transfer rele
6330: 76 61 6e 74 20 6b 65 79 73 20 69 6e 74 6f 20 61 vant keys into a
6340: 20 68 61 73 68 20 74 6f 20 62 65 20 70 61 73 73 hash to be pass
6350: 65 64 20 74 6f 20 74 65 73 74 2d 73 65 74 2d 73 ed to test-set-s
6360: 74 61 74 75 73 21 0a 09 09 20 20 20 20 3b 3b 20 tatus!... ;;
6370: 63 6f 75 6c 64 20 75 73 65 20 61 6e 20 61 73 73 could use an ass
6380: 6f 63 20 6c 69 73 74 20 49 20 67 75 65 73 73 2e oc list I guess.
6390: 20 0a 09 09 20 20 20 20 28 6f 74 68 65 72 64 61 ... (otherda
63a0: 74 61 20 28 6c 65 74 20 28 28 72 65 73 20 28 6d ta (let ((res (m
63b0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
63c0: 29 0a 09 09 09 09 20 28 66 6f 72 2d 65 61 63 68 )..... (for-each
63d0: 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 (lambda (key)..
63e0: 09 09 09 09 20 20 20 20 20 28 69 66 20 28 61 72 .... (if (ar
63f0: 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 79 29 0a gs:get-arg key).
6400: 09 09 09 09 09 09 20 28 68 61 73 68 2d 74 61 62 ...... (hash-tab
6410: 6c 65 2d 73 65 74 21 20 72 65 73 20 6b 65 79 20 le-set! res key
6420: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 (args:get-arg ke
6430: 79 29 29 29 29 0a 09 09 09 09 09 20 20 20 28 6c y))))...... (l
6440: 69 73 74 20 22 3a 76 61 6c 75 65 22 20 22 3a 74 ist ":value" ":t
6450: 6f 6c 22 20 22 3a 65 78 70 65 63 74 65 64 5f 76 ol" ":expected_v
6460: 61 6c 75 65 22 20 22 3a 66 69 72 73 74 5f 65 72 alue" ":first_er
6470: 72 22 20 22 3a 66 69 72 73 74 5f 77 61 72 6e 22 r" ":first_warn"
6480: 20 22 3a 75 6e 69 74 73 22 29 29 0a 09 09 09 09 ":units")).....
6490: 20 72 65 73 29 29 29 0a 09 09 28 69 66 20 28 61 res)))...(if (a
64a0: 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 nd (args:get-arg
64b0: 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 "-test-status")
64c0: 0a 09 09 09 20 28 6f 72 20 28 6e 6f 74 20 73 74 .... (or (not st
64d0: 61 74 65 29 0a 09 09 09 20 20 20 20 20 28 6e 6f ate).... (no
64e0: 74 20 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 t status)))...
64f0: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 (begin...
6500: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
6510: 22 45 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 "ERROR: You must
6520: 20 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 specify :state
6530: 61 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 and :status with
6540: 20 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d every call to -
6550: 74 65 73 74 2d 73 74 61 74 75 73 5c 6e 22 20 68 test-status\n" h
6560: 65 6c 70 29 0a 09 09 20 20 20 20 20 20 28 73 71 elp)... (sq
6570: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
6580: 64 62 29 0a 09 09 20 20 20 20 20 20 28 65 78 69 db)... (exi
6590: 74 20 36 29 29 29 0a 09 09 28 74 65 73 74 2d 73 t 6)))...(test-s
65a0: 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 et-status! db ru
65b0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 73 n-id test-name s
65c0: 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 20 69 tate newstatus i
65d0: 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67 65 74 temdat (args:get
65e0: 2d 61 72 67 20 22 2d 6d 22 29 20 6f 74 68 65 72 -arg "-m") other
65f0: 64 61 74 61 29 29 29 0a 09 20 20 28 73 71 6c 69 data))).. (sqli
6600: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
6610: 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 ).. (set! *dids
6620: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 omething* #t))))
6630: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
6640: 61 72 67 20 22 2d 73 68 6f 77 6b 65 79 73 22 29 arg "-showkeys")
6650: 0a 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 23 . (let ((db #
6660: 66 29 0a 09 20 20 28 6b 65 79 73 20 23 66 29 29 f).. (keys #f))
6670: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
6680: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
6690: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
66a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
66b0: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
66c0: 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 exiting")..
66d0: 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 (exit 1))).
66e0: 20 28 73 65 74 21 20 64 62 20 28 6f 70 65 6e 2d (set! db (open-
66f0: 64 62 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 db)). (set!
6700: 20 6b 65 79 73 20 28 64 62 2d 67 65 74 2d 6b 65 keys (db-get-ke
6710: 79 73 20 64 62 29 29 0a 20 20 20 20 20 20 28 64 ys db)). (d
6720: 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 4b 65 ebug:print 1 "Ke
6730: 79 73 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e ys: " (string-in
6740: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 6b tersperse (map k
6750: 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 ey:get-fieldname
6760: 20 6b 65 79 73 29 20 22 2c 20 22 29 29 0a 20 20 keys) ", ")).
6770: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e (sqlite3:fin
6780: 61 6c 69 7a 65 21 20 64 62 29 0a 20 20 20 20 20 alize! db).
6790: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
67a0: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 hing* #t)))..(if
67b0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
67c0: 2d 67 75 69 22 29 0a 20 20 20 20 28 62 65 67 69 -gui"). (begi
67d0: 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 n. (debug:p
67e0: 72 69 6e 74 20 30 20 22 4c 6f 6f 6b 20 61 74 20 rint 0 "Look at
67f0: 74 68 65 20 64 61 73 68 62 6f 61 72 64 20 66 6f the dashboard fo
6800: 72 20 6e 6f 77 22 29 0a 20 20 20 20 20 20 3b 3b r now"). ;;
6810: 20 28 6d 65 67 61 74 65 73 74 2d 67 75 69 29 0a (megatest-gui).
6820: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
6830: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
6840: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
6850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 ==========.;; Up
6890: 64 61 74 65 20 74 68 65 20 64 61 74 61 62 61 73 date the databas
68a0: 65 20 73 63 68 65 6d 61 20 6f 6e 20 72 65 71 75 e schema on requ
68b0: 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d est.;;==========
68c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
68d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
68e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
68f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
6900: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
6910: 22 2d 72 65 62 75 69 6c 64 2d 64 62 22 29 0a 20 "-rebuild-db").
6920: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
6930: 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d (if (not (setup-
6940: 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 62 65 for-run)).. (be
6950: 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a gin.. (debug:
6960: 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 print 0 "Failed
6970: 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
6980: 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 g") .. (exit
6990: 31 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6e 6f 1))). ;; no
69a0: 77 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 64 w can find our d
69b0: 62 0a 20 20 20 20 20 20 28 73 65 74 21 20 64 62 b. (set! db
69c0: 20 28 6f 70 65 6e 2d 64 62 29 29 0a 20 20 20 20 (open-db)).
69d0: 20 20 28 70 61 74 63 68 2d 64 62 20 64 62 29 0a (patch-db db).
69e0: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 (sqlite3:f
69f0: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 20 20 20 inalize! db).
6a00: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
6a10: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b ething* #t)))..;
6a20: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
6a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a60: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 =======.;; Updat
6a70: 65 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 61 e the tests meta
6a80: 20 64 61 74 61 20 66 72 6f 6d 20 74 68 65 20 74 data from the t
6a90: 65 73 74 63 6f 6e 66 69 67 20 66 69 6c 65 73 0a estconfig files.
6aa0: 3b 3b 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ;;..(if (args:ge
6ab0: 74 2d 61 72 67 20 22 2d 75 70 64 61 74 65 2d 6d t-arg "-update-m
6ac0: 65 74 61 22 29 0a 20 20 20 20 28 62 65 67 69 6e eta"). (begin
6ad0: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
6ae0: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
6af0: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
6b00: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
6b10: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
6b20: 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 exiting") ..
6b30: 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 (exit 1))).
6b40: 20 20 3b 3b 20 6e 6f 77 20 63 61 6e 20 66 69 6e ;; now can fin
6b50: 64 20 6f 75 72 20 64 62 0a 20 20 20 20 20 20 28 d our db. (
6b60: 73 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 set! db (open-db
6b70: 29 29 0a 20 20 20 20 20 20 28 72 75 6e 73 3a 75 )). (runs:u
6b80: 70 64 61 74 65 2d 61 6c 6c 2d 74 65 73 74 5f 6d pdate-all-test_m
6b90: 65 74 61 20 64 62 29 0a 20 20 20 20 20 20 28 73 eta db). (s
6ba0: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
6bb0: 20 64 62 29 0a 20 20 20 20 20 20 28 73 65 74 21 db). (set!
6bc0: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
6bd0: 23 74 29 29 29 0a 0a 28 69 66 20 28 6e 6f 74 20 #t)))..(if (not
6be0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 29 0a *didsomething*).
6bf0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6c00: 20 30 20 68 65 6c 70 29 29 0a 0a 28 69 66 20 28 0 help))..(if (
6c10: 6e 6f 74 20 28 65 71 3f 20 2a 67 6c 6f 62 61 6c not (eq? *global
6c20: 65 78 69 74 73 74 61 74 75 73 2a 20 30 29 29 0a exitstatus* 0)).
6c30: 20 20 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 (if (or (arg
6c40: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 s:get-arg "-runt
6c50: 65 73 74 73 22 29 28 61 72 67 73 3a 67 65 74 2d ests")(args:get-
6c60: 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 29 0a arg "-runall")).
6c70: 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 (begin.
6c80: 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
6c90: 3a 70 72 69 6e 74 20 30 20 22 4e 4f 54 45 3a 20 :print 0 "NOTE:
6ca0: 53 75 62 70 72 6f 63 65 73 73 65 73 20 77 69 74 Subprocesses wit
6cb0: 68 20 6e 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 20 h non-zero exit
6cc0: 63 6f 64 65 20 64 65 74 65 63 74 65 64 3a 20 22 code detected: "
6cd0: 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 *globalexitstat
6ce0: 75 73 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 us*).
6cf0: 28 65 78 69 74 20 30 29 29 0a 20 20 20 20 20 20 (exit 0)).
6d00: 20 20 28 63 61 73 65 20 2a 67 6c 6f 62 61 6c 65 (case *globale
6d10: 78 69 74 73 74 61 74 75 73 2a 0a 20 20 20 20 20 xitstatus*.
6d20: 20 20 20 20 28 28 30 29 28 65 78 69 74 20 30 29 ((0)(exit 0)
6d30: 29 0a 20 20 20 20 20 20 20 20 20 28 28 31 29 28 ). ((1)(
6d40: 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 20 20 exit 1)).
6d50: 20 20 28 28 32 29 28 65 78 69 74 20 32 29 29 0a ((2)(exit 2)).
6d60: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 (else (
6d70: 65 78 69 74 20 33 29 29 29 29 29 0a exit 3))))).