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 63 61 74 atest db . :cat
0720: 65 67 6f 72 79 20 20 20 20 20 20 20 20 20 20 20 egory
0730: 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 63 61 : set the ca
0740: 74 65 67 6f 72 79 20 66 69 65 6c 64 20 28 6f 70 tegory field (op
0750: 74 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 72 69 61 tional). :varia
0760: 62 6c 65 20 20 20 20 20 20 20 20 20 20 20 20 20 ble
0770: 20 20 3a 20 73 65 74 20 74 68 65 20 76 61 72 69 : set the vari
0780: 61 62 6c 65 20 6e 61 6d 65 20 28 6f 70 74 69 6f able name (optio
0790: 6e 61 6c 29 0a 20 20 3a 76 61 6c 75 65 20 20 20 nal). :value
07a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
07b0: 20 76 61 6c 75 65 20 6d 65 61 73 75 72 65 64 20 value measured
07c0: 28 72 65 71 75 69 72 65 64 29 0a 20 20 3a 65 78 (required). :ex
07d0: 70 65 63 74 65 64 20 20 20 20 20 20 20 20 20 20 pected
07e0: 20 20 20 20 20 3a 20 76 61 6c 75 65 20 65 78 70 : value exp
07f0: 65 63 74 65 64 20 28 72 65 71 75 69 72 65 64 29 ected (required)
0800: 0a 20 20 3a 74 6f 6c 20 20 20 20 20 20 20 20 20 . :tol
0810: 20 20 20 20 20 20 20 20 20 20 20 3a 20 7c 76 61 : |va
0820: 6c 75 65 2d 65 78 70 65 63 74 7c 20 3c 3d 20 74 lue-expect| <= t
0830: 6f 6c 20 28 72 65 71 75 69 72 65 64 2c 20 63 61 ol (required, ca
0840: 6e 20 62 65 20 3c 2c 20 3e 2c 20 3e 3d 2c 20 3c n be <, >, >=, <
0850: 3d 20 6f 72 20 6e 75 6d 62 65 72 29 0a 20 20 3a = or number). :
0860: 75 6e 69 74 73 20 20 20 20 20 20 20 20 20 20 20 units
0870: 20 20 20 20 20 20 20 3a 20 6e 61 6d 65 20 6f 66 : name of
0880: 20 74 68 65 20 75 6e 69 74 73 20 66 6f 72 20 76 the units for v
0890: 61 6c 75 65 2c 20 65 78 70 65 63 74 65 64 5f 76 alue, expected_v
08a0: 61 6c 75 65 20 65 74 63 2e 20 28 6f 70 74 69 6f alue etc. (optio
08b0: 6e 61 6c 29 0a 20 20 3a 66 69 72 73 74 5f 65 72 nal). :first_er
08c0: 72 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a r :
08d0: 20 72 65 63 6f 72 64 20 61 6e 20 65 72 72 6f 72 record an error
08e0: 20 6d 65 73 73 61 67 65 0a 20 20 3a 66 69 72 73 message. :firs
08f0: 74 5f 77 61 72 6e 20 20 20 20 20 20 20 20 20 20 t_warn
0900: 20 20 20 3a 20 72 65 63 6f 72 64 20 61 20 77 61 : record a wa
0910: 72 6e 69 6e 67 20 6d 65 73 73 61 67 65 0a 0a 41 rning message..A
0920: 72 62 69 74 72 61 72 79 20 74 65 73 74 20 64 61 rbitrary test da
0930: 74 61 20 6c 6f 61 64 69 6e 67 0a 20 20 2d 6c 6f ta loading. -lo
0940: 61 64 2d 74 65 73 74 2d 64 61 74 61 20 20 20 20 ad-test-data
0950: 20 20 20 20 20 3a 20 72 65 61 64 20 74 65 73 74 : read test
0960: 20 73 70 65 63 69 66 69 63 20 64 61 74 61 20 66 specific data f
0970: 6f 72 20 73 74 6f 72 61 67 65 20 69 6e 20 74 68 or storage in th
0980: 65 20 74 65 73 74 5f 64 61 74 61 20 74 61 62 6c e test_data tabl
0990: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
09a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 72 fr
09b0: 6f 6d 20 73 74 61 6e 64 61 72 64 20 69 6e 2e 20 om standard in.
09c0: 45 61 63 68 20 6c 69 6e 65 20 69 73 20 63 6f 6d Each line is com
09d0: 6d 61 20 64 65 6c 69 6d 69 74 65 64 20 77 69 74 ma delimited wit
09e0: 68 20 66 6f 75 72 0a 20 20 20 20 20 20 20 20 20 h four.
09f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a00: 20 20 20 66 69 65 6c 64 73 20 63 61 74 65 67 6f fields catego
0a10: 72 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 6c 75 ry,variable,valu
0a20: 65 2c 63 6f 6d 6d 65 6e 74 0a 0a 51 75 65 72 69 e,comment..Queri
0a30: 65 73 0a 20 20 2d 6c 69 73 74 2d 72 75 6e 73 20 es. -list-runs
0a40: 70 61 74 74 20 20 20 20 20 20 20 20 20 3a 20 6c patt : l
0a50: 69 73 74 20 72 75 6e 73 20 6d 61 74 63 68 69 6e ist runs matchin
0a60: 67 20 70 61 74 74 65 72 6e 20 5c 22 70 61 74 74 g pattern \"patt
0a70: 5c 22 2c 20 25 20 69 73 20 74 68 65 20 77 69 6c \", % is the wil
0a80: 64 63 61 72 64 0a 20 20 2d 74 65 73 74 70 61 74 dcard. -testpat
0a90: 74 20 70 61 74 74 20 20 20 20 20 20 20 20 20 20 t patt
0aa0: 3a 20 69 6e 20 6c 69 73 74 2d 72 75 6e 73 20 73 : in list-runs s
0ab0: 68 6f 77 20 6f 6e 6c 79 20 74 68 65 73 65 20 74 how only these t
0ac0: 65 73 74 73 2c 20 25 20 69 73 20 74 68 65 20 77 ests, % is the w
0ad0: 69 6c 64 63 61 72 64 0a 20 20 2d 69 74 65 6d 70 ildcard. -itemp
0ae0: 61 74 74 20 70 61 74 74 20 20 20 20 20 20 20 20 att patt
0af0: 20 20 3a 20 69 6e 20 6c 69 73 74 2d 72 75 6e 73 : in list-runs
0b00: 20 73 68 6f 77 20 6f 6e 6c 79 20 74 65 73 74 73 show only tests
0b10: 20 77 69 74 68 20 69 74 65 6d 73 20 74 68 61 74 with items that
0b20: 20 6d 61 74 63 68 20 70 61 74 74 0a 20 20 2d 73 match patt. -s
0b30: 68 6f 77 6b 65 79 73 20 20 20 20 20 20 20 20 20 howkeys
0b40: 20 20 20 20 20 20 3a 20 73 68 6f 77 20 74 68 65 : show the
0b50: 20 6b 65 79 73 20 75 73 65 64 20 69 6e 20 74 68 keys used in th
0b60: 69 73 20 6d 65 67 61 74 65 73 74 20 73 65 74 75 is megatest setu
0b70: 70 0a 0a 4d 69 73 63 20 0a 20 20 2d 66 6f 72 63 p..Misc . -forc
0b80: 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e
0b90: 20 20 20 3a 20 6f 76 65 72 72 69 64 65 20 73 6f : override so
0ba0: 6d 65 20 63 68 65 63 6b 73 0a 20 20 2d 78 74 65 me checks. -xte
0bb0: 72 6d 20 20 20 20 20 20 20 20 20 20 20 20 20 20 rm
0bc0: 20 20 20 20 3a 20 73 74 61 72 74 20 61 6e 20 78 : start an x
0bd0: 74 65 72 6d 20 69 6e 73 74 65 61 64 20 6f 66 20 term instead of
0be0: 6c 61 75 6e 63 68 69 6e 67 20 74 68 65 20 74 65 launching the te
0bf0: 73 74 0a 20 20 2d 72 65 6d 6f 76 65 2d 72 75 6e st. -remove-run
0c00: 73 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 s : r
0c10: 65 6d 6f 76 65 20 74 68 65 20 64 61 74 61 20 66 emove the data f
0c20: 6f 72 20 61 20 72 75 6e 2c 20 72 65 71 75 69 72 or a run, requir
0c30: 65 73 20 61 6c 6c 20 66 69 65 6c 64 73 20 62 65 es all fields be
0c40: 20 73 70 65 63 69 66 69 65 64 0a 20 20 20 20 20 specified.
0c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c60: 20 20 20 20 20 20 20 61 6e 64 20 3a 72 75 6e 6e and :runn
0c70: 61 6d 65 20 2c 2d 74 65 73 74 70 61 74 74 20 61 ame ,-testpatt a
0c80: 6e 64 20 2d 69 74 65 6d 70 61 74 74 0a 20 20 20 nd -itempatt.
0c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ca0: 20 20 20 20 20 20 20 20 20 61 6e 64 20 2d 74 65 and -te
0cb0: 73 74 70 61 74 74 0a 20 20 2d 6b 65 65 70 67 6f stpatt. -keepgo
0cc0: 69 6e 67 20 20 20 20 20 20 20 20 20 20 20 20 20 ing
0cd0: 20 3a 20 63 6f 6e 74 69 6e 75 65 20 72 75 6e 6e : continue runn
0ce0: 69 6e 67 20 75 6e 74 69 6c 20 6e 6f 20 6a 6f 62 ing until no job
0cf0: 73 20 61 72 65 20 5c 22 4c 41 55 4e 43 48 45 44 s are \"LAUNCHED
0d00: 5c 22 20 6f 72 0a 20 20 20 20 20 20 20 20 20 20 \" or.
0d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d20: 20 20 5c 22 4e 4f 54 5f 53 54 41 52 54 45 44 5c \"NOT_STARTED\
0d30: 22 0a 20 20 2d 72 65 72 75 6e 20 46 41 49 4c 2c ". -rerun FAIL,
0d40: 57 41 52 4e 2e 2e 2e 20 20 20 20 20 3a 20 72 65 WARN... : re
0d50: 2d 72 75 6e 20 69 66 20 63 61 6c 6c 65 64 20 6f -run if called o
0d60: 6e 20 61 20 74 65 73 74 20 74 68 61 74 20 70 72 n a test that pr
0d70: 65 76 69 6f 75 73 6c 79 20 72 61 6e 20 28 6e 75 eviously ran (nu
0d80: 6c 6c 69 66 69 65 64 0a 20 20 20 20 20 20 20 20 llified.
0d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0da0: 20 20 20 20 69 66 20 2d 6b 65 65 70 67 6f 69 6e if -keepgoin
0db0: 67 20 69 73 20 61 6c 73 6f 20 73 70 65 63 69 66 g is also specif
0dc0: 69 65 64 29 0a 20 20 2d 72 65 62 75 69 6c 64 2d ied). -rebuild-
0dd0: 64 62 20 20 20 20 20 20 20 20 20 20 20 20 20 3a db :
0de0: 20 62 72 69 6e 67 20 74 68 65 20 64 61 74 61 62 bring the datab
0df0: 61 73 65 20 73 63 68 65 6d 61 20 75 70 20 74 6f ase schema up to
0e00: 20 64 61 74 65 0a 20 20 2d 72 6f 6c 6c 75 70 20 date. -rollup
0e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e20: 3a 20 66 69 6c 6c 20 72 75 6e 20 28 73 65 74 20 : fill run (set
0e30: 62 79 20 3a 72 75 6e 6e 61 6d 65 29 20 20 77 69 by :runname) wi
0e40: 74 68 20 6c 61 74 65 73 74 20 74 65 73 74 28 73 th latest test(s
0e50: 29 20 66 72 6f 6d 0a 20 20 20 20 20 20 20 20 20 ) from.
0e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e70: 20 20 20 70 72 69 6f 72 20 72 75 6e 73 20 77 69 prior runs wi
0e80: 74 68 20 73 61 6d 65 20 6b 65 79 73 0a 20 20 2d th same keys. -
0e90: 72 65 6e 61 6d 65 2d 72 75 6e 20 3c 72 75 6e 62 rename-run <runb
0ea0: 3e 20 20 20 20 20 20 3a 20 72 65 6e 61 6d 65 20 > : rename
0eb0: 72 75 6e 20 28 73 65 74 20 62 79 20 3a 72 75 6e run (set by :run
0ec0: 6e 61 6d 65 29 20 74 6f 20 3c 72 75 6e 62 3e 2c name) to <runb>,
0ed0: 20 72 65 71 75 69 72 65 73 20 6b 65 79 73 0a 20 requires keys.
0ee0: 20 2d 75 70 64 61 74 65 2d 6d 65 74 61 20 20 20 -update-meta
0ef0: 20 20 20 20 20 20 20 20 20 3a 20 75 70 64 61 74 : updat
0f00: 65 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 61 e the tests meta
0f10: 64 61 74 61 20 66 6f 72 20 61 6c 6c 20 74 65 73 data for all tes
0f20: 74 73 0a 20 20 2d 65 78 74 72 61 63 74 2d 6f 64 ts. -extract-od
0f30: 73 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 65 s : e
0f40: 78 74 72 61 63 74 20 61 6e 20 6f 70 65 6e 20 64 xtract an open d
0f50: 6f 63 75 6d 65 6e 74 20 73 70 72 65 61 64 73 68 ocument spreadsh
0f60: 65 65 74 20 66 72 6f 6d 20 74 68 65 20 64 61 74 eet from the dat
0f70: 61 62 61 73 65 0a 0a 48 65 6c 70 65 72 73 0a 20 abase..Helpers.
0f80: 20 2d 72 75 6e 73 74 65 70 20 73 74 65 70 6e 61 -runstep stepna
0f90: 6d 65 20 20 2e 2e 2e 20 20 3a 20 74 61 6b 65 20 me ... : take
0fa0: 72 65 6d 61 69 6e 69 6e 67 20 70 61 72 61 6d 73 remaining params
0fb0: 20 61 73 20 63 6f 6d 61 6e 64 20 61 6e 64 20 65 as comand and e
0fc0: 78 65 63 75 74 65 20 61 73 20 73 74 65 70 6e 61 xecute as stepna
0fd0: 6d 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 me.
0fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c l
0ff0: 6f 67 20 77 69 6c 6c 20 62 65 20 69 6e 20 73 74 og will be in st
1000: 65 70 6e 61 6d 65 2e 6c 6f 67 2e 20 42 65 73 74 epname.log. Best
1010: 20 74 6f 20 70 75 74 20 63 6f 6d 6d 61 6e 64 20 to put command
1020: 69 6e 20 71 75 6f 74 65 73 0a 20 20 2d 6c 6f 67 in quotes. -log
1030: 70 72 6f 20 66 69 6c 65 20 20 20 20 20 20 20 20 pro file
1040: 20 20 20 20 3a 20 77 69 74 68 20 2d 65 78 65 63 : with -exec
1050: 20 61 70 70 6c 79 20 6c 6f 67 70 72 6f 20 66 69 apply logpro fi
1060: 6c 65 20 74 6f 20 73 74 65 70 6e 61 6d 65 2e 6c le to stepname.l
1070: 6f 67 2c 20 63 72 65 61 74 65 73 0a 20 20 20 20 og, creates.
1080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1090: 20 20 20 20 20 20 20 20 73 74 65 70 6e 61 6d 65 stepname
10a0: 2e 68 74 6d 6c 20 61 6e 64 20 73 65 74 73 20 6c .html and sets l
10b0: 6f 67 20 74 6f 20 73 61 6d 65 0a 20 20 20 20 20 og to same.
10c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10d0: 20 20 20 20 20 20 20 49 66 20 75 73 69 6e 67 20 If using
10e0: 6d 61 6b 65 20 75 73 65 20 73 74 65 70 6e 61 6d make use stepnam
10f0: 65 5f 6c 6f 67 70 72 6f 2e 6c 6f 67 20 61 73 20 e_logpro.log as
1100: 79 6f 75 72 20 74 61 72 67 65 74 0a 0a 43 61 6c your target..Cal
1110: 6c 65 64 20 61 73 20 22 20 28 73 74 72 69 6e 67 led as " (string
1120: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 61 72 -intersperse (ar
1130: 67 76 29 20 22 20 22 29 29 29 0a 0a 3b 3b 20 20 gv) " ")))..;;
1140: 2d 67 75 69 20 20 20 20 20 20 20 20 20 20 20 20 -gui
1150: 20 20 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 : start
1160: 61 20 67 75 69 20 69 6e 74 65 72 66 61 63 65 0a a gui interface.
1170: 3b 3b 20 20 2d 63 6f 6e 66 69 67 20 66 6e 61 6d ;; -config fnam
1180: 65 20 20 20 20 20 20 20 20 20 20 20 3a 20 6f 76 e : ov
1190: 65 72 72 69 64 65 20 74 68 65 20 72 75 6e 63 6f erride the runco
11a0: 6e 66 69 67 20 66 69 6c 65 20 77 69 74 68 20 66 nfig file with f
11b0: 6e 61 6d 65 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 name..;; process
11c0: 20 61 72 67 73 0a 28 64 65 66 69 6e 65 20 72 65 args.(define re
11d0: 6d 61 72 67 73 20 28 61 72 67 73 3a 67 65 74 2d margs (args:get-
11e0: 61 72 67 73 20 0a 09 09 20 28 61 72 67 76 29 0a args ... (argv).
11f0: 09 09 20 28 6c 69 73 74 20 20 22 2d 72 75 6e 74 .. (list "-runt
1200: 65 73 74 73 22 20 20 3b 3b 20 72 75 6e 20 61 20 ests" ;; run a
1210: 73 70 65 63 69 66 69 63 20 74 65 73 74 0a 09 09 specific test...
1220: 09 22 2d 63 6f 6e 66 69 67 22 20 20 20 20 3b 3b ."-config" ;;
1230: 20 6f 76 65 72 72 69 64 65 20 74 68 65 20 63 6f override the co
1240: 6e 66 69 67 20 66 69 6c 65 20 6e 61 6d 65 0a 09 nfig file name..
1250: 09 09 22 2d 65 78 65 63 75 74 65 22 20 20 20 3b .."-execute" ;
1260: 3b 20 72 75 6e 20 74 68 65 20 63 6f 6d 6d 61 6e ; run the comman
1270: 64 20 65 6e 63 6f 64 65 64 20 69 6e 20 74 68 65 d encoded in the
1280: 20 62 61 73 65 36 34 20 70 61 72 61 6d 65 74 65 base64 paramete
1290: 72 0a 09 09 09 22 2d 73 74 65 70 22 0a 09 09 09 r...."-step"....
12a0: 22 3a 72 75 6e 6e 61 6d 65 22 20 20 20 0a 09 09 ":runname" ...
12b0: 09 22 3a 69 74 65 6d 22 0a 09 09 09 22 3a 72 75 .":item"....":ru
12c0: 6e 6e 61 6d 65 22 20 20 20 0a 09 09 09 22 3a 73 nname" ....":s
12d0: 74 61 74 65 22 20 20 0a 09 09 09 22 3a 73 74 61 tate" ....":sta
12e0: 74 75 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d 72 tus"...."-list-r
12f0: 75 6e 73 22 0a 09 09 09 22 2d 74 65 73 74 70 61 uns"...."-testpa
1300: 74 74 22 20 0a 09 09 09 22 2d 69 74 65 6d 70 61 tt" ...."-itempa
1310: 74 74 22 0a 09 09 09 22 2d 73 65 74 6c 6f 67 22 tt"...."-setlog"
1320: 0a 09 09 09 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 ...."-set-toplog
1330: 22 0a 09 09 09 22 2d 72 75 6e 73 74 65 70 22 0a "...."-runstep".
1340: 09 09 09 22 2d 6c 6f 67 70 72 6f 22 0a 09 09 09 ..."-logpro"....
1350: 22 2d 6d 22 0a 09 09 09 22 2d 72 65 72 75 6e 22 "-m"...."-rerun"
1360: 0a 09 09 09 22 2d 64 61 79 73 22 0a 09 09 09 22 ...."-days"...."
1370: 2d 72 65 6e 61 6d 65 2d 72 75 6e 22 0a 09 09 09 -rename-run"....
1380: 22 2d 74 6f 22 0a 09 09 09 3b 3b 20 76 61 6c 75 "-to"....;; valu
1390: 65 73 20 61 6e 64 20 6d 65 73 73 61 67 65 73 0a es and messages.
13a0: 09 09 09 22 3a 63 61 74 65 67 6f 72 79 22 0a 09 ...":category"..
13b0: 09 09 22 3a 76 61 72 69 61 62 6c 65 22 0a 09 09 ..":variable"...
13c0: 09 22 3a 66 69 72 73 74 5f 65 72 72 22 0a 09 09 .":first_err"...
13d0: 09 22 3a 66 69 72 73 74 5f 77 61 72 6e 22 0a 09 .":first_warn"..
13e0: 09 09 22 3a 76 61 6c 75 65 22 0a 09 09 09 22 3a ..":value"....":
13f0: 65 78 70 65 63 74 65 64 22 0a 09 09 09 22 3a 74 expected"....":t
1400: 6f 6c 22 0a 09 09 09 22 3a 75 6e 69 74 73 22 0a ol"....":units".
1410: 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 09 22 2d ...;; misc...."-
1420: 65 78 74 72 61 63 74 2d 6f 64 73 22 0a 09 09 09 extract-ods"....
1430: 22 2d 64 65 62 75 67 22 20 3b 3b 20 66 6f 72 20 "-debug" ;; for
1440: 2a 76 65 72 62 6f 73 69 74 79 2a 20 3e 20 32 0a *verbosity* > 2.
1450: 09 09 09 29 20 0a 09 09 20 28 6c 69 73 74 20 20 ...) ... (list
1460: 22 2d 68 22 0a 09 09 20 20 20 20 20 20 20 20 22 "-h"... "
1470: 2d 66 6f 72 63 65 22 0a 09 09 20 20 20 20 20 20 -force"...
1480: 20 20 22 2d 78 74 65 72 6d 22 0a 09 09 20 20 20 "-xterm"...
1490: 20 20 20 20 20 22 2d 73 68 6f 77 6b 65 79 73 22 "-showkeys"
14a0: 0a 09 09 20 20 20 20 20 20 20 20 22 2d 74 65 73 ... "-tes
14b0: 74 2d 73 74 61 74 75 73 22 0a 09 09 09 22 2d 73 t-status"...."-s
14c0: 65 74 2d 76 61 6c 75 65 73 22 0a 09 09 09 22 2d et-values"...."-
14d0: 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 0a load-test-data".
14e0: 09 09 09 22 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 ..."-summarize-i
14f0: 74 65 6d 73 22 0a 09 09 20 20 20 20 20 20 20 20 tems"...
1500: 22 2d 67 75 69 22 0a 09 09 09 22 2d 72 75 6e 61 "-gui"...."-runa
1510: 6c 6c 22 20 20 20 20 3b 3b 20 72 75 6e 20 61 6c ll" ;; run al
1520: 6c 20 74 65 73 74 73 0a 09 09 09 22 2d 72 65 6d l tests...."-rem
1530: 6f 76 65 2d 72 75 6e 73 22 0a 09 09 09 22 2d 6b ove-runs"...."-k
1540: 65 65 70 67 6f 69 6e 67 22 0a 09 09 09 22 2d 75 eepgoing"...."-u
1550: 73 65 71 75 65 75 65 22 0a 09 09 09 22 2d 72 65 sequeue"...."-re
1560: 62 75 69 6c 64 2d 64 62 22 0a 09 09 09 22 2d 72 build-db"...."-r
1570: 6f 6c 6c 75 70 22 0a 09 09 09 22 2d 75 70 64 61 ollup"...."-upda
1580: 74 65 2d 6d 65 74 61 22 0a 09 09 09 22 2d 76 22 te-meta"...."-v"
1590: 20 3b 3b 20 76 65 72 62 6f 73 65 20 32 2c 20 6d ;; verbose 2, m
15a0: 6f 72 65 20 74 68 61 6e 20 6e 6f 72 6d 61 6c 20 ore than normal
15b0: 28 6e 6f 72 6d 61 6c 20 69 73 20 31 29 0a 09 09 (normal is 1)...
15c0: 09 22 2d 71 22 20 3b 3b 20 71 75 69 65 74 20 30 ."-q" ;; quiet 0
15d0: 2c 20 65 72 72 6f 72 73 2f 77 61 72 6e 69 6e 67 , errors/warning
15e0: 73 20 6f 6e 6c 79 0a 09 09 20 20 20 20 20 20 20 s only...
15f0: 29 0a 09 09 20 61 72 67 73 3a 61 72 67 2d 68 61 )... args:arg-ha
1600: 73 68 0a 09 09 20 30 29 29 0a 0a 28 69 66 20 28 sh... 0))..(if (
1610: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 args:get-arg "-h
1620: 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
1630: 20 20 20 20 28 70 72 69 6e 74 20 68 65 6c 70 29 (print help)
1640: 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a . (exit))).
1650: 0a 28 69 6e 63 6c 75 64 65 20 22 6b 65 79 73 2e .(include "keys.
1660: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
1670: 69 74 65 6d 73 2e 73 63 6d 22 29 0a 28 69 6e 63 items.scm").(inc
1680: 6c 75 64 65 20 22 64 62 2e 73 63 6d 22 29 0a 28 lude "db.scm").(
1690: 69 6e 63 6c 75 64 65 20 22 63 6f 6e 66 69 67 66 include "configf
16a0: 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 .scm").(include
16b0: 22 70 72 6f 63 65 73 73 2e 73 63 6d 22 29 0a 28 "process.scm").(
16c0: 69 6e 63 6c 75 64 65 20 22 6c 61 75 6e 63 68 2e include "launch.
16d0: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
16e0: 72 75 6e 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c runs.scm").(incl
16f0: 75 64 65 20 22 72 75 6e 63 6f 6e 66 69 67 2e 73 ude "runconfig.s
1700: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 6f cm").(include "o
1710: 64 73 2e 73 63 6d 22 29 0a 0a 28 64 65 66 69 6e ds.scm")..(defin
1720: 65 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a e *didsomething*
1730: 20 23 66 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d #f)..;;========
1740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
1780: 3b 20 4d 69 73 63 20 73 65 74 75 70 20 73 74 75 ; Misc setup stu
1790: 66 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ff.;;===========
17a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
17b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
17c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
17d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 73 65 ===========..(se
17e0: 74 21 20 2a 76 65 72 62 6f 73 69 74 79 2a 20 28 t! *verbosity* (
17f0: 63 6f 6e 64 0a 09 09 20 20 20 28 28 61 72 67 73 cond... ((args
1800: 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 :get-arg "-debug
1810: 22 29 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 ")(string->numbe
1820: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
1830: 22 2d 64 65 62 75 67 22 29 29 29 0a 09 09 20 20 "-debug")))...
1840: 20 28 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ((args:get-arg
1850: 22 2d 76 22 29 20 20 20 20 32 29 0a 09 09 20 20 "-v") 2)...
1860: 20 28 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ((args:get-arg
1870: 22 2d 71 22 29 20 20 20 20 30 29 0a 09 09 20 20 "-q") 0)...
1880: 20 28 65 6c 73 65 20 20 20 20 20 20 20 20 20 20 (else
1890: 20 20 20 20 20 20 20 20 20 31 29 29 29 0a 0a 3b 1)))..;
18a0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
18b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
18c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
18d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
18e0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 65 6d 6f 76 =======.;; Remov
18f0: 65 20 6f 6c 64 20 72 75 6e 28 73 29 0a 3b 3b 3d e old run(s).;;=
1900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1940: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 69 6e 63 65 20 =====..;; since
1950: 73 65 76 65 72 61 6c 20 61 63 74 69 6f 6e 73 20 several actions
1960: 63 61 6e 20 62 65 20 73 70 65 63 69 66 69 65 64 can be specified
1970: 20 6f 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 on the command
1980: 6c 69 6e 65 20 74 68 65 20 72 65 6d 6f 76 61 6c line the removal
1990: 0a 3b 3b 20 69 73 20 64 6f 6e 65 20 66 69 72 73 .;; is done firs
19a0: 74 0a 28 64 65 66 69 6e 65 20 28 72 65 6d 6f 76 t.(define (remov
19b0: 65 2d 72 75 6e 73 29 0a 20 20 28 63 6f 6e 64 0a e-runs). (cond.
19c0: 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 ((not (args:g
19d0: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
19e0: 22 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ")). (debug:p
19f0: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4d rint 0 "ERROR: M
1a00: 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 issing required
1a10: 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 2d 72 parameter for -r
1a20: 65 6d 6f 76 65 2d 72 75 6e 73 2c 20 79 6f 75 20 emove-runs, you
1a30: 6d 75 73 74 20 73 70 65 63 69 66 79 20 74 68 65 must specify the
1a40: 20 72 75 6e 20 6e 61 6d 65 20 70 61 74 74 65 72 run name patter
1a50: 6e 20 77 69 74 68 20 3a 72 75 6e 6e 61 6d 65 20 n with :runname
1a60: 70 61 74 74 22 29 0a 20 20 20 20 28 65 78 69 74 patt"). (exit
1a70: 20 32 29 29 0a 20 20 20 28 28 6e 6f 74 20 28 61 2)). ((not (a
1a80: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
1a90: 73 74 70 61 74 74 22 29 29 0a 20 20 20 20 28 64 stpatt")). (d
1aa0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
1ab0: 52 4f 52 3a 20 4d 69 73 73 69 6e 67 20 72 65 71 ROR: Missing req
1ac0: 75 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 uired parameter
1ad0: 66 6f 72 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 for -remove-runs
1ae0: 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 69 , you must speci
1af0: 66 79 20 74 68 65 20 74 65 73 74 20 70 61 74 74 fy the test patt
1b00: 65 72 6e 20 77 69 74 68 20 2d 74 65 73 74 70 61 ern with -testpa
1b10: 74 74 22 29 0a 20 20 20 20 28 65 78 69 74 20 33 tt"). (exit 3
1b20: 29 29 0a 20 20 20 28 28 6e 6f 74 20 28 61 72 67 )). ((not (arg
1b30: 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d s:get-arg "-item
1b40: 70 61 74 74 22 29 29 0a 20 20 20 20 28 70 72 69 patt")). (pri
1b50: 6e 74 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 nt "ERROR: Missi
1b60: 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 ng required para
1b70: 6d 65 74 65 72 20 66 6f 72 20 2d 72 65 6d 6f 76 meter for -remov
1b80: 65 2d 72 75 6e 73 2c 20 79 6f 75 20 6d 75 73 74 e-runs, you must
1b90: 20 73 70 65 63 69 66 79 20 74 68 65 20 69 74 65 specify the ite
1ba0: 6d 73 20 77 69 74 68 20 2d 69 74 65 6d 70 61 74 ms with -itempat
1bb0: 74 22 29 0a 20 20 20 20 28 65 78 69 74 20 34 29 t"). (exit 4)
1bc0: 29 0a 20 20 20 28 28 6c 65 74 20 28 28 64 62 20 ). ((let ((db
1bd0: 23 66 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 #f)). (if (
1be0: 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 not (setup-for-r
1bf0: 75 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 20 0a un)).. (begin .
1c00: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
1c10: 74 20 30 20 70 72 69 6e 74 20 22 46 61 69 6c 65 t 0 print "Faile
1c20: 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit
1c30: 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 69 74 ing").. (exit
1c40: 20 31 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 1))). (set
1c50: 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a ! db (open-db)).
1c60: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
1c70: 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a car *configinfo*
1c80: 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 )).. (begin..
1c90: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
1ca0: 20 22 45 52 52 4f 52 3a 20 41 74 74 65 6d 70 74 "ERROR: Attempt
1cb0: 65 64 20 74 6f 20 72 65 6d 6f 76 65 20 74 65 73 ed to remove tes
1cc0: 74 28 73 29 20 62 75 74 20 72 75 6e 20 61 72 65 t(s) but run are
1cd0: 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e 6f a config file no
1ce0: 74 20 66 6f 75 6e 64 22 29 0a 09 20 20 20 20 28 t found").. (
1cf0: 65 78 69 74 20 31 29 29 0a 09 20 20 3b 3b 20 70 exit 1)).. ;; p
1d00: 75 74 20 74 65 73 74 20 70 61 72 61 6d 65 74 65 ut test paramete
1d10: 72 73 20 69 6e 74 6f 20 63 6f 6e 76 65 6e 69 65 rs into convenie
1d20: 6e 74 20 76 61 72 69 61 62 6c 65 73 0a 09 20 20 nt variables..
1d30: 28 72 75 6e 73 3a 72 65 6d 6f 76 65 2d 72 75 6e (runs:remove-run
1d40: 73 20 64 62 0a 09 09 09 20 20 20 20 28 61 72 67 s db.... (arg
1d50: 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e s:get-arg ":runn
1d60: 61 6d 65 22 29 0a 09 09 09 20 20 20 20 28 61 72 ame").... (ar
1d70: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
1d80: 74 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 28 tpatt").... (
1d90: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 args:get-arg "-i
1da0: 74 65 6d 70 61 74 74 22 29 29 29 0a 20 20 20 20 tempatt"))).
1db0: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
1dc0: 69 7a 65 21 20 64 62 29 0a 20 20 20 20 20 20 28 ize! db). (
1dd0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
1de0: 6e 67 2a 20 23 74 29 29 29 29 29 0a 09 20 20 0a ng* #t))))).. .
1df0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
1e00: 67 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 g "-remove-runs"
1e10: 29 0a 20 20 20 20 28 72 65 6d 6f 76 65 2d 72 75 ). (remove-ru
1e20: 6e 73 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ns))..;;========
1e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
1e70: 3b 20 51 75 65 72 79 20 72 75 6e 73 0a 3b 3b 3d ; Query runs.;;=
1e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ec0: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
1ed0: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d :get-arg "-list-
1ee0: 72 75 6e 73 22 29 0a 20 20 20 20 28 6c 65 74 2a runs"). (let*
1ef0: 20 28 28 64 62 20 20 20 20 20 20 20 28 62 65 67 ((db (beg
1f00: 69 6e 0a 09 09 20 20 20 20 20 20 20 28 73 65 74 in... (set
1f10: 75 70 2d 66 6f 72 2d 72 75 6e 29 0a 09 09 20 20 up-for-run)...
1f20: 20 20 20 20 20 28 6f 70 65 6e 2d 64 62 29 29 29 (open-db)))
1f30: 0a 09 20 20 20 28 72 75 6e 70 61 74 74 20 20 28 .. (runpatt (
1f40: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
1f50: 69 73 74 2d 72 75 6e 73 22 29 29 0a 09 20 20 20 ist-runs"))..
1f60: 28 74 65 73 74 70 61 74 74 20 28 61 72 67 73 3a (testpatt (args:
1f70: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
1f80: 74 74 22 29 29 0a 09 20 20 20 28 69 74 65 6d 70 tt")).. (itemp
1f90: 61 74 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 att (args:get-ar
1fa0: 67 20 22 2d 69 74 65 6d 70 61 74 74 22 29 29 0a g "-itempatt")).
1fb0: 09 20 20 20 28 72 75 6e 73 64 61 74 20 20 28 64 . (runsdat (d
1fc0: 62 2d 67 65 74 2d 72 75 6e 73 20 64 62 20 72 75 b-get-runs db ru
1fd0: 6e 70 61 74 74 29 29 0a 09 20 20 20 28 72 75 6e npatt)).. (run
1fe0: 73 20 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f s (db:get-ro
1ff0: 77 73 20 72 75 6e 73 64 61 74 29 29 0a 09 20 20 ws runsdat))..
2000: 20 28 68 65 61 64 65 72 20 20 20 28 64 62 3a 67 (header (db:g
2010: 65 74 2d 68 65 61 64 65 72 20 72 75 6e 73 64 61 et-header runsda
2020: 74 29 29 0a 09 20 20 20 28 6b 65 79 73 20 20 20 t)).. (keys
2030: 20 20 28 64 62 2d 67 65 74 2d 6b 65 79 73 20 64 (db-get-keys d
2040: 62 29 29 0a 09 20 20 20 28 6b 65 79 6e 61 6d 65 b)).. (keyname
2050: 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 s (map key:get-f
2060: 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 29 ieldname keys)))
2070: 0a 20 20 20 20 20 20 3b 3b 20 45 61 63 68 20 72 . ;; Each r
2080: 75 6e 0a 20 20 20 20 20 20 28 66 6f 72 2d 65 61 un. (for-ea
2090: 63 68 20 0a 20 20 20 20 20 20 20 28 6c 61 6d 62 ch . (lamb
20a0: 64 61 20 28 72 75 6e 29 0a 09 20 28 64 65 62 75 da (run).. (debu
20b0: 67 3a 70 72 69 6e 74 20 32 20 22 52 75 6e 3a 20 g:print 2 "Run:
20c0: 22 0a 09 09 28 73 74 72 69 6e 67 2d 69 6e 74 65 "...(string-inte
20d0: 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 rsperse (map (la
20e0: 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 20 20 mbda (x)......
20f0: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
2100: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
2110: 64 65 72 20 78 29 29 0a 09 09 09 09 09 20 6b 65 der x))...... ke
2120: 79 6e 61 6d 65 73 29 20 22 2f 22 29 0a 09 09 22 ynames) "/")..."
2130: 2f 22 0a 09 09 28 64 62 3a 67 65 74 2d 76 61 6c /"...(db:get-val
2140: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
2150: 20 68 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 header "runname
2160: 22 29 29 0a 09 20 28 6c 65 74 20 28 28 72 75 6e ")).. (let ((run
2170: 2d 69 64 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 -id (db:get-valu
2180: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
2190: 68 65 61 64 65 72 20 22 69 64 22 29 29 29 0a 09 header "id")))..
21a0: 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 73 20 (let ((tests
21b0: 28 64 62 2d 67 65 74 2d 74 65 73 74 73 2d 66 6f (db-get-tests-fo
21c0: 72 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 20 r-run db run-id
21d0: 74 65 73 74 70 61 74 74 20 69 74 65 6d 70 61 74 testpatt itempat
21e0: 74 29 29 29 0a 09 20 20 20 20 20 3b 3b 20 45 61 t))).. ;; Ea
21f0: 63 68 20 74 65 73 74 0a 09 20 20 20 20 20 28 66 ch test.. (f
2200: 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 20 or-each ..
2210: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 (lambda (test)..
2220: 09 28 66 6f 72 6d 61 74 20 23 74 0a 09 09 09 22 .(format #t...."
2230: 20 20 54 65 73 74 3a 20 7e 32 35 61 20 53 74 61 Test: ~25a Sta
2240: 74 65 3a 20 7e 31 35 61 20 53 74 61 74 75 73 3a te: ~15a Status:
2250: 20 7e 31 35 61 20 52 75 6e 74 69 6d 65 3a 20 7e ~15a Runtime: ~
2260: 35 40 61 73 20 54 69 6d 65 3a 20 7e 32 32 61 20 5@as Time: ~22a
2270: 48 6f 73 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 Host: ~10a\n"...
2280: 09 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d .(conc (db:test-
2290: 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 get-testname tes
22a0: 74 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 t).... (if
22b0: 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 (equal? (db:test
22c0: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 -get-item-path t
22d0: 65 73 74 29 20 22 22 29 0a 09 09 09 09 20 20 22 est) "")..... "
22e0: 22 20 0a 09 09 09 09 20 20 28 63 6f 6e 63 20 22 " ..... (conc "
22f0: 28 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (" (db:test-get-
2300: 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 20 item-path test)
2310: 22 29 22 29 29 29 0a 09 09 09 28 64 62 3a 74 65 ")")))....(db:te
2320: 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 st-get-state tes
2330: 74 29 0a 09 09 09 28 64 62 3a 74 65 73 74 2d 67 t)....(db:test-g
2340: 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 0a et-status test).
2350: 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ...(db:test-get-
2360: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 run_duration tes
2370: 74 29 0a 09 09 09 28 64 62 3a 74 65 73 74 2d 67 t)....(db:test-g
2380: 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 et-event_time te
2390: 73 74 29 0a 09 09 09 28 64 62 3a 74 65 73 74 2d st)....(db:test-
23a0: 67 65 74 2d 68 6f 73 74 20 74 65 73 74 29 29 0a get-host test)).
23b0: 20 09 09 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 ..(if (not (or
23c0: 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 (equal? (db:test
23d0: 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 -get-status test
23e0: 29 20 22 50 41 53 53 22 29 0a 09 09 09 20 20 20 ) "PASS")....
23f0: 20 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 (equal? (db:te
2400: 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 st-get-status te
2410: 73 74 29 20 22 57 41 52 4e 22 29 0a 09 09 09 20 st) "WARN")....
2420: 20 20 20 20 28 65 71 75 61 6c 3f 20 28 64 62 3a (equal? (db:
2430: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
2440: 65 73 74 29 20 20 22 4e 4f 54 5f 53 54 41 52 54 est) "NOT_START
2450: 45 44 22 29 29 29 0a 09 09 20 20 20 20 28 62 65 ED")))... (be
2460: 67 69 6e 0a 09 09 20 20 20 20 20 20 28 70 72 69 gin... (pri
2470: 6e 74 20 22 20 20 20 20 20 20 20 20 20 63 70 75 nt " cpu
2480: 6c 6f 61 64 3a 20 20 22 20 28 64 62 3a 74 65 73 load: " (db:tes
2490: 74 2d 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 t-get-cpuload te
24a0: 73 74 29 0a 09 09 09 20 20 20 20 20 22 5c 6e 20 st).... "\n
24b0: 20 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 diskfree
24c0: 3a 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 : " (db:test-get
24d0: 2d 64 69 73 6b 66 72 65 65 20 74 65 73 74 29 0a -diskfree test).
24e0: 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 ... "\n
24f0: 20 20 20 20 75 6e 61 6d 65 3a 20 20 20 20 22 20 uname: "
2500: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 75 6e 61 (db:test-get-una
2510: 6d 65 20 74 65 73 74 29 0a 09 09 09 20 20 20 20 me test)....
2520: 20 22 5c 6e 20 20 20 20 20 20 20 20 20 72 75 6e "\n run
2530: 64 69 72 3a 20 20 20 22 20 28 64 62 3a 74 65 73 dir: " (db:tes
2540: 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 t-get-rundir tes
2550: 74 29 0a 09 09 09 20 20 20 20 20 29 0a 09 09 20 t).... )...
2560: 20 20 20 20 20 3b 3b 20 45 61 63 68 20 74 65 73 ;; Each tes
2570: 74 0a 09 09 20 20 20 20 20 20 28 6c 65 74 20 28 t... (let (
2580: 28 73 74 65 70 73 20 28 64 62 2d 67 65 74 2d 74 (steps (db-get-t
2590: 65 73 74 2d 73 74 65 70 73 2d 66 6f 72 2d 72 75 est-steps-for-ru
25a0: 6e 20 64 62 20 28 64 62 3a 74 65 73 74 2d 67 65 n db (db:test-ge
25b0: 74 2d 69 64 20 74 65 73 74 29 29 29 29 0a 09 09 t-id test))))...
25c0: 09 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 .(for-each ....
25d0: 28 6c 61 6d 62 64 61 20 28 73 74 65 70 29 0a 09 (lambda (step)..
25e0: 09 09 20 20 20 28 66 6f 72 6d 61 74 20 23 74 20 .. (format #t
25f0: 0a 09 09 09 09 20 20 20 22 20 20 20 20 53 74 65 ..... " Ste
2600: 70 3a 20 7e 32 30 61 20 53 74 61 74 65 3a 20 7e p: ~20a State: ~
2610: 31 30 61 20 53 74 61 74 75 73 3a 20 7e 31 30 61 10a Status: ~10a
2620: 20 54 69 6d 65 20 7e 32 32 61 5c 6e 22 0a 09 09 Time ~22a\n"...
2630: 09 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 .. (db:step-ge
2640: 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 70 29 t-stepname step)
2650: 0a 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 ..... (db:step
2660: 2d 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 -get-state step)
2670: 0a 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 ..... (db:step
2680: 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 70 -get-status step
2690: 29 0a 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 )..... (db:ste
26a0: 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 p-get-event_time
26b0: 20 73 74 65 70 29 29 29 0a 09 09 09 20 73 74 65 step))).... ste
26c0: 70 73 29 29 29 29 29 0a 09 09 74 65 73 74 73 29 ps)))))...tests)
26d0: 29 29 29 0a 20 20 20 20 20 20 20 72 75 6e 73 29 ))). runs)
26e0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
26f0: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a dsomething* #t).
2700: 20 20 20 20 20 20 29 29 0a 0a 3b 3b 3d 3d 3d 3d ))..;;====
2710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2750: 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e 0a 3b ==.;; full run.;
2760: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
2770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
27a0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 20 =======..;; get
27b0: 6c 6f 63 6b 20 69 6e 20 64 62 20 66 6f 72 20 66 lock in db for f
27c0: 75 6c 6c 20 72 75 6e 20 66 6f 72 20 74 68 69 73 ull run for this
27d0: 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 66 6f directory.;; fo
27e0: 72 20 61 6c 6c 20 74 65 73 74 73 20 77 69 74 68 r all tests with
27f0: 20 64 65 70 73 0a 3b 3b 20 20 20 77 61 6c 6b 20 deps.;; walk
2800: 74 72 65 65 20 6f 66 20 74 65 73 74 73 20 74 6f tree of tests to
2810: 20 66 69 6e 64 20 68 65 61 64 20 74 61 73 6b 73 find head tasks
2820: 0a 3b 3b 20 20 20 61 64 64 20 68 65 61 64 20 74 .;; add head t
2830: 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 asks to task que
2840: 75 65 0a 3b 3b 20 20 20 61 64 64 20 64 65 70 65 ue.;; add depe
2850: 6e 64 61 6e 74 20 74 61 73 6b 73 20 74 6f 20 74 ndant tasks to t
2860: 61 73 6b 20 71 75 65 75 65 20 0a 3b 3b 20 20 20 ask queue .;;
2870: 61 64 64 20 72 65 6d 61 69 6e 69 6e 67 20 74 61 add remaining ta
2880: 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 sks to task queu
2890: 65 0a 3b 3b 20 66 6f 72 20 65 61 63 68 20 74 61 e.;; for each ta
28a0: 73 6b 20 69 6e 20 74 61 73 6b 20 71 75 65 75 65 sk in task queue
28b0: 0a 3b 3b 20 20 20 69 66 20 68 61 76 65 20 61 64 .;; if have ad
28c0: 65 71 75 61 74 65 20 72 65 73 6f 75 72 63 65 73 equate resources
28d0: 0a 3b 3b 20 20 20 20 20 6c 61 75 6e 63 68 20 74 .;; launch t
28e0: 61 73 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b ask.;; else.;;
28f0: 20 20 20 20 20 70 75 74 20 74 61 73 6b 20 69 6e put task in
2900: 20 64 65 66 65 72 72 65 64 20 71 75 65 75 65 0a deferred queue.
2910: 3b 3b 20 69 66 20 73 74 69 6c 6c 20 6f 6b 20 74 ;; if still ok t
2920: 6f 20 72 75 6e 20 74 61 73 6b 73 0a 3b 3b 20 20 o run tasks.;;
2930: 20 70 72 6f 63 65 73 73 20 64 65 66 65 72 72 65 process deferre
2940: 64 20 74 61 73 6b 73 20 70 65 72 20 61 62 6f 76 d tasks per abov
2950: 65 20 73 74 65 70 73 0a 0a 3b 3b 20 72 75 6e 20 e steps..;; run
2960: 61 6c 6c 20 74 65 73 74 73 20 61 72 65 20 61 72 all tests are ar
2970: 65 20 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 44 20 e Not COMPLETED
2980: 61 6e 64 20 50 41 53 53 20 6f 72 20 43 48 45 43 and PASS or CHEC
2990: 4b 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d K.(if (args:get-
29a0: 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 0a 20 arg "-runall").
29b0: 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
29c0: 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 75 6e call . "-run
29d0: 61 6c 6c 22 0a 20 20 20 20 20 22 72 75 6e 20 61 all". "run a
29e0: 6c 6c 20 74 65 73 74 73 22 0a 20 20 20 20 20 28 ll tests". (
29f0: 6c 61 6d 62 64 61 20 28 64 62 20 6b 65 79 73 20 lambda (db keys
2a00: 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c keynames keyvall
2a10: 73 74 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a st). (let*
2a20: 20 28 28 74 65 73 74 2d 6e 61 6d 65 73 20 28 67 ((test-names (g
2a30: 65 74 2d 61 6c 6c 2d 6c 65 67 61 6c 2d 74 65 73 et-all-legal-tes
2a40: 74 73 29 29 29 20 3b 3b 20 22 50 52 4f 44 22 20 ts))) ;; "PROD"
2a50: 69 73 20 69 67 6e 6f 72 65 64 20 66 6f 72 20 6e is ignored for n
2a60: 6f 77 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e ow.. (debug:prin
2a70: 74 20 31 20 22 49 4e 46 4f 3a 20 41 74 74 65 6d t 1 "INFO: Attem
2a80: 70 74 69 6e 67 20 74 6f 20 73 74 61 72 74 20 74 pting to start t
2a90: 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 74 65 73 he following tes
2aa0: 74 73 2e 2e 2e 22 29 0a 09 20 28 64 65 62 75 67 ts...").. (debug
2ab0: 3a 70 72 69 6e 74 20 31 20 22 20 20 20 20 20 22 :print 1 " "
2ac0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
2ad0: 65 72 73 65 20 74 65 73 74 2d 6e 61 6d 65 73 20 erse test-names
2ae0: 22 2c 22 29 29 0a 09 20 28 72 75 6e 2d 74 65 73 ",")).. (run-tes
2af0: 74 73 20 64 62 20 74 65 73 74 2d 6e 61 6d 65 73 ts db test-names
2b00: 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d )))))..;;=======
2b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
2b50: 3b 3b 20 52 6f 6c 6c 75 70 20 69 6e 74 6f 20 61 ;; Rollup into a
2b60: 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;=========
2b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 69 =============.(i
2bb0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
2bc0: 22 2d 72 6f 6c 6c 75 70 22 29 0a 20 20 20 20 28 "-rollup"). (
2bd0: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
2be0: 20 0a 20 20 20 20 20 22 2d 72 6f 6c 6c 75 70 22 . "-rollup"
2bf0: 20 0a 20 20 20 20 20 22 72 6f 6c 6c 75 70 20 74 . "rollup t
2c00: 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c 61 6d ests" . (lam
2c10: 62 64 61 20 28 64 62 20 6b 65 79 73 20 6b 65 79 bda (db keys key
2c20: 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 names keyvallst)
2c30: 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a 72 6f . (runs:ro
2c40: 6c 6c 75 70 2d 72 75 6e 20 64 62 20 6b 65 79 73 llup-run db keys
2c50: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
2c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
2ca0: 3b 20 45 78 74 72 61 63 74 20 61 20 73 70 72 65 ; Extract a spre
2cb0: 61 64 73 68 65 65 74 20 66 72 6f 6d 20 74 68 65 adsheet from the
2cc0: 20 72 75 6e 73 20 64 61 74 61 62 61 73 65 0a 3b runs database.;
2cd0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
2ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d10: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
2d20: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 74 gs:get-arg "-ext
2d30: 72 61 63 74 2d 6f 64 73 22 29 0a 20 20 20 20 28 ract-ods"). (
2d40: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
2d50: 0a 20 20 20 20 20 22 2d 65 78 74 72 61 63 74 2d . "-extract-
2d60: 6f 64 73 22 0a 20 20 20 20 20 22 4d 61 6b 65 20 ods". "Make
2d70: 6f 64 73 20 73 70 72 65 61 64 73 68 65 65 74 22 ods spreadsheet"
2d80: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 64 . (lambda (d
2d90: 62 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 b keys keynames
2da0: 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 20 keyvallst).
2db0: 20 20 28 6c 65 74 20 28 28 6f 75 74 70 75 74 66 (let ((outputf
2dc0: 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ile (args:get-ar
2dd0: 67 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 g "-extract-ods"
2de0: 29 29 0a 09 20 20 20 20 20 28 72 75 6e 73 70 61 )).. (runspa
2df0: 74 74 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 tt (args:get-a
2e00: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a rg ":runname")).
2e10: 09 20 20 20 20 20 28 6b 65 79 76 61 6c 61 6c 69 . (keyvalali
2e20: 73 74 20 28 6b 65 79 73 2d 3e 61 6c 69 73 74 20 st (keys->alist
2e30: 6b 65 79 73 20 22 25 22 29 29 29 0a 09 20 28 64 keys "%"))).. (d
2e40: 62 3a 65 78 74 72 61 63 74 2d 6f 64 73 2d 66 69 b:extract-ods-fi
2e50: 6c 65 20 64 62 20 6f 75 74 70 75 74 66 69 6c 65 le db outputfile
2e60: 20 6b 65 79 76 61 6c 61 6c 69 73 74 20 28 69 66 keyvalalist (if
2e70: 20 72 75 6e 73 70 61 74 74 20 72 75 6e 73 70 61 runspatt runspa
2e80: 74 74 20 22 25 22 29 29 29 29 29 29 0a 0a 3b 3b tt "%"))))))..;;
2e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ed0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e 20 6f 6e ======.;; run on
2ee0: 65 20 74 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d e test.;;=======
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 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
2f30: 0a 3b 3b 20 31 2e 20 66 69 6e 64 20 74 68 65 20 .;; 1. find the
2f40: 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b 20 32 config file.;; 2
2f50: 2e 20 63 68 61 6e 67 65 20 74 6f 20 74 68 65 20 . change to the
2f60: 74 65 73 74 20 64 69 72 65 63 74 6f 72 79 0a 3b test directory.;
2f70: 3b 20 33 2e 20 75 70 64 61 74 65 20 74 68 65 20 ; 3. update the
2f80: 64 62 20 77 69 74 68 20 22 74 65 73 74 20 73 74 db with "test st
2f90: 61 72 74 65 64 22 20 73 74 61 74 75 73 2c 20 73 arted" status, s
2fa0: 65 74 20 72 75 6e 6e 69 6e 67 20 68 6f 73 74 0a et running host.
2fb0: 3b 3b 20 34 2e 20 70 72 6f 63 65 73 73 20 6c 61 ;; 4. process la
2fc0: 75 6e 63 68 20 74 68 65 20 74 65 73 74 0a 3b 3b unch the test.;;
2fd0: 20 20 20 20 2d 20 6d 6f 6e 69 74 6f 72 20 74 68 - monitor th
2fe0: 65 20 70 72 6f 63 65 73 73 2c 20 75 70 64 61 74 e process, updat
2ff0: 65 20 73 74 61 74 73 20 69 6e 20 74 68 65 20 64 e stats in the d
3000: 62 20 65 76 65 72 79 20 32 5e 6e 20 6d 69 6e 75 b every 2^n minu
3010: 74 65 73 0a 3b 3b 20 35 2e 20 61 73 20 74 68 65 tes.;; 5. as the
3020: 20 74 65 73 74 20 70 72 6f 63 65 65 64 73 20 69 test proceeds i
3030: 6e 74 65 72 6e 61 6c 6c 79 20 69 74 20 63 61 6c nternally it cal
3040: 6c 73 20 6d 65 67 61 74 65 73 74 20 61 73 20 65 ls megatest as e
3050: 61 63 68 20 73 74 65 70 20 69 73 0a 3b 3b 20 20 ach step is.;;
3060: 20 20 73 74 61 72 74 65 64 20 61 6e 64 20 63 6f started and co
3070: 6d 70 6c 65 74 65 64 0a 3b 3b 20 20 20 20 2d 20 mpleted.;; -
3080: 73 74 65 70 20 73 74 61 72 74 65 64 2c 20 74 69 step started, ti
3090: 6d 65 73 74 61 6d 70 0a 3b 3b 20 20 20 20 2d 20 mestamp.;; -
30a0: 73 74 65 70 20 63 6f 6d 70 6c 65 74 65 64 2c 20 step completed,
30b0: 65 78 69 74 20 73 74 61 74 75 73 2c 20 74 69 6d exit status, tim
30c0: 65 73 74 61 6d 70 0a 3b 3b 20 36 2e 20 74 65 73 estamp.;; 6. tes
30d0: 74 20 70 68 6f 6e 65 20 68 6f 6d 65 0a 3b 3b 20 t phone home.;;
30e0: 20 20 20 2d 20 69 66 20 74 65 73 74 20 72 75 6e - if test run
30f0: 20 74 69 6d 65 20 3e 20 61 6c 6c 6f 77 65 64 20 time > allowed
3100: 72 75 6e 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 run time then ki
3110: 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 20 20 2d 20 69 ll job.;; - i
3120: 66 20 63 61 6e 6e 6f 74 20 61 63 63 65 73 73 20 f cannot access
3130: 64 62 20 3e 20 61 6c 6c 6f 77 65 64 20 64 69 73 db > allowed dis
3140: 63 6f 6e 6e 65 63 74 20 74 69 6d 65 20 74 68 65 connect time the
3150: 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 0a 28 69 66 20 n kill job..(if
3160: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3170: 72 75 6e 74 65 73 74 73 22 29 0a 20 20 28 67 65 runtests"). (ge
3180: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
3190: 20 20 20 22 2d 72 75 6e 74 65 73 74 73 22 20 0a "-runtests" .
31a0: 20 20 20 22 72 75 6e 20 61 20 74 65 73 74 22 20 "run a test"
31b0: 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 64 62 20 . (lambda (db
31c0: 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 keys keynames ke
31d0: 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 20 28 6c yvallst). (l
31e0: 65 74 20 28 28 74 65 73 74 2d 6e 61 6d 65 73 20 et ((test-names
31f0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 61 (string-split (a
3200: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
3210: 6e 74 65 73 74 73 22 29 20 22 2c 22 29 29 29 0a ntests") ","))).
3220: 20 20 20 20 20 20 20 28 72 75 6e 2d 74 65 73 74 (run-test
3230: 73 20 64 62 20 74 65 73 74 2d 6e 61 6d 65 73 29 s db test-names)
3240: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
3250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
3290: 3b 20 65 78 65 63 75 74 65 20 74 68 65 20 74 65 ; execute the te
32a0: 73 74 0a 3b 3b 20 20 20 20 2d 20 67 65 74 73 20 st.;; - gets
32b0: 63 61 6c 6c 65 64 20 6f 6e 20 72 65 6d 6f 74 65 called on remote
32c0: 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 72 65 host.;; - re
32d0: 63 65 69 76 65 73 20 69 6e 66 6f 20 66 72 6f 6d ceives info from
32e0: 20 74 68 65 20 2d 65 78 65 63 75 74 65 20 70 61 the -execute pa
32f0: 72 61 6d 0a 3b 3b 20 20 20 20 2d 20 70 61 73 73 ram.;; - pass
3300: 65 73 20 69 6e 66 6f 20 74 6f 20 73 74 65 70 73 es info to steps
3310: 20 76 69 61 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 via MT_CMDINFO
3320: 65 6e 76 20 76 61 72 20 28 66 75 74 75 72 65 20 env var (future
3330: 69 73 20 74 6f 20 75 73 65 20 61 20 64 6f 74 20 is to use a dot
3340: 66 69 6c 65 29 0a 3b 3b 20 20 20 20 2d 20 67 61 file).;; - ga
3350: 74 68 65 72 73 20 68 6f 73 74 20 69 6e 66 6f 20 thers host info
3360: 61 6e 64 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d and .;;=========
3370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
33a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
33b0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
33c0: 20 22 2d 65 78 65 63 75 74 65 22 29 0a 20 20 20 "-execute").
33d0: 20 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e 66 6f (let* ((cmdinfo
33e0: 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 (read (open-i
33f0: 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 nput-string (bas
3400: 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 e64:base64-decod
3410: 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 e (args:get-arg
3420: 22 2d 65 78 65 63 75 74 65 22 29 29 29 29 29 29 "-execute"))))))
3430: 0a 20 20 20 20 20 20 28 73 65 74 65 6e 76 20 22 . (setenv "
3440: 4d 54 5f 43 4d 44 49 4e 46 4f 22 20 28 61 72 67 MT_CMDINFO" (arg
3450: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 s:get-arg "-exec
3460: 75 74 65 22 29 29 0a 20 20 20 20 20 20 28 69 66 ute")). (if
3470: 20 28 6c 69 73 74 3f 20 63 6d 64 69 6e 66 6f 29 (list? cmdinfo)
3480: 20 3b 3b 20 28 28 74 65 73 74 70 61 74 68 20 2f ;; ((testpath /
3490: 74 6d 70 2f 6d 72 77 65 6c 6c 61 6e 2f 6a 61 7a tmp/mrwellan/jaz
34a0: 7a 6d 69 6e 64 2f 73 72 63 2f 65 78 61 6d 70 6c zmind/src/exampl
34b0: 65 5f 72 75 6e 2f 74 65 73 74 73 2f 73 71 6c 69 e_run/tests/sqli
34c0: 74 65 73 70 65 65 64 29 20 28 74 65 73 74 2d 6e tespeed) (test-n
34d0: 61 6d 65 20 73 71 6c 69 74 65 73 70 65 65 64 29 ame sqlitespeed)
34e0: 20 28 72 75 6e 73 63 72 69 70 74 20 72 75 6e 73 (runscript runs
34f0: 63 72 69 70 74 2e 72 62 29 20 28 64 62 2d 68 6f cript.rb) (db-ho
3500: 73 74 20 6c 6f 63 61 6c 68 6f 73 74 29 20 28 72 st localhost) (r
3510: 75 6e 2d 69 64 20 31 29 29 0a 09 20 20 28 6c 65 un-id 1)).. (le
3520: 74 2a 20 28 28 74 65 73 74 70 61 74 68 20 20 28 t* ((testpath (
3530: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
3540: 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
3550: 29 29 0a 09 09 20 28 77 6f 72 6b 2d 61 72 65 61 ))... (work-area
3560: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
3570: 27 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 'work-area cmdin
3580: 66 6f 29 29 0a 09 09 20 28 74 65 73 74 2d 6e 61 fo))... (test-na
3590: 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c me (assoc/defaul
35a0: 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 t 'test-name cmd
35b0: 69 6e 66 6f 29 29 0a 09 09 20 28 72 75 6e 73 63 info))... (runsc
35c0: 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 ript (assoc/defa
35d0: 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 ult 'runscript c
35e0: 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 64 62 2d mdinfo))... (db-
35f0: 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 host (assoc/de
3600: 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 fault 'db-host
3610: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 72 cmdinfo))... (r
3620: 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f un-id (assoc/
3630: 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 default 'run-id
3640: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 cmdinfo))...
3650: 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f (itemdat (asso
3660: 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 c/default 'itemd
3670: 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 at cmdinfo))..
3680: 09 20 28 65 6e 76 2d 6f 76 72 64 20 20 28 61 73 . (env-ovrd (as
3690: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 6e 76 soc/default 'env
36a0: 2d 6f 76 72 64 20 20 63 6d 64 69 6e 66 6f 29 29 -ovrd cmdinfo))
36b0: 0a 09 09 20 28 72 75 6e 6e 61 6d 65 20 20 20 28 ... (runname (
36c0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
36d0: 75 6e 6e 61 6d 65 20 20 20 63 6d 64 69 6e 66 6f unname cmdinfo
36e0: 29 29 0a 09 09 20 28 6d 65 67 61 74 65 73 74 20 ))... (megatest
36f0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
3700: 27 6d 65 67 61 74 65 73 74 20 20 63 6d 64 69 6e 'megatest cmdin
3710: 66 6f 29 29 0a 09 09 20 28 6d 74 2d 62 69 6e 64 fo))... (mt-bind
3720: 69 72 2d 70 61 74 68 20 28 61 73 73 6f 63 2f 64 ir-path (assoc/d
3730: 65 66 61 75 6c 74 20 27 6d 74 2d 62 69 6e 64 69 efault 'mt-bindi
3740: 72 2d 70 61 74 68 20 63 6d 64 69 6e 66 6f 29 29 r-path cmdinfo))
3750: 0a 09 09 20 28 66 75 6c 6c 72 75 6e 73 63 72 69 ... (fullrunscri
3760: 70 74 20 28 63 6f 6e 63 20 74 65 73 74 70 61 74 pt (conc testpat
3770: 68 20 22 2f 22 20 72 75 6e 73 63 72 69 70 74 29 h "/" runscript)
3780: 29 0a 09 09 20 28 64 62 20 20 20 20 20 20 20 20 )... (db
3790: 23 66 29 29 0a 09 20 20 20 20 28 64 65 62 75 67 #f)).. (debug
37a0: 3a 70 72 69 6e 74 20 32 20 22 45 78 65 63 74 75 :print 2 "Exectu
37b0: 69 6e 67 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 ing " test-name
37c0: 22 20 6f 6e 20 22 20 28 67 65 74 2d 68 6f 73 74 " on " (get-host
37d0: 2d 6e 61 6d 65 29 29 0a 09 20 20 20 20 28 63 68 -name)).. (ch
37e0: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
37f0: 65 73 74 70 61 74 68 29 0a 09 20 20 20 20 28 73 estpath).. (s
3800: 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 5f 52 etenv "MT_TEST_R
3810: 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 UN_DIR" work-are
3820: 61 29 0a 09 20 20 20 20 28 73 65 74 65 6e 76 20 a).. (setenv
3830: 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 "MT_TEST_NAME" t
3840: 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 20 20 28 est-name).. (
3850: 73 65 74 65 6e 76 20 22 4d 54 5f 49 54 45 4d 5f setenv "MT_ITEM_
3860: 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d INFO" (conc item
3870: 64 61 74 29 29 0a 09 20 20 20 20 28 73 65 74 65 dat)).. (sete
3880: 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 nv "MT_RUNNAME"
3890: 20 20 72 75 6e 6e 61 6d 65 29 0a 09 20 20 20 20 runname)..
38a0: 28 73 65 74 65 6e 76 20 22 4d 54 5f 4d 45 47 41 (setenv "MT_MEGA
38b0: 54 45 53 54 22 20 20 6d 65 67 61 74 65 73 74 29 TEST" megatest)
38c0: 0a 09 20 20 20 20 28 73 65 74 65 6e 76 20 22 50 .. (setenv "P
38d0: 41 54 48 22 20 28 63 6f 6e 63 20 28 67 65 74 65 ATH" (conc (gete
38e0: 6e 76 20 22 50 41 54 48 22 29 20 22 3a 22 20 6d nv "PATH") ":" m
38f0: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 29 29 0a t-bindir-path)).
3900: 09 20 20 20 20 0a 09 20 20 20 20 28 69 66 20 28 . .. (if (
3910: 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 not (setup-for-r
3920: 75 6e 29 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 un))...(begin...
3930: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
3940: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
3950: 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 09 p, exiting") ...
3960: 20 20 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 (exit 1)))..
3970: 20 20 3b 3b 20 6e 6f 77 20 63 61 6e 20 66 69 6e ;; now can fin
3980: 64 20 6f 75 72 20 64 62 0a 09 20 20 20 20 28 73 d our db.. (s
3990: 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 et! db (open-db)
39a0: 29 0a 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 ).. (change-d
39b0: 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 irectory work-ar
39c0: 65 61 29 20 0a 09 20 20 20 20 28 73 65 74 2d 72 ea) .. (set-r
39d0: 75 6e 2d 63 6f 6e 66 69 67 2d 76 61 72 73 20 64 un-config-vars d
39e0: 62 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 20 20 b run-id).
39f0: 20 20 20 20 20 20 3b 3b 20 65 6e 76 69 72 6f 6e ;; environ
3a00: 6d 65 6e 74 20 6f 76 65 72 72 69 64 65 73 20 61 ment overrides a
3a10: 72 65 20 64 6f 6e 65 20 2a 62 65 66 6f 72 65 2a re done *before*
3a20: 20 74 68 65 20 72 65 6d 61 69 6e 69 6e 67 20 63 the remaining c
3a30: 72 69 74 69 63 61 6c 20 65 6e 76 61 72 73 2e 0a ritical envars..
3a40: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6c 69 (ali
3a50: 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 65 6e 76 st->env-vars env
3a60: 2d 6f 76 72 64 29 0a 09 20 20 20 20 28 73 65 74 -ovrd).. (set
3a70: 2d 6d 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 -megatest-env-va
3a80: 72 73 20 64 62 20 72 75 6e 2d 69 64 29 0a 09 20 rs db run-id)..
3a90: 20 20 20 28 73 65 74 2d 69 74 65 6d 2d 65 6e 76 (set-item-env
3aa0: 2d 76 61 72 73 20 69 74 65 6d 64 61 74 29 0a 20 -vars itemdat).
3ab0: 20 20 20 20 20 20 20 20 20 20 20 28 73 61 76 65 (save
3ac0: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d -environment-as-
3ad0: 66 69 6c 65 73 20 22 6d 65 67 61 74 65 73 74 22 files "megatest"
3ae0: 29 0a 09 20 20 20 20 28 74 65 73 74 2d 73 65 74 ).. (test-set
3af0: 2d 6d 65 74 61 2d 69 6e 66 6f 20 64 62 20 72 75 -meta-info db ru
3b00: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
3b10: 74 65 6d 64 61 74 29 0a 09 20 20 20 20 28 74 65 temdat).. (te
3b20: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 st-set-status! d
3b30: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
3b40: 6d 65 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 me "REMOTEHOSTST
3b50: 41 52 54 22 20 22 6e 2f 61 22 20 69 74 65 6d 64 ART" "n/a" itemd
3b60: 61 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 at (args:get-arg
3b70: 20 22 2d 6d 22 29 20 23 66 29 0a 09 20 20 20 20 "-m") #f)..
3b80: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
3b90: 67 20 22 2d 78 74 65 72 6d 22 29 0a 09 09 28 73 g "-xterm")...(s
3ba0: 65 74 21 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 et! fullrunscrip
3bb0: 74 20 22 78 74 65 72 6d 22 29 0a 20 20 20 20 20 t "xterm").
3bc0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
3bd0: 6e 6f 74 20 28 66 69 6c 65 2d 65 78 65 63 75 74 not (file-execut
3be0: 65 2d 61 63 63 65 73 73 3f 20 66 75 6c 6c 72 75 e-access? fullru
3bf0: 6e 73 63 72 69 70 74 29 29 0a 20 20 20 20 20 20 nscript)).
3c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
3c10: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 63 68 6d ystem (conc "chm
3c20: 6f 64 20 75 67 2b 78 20 22 20 66 75 6c 6c 72 75 od ug+x " fullru
3c30: 6e 73 63 72 69 70 74 29 29 29 29 0a 09 20 20 20 nscript))))..
3c40: 20 3b 3b 20 57 65 20 61 72 65 20 61 62 6f 75 74 ;; We are about
3c50: 20 74 6f 20 61 63 74 75 61 6c 6c 79 20 6b 69 63 to actually kic
3c60: 6b 20 6f 66 66 20 74 68 65 20 74 65 73 74 0a 09 k off the test..
3c70: 20 20 20 20 3b 3b 20 73 6f 20 74 68 69 73 20 69 ;; so this i
3c80: 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 20 74 s a good place t
3c90: 6f 20 72 65 6d 6f 76 65 20 74 68 65 20 72 65 63 o remove the rec
3ca0: 6f 72 64 73 20 66 6f 72 20 0a 09 20 20 20 20 3b ords for .. ;
3cb0: 3b 20 61 6e 79 20 70 72 65 76 69 6f 75 73 20 72 ; any previous r
3cc0: 75 6e 73 0a 09 20 20 20 20 3b 3b 20 28 64 62 3a uns.. ;; (db:
3cd0: 74 65 73 74 2d 72 65 6d 6f 76 65 2d 73 74 65 70 test-remove-step
3ce0: 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 s db run-id test
3cf0: 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 09 20 name itemdat)..
3d00: 20 20 20 0a 09 20 20 20 20 3b 3b 20 66 72 6f 6d .. ;; from
3d10: 20 68 65 72 65 20 6f 6e 20 6f 75 74 20 77 65 20 here on out we
3d20: 77 69 6c 6c 20 6f 70 65 6e 20 61 6e 64 20 63 6c will open and cl
3d30: 6f 73 65 20 74 68 65 20 64 62 0a 09 20 20 20 20 ose the db..
3d40: 3b 3b 20 6f 6e 20 65 76 65 72 79 20 61 63 63 65 ;; on every acce
3d50: 73 73 20 74 6f 20 72 65 64 75 63 65 20 74 68 65 ss to reduce the
3d60: 20 70 72 6f 62 61 62 6c 69 74 69 79 20 6f 66 20 probablitiy of
3d70: 0a 09 20 20 20 20 3b 3b 20 63 6f 6e 74 65 6e 74 .. ;; content
3d80: 69 6f 6e 20 6f 72 20 73 74 75 63 6b 20 61 63 63 ion or stuck acc
3d90: 65 73 73 20 6f 6e 20 6e 66 73 2e 0a 09 20 20 20 ess on nfs...
3da0: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
3db0: 7a 65 21 20 64 62 29 0a 0a 09 20 20 20 20 28 6c ze! db)... (l
3dc0: 65 74 2a 20 28 28 6d 20 20 20 20 20 20 20 20 20 et* ((m
3dd0: 20 20 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 29 (make-mutex))
3de0: 0a 09 09 20 20 20 28 6b 69 6c 6c 2d 6a 6f 62 3f ... (kill-job?
3df0: 20 20 20 20 23 66 29 0a 09 09 20 20 20 28 65 78 #f)... (ex
3e00: 69 74 2d 69 6e 66 6f 20 20 20 20 28 6d 61 6b 65 it-info (make
3e10: 2d 76 65 63 74 6f 72 20 33 29 29 0a 09 09 20 20 -vector 3))...
3e20: 20 28 6a 6f 62 2d 74 68 72 65 61 64 20 20 20 23 (job-thread #
3e30: 66 29 0a 09 09 20 20 20 28 72 75 6e 69 74 20 20 f)... (runit
3e40: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 (lambda ()
3e50: 0a 09 09 09 09 20 20 20 3b 3b 20 28 6c 65 74 2d ..... ;; (let-
3e60: 76 61 6c 75 65 73 0a 09 09 09 09 20 20 20 3b 3b values..... ;;
3e70: 20 20 28 28 28 70 69 64 20 65 78 69 74 2d 73 74 (((pid exit-st
3e80: 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 0a atus exit-code).
3e90: 09 09 09 09 20 20 20 3b 3b 20 20 20 20 28 72 75 .... ;; (ru
3ea0: 6e 2d 6e 2d 77 61 69 74 20 66 75 6c 6c 72 75 6e n-n-wait fullrun
3eb0: 73 63 72 69 70 74 29 29 29 0a 09 09 09 09 20 20 script))).....
3ec0: 20 28 6c 65 74 20 28 28 70 69 64 20 28 70 72 6f (let ((pid (pro
3ed0: 63 65 73 73 2d 72 75 6e 20 66 75 6c 6c 72 75 6e cess-run fullrun
3ee0: 73 63 72 69 70 74 29 29 29 0a 09 09 09 09 20 20 script))).....
3ef0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 (let loop ((i
3f00: 20 30 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 0)).....
3f10: 28 6c 65 74 2d 76 61 6c 75 65 73 0a 09 09 09 09 (let-values.....
3f20: 09 28 28 28 70 69 64 2d 76 61 6c 20 65 78 69 74 .(((pid-val exit
3f30: 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 -status exit-cod
3f40: 65 29 20 28 70 72 6f 63 65 73 73 2d 77 61 69 74 e) (process-wait
3f50: 20 70 69 64 20 23 74 29 29 29 0a 09 09 09 09 09 pid #t)))......
3f60: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a (mutex-lock! m).
3f70: 09 09 09 09 09 28 76 65 63 74 6f 72 2d 73 65 74 .....(vector-set
3f80: 21 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 ! exit-info 0 pi
3f90: 64 29 0a 09 09 09 09 09 28 76 65 63 74 6f 72 2d d)......(vector-
3fa0: 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 set! exit-info 1
3fb0: 20 65 78 69 74 2d 73 74 61 74 75 73 29 0a 09 09 exit-status)...
3fc0: 09 09 09 28 76 65 63 74 6f 72 2d 73 65 74 21 20 ...(vector-set!
3fd0: 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 78 69 74 exit-info 2 exit
3fe0: 2d 63 6f 64 65 29 0a 09 09 09 09 09 28 6d 75 74 -code)......(mut
3ff0: 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 09 ex-unlock! m)...
4000: 09 09 09 28 69 66 20 28 65 71 3f 20 70 69 64 2d ...(if (eq? pid-
4010: 76 61 6c 20 30 29 0a 09 09 09 09 09 20 20 20 20 val 0)......
4020: 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 20 (begin......
4030: 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
4040: 20 32 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 2)...... (
4050: 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 0a 09 loop (+ i 1)))..
4060: 09 09 09 09 20 20 20 20 29 29 29 29 29 29 0a 09 .... ))))))..
4070: 09 20 20 20 28 6d 6f 6e 69 74 6f 72 6a 6f 62 20 . (monitorjob
4080: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 (lambda ()....
4090: 09 20 20 20 28 6c 65 74 2a 20 28 28 73 74 61 72 . (let* ((star
40a0: 74 2d 73 65 63 6f 6e 64 73 20 28 63 75 72 72 65 t-seconds (curre
40b0: 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 09 09 nt-seconds))....
40c0: 09 09 20 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 .. (calc-minute
40d0: 73 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 s (lambda ()...
40e0: 09 09 09 09 09 20 20 20 28 69 6e 65 78 61 63 74 ..... (inexact
40f0: 2d 3e 65 78 61 63 74 20 0a 09 09 09 09 09 09 09 ->exact ........
4100: 20 20 20 20 28 72 6f 75 6e 64 20 0a 09 09 09 09 (round .....
4110: 09 09 09 20 20 20 20 20 28 2d 20 0a 09 09 09 09 ... (- .....
4120: 09 09 09 20 20 20 20 20 20 28 63 75 72 72 65 6e ... (curren
4130: 74 2d 73 65 63 6f 6e 64 73 29 20 0a 09 09 09 09 t-seconds) .....
4140: 09 09 09 20 20 20 20 20 20 73 74 61 72 74 2d 73 ... start-s
4150: 65 63 6f 6e 64 73 29 29 29 29 29 0a 09 09 09 09 econds))))).....
4160: 09 20 20 28 6b 69 6c 6c 2d 74 72 69 65 73 20 30 . (kill-tries 0
4170: 29 29 0a 09 09 09 09 20 20 20 20 20 28 6c 65 74 ))..... (let
4180: 20 6c 6f 6f 70 20 28 28 6d 69 6e 75 74 65 73 20 loop ((minutes
4190: 20 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 (calc-minutes)
41a0: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c ))..... (l
41b0: 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 28 et* ((db (
41c0: 6f 70 65 6e 2d 64 62 29 29 0a 09 09 09 09 09 20 open-db))......
41d0: 20 20 20 20 20 28 63 70 75 6c 6f 61 64 20 20 28 (cpuload (
41e0: 67 65 74 2d 63 70 75 2d 6c 6f 61 64 29 29 0a 09 get-cpu-load))..
41f0: 09 09 09 09 20 20 20 20 20 20 28 64 69 73 6b 66 .... (diskf
4200: 72 65 65 20 28 67 65 74 2d 64 66 20 28 63 75 72 ree (get-df (cur
4210: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 rent-directory))
4220: 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 74 6d )...... (tm
4230: 70 66 72 65 65 20 20 28 67 65 74 2d 64 66 20 22 pfree (get-df "
4240: 2f 74 6d 70 22 29 29 29 0a 09 09 09 09 09 20 28 /tmp")))...... (
4250: 69 66 20 28 6e 6f 74 20 63 70 75 6c 6f 61 64 29 if (not cpuload)
4260: 20 20 28 62 65 67 69 6e 20 28 64 65 62 75 67 3a (begin (debug:
4270: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
4280: 3a 20 43 50 55 4c 4f 41 44 20 6e 6f 74 20 66 6f : CPULOAD not fo
4290: 75 6e 64 2e 22 29 20 20 28 73 65 74 21 20 63 70 und.") (set! cp
42a0: 75 6c 6f 61 64 20 22 6e 2f 61 22 29 29 29 0a 09 uload "n/a")))..
42b0: 09 09 09 09 20 28 69 66 20 28 6e 6f 74 20 64 69 .... (if (not di
42c0: 73 6b 66 72 65 65 29 20 28 62 65 67 69 6e 20 28 skfree) (begin (
42d0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 debug:print 0 "W
42e0: 41 52 4e 49 4e 47 3a 20 44 49 53 4b 46 52 45 45 ARNING: DISKFREE
42f0: 20 6e 6f 74 20 66 6f 75 6e 64 2e 22 29 20 28 73 not found.") (s
4300: 65 74 21 20 64 69 73 6b 66 72 65 65 20 22 6e 2f et! diskfree "n/
4310: 61 22 29 29 29 0a 09 09 09 09 09 20 28 73 65 74 a")))...... (set
4320: 21 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 28 74 65 73 ! kill-job? (tes
4330: 74 2d 67 65 74 2d 6b 69 6c 6c 2d 72 65 71 75 65 t-get-kill-reque
4340: 73 74 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 st db run-id tes
4350: 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 29 t-name itemdat))
4360: 0a 09 09 09 09 09 20 28 74 65 73 74 2d 75 70 64 ...... (test-upd
4370: 61 74 65 2d 6d 65 74 61 2d 69 6e 66 6f 20 64 62 ate-meta-info db
4380: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
4390: 65 20 69 74 65 6d 64 61 74 20 6d 69 6e 75 74 65 e itemdat minute
43a0: 73 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 s cpuload diskfr
43b0: 65 65 20 74 6d 70 66 72 65 65 29 0a 09 09 09 09 ee tmpfree).....
43c0: 09 20 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 . (if kill-job?
43d0: 0a 09 09 09 09 09 20 20 20 20 20 28 62 65 67 69 ...... (begi
43e0: 6e 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 6d n...... (m
43f0: 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 utex-lock! m)...
4400: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 ... (let*
4410: 28 28 70 69 64 20 28 76 65 63 74 6f 72 2d 72 65 ((pid (vector-re
4420: 66 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 29 29 f exit-info 0)))
4430: 0a 09 09 09 09 09 09 20 28 69 66 20 28 6e 75 6d ....... (if (num
4440: 62 65 72 3f 20 70 69 64 29 0a 09 09 09 09 09 09 ber? pid).......
4450: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 (begin.....
4460: 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a .. (debug:
4470: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
4480: 3a 20 52 65 71 75 65 73 74 20 72 65 63 65 69 76 : Request receiv
4490: 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 28 ed to kill job (
44a0: 61 74 74 65 6d 70 74 20 23 20 22 20 6b 69 6c 6c attempt # " kill
44b0: 2d 74 72 69 65 73 20 22 29 22 29 0a 09 09 09 09 -tries ")").....
44c0: 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 .. (let ((
44d0: 70 72 6f 63 65 73 73 65 73 20 28 63 6d 64 2d 72 processes (cmd-r
44e0: 75 6e 2d 3e 6c 69 73 74 20 28 63 6f 6e 63 20 22 un->list (conc "
44f0: 70 67 72 65 70 20 2d 6c 20 2d 50 20 22 20 70 69 pgrep -l -P " pi
4500: 64 29 29 29 29 0a 09 09 09 09 09 09 09 20 28 66 d))))........ (f
4510: 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 09 09 09 or-each ........
4520: 20 20 28 6c 61 6d 62 64 61 20 28 70 29 0a 09 09 (lambda (p)...
4530: 09 09 09 09 09 20 20 20 20 28 6c 65 74 2a 20 28 ..... (let* (
4540: 28 70 61 72 74 73 20 20 28 73 74 72 69 6e 67 2d (parts (string-
4550: 73 70 6c 69 74 20 70 29 29 0a 09 09 09 09 09 09 split p)).......
4560: 09 09 20 20 20 28 70 2d 69 64 20 20 20 28 69 66 .. (p-id (if
4570: 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 72 74 (> (length part
4580: 73 29 20 30 29 0a 09 09 09 09 09 09 09 09 09 20 s) 0)..........
4590: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e (string->n
45a0: 75 6d 62 65 72 20 28 63 61 72 20 70 61 72 74 73 umber (car parts
45b0: 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 ))..........
45c0: 20 20 20 23 66 29 29 29 0a 09 09 09 09 09 09 09 #f)))........
45d0: 20 20 20 20 20 20 28 69 66 20 70 2d 69 64 0a 09 (if p-id..
45e0: 09 09 09 09 09 09 09 20 20 28 62 65 67 69 6e 0a ....... (begin.
45f0: 09 09 09 09 09 09 09 09 20 20 20 20 28 64 65 62 ........ (deb
4600: 75 67 3a 70 72 69 6e 74 20 30 20 22 4b 69 6c 6c ug:print 0 "Kill
4610: 69 6e 67 20 22 20 28 63 61 64 72 20 70 61 72 74 ing " (cadr part
4620: 73 29 20 22 3b 20 6b 69 6c 6c 20 2d 39 20 20 22 s) "; kill -9 "
4630: 20 70 2d 69 64 29 0a 09 09 09 09 09 09 09 09 20 p-id).........
4640: 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 (system (conc
4650: 20 22 6b 69 6c 6c 20 2d 39 20 22 20 70 2d 69 64 "kill -9 " p-id
4660: 29 29 29 29 29 29 0a 09 09 09 09 09 09 09 20 20 ))))))........
4670: 28 63 61 72 20 70 72 6f 63 65 73 73 65 73 29 29 (car processes))
4680: 0a 09 09 09 09 09 09 09 20 28 73 79 73 74 65 6d ........ (system
4690: 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d 39 20 (conc "kill -9
46a0: 22 20 70 69 64 29 29 29 29 0a 09 09 09 09 09 09 " pid)))).......
46b0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 (begin.....
46c0: 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a .. (debug:
46d0: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
46e0: 3a 20 52 65 71 75 65 73 74 20 72 65 63 65 69 76 : Request receiv
46f0: 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 62 ed to kill job b
4700: 75 74 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 ut problem with
4710: 70 72 6f 63 65 73 73 2c 20 61 74 74 65 6d 70 74 process, attempt
4720: 69 6e 67 20 74 6f 20 6b 69 6c 6c 20 6d 61 6e 61 ing to kill mana
4730: 67 65 72 20 70 72 6f 63 65 73 73 22 29 0a 09 09 ger process")...
4740: 09 09 09 09 20 20 20 20 20 20 20 28 74 65 73 74 .... (test
4750: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 -set-status! db
4760: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
4770: 20 22 4b 49 4c 4c 45 44 22 20 20 22 46 41 49 4c "KILLED" "FAIL
4780: 22 0a 09 09 09 09 09 09 09 09 09 20 69 74 65 6d ".......... item
4790: 64 61 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 dat (args:get-ar
47a0: 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 09 09 09 g "-m") #f).....
47b0: 09 09 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 .. (sqlite
47c0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
47d0: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 65 78 ...... (ex
47e0: 69 74 20 31 29 29 29 29 0a 09 09 09 09 09 20 20 it 1))))......
47f0: 20 20 20 20 20 28 73 65 74 21 20 6b 69 6c 6c 2d (set! kill-
4800: 74 72 69 65 73 20 28 2b 20 31 20 6b 69 6c 6c 2d tries (+ 1 kill-
4810: 74 72 69 65 73 29 29 0a 09 09 09 09 09 20 20 20 tries))......
4820: 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 (mutex-unloc
4830: 6b 21 20 6d 29 29 29 0a 09 09 09 09 09 20 28 73 k! m)))...... (s
4840: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
4850: 20 64 62 29 0a 09 09 09 09 09 20 28 74 68 72 65 db)...... (thre
4860: 61 64 2d 73 6c 65 65 70 21 20 28 2b 20 38 20 28 ad-sleep! (+ 8 (
4870: 72 61 6e 64 6f 6d 20 34 29 29 29 20 3b 3b 20 61 random 4))) ;; a
4880: 64 64 20 73 6f 6d 65 20 6a 69 74 74 65 72 20 74 dd some jitter t
4890: 6f 20 74 68 65 20 63 61 6c 6c 20 68 6f 6d 65 20 o the call home
48a0: 74 69 6d 65 20 74 6f 20 73 70 72 65 61 64 20 6f time to spread o
48b0: 75 74 20 74 68 65 20 64 62 20 61 63 63 65 73 73 ut the db access
48c0: 65 73 0a 09 09 09 09 09 20 28 6c 6f 6f 70 20 28 es...... (loop (
48d0: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 29 calc-minutes))))
48e0: 29 29 29 0a 09 09 20 20 20 28 74 68 31 20 20 20 )))... (th1
48f0: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 (make-thr
4900: 65 61 64 20 6d 6f 6e 69 74 6f 72 6a 6f 62 29 29 ead monitorjob))
4910: 0a 09 09 20 20 20 28 74 68 32 20 20 20 20 20 20 ... (th2
4920: 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 (make-thread
4930: 20 72 75 6e 69 74 29 29 29 0a 09 20 20 20 20 20 runit)))..
4940: 20 28 73 65 74 21 20 6a 6f 62 2d 74 68 72 65 61 (set! job-threa
4950: 64 20 74 68 32 29 0a 09 20 20 20 20 20 20 28 74 d th2).. (t
4960: 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 hread-start! th1
4970: 29 0a 09 20 20 20 20 20 20 28 74 68 72 65 61 64 ).. (thread
4980: 2d 73 74 61 72 74 21 20 74 68 32 29 0a 09 20 20 -start! th2)..
4990: 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e (thread-join
49a0: 21 20 74 68 32 29 0a 09 20 20 20 20 20 20 28 6d ! th2).. (m
49b0: 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 20 utex-lock! m)..
49c0: 20 20 20 20 20 28 73 65 74 21 20 64 62 20 28 6f (set! db (o
49d0: 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 20 20 pen-db))..
49e0: 28 6c 65 74 2a 20 28 28 69 74 65 6d 2d 70 61 74 (let* ((item-pat
49f0: 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 h (item-list->pa
4a00: 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 09 20 th itemdat))...
4a10: 20 20 20 20 28 74 65 73 74 69 6e 66 6f 20 20 28 (testinfo (
4a20: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f db:get-test-info
4a30: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d db run-id test-
4a40: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 name item-path))
4a50: 29 0a 09 09 28 69 66 20 28 6e 6f 74 20 28 65 71 )...(if (not (eq
4a60: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
4a70: 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f t-state testinfo
4a80: 29 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 0a ) "COMPLETED")).
4a90: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 .. (begin...
4aa0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
4ab0: 74 20 32 20 22 54 65 73 74 20 4e 4f 54 20 6c 6f t 2 "Test NOT lo
4ac0: 67 67 65 64 20 61 73 20 43 4f 4d 50 4c 45 54 45 gged as COMPLETE
4ad0: 44 2c 20 28 73 74 61 74 65 3d 22 20 28 64 62 3a D, (state=" (db:
4ae0: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
4af0: 65 73 74 69 6e 66 6f 29 20 22 29 2c 20 75 70 64 estinfo) "), upd
4b00: 61 74 69 6e 67 20 72 65 73 75 6c 74 22 29 0a 09 ating result")..
4b10: 09 20 20 20 20 20 20 28 74 65 73 74 2d 73 65 74 . (test-set
4b20: 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 6e 2d -status! db run-
4b30: 69 64 20 74 65 73 74 2d 6e 61 6d 65 0a 09 09 09 id test-name....
4b40: 09 09 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 ..(if kill-job?
4b50: 22 4b 49 4c 4c 45 44 22 20 22 43 4f 4d 50 4c 45 "KILLED" "COMPLE
4b60: 54 45 44 22 29 0a 09 09 09 09 09 28 69 66 20 28 TED")......(if (
4b70: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
4b80: 69 6e 66 6f 20 31 29 20 3b 3b 20 6c 6f 6f 6b 20 info 1) ;; look
4b90: 61 74 20 74 68 65 20 65 78 69 74 2d 73 74 61 74 at the exit-stat
4ba0: 75 73 0a 09 09 09 09 09 20 20 20 20 28 69 66 20 us...... (if
4bb0: 28 61 6e 64 20 28 6e 6f 74 20 6b 69 6c 6c 2d 6a (and (not kill-j
4bc0: 6f 62 3f 29 20 0a 09 09 09 09 09 09 20 20 20 20 ob?) .......
4bd0: 20 28 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 65 (eq? (vector-re
4be0: 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 30 f exit-info 2) 0
4bf0: 29 29 0a 09 09 09 09 09 09 22 50 41 53 53 22 0a ))......."PASS".
4c00: 09 09 09 09 09 09 22 46 41 49 4c 22 29 0a 09 09 ......"FAIL")...
4c10: 09 09 09 20 20 20 20 22 46 41 49 4c 22 29 20 69 ... "FAIL") i
4c20: 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67 65 74 temdat (args:get
4c30: 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 29 29 -arg "-m") #f)))
4c40: 0a 09 09 3b 3b 20 66 6f 72 20 61 75 74 6f 6d 61 ...;; for automa
4c50: 74 65 64 20 63 72 65 61 74 69 6f 6e 20 6f 66 20 ted creation of
4c60: 74 68 65 20 72 6f 6c 6c 75 70 20 68 74 6d 6c 20 the rollup html
4c70: 66 69 6c 65 20 74 68 69 73 20 69 73 20 61 20 67 file this is a g
4c80: 6f 6f 64 20 70 6c 61 63 65 2e 2e 2e 0a 09 09 28 ood place......(
4c90: 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 if (not (equal?
4ca0: 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 0a 09 item-path ""))..
4cb0: 09 20 20 20 28 74 65 73 74 73 3a 73 75 6d 6d 61 . (tests:summa
4cc0: 72 69 7a 65 2d 69 74 65 6d 73 20 64 62 20 72 75 rize-items db ru
4cd0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 n-id test-name #
4ce0: 66 29 29 20 3b 3b 20 64 6f 6e 27 74 20 66 6f 72 f)) ;; don't for
4cf0: 63 65 20 2d 20 6a 75 73 74 20 75 70 64 61 74 65 ce - just update
4d00: 20 69 66 20 6e 6f 0a 09 09 29 0a 09 20 20 20 20 if no...)..
4d10: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
4d20: 20 6d 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 65 m).. ;; (e
4d30: 78 65 63 2d 72 65 73 75 6c 74 73 20 28 63 6d 64 xec-results (cmd
4d40: 2d 72 75 6e 2d 3e 6c 69 73 74 20 66 75 6c 6c 72 -run->list fullr
4d50: 75 6e 73 63 72 69 70 74 29 29 20 3b 3b 20 20 28 unscript)) ;; (
4d60: 6c 69 73 74 20 22 3e 22 20 28 63 6f 6e 63 20 74 list ">" (conc t
4d70: 65 73 74 2d 6e 61 6d 65 20 22 2d 72 75 6e 2e 6c est-name "-run.l
4d80: 6f 67 22 29 29 29 29 0a 09 20 20 20 20 20 20 3b og")))).. ;
4d90: 3b 20 28 73 75 63 63 65 73 73 20 20 20 20 20 20 ; (success
4da0: 65 78 65 63 2d 72 65 73 75 6c 74 73 29 29 20 3b exec-results)) ;
4db0: 3b 20 28 65 71 3f 20 28 63 61 64 72 20 65 78 65 ; (eq? (cadr exe
4dc0: 63 2d 72 65 73 75 6c 74 73 29 20 30 29 29 29 0a c-results) 0))).
4dd0: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
4de0: 69 6e 74 20 32 20 22 4f 75 74 70 75 74 20 66 72 int 2 "Output fr
4df0: 6f 6d 20 72 75 6e 6e 69 6e 67 20 22 20 66 75 6c om running " ful
4e00: 6c 72 75 6e 73 63 72 69 70 74 20 22 2c 20 70 69 lrunscript ", pi
4e10: 64 20 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 d " (vector-ref
4e20: 65 78 69 74 2d 69 6e 66 6f 20 30 29 20 22 20 69 exit-info 0) " i
4e30: 6e 20 77 6f 72 6b 20 61 72 65 61 20 22 20 0a 09 n work area " ..
4e40: 09 20 20 20 20 20 77 6f 72 6b 2d 61 72 65 61 20 . work-area
4e50: 22 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 65 78 69 74 20 ":\n====\n exit
4e60: 63 6f 64 65 20 22 20 28 76 65 63 74 6f 72 2d 72 code " (vector-r
4e70: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 ef exit-info 2)
4e80: 22 5c 6e 22 20 22 3d 3d 3d 3d 5c 6e 22 29 0a 09 "\n" "====\n")..
4e90: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 (sqlite3:f
4ea0: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 inalize! db)..
4eb0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 76 65 (if (not (ve
4ec0: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
4ed0: 66 6f 20 31 29 29 0a 09 09 20 20 28 65 78 69 74 fo 1))... (exit
4ee0: 20 34 29 29 29 29 29 0a 20 20 20 20 20 20 28 73 4))))). (s
4ef0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
4f00: 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
4f10: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
4f20: 65 70 22 29 0a 20 20 20 20 28 69 66 20 28 6e 6f ep"). (if (no
4f30: 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d t (getenv "MT_CM
4f40: 44 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e DINFO"))..(begin
4f50: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
4f60: 20 30 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 0 "ERROR: MT_CM
4f70: 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f DINFO env var no
4f80: 74 20 73 65 74 2c 20 2d 73 74 65 70 20 6d 75 73 t set, -step mus
4f90: 74 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 t be called *ins
4fa0: 69 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 ide* a megatest
4fb0: 69 6e 76 6f 6b 65 64 20 65 6e 76 69 72 6f 6e 6d invoked environm
4fc0: 65 6e 74 21 22 29 0a 09 20 20 28 65 78 69 74 20 ent!").. (exit
4fd0: 35 29 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 65 5))..(let* ((ste
4fe0: 70 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 p (args:get
4ff0: 2d 61 72 67 20 22 2d 73 74 65 70 22 29 29 0a 09 -arg "-step"))..
5000: 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f 20 (cmdinfo
5010: 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e (read (open-in
5020: 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 put-string (base
5030: 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 64:base64-decode
5040: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
5050: 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 20 20 INFO")))))..
5060: 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 61 (testpath (a
5070: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
5080: 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 stpath cmdinfo)
5090: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d ).. (test-
50a0: 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 name (assoc/defa
50b0: 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 ult 'test-name c
50c0: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
50d0: 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 73 (runscript (ass
50e0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 73 oc/default 'runs
50f0: 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a cript cmdinfo)).
5100: 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 74 . (db-host
5110: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
5120: 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 t 'db-host cmd
5130: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
5140: 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 run-id (assoc
5150: 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 /default 'run-id
5160: 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 cmdinfo))..
5170: 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 (itemdat
5180: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
5190: 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 'itemdat cmdin
51a0: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 fo)).. (db
51b0: 20 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 #f)..
51c0: 20 20 20 20 28 73 74 61 74 65 20 20 20 20 28 61 (state (a
51d0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
51e0: 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 ate")).. (
51f0: 73 74 61 74 75 73 20 20 20 28 61 72 67 73 3a 67 status (args:g
5200: 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 et-arg ":status"
5210: 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 ))).. (change-d
5220: 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
5230: 68 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 h).. (if (not (
5240: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
5250: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
5260: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
5270: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
5280: 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 exiting")...(ex
5290: 69 74 20 31 29 29 29 0a 09 20 20 28 73 65 74 21 it 1))).. (set!
52a0: 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 db (open-db))..
52b0: 20 20 28 69 66 20 28 61 6e 64 20 73 74 61 74 65 (if (and state
52c0: 20 73 74 61 74 75 73 29 0a 09 20 20 20 20 20 20 status)..
52d0: 28 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 (teststep-set-st
52e0: 61 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 atus! db run-id
52f0: 74 65 73 74 2d 6e 61 6d 65 20 73 74 65 70 20 73 test-name step s
5300: 74 61 74 65 20 73 74 61 74 75 73 20 69 74 65 6d tate status item
5310: 64 61 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 dat (args:get-ar
5320: 67 20 22 2d 6d 22 29 29 0a 09 20 20 20 20 20 20 g "-m"))..
5330: 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a (begin...(debug:
5340: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
5350: 59 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 You must specify
5360: 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 :state and :sta
5370: 74 75 73 20 77 69 74 68 20 65 76 65 72 79 20 63 tus with every c
5380: 61 6c 6c 20 74 6f 20 2d 73 74 65 70 22 29 0a 09 all to -step")..
5390: 09 28 65 78 69 74 20 36 29 29 29 0a 09 20 20 28 .(exit 6))).. (
53a0: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
53b0: 21 20 64 62 29 0a 09 20 20 28 73 65 74 21 20 2a ! db).. (set! *
53c0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
53d0: 29 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 ))))..(if (or (a
53e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
53f0: 74 6c 6f 67 22 29 20 20 20 20 20 20 20 3b 3b 20 tlog") ;;
5400: 73 69 6e 63 65 20 73 65 74 74 69 6e 67 20 75 70 since setting up
5410: 20 69 73 20 73 6f 20 63 6f 73 74 6c 79 20 6c 65 is so costly le
5420: 74 73 20 70 69 67 67 79 62 61 63 6b 20 6f 6e 20 ts piggyback on
5430: 2d 74 65 73 74 2d 73 74 61 74 75 73 0a 09 28 61 -test-status..(a
5440: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
5450: 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 28 61 72 67 t-toplog")..(arg
5460: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
5470: 2d 73 74 61 74 75 73 22 29 0a 09 28 61 72 67 73 -status")..(args
5480: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 :get-arg "-set-v
5490: 61 6c 75 65 73 22 29 0a 09 28 61 72 67 73 3a 67 alues")..(args:g
54a0: 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d 74 65 et-arg "-load-te
54b0: 73 74 2d 64 61 74 61 22 29 0a 09 28 61 72 67 73 st-data")..(args
54c0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 :get-arg "-runst
54d0: 65 70 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d ep")..(args:get-
54e0: 61 72 67 20 22 2d 73 75 6d 6d 61 72 69 7a 65 2d arg "-summarize-
54f0: 69 74 65 6d 73 22 29 29 0a 20 20 20 20 28 69 66 items")). (if
5500: 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 4d (not (getenv "M
5510: 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 28 62 T_CMDINFO"))..(b
5520: 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 egin.. (debug:p
5530: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4d rint 0 "ERROR: M
5540: 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 T_CMDINFO env va
5550: 72 20 6e 6f 74 20 73 65 74 2c 20 63 6f 6d 6d 61 r not set, comma
5560: 6e 64 73 20 2d 74 65 73 74 2d 73 74 61 74 75 73 nds -test-status
5570: 2c 20 2d 72 75 6e 73 74 65 70 20 61 6e 64 20 2d , -runstep and -
5580: 73 65 74 6c 6f 67 20 6d 75 73 74 20 62 65 20 63 setlog must be c
5590: 61 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 alled *inside* a
55a0: 20 6d 65 67 61 74 65 73 74 20 65 6e 76 69 72 6f megatest enviro
55b0: 6e 6d 65 6e 74 21 22 29 0a 09 20 20 28 65 78 69 nment!").. (exi
55c0: 74 20 35 29 29 0a 09 28 6c 65 74 2a 20 28 28 73 t 5))..(let* ((s
55d0: 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 72 72 tartingdir (curr
55e0: 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a ent-directory)).
55f0: 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e 66 6f . (cmdinfo
5600: 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 (read (open-i
5610: 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 nput-string (bas
5620: 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 e64:base64-decod
5630: 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d e (getenv "MT_CM
5640: 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 20 DINFO")))))..
5650: 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 (testpath (
5660: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
5670: 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
5680: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
5690: 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 -name (assoc/def
56a0: 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 ault 'test-name
56b0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
56c0: 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 (runscript (as
56d0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
56e0: 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 script cmdinfo))
56f0: 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 .. (db-hos
5700: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
5710: 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d lt 'db-host cm
5720: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
5730: 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f (run-id (asso
5740: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 c/default 'run-i
5750: 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 d cmdinfo))..
5760: 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 (itemdat
5770: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
5780: 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 'itemdat cmdi
5790: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 nfo)).. (d
57a0: 62 20 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 b #f)..
57b0: 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 20 (state
57c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
57d0: 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 state"))..
57e0: 20 28 73 74 61 74 75 73 20 20 20 20 28 61 72 67 (status (arg
57f0: 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
5800: 75 73 22 29 29 29 0a 09 20 20 28 63 68 61 6e 67 us"))).. (chang
5810: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test
5820: 70 61 74 68 29 0a 09 20 20 28 69 66 20 28 6e 6f path).. (if (no
5830: 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e t (setup-for-run
5840: 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e )).. (begin
5850: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
5860: 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 0 "Failed to set
5870: 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 up, exiting")...
5880: 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 73 (exit 1))).. (s
5890: 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 et! db (open-db)
58a0: 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 ).. (if (args:g
58b0: 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d 74 65 et-arg "-load-te
58c0: 73 74 2d 64 61 74 61 22 29 0a 09 20 20 20 20 20 st-data")..
58d0: 20 28 64 62 3a 6c 6f 61 64 2d 74 65 73 74 2d 64 (db:load-test-d
58e0: 61 74 61 20 64 62 20 72 75 6e 2d 69 64 20 74 65 ata db run-id te
58f0: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 st-name itemdat)
5900: 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 ).. (if (args:g
5910: 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 et-arg "-setlog"
5920: 29 0a 09 20 20 20 20 20 20 28 74 65 73 74 2d 73 ).. (test-s
5930: 65 74 2d 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 et-log! db run-i
5940: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
5950: 64 61 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 dat (args:get-ar
5960: 67 20 22 2d 73 65 74 6c 6f 67 22 29 29 29 0a 09 g "-setlog")))..
5970: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
5980: 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 arg "-set-toplog
5990: 22 29 0a 09 20 20 20 20 20 20 28 74 65 73 74 2d ").. (test-
59a0: 73 65 74 2d 74 6f 70 6c 6f 67 21 20 64 62 20 72 set-toplog! db r
59b0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
59c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
59d0: 73 65 74 2d 74 6f 70 6c 6f 67 22 29 29 29 0a 09 set-toplog")))..
59e0: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
59f0: 61 72 67 20 22 2d 73 75 6d 6d 61 72 69 7a 65 2d arg "-summarize-
5a00: 69 74 65 6d 73 22 29 0a 09 20 20 20 20 20 20 28 items").. (
5a10: 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d tests:summarize-
5a20: 69 74 65 6d 73 20 64 62 20 72 75 6e 2d 69 64 20 items db run-id
5a30: 74 65 73 74 2d 6e 61 6d 65 20 23 74 29 29 20 3b test-name #t)) ;
5a40: 3b 20 64 6f 20 66 6f 72 63 65 20 68 65 72 65 0a ; do force here.
5a50: 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 . (if (args:get
5a60: 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 -arg "-runstep")
5a70: 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c .. (if (nul
5a80: 6c 3f 20 72 65 6d 61 72 67 73 29 0a 09 09 20 20 l? remargs)...
5a90: 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 64 65 (begin... (de
5aa0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
5ab0: 4f 52 3a 20 6e 6f 74 68 69 6e 67 20 73 70 65 63 OR: nothing spec
5ac0: 69 66 69 65 64 20 74 6f 20 72 75 6e 21 22 29 0a ified to run!").
5ad0: 09 09 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 .. (sqlite3:f
5ae0: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 20 inalize! db)...
5af0: 20 20 20 28 65 78 69 74 20 36 29 29 0a 09 09 20 (exit 6))...
5b00: 20 28 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 6d (let* ((stepnam
5b10: 65 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 e (args:get-ar
5b20: 67 20 22 2d 72 75 6e 73 74 65 70 22 29 29 0a 09 g "-runstep"))..
5b30: 09 09 20 28 6c 6f 67 70 72 6f 66 69 6c 65 20 28 .. (logprofile (
5b40: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
5b50: 6f 67 70 72 6f 22 29 29 0a 09 09 09 20 28 6c 6f ogpro")).... (lo
5b60: 67 66 69 6c 65 20 20 20 20 28 63 6f 6e 63 20 73 gfile (conc s
5b70: 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 29 tepname ".log"))
5b80: 0a 09 09 09 20 28 63 6d 64 20 20 20 20 20 20 20 .... (cmd
5b90: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 (if (null? rema
5ba0: 72 67 73 29 20 23 66 20 28 63 61 72 20 72 65 6d rgs) #f (car rem
5bb0: 61 72 67 73 29 29 29 0a 09 09 09 20 28 70 61 72 args))).... (par
5bc0: 61 6d 73 20 20 20 20 20 28 69 66 20 63 6d 64 20 ams (if cmd
5bd0: 28 63 64 72 20 72 65 6d 61 72 67 73 29 20 27 28 (cdr remargs) '(
5be0: 29 29 29 0a 09 09 09 20 28 65 78 69 74 73 74 61 ))).... (exitsta
5bf0: 74 20 20 20 23 66 29 0a 09 09 09 20 28 73 68 65 t #f).... (she
5c00: 6c 6c 20 20 20 20 20 20 28 6c 61 73 74 20 28 73 ll (last (s
5c10: 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 67 65 74 tring-split (get
5c20: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
5c30: 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 20 22 iable "SHELL") "
5c40: 2f 22 29 29 29 0a 09 09 09 20 28 72 65 64 69 72 /"))).... (redir
5c50: 20 20 20 20 20 20 28 63 61 73 65 20 28 73 74 72 (case (str
5c60: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 68 65 6c ing->symbol shel
5c70: 6c 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 l)..... ((
5c80: 74 63 73 68 20 63 73 68 20 6b 73 68 29 20 20 20 tcsh csh ksh)
5c90: 20 22 3e 26 22 29 0a 09 09 09 09 20 20 20 20 20 ">&").....
5ca0: 20 20 28 28 7a 73 68 20 62 61 73 68 20 73 68 20 ((zsh bash sh
5cb0: 61 73 68 29 20 22 32 3e 26 31 20 3e 22 29 29 29 ash) "2>&1 >")))
5cc0: 0a 09 09 09 20 28 66 75 6c 6c 63 6d 64 20 20 20 .... (fullcmd
5cd0: 20 28 63 6f 6e 63 20 22 28 22 20 28 73 74 72 69 (conc "(" (stri
5ce0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a ng-intersperse .
5cf0: 09 09 09 09 09 09 28 63 6f 6e 73 20 63 6d 64 20 ......(cons cmd
5d00: 70 61 72 61 6d 73 29 20 22 20 22 29 0a 09 09 09 params) " ")....
5d10: 09 09 20 20 20 22 29 20 22 20 72 65 64 69 72 20 .. ") " redir
5d20: 22 20 22 20 6c 6f 67 66 69 6c 65 29 29 29 0a 09 " " logfile)))..
5d30: 09 20 20 20 20 3b 3b 20 6d 61 72 6b 20 74 68 65 . ;; mark the
5d40: 20 73 74 61 72 74 20 6f 66 20 74 68 65 20 74 65 start of the te
5d50: 73 74 0a 09 09 20 20 20 20 28 74 65 73 74 73 74 st... (testst
5d60: 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 ep-set-status! d
5d70: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
5d80: 6d 65 20 73 74 65 70 6e 61 6d 65 20 22 73 74 61 me stepname "sta
5d90: 72 74 22 20 22 6e 2f 61 22 20 69 74 65 6d 64 61 rt" "n/a" itemda
5da0: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
5db0: 22 2d 6d 22 29 29 0a 09 09 20 20 20 20 3b 3b 20 "-m"))... ;;
5dc0: 63 6c 6f 73 65 20 74 68 65 20 64 62 0a 09 09 20 close the db...
5dd0: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 (sqlite3:fina
5de0: 6c 69 7a 65 21 20 64 62 29 0a 09 09 20 20 20 20 lize! db)...
5df0: 3b 3b 20 72 75 6e 20 74 68 65 20 74 65 73 74 20 ;; run the test
5e00: 73 74 65 70 0a 09 09 20 20 20 20 28 64 65 62 75 step... (debu
5e10: 67 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 4f 3a g:print 2 "INFO:
5e20: 20 52 75 6e 6e 69 6e 67 20 5c 22 22 20 66 75 6c Running \"" ful
5e30: 6c 63 6d 64 20 22 5c 22 22 29 0a 09 09 20 20 20 lcmd "\"")...
5e40: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
5e50: 72 79 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a ry startingdir).
5e60: 09 09 20 20 20 20 28 73 65 74 21 20 65 78 69 74 .. (set! exit
5e70: 73 74 61 74 20 28 73 79 73 74 65 6d 20 66 75 6c stat (system ful
5e80: 6c 63 6d 64 29 29 20 3b 3b 20 63 6d 64 20 70 61 lcmd)) ;; cmd pa
5e90: 72 61 6d 73 29 29 0a 09 09 20 20 20 20 28 73 65 rams))... (se
5ea0: 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 t! *globalexitst
5eb0: 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 0a atus* exitstat).
5ec0: 09 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 .. (change-di
5ed0: 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 rectory testpath
5ee0: 29 0a 09 09 20 20 20 20 3b 3b 20 72 65 2d 6f 70 )... ;; re-op
5ef0: 65 6e 20 74 68 65 20 64 62 0a 09 09 20 20 20 20 en the db...
5f00: 28 73 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 (set! db (open-d
5f10: 62 29 29 20 0a 09 09 20 20 20 20 3b 3b 20 72 75 b)) ... ;; ru
5f20: 6e 20 6c 6f 67 70 72 6f 20 69 66 20 61 70 70 6c n logpro if appl
5f30: 69 63 61 62 6c 65 20 3b 3b 20 28 70 72 6f 63 65 icable ;; (proce
5f40: 73 73 2d 72 75 6e 20 22 6c 73 22 20 28 6c 69 73 ss-run "ls" (lis
5f50: 74 20 22 2f 66 6f 6f 22 20 22 32 3e 26 31 22 20 t "/foo" "2>&1"
5f60: 22 62 6c 61 68 2e 6c 6f 67 22 29 29 0a 09 09 20 "blah.log"))...
5f70: 20 20 20 28 69 66 20 6c 6f 67 70 72 6f 66 69 6c (if logprofil
5f80: 65 0a 09 09 09 28 6c 65 74 2a 20 28 28 68 74 6d e....(let* ((htm
5f90: 6c 6c 6f 67 66 69 6c 65 20 28 63 6f 6e 63 20 73 llogfile (conc s
5fa0: 74 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 tepname ".html")
5fb0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 6f 6c 64 ).... (old
5fc0: 65 78 69 74 73 74 61 74 20 65 78 69 74 73 74 61 exitstat exitsta
5fd0: 74 29 0a 09 09 09 20 20 20 20 20 20 20 28 63 6d t).... (cm
5fe0: 64 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e d (strin
5ff0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6c g-intersperse (l
6000: 69 73 74 20 22 6c 6f 67 70 72 6f 22 20 6c 6f 67 ist "logpro" log
6010: 70 72 6f 66 69 6c 65 20 68 74 6d 6c 6c 6f 67 66 profile htmllogf
6020: 69 6c 65 20 22 3c 22 20 6c 6f 67 66 69 6c 65 20 ile "<" logfile
6030: 22 3e 22 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 ">" (conc stepna
6040: 6d 65 20 22 5f 6c 6f 67 70 72 6f 2e 6c 6f 67 22 me "_logpro.log"
6050: 29 29 20 22 20 22 29 29 29 0a 09 09 09 20 20 28 )) " "))).... (
6060: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 49 debug:print 2 "I
6070: 4e 46 4f 3a 20 72 75 6e 6e 69 6e 67 20 5c 22 22 NFO: running \""
6080: 20 63 6d 64 20 22 5c 22 22 29 0a 09 09 09 20 20 cmd "\"")....
6090: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
60a0: 79 20 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 y startingdir)..
60b0: 09 09 20 20 28 73 65 74 21 20 65 78 69 74 73 74 .. (set! exitst
60c0: 61 74 20 28 73 79 73 74 65 6d 20 63 6d 64 29 29 at (system cmd))
60d0: 0a 09 09 09 20 20 28 73 65 74 21 20 2a 67 6c 6f .... (set! *glo
60e0: 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 65 balexitstatus* e
60f0: 78 69 74 73 74 61 74 29 20 3b 3b 20 6e 6f 20 6e xitstat) ;; no n
6100: 65 63 65 73 73 61 72 79 0a 09 09 09 20 20 28 63 ecessary.... (c
6110: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
6120: 74 65 73 74 70 61 74 68 29 0a 09 09 09 20 20 28 testpath).... (
6130: 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 64 62 test-set-log! db
6140: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
6150: 65 20 69 74 65 6d 64 61 74 20 68 74 6d 6c 6c 6f e itemdat htmllo
6160: 67 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 28 gfile)))... (
6170: 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
6180: 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 tus! db run-id t
6190: 65 73 74 2d 6e 61 6d 65 20 73 74 65 70 6e 61 6d est-name stepnam
61a0: 65 20 22 65 6e 64 22 20 65 78 69 74 73 74 61 74 e "end" exitstat
61b0: 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67 itemdat (args:g
61c0: 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 et-arg "-m"))...
61d0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e (sqlite3:fin
61e0: 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 20 20 20 alize! db)...
61f0: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 65 (if (not (eq? e
6200: 78 69 74 73 74 61 74 20 30 29 29 0a 09 09 09 28 xitstat 0))....(
6210: 65 78 69 74 20 32 35 34 29 29 20 3b 3b 20 28 65 exit 254)) ;; (e
6220: 78 69 74 20 65 78 69 74 73 74 61 74 29 20 64 6f xit exitstat) do
6230: 65 73 6e 27 74 20 77 6f 72 6b 3f 21 3f 0a 09 09 esn't work?!?...
6240: 20 20 3b 3b 20 6f 70 65 6e 20 74 68 65 20 64 62 ;; open the db
6250: 0a 09 09 20 20 3b 3b 20 6d 61 72 6b 20 74 68 65 ... ;; mark the
6260: 20 65 6e 64 20 6f 66 20 74 68 65 20 74 65 73 74 end of the test
6270: 0a 09 09 20 20 29 29 29 0a 09 20 20 28 69 66 20 ... ))).. (if
6280: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
6290: 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 g "-test-status"
62a0: 29 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d )... (args:get-
62b0: 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 73 arg "-set-values
62c0: 22 29 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 ")).. (let
62d0: 28 28 6e 65 77 73 74 61 74 75 73 20 28 63 6f 6e ((newstatus (con
62e0: 64 0a 09 09 09 09 28 28 6e 75 6d 62 65 72 3f 20 d.....((number?
62f0: 73 74 61 74 75 73 29 20 20 20 20 20 20 20 28 69 status) (i
6300: 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 f (equal? status
6310: 20 30 29 20 22 50 41 53 53 22 20 22 46 41 49 4c 0) "PASS" "FAIL
6320: 22 29 29 0a 09 09 09 09 28 28 61 6e 64 20 28 73 ")).....((and (s
6330: 74 72 69 6e 67 3f 20 73 74 61 74 75 73 29 0a 09 tring? status)..
6340: 09 09 09 20 20 20 20 20 20 28 73 74 72 69 6e 67 ... (string
6350: 2d 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 73 29 ->number status)
6360: 29 28 69 66 20 28 65 71 75 61 6c 3f 20 28 73 74 )(if (equal? (st
6370: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 61 ring->number sta
6380: 74 75 73 29 20 30 29 20 22 50 41 53 53 22 20 22 tus) 0) "PASS" "
6390: 46 41 49 4c 22 29 29 0a 09 09 09 09 28 65 6c 73 FAIL")).....(els
63a0: 65 20 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 e status)))...
63b0: 20 20 3b 3b 20 74 72 61 6e 73 66 65 72 20 72 65 ;; transfer re
63c0: 6c 65 76 61 6e 74 20 6b 65 79 73 20 69 6e 74 6f levant keys into
63d0: 20 61 20 68 61 73 68 20 74 6f 20 62 65 20 70 61 a hash to be pa
63e0: 73 73 65 64 20 74 6f 20 74 65 73 74 2d 73 65 74 ssed to test-set
63f0: 2d 73 74 61 74 75 73 21 0a 09 09 20 20 20 20 3b -status!... ;
6400: 3b 20 63 6f 75 6c 64 20 75 73 65 20 61 6e 20 61 ; could use an a
6410: 73 73 6f 63 20 6c 69 73 74 20 49 20 67 75 65 73 ssoc list I gues
6420: 73 2e 20 0a 09 09 20 20 20 20 28 6f 74 68 65 72 s. ... (other
6430: 64 61 74 61 20 28 6c 65 74 20 28 28 72 65 73 20 data (let ((res
6440: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
6450: 29 29 29 0a 09 09 09 09 20 28 66 6f 72 2d 65 61 )))..... (for-ea
6460: 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 ch (lambda (key)
6470: 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 ...... (if (
6480: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 79 args:get-arg key
6490: 29 0a 09 09 09 09 09 09 20 28 68 61 73 68 2d 74 )....... (hash-t
64a0: 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 6b 65 able-set! res ke
64b0: 79 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 y (args:get-arg
64c0: 6b 65 79 29 29 29 29 0a 09 09 09 09 09 20 20 20 key))))......
64d0: 28 6c 69 73 74 20 22 3a 76 61 6c 75 65 22 20 22 (list ":value" "
64e0: 3a 74 6f 6c 22 20 22 3a 65 78 70 65 63 74 65 64 :tol" ":expected
64f0: 22 20 22 3a 66 69 72 73 74 5f 65 72 72 22 20 22 " ":first_err" "
6500: 3a 66 69 72 73 74 5f 77 61 72 6e 22 20 22 3a 75 :first_warn" ":u
6510: 6e 69 74 73 22 20 22 3a 63 61 74 65 67 6f 72 79 nits" ":category
6520: 22 20 22 3a 76 61 72 69 61 62 6c 65 22 29 29 0a " ":variable")).
6530: 09 09 09 09 20 72 65 73 29 29 29 0a 09 09 28 69 .... res)))...(i
6540: 66 20 28 61 6e 64 20 28 61 72 67 73 3a 67 65 74 f (and (args:get
6550: 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 -arg "-test-stat
6560: 75 73 22 29 0a 09 09 09 20 28 6f 72 20 28 6e 6f us").... (or (no
6570: 74 20 73 74 61 74 65 29 0a 09 09 09 20 20 20 20 t state)....
6580: 20 28 6e 6f 74 20 73 74 61 74 75 73 29 29 29 0a (not status))).
6590: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 .. (begin...
65a0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
65b0: 74 20 30 20 22 45 52 52 4f 52 3a 20 59 6f 75 20 t 0 "ERROR: You
65c0: 6d 75 73 74 20 73 70 65 63 69 66 79 20 3a 73 74 must specify :st
65d0: 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 20 ate and :status
65e0: 77 69 74 68 20 65 76 65 72 79 20 63 61 6c 6c 20 with every call
65f0: 74 6f 20 2d 74 65 73 74 2d 73 74 61 74 75 73 5c to -test-status\
6600: 6e 22 20 68 65 6c 70 29 0a 09 09 20 20 20 20 20 n" help)...
6610: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
6620: 7a 65 21 20 64 62 29 0a 09 09 20 20 20 20 20 20 ze! db)...
6630: 28 65 78 69 74 20 36 29 29 29 0a 09 09 28 74 65 (exit 6)))...(te
6640: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 st-set-status! d
6650: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
6660: 6d 65 20 73 74 61 74 65 20 6e 65 77 73 74 61 74 me state newstat
6670: 75 73 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 us itemdat (args
6680: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 6f :get-arg "-m") o
6690: 74 68 65 72 64 61 74 61 29 29 29 0a 09 20 20 28 therdata))).. (
66a0: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
66b0: 21 20 64 62 29 0a 09 20 20 28 73 65 74 21 20 2a ! db).. (set! *
66c0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
66d0: 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a ))))..(if (args:
66e0: 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 6b 65 get-arg "-showke
66f0: 79 73 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 ys"). (let ((
6700: 64 62 20 23 66 29 0a 09 20 20 28 6b 65 79 73 20 db #f).. (keys
6710: 23 66 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 #f)). (if (
6720: 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 not (setup-for-r
6730: 75 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 un)).. (begin..
6740: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6750: 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 0 "Failed to se
6760: 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 tup, exiting")..
6770: 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
6780: 20 20 20 20 20 28 73 65 74 21 20 64 62 20 28 6f (set! db (o
6790: 70 65 6e 2d 64 62 29 29 0a 20 20 20 20 20 20 28 pen-db)). (
67a0: 73 65 74 21 20 6b 65 79 73 20 28 64 62 2d 67 65 set! keys (db-ge
67b0: 74 2d 6b 65 79 73 20 64 62 29 29 0a 20 20 20 20 t-keys db)).
67c0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 (debug:print 1
67d0: 20 22 4b 65 79 73 3a 20 22 20 28 73 74 72 69 6e "Keys: " (strin
67e0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m
67f0: 61 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 ap key:get-field
6800: 6e 61 6d 65 20 6b 65 79 73 29 20 22 2c 20 22 29 name keys) ", ")
6810: 29 0a 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 ). (sqlite3
6820: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 20 :finalize! db).
6830: 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
6840: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
6850: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
6860: 72 67 20 22 2d 67 75 69 22 29 0a 20 20 20 20 28 rg "-gui"). (
6870: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 64 65 62 begin. (deb
6880: 75 67 3a 70 72 69 6e 74 20 30 20 22 4c 6f 6f 6b ug:print 0 "Look
6890: 20 61 74 20 74 68 65 20 64 61 73 68 62 6f 61 72 at the dashboar
68a0: 64 20 66 6f 72 20 6e 6f 77 22 29 0a 20 20 20 20 d for now").
68b0: 20 20 3b 3b 20 28 6d 65 67 61 74 65 73 74 2d 67 ;; (megatest-g
68c0: 75 69 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ui). (set!
68d0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
68e0: 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
68f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
6930: 3b 20 55 70 64 61 74 65 20 74 68 65 20 64 61 74 ; Update the dat
6940: 61 62 61 73 65 20 73 63 68 65 6d 61 20 6f 6e 20 abase schema on
6950: 72 65 71 75 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d request.;;======
6960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
69a0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
69b0: 61 72 67 20 22 2d 72 65 62 75 69 6c 64 2d 64 62 arg "-rebuild-db
69c0: 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
69d0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 (if (not (se
69e0: 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 tup-for-run))..
69f0: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 (begin.. (de
6a00: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 bug:print 0 "Fai
6a10: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
6a20: 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 iting") .. (e
6a30: 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 3b xit 1))). ;
6a40: 3b 20 6e 6f 77 20 63 61 6e 20 66 69 6e 64 20 6f ; now can find o
6a50: 75 72 20 64 62 0a 20 20 20 20 20 20 28 73 65 74 ur db. (set
6a60: 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a ! db (open-db)).
6a70: 20 20 20 20 20 20 28 70 61 74 63 68 2d 64 62 20 (patch-db
6a80: 64 62 29 0a 20 20 20 20 20 20 28 73 71 6c 69 74 db). (sqlit
6a90: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
6aa0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
6ab0: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
6ac0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
6ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 ===========.;; U
6b10: 70 64 61 74 65 20 74 68 65 20 74 65 73 74 73 20 pdate the tests
6b20: 6d 65 74 61 20 64 61 74 61 20 66 72 6f 6d 20 74 meta data from t
6b30: 68 65 20 74 65 73 74 63 6f 6e 66 69 67 20 66 69 he testconfig fi
6b40: 6c 65 73 0a 3b 3b 0a 0a 28 69 66 20 28 61 72 67 les.;;..(if (arg
6b50: 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 70 64 61 s:get-arg "-upda
6b60: 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 20 28 62 te-meta"). (b
6b70: 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 egin. (if (
6b80: 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 not (setup-for-r
6b90: 75 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 un)).. (begin..
6ba0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6bb0: 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 0 "Failed to se
6bc0: 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a tup, exiting") .
6bd0: 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a . (exit 1))).
6be0: 20 20 20 20 20 20 3b 3b 20 6e 6f 77 20 63 61 6e ;; now can
6bf0: 20 66 69 6e 64 20 6f 75 72 20 64 62 0a 20 20 20 find our db.
6c00: 20 20 20 28 73 65 74 21 20 64 62 20 28 6f 70 65 (set! db (ope
6c10: 6e 2d 64 62 29 29 0a 20 20 20 20 20 20 28 72 75 n-db)). (ru
6c20: 6e 73 3a 75 70 64 61 74 65 2d 61 6c 6c 2d 74 65 ns:update-all-te
6c30: 73 74 5f 6d 65 74 61 20 64 62 29 0a 20 20 20 20 st_meta db).
6c40: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
6c50: 69 7a 65 21 20 64 62 29 0a 20 20 20 20 20 20 28 ize! db). (
6c60: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
6c70: 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 ng* #t)))..(if (
6c80: 6e 6f 74 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e not *didsomethin
6c90: 67 2a 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 g*). (debug:p
6ca0: 72 69 6e 74 20 30 20 68 65 6c 70 29 29 0a 0a 28 rint 0 help))..(
6cb0: 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 2a 67 6c if (not (eq? *gl
6cc0: 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 obalexitstatus*
6cd0: 30 29 29 0a 20 20 20 20 28 69 66 20 28 6f 72 20 0)). (if (or
6ce0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6cf0: 72 75 6e 74 65 73 74 73 22 29 28 61 72 67 73 3a runtests")(args:
6d00: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c get-arg "-runall
6d10: 22 29 29 0a 20 20 20 20 20 20 20 20 28 62 65 67 ")). (beg
6d20: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 in. (d
6d30: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 4e 4f ebug:print 0 "NO
6d40: 54 45 3a 20 53 75 62 70 72 6f 63 65 73 73 65 73 TE: Subprocesses
6d50: 20 77 69 74 68 20 6e 6f 6e 2d 7a 65 72 6f 20 65 with non-zero e
6d60: 78 69 74 20 63 6f 64 65 20 64 65 74 65 63 74 65 xit code detecte
6d70: 64 3a 20 22 20 2a 67 6c 6f 62 61 6c 65 78 69 74 d: " *globalexit
6d80: 73 74 61 74 75 73 2a 29 0a 20 20 20 20 20 20 20 status*).
6d90: 20 20 20 20 28 65 78 69 74 20 30 29 29 0a 20 20 (exit 0)).
6da0: 20 20 20 20 20 20 28 63 61 73 65 20 2a 67 6c 6f (case *glo
6db0: 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 0a 20 balexitstatus*.
6dc0: 20 20 20 20 20 20 20 20 28 28 30 29 28 65 78 69 ((0)(exi
6dd0: 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 28 t 0)). (
6de0: 28 31 29 28 65 78 69 74 20 31 29 29 0a 20 20 20 (1)(exit 1)).
6df0: 20 20 20 20 20 20 28 28 32 29 28 65 78 69 74 20 ((2)(exit
6e00: 32 29 29 0a 20 20 20 20 20 20 20 20 20 28 65 6c 2)). (el
6e10: 73 65 20 28 65 78 69 74 20 33 29 29 29 29 29 0a se (exit 3))))).