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 3a 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 20 23 66 20 23 66 20 27 28 29 29 npatt #f #f '())
1fe0: 29 0a 09 20 20 20 28 72 75 6e 73 20 20 20 20 20 ).. (runs
1ff0: 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e (db:get-rows run
2000: 73 64 61 74 29 29 0a 09 20 20 20 28 68 65 61 64 sdat)).. (head
2010: 65 72 20 20 20 28 64 62 3a 67 65 74 2d 68 65 61 er (db:get-hea
2020: 64 65 72 20 72 75 6e 73 64 61 74 29 29 0a 09 20 der runsdat))..
2030: 20 20 28 6b 65 79 73 20 20 20 20 20 28 64 62 2d (keys (db-
2040: 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 get-keys db))..
2050: 20 20 28 6b 65 79 6e 61 6d 65 73 20 28 6d 61 70 (keynames (map
2060: 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 key:get-fieldna
2070: 6d 65 20 6b 65 79 73 29 29 29 0a 20 20 20 20 20 me keys))).
2080: 20 3b 3b 20 45 61 63 68 20 72 75 6e 0a 20 20 20 ;; Each run.
2090: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 (for-each .
20a0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 (lambda (ru
20b0: 6e 29 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e n).. (debug:prin
20c0: 74 20 32 20 22 52 75 6e 3a 20 22 0a 09 09 28 73 t 2 "Run: "...(s
20d0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
20e0: 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 e (map (lambda (
20f0: 78 29 0a 09 09 09 09 09 20 20 20 28 64 62 3a 67 x)...... (db:g
2100: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
2110: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 78 29 er run header x)
2120: 29 0a 09 09 09 09 09 20 6b 65 79 6e 61 6d 65 73 )...... keynames
2130: 29 20 22 2f 22 29 0a 09 09 22 2f 22 0a 09 09 28 ) "/")..."/"...(
2140: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
2150: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
2160: 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 20 r "runname"))..
2170: 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 28 64 (let ((run-id (d
2180: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
2190: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
21a0: 20 22 69 64 22 29 29 29 0a 09 20 20 20 28 6c 65 "id"))).. (le
21b0: 74 20 28 28 74 65 73 74 73 20 28 64 62 2d 67 65 t ((tests (db-ge
21c0: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
21d0: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 db run-id testpa
21e0: 74 74 20 69 74 65 6d 70 61 74 74 29 29 29 0a 09 tt itempatt)))..
21f0: 20 20 20 20 20 3b 3b 20 45 61 63 68 20 74 65 73 ;; Each tes
2200: 74 0a 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 t.. (for-eac
2210: 68 20 0a 09 20 20 20 20 20 20 28 6c 61 6d 62 64 h .. (lambd
2220: 61 20 28 74 65 73 74 29 0a 09 09 28 66 6f 72 6d a (test)...(form
2230: 61 74 20 23 74 0a 09 09 09 22 20 20 54 65 73 74 at #t...." Test
2240: 3a 20 7e 32 35 61 20 53 74 61 74 65 3a 20 7e 31 : ~25a State: ~1
2250: 35 61 20 53 74 61 74 75 73 3a 20 7e 31 35 61 20 5a Status: ~15a
2260: 52 75 6e 74 69 6d 65 3a 20 7e 35 40 61 73 20 54 Runtime: ~5@as T
2270: 69 6d 65 3a 20 7e 32 32 61 20 48 6f 73 74 3a 20 ime: ~22a Host:
2280: 7e 31 30 61 5c 6e 22 0a 09 09 09 28 63 6f 6e 63 ~10a\n"....(conc
2290: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 (db:test-get-te
22a0: 73 74 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 09 stname test)....
22b0: 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c (if (equal
22c0: 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 ? (db:test-get-i
22d0: 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 20 22 tem-path test) "
22e0: 22 29 0a 09 09 09 09 20 20 22 22 20 0a 09 09 09 ")..... "" ....
22f0: 09 20 20 28 63 6f 6e 63 20 22 28 22 20 28 64 62 . (conc "(" (db
2300: 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 :test-get-item-p
2310: 61 74 68 20 74 65 73 74 29 20 22 29 22 29 29 29 ath test) ")")))
2320: 0a 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65 74 ....(db:test-get
2330: 2d 73 74 61 74 65 20 74 65 73 74 29 0a 09 09 09 -state test)....
2340: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
2350: 74 75 73 20 74 65 73 74 29 0a 09 09 09 28 64 62 tus test)....(db
2360: 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 :test-get-run_du
2370: 72 61 74 69 6f 6e 20 74 65 73 74 29 0a 09 09 09 ration test)....
2380: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 (db:test-get-eve
2390: 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 0a 09 09 nt_time test)...
23a0: 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f .(db:test-get-ho
23b0: 73 74 20 74 65 73 74 29 29 0a 20 09 09 28 69 66 st test)). ..(if
23c0: 20 28 6e 6f 74 20 28 6f 72 20 28 65 71 75 61 6c (not (or (equal
23d0: 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ? (db:test-get-s
23e0: 74 61 74 75 73 20 74 65 73 74 29 20 22 50 41 53 tatus test) "PAS
23f0: 53 22 29 0a 09 09 09 20 20 20 20 20 28 65 71 75 S").... (equ
2400: 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 al? (db:test-get
2410: 2d 73 74 61 74 75 73 20 74 65 73 74 29 20 22 57 -status test) "W
2420: 41 52 4e 22 29 0a 09 09 09 20 20 20 20 20 28 65 ARN").... (e
2430: 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 qual? (db:test-g
2440: 65 74 2d 73 74 61 74 65 20 74 65 73 74 29 20 20 et-state test)
2450: 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 29 29 "NOT_STARTED")))
2460: 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ... (begin...
2470: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 20 20 (print "
2480: 20 20 20 20 20 20 20 63 70 75 6c 6f 61 64 3a 20 cpuload:
2490: 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d " (db:test-get-
24a0: 63 70 75 6c 6f 61 64 20 74 65 73 74 29 0a 09 09 cpuload test)...
24b0: 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 20 20 . "\n
24c0: 20 20 64 69 73 6b 66 72 65 65 3a 20 22 20 28 64 diskfree: " (d
24d0: 62 3a 74 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 b:test-get-diskf
24e0: 72 65 65 20 74 65 73 74 29 0a 09 09 09 20 20 20 ree test)....
24f0: 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 75 6e "\n un
2500: 61 6d 65 3a 20 20 20 20 22 20 28 64 62 3a 74 65 ame: " (db:te
2510: 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 74 65 73 st-get-uname tes
2520: 74 29 0a 09 09 09 20 20 20 20 20 22 5c 6e 20 20 t).... "\n
2530: 20 20 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 rundir:
2540: 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d " (db:test-get-
2550: 72 75 6e 64 69 72 20 74 65 73 74 29 0a 09 09 09 rundir test)....
2560: 20 20 20 20 20 29 0a 09 09 20 20 20 20 20 20 3b )... ;
2570: 3b 20 45 61 63 68 20 74 65 73 74 0a 09 09 20 20 ; Each test...
2580: 20 20 20 20 28 6c 65 74 20 28 28 73 74 65 70 73 (let ((steps
2590: 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 (db:get-steps-f
25a0: 6f 72 2d 74 65 73 74 20 64 62 20 28 64 62 3a 74 or-test db (db:t
25b0: 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 29 est-get-id test)
25c0: 29 29 29 0a 09 09 09 28 66 6f 72 2d 65 61 63 68 )))....(for-each
25d0: 20 0a 09 09 09 20 28 6c 61 6d 62 64 61 20 28 73 .... (lambda (s
25e0: 74 65 70 29 0a 09 09 09 20 20 20 28 66 6f 72 6d tep).... (form
25f0: 61 74 20 23 74 20 0a 09 09 09 09 20 20 20 22 20 at #t ..... "
2600: 20 20 20 53 74 65 70 3a 20 7e 32 30 61 20 53 74 Step: ~20a St
2610: 61 74 65 3a 20 7e 31 30 61 20 53 74 61 74 75 73 ate: ~10a Status
2620: 3a 20 7e 31 30 61 20 54 69 6d 65 20 7e 32 32 61 : ~10a Time ~22a
2630: 5c 6e 22 0a 09 09 09 09 20 20 20 28 64 62 3a 73 \n"..... (db:s
2640: 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
2650: 20 73 74 65 70 29 0a 09 09 09 09 20 20 20 28 64 step)..... (d
2660: 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 b:step-get-state
2670: 20 73 74 65 70 29 0a 09 09 09 09 20 20 20 28 64 step)..... (d
2680: 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 b:step-get-statu
2690: 73 20 73 74 65 70 29 0a 09 09 09 09 20 20 20 28 s step)..... (
26a0: 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e db:step-get-even
26b0: 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 0a 09 t_time step)))..
26c0: 09 09 20 73 74 65 70 73 29 29 29 29 29 0a 09 09 .. steps)))))...
26d0: 74 65 73 74 73 29 29 29 29 0a 20 20 20 20 20 20 tests)))).
26e0: 20 72 75 6e 73 29 0a 20 20 20 20 20 20 28 73 65 runs). (se
26f0: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
2700: 2a 20 23 74 29 0a 20 20 20 20 20 20 29 29 0a 0a * #t). ))..
2710: 3b 3b 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 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c ========.;; full
2760: 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;=========
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 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
27b0: 3b 20 67 65 74 20 6c 6f 63 6b 20 69 6e 20 64 62 ; get lock in db
27c0: 20 66 6f 72 20 66 75 6c 6c 20 72 75 6e 20 66 6f for full run fo
27d0: 72 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 r this directory
27e0: 0a 3b 3b 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 .;; for all test
27f0: 73 20 77 69 74 68 20 64 65 70 73 0a 3b 3b 20 20 s with deps.;;
2800: 20 77 61 6c 6b 20 74 72 65 65 20 6f 66 20 74 65 walk tree of te
2810: 73 74 73 20 74 6f 20 66 69 6e 64 20 68 65 61 64 sts to find head
2820: 20 74 61 73 6b 73 0a 3b 3b 20 20 20 61 64 64 20 tasks.;; add
2830: 68 65 61 64 20 74 61 73 6b 73 20 74 6f 20 74 61 head tasks to ta
2840: 73 6b 20 71 75 65 75 65 0a 3b 3b 20 20 20 61 64 sk queue.;; ad
2850: 64 20 64 65 70 65 6e 64 61 6e 74 20 74 61 73 6b d dependant task
2860: 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 20 s to task queue
2870: 0a 3b 3b 20 20 20 61 64 64 20 72 65 6d 61 69 6e .;; add remain
2880: 69 6e 67 20 74 61 73 6b 73 20 74 6f 20 74 61 73 ing tasks to tas
2890: 6b 20 71 75 65 75 65 0a 3b 3b 20 66 6f 72 20 65 k queue.;; for e
28a0: 61 63 68 20 74 61 73 6b 20 69 6e 20 74 61 73 6b ach task in task
28b0: 20 71 75 65 75 65 0a 3b 3b 20 20 20 69 66 20 68 queue.;; if h
28c0: 61 76 65 20 61 64 65 71 75 61 74 65 20 72 65 73 ave adequate res
28d0: 6f 75 72 63 65 73 0a 3b 3b 20 20 20 20 20 6c 61 ources.;; la
28e0: 75 6e 63 68 20 74 61 73 6b 0a 3b 3b 20 20 20 65 unch task.;; e
28f0: 6c 73 65 0a 3b 3b 20 20 20 20 20 70 75 74 20 74 lse.;; put t
2900: 61 73 6b 20 69 6e 20 64 65 66 65 72 72 65 64 20 ask in deferred
2910: 71 75 65 75 65 0a 3b 3b 20 69 66 20 73 74 69 6c queue.;; if stil
2920: 6c 20 6f 6b 20 74 6f 20 72 75 6e 20 74 61 73 6b l ok to run task
2930: 73 0a 3b 3b 20 20 20 70 72 6f 63 65 73 73 20 64 s.;; process d
2940: 65 66 65 72 72 65 64 20 74 61 73 6b 73 20 70 65 eferred tasks pe
2950: 72 20 61 62 6f 76 65 20 73 74 65 70 73 0a 0a 3b r above steps..;
2960: 3b 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 ; run all tests
2970: 61 72 65 20 61 72 65 20 4e 6f 74 20 43 4f 4d 50 are are Not COMP
2980: 4c 45 54 45 44 20 61 6e 64 20 50 41 53 53 20 6f LETED and PASS o
2990: 72 20 43 48 45 43 4b 0a 28 69 66 20 28 61 72 67 r CHECK.(if (arg
29a0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 s:get-arg "-runa
29b0: 6c 6c 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 ll"). (genera
29c0: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 l-run-call .
29d0: 20 22 2d 72 75 6e 61 6c 6c 22 0a 20 20 20 20 20 "-runall".
29e0: 22 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 22 0a "run all tests".
29f0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 64 62 (lambda (db
2a00: 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b keys keynames k
2a10: 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 20 20 eyvallst).
2a20: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 6e 61 (let* ((test-na
2a30: 6d 65 73 20 28 67 65 74 2d 61 6c 6c 2d 6c 65 67 mes (get-all-leg
2a40: 61 6c 2d 74 65 73 74 73 29 29 29 20 3b 3b 20 22 al-tests))) ;; "
2a50: 50 52 4f 44 22 20 69 73 20 69 67 6e 6f 72 65 64 PROD" is ignored
2a60: 20 66 6f 72 20 6e 6f 77 0a 09 20 28 64 65 62 75 for now.. (debu
2a70: 67 3a 70 72 69 6e 74 20 31 20 22 49 4e 46 4f 3a g:print 1 "INFO:
2a80: 20 41 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 73 Attempting to s
2a90: 74 61 72 74 20 74 68 65 20 66 6f 6c 6c 6f 77 69 tart the followi
2aa0: 6e 67 20 74 65 73 74 73 2e 2e 2e 22 29 0a 09 20 ng tests...")..
2ab0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 (debug:print 1 "
2ac0: 20 20 20 20 20 22 20 28 73 74 72 69 6e 67 2d 69 " (string-i
2ad0: 6e 74 65 72 73 70 65 72 73 65 20 74 65 73 74 2d ntersperse test-
2ae0: 6e 61 6d 65 73 20 22 2c 22 29 29 0a 09 20 28 72 names ",")).. (r
2af0: 75 6e 2d 74 65 73 74 73 20 64 62 20 74 65 73 74 un-tests db test
2b00: 2d 6e 61 6d 65 73 29 29 29 29 29 0a 0a 3b 3b 3d -names)))))..;;=
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 3d ================
2b50: 3d 3d 3d 3d 3d 0a 3b 3b 20 52 6f 6c 6c 75 70 20 =====.;; Rollup
2b60: 69 6e 74 6f 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d into a 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 3d 3d 3d ================
2bb0: 3d 3d 3d 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ===.(if (args:ge
2bc0: 74 2d 61 72 67 20 22 2d 72 6f 6c 6c 75 70 22 29 t-arg "-rollup")
2bd0: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
2be0: 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 n-call . "-r
2bf0: 6f 6c 6c 75 70 22 20 0a 20 20 20 20 20 22 72 6f ollup" . "ro
2c00: 6c 6c 75 70 20 74 65 73 74 73 22 20 0a 20 20 20 llup tests" .
2c10: 20 20 28 6c 61 6d 62 64 61 20 28 64 62 20 6b 65 (lambda (db ke
2c20: 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 ys keynames keyv
2c30: 61 6c 6c 73 74 29 0a 20 20 20 20 20 20 20 28 72 allst). (r
2c40: 75 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 64 uns:rollup-run d
2c50: 62 20 6b 65 79 73 29 29 29 29 0a 0a 3b 3b 3d 3d b keys))))..;;==
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 3d 3d ================
2ca0: 3d 3d 3d 3d 0a 3b 3b 20 45 78 74 72 61 63 74 20 ====.;; Extract
2cb0: 61 20 73 70 72 65 61 64 73 68 65 65 74 20 66 72 a spreadsheet fr
2cc0: 6f 6d 20 74 68 65 20 72 75 6e 73 20 64 61 74 61 om the runs data
2cd0: 62 61 73 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d base.;;=========
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 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
2d20: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
2d30: 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 "-extract-ods")
2d40: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
2d50: 6e 2d 63 61 6c 6c 0a 20 20 20 20 20 22 2d 65 78 n-call. "-ex
2d60: 74 72 61 63 74 2d 6f 64 73 22 0a 20 20 20 20 20 tract-ods".
2d70: 22 4d 61 6b 65 20 6f 64 73 20 73 70 72 65 61 64 "Make ods spread
2d80: 73 68 65 65 74 22 0a 20 20 20 20 20 28 6c 61 6d sheet". (lam
2d90: 62 64 61 20 28 64 62 20 6b 65 79 73 20 6b 65 79 bda (db keys key
2da0: 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 names keyvallst)
2db0: 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6f . (let ((o
2dc0: 75 74 70 75 74 66 69 6c 65 20 28 61 72 67 73 3a utputfile (args:
2dd0: 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 61 63 get-arg "-extrac
2de0: 74 2d 6f 64 73 22 29 29 0a 09 20 20 20 20 20 28 t-ods")).. (
2df0: 72 75 6e 73 70 61 74 74 20 20 20 28 61 72 67 73 runspatt (args
2e00: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
2e10: 6d 65 22 29 29 0a 09 20 20 20 20 20 28 6b 65 79 me")).. (key
2e20: 76 61 6c 61 6c 69 73 74 20 28 6b 65 79 73 2d 3e valalist (keys->
2e30: 61 6c 69 73 74 20 6b 65 79 73 20 22 25 22 29 29 alist keys "%"))
2e40: 29 0a 09 20 28 64 62 3a 65 78 74 72 61 63 74 2d ).. (db:extract-
2e50: 6f 64 73 2d 66 69 6c 65 20 64 62 20 6f 75 74 70 ods-file db outp
2e60: 75 74 66 69 6c 65 20 6b 65 79 76 61 6c 61 6c 69 utfile keyvalali
2e70: 73 74 20 28 69 66 20 72 75 6e 73 70 61 74 74 20 st (if runspatt
2e80: 72 75 6e 73 70 61 74 74 20 22 25 22 29 29 29 29 runspatt "%"))))
2e90: 29 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
2ee0: 72 75 6e 20 6f 6e 65 20 74 65 73 74 0a 3b 3b 3d run one 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 3d ================
2f30: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e 20 66 69 6e =====..;; 1. fin
2f40: 64 20 74 68 65 20 63 6f 6e 66 69 67 20 66 69 6c d the config fil
2f50: 65 0a 3b 3b 20 32 2e 20 63 68 61 6e 67 65 20 74 e.;; 2. change t
2f60: 6f 20 74 68 65 20 74 65 73 74 20 64 69 72 65 63 o the test direc
2f70: 74 6f 72 79 0a 3b 3b 20 33 2e 20 75 70 64 61 74 tory.;; 3. updat
2f80: 65 20 74 68 65 20 64 62 20 77 69 74 68 20 22 74 e the db with "t
2f90: 65 73 74 20 73 74 61 72 74 65 64 22 20 73 74 61 est started" sta
2fa0: 74 75 73 2c 20 73 65 74 20 72 75 6e 6e 69 6e 67 tus, set running
2fb0: 20 68 6f 73 74 0a 3b 3b 20 34 2e 20 70 72 6f 63 host.;; 4. proc
2fc0: 65 73 73 20 6c 61 75 6e 63 68 20 74 68 65 20 74 ess launch the t
2fd0: 65 73 74 0a 3b 3b 20 20 20 20 2d 20 6d 6f 6e 69 est.;; - moni
2fe0: 74 6f 72 20 74 68 65 20 70 72 6f 63 65 73 73 2c tor the process,
2ff0: 20 75 70 64 61 74 65 20 73 74 61 74 73 20 69 6e update stats in
3000: 20 74 68 65 20 64 62 20 65 76 65 72 79 20 32 5e the db every 2^
3010: 6e 20 6d 69 6e 75 74 65 73 0a 3b 3b 20 35 2e 20 n minutes.;; 5.
3020: 61 73 20 74 68 65 20 74 65 73 74 20 70 72 6f 63 as the test proc
3030: 65 65 64 73 20 69 6e 74 65 72 6e 61 6c 6c 79 20 eeds internally
3040: 69 74 20 63 61 6c 6c 73 20 6d 65 67 61 74 65 73 it calls megates
3050: 74 20 61 73 20 65 61 63 68 20 73 74 65 70 20 69 t as each step i
3060: 73 0a 3b 3b 20 20 20 20 73 74 61 72 74 65 64 20 s.;; started
3070: 61 6e 64 20 63 6f 6d 70 6c 65 74 65 64 0a 3b 3b and completed.;;
3080: 20 20 20 20 2d 20 73 74 65 70 20 73 74 61 72 74 - step start
3090: 65 64 2c 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b ed, timestamp.;;
30a0: 20 20 20 20 2d 20 73 74 65 70 20 63 6f 6d 70 6c - step compl
30b0: 65 74 65 64 2c 20 65 78 69 74 20 73 74 61 74 75 eted, exit statu
30c0: 73 2c 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 s, timestamp.;;
30d0: 36 2e 20 74 65 73 74 20 70 68 6f 6e 65 20 68 6f 6. test phone ho
30e0: 6d 65 0a 3b 3b 20 20 20 20 2d 20 69 66 20 74 65 me.;; - if te
30f0: 73 74 20 72 75 6e 20 74 69 6d 65 20 3e 20 61 6c st run time > al
3100: 6c 6f 77 65 64 20 72 75 6e 20 74 69 6d 65 20 74 lowed run time t
3110: 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 hen kill job.;;
3120: 20 20 20 2d 20 69 66 20 63 61 6e 6e 6f 74 20 61 - if cannot a
3130: 63 63 65 73 73 20 64 62 20 3e 20 61 6c 6c 6f 77 ccess db > allow
3140: 65 64 20 64 69 73 63 6f 6e 6e 65 63 74 20 74 69 ed disconnect ti
3150: 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 me then kill job
3160: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
3170: 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
3180: 0a 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d . (general-run-
3190: 63 61 6c 6c 20 0a 20 20 20 22 2d 72 75 6e 74 65 call . "-runte
31a0: 73 74 73 22 20 0a 20 20 20 22 72 75 6e 20 61 20 sts" . "run a
31b0: 74 65 73 74 22 20 0a 20 20 20 28 6c 61 6d 62 64 test" . (lambd
31c0: 61 20 28 64 62 20 6b 65 79 73 20 6b 65 79 6e 61 a (db keys keyna
31d0: 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 mes keyvallst).
31e0: 20 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 2d (let ((test-
31f0: 6e 61 6d 65 73 20 28 73 74 72 69 6e 67 2d 73 70 names (string-sp
3200: 6c 69 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 lit (args:get-ar
3210: 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 20 22 g "-runtests") "
3220: 2c 22 29 29 29 0a 20 20 20 20 20 20 20 28 72 75 ,"))). (ru
3230: 6e 2d 74 65 73 74 73 20 64 62 20 74 65 73 74 2d n-tests db test-
3240: 6e 61 6d 65 73 29 29 29 29 29 0a 0a 3b 3b 3d 3d names)))))..;;==
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 3d 3d ================
3290: 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 63 75 74 65 20 ====.;; execute
32a0: 74 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d the test.;; -
32b0: 20 67 65 74 73 20 63 61 6c 6c 65 64 20 6f 6e 20 gets called on
32c0: 72 65 6d 6f 74 65 20 68 6f 73 74 0a 3b 3b 20 20 remote host.;;
32d0: 20 20 2d 20 72 65 63 65 69 76 65 73 20 69 6e 66 - receives inf
32e0: 6f 20 66 72 6f 6d 20 74 68 65 20 2d 65 78 65 63 o from the -exec
32f0: 75 74 65 20 70 61 72 61 6d 0a 3b 3b 20 20 20 20 ute param.;;
3300: 2d 20 70 61 73 73 65 73 20 69 6e 66 6f 20 74 6f - passes info to
3310: 20 73 74 65 70 73 20 76 69 61 20 4d 54 5f 43 4d steps via MT_CM
3320: 44 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 28 66 DINFO env var (f
3330: 75 74 75 72 65 20 69 73 20 74 6f 20 75 73 65 20 uture is to use
3340: 61 20 64 6f 74 20 66 69 6c 65 29 0a 3b 3b 20 20 a dot file).;;
3350: 20 20 2d 20 67 61 74 68 65 72 73 20 68 6f 73 74 - gathers host
3360: 20 69 6e 66 6f 20 61 6e 64 20 0a 3b 3b 3d 3d 3d info 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 3d 3d 3d ================
33b0: 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
33c0: 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 65 et-arg "-execute
33d0: 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 63 "). (let* ((c
33e0: 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 mdinfo (read (
33f0: 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e open-input-strin
3400: 67 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 g (base64:base64
3410: 2d 64 65 63 6f 64 65 20 28 61 72 67 73 3a 67 65 -decode (args:ge
3420: 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 t-arg "-execute"
3430: 29 29 29 29 29 29 0a 20 20 20 20 20 20 28 73 65 )))))). (se
3440: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
3450: 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 " (args:get-arg
3460: 22 2d 65 78 65 63 75 74 65 22 29 29 0a 20 20 20 "-execute")).
3470: 20 20 20 28 69 66 20 28 6c 69 73 74 3f 20 63 6d (if (list? cm
3480: 64 69 6e 66 6f 29 20 3b 3b 20 28 28 74 65 73 74 dinfo) ;; ((test
3490: 70 61 74 68 20 2f 74 6d 70 2f 6d 72 77 65 6c 6c path /tmp/mrwell
34a0: 61 6e 2f 6a 61 7a 7a 6d 69 6e 64 2f 73 72 63 2f an/jazzmind/src/
34b0: 65 78 61 6d 70 6c 65 5f 72 75 6e 2f 74 65 73 74 example_run/test
34c0: 73 2f 73 71 6c 69 74 65 73 70 65 65 64 29 20 28 s/sqlitespeed) (
34d0: 74 65 73 74 2d 6e 61 6d 65 20 73 71 6c 69 74 65 test-name sqlite
34e0: 73 70 65 65 64 29 20 28 72 75 6e 73 63 72 69 70 speed) (runscrip
34f0: 74 20 72 75 6e 73 63 72 69 70 74 2e 72 62 29 20 t runscript.rb)
3500: 28 64 62 2d 68 6f 73 74 20 6c 6f 63 61 6c 68 6f (db-host localho
3510: 73 74 29 20 28 72 75 6e 2d 69 64 20 31 29 29 0a st) (run-id 1)).
3520: 09 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 70 . (let* ((testp
3530: 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
3540: 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
3550: 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 77 6f 72 mdinfo))... (wor
3560: 6b 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 65 k-area (assoc/de
3570: 66 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 fault 'work-area
3580: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 74 cmdinfo))... (t
3590: 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f est-name (assoc/
35a0: 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 default 'test-na
35b0: 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 me cmdinfo))...
35c0: 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f (runscript (asso
35d0: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 c/default 'runsc
35e0: 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 ript cmdinfo))..
35f0: 09 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 . (db-host (as
3600: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d soc/default 'db-
3610: 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 host cmdinfo))
3620: 0a 09 09 20 28 72 75 6e 2d 69 64 20 20 20 20 28 ... (run-id (
3630: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
3640: 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f un-id cmdinfo
3650: 29 29 0a 09 09 20 28 69 74 65 6d 64 61 74 20 20 ))... (itemdat
3660: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
3670: 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 'itemdat cmdin
3680: 66 6f 29 29 0a 09 09 20 28 65 6e 76 2d 6f 76 72 fo))... (env-ovr
3690: 64 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c d (assoc/defaul
36a0: 74 20 27 65 6e 76 2d 6f 76 72 64 20 20 63 6d 64 t 'env-ovrd cmd
36b0: 69 6e 66 6f 29 29 0a 09 09 20 28 72 75 6e 6e 61 info))... (runna
36c0: 6d 65 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 me (assoc/defa
36d0: 75 6c 74 20 27 72 75 6e 6e 61 6d 65 20 20 20 63 ult 'runname c
36e0: 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 6d 65 67 mdinfo))... (meg
36f0: 61 74 65 73 74 20 20 28 61 73 73 6f 63 2f 64 65 atest (assoc/de
3700: 66 61 75 6c 74 20 27 6d 65 67 61 74 65 73 74 20 fault 'megatest
3710: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 6d cmdinfo))... (m
3720: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 61 t-bindir-path (a
3730: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d 74 ssoc/default 'mt
3740: 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 63 6d 64 -bindir-path cmd
3750: 69 6e 66 6f 29 29 0a 09 09 20 28 66 75 6c 6c 72 info))... (fullr
3760: 75 6e 73 63 72 69 70 74 20 28 63 6f 6e 63 20 74 unscript (conc t
3770: 65 73 74 70 61 74 68 20 22 2f 22 20 72 75 6e 73 estpath "/" runs
3780: 63 72 69 70 74 29 29 0a 09 09 20 28 64 62 20 20 cript))... (db
3790: 20 20 20 20 20 20 23 66 29 29 0a 09 20 20 20 20 #f))..
37a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
37b0: 45 78 65 63 74 75 69 6e 67 20 22 20 74 65 73 74 Exectuing " test
37c0: 2d 6e 61 6d 65 20 22 20 6f 6e 20 22 20 28 67 65 -name " on " (ge
37d0: 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 0a 09 20 t-host-name))..
37e0: 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 (change-direc
37f0: 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
3800: 20 20 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f (setenv "MT_
3810: 54 45 53 54 5f 52 55 4e 5f 44 49 52 22 20 77 6f TEST_RUN_DIR" wo
3820: 72 6b 2d 61 72 65 61 29 0a 09 20 20 20 20 28 73 rk-area).. (s
3830: 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 5f 4e etenv "MT_TEST_N
3840: 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 0a AME" test-name).
3850: 09 20 20 20 20 28 73 65 74 65 6e 76 20 22 4d 54 . (setenv "MT
3860: 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e _ITEM_INFO" (con
3870: 63 20 69 74 65 6d 64 61 74 29 29 0a 09 20 20 20 c itemdat))..
3880: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e (setenv "MT_RUN
3890: 4e 41 4d 45 22 20 20 20 72 75 6e 6e 61 6d 65 29 NAME" runname)
38a0: 0a 09 20 20 20 20 28 73 65 74 65 6e 76 20 22 4d .. (setenv "M
38b0: 54 5f 4d 45 47 41 54 45 53 54 22 20 20 6d 65 67 T_MEGATEST" meg
38c0: 61 74 65 73 74 29 0a 09 20 20 20 20 28 69 66 20 atest).. (if
38d0: 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 mt-bindir-path (
38e0: 73 65 74 65 6e 76 20 22 50 41 54 48 22 20 28 63 setenv "PATH" (c
38f0: 6f 6e 63 20 28 67 65 74 65 6e 76 20 22 50 41 54 onc (getenv "PAT
3900: 48 22 29 20 22 3a 22 20 6d 74 2d 62 69 6e 64 69 H") ":" mt-bindi
3910: 72 2d 70 61 74 68 29 29 29 0a 09 20 20 20 20 0a r-path))).. .
3920: 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 73 . (if (not (s
3930: 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 etup-for-run))..
3940: 09 28 62 65 67 69 6e 0a 09 09 20 20 28 64 65 62 .(begin... (deb
3950: 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c ug:print 0 "Fail
3960: 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
3970: 74 69 6e 67 22 29 20 0a 09 09 20 20 28 65 78 69 ting") ... (exi
3980: 74 20 31 29 29 29 0a 09 20 20 20 20 3b 3b 20 6e t 1))).. ;; n
3990: 6f 77 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 ow can find our
39a0: 64 62 0a 09 20 20 20 20 28 73 65 74 21 20 64 62 db.. (set! db
39b0: 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 (open-db))..
39c0: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
39d0: 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 0a 09 ry work-area) ..
39e0: 20 20 20 20 28 73 65 74 2d 72 75 6e 2d 63 6f 6e (set-run-con
39f0: 66 69 67 2d 76 61 72 73 20 64 62 20 72 75 6e 2d fig-vars db run-
3a00: 69 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 id).
3a10: 3b 3b 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 6f ;; environment o
3a20: 76 65 72 72 69 64 65 73 20 61 72 65 20 64 6f 6e verrides are don
3a30: 65 20 2a 62 65 66 6f 72 65 2a 20 74 68 65 20 72 e *before* the r
3a40: 65 6d 61 69 6e 69 6e 67 20 63 72 69 74 69 63 61 emaining critica
3a50: 6c 20 65 6e 76 61 72 73 2e 0a 20 20 20 20 20 20 l envars..
3a60: 20 20 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e (alist->en
3a70: 76 2d 76 61 72 73 20 65 6e 76 2d 6f 76 72 64 29 v-vars env-ovrd)
3a80: 0a 09 20 20 20 20 28 73 65 74 2d 6d 65 67 61 74 .. (set-megat
3a90: 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 64 62 20 est-env-vars db
3aa0: 72 75 6e 2d 69 64 29 0a 09 20 20 20 20 28 73 65 run-id).. (se
3ab0: 74 2d 69 74 65 6d 2d 65 6e 76 2d 76 61 72 73 20 t-item-env-vars
3ac0: 69 74 65 6d 64 61 74 29 0a 20 20 20 20 20 20 20 itemdat).
3ad0: 20 20 20 20 20 28 73 61 76 65 2d 65 6e 76 69 72 (save-envir
3ae0: 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 onment-as-files
3af0: 22 6d 65 67 61 74 65 73 74 22 29 0a 09 20 20 20 "megatest")..
3b00: 20 28 74 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d (test-set-meta-
3b10: 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 20 74 info db run-id t
3b20: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 est-name itemdat
3b30: 29 0a 09 20 20 20 20 28 74 65 73 74 2d 73 65 74 ).. (test-set
3b40: 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 6e 2d -status! db run-
3b50: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 22 52 45 id test-name "RE
3b60: 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 20 22 MOTEHOSTSTART" "
3b70: 6e 2f 61 22 20 69 74 65 6d 64 61 74 20 28 61 72 n/a" itemdat (ar
3b80: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
3b90: 20 23 66 29 0a 09 20 20 20 20 28 69 66 20 28 61 #f).. (if (a
3ba0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 78 74 rgs:get-arg "-xt
3bb0: 65 72 6d 22 29 0a 09 09 28 73 65 74 21 20 66 75 erm")...(set! fu
3bc0: 6c 6c 72 75 6e 73 63 72 69 70 74 20 22 78 74 65 llrunscript "xte
3bd0: 72 6d 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 rm").
3be0: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 (if (not (f
3bf0: 69 6c 65 2d 65 78 65 63 75 74 65 2d 61 63 63 65 ile-execute-acce
3c00: 73 73 3f 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 ss? fullrunscrip
3c10: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
3c20: 20 20 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 (system
3c30: 28 63 6f 6e 63 20 22 63 68 6d 6f 64 20 75 67 2b (conc "chmod ug+
3c40: 78 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 x " fullrunscrip
3c50: 74 29 29 29 29 0a 09 20 20 20 20 3b 3b 20 57 65 t)))).. ;; We
3c60: 20 61 72 65 20 61 62 6f 75 74 20 74 6f 20 61 63 are about to ac
3c70: 74 75 61 6c 6c 79 20 6b 69 63 6b 20 6f 66 66 20 tually kick off
3c80: 74 68 65 20 74 65 73 74 0a 09 20 20 20 20 3b 3b the test.. ;;
3c90: 20 73 6f 20 74 68 69 73 20 69 73 20 61 20 67 6f so this is a go
3ca0: 6f 64 20 70 6c 61 63 65 20 74 6f 20 72 65 6d 6f od place to remo
3cb0: 76 65 20 74 68 65 20 72 65 63 6f 72 64 73 20 66 ve the records f
3cc0: 6f 72 20 0a 09 20 20 20 20 3b 3b 20 61 6e 79 20 or .. ;; any
3cd0: 70 72 65 76 69 6f 75 73 20 72 75 6e 73 0a 09 20 previous runs..
3ce0: 20 20 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 72 ;; (db:test-r
3cf0: 65 6d 6f 76 65 2d 73 74 65 70 73 20 64 62 20 72 emove-steps db r
3d00: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 un-id testname i
3d10: 74 65 6d 64 61 74 29 0a 09 20 20 20 20 0a 09 20 temdat).. ..
3d20: 20 20 20 3b 3b 20 66 72 6f 6d 20 68 65 72 65 20 ;; from here
3d30: 6f 6e 20 6f 75 74 20 77 65 20 77 69 6c 6c 20 6f on out we will o
3d40: 70 65 6e 20 61 6e 64 20 63 6c 6f 73 65 20 74 68 pen and close th
3d50: 65 20 64 62 0a 09 20 20 20 20 3b 3b 20 6f 6e 20 e db.. ;; on
3d60: 65 76 65 72 79 20 61 63 63 65 73 73 20 74 6f 20 every access to
3d70: 72 65 64 75 63 65 20 74 68 65 20 70 72 6f 62 61 reduce the proba
3d80: 62 6c 69 74 69 79 20 6f 66 20 0a 09 20 20 20 20 blitiy of ..
3d90: 3b 3b 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 6f 72 ;; contention or
3da0: 20 73 74 75 63 6b 20 61 63 63 65 73 73 20 6f 6e stuck access on
3db0: 20 6e 66 73 2e 0a 09 20 20 20 20 28 73 71 6c 69 nfs... (sqli
3dc0: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
3dd0: 29 0a 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 )... (let* ((
3de0: 6d 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 m (ma
3df0: 6b 65 2d 6d 75 74 65 78 29 29 0a 09 09 20 20 20 ke-mutex))...
3e00: 28 6b 69 6c 6c 2d 6a 6f 62 3f 20 20 20 20 23 66 (kill-job? #f
3e10: 29 0a 09 09 20 20 20 28 65 78 69 74 2d 69 6e 66 )... (exit-inf
3e20: 6f 20 20 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f o (make-vecto
3e30: 72 20 33 29 29 0a 09 09 20 20 20 28 6a 6f 62 2d r 3))... (job-
3e40: 74 68 72 65 61 64 20 20 20 23 66 29 0a 09 09 20 thread #f)...
3e50: 20 20 28 72 75 6e 69 74 20 20 20 20 20 20 20 20 (runit
3e60: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 20 (lambda ().....
3e70: 20 20 3b 3b 20 28 6c 65 74 2d 76 61 6c 75 65 73 ;; (let-values
3e80: 0a 09 09 09 09 20 20 20 3b 3b 20 20 28 28 28 70 ..... ;; (((p
3e90: 69 64 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 id exit-status e
3ea0: 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 09 20 20 xit-code).....
3eb0: 20 3b 3b 20 20 20 20 28 72 75 6e 2d 6e 2d 77 61 ;; (run-n-wa
3ec0: 69 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 it fullrunscript
3ed0: 29 29 29 0a 09 09 09 09 20 20 20 28 6c 65 74 20 )))..... (let
3ee0: 28 28 70 69 64 20 28 70 72 6f 63 65 73 73 2d 72 ((pid (process-r
3ef0: 75 6e 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 un fullrunscript
3f00: 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 6c 65 )))..... (le
3f10: 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 t loop ((i 0))..
3f20: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 2d 76 ... (let-v
3f30: 61 6c 75 65 73 0a 09 09 09 09 09 28 28 28 70 69 alues......(((pi
3f40: 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 75 d-val exit-statu
3f50: 73 20 65 78 69 74 2d 63 6f 64 65 29 20 28 70 72 s exit-code) (pr
3f60: 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 ocess-wait pid #
3f70: 74 29 29 29 0a 09 09 09 09 09 28 6d 75 74 65 78 t)))......(mutex
3f80: 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 28 -lock! m)......(
3f90: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit
3fa0: 2d 69 6e 66 6f 20 30 20 70 69 64 29 0a 09 09 09 -info 0 pid)....
3fb0: 09 09 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 ..(vector-set! e
3fc0: 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 74 2d xit-info 1 exit-
3fd0: 73 74 61 74 75 73 29 0a 09 09 09 09 09 28 76 65 status)......(ve
3fe0: 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 ctor-set! exit-i
3ff0: 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f 64 65 29 nfo 2 exit-code)
4000: 0a 09 09 09 09 09 28 6d 75 74 65 78 2d 75 6e 6c ......(mutex-unl
4010: 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 28 69 66 ock! m)......(if
4020: 20 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 (eq? pid-val 0)
4030: 0a 09 09 09 09 09 20 20 20 20 28 62 65 67 69 6e ...... (begin
4040: 0a 09 09 09 09 09 20 20 20 20 20 20 28 74 68 72 ...... (thr
4050: 65 61 64 2d 73 6c 65 65 70 21 20 32 29 0a 09 09 ead-sleep! 2)...
4060: 09 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 ... (loop (
4070: 2b 20 69 20 31 29 29 29 0a 09 09 09 09 09 20 20 + i 1)))......
4080: 20 20 29 29 29 29 29 29 0a 09 09 20 20 20 28 6d ))))))... (m
4090: 6f 6e 69 74 6f 72 6a 6f 62 20 20 20 28 6c 61 6d onitorjob (lam
40a0: 62 64 61 20 28 29 0a 09 09 09 09 20 20 20 28 6c bda ()..... (l
40b0: 65 74 2a 20 28 28 73 74 61 72 74 2d 73 65 63 6f et* ((start-seco
40c0: 6e 64 73 20 28 63 75 72 72 65 6e 74 2d 73 65 63 nds (current-sec
40d0: 6f 6e 64 73 29 29 0a 09 09 09 09 09 20 20 28 63 onds))...... (c
40e0: 61 6c 63 2d 6d 69 6e 75 74 65 73 20 20 28 6c 61 alc-minutes (la
40f0: 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 09 20 mbda ()........
4100: 20 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 63 (inexact->exac
4110: 74 20 0a 09 09 09 09 09 09 09 20 20 20 20 28 72 t ........ (r
4120: 6f 75 6e 64 20 0a 09 09 09 09 09 09 09 20 20 20 ound ........
4130: 20 20 28 2d 20 0a 09 09 09 09 09 09 09 20 20 20 (- ........
4140: 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (current-seco
4150: 6e 64 73 29 20 0a 09 09 09 09 09 09 09 20 20 20 nds) ........
4160: 20 20 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 start-seconds
4170: 29 29 29 29 29 0a 09 09 09 09 09 20 20 28 6b 69 )))))...... (ki
4180: 6c 6c 2d 74 72 69 65 73 20 30 29 29 0a 09 09 09 ll-tries 0))....
4190: 09 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 . (let loop
41a0: 28 28 6d 69 6e 75 74 65 73 20 20 20 28 63 61 6c ((minutes (cal
41b0: 63 2d 6d 69 6e 75 74 65 73 29 29 29 0a 09 09 09 c-minutes)))....
41c0: 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 . (let* ((
41d0: 64 62 20 20 20 20 20 20 20 28 6f 70 65 6e 2d 64 db (open-d
41e0: 62 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 b))...... (
41f0: 63 70 75 6c 6f 61 64 20 20 28 67 65 74 2d 63 70 cpuload (get-cp
4200: 75 2d 6c 6f 61 64 29 29 0a 09 09 09 09 09 20 20 u-load))......
4210: 20 20 20 20 28 64 69 73 6b 66 72 65 65 20 28 67 (diskfree (g
4220: 65 74 2d 64 66 20 28 63 75 72 72 65 6e 74 2d 64 et-df (current-d
4230: 69 72 65 63 74 6f 72 79 29 29 29 0a 09 09 09 09 irectory))).....
4240: 09 20 20 20 20 20 20 28 74 6d 70 66 72 65 65 20 . (tmpfree
4250: 20 28 67 65 74 2d 64 66 20 22 2f 74 6d 70 22 29 (get-df "/tmp")
4260: 29 29 0a 09 09 09 09 09 20 28 69 66 20 28 6e 6f ))...... (if (no
4270: 74 20 63 70 75 6c 6f 61 64 29 20 20 28 62 65 67 t cpuload) (beg
4280: 69 6e 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 in (debug:print
4290: 30 20 22 57 41 52 4e 49 4e 47 3a 20 43 50 55 4c 0 "WARNING: CPUL
42a0: 4f 41 44 20 6e 6f 74 20 66 6f 75 6e 64 2e 22 29 OAD not found.")
42b0: 20 20 28 73 65 74 21 20 63 70 75 6c 6f 61 64 20 (set! cpuload
42c0: 22 6e 2f 61 22 29 29 29 0a 09 09 09 09 09 20 28 "n/a")))...... (
42d0: 69 66 20 28 6e 6f 74 20 64 69 73 6b 66 72 65 65 if (not diskfree
42e0: 29 20 28 62 65 67 69 6e 20 28 64 65 62 75 67 3a ) (begin (debug:
42f0: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
4300: 3a 20 44 49 53 4b 46 52 45 45 20 6e 6f 74 20 66 : DISKFREE not f
4310: 6f 75 6e 64 2e 22 29 20 28 73 65 74 21 20 64 69 ound.") (set! di
4320: 73 6b 66 72 65 65 20 22 6e 2f 61 22 29 29 29 0a skfree "n/a"))).
4330: 09 09 09 09 09 20 28 73 65 74 21 20 6b 69 6c 6c ..... (set! kill
4340: 2d 6a 6f 62 3f 20 28 74 65 73 74 2d 67 65 74 2d -job? (test-get-
4350: 6b 69 6c 6c 2d 72 65 71 75 65 73 74 20 64 62 20 kill-request db
4360: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
4370: 20 69 74 65 6d 64 61 74 29 29 0a 09 09 09 09 09 itemdat))......
4380: 20 28 74 65 73 74 2d 75 70 64 61 74 65 2d 6d 65 (test-update-me
4390: 74 61 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 ta-info db run-i
43a0: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
43b0: 64 61 74 20 6d 69 6e 75 74 65 73 20 63 70 75 6c dat minutes cpul
43c0: 6f 61 64 20 64 69 73 6b 66 72 65 65 20 74 6d 70 oad diskfree tmp
43d0: 66 72 65 65 29 0a 09 09 09 09 09 20 28 69 66 20 free)...... (if
43e0: 6b 69 6c 6c 2d 6a 6f 62 3f 20 0a 09 09 09 09 09 kill-job? ......
43f0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 (begin.....
4400: 09 20 20 20 20 20 20 20 28 6d 75 74 65 78 2d 6c . (mutex-l
4410: 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 20 20 20 ock! m)......
4420: 20 20 20 20 28 6c 65 74 2a 20 28 28 70 69 64 20 (let* ((pid
4430: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
4440: 2d 69 6e 66 6f 20 30 29 29 29 0a 09 09 09 09 09 -info 0)))......
4450: 09 20 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 70 . (if (number? p
4460: 69 64 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 id)....... (
4470: 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 20 begin.......
4480: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
4490: 30 20 22 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 0 "WARNING: Requ
44a0: 65 73 74 20 72 65 63 65 69 76 65 64 20 74 6f 20 est received to
44b0: 6b 69 6c 6c 20 6a 6f 62 20 28 61 74 74 65 6d 70 kill job (attemp
44c0: 74 20 23 20 22 20 6b 69 6c 6c 2d 74 72 69 65 73 t # " kill-tries
44d0: 20 22 29 22 29 0a 09 09 09 09 09 09 20 20 20 20 ")").......
44e0: 20 20 20 28 6c 65 74 20 28 28 70 72 6f 63 65 73 (let ((proces
44f0: 73 65 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 ses (cmd-run->li
4500: 73 74 20 28 63 6f 6e 63 20 22 70 67 72 65 70 20 st (conc "pgrep
4510: 2d 6c 20 2d 50 20 22 20 70 69 64 29 29 29 29 0a -l -P " pid)))).
4520: 09 09 09 09 09 09 09 20 28 66 6f 72 2d 65 61 63 ....... (for-eac
4530: 68 20 0a 09 09 09 09 09 09 09 20 20 28 6c 61 6d h ........ (lam
4540: 62 64 61 20 28 70 29 0a 09 09 09 09 09 09 09 20 bda (p)........
4550: 20 20 20 28 6c 65 74 2a 20 28 28 70 61 72 74 73 (let* ((parts
4560: 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 (string-split
4570: 70 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 p))......... (
4580: 70 2d 69 64 20 20 20 28 69 66 20 28 3e 20 28 6c p-id (if (> (l
4590: 65 6e 67 74 68 20 70 61 72 74 73 29 20 30 29 0a ength parts) 0).
45a0: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
45b0: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
45c0: 28 63 61 72 20 70 61 72 74 73 29 29 0a 09 09 09 (car parts))....
45d0: 09 09 09 09 09 09 20 20 20 20 20 20 20 23 66 29 ...... #f)
45e0: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 ))........
45f0: 28 69 66 20 70 2d 69 64 0a 09 09 09 09 09 09 09 (if p-id........
4600: 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 . (begin.......
4610: 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
4620: 6e 74 20 30 20 22 4b 69 6c 6c 69 6e 67 20 22 20 nt 0 "Killing "
4630: 28 63 61 64 72 20 70 61 72 74 73 29 20 22 3b 20 (cadr parts) ";
4640: 6b 69 6c 6c 20 2d 39 20 20 22 20 70 2d 69 64 29 kill -9 " p-id)
4650: 0a 09 09 09 09 09 09 09 09 20 20 20 20 28 73 79 ......... (sy
4660: 73 74 65 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c stem (conc "kill
4670: 20 2d 39 20 22 20 70 2d 69 64 29 29 29 29 29 29 -9 " p-id))))))
4680: 0a 09 09 09 09 09 09 09 20 20 28 63 61 72 20 70 ........ (car p
4690: 72 6f 63 65 73 73 65 73 29 29 0a 09 09 09 09 09 rocesses))......
46a0: 09 09 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 .. (system (conc
46b0: 20 22 6b 69 6c 6c 20 2d 39 20 22 20 70 69 64 29 "kill -9 " pid)
46c0: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 )))....... (
46d0: 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 20 begin.......
46e0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
46f0: 30 20 22 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 0 "WARNING: Requ
4700: 65 73 74 20 72 65 63 65 69 76 65 64 20 74 6f 20 est received to
4710: 6b 69 6c 6c 20 6a 6f 62 20 62 75 74 20 70 72 6f kill job but pro
4720: 62 6c 65 6d 20 77 69 74 68 20 70 72 6f 63 65 73 blem with proces
4730: 73 2c 20 61 74 74 65 6d 70 74 69 6e 67 20 74 6f s, attempting to
4740: 20 6b 69 6c 6c 20 6d 61 6e 61 67 65 72 20 70 72 kill manager pr
4750: 6f 63 65 73 73 22 29 0a 09 09 09 09 09 09 20 20 ocess").......
4760: 20 20 20 20 20 28 74 65 73 74 2d 73 65 74 2d 73 (test-set-s
4770: 74 61 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 tatus! db run-id
4780: 20 74 65 73 74 2d 6e 61 6d 65 20 22 4b 49 4c 4c test-name "KILL
4790: 45 44 22 20 20 22 46 41 49 4c 22 0a 09 09 09 09 ED" "FAIL".....
47a0: 09 09 09 09 09 20 69 74 65 6d 64 61 74 20 28 61 ..... itemdat (a
47b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
47c0: 29 20 23 66 29 0a 09 09 09 09 09 09 20 20 20 20 ) #f).......
47d0: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 (sqlite3:fina
47e0: 6c 69 7a 65 21 20 64 62 29 0a 09 09 09 09 09 09 lize! db).......
47f0: 20 20 20 20 20 20 20 28 65 78 69 74 20 31 29 29 (exit 1))
4800: 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 ))...... (
4810: 73 65 74 21 20 6b 69 6c 6c 2d 74 72 69 65 73 20 set! kill-tries
4820: 28 2b 20 31 20 6b 69 6c 6c 2d 74 72 69 65 73 29 (+ 1 kill-tries)
4830: 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 6d )...... (m
4840: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 29 utex-unlock! m))
4850: 29 0a 09 09 09 09 09 20 28 73 71 6c 69 74 65 33 )...... (sqlite3
4860: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 :finalize! db)..
4870: 09 09 09 09 20 28 74 68 72 65 61 64 2d 73 6c 65 .... (thread-sle
4880: 65 70 21 20 28 2b 20 38 20 28 72 61 6e 64 6f 6d ep! (+ 8 (random
4890: 20 34 29 29 29 20 3b 3b 20 61 64 64 20 73 6f 6d 4))) ;; add som
48a0: 65 20 6a 69 74 74 65 72 20 74 6f 20 74 68 65 20 e jitter to the
48b0: 63 61 6c 6c 20 68 6f 6d 65 20 74 69 6d 65 20 74 call home time t
48c0: 6f 20 73 70 72 65 61 64 20 6f 75 74 20 74 68 65 o spread out the
48d0: 20 64 62 20 61 63 63 65 73 73 65 73 0a 09 09 09 db accesses....
48e0: 09 09 20 28 6c 6f 6f 70 20 28 63 61 6c 63 2d 6d .. (loop (calc-m
48f0: 69 6e 75 74 65 73 29 29 29 29 29 29 29 0a 09 09 inutes)))))))...
4900: 20 20 20 28 74 68 31 20 20 20 20 20 20 20 20 20 (th1
4910: 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 6d 6f (make-thread mo
4920: 6e 69 74 6f 72 6a 6f 62 29 29 0a 09 09 20 20 20 nitorjob))...
4930: 28 74 68 32 20 20 20 20 20 20 20 20 20 20 28 6d (th2 (m
4940: 61 6b 65 2d 74 68 72 65 61 64 20 72 75 6e 69 74 ake-thread runit
4950: 29 29 29 0a 09 20 20 20 20 20 20 28 73 65 74 21 ))).. (set!
4960: 20 6a 6f 62 2d 74 68 72 65 61 64 20 74 68 32 29 job-thread th2)
4970: 0a 09 20 20 20 20 20 20 28 74 68 72 65 61 64 2d .. (thread-
4980: 73 74 61 72 74 21 20 74 68 31 29 0a 09 20 20 20 start! th1)..
4990: 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 (thread-start
49a0: 21 20 74 68 32 29 0a 09 20 20 20 20 20 20 28 74 ! th2).. (t
49b0: 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 32 29 hread-join! th2)
49c0: 0a 09 20 20 20 20 20 20 28 6d 75 74 65 78 2d 6c .. (mutex-l
49d0: 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 20 20 28 ock! m).. (
49e0: 73 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 set! db (open-db
49f0: 29 29 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 )).. (let*
4a00: 28 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 ((item-path (ite
4a10: 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
4a20: 6d 64 61 74 29 29 0a 09 09 20 20 20 20 20 28 74 mdat))... (t
4a30: 65 73 74 69 6e 66 6f 20 20 28 64 62 3a 67 65 74 estinfo (db:get
4a40: 2d 74 65 73 74 2d 69 6e 66 6f 20 64 62 20 72 75 -test-info db ru
4a50: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
4a60: 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 09 28 69 tem-path)))...(i
4a70: 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 f (not (equal? (
4a80: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
4a90: 65 20 74 65 73 74 69 6e 66 6f 29 20 22 43 4f 4d e testinfo) "COM
4aa0: 50 4c 45 54 45 44 22 29 29 0a 09 09 20 20 20 20 PLETED"))...
4ab0: 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 28 (begin... (
4ac0: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 54 debug:print 2 "T
4ad0: 65 73 74 20 4e 4f 54 20 6c 6f 67 67 65 64 20 61 est NOT logged a
4ae0: 73 20 43 4f 4d 50 4c 45 54 45 44 2c 20 28 73 74 s COMPLETED, (st
4af0: 61 74 65 3d 22 20 28 64 62 3a 74 65 73 74 2d 67 ate=" (db:test-g
4b00: 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 et-state testinf
4b10: 6f 29 20 22 29 2c 20 75 70 64 61 74 69 6e 67 20 o) "), updating
4b20: 72 65 73 75 6c 74 22 29 0a 09 09 20 20 20 20 20 result")...
4b30: 20 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 (test-set-statu
4b40: 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 s! db run-id tes
4b50: 74 2d 6e 61 6d 65 0a 09 09 09 09 09 28 69 66 20 t-name......(if
4b60: 6b 69 6c 6c 2d 6a 6f 62 3f 20 22 4b 49 4c 4c 45 kill-job? "KILLE
4b70: 44 22 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a D" "COMPLETED").
4b80: 09 09 09 09 09 28 69 66 20 28 76 65 63 74 6f 72 .....(if (vector
4b90: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 -ref exit-info 1
4ba0: 29 20 3b 3b 20 6c 6f 6f 6b 20 61 74 20 74 68 65 ) ;; look at the
4bb0: 20 65 78 69 74 2d 73 74 61 74 75 73 0a 09 09 09 exit-status....
4bc0: 09 09 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 .. (if (and (
4bd0: 6e 6f 74 20 6b 69 6c 6c 2d 6a 6f 62 3f 29 20 0a not kill-job?) .
4be0: 09 09 09 09 09 09 20 20 20 20 20 28 65 71 3f 20 ...... (eq?
4bf0: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
4c00: 2d 69 6e 66 6f 20 32 29 20 30 29 29 0a 09 09 09 -info 2) 0))....
4c10: 09 09 09 22 50 41 53 53 22 0a 09 09 09 09 09 09 ..."PASS".......
4c20: 22 46 41 49 4c 22 29 0a 09 09 09 09 09 20 20 20 "FAIL")......
4c30: 20 22 46 41 49 4c 22 29 20 69 74 65 6d 64 61 74 "FAIL") itemdat
4c40: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4c50: 2d 6d 22 29 20 23 66 29 29 29 0a 09 09 3b 3b 20 -m") #f)))...;;
4c60: 66 6f 72 20 61 75 74 6f 6d 61 74 65 64 20 63 72 for automated cr
4c70: 65 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 72 6f eation of the ro
4c80: 6c 6c 75 70 20 68 74 6d 6c 20 66 69 6c 65 20 74 llup html file t
4c90: 68 69 73 20 69 73 20 61 20 67 6f 6f 64 20 70 6c his is a good pl
4ca0: 61 63 65 2e 2e 2e 0a 09 09 28 69 66 20 28 6e 6f ace......(if (no
4cb0: 74 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 t (equal? item-p
4cc0: 61 74 68 20 22 22 29 29 0a 09 09 20 20 20 28 74 ath ""))... (t
4cd0: 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 ests:summarize-i
4ce0: 74 65 6d 73 20 64 62 20 72 75 6e 2d 69 64 20 74 tems db run-id t
4cf0: 65 73 74 2d 6e 61 6d 65 20 23 66 29 29 20 3b 3b est-name #f)) ;;
4d00: 20 64 6f 6e 27 74 20 66 6f 72 63 65 20 2d 20 6a don't force - j
4d10: 75 73 74 20 75 70 64 61 74 65 20 69 66 20 6e 6f ust update if no
4d20: 0a 09 09 29 0a 09 20 20 20 20 20 20 28 6d 75 74 ...).. (mut
4d30: 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 20 ex-unlock! m)..
4d40: 20 20 20 20 20 3b 3b 20 28 65 78 65 63 2d 72 65 ;; (exec-re
4d50: 73 75 6c 74 73 20 28 63 6d 64 2d 72 75 6e 2d 3e sults (cmd-run->
4d60: 6c 69 73 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 list fullrunscri
4d70: 70 74 29 29 20 3b 3b 20 20 28 6c 69 73 74 20 22 pt)) ;; (list "
4d80: 3e 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 6e 61 >" (conc test-na
4d90: 6d 65 20 22 2d 72 75 6e 2e 6c 6f 67 22 29 29 29 me "-run.log")))
4da0: 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 73 75 63 ).. ;; (suc
4db0: 63 65 73 73 20 20 20 20 20 20 65 78 65 63 2d 72 cess exec-r
4dc0: 65 73 75 6c 74 73 29 29 20 3b 3b 20 28 65 71 3f esults)) ;; (eq?
4dd0: 20 28 63 61 64 72 20 65 78 65 63 2d 72 65 73 75 (cadr exec-resu
4de0: 6c 74 73 29 20 30 29 29 29 0a 09 20 20 20 20 20 lts) 0)))..
4df0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
4e00: 22 4f 75 74 70 75 74 20 66 72 6f 6d 20 72 75 6e "Output from run
4e10: 6e 69 6e 67 20 22 20 66 75 6c 6c 72 75 6e 73 63 ning " fullrunsc
4e20: 72 69 70 74 20 22 2c 20 70 69 64 20 22 20 28 76 ript ", pid " (v
4e30: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
4e40: 6e 66 6f 20 30 29 20 22 20 69 6e 20 77 6f 72 6b nfo 0) " in work
4e50: 20 61 72 65 61 20 22 20 0a 09 09 20 20 20 20 20 area " ...
4e60: 77 6f 72 6b 2d 61 72 65 61 20 22 3a 5c 6e 3d 3d work-area ":\n==
4e70: 3d 3d 5c 6e 20 65 78 69 74 20 63 6f 64 65 20 22 ==\n exit code "
4e80: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
4e90: 74 2d 69 6e 66 6f 20 32 29 20 22 5c 6e 22 20 22 t-info 2) "\n" "
4ea0: 3d 3d 3d 3d 5c 6e 22 29 0a 09 20 20 20 20 20 20 ====\n")..
4eb0: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
4ec0: 65 21 20 64 62 29 0a 09 20 20 20 20 20 20 28 69 e! db).. (i
4ed0: 66 20 28 6e 6f 74 20 28 76 65 63 74 6f 72 2d 72 f (not (vector-r
4ee0: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 29 ef exit-info 1))
4ef0: 0a 09 09 20 20 28 65 78 69 74 20 34 29 29 29 29 ... (exit 4))))
4f00: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 ). (set! *d
4f10: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
4f20: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
4f30: 74 2d 61 72 67 20 22 2d 73 74 65 70 22 29 0a 20 t-arg "-step").
4f40: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 (if (not (get
4f50: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
4f60: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
4f70: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
4f80: 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 ROR: MT_CMDINFO
4f90: 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c env var not set,
4fa0: 20 2d 73 74 65 70 20 6d 75 73 74 20 62 65 20 63 -step must be c
4fb0: 61 6c 6c 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 alled *inside* a
4fc0: 20 6d 65 67 61 74 65 73 74 20 69 6e 76 6f 6b 65 megatest invoke
4fd0: 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 d environment!")
4fe0: 0a 09 20 20 28 65 78 69 74 20 35 29 29 0a 09 28 .. (exit 5))..(
4ff0: 6c 65 74 2a 20 28 28 73 74 65 70 20 20 20 20 20 let* ((step
5000: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5010: 2d 73 74 65 70 22 29 29 0a 09 20 20 20 20 20 20 -step"))..
5020: 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 (cmdinfo (rea
5030: 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 d (open-input-st
5040: 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 73 ring (base64:bas
5050: 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 74 65 e64-decode (gete
5060: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
5070: 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 )))).. (te
5080: 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 stpath (assoc/d
5090: 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 efault 'testpath
50a0: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
50b0: 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 (test-name (
50c0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
50d0: 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f est-name cmdinfo
50e0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 )).. (runs
50f0: 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 cript (assoc/def
5100: 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 ault 'runscript
5110: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
5120: 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 (db-host (as
5130: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d soc/default 'db-
5140: 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 host cmdinfo))
5150: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 .. (run-id
5160: 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 (assoc/defau
5170: 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d lt 'run-id cm
5180: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
5190: 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f (itemdat (asso
51a0: 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 c/default 'itemd
51b0: 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 at cmdinfo))..
51c0: 20 20 20 20 20 20 20 28 64 62 20 20 20 20 20 20 (db
51d0: 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 73 #f).. (s
51e0: 74 61 74 65 20 20 20 20 28 61 72 67 73 3a 67 65 tate (args:ge
51f0: 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 t-arg ":state"))
5200: 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 .. (status
5210: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
5220: 20 22 3a 73 74 61 74 75 73 22 29 29 29 0a 09 20 ":status")))..
5230: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
5240: 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 20 20 ry testpath)..
5250: 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d (if (not (setup-
5260: 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 for-run))..
5270: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
5280: 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 :print 0 "Failed
5290: 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 to setup, exiti
52a0: 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 ng")...(exit 1))
52b0: 29 0a 09 20 20 28 73 65 74 21 20 64 62 20 28 6f ).. (set! db (o
52c0: 70 65 6e 2d 64 62 29 29 0a 09 20 20 28 69 66 20 pen-db)).. (if
52d0: 28 61 6e 64 20 73 74 61 74 65 20 73 74 61 74 75 (and state statu
52e0: 73 29 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 s).. (tests
52f0: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 tep-set-status!
5300: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
5310: 61 6d 65 20 73 74 65 70 20 73 74 61 74 65 20 73 ame step state s
5320: 74 61 74 75 73 20 69 74 65 6d 64 61 74 20 28 61 tatus itemdat (a
5330: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
5340: 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e )).. (begin
5350: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
5360: 30 20 22 45 52 52 4f 52 3a 20 59 6f 75 20 6d 75 0 "ERROR: You mu
5370: 73 74 20 73 70 65 63 69 66 79 20 3a 73 74 61 74 st specify :stat
5380: 65 20 61 6e 64 20 3a 73 74 61 74 75 73 20 77 69 e and :status wi
5390: 74 68 20 65 76 65 72 79 20 63 61 6c 6c 20 74 6f th every call to
53a0: 20 2d 73 74 65 70 22 29 0a 09 09 28 65 78 69 74 -step")...(exit
53b0: 20 36 29 29 29 0a 09 20 20 28 73 71 6c 69 74 65 6))).. (sqlite
53c0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
53d0: 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d . (set! *didsom
53e0: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a ething* #t))))..
53f0: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
5400: 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 t-arg "-setlog")
5410: 20 20 20 20 20 20 20 3b 3b 20 73 69 6e 63 65 20 ;; since
5420: 73 65 74 74 69 6e 67 20 75 70 20 69 73 20 73 6f setting up is so
5430: 20 63 6f 73 74 6c 79 20 6c 65 74 73 20 70 69 67 costly lets pig
5440: 67 79 62 61 63 6b 20 6f 6e 20 2d 74 65 73 74 2d gyback on -test-
5450: 73 74 61 74 75 73 0a 09 28 61 72 67 73 3a 67 65 status..(args:ge
5460: 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c t-arg "-set-topl
5470: 6f 67 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d og")..(args:get-
5480: 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 arg "-test-statu
5490: 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 s")..(args:get-a
54a0: 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 rg "-set-values"
54b0: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
54c0: 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 "-load-test-dat
54d0: 61 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 a")..(args:get-a
54e0: 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 rg "-runstep")..
54f0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5500: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 summarize-items"
5510: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 )). (if (not
5520: 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (getenv "MT_CMDI
5530: 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 NFO"))..(begin..
5540: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
5550: 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 "ERROR: MT_CMDI
5560: 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 NFO env var not
5570: 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 set, commands -t
5580: 65 73 74 2d 73 74 61 74 75 73 2c 20 2d 72 75 6e est-status, -run
5590: 73 74 65 70 20 61 6e 64 20 2d 73 65 74 6c 6f 67 step and -setlog
55a0: 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 20 must be called
55b0: 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 74 *inside* a megat
55c0: 65 73 74 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 est environment!
55d0: 22 29 0a 09 20 20 28 65 78 69 74 20 35 29 29 0a ").. (exit 5)).
55e0: 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e .(let* ((startin
55f0: 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 gdir (current-di
5600: 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 rectory))..
5610: 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 (cmdinfo (re
5620: 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 ad (open-input-s
5630: 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 tring (base64:ba
5640: 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 74 se64-decode (get
5650: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
5660: 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 ))))).. (t
5670: 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f estpath (assoc/
5680: 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 default 'testpat
5690: 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 h cmdinfo))..
56a0: 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 (test-name
56b0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
56c0: 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 test-name cmdinf
56d0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
56e0: 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 script (assoc/de
56f0: 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 fault 'runscript
5700: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
5710: 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 (db-host (a
5720: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 ssoc/default 'db
5730: 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 -host cmdinfo)
5740: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 ).. (run-i
5750: 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 d (assoc/defa
5760: 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 ult 'run-id c
5770: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
5780: 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 (itemdat (ass
5790: 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d oc/default 'item
57a0: 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a dat cmdinfo)).
57b0: 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 20 . (db
57c0: 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 #f).. (
57d0: 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 3a state (args:
57e0: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 get-arg ":state"
57f0: 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 )).. (stat
5800: 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d us (args:get-
5810: 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 29 arg ":status")))
5820: 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 .. (change-dire
5830: 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a ctory testpath).
5840: 09 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 . (if (not (set
5850: 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 up-for-run))..
5860: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 (begin...(de
5870: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 bug:print 0 "Fai
5880: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
5890: 69 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 iting")...(exit
58a0: 31 29 29 29 0a 09 20 20 28 73 65 74 21 20 64 62 1))).. (set! db
58b0: 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 20 20 28 (open-db)).. (
58c0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
58d0: 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 "-load-test-dat
58e0: 61 22 29 0a 09 20 20 20 20 20 20 28 64 62 3a 6c a").. (db:l
58f0: 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 20 64 62 oad-test-data db
5900: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
5910: 65 20 69 74 65 6d 64 61 74 29 29 0a 09 20 20 28 e itemdat)).. (
5920: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
5930: 20 22 2d 73 65 74 6c 6f 67 22 29 0a 09 20 20 20 "-setlog")..
5940: 20 20 20 28 74 65 73 74 2d 73 65 74 2d 6c 6f 67 (test-set-log
5950: 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 ! db run-id test
5960: 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 20 28 61 -name itemdat (a
5970: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
5980: 74 6c 6f 67 22 29 29 29 0a 09 20 20 28 69 66 20 tlog"))).. (if
5990: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
59a0: 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 20 20 set-toplog")..
59b0: 20 20 20 20 28 74 65 73 74 2d 73 65 74 2d 74 6f (test-set-to
59c0: 70 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 plog! db run-id
59d0: 74 65 73 74 2d 6e 61 6d 65 20 28 61 72 67 73 3a test-name (args:
59e0: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f get-arg "-set-to
59f0: 70 6c 6f 67 22 29 29 29 0a 09 20 20 28 69 66 20 plog"))).. (if
5a00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5a10: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 summarize-items"
5a20: 29 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 3a ).. (tests:
5a30: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 summarize-items
5a40: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
5a50: 61 6d 65 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 ame #t)) ;; do f
5a60: 6f 72 63 65 20 68 65 72 65 0a 09 20 20 28 69 66 orce here.. (if
5a70: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5a80: 2d 72 75 6e 73 74 65 70 22 29 0a 09 20 20 20 20 -runstep")..
5a90: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d (if (null? rem
5aa0: 61 72 67 73 29 0a 09 09 20 20 28 62 65 67 69 6e args)... (begin
5ab0: 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
5ac0: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 6e 6f int 0 "ERROR: no
5ad0: 74 68 69 6e 67 20 73 70 65 63 69 66 69 65 64 20 thing specified
5ae0: 74 6f 20 72 75 6e 21 22 29 0a 09 09 20 20 20 20 to run!")...
5af0: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
5b00: 65 21 20 64 62 29 0a 09 09 20 20 20 20 28 65 78 e! db)... (ex
5b10: 69 74 20 36 29 29 0a 09 09 20 20 28 6c 65 74 2a it 6))... (let*
5b20: 20 28 28 73 74 65 70 6e 61 6d 65 20 20 20 28 61 ((stepname (a
5b30: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
5b40: 6e 73 74 65 70 22 29 29 0a 09 09 09 20 28 6c 6f nstep")).... (lo
5b50: 67 70 72 6f 66 69 6c 65 20 28 61 72 67 73 3a 67 gprofile (args:g
5b60: 65 74 2d 61 72 67 20 22 2d 6c 6f 67 70 72 6f 22 et-arg "-logpro"
5b70: 29 29 0a 09 09 09 20 28 6c 6f 67 66 69 6c 65 20 )).... (logfile
5b80: 20 20 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d (conc stepnam
5b90: 65 20 22 2e 6c 6f 67 22 29 29 0a 09 09 09 20 28 e ".log")).... (
5ba0: 63 6d 64 20 20 20 20 20 20 20 20 28 69 66 20 28 cmd (if (
5bb0: 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 23 null? remargs) #
5bc0: 66 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 f (car remargs))
5bd0: 29 0a 09 09 09 20 28 70 61 72 61 6d 73 20 20 20 ).... (params
5be0: 20 20 28 69 66 20 63 6d 64 20 28 63 64 72 20 72 (if cmd (cdr r
5bf0: 65 6d 61 72 67 73 29 20 27 28 29 29 29 0a 09 09 emargs) '()))...
5c00: 09 20 28 65 78 69 74 73 74 61 74 20 20 20 23 66 . (exitstat #f
5c10: 29 0a 09 09 09 20 28 73 68 65 6c 6c 20 20 20 20 ).... (shell
5c20: 20 20 28 6c 61 73 74 20 28 73 74 72 69 6e 67 2d (last (string-
5c30: 73 70 6c 69 74 20 28 67 65 74 2d 65 6e 76 69 72 split (get-envir
5c40: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
5c50: 22 53 48 45 4c 4c 22 29 20 22 2f 22 29 29 29 0a "SHELL") "/"))).
5c60: 09 09 09 20 28 72 65 64 69 72 20 20 20 20 20 20 ... (redir
5c70: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
5c80: 79 6d 62 6f 6c 20 73 68 65 6c 6c 29 0a 09 09 09 ymbol shell)....
5c90: 09 20 20 20 20 20 20 20 28 28 74 63 73 68 20 63 . ((tcsh c
5ca0: 73 68 20 6b 73 68 29 20 20 20 20 22 3e 26 22 29 sh ksh) ">&")
5cb0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 7a 73 ..... ((zs
5cc0: 68 20 62 61 73 68 20 73 68 20 61 73 68 29 20 22 h bash sh ash) "
5cd0: 32 3e 26 31 20 3e 22 29 29 29 0a 09 09 09 20 28 2>&1 >"))).... (
5ce0: 66 75 6c 6c 63 6d 64 20 20 20 20 28 63 6f 6e 63 fullcmd (conc
5cf0: 20 22 28 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 "(" (string-int
5d00: 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 09 09 ersperse .......
5d10: 28 63 6f 6e 73 20 63 6d 64 20 70 61 72 61 6d 73 (cons cmd params
5d20: 29 20 22 20 22 29 0a 09 09 09 09 09 20 20 20 22 ) " ")...... "
5d30: 29 20 22 20 72 65 64 69 72 20 22 20 22 20 6c 6f ) " redir " " lo
5d40: 67 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 3b gfile)))... ;
5d50: 3b 20 6d 61 72 6b 20 74 68 65 20 73 74 61 72 74 ; mark the start
5d60: 20 6f 66 20 74 68 65 20 74 65 73 74 0a 09 09 20 of the test...
5d70: 20 20 20 28 74 65 73 74 73 74 65 70 2d 73 65 74 (teststep-set
5d80: 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 6e 2d -status! db run-
5d90: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 73 74 65 id test-name ste
5da0: 70 6e 61 6d 65 20 22 73 74 61 72 74 22 20 22 6e pname "start" "n
5db0: 2f 61 22 20 69 74 65 6d 64 61 74 20 28 61 72 67 /a" itemdat (arg
5dc0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 s:get-arg "-m"))
5dd0: 0a 09 09 20 20 20 20 3b 3b 20 63 6c 6f 73 65 20 ... ;; close
5de0: 74 68 65 20 64 62 0a 09 09 20 20 20 20 28 73 71 the db... (sq
5df0: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
5e00: 64 62 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e db)... ;; run
5e10: 20 74 68 65 20 74 65 73 74 20 73 74 65 70 0a 09 the test step..
5e20: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
5e30: 74 20 32 20 22 49 4e 46 4f 3a 20 52 75 6e 6e 69 t 2 "INFO: Runni
5e40: 6e 67 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 ng \"" fullcmd "
5e50: 5c 22 22 29 0a 09 09 20 20 20 20 28 63 68 61 6e \"")... (chan
5e60: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 ge-directory sta
5e70: 72 74 69 6e 67 64 69 72 29 0a 09 09 20 20 20 20 rtingdir)...
5e80: 28 73 65 74 21 20 65 78 69 74 73 74 61 74 20 28 (set! exitstat (
5e90: 73 79 73 74 65 6d 20 66 75 6c 6c 63 6d 64 29 29 system fullcmd))
5ea0: 20 3b 3b 20 63 6d 64 20 70 61 72 61 6d 73 29 29 ;; cmd params))
5eb0: 0a 09 09 20 20 20 20 28 73 65 74 21 20 2a 67 6c ... (set! *gl
5ec0: 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 obalexitstatus*
5ed0: 65 78 69 74 73 74 61 74 29 0a 09 09 20 20 20 20 exitstat)...
5ee0: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
5ef0: 79 20 74 65 73 74 70 61 74 68 29 0a 09 09 20 20 y testpath)...
5f00: 20 20 3b 3b 20 72 65 2d 6f 70 65 6e 20 74 68 65 ;; re-open the
5f10: 20 64 62 0a 09 09 20 20 20 20 28 73 65 74 21 20 db... (set!
5f20: 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 20 0a 09 db (open-db)) ..
5f30: 09 20 20 20 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 . ;; run logp
5f40: 72 6f 20 69 66 20 61 70 70 6c 69 63 61 62 6c 65 ro if applicable
5f50: 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d 72 75 6e ;; (process-run
5f60: 20 22 6c 73 22 20 28 6c 69 73 74 20 22 2f 66 6f "ls" (list "/fo
5f70: 6f 22 20 22 32 3e 26 31 22 20 22 62 6c 61 68 2e o" "2>&1" "blah.
5f80: 6c 6f 67 22 29 29 0a 09 09 20 20 20 20 28 69 66 log"))... (if
5f90: 20 6c 6f 67 70 72 6f 66 69 6c 65 0a 09 09 09 28 logprofile....(
5fa0: 6c 65 74 2a 20 28 28 68 74 6d 6c 6c 6f 67 66 69 let* ((htmllogfi
5fb0: 6c 65 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d le (conc stepnam
5fc0: 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 09 09 20 e ".html"))....
5fd0: 20 20 20 20 20 20 28 6f 6c 64 65 78 69 74 73 74 (oldexitst
5fe0: 61 74 20 65 78 69 74 73 74 61 74 29 0a 09 09 09 at exitstat)....
5ff0: 20 20 20 20 20 20 20 28 63 6d 64 20 20 20 20 20 (cmd
6000: 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 (string-inte
6010: 72 73 70 65 72 73 65 20 28 6c 69 73 74 20 22 6c rsperse (list "l
6020: 6f 67 70 72 6f 22 20 6c 6f 67 70 72 6f 66 69 6c ogpro" logprofil
6030: 65 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c e htmllogfile "<
6040: 22 20 6c 6f 67 66 69 6c 65 20 22 3e 22 20 28 63 " logfile ">" (c
6050: 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 5f 6c onc stepname "_l
6060: 6f 67 70 72 6f 2e 6c 6f 67 22 29 29 20 22 20 22 ogpro.log")) " "
6070: 29 29 29 0a 09 09 09 20 20 28 64 65 62 75 67 3a ))).... (debug:
6080: 70 72 69 6e 74 20 32 20 22 49 4e 46 4f 3a 20 72 print 2 "INFO: r
6090: 75 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 unning \"" cmd "
60a0: 5c 22 22 29 0a 09 09 09 20 20 28 63 68 61 6e 67 \"").... (chang
60b0: 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 e-directory star
60c0: 74 69 6e 67 64 69 72 29 0a 09 09 09 20 20 28 73 tingdir).... (s
60d0: 65 74 21 20 65 78 69 74 73 74 61 74 20 28 73 79 et! exitstat (sy
60e0: 73 74 65 6d 20 63 6d 64 29 29 0a 09 09 09 20 20 stem cmd))....
60f0: 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 (set! *globalexi
6100: 74 73 74 61 74 75 73 2a 20 65 78 69 74 73 74 61 tstatus* exitsta
6110: 74 29 20 3b 3b 20 6e 6f 20 6e 65 63 65 73 73 61 t) ;; no necessa
6120: 72 79 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d ry.... (change-
6130: 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 directory testpa
6140: 74 68 29 0a 09 09 09 20 20 28 74 65 73 74 2d 73 th).... (test-s
6150: 65 74 2d 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 et-log! db run-i
6160: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
6170: 64 61 74 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 29 dat htmllogfile)
6180: 29 29 0a 09 09 20 20 20 20 28 74 65 73 74 73 74 ))... (testst
6190: 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 ep-set-status! d
61a0: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
61b0: 6d 65 20 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 me stepname "end
61c0: 22 20 65 78 69 74 73 74 61 74 20 69 74 65 6d 64 " exitstat itemd
61d0: 61 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 at (args:get-arg
61e0: 20 22 2d 6d 22 29 29 0a 09 09 20 20 20 20 28 73 "-m"))... (s
61f0: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
6200: 20 64 62 29 0a 09 09 20 20 20 20 28 69 66 20 28 db)... (if (
6210: 6e 6f 74 20 28 65 71 3f 20 65 78 69 74 73 74 61 not (eq? exitsta
6220: 74 20 30 29 29 0a 09 09 09 28 65 78 69 74 20 32 t 0))....(exit 2
6230: 35 34 29 29 20 3b 3b 20 28 65 78 69 74 20 65 78 54)) ;; (exit ex
6240: 69 74 73 74 61 74 29 20 64 6f 65 73 6e 27 74 20 itstat) doesn't
6250: 77 6f 72 6b 3f 21 3f 0a 09 09 20 20 3b 3b 20 6f work?!?... ;; o
6260: 70 65 6e 20 74 68 65 20 64 62 0a 09 09 20 20 3b pen the db... ;
6270: 3b 20 6d 61 72 6b 20 74 68 65 20 65 6e 64 20 6f ; mark the end o
6280: 66 20 74 68 65 20 74 65 73 74 0a 09 09 20 20 29 f the test... )
6290: 29 29 0a 09 20 20 28 69 66 20 28 6f 72 20 28 61 )).. (if (or (a
62a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
62b0: 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 20 20 st-status")...
62c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
62d0: 73 65 74 2d 76 61 6c 75 65 73 22 29 29 0a 09 20 set-values"))..
62e0: 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 73 (let ((news
62f0: 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 tatus (cond.....
6300: 28 28 6e 75 6d 62 65 72 3f 20 73 74 61 74 75 73 ((number? status
6310: 29 20 20 20 20 20 20 20 28 69 66 20 28 65 71 75 ) (if (equ
6320: 61 6c 3f 20 73 74 61 74 75 73 20 30 29 20 22 50 al? status 0) "P
6330: 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 09 ASS" "FAIL"))...
6340: 09 09 28 28 61 6e 64 20 28 73 74 72 69 6e 67 3f ..((and (string?
6350: 20 73 74 61 74 75 73 29 0a 09 09 09 09 20 20 20 status).....
6360: 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 (string->numb
6370: 65 72 20 73 74 61 74 75 73 29 29 28 69 66 20 28 er status))(if (
6380: 65 71 75 61 6c 3f 20 28 73 74 72 69 6e 67 2d 3e equal? (string->
6390: 6e 75 6d 62 65 72 20 73 74 61 74 75 73 29 20 30 number status) 0
63a0: 29 20 22 50 41 53 53 22 20 22 46 41 49 4c 22 29 ) "PASS" "FAIL")
63b0: 29 0a 09 09 09 09 28 65 6c 73 65 20 73 74 61 74 ).....(else stat
63c0: 75 73 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 74 us)))... ;; t
63d0: 72 61 6e 73 66 65 72 20 72 65 6c 65 76 61 6e 74 ransfer relevant
63e0: 20 6b 65 79 73 20 69 6e 74 6f 20 61 20 68 61 73 keys into a has
63f0: 68 20 74 6f 20 62 65 20 70 61 73 73 65 64 20 74 h to be passed t
6400: 6f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 o test-set-statu
6410: 73 21 0a 09 09 20 20 20 20 3b 3b 20 63 6f 75 6c s!... ;; coul
6420: 64 20 75 73 65 20 61 6e 20 61 73 73 6f 63 20 6c d use an assoc l
6430: 69 73 74 20 49 20 67 75 65 73 73 2e 20 0a 09 09 ist I guess. ...
6440: 20 20 20 20 28 6f 74 68 65 72 64 61 74 61 20 28 (otherdata (
6450: 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 2d let ((res (make-
6460: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 hash-table)))...
6470: 09 09 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 .. (for-each (la
6480: 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 09 09 mbda (key)......
6490: 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 (if (args:g
64a0: 65 74 2d 61 72 67 20 6b 65 79 29 0a 09 09 09 09 et-arg key).....
64b0: 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 .. (hash-table-s
64c0: 65 74 21 20 72 65 73 20 6b 65 79 20 28 61 72 67 et! res key (arg
64d0: 73 3a 67 65 74 2d 61 72 67 20 6b 65 79 29 29 29 s:get-arg key)))
64e0: 29 0a 09 09 09 09 09 20 20 20 28 6c 69 73 74 20 )...... (list
64f0: 22 3a 76 61 6c 75 65 22 20 22 3a 74 6f 6c 22 20 ":value" ":tol"
6500: 22 3a 65 78 70 65 63 74 65 64 22 20 22 3a 66 69 ":expected" ":fi
6510: 72 73 74 5f 65 72 72 22 20 22 3a 66 69 72 73 74 rst_err" ":first
6520: 5f 77 61 72 6e 22 20 22 3a 75 6e 69 74 73 22 20 _warn" ":units"
6530: 22 3a 63 61 74 65 67 6f 72 79 22 20 22 3a 76 61 ":category" ":va
6540: 72 69 61 62 6c 65 22 29 29 0a 09 09 09 09 20 72 riable"))..... r
6550: 65 73 29 29 29 0a 09 09 28 69 66 20 28 61 6e 64 es)))...(if (and
6560: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6570: 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a 09 -test-status")..
6580: 09 09 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 .. (or (not stat
6590: 65 29 0a 09 09 09 20 20 20 20 20 28 6e 6f 74 20 e).... (not
65a0: 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 20 20 status)))...
65b0: 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 28 (begin... (
65c0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
65d0: 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 20 73 RROR: You must s
65e0: 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 6e pecify :state an
65f0: 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 65 d :status with e
6600: 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 74 65 very call to -te
6610: 73 74 2d 73 74 61 74 75 73 5c 6e 22 20 68 65 6c st-status\n" hel
6620: 70 29 0a 09 09 20 20 20 20 20 20 28 73 71 6c 69 p)... (sqli
6630: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
6640: 29 0a 09 09 20 20 20 20 20 20 28 65 78 69 74 20 )... (exit
6650: 36 29 29 29 0a 09 09 28 74 65 73 74 2d 73 65 74 6)))...(test-set
6660: 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 6e 2d -status! db run-
6670: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 73 74 61 id test-name sta
6680: 74 65 20 6e 65 77 73 74 61 74 75 73 20 69 74 65 te newstatus ite
6690: 6d 64 61 74 20 28 61 72 67 73 3a 67 65 74 2d 61 mdat (args:get-a
66a0: 72 67 20 22 2d 6d 22 29 20 6f 74 68 65 72 64 61 rg "-m") otherda
66b0: 74 61 29 29 29 0a 09 20 20 28 73 71 6c 69 74 65 ta))).. (sqlite
66c0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
66d0: 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d . (set! *didsom
66e0: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a ething* #t))))..
66f0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
6700: 67 20 22 2d 73 68 6f 77 6b 65 79 73 22 29 0a 20 g "-showkeys").
6710: 20 20 20 28 6c 65 74 20 28 28 64 62 20 23 66 29 (let ((db #f)
6720: 0a 09 20 20 28 6b 65 79 73 20 23 66 29 29 0a 20 .. (keys #f)).
6730: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 73 (if (not (s
6740: 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 etup-for-run))..
6750: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 (begin.. (d
6760: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 ebug:print 0 "Fa
6770: 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 iled to setup, e
6780: 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 28 65 xiting").. (e
6790: 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 28 xit 1))). (
67a0: 73 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 set! db (open-db
67b0: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 6b )). (set! k
67c0: 65 79 73 20 28 64 62 2d 67 65 74 2d 6b 65 79 73 eys (db-get-keys
67d0: 20 64 62 29 29 0a 20 20 20 20 20 20 28 64 65 62 db)). (deb
67e0: 75 67 3a 70 72 69 6e 74 20 31 20 22 4b 65 79 73 ug:print 1 "Keys
67f0: 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 : " (string-inte
6800: 72 73 70 65 72 73 65 20 28 6d 61 70 20 6b 65 79 rsperse (map key
6810: 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b :get-fieldname k
6820: 65 79 73 29 20 22 2c 20 22 29 29 0a 20 20 20 20 eys) ", ")).
6830: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
6840: 69 7a 65 21 20 64 62 29 0a 20 20 20 20 20 20 28 ize! db). (
6850: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
6860: 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 ng* #t)))..(if (
6870: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 args:get-arg "-g
6880: 75 69 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a ui"). (begin.
6890: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
68a0: 6e 74 20 30 20 22 4c 6f 6f 6b 20 61 74 20 74 68 nt 0 "Look at th
68b0: 65 20 64 61 73 68 62 6f 61 72 64 20 66 6f 72 20 e dashboard for
68c0: 6e 6f 77 22 29 0a 20 20 20 20 20 20 3b 3b 20 28 now"). ;; (
68d0: 6d 65 67 61 74 65 73 74 2d 67 75 69 29 0a 20 20 megatest-gui).
68e0: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
68f0: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
6900: 3b 3b 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 3d 3d ================
6930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6940: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 ========.;; Upda
6950: 74 65 20 74 68 65 20 64 61 74 61 62 61 73 65 20 te the database
6960: 73 63 68 65 6d 61 20 6f 6e 20 72 65 71 75 65 73 schema on reques
6970: 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d t.;;============
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: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
69b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
69c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
69d0: 72 65 62 75 69 6c 64 2d 64 62 22 29 0a 20 20 20 rebuild-db").
69e0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 (begin. (i
69f0: 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f f (not (setup-fo
6a00: 72 2d 72 75 6e 29 29 0a 09 20 20 28 62 65 67 69 r-run)).. (begi
6a10: 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 n.. (debug:pr
6a20: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f int 0 "Failed to
6a30: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
6a40: 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ) .. (exit 1)
6a50: 29 29 0a 20 20 20 20 20 20 3b 3b 20 6e 6f 77 20 )). ;; now
6a60: 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 64 62 0a can find our db.
6a70: 20 20 20 20 20 20 28 73 65 74 21 20 64 62 20 28 (set! db (
6a80: 6f 70 65 6e 2d 64 62 29 29 0a 20 20 20 20 20 20 open-db)).
6a90: 28 70 61 74 63 68 2d 64 62 20 64 62 29 0a 20 20 (patch-db db).
6aa0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e (sqlite3:fin
6ab0: 61 6c 69 7a 65 21 20 64 62 29 0a 20 20 20 20 20 alize! db).
6ac0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
6ad0: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d hing* #t)))..;;=
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 3d 3d 3d 3d 3d ================
6b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6b20: 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 =====.;; Update
6b30: 74 68 65 20 74 65 73 74 73 20 6d 65 74 61 20 64 the tests meta d
6b40: 61 74 61 20 66 72 6f 6d 20 74 68 65 20 74 65 73 ata from the tes
6b50: 74 63 6f 6e 66 69 67 20 66 69 6c 65 73 0a 3b 3b tconfig files.;;
6b60: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
6b70: 61 72 67 20 22 2d 75 70 64 61 74 65 2d 6d 65 74 arg "-update-met
6b80: 61 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 a"). (begin.
6b90: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 73 (if (not (s
6ba0: 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 etup-for-run))..
6bb0: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 (begin.. (d
6bc0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 ebug:print 0 "Fa
6bd0: 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 iled to setup, e
6be0: 78 69 74 69 6e 67 22 29 20 0a 09 20 20 20 20 28 xiting") .. (
6bf0: 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 20 exit 1))).
6c00: 3b 3b 20 6e 6f 77 20 63 61 6e 20 66 69 6e 64 20 ;; now can find
6c10: 6f 75 72 20 64 62 0a 20 20 20 20 20 20 28 73 65 our db. (se
6c20: 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 t! db (open-db))
6c30: 0a 20 20 20 20 20 20 28 72 75 6e 73 3a 75 70 64 . (runs:upd
6c40: 61 74 65 2d 61 6c 6c 2d 74 65 73 74 5f 6d 65 74 ate-all-test_met
6c50: 61 20 64 62 29 0a 20 20 20 20 20 20 28 73 71 6c a db). (sql
6c60: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
6c70: 62 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a b). (set! *
6c80: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
6c90: 29 29 29 0a 0a 28 69 66 20 28 6e 6f 74 20 2a 64 )))..(if (not *d
6ca0: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 29 0a 20 20 idsomething*).
6cb0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
6cc0: 20 68 65 6c 70 29 29 0a 0a 28 69 66 20 28 6e 6f help))..(if (no
6cd0: 74 20 28 65 71 3f 20 2a 67 6c 6f 62 61 6c 65 78 t (eq? *globalex
6ce0: 69 74 73 74 61 74 75 73 2a 20 30 29 29 0a 20 20 itstatus* 0)).
6cf0: 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a (if (or (args:
6d00: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 get-arg "-runtes
6d10: 74 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 ts")(args:get-ar
6d20: 67 20 22 2d 72 75 6e 61 6c 6c 22 29 29 0a 20 20 g "-runall")).
6d30: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 (begin.
6d40: 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 (debug:p
6d50: 72 69 6e 74 20 30 20 22 4e 4f 54 45 3a 20 53 75 rint 0 "NOTE: Su
6d60: 62 70 72 6f 63 65 73 73 65 73 20 77 69 74 68 20 bprocesses with
6d70: 6e 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 20 63 6f non-zero exit co
6d80: 64 65 20 64 65 74 65 63 74 65 64 3a 20 22 20 2a de detected: " *
6d90: 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 globalexitstatus
6da0: 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 *). (e
6db0: 78 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 xit 0)).
6dc0: 28 63 61 73 65 20 2a 67 6c 6f 62 61 6c 65 78 69 (case *globalexi
6dd0: 74 73 74 61 74 75 73 2a 0a 20 20 20 20 20 20 20 tstatus*.
6de0: 20 20 28 28 30 29 28 65 78 69 74 20 30 29 29 0a ((0)(exit 0)).
6df0: 20 20 20 20 20 20 20 20 20 28 28 31 29 28 65 78 ((1)(ex
6e00: 69 74 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 it 1)).
6e10: 28 28 32 29 28 65 78 69 74 20 32 29 29 0a 20 20 ((2)(exit 2)).
6e20: 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 65 78 (else (ex
6e30: 69 74 20 33 29 29 29 29 29 0a it 3))))).