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 73 65 74 atest).. (set
38d0: 65 6e 76 20 22 50 41 54 48 22 20 28 63 6f 6e 63 env "PATH" (conc
38e0: 20 28 67 65 74 65 6e 76 20 22 50 41 54 48 22 29 (getenv "PATH")
38f0: 20 22 3a 22 20 6d 74 2d 62 69 6e 64 69 72 2d 70 ":" mt-bindir-p
3900: 61 74 68 29 29 0a 09 20 20 20 20 0a 09 20 20 20 ath)).. ..
3910: 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 (if (not (setup
3920: 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 09 28 62 65 -for-run))...(be
3930: 67 69 6e 0a 09 09 20 20 28 64 65 62 75 67 3a 70 gin... (debug:p
3940: 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 rint 0 "Failed t
3950: 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
3960: 22 29 20 0a 09 09 20 20 28 65 78 69 74 20 31 29 ") ... (exit 1)
3970: 29 29 0a 09 20 20 20 20 3b 3b 20 6e 6f 77 20 63 )).. ;; now c
3980: 61 6e 20 66 69 6e 64 20 6f 75 72 20 64 62 0a 09 an find our db..
3990: 20 20 20 20 28 73 65 74 21 20 64 62 20 28 6f 70 (set! db (op
39a0: 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 28 63 68 en-db)).. (ch
39b0: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 ange-directory w
39c0: 6f 72 6b 2d 61 72 65 61 29 20 0a 09 20 20 20 20 ork-area) ..
39d0: 28 73 65 74 2d 72 75 6e 2d 63 6f 6e 66 69 67 2d (set-run-config-
39e0: 76 61 72 73 20 64 62 20 72 75 6e 2d 69 64 29 0a vars db run-id).
39f0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 65 ;; e
3a00: 6e 76 69 72 6f 6e 6d 65 6e 74 20 6f 76 65 72 72 nvironment overr
3a10: 69 64 65 73 20 61 72 65 20 64 6f 6e 65 20 2a 62 ides are done *b
3a20: 65 66 6f 72 65 2a 20 74 68 65 20 72 65 6d 61 69 efore* the remai
3a30: 6e 69 6e 67 20 63 72 69 74 69 63 61 6c 20 65 6e ning critical en
3a40: 76 61 72 73 2e 0a 20 20 20 20 20 20 20 20 20 20 vars..
3a50: 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 (alist->env-va
3a60: 72 73 20 65 6e 76 2d 6f 76 72 64 29 0a 09 20 20 rs env-ovrd)..
3a70: 20 20 28 73 65 74 2d 6d 65 67 61 74 65 73 74 2d (set-megatest-
3a80: 65 6e 76 2d 76 61 72 73 20 64 62 20 72 75 6e 2d env-vars db run-
3a90: 69 64 29 0a 09 20 20 20 20 28 73 65 74 2d 69 74 id).. (set-it
3aa0: 65 6d 2d 65 6e 76 2d 76 61 72 73 20 69 74 65 6d em-env-vars item
3ab0: 64 61 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 dat).
3ac0: 20 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 (save-environme
3ad0: 6e 74 2d 61 73 2d 66 69 6c 65 73 20 22 6d 65 67 nt-as-files "meg
3ae0: 61 74 65 73 74 22 29 0a 09 20 20 20 20 28 74 65 atest").. (te
3af0: 73 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f st-set-meta-info
3b00: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d db run-id test-
3b10: 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 09 20 name itemdat)..
3b20: 20 20 20 28 74 65 73 74 2d 73 65 74 2d 73 74 61 (test-set-sta
3b30: 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 tus! db run-id t
3b40: 65 73 74 2d 6e 61 6d 65 20 22 52 45 4d 4f 54 45 est-name "REMOTE
3b50: 48 4f 53 54 53 54 41 52 54 22 20 22 6e 2f 61 22 HOSTSTART" "n/a"
3b60: 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67 itemdat (args:g
3b70: 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 et-arg "-m") #f)
3b80: 0a 09 20 20 20 20 28 69 66 20 28 61 72 67 73 3a .. (if (args:
3b90: 67 65 74 2d 61 72 67 20 22 2d 78 74 65 72 6d 22 get-arg "-xterm"
3ba0: 29 0a 09 09 28 73 65 74 21 20 66 75 6c 6c 72 75 )...(set! fullru
3bb0: 6e 73 63 72 69 70 74 20 22 78 74 65 72 6d 22 29 nscript "xterm")
3bc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3bd0: 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d (if (not (file-
3be0: 65 78 65 63 75 74 65 2d 61 63 63 65 73 73 3f 20 execute-access?
3bf0: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 0a fullrunscript)).
3c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c10: 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e (system (con
3c20: 63 20 22 63 68 6d 6f 64 20 75 67 2b 78 20 22 20 c "chmod ug+x "
3c30: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 fullrunscript)))
3c40: 29 0a 09 20 20 20 20 3b 3b 20 57 65 20 61 72 65 ).. ;; We are
3c50: 20 61 62 6f 75 74 20 74 6f 20 61 63 74 75 61 6c about to actual
3c60: 6c 79 20 6b 69 63 6b 20 6f 66 66 20 74 68 65 20 ly kick off the
3c70: 74 65 73 74 0a 09 20 20 20 20 3b 3b 20 73 6f 20 test.. ;; so
3c80: 74 68 69 73 20 69 73 20 61 20 67 6f 6f 64 20 70 this is a good p
3c90: 6c 61 63 65 20 74 6f 20 72 65 6d 6f 76 65 20 74 lace to remove t
3ca0: 68 65 20 72 65 63 6f 72 64 73 20 66 6f 72 20 0a he records for .
3cb0: 09 20 20 20 20 3b 3b 20 61 6e 79 20 70 72 65 76 . ;; any prev
3cc0: 69 6f 75 73 20 72 75 6e 73 0a 09 20 20 20 20 3b ious runs.. ;
3cd0: 3b 20 28 64 62 3a 74 65 73 74 2d 72 65 6d 6f 76 ; (db:test-remov
3ce0: 65 2d 73 74 65 70 73 20 64 62 20 72 75 6e 2d 69 e-steps db run-i
3cf0: 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 64 d testname itemd
3d00: 61 74 29 0a 09 20 20 20 20 0a 09 20 20 20 20 3b at).. .. ;
3d10: 3b 20 66 72 6f 6d 20 68 65 72 65 20 6f 6e 20 6f ; from here on o
3d20: 75 74 20 77 65 20 77 69 6c 6c 20 6f 70 65 6e 20 ut we will open
3d30: 61 6e 64 20 63 6c 6f 73 65 20 74 68 65 20 64 62 and close the db
3d40: 0a 09 20 20 20 20 3b 3b 20 6f 6e 20 65 76 65 72 .. ;; on ever
3d50: 79 20 61 63 63 65 73 73 20 74 6f 20 72 65 64 75 y access to redu
3d60: 63 65 20 74 68 65 20 70 72 6f 62 61 62 6c 69 74 ce the probablit
3d70: 69 79 20 6f 66 20 0a 09 20 20 20 20 3b 3b 20 63 iy of .. ;; c
3d80: 6f 6e 74 65 6e 74 69 6f 6e 20 6f 72 20 73 74 75 ontention or stu
3d90: 63 6b 20 61 63 63 65 73 73 20 6f 6e 20 6e 66 73 ck access on nfs
3da0: 2e 0a 09 20 20 20 20 28 73 71 6c 69 74 65 33 3a ... (sqlite3:
3db0: 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 0a 09 finalize! db)...
3dc0: 20 20 20 20 28 6c 65 74 2a 20 28 28 6d 20 20 20 (let* ((m
3dd0: 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 6d (make-m
3de0: 75 74 65 78 29 29 0a 09 09 20 20 20 28 6b 69 6c utex))... (kil
3df0: 6c 2d 6a 6f 62 3f 20 20 20 20 23 66 29 0a 09 09 l-job? #f)...
3e00: 20 20 20 28 65 78 69 74 2d 69 6e 66 6f 20 20 20 (exit-info
3e10: 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 33 29 (make-vector 3)
3e20: 29 0a 09 09 20 20 20 28 6a 6f 62 2d 74 68 72 65 )... (job-thre
3e30: 61 64 20 20 20 23 66 29 0a 09 09 20 20 20 28 72 ad #f)... (r
3e40: 75 6e 69 74 20 20 20 20 20 20 20 20 28 6c 61 6d unit (lam
3e50: 62 64 61 20 28 29 0a 09 09 09 09 20 20 20 3b 3b bda ()..... ;;
3e60: 20 28 6c 65 74 2d 76 61 6c 75 65 73 0a 09 09 09 (let-values....
3e70: 09 20 20 20 3b 3b 20 20 28 28 28 70 69 64 20 65 . ;; (((pid e
3e80: 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d xit-status exit-
3e90: 63 6f 64 65 29 0a 09 09 09 09 20 20 20 3b 3b 20 code)..... ;;
3ea0: 20 20 20 28 72 75 6e 2d 6e 2d 77 61 69 74 20 66 (run-n-wait f
3eb0: 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a ullrunscript))).
3ec0: 09 09 09 09 20 20 20 28 6c 65 74 20 28 28 70 69 .... (let ((pi
3ed0: 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 66 d (process-run f
3ee0: 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a ullrunscript))).
3ef0: 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 6c 6f .... (let lo
3f00: 6f 70 20 28 28 69 20 30 29 29 0a 09 09 09 09 20 op ((i 0)).....
3f10: 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 (let-value
3f20: 73 0a 09 09 09 09 09 28 28 28 70 69 64 2d 76 61 s......(((pid-va
3f30: 6c 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 l exit-status ex
3f40: 69 74 2d 63 6f 64 65 29 20 28 70 72 6f 63 65 73 it-code) (proces
3f50: 73 2d 77 61 69 74 20 70 69 64 20 23 74 29 29 29 s-wait pid #t)))
3f60: 0a 09 09 09 09 09 28 6d 75 74 65 78 2d 6c 6f 63 ......(mutex-loc
3f70: 6b 21 20 6d 29 0a 09 09 09 09 09 28 76 65 63 74 k! m)......(vect
3f80: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
3f90: 6f 20 30 20 70 69 64 29 0a 09 09 09 09 09 28 76 o 0 pid)......(v
3fa0: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
3fb0: 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 61 74 info 1 exit-stat
3fc0: 75 73 29 0a 09 09 09 09 09 28 76 65 63 74 6f 72 us)......(vector
3fd0: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
3fe0: 32 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 2 exit-code)....
3ff0: 09 09 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 ..(mutex-unlock!
4000: 20 6d 29 0a 09 09 09 09 09 28 69 66 20 28 65 71 m)......(if (eq
4010: 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 09 09 ? pid-val 0)....
4020: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 .. (begin....
4030: 09 09 20 20 20 20 20 20 28 74 68 72 65 61 64 2d .. (thread-
4040: 73 6c 65 65 70 21 20 32 29 0a 09 09 09 09 09 20 sleep! 2)......
4050: 20 20 20 20 20 28 6c 6f 6f 70 20 28 2b 20 69 20 (loop (+ i
4060: 31 29 29 29 0a 09 09 09 09 09 20 20 20 20 29 29 1)))...... ))
4070: 29 29 29 29 0a 09 09 20 20 20 28 6d 6f 6e 69 74 ))))... (monit
4080: 6f 72 6a 6f 62 20 20 20 28 6c 61 6d 62 64 61 20 orjob (lambda
4090: 28 29 0a 09 09 09 09 20 20 20 28 6c 65 74 2a 20 ()..... (let*
40a0: 28 28 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 20 ((start-seconds
40b0: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
40c0: 29 29 0a 09 09 09 09 09 20 20 28 63 61 6c 63 2d ))...... (calc-
40d0: 6d 69 6e 75 74 65 73 20 20 28 6c 61 6d 62 64 61 minutes (lambda
40e0: 20 28 29 0a 09 09 09 09 09 09 09 20 20 20 28 69 ()........ (i
40f0: 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 20 0a 09 nexact->exact ..
4100: 09 09 09 09 09 09 20 20 20 20 28 72 6f 75 6e 64 ...... (round
4110: 20 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 2d ........ (-
4120: 20 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 28 ........ (
4130: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
4140: 20 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 73 ........ s
4150: 74 61 72 74 2d 73 65 63 6f 6e 64 73 29 29 29 29 tart-seconds))))
4160: 29 0a 09 09 09 09 09 20 20 28 6b 69 6c 6c 2d 74 )...... (kill-t
4170: 72 69 65 73 20 30 29 29 0a 09 09 09 09 20 20 20 ries 0)).....
4180: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6d 69 (let loop ((mi
4190: 6e 75 74 65 73 20 20 20 28 63 61 6c 63 2d 6d 69 nutes (calc-mi
41a0: 6e 75 74 65 73 29 29 29 0a 09 09 09 09 20 20 20 nutes))).....
41b0: 20 20 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 (let* ((db
41c0: 20 20 20 20 20 28 6f 70 65 6e 2d 64 62 29 29 0a (open-db)).
41d0: 09 09 09 09 09 20 20 20 20 20 20 28 63 70 75 6c ..... (cpul
41e0: 6f 61 64 20 20 28 67 65 74 2d 63 70 75 2d 6c 6f oad (get-cpu-lo
41f0: 61 64 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 ad))......
4200: 28 64 69 73 6b 66 72 65 65 20 28 67 65 74 2d 64 (diskfree (get-d
4210: 66 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 f (current-direc
4220: 74 6f 72 79 29 29 29 0a 09 09 09 09 09 20 20 20 tory)))......
4230: 20 20 20 28 74 6d 70 66 72 65 65 20 20 28 67 65 (tmpfree (ge
4240: 74 2d 64 66 20 22 2f 74 6d 70 22 29 29 29 0a 09 t-df "/tmp")))..
4250: 09 09 09 09 20 28 69 66 20 28 6e 6f 74 20 63 70 .... (if (not cp
4260: 75 6c 6f 61 64 29 20 20 28 62 65 67 69 6e 20 28 uload) (begin (
4270: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 debug:print 0 "W
4280: 41 52 4e 49 4e 47 3a 20 43 50 55 4c 4f 41 44 20 ARNING: CPULOAD
4290: 6e 6f 74 20 66 6f 75 6e 64 2e 22 29 20 20 28 73 not found.") (s
42a0: 65 74 21 20 63 70 75 6c 6f 61 64 20 22 6e 2f 61 et! cpuload "n/a
42b0: 22 29 29 29 0a 09 09 09 09 09 20 28 69 66 20 28 ")))...... (if (
42c0: 6e 6f 74 20 64 69 73 6b 66 72 65 65 29 20 28 62 not diskfree) (b
42d0: 65 67 69 6e 20 28 64 65 62 75 67 3a 70 72 69 6e egin (debug:prin
42e0: 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 44 49 t 0 "WARNING: DI
42f0: 53 4b 46 52 45 45 20 6e 6f 74 20 66 6f 75 6e 64 SKFREE not found
4300: 2e 22 29 20 28 73 65 74 21 20 64 69 73 6b 66 72 .") (set! diskfr
4310: 65 65 20 22 6e 2f 61 22 29 29 29 0a 09 09 09 09 ee "n/a"))).....
4320: 09 20 28 73 65 74 21 20 6b 69 6c 6c 2d 6a 6f 62 . (set! kill-job
4330: 3f 20 28 74 65 73 74 2d 67 65 74 2d 6b 69 6c 6c ? (test-get-kill
4340: 2d 72 65 71 75 65 73 74 20 64 62 20 72 75 6e 2d -request db run-
4350: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
4360: 6d 64 61 74 29 29 0a 09 09 09 09 09 20 28 74 65 mdat))...... (te
4370: 73 74 2d 75 70 64 61 74 65 2d 6d 65 74 61 2d 69 st-update-meta-i
4380: 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 20 74 65 nfo db run-id te
4390: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 20 st-name itemdat
43a0: 6d 69 6e 75 74 65 73 20 63 70 75 6c 6f 61 64 20 minutes cpuload
43b0: 64 69 73 6b 66 72 65 65 20 74 6d 70 66 72 65 65 diskfree tmpfree
43c0: 29 0a 09 09 09 09 09 20 28 69 66 20 6b 69 6c 6c )...... (if kill
43d0: 2d 6a 6f 62 3f 20 0a 09 09 09 09 09 20 20 20 20 -job? ......
43e0: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 (begin......
43f0: 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 (mutex-lock!
4400: 20 6d 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 m)......
4410: 28 6c 65 74 2a 20 28 28 70 69 64 20 28 76 65 63 (let* ((pid (vec
4420: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
4430: 6f 20 30 29 29 29 0a 09 09 09 09 09 09 20 28 69 o 0)))....... (i
4440: 66 20 28 6e 75 6d 62 65 72 3f 20 70 69 64 29 0a f (number? pid).
4450: 09 09 09 09 09 09 20 20 20 20 20 28 62 65 67 69 ...... (begi
4460: 6e 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 n....... (
4470: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 debug:print 0 "W
4480: 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 20 ARNING: Request
4490: 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 6c 6c received to kill
44a0: 20 6a 6f 62 20 28 61 74 74 65 6d 70 74 20 23 20 job (attempt #
44b0: 22 20 6b 69 6c 6c 2d 74 72 69 65 73 20 22 29 22 " kill-tries ")"
44c0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 )....... (
44d0: 6c 65 74 20 28 28 70 72 6f 63 65 73 73 65 73 20 let ((processes
44e0: 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 (cmd-run->list (
44f0: 63 6f 6e 63 20 22 70 67 72 65 70 20 2d 6c 20 2d conc "pgrep -l -
4500: 50 20 22 20 70 69 64 29 29 29 29 0a 09 09 09 09 P " pid)))).....
4510: 09 09 09 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 ... (for-each ..
4520: 09 09 09 09 09 09 20 20 28 6c 61 6d 62 64 61 20 ...... (lambda
4530: 28 70 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 (p)........ (
4540: 6c 65 74 2a 20 28 28 70 61 72 74 73 20 20 28 73 let* ((parts (s
4550: 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 29 29 0a tring-split p)).
4560: 09 09 09 09 09 09 09 09 20 20 20 28 70 2d 69 64 ........ (p-id
4570: 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 (if (> (lengt
4580: 68 20 70 61 72 74 73 29 20 30 29 0a 09 09 09 09 h parts) 0).....
4590: 09 09 09 09 09 20 20 20 20 20 20 20 28 73 74 72 ..... (str
45a0: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 72 ing->number (car
45b0: 20 70 61 72 74 73 29 29 0a 09 09 09 09 09 09 09 parts))........
45c0: 09 09 20 20 20 20 20 20 20 23 66 29 29 29 0a 09 .. #f)))..
45d0: 09 09 09 09 09 09 20 20 20 20 20 20 28 69 66 20 ...... (if
45e0: 70 2d 69 64 0a 09 09 09 09 09 09 09 09 20 20 28 p-id......... (
45f0: 62 65 67 69 6e 0a 09 09 09 09 09 09 09 09 20 20 begin.........
4600: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
4610: 20 22 4b 69 6c 6c 69 6e 67 20 22 20 28 63 61 64 "Killing " (cad
4620: 72 20 70 61 72 74 73 29 20 22 3b 20 6b 69 6c 6c r parts) "; kill
4630: 20 2d 39 20 20 22 20 70 2d 69 64 29 0a 09 09 09 -9 " p-id)....
4640: 09 09 09 09 09 20 20 20 20 28 73 79 73 74 65 6d ..... (system
4650: 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d 39 20 (conc "kill -9
4660: 22 20 70 2d 69 64 29 29 29 29 29 29 0a 09 09 09 " p-id))))))....
4670: 09 09 09 09 20 20 28 63 61 72 20 70 72 6f 63 65 .... (car proce
4680: 73 73 65 73 29 29 0a 09 09 09 09 09 09 09 20 28 sses))........ (
4690: 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6b 69 system (conc "ki
46a0: 6c 6c 20 2d 39 20 22 20 70 69 64 29 29 29 29 0a ll -9 " pid)))).
46b0: 09 09 09 09 09 09 20 20 20 20 20 28 62 65 67 69 ...... (begi
46c0: 6e 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 n....... (
46d0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 debug:print 0 "W
46e0: 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 20 ARNING: Request
46f0: 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 6c 6c received to kill
4700: 20 6a 6f 62 20 62 75 74 20 70 72 6f 62 6c 65 6d job but problem
4710: 20 77 69 74 68 20 70 72 6f 63 65 73 73 2c 20 61 with process, a
4720: 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 6b 69 6c ttempting to kil
4730: 6c 20 6d 61 6e 61 67 65 72 20 70 72 6f 63 65 73 l manager proces
4740: 73 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 s").......
4750: 20 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 (test-set-statu
4760: 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 s! db run-id tes
4770: 74 2d 6e 61 6d 65 20 22 4b 49 4c 4c 45 44 22 20 t-name "KILLED"
4780: 20 22 46 41 49 4c 22 0a 09 09 09 09 09 09 09 09 "FAIL".........
4790: 09 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a . itemdat (args:
47a0: 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 get-arg "-m") #f
47b0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 )....... (
47c0: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
47d0: 21 20 64 62 29 0a 09 09 09 09 09 09 20 20 20 20 ! db).......
47e0: 20 20 20 28 65 78 69 74 20 31 29 29 29 29 0a 09 (exit 1))))..
47f0: 09 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 .... (set!
4800: 20 6b 69 6c 6c 2d 74 72 69 65 73 20 28 2b 20 31 kill-tries (+ 1
4810: 20 6b 69 6c 6c 2d 74 72 69 65 73 29 29 0a 09 09 kill-tries))...
4820: 09 09 09 20 20 20 20 20 20 20 28 6d 75 74 65 78 ... (mutex
4830: 2d 75 6e 6c 6f 63 6b 21 20 6d 29 29 29 0a 09 09 -unlock! m)))...
4840: 09 09 09 20 28 73 71 6c 69 74 65 33 3a 66 69 6e ... (sqlite3:fin
4850: 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 09 09 09 alize! db)......
4860: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
4870: 28 2b 20 38 20 28 72 61 6e 64 6f 6d 20 34 29 29 (+ 8 (random 4))
4880: 29 20 3b 3b 20 61 64 64 20 73 6f 6d 65 20 6a 69 ) ;; add some ji
4890: 74 74 65 72 20 74 6f 20 74 68 65 20 63 61 6c 6c tter to the call
48a0: 20 68 6f 6d 65 20 74 69 6d 65 20 74 6f 20 73 70 home time to sp
48b0: 72 65 61 64 20 6f 75 74 20 74 68 65 20 64 62 20 read out the db
48c0: 61 63 63 65 73 73 65 73 0a 09 09 09 09 09 20 28 accesses...... (
48d0: 6c 6f 6f 70 20 28 63 61 6c 63 2d 6d 69 6e 75 74 loop (calc-minut
48e0: 65 73 29 29 29 29 29 29 29 0a 09 09 20 20 20 28 es)))))))... (
48f0: 74 68 31 20 20 20 20 20 20 20 20 20 20 28 6d 61 th1 (ma
4900: 6b 65 2d 74 68 72 65 61 64 20 6d 6f 6e 69 74 6f ke-thread monito
4910: 72 6a 6f 62 29 29 0a 09 09 20 20 20 28 74 68 32 rjob))... (th2
4920: 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d (make-
4930: 74 68 72 65 61 64 20 72 75 6e 69 74 29 29 29 0a thread runit))).
4940: 09 20 20 20 20 20 20 28 73 65 74 21 20 6a 6f 62 . (set! job
4950: 2d 74 68 72 65 61 64 20 74 68 32 29 0a 09 20 20 -thread th2)..
4960: 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 (thread-star
4970: 74 21 20 74 68 31 29 0a 09 20 20 20 20 20 20 28 t! th1).. (
4980: 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 thread-start! th
4990: 32 29 0a 09 20 20 20 20 20 20 28 74 68 72 65 61 2).. (threa
49a0: 64 2d 6a 6f 69 6e 21 20 74 68 32 29 0a 09 20 20 d-join! th2)..
49b0: 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 (mutex-lock!
49c0: 20 6d 29 0a 09 20 20 20 20 20 20 28 73 65 74 21 m).. (set!
49d0: 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 db (open-db))..
49e0: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 69 74 (let* ((it
49f0: 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 em-path (item-li
4a00: 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 st->path itemdat
4a10: 29 29 0a 09 09 20 20 20 20 20 28 74 65 73 74 69 ))... (testi
4a20: 6e 66 6f 20 20 28 64 62 3a 67 65 74 2d 74 65 73 nfo (db:get-tes
4a30: 74 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 t-info db run-id
4a40: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
4a50: 70 61 74 68 29 29 29 0a 09 09 28 69 66 20 28 6e path)))...(if (n
4a60: 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 ot (equal? (db:t
4a70: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 est-get-state te
4a80: 73 74 69 6e 66 6f 29 20 22 43 4f 4d 50 4c 45 54 stinfo) "COMPLET
4a90: 45 44 22 29 29 0a 09 09 20 20 20 20 28 62 65 67 ED"))... (beg
4aa0: 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 in... (debu
4ab0: 67 3a 70 72 69 6e 74 20 32 20 22 54 65 73 74 20 g:print 2 "Test
4ac0: 4e 4f 54 20 6c 6f 67 67 65 64 20 61 73 20 43 4f NOT logged as CO
4ad0: 4d 50 4c 45 54 45 44 2c 20 28 73 74 61 74 65 3d MPLETED, (state=
4ae0: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 " (db:test-get-s
4af0: 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 20 22 tate testinfo) "
4b00: 29 2c 20 75 70 64 61 74 69 6e 67 20 72 65 73 75 ), updating resu
4b10: 6c 74 22 29 0a 09 09 20 20 20 20 20 20 28 74 65 lt")... (te
4b20: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 st-set-status! d
4b30: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
4b40: 6d 65 0a 09 09 09 09 09 28 69 66 20 6b 69 6c 6c me......(if kill
4b50: 2d 6a 6f 62 3f 20 22 4b 49 4c 4c 45 44 22 20 22 -job? "KILLED" "
4b60: 43 4f 4d 50 4c 45 54 45 44 22 29 0a 09 09 09 09 COMPLETED").....
4b70: 09 28 69 66 20 28 76 65 63 74 6f 72 2d 72 65 66 .(if (vector-ref
4b80: 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 20 3b 3b exit-info 1) ;;
4b90: 20 6c 6f 6f 6b 20 61 74 20 74 68 65 20 65 78 69 look at the exi
4ba0: 74 2d 73 74 61 74 75 73 0a 09 09 09 09 09 20 20 t-status......
4bb0: 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 (if (and (not
4bc0: 6b 69 6c 6c 2d 6a 6f 62 3f 29 20 0a 09 09 09 09 kill-job?) .....
4bd0: 09 09 20 20 20 20 20 28 65 71 3f 20 28 76 65 63 .. (eq? (vec
4be0: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
4bf0: 6f 20 32 29 20 30 29 29 0a 09 09 09 09 09 09 22 o 2) 0))......."
4c00: 50 41 53 53 22 0a 09 09 09 09 09 09 22 46 41 49 PASS"......."FAI
4c10: 4c 22 29 0a 09 09 09 09 09 20 20 20 20 22 46 41 L")...... "FA
4c20: 49 4c 22 29 20 69 74 65 6d 64 61 74 20 28 61 72 IL") itemdat (ar
4c30: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
4c40: 20 23 66 29 29 29 0a 09 09 3b 3b 20 66 6f 72 20 #f)))...;; for
4c50: 61 75 74 6f 6d 61 74 65 64 20 63 72 65 61 74 69 automated creati
4c60: 6f 6e 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 70 on of the rollup
4c70: 20 68 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 20 html file this
4c80: 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 2e is a good place.
4c90: 2e 2e 0a 09 09 28 69 66 20 28 6e 6f 74 20 28 65 .....(if (not (e
4ca0: 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 qual? item-path
4cb0: 22 22 29 29 0a 09 09 20 20 20 28 74 65 73 74 73 ""))... (tests
4cc0: 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 :summarize-items
4cd0: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d db run-id test-
4ce0: 6e 61 6d 65 20 23 66 29 29 20 3b 3b 20 64 6f 6e name #f)) ;; don
4cf0: 27 74 20 66 6f 72 63 65 20 2d 20 6a 75 73 74 20 't force - just
4d00: 75 70 64 61 74 65 20 69 66 20 6e 6f 0a 09 09 29 update if no...)
4d10: 0a 09 20 20 20 20 20 20 28 6d 75 74 65 78 2d 75 .. (mutex-u
4d20: 6e 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 20 nlock! m)..
4d30: 20 3b 3b 20 28 65 78 65 63 2d 72 65 73 75 6c 74 ;; (exec-result
4d40: 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 s (cmd-run->list
4d50: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 fullrunscript))
4d60: 20 3b 3b 20 20 28 6c 69 73 74 20 22 3e 22 20 28 ;; (list ">" (
4d70: 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 conc test-name "
4d80: 2d 72 75 6e 2e 6c 6f 67 22 29 29 29 29 0a 09 20 -run.log"))))..
4d90: 20 20 20 20 20 3b 3b 20 28 73 75 63 63 65 73 73 ;; (success
4da0: 20 20 20 20 20 20 65 78 65 63 2d 72 65 73 75 6c exec-resul
4db0: 74 73 29 29 20 3b 3b 20 28 65 71 3f 20 28 63 61 ts)) ;; (eq? (ca
4dc0: 64 72 20 65 78 65 63 2d 72 65 73 75 6c 74 73 29 dr exec-results)
4dd0: 20 30 29 29 29 0a 09 20 20 20 20 20 20 28 64 65 0))).. (de
4de0: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4f 75 74 bug:print 2 "Out
4df0: 70 75 74 20 66 72 6f 6d 20 72 75 6e 6e 69 6e 67 put from running
4e00: 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 " fullrunscript
4e10: 20 22 2c 20 70 69 64 20 22 20 28 76 65 63 74 6f ", pid " (vecto
4e20: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
4e30: 30 29 20 22 20 69 6e 20 77 6f 72 6b 20 61 72 65 0) " in work are
4e40: 61 20 22 20 0a 09 09 20 20 20 20 20 77 6f 72 6b a " ... work
4e50: 2d 61 72 65 61 20 22 3a 5c 6e 3d 3d 3d 3d 5c 6e -area ":\n====\n
4e60: 20 65 78 69 74 20 63 6f 64 65 20 22 20 28 76 65 exit code " (ve
4e70: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
4e80: 66 6f 20 32 29 20 22 5c 6e 22 20 22 3d 3d 3d 3d fo 2) "\n" "====
4e90: 5c 6e 22 29 0a 09 20 20 20 20 20 20 28 73 71 6c \n").. (sql
4ea0: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
4eb0: 62 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e b).. (if (n
4ec0: 6f 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 ot (vector-ref e
4ed0: 78 69 74 2d 69 6e 66 6f 20 31 29 29 0a 09 09 20 xit-info 1))...
4ee0: 20 28 65 78 69 74 20 34 29 29 29 29 29 0a 20 20 (exit 4))))).
4ef0: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
4f00: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
4f10: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
4f20: 67 20 22 2d 73 74 65 70 22 29 0a 20 20 20 20 28 g "-step"). (
4f30: 69 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 if (not (getenv
4f40: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 "MT_CMDINFO"))..
4f50: 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 (begin.. (debug
4f60: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
4f70: 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 MT_CMDINFO env
4f80: 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 2d 73 74 var not set, -st
4f90: 65 70 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 ep must be calle
4fa0: 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 d *inside* a meg
4fb0: 61 74 65 73 74 20 69 6e 76 6f 6b 65 64 20 65 6e atest invoked en
4fc0: 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 20 20 vironment!")..
4fd0: 28 65 78 69 74 20 35 29 29 0a 09 28 6c 65 74 2a (exit 5))..(let*
4fe0: 20 28 28 73 74 65 70 20 20 20 20 20 20 28 61 72 ((step (ar
4ff0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 gs:get-arg "-ste
5000: 70 22 29 29 0a 09 20 20 20 20 20 20 20 28 63 6d p")).. (cm
5010: 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 6f dinfo (read (o
5020: 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 pen-input-string
5030: 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d (base64:base64-
5040: 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 22 decode (getenv "
5050: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 MT_CMDINFO")))))
5060: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 61 .. (testpa
5070: 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 th (assoc/defau
5080: 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 6d lt 'testpath cm
5090: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
50a0: 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f (test-name (asso
50b0: 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d c/default 'test-
50c0: 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 name cmdinfo))..
50d0: 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 (runscrip
50e0: 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
50f0: 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 'runscript cmdi
5100: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 nfo)).. (d
5110: 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f b-host (assoc/
5120: 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 default 'db-host
5130: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
5140: 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 (run-id
5150: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
5160: 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 run-id cmdinf
5170: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 o)).. (ite
5180: 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 mdat (assoc/de
5190: 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 fault 'itemdat
51a0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
51b0: 20 20 20 28 64 62 20 20 20 20 20 20 20 20 23 66 (db #f
51c0: 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 65 ).. (state
51d0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
51e0: 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 g ":state"))..
51f0: 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 28 (status (
5200: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 args:get-arg ":s
5210: 74 61 74 75 73 22 29 29 29 0a 09 20 20 28 63 68 tatus"))).. (ch
5220: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
5230: 65 73 74 70 61 74 68 29 0a 09 20 20 28 69 66 20 estpath).. (if
5240: 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d (not (setup-for-
5250: 72 75 6e 29 29 0a 09 20 20 20 20 20 20 28 62 65 run)).. (be
5260: 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 gin...(debug:pri
5270: 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 nt 0 "Failed to
5280: 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 setup, exiting")
5290: 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 ...(exit 1)))..
52a0: 20 28 73 65 74 21 20 64 62 20 28 6f 70 65 6e 2d (set! db (open-
52b0: 64 62 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 db)).. (if (and
52c0: 20 73 74 61 74 65 20 73 74 61 74 75 73 29 0a 09 state status)..
52d0: 20 20 20 20 20 20 28 74 65 73 74 73 74 65 70 2d (teststep-
52e0: 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 72 set-status! db r
52f0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
5300: 73 74 65 70 20 73 74 61 74 65 20 73 74 61 74 75 step state statu
5310: 73 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a s itemdat (args:
5320: 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 get-arg "-m"))..
5330: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 (begin...(
5340: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
5350: 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 20 73 RROR: You must s
5360: 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 6e pecify :state an
5370: 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 65 d :status with e
5380: 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 73 74 very call to -st
5390: 65 70 22 29 0a 09 09 28 65 78 69 74 20 36 29 29 ep")...(exit 6))
53a0: 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 66 69 ).. (sqlite3:fi
53b0: 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 28 nalize! db).. (
53c0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
53d0: 6e 67 2a 20 23 74 29 29 29 29 0a 0a 28 69 66 20 ng* #t))))..(if
53e0: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
53f0: 67 20 22 2d 73 65 74 6c 6f 67 22 29 20 20 20 20 g "-setlog")
5400: 20 20 20 3b 3b 20 73 69 6e 63 65 20 73 65 74 74 ;; since sett
5410: 69 6e 67 20 75 70 20 69 73 20 73 6f 20 63 6f 73 ing up is so cos
5420: 74 6c 79 20 6c 65 74 73 20 70 69 67 67 79 62 61 tly lets piggyba
5430: 63 6b 20 6f 6e 20 2d 74 65 73 74 2d 73 74 61 74 ck on -test-stat
5440: 75 73 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 us..(args:get-ar
5450: 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 g "-set-toplog")
5460: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
5470: 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a "-test-status").
5480: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
5490: 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 0a 09 28 -set-values")..(
54a0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
54b0: 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a oad-test-data").
54c0: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
54d0: 2d 72 75 6e 73 74 65 70 22 29 0a 09 28 61 72 67 -runstep")..(arg
54e0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d 6d s:get-arg "-summ
54f0: 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 29 0a 20 arize-items")).
5500: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 74 (if (not (get
5510: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
5520: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
5530: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
5540: 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 ROR: MT_CMDINFO
5550: 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c env var not set,
5560: 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 65 73 74 2d commands -test-
5570: 73 74 61 74 75 73 2c 20 2d 72 75 6e 73 74 65 70 status, -runstep
5580: 20 61 6e 64 20 2d 73 65 74 6c 6f 67 20 6d 75 73 and -setlog mus
5590: 74 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 t be called *ins
55a0: 69 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 ide* a megatest
55b0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 environment!")..
55c0: 20 20 28 65 78 69 74 20 35 29 29 0a 09 28 6c 65 (exit 5))..(le
55d0: 74 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 t* ((startingdir
55e0: 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 (current-direct
55f0: 6f 72 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 ory)).. (c
5600: 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 mdinfo (read (
5610: 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e open-input-strin
5620: 67 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 g (base64:base64
5630: 2d 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 -decode (getenv
5640: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 "MT_CMDINFO"))))
5650: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 ).. (testp
5660: 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
5670: 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
5680: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
5690: 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 (test-name (ass
56a0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
56b0: 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a -name cmdinfo)).
56c0: 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 . (runscri
56d0: 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c pt (assoc/defaul
56e0: 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 t 'runscript cmd
56f0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
5700: 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 db-host (assoc
5710: 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 /default 'db-hos
5720: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
5730: 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id
5740: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
5750: 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 'run-id cmdin
5760: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 fo)).. (it
5770: 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 emdat (assoc/d
5780: 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 efault 'itemdat
5790: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
57a0: 20 20 20 20 28 64 62 20 20 20 20 20 20 20 20 23 (db #
57b0: 66 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 f).. (stat
57c0: 65 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d e (args:get-
57d0: 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 arg ":state"))..
57e0: 20 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 (status
57f0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
5800: 22 3a 73 74 61 74 75 73 22 29 29 29 0a 09 20 20 ":status")))..
5810: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
5820: 79 20 74 65 73 74 70 61 74 68 29 0a 09 20 20 28 y testpath).. (
5830: 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 if (not (setup-f
5840: 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 or-run))..
5850: 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a (begin...(debug:
5860: 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 print 0 "Failed
5870: 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
5880: 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 g")...(exit 1)))
5890: 0a 09 20 20 28 73 65 74 21 20 64 62 20 28 6f 70 .. (set! db (op
58a0: 65 6e 2d 64 62 29 29 0a 09 20 20 28 69 66 20 28 en-db)).. (if (
58b0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
58c0: 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 0a oad-test-data").
58d0: 09 20 20 20 20 20 20 28 64 62 3a 6c 6f 61 64 2d . (db:load-
58e0: 74 65 73 74 2d 64 61 74 61 20 64 62 20 72 75 6e test-data db run
58f0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
5900: 65 6d 64 61 74 29 29 0a 09 20 20 28 69 66 20 28 emdat)).. (if (
5910: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
5920: 65 74 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 28 etlog").. (
5930: 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 64 62 test-set-log! db
5940: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
5950: 65 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a e itemdat (args:
5960: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 get-arg "-setlog
5970: 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 "))).. (if (arg
5980: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
5990: 74 6f 70 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 toplog")..
59a0: 28 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 (test-set-toplog
59b0: 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 ! db run-id test
59c0: 2d 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d -name (args:get-
59d0: 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 arg "-set-toplog
59e0: 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 "))).. (if (arg
59f0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d 6d s:get-arg "-summ
5a00: 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 0a 09 20 arize-items")..
5a10: 20 20 20 20 20 28 74 65 73 74 73 3a 73 75 6d 6d (tests:summ
5a20: 61 72 69 7a 65 2d 69 74 65 6d 73 20 64 62 20 72 arize-items db r
5a30: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
5a40: 23 74 29 29 20 3b 3b 20 64 6f 20 66 6f 72 63 65 #t)) ;; do force
5a50: 20 68 65 72 65 0a 09 20 20 28 69 66 20 28 61 72 here.. (if (ar
5a60: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
5a70: 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 28 69 step").. (i
5a80: 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 f (null? remargs
5a90: 29 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 )... (begin...
5aa0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
5ab0: 30 20 22 45 52 52 4f 52 3a 20 6e 6f 74 68 69 6e 0 "ERROR: nothin
5ac0: 67 20 73 70 65 63 69 66 69 65 64 20 74 6f 20 72 g specified to r
5ad0: 75 6e 21 22 29 0a 09 09 20 20 20 20 28 73 71 6c un!")... (sql
5ae0: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
5af0: 62 29 0a 09 09 20 20 20 20 28 65 78 69 74 20 36 b)... (exit 6
5b00: 29 29 0a 09 09 20 20 28 6c 65 74 2a 20 28 28 73 ))... (let* ((s
5b10: 74 65 70 6e 61 6d 65 20 20 20 28 61 72 67 73 3a tepname (args:
5b20: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 get-arg "-runste
5b30: 70 22 29 29 0a 09 09 09 20 28 6c 6f 67 70 72 6f p")).... (logpro
5b40: 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 file (args:get-a
5b50: 72 67 20 22 2d 6c 6f 67 70 72 6f 22 29 29 0a 09 rg "-logpro"))..
5b60: 09 09 20 28 6c 6f 67 66 69 6c 65 20 20 20 20 28 .. (logfile (
5b70: 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e conc stepname ".
5b80: 6c 6f 67 22 29 29 0a 09 09 09 20 28 63 6d 64 20 log")).... (cmd
5b90: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null
5ba0: 3f 20 72 65 6d 61 72 67 73 29 20 23 66 20 28 63 ? remargs) #f (c
5bb0: 61 72 20 72 65 6d 61 72 67 73 29 29 29 0a 09 09 ar remargs)))...
5bc0: 09 20 28 70 61 72 61 6d 73 20 20 20 20 20 28 69 . (params (i
5bd0: 66 20 63 6d 64 20 28 63 64 72 20 72 65 6d 61 72 f cmd (cdr remar
5be0: 67 73 29 20 27 28 29 29 29 0a 09 09 09 20 28 65 gs) '())).... (e
5bf0: 78 69 74 73 74 61 74 20 20 20 23 66 29 0a 09 09 xitstat #f)...
5c00: 09 20 28 73 68 65 6c 6c 20 20 20 20 20 20 28 6c . (shell (l
5c10: 61 73 74 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 ast (string-spli
5c20: 74 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 t (get-environme
5c30: 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 53 48 45 nt-variable "SHE
5c40: 4c 4c 22 29 20 22 2f 22 29 29 29 0a 09 09 09 20 LL") "/")))....
5c50: 28 72 65 64 69 72 20 20 20 20 20 20 28 63 61 73 (redir (cas
5c60: 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f e (string->symbo
5c70: 6c 20 73 68 65 6c 6c 29 0a 09 09 09 09 20 20 20 l shell).....
5c80: 20 20 20 20 28 28 74 63 73 68 20 63 73 68 20 6b ((tcsh csh k
5c90: 73 68 29 20 20 20 20 22 3e 26 22 29 0a 09 09 09 sh) ">&")....
5ca0: 09 20 20 20 20 20 20 20 28 28 7a 73 68 20 62 61 . ((zsh ba
5cb0: 73 68 20 73 68 20 61 73 68 29 20 22 32 3e 26 31 sh sh ash) "2>&1
5cc0: 20 3e 22 29 29 29 0a 09 09 09 20 28 66 75 6c 6c >"))).... (full
5cd0: 63 6d 64 20 20 20 20 28 63 6f 6e 63 20 22 28 22 cmd (conc "("
5ce0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
5cf0: 65 72 73 65 20 0a 09 09 09 09 09 09 28 63 6f 6e erse .......(con
5d00: 73 20 63 6d 64 20 70 61 72 61 6d 73 29 20 22 20 s cmd params) "
5d10: 22 29 0a 09 09 09 09 09 20 20 20 22 29 20 22 20 ")...... ") "
5d20: 72 65 64 69 72 20 22 20 22 20 6c 6f 67 66 69 6c redir " " logfil
5d30: 65 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 6d 61 e)))... ;; ma
5d40: 72 6b 20 74 68 65 20 73 74 61 72 74 20 6f 66 20 rk the start of
5d50: 74 68 65 20 74 65 73 74 0a 09 09 20 20 20 20 28 the test... (
5d60: 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
5d70: 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 tus! db run-id t
5d80: 65 73 74 2d 6e 61 6d 65 20 73 74 65 70 6e 61 6d est-name stepnam
5d90: 65 20 22 73 74 61 72 74 22 20 22 6e 2f 61 22 20 e "start" "n/a"
5da0: 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67 65 itemdat (args:ge
5db0: 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 20 t-arg "-m"))...
5dc0: 20 20 20 3b 3b 20 63 6c 6f 73 65 20 74 68 65 20 ;; close the
5dd0: 64 62 0a 09 09 20 20 20 20 28 73 71 6c 69 74 65 db... (sqlite
5de0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
5df0: 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 74 68 65 .. ;; run the
5e00: 20 74 65 73 74 20 73 74 65 70 0a 09 09 20 20 20 test step...
5e10: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
5e20: 22 49 4e 46 4f 3a 20 52 75 6e 6e 69 6e 67 20 5c "INFO: Running \
5e30: 22 22 20 66 75 6c 6c 63 6d 64 20 22 5c 22 22 29 "" fullcmd "\"")
5e40: 0a 09 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 ... (change-d
5e50: 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e irectory startin
5e60: 67 64 69 72 29 0a 09 09 20 20 20 20 28 73 65 74 gdir)... (set
5e70: 21 20 65 78 69 74 73 74 61 74 20 28 73 79 73 74 ! exitstat (syst
5e80: 65 6d 20 66 75 6c 6c 63 6d 64 29 29 20 3b 3b 20 em fullcmd)) ;;
5e90: 63 6d 64 20 70 61 72 61 6d 73 29 29 0a 09 09 20 cmd params))...
5ea0: 20 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c (set! *global
5eb0: 65 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 74 exitstatus* exit
5ec0: 73 74 61 74 29 0a 09 09 20 20 20 20 28 63 68 61 stat)... (cha
5ed0: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 nge-directory te
5ee0: 73 74 70 61 74 68 29 0a 09 09 20 20 20 20 3b 3b stpath)... ;;
5ef0: 20 72 65 2d 6f 70 65 6e 20 74 68 65 20 64 62 0a re-open the db.
5f00: 09 09 20 20 20 20 28 73 65 74 21 20 64 62 20 28 .. (set! db (
5f10: 6f 70 65 6e 2d 64 62 29 29 20 0a 09 09 20 20 20 open-db)) ...
5f20: 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 ;; run logpro i
5f30: 66 20 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b 20 f applicable ;;
5f40: 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c 73 (process-run "ls
5f50: 22 20 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20 22 " (list "/foo" "
5f60: 32 3e 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67 22 2>&1" "blah.log"
5f70: 29 29 0a 09 09 20 20 20 20 28 69 66 20 6c 6f 67 ))... (if log
5f80: 70 72 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74 2a profile....(let*
5f90: 20 28 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 28 ((htmllogfile (
5fa0: 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e conc stepname ".
5fb0: 68 74 6d 6c 22 29 29 0a 09 09 09 20 20 20 20 20 html"))....
5fc0: 20 20 28 6f 6c 64 65 78 69 74 73 74 61 74 20 65 (oldexitstat e
5fd0: 78 69 74 73 74 61 74 29 0a 09 09 09 20 20 20 20 xitstat)....
5fe0: 20 20 20 28 63 6d 64 20 20 20 20 20 20 20 20 20 (cmd
5ff0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
6000: 72 73 65 20 28 6c 69 73 74 20 22 6c 6f 67 70 72 rse (list "logpr
6010: 6f 22 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68 74 o" logprofile ht
6020: 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c 6f mllogfile "<" lo
6030: 67 66 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63 20 gfile ">" (conc
6040: 73 74 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70 72 stepname "_logpr
6050: 6f 2e 6c 6f 67 22 29 29 20 22 20 22 29 29 29 0a o.log")) " "))).
6060: 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
6070: 74 20 32 20 22 49 4e 46 4f 3a 20 72 75 6e 6e 69 t 2 "INFO: runni
6080: 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 29 ng \"" cmd "\"")
6090: 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 .... (change-di
60a0: 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 rectory starting
60b0: 64 69 72 29 0a 09 09 09 20 20 28 73 65 74 21 20 dir).... (set!
60c0: 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65 6d exitstat (system
60d0: 20 63 6d 64 29 29 0a 09 09 09 20 20 28 73 65 74 cmd)).... (set
60e0: 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 ! *globalexitsta
60f0: 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 20 3b tus* exitstat) ;
6100: 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 0a 09 ; no necessary..
6110: 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 .. (change-dire
6120: 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a ctory testpath).
6130: 09 09 09 20 20 28 74 65 73 74 2d 73 65 74 2d 6c ... (test-set-l
6140: 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 og! db run-id te
6150: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 20 st-name itemdat
6160: 68 74 6d 6c 6c 6f 67 66 69 6c 65 29 29 29 0a 09 htmllogfile)))..
6170: 09 20 20 20 20 28 74 65 73 74 73 74 65 70 2d 73 . (teststep-s
6180: 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 et-status! db ru
6190: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 73 n-id test-name s
61a0: 74 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 78 tepname "end" ex
61b0: 69 74 73 74 61 74 20 69 74 65 6d 64 61 74 20 28 itstat itemdat (
61c0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
61d0: 22 29 29 0a 09 09 20 20 20 20 28 73 71 6c 69 74 "))... (sqlit
61e0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
61f0: 0a 09 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 ... (if (not
6200: 28 65 71 3f 20 65 78 69 74 73 74 61 74 20 30 29 (eq? exitstat 0)
6210: 29 0a 09 09 09 28 65 78 69 74 20 32 35 34 29 29 )....(exit 254))
6220: 20 3b 3b 20 28 65 78 69 74 20 65 78 69 74 73 74 ;; (exit exitst
6230: 61 74 29 20 64 6f 65 73 6e 27 74 20 77 6f 72 6b at) doesn't work
6240: 3f 21 3f 0a 09 09 20 20 3b 3b 20 6f 70 65 6e 20 ?!?... ;; open
6250: 74 68 65 20 64 62 0a 09 09 20 20 3b 3b 20 6d 61 the db... ;; ma
6260: 72 6b 20 74 68 65 20 65 6e 64 20 6f 66 20 74 68 rk the end of th
6270: 65 20 74 65 73 74 0a 09 09 20 20 29 29 29 0a 09 e test... )))..
6280: 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a (if (or (args:
6290: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 get-arg "-test-s
62a0: 74 61 74 75 73 22 29 0a 09 09 20 20 28 61 72 67 tatus")... (arg
62b0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
62c0: 76 61 6c 75 65 73 22 29 29 0a 09 20 20 20 20 20 values"))..
62d0: 20 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 75 (let ((newstatu
62e0: 73 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e 75 s (cond.....((nu
62f0: 6d 62 65 72 3f 20 73 74 61 74 75 73 29 20 20 20 mber? status)
6300: 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 (if (equal?
6310: 73 74 61 74 75 73 20 30 29 20 22 50 41 53 53 22 status 0) "PASS"
6320: 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 28 "FAIL")).....((
6330: 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 74 61 and (string? sta
6340: 74 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 28 tus)..... (
6350: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 string->number s
6360: 74 61 74 75 73 29 29 28 69 66 20 28 65 71 75 61 tatus))(if (equa
6370: 6c 3f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 l? (string->numb
6380: 65 72 20 73 74 61 74 75 73 29 20 30 29 20 22 50 er status) 0) "P
6390: 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 09 ASS" "FAIL"))...
63a0: 09 09 28 65 6c 73 65 20 73 74 61 74 75 73 29 29 ..(else status))
63b0: 29 0a 09 09 20 20 20 20 3b 3b 20 74 72 61 6e 73 )... ;; trans
63c0: 66 65 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 79 fer relevant key
63d0: 73 20 69 6e 74 6f 20 61 20 68 61 73 68 20 74 6f s into a hash to
63e0: 20 62 65 20 70 61 73 73 65 64 20 74 6f 20 74 65 be passed to te
63f0: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a 09 st-set-status!..
6400: 09 20 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 73 . ;; could us
6410: 65 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 20 e an assoc list
6420: 49 20 67 75 65 73 73 2e 20 0a 09 09 20 20 20 20 I guess. ...
6430: 28 6f 74 68 65 72 64 61 74 61 20 28 6c 65 74 20 (otherdata (let
6440: 28 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 68 ((res (make-hash
6450: 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 09 20 28 -table)))..... (
6460: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
6470: 20 28 6b 65 79 29 0a 09 09 09 09 09 20 20 20 20 (key)......
6480: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
6490: 72 67 20 6b 65 79 29 0a 09 09 09 09 09 09 20 28 rg key)....... (
64a0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
64b0: 72 65 73 20 6b 65 79 20 28 61 72 67 73 3a 67 65 res key (args:ge
64c0: 74 2d 61 72 67 20 6b 65 79 29 29 29 29 0a 09 09 t-arg key))))...
64d0: 09 09 09 20 20 20 28 6c 69 73 74 20 22 3a 76 61 ... (list ":va
64e0: 6c 75 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 78 lue" ":tol" ":ex
64f0: 70 65 63 74 65 64 22 20 22 3a 66 69 72 73 74 5f pected" ":first_
6500: 65 72 72 22 20 22 3a 66 69 72 73 74 5f 77 61 72 err" ":first_war
6510: 6e 22 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 61 n" ":units" ":ca
6520: 74 65 67 6f 72 79 22 20 22 3a 76 61 72 69 61 62 tegory" ":variab
6530: 6c 65 22 29 29 0a 09 09 09 09 20 72 65 73 29 29 le"))..... res))
6540: 29 0a 09 09 28 69 66 20 28 61 6e 64 20 28 61 72 )...(if (and (ar
6550: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
6560: 74 2d 73 74 61 74 75 73 22 29 0a 09 09 09 20 28 t-status").... (
6570: 6f 72 20 28 6e 6f 74 20 73 74 61 74 65 29 0a 09 or (not state)..
6580: 09 09 20 20 20 20 20 28 6e 6f 74 20 73 74 61 74 .. (not stat
6590: 75 73 29 29 29 0a 09 09 20 20 20 20 28 62 65 67 us)))... (beg
65a0: 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 in... (debu
65b0: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
65c0: 3a 20 59 6f 75 20 6d 75 73 74 20 73 70 65 63 69 : You must speci
65d0: 66 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 fy :state and :s
65e0: 74 61 74 75 73 20 77 69 74 68 20 65 76 65 72 79 tatus with every
65f0: 20 63 61 6c 6c 20 74 6f 20 2d 74 65 73 74 2d 73 call to -test-s
6600: 74 61 74 75 73 5c 6e 22 20 68 65 6c 70 29 0a 09 tatus\n" help)..
6610: 09 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a . (sqlite3:
6620: 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 finalize! db)...
6630: 20 20 20 20 20 20 28 65 78 69 74 20 36 29 29 29 (exit 6)))
6640: 0a 09 09 28 74 65 73 74 2d 73 65 74 2d 73 74 61 ...(test-set-sta
6650: 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 tus! db run-id t
6660: 65 73 74 2d 6e 61 6d 65 20 73 74 61 74 65 20 6e est-name state n
6670: 65 77 73 74 61 74 75 73 20 69 74 65 6d 64 61 74 ewstatus itemdat
6680: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6690: 2d 6d 22 29 20 6f 74 68 65 72 64 61 74 61 29 29 -m") otherdata))
66a0: 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 66 69 ).. (sqlite3:fi
66b0: 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 28 nalize! db).. (
66c0: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
66d0: 6e 67 2a 20 23 74 29 29 29 29 0a 0a 28 69 66 20 ng* #t))))..(if
66e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
66f0: 73 68 6f 77 6b 65 79 73 22 29 0a 20 20 20 20 28 showkeys"). (
6700: 6c 65 74 20 28 28 64 62 20 23 66 29 0a 09 20 20 let ((db #f)..
6710: 28 6b 65 79 73 20 23 66 29 29 0a 20 20 20 20 20 (keys #f)).
6720: 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 (if (not (setup
6730: 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 62 -for-run)).. (b
6740: 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 egin.. (debug
6750: 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 :print 0 "Failed
6760: 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 to setup, exiti
6770: 6e 67 22 29 0a 09 20 20 20 20 28 65 78 69 74 20 ng").. (exit
6780: 31 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 1))). (set!
6790: 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 20 db (open-db)).
67a0: 20 20 20 20 20 28 73 65 74 21 20 6b 65 79 73 20 (set! keys
67b0: 28 64 62 2d 67 65 74 2d 6b 65 79 73 20 64 62 29 (db-get-keys db)
67c0: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
67d0: 72 69 6e 74 20 31 20 22 4b 65 79 73 3a 20 22 20 rint 1 "Keys: "
67e0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
67f0: 72 73 65 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 rse (map key:get
6800: 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 -fieldname keys)
6810: 20 22 2c 20 22 29 29 0a 20 20 20 20 20 20 28 73 ", ")). (s
6820: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
6830: 20 64 62 29 0a 20 20 20 20 20 20 28 73 65 74 21 db). (set!
6840: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
6850: 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 #t)))..(if (args
6860: 3a 67 65 74 2d 61 72 67 20 22 2d 67 75 69 22 29 :get-arg "-gui")
6870: 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
6880: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
6890: 20 22 4c 6f 6f 6b 20 61 74 20 74 68 65 20 64 61 "Look at the da
68a0: 73 68 62 6f 61 72 64 20 66 6f 72 20 6e 6f 77 22 shboard for now"
68b0: 29 0a 20 20 20 20 20 20 3b 3b 20 28 6d 65 67 61 ). ;; (mega
68c0: 74 65 73 74 2d 67 75 69 29 0a 20 20 20 20 20 20 test-gui).
68d0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
68e0: 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d ing* #t)))..;;==
68f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6930: 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 ====.;; Update t
6940: 68 65 20 64 61 74 61 62 61 73 65 20 73 63 68 65 he database sche
6950: 6d 61 20 6f 6e 20 72 65 71 75 65 73 74 0a 3b 3b ma on request.;;
6960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
69a0: 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 ======..(if (arg
69b0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 62 75 s:get-arg "-rebu
69c0: 69 6c 64 2d 64 62 22 29 0a 20 20 20 20 28 62 65 ild-db"). (be
69d0: 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e gin. (if (n
69e0: 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 ot (setup-for-ru
69f0: 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 n)).. (begin..
6a00: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
6a10: 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 0 "Failed to set
6a20: 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 up, exiting") ..
6a30: 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
6a40: 20 20 20 20 20 3b 3b 20 6e 6f 77 20 63 61 6e 20 ;; now can
6a50: 66 69 6e 64 20 6f 75 72 20 64 62 0a 20 20 20 20 find our db.
6a60: 20 20 28 73 65 74 21 20 64 62 20 28 6f 70 65 6e (set! db (open
6a70: 2d 64 62 29 29 0a 20 20 20 20 20 20 28 70 61 74 -db)). (pat
6a80: 63 68 2d 64 62 20 64 62 29 0a 20 20 20 20 20 20 ch-db db).
6a90: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
6aa0: 65 21 20 64 62 29 0a 20 20 20 20 20 20 28 73 65 e! db). (se
6ab0: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
6ac0: 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d * #t)))..;;=====
6ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6b10: 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 =.;; Update the
6b20: 74 65 73 74 73 20 6d 65 74 61 20 64 61 74 61 20 tests meta data
6b30: 66 72 6f 6d 20 74 68 65 20 74 65 73 74 63 6f 6e from the testcon
6b40: 66 69 67 20 66 69 6c 65 73 0a 3b 3b 0a 0a 28 69 fig files.;;..(i
6b50: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
6b60: 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 22 29 0a "-update-meta").
6b70: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
6b80: 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 (if (not (setup
6b90: 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 62 -for-run)).. (b
6ba0: 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 egin.. (debug
6bb0: 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 :print 0 "Failed
6bc0: 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 to setup, exiti
6bd0: 6e 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 ng") .. (exit
6be0: 20 31 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6e 1))). ;; n
6bf0: 6f 77 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 ow can find our
6c00: 64 62 0a 20 20 20 20 20 20 28 73 65 74 21 20 64 db. (set! d
6c10: 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 20 20 20 b (open-db)).
6c20: 20 20 20 28 72 75 6e 73 3a 75 70 64 61 74 65 2d (runs:update-
6c30: 61 6c 6c 2d 74 65 73 74 5f 6d 65 74 61 20 64 62 all-test_meta db
6c40: 29 0a 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 ). (sqlite3
6c50: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 20 :finalize! db).
6c60: 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
6c70: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
6c80: 0a 28 69 66 20 28 6e 6f 74 20 2a 64 69 64 73 6f .(if (not *didso
6c90: 6d 65 74 68 69 6e 67 2a 29 0a 20 20 20 20 28 64 mething*). (d
6ca0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 68 65 6c ebug:print 0 hel
6cb0: 70 29 29 0a 0a 28 69 66 20 28 6e 6f 74 20 28 65 p))..(if (not (e
6cc0: 71 3f 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 q? *globalexitst
6cd0: 61 74 75 73 2a 20 30 29 29 0a 20 20 20 20 28 69 atus* 0)). (i
6ce0: 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d f (or (args:get-
6cf0: 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 arg "-runtests")
6d00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6d10: 72 75 6e 61 6c 6c 22 29 29 0a 20 20 20 20 20 20 runall")).
6d20: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
6d30: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6d40: 20 30 20 22 4e 4f 54 45 3a 20 53 75 62 70 72 6f 0 "NOTE: Subpro
6d50: 63 65 73 73 65 73 20 77 69 74 68 20 6e 6f 6e 2d cesses with non-
6d60: 7a 65 72 6f 20 65 78 69 74 20 63 6f 64 65 20 64 zero exit code d
6d70: 65 74 65 63 74 65 64 3a 20 22 20 2a 67 6c 6f 62 etected: " *glob
6d80: 61 6c 65 78 69 74 73 74 61 74 75 73 2a 29 0a 20 alexitstatus*).
6d90: 20 20 20 20 20 20 20 20 20 20 28 65 78 69 74 20 (exit
6da0: 30 29 29 0a 20 20 20 20 20 20 20 20 28 63 61 73 0)). (cas
6db0: 65 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 e *globalexitsta
6dc0: 74 75 73 2a 0a 20 20 20 20 20 20 20 20 20 28 28 tus*. ((
6dd0: 30 29 28 65 78 69 74 20 30 29 29 0a 20 20 20 20 0)(exit 0)).
6de0: 20 20 20 20 20 28 28 31 29 28 65 78 69 74 20 31 ((1)(exit 1
6df0: 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 32 29 )). ((2)
6e00: 28 65 78 69 74 20 32 29 29 0a 20 20 20 20 20 20 (exit 2)).
6e10: 20 20 20 28 65 6c 73 65 20 28 65 78 69 74 20 33 (else (exit 3
6e20: 29 29 29 29 29 0a ))))).