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 3b 3b 20 28 69 6e PURPOSE...;; (in
0150: 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 2e 73 63 clude "common.sc
0160: 6d 22 29 0a 3b 3b 20 28 69 6e 63 6c 75 64 65 20 m").;; (include
0170: 22 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f "megatest-versio
0180: 6e 2e 73 63 6d 22 29 0a 0a 28 64 65 63 6c 61 72 n.scm")..(declar
0190: 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 e (uses common))
01a0: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
01b0: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
01c0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
01d0: 73 20 6d 61 72 67 73 29 29 0a 28 64 65 63 6c 61 s margs)).(decla
01e0: 72 65 20 28 75 73 65 73 20 72 75 6e 73 29 29 0a re (uses runs)).
01f0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6c (declare (uses l
0200: 61 75 6e 63 68 29 29 0a 0a 28 69 6e 63 6c 75 64 aunch))..(includ
0210: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
0220: 73 2e 73 63 6d 22 29 0a 0a 28 64 65 66 69 6e 65 s.scm")..(define
0230: 20 68 65 6c 70 20 28 63 6f 6e 63 20 22 0a 4d 65 help (conc ".Me
0240: 67 61 74 65 73 74 2c 20 64 6f 63 75 6d 65 6e 74 gatest, document
0250: 61 74 69 6f 6e 20 61 74 20 68 74 74 70 3a 2f 2f ation at http://
0260: 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 www.kiatoa.com/f
0270: 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 0a ossils/megatest.
0280: 20 20 76 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 version " mega
0290: 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 0a 20 test-version ".
02a0: 20 6c 69 63 65 6e 73 65 20 47 50 4c 2c 20 43 6f license GPL, Co
02b0: 70 79 72 69 67 68 74 20 4d 61 74 74 20 57 65 6c pyright Matt Wel
02c0: 6c 61 6e 64 20 32 30 30 36 2d 32 30 31 31 0a 0a land 2006-2011..
02d0: 55 73 61 67 65 3a 20 6d 65 67 61 74 65 73 74 20 Usage: megatest
02e0: 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 2d 68 20 20 [options]. -h
02f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0300: 20 20 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a : this help.
0310: 0a 50 72 6f 63 65 73 73 20 61 6e 64 20 74 65 73 .Process and tes
0320: 74 20 72 75 6e 6e 69 6e 67 0a 20 20 2d 72 75 6e t running. -run
0330: 61 6c 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 all
0340: 20 20 20 20 3a 20 72 75 6e 20 61 6c 6c 20 74 65 : run all te
0350: 73 74 73 20 74 68 61 74 20 61 72 65 20 6e 6f 74 sts that are not
0360: 20 73 74 61 74 65 20 43 4f 4d 50 4c 45 54 45 44 state COMPLETED
0370: 20 61 6e 64 20 73 74 61 74 75 73 20 50 41 53 53 and status PASS
0380: 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 , .
0390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 43 C
03a0: 48 45 43 4b 20 6f 72 20 4b 49 4c 4c 45 44 0a 20 HECK or KILLED.
03b0: 20 2d 72 75 6e 74 65 73 74 73 20 74 73 74 31 2c -runtests tst1,
03c0: 74 73 74 32 20 2e 2e 2e 20 3a 20 72 75 6e 20 74 tst2 ... : run t
03d0: 65 73 74 73 0a 0a 52 75 6e 20 73 74 61 74 75 73 ests..Run status
03e0: 20 75 70 64 61 74 65 73 20 28 74 68 65 73 65 20 updates (these
03f0: 72 65 71 75 69 72 65 20 74 68 61 74 20 79 6f 75 require that you
0400: 20 61 72 65 20 69 6e 20 61 20 74 65 73 74 20 64 are in a test d
0410: 69 72 65 63 74 6f 72 79 0a 20 20 20 20 20 20 20 irectory.
0420: 20 20 20 20 20 20 20 20 20 20 20 20 20 61 6e 64 and
0430: 20 79 6f 75 20 68 61 76 65 20 73 6f 75 72 63 65 you have source
0440: 64 20 74 68 65 20 5c 22 6d 65 67 61 74 65 73 74 d the \"megatest
0450: 2e 63 73 68 5c 22 20 6f 72 0a 20 20 20 20 20 20 .csh\" or.
0460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5c 22 \"
0470: 6d 65 67 61 74 65 73 74 2e 73 68 5c 22 20 66 69 megatest.sh\" fi
0480: 6c 65 2e 29 0a 20 20 2d 73 74 65 70 20 73 74 65 le.). -step ste
0490: 70 6e 61 6d 65 0a 20 20 2d 74 65 73 74 2d 73 74 pname. -test-st
04a0: 61 74 75 73 20 20 20 20 20 20 20 20 20 20 20 20 atus
04b0: 3a 20 73 65 74 20 74 68 65 20 73 74 61 74 65 20 : set the state
04c0: 61 6e 64 20 73 74 61 74 75 73 20 6f 66 20 61 20 and status of a
04d0: 74 65 73 74 20 28 75 73 65 20 3a 73 74 61 74 65 test (use :state
04e0: 20 61 6e 64 20 3a 73 74 61 74 75 73 29 0a 20 20 and :status).
04f0: 2d 73 65 74 6c 6f 67 20 6c 6f 67 66 6e 61 6d 65 -setlog logfname
0500: 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 : set th
0510: 65 20 70 61 74 68 2f 66 69 6c 65 6e 61 6d 65 20 e path/filename
0520: 74 6f 20 74 68 65 20 66 69 6e 61 6c 20 6c 6f 67 to the final log
0530: 20 72 65 6c 61 74 69 76 65 20 74 6f 20 74 68 65 relative to the
0540: 20 74 65 73 74 0a 20 20 20 20 20 20 20 20 20 20 test.
0550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0560: 20 20 64 69 72 65 63 74 6f 72 79 2e 20 6d 61 79 directory. may
0570: 20 62 65 20 75 73 65 64 20 77 69 74 68 20 2d 74 be used with -t
0580: 65 73 74 2d 73 74 61 74 75 73 0a 20 20 2d 73 65 est-status. -se
0590: 74 2d 74 6f 70 6c 6f 67 20 6c 6f 67 66 6e 61 6d t-toplog logfnam
05a0: 65 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 6f e : set the o
05b0: 76 65 72 61 6c 6c 20 6c 6f 67 20 66 6f 72 20 61 verall log for a
05c0: 20 73 75 69 74 65 20 6f 66 20 73 75 62 2d 74 65 suite of sub-te
05d0: 73 74 73 0a 20 20 2d 73 75 6d 6d 61 72 69 7a 65 sts. -summarize
05e0: 2d 69 74 65 6d 73 20 20 20 20 20 20 20 20 3a 20 -items :
05f0: 66 6f 72 20 61 6e 20 69 74 65 6d 69 7a 65 64 20 for an itemized
0600: 74 65 73 74 20 63 72 65 61 74 65 20 61 20 73 75 test create a su
0610: 6d 6d 61 72 79 20 68 74 6d 6c 20 0a 20 20 2d 6d mmary html . -m
0620: 20 63 6f 6d 6d 65 6e 74 20 20 20 20 20 20 20 20 comment
0630: 20 20 20 20 20 20 3a 20 69 6e 73 65 72 74 20 61 : insert a
0640: 20 63 6f 6d 6d 65 6e 74 20 66 6f 72 20 74 68 69 comment for thi
0650: 73 20 74 65 73 74 0a 0a 52 75 6e 20 64 61 74 61 s test..Run data
0660: 0a 20 20 3a 72 75 6e 6e 61 6d 65 20 20 20 20 20 . :runname
0670: 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 71 : req
0680: 75 69 72 65 64 2c 20 6e 61 6d 65 20 66 6f 72 20 uired, name for
0690: 74 68 69 73 20 70 61 72 74 69 63 75 6c 61 72 20 this particular
06a0: 74 65 73 74 20 72 75 6e 0a 20 20 3a 73 74 61 74 test run. :stat
06b0: 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e
06c0: 20 20 20 3a 20 72 65 71 75 69 72 65 64 20 69 66 : required if
06d0: 20 75 70 64 61 74 69 6e 67 20 73 74 65 70 20 73 updating step s
06e0: 74 61 74 65 3b 20 65 2e 67 2e 20 73 74 61 72 74 tate; e.g. start
06f0: 2c 20 65 6e 64 2c 20 63 6f 6d 70 6c 65 74 65 64 , end, completed
0700: 0a 20 20 3a 73 74 61 74 75 73 20 20 20 20 20 20 . :status
0710: 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 71 : req
0720: 75 69 72 65 64 20 69 66 20 75 70 64 61 74 69 6e uired if updatin
0730: 67 20 73 74 65 70 20 73 74 61 74 75 73 3b 20 65 g step status; e
0740: 2e 67 2e 20 70 61 73 73 2c 20 66 61 69 6c 2c 20 .g. pass, fail,
0750: 6e 2f 61 0a 0a 56 61 6c 75 65 73 20 61 6e 64 20 n/a..Values and
0760: 72 65 63 6f 72 64 20 65 72 72 6f 72 73 20 61 6e record errors an
0770: 64 20 77 61 72 6e 69 6e 67 73 0a 20 20 2d 73 65 d warnings. -se
0780: 74 2d 76 61 6c 75 65 73 20 20 20 20 20 20 20 20 t-values
0790: 20 20 20 20 20 3a 20 75 70 64 61 74 65 20 6f 72 : update or
07a0: 20 73 65 74 20 76 61 6c 75 65 73 20 69 6e 20 74 set values in t
07b0: 68 65 20 6d 65 67 61 74 65 73 74 20 64 62 20 0a he megatest db .
07c0: 20 20 3a 63 61 74 65 67 6f 72 79 20 20 20 20 20 :category
07d0: 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 : set
07e0: 74 68 65 20 63 61 74 65 67 6f 72 79 20 66 69 65 the category fie
07f0: 6c 64 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 ld (optional).
0800: 3a 76 61 72 69 61 62 6c 65 20 20 20 20 20 20 20 :variable
0810: 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 : set th
0820: 65 20 76 61 72 69 61 62 6c 65 20 6e 61 6d 65 20 e variable name
0830: 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 (optional). :va
0840: 6c 75 65 20 20 20 20 20 20 20 20 20 20 20 20 20 lue
0850: 20 20 20 20 20 3a 20 76 61 6c 75 65 20 6d 65 61 : value mea
0860: 73 75 72 65 64 20 28 72 65 71 75 69 72 65 64 29 sured (required)
0870: 0a 20 20 3a 65 78 70 65 63 74 65 64 20 20 20 20 . :expected
0880: 20 20 20 20 20 20 20 20 20 20 20 3a 20 76 61 6c : val
0890: 75 65 20 65 78 70 65 63 74 65 64 20 28 72 65 71 ue expected (req
08a0: 75 69 72 65 64 29 0a 20 20 3a 74 6f 6c 20 20 20 uired). :tol
08b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
08c0: 20 3a 20 7c 76 61 6c 75 65 2d 65 78 70 65 63 74 : |value-expect
08d0: 7c 20 3c 3d 20 74 6f 6c 20 28 72 65 71 75 69 72 | <= tol (requir
08e0: 65 64 2c 20 63 61 6e 20 62 65 20 3c 2c 20 3e 2c ed, can be <, >,
08f0: 20 3e 3d 2c 20 3c 3d 20 6f 72 20 6e 75 6d 62 65 >=, <= or numbe
0900: 72 29 0a 20 20 3a 75 6e 69 74 73 20 20 20 20 20 r). :units
0910: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6e : n
0920: 61 6d 65 20 6f 66 20 74 68 65 20 75 6e 69 74 73 ame of the units
0930: 20 66 6f 72 20 76 61 6c 75 65 2c 20 65 78 70 65 for value, expe
0940: 63 74 65 64 5f 76 61 6c 75 65 20 65 74 63 2e 20 cted_value etc.
0950: 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a 66 69 (optional). :fi
0960: 72 73 74 5f 65 72 72 20 20 20 20 20 20 20 20 20 rst_err
0970: 20 20 20 20 20 3a 20 72 65 63 6f 72 64 20 61 6e : record an
0980: 20 65 72 72 6f 72 20 6d 65 73 73 61 67 65 0a 20 error message.
0990: 20 3a 66 69 72 73 74 5f 77 61 72 6e 20 20 20 20 :first_warn
09a0: 20 20 20 20 20 20 20 20 20 3a 20 72 65 63 6f 72 : recor
09b0: 64 20 61 20 77 61 72 6e 69 6e 67 20 6d 65 73 73 d a warning mess
09c0: 61 67 65 0a 0a 41 72 62 69 74 72 61 72 79 20 74 age..Arbitrary t
09d0: 65 73 74 20 64 61 74 61 20 6c 6f 61 64 69 6e 67 est data loading
09e0: 0a 20 20 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 . -load-test-da
09f0: 74 61 20 20 20 20 20 20 20 20 20 3a 20 72 65 61 ta : rea
0a00: 64 20 74 65 73 74 20 73 70 65 63 69 66 69 63 20 d test specific
0a10: 64 61 74 61 20 66 6f 72 20 73 74 6f 72 61 67 65 data for storage
0a20: 20 69 6e 20 74 68 65 20 74 65 73 74 5f 64 61 74 in the test_dat
0a30: 61 20 74 61 62 6c 65 0a 20 20 20 20 20 20 20 20 a table.
0a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a50: 20 20 20 20 66 72 6f 6d 20 73 74 61 6e 64 61 72 from standar
0a60: 64 20 69 6e 2e 20 45 61 63 68 20 6c 69 6e 65 20 d in. Each line
0a70: 69 73 20 63 6f 6d 6d 61 20 64 65 6c 69 6d 69 74 is comma delimit
0a80: 65 64 20 77 69 74 68 20 66 6f 75 72 0a 20 20 20 ed with four.
0a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0aa0: 20 20 20 20 20 20 20 20 20 66 69 65 6c 64 73 20 fields
0ab0: 63 61 74 65 67 6f 72 79 2c 76 61 72 69 61 62 6c category,variabl
0ac0: 65 2c 76 61 6c 75 65 2c 63 6f 6d 6d 65 6e 74 0a e,value,comment.
0ad0: 0a 51 75 65 72 69 65 73 0a 20 20 2d 6c 69 73 74 .Queries. -list
0ae0: 2d 72 75 6e 73 20 70 61 74 74 20 20 20 20 20 20 -runs patt
0af0: 20 20 20 3a 20 6c 69 73 74 20 72 75 6e 73 20 6d : list runs m
0b00: 61 74 63 68 69 6e 67 20 70 61 74 74 65 72 6e 20 atching pattern
0b10: 5c 22 70 61 74 74 5c 22 2c 20 25 20 69 73 20 74 \"patt\", % is t
0b20: 68 65 20 77 69 6c 64 63 61 72 64 0a 20 20 2d 74 he wildcard. -t
0b30: 65 73 74 70 61 74 74 20 70 61 74 74 20 20 20 20 estpatt patt
0b40: 20 20 20 20 20 20 3a 20 69 6e 20 6c 69 73 74 2d : in list-
0b50: 72 75 6e 73 20 73 68 6f 77 20 6f 6e 6c 79 20 74 runs show only t
0b60: 68 65 73 65 20 74 65 73 74 73 2c 20 25 20 69 73 hese tests, % is
0b70: 20 74 68 65 20 77 69 6c 64 63 61 72 64 0a 20 20 the wildcard.
0b80: 2d 69 74 65 6d 70 61 74 74 20 70 61 74 74 20 20 -itempatt patt
0b90: 20 20 20 20 20 20 20 20 3a 20 69 6e 20 6c 69 73 : in lis
0ba0: 74 2d 72 75 6e 73 20 73 68 6f 77 20 6f 6e 6c 79 t-runs show only
0bb0: 20 74 65 73 74 73 20 77 69 74 68 20 69 74 65 6d tests with item
0bc0: 73 20 74 68 61 74 20 6d 61 74 63 68 20 70 61 74 s that match pat
0bd0: 74 0a 20 20 2d 73 68 6f 77 6b 65 79 73 20 20 20 t. -showkeys
0be0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 68 : sh
0bf0: 6f 77 20 74 68 65 20 6b 65 79 73 20 75 73 65 64 ow the keys used
0c00: 20 69 6e 20 74 68 69 73 20 6d 65 67 61 74 65 73 in this megates
0c10: 74 20 73 65 74 75 70 0a 0a 4d 69 73 63 20 0a 20 t setup..Misc .
0c20: 20 2d 66 6f 72 63 65 20 20 20 20 20 20 20 20 20 -force
0c30: 20 20 20 20 20 20 20 20 20 3a 20 6f 76 65 72 72 : overr
0c40: 69 64 65 20 73 6f 6d 65 20 63 68 65 63 6b 73 0a ide some checks.
0c50: 20 20 2d 78 74 65 72 6d 20 20 20 20 20 20 20 20 -xterm
0c60: 20 20 20 20 20 20 20 20 20 20 3a 20 73 74 61 72 : star
0c70: 74 20 61 6e 20 78 74 65 72 6d 20 69 6e 73 74 65 t an xterm inste
0c80: 61 64 20 6f 66 20 6c 61 75 6e 63 68 69 6e 67 20 ad of launching
0c90: 74 68 65 20 74 65 73 74 0a 20 20 2d 72 65 6d 6f the test. -remo
0ca0: 76 65 2d 72 75 6e 73 20 20 20 20 20 20 20 20 20 ve-runs
0cb0: 20 20 20 3a 20 72 65 6d 6f 76 65 20 74 68 65 20 : remove the
0cc0: 64 61 74 61 20 66 6f 72 20 61 20 72 75 6e 2c 20 data for a run,
0cd0: 72 65 71 75 69 72 65 73 20 61 6c 6c 20 66 69 65 requires all fie
0ce0: 6c 64 73 20 62 65 20 73 70 65 63 69 66 69 65 64 lds be specified
0cf0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 61 6e 64 and
0d10: 20 3a 72 75 6e 6e 61 6d 65 20 2c 2d 74 65 73 74 :runname ,-test
0d20: 70 61 74 74 20 61 6e 64 20 2d 69 74 65 6d 70 61 patt and -itempa
0d30: 74 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 tt.
0d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 a
0d50: 6e 64 20 2d 74 65 73 74 70 61 74 74 0a 20 20 2d nd -testpatt. -
0d60: 6b 65 65 70 67 6f 69 6e 67 20 20 20 20 20 20 20 keepgoing
0d70: 20 20 20 20 20 20 20 3a 20 63 6f 6e 74 69 6e 75 : continu
0d80: 65 20 72 75 6e 6e 69 6e 67 20 75 6e 74 69 6c 20 e running until
0d90: 6e 6f 20 6a 6f 62 73 20 61 72 65 20 5c 22 4c 41 no jobs are \"LA
0da0: 55 4e 43 48 45 44 5c 22 20 6f 72 0a 20 20 20 20 UNCHED\" or.
0db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0dc0: 20 20 20 20 20 20 20 20 5c 22 4e 4f 54 5f 53 54 \"NOT_ST
0dd0: 41 52 54 45 44 5c 22 0a 20 20 2d 72 65 72 75 6e ARTED\". -rerun
0de0: 20 46 41 49 4c 2c 57 41 52 4e 2e 2e 2e 20 20 20 FAIL,WARN...
0df0: 20 20 3a 20 72 65 2d 72 75 6e 20 69 66 20 63 61 : re-run if ca
0e00: 6c 6c 65 64 20 6f 6e 20 61 20 74 65 73 74 20 74 lled on a test t
0e10: 68 61 74 20 70 72 65 76 69 6f 75 73 6c 79 20 72 hat previously r
0e20: 61 6e 20 28 6e 75 6c 6c 69 66 69 65 64 0a 20 20 an (nullified.
0e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e40: 20 20 20 20 20 20 20 20 20 20 69 66 20 2d 6b 65 if -ke
0e50: 65 70 67 6f 69 6e 67 20 69 73 20 61 6c 73 6f 20 epgoing is also
0e60: 73 70 65 63 69 66 69 65 64 29 0a 20 20 2d 72 65 specified). -re
0e70: 62 75 69 6c 64 2d 64 62 20 20 20 20 20 20 20 20 build-db
0e80: 20 20 20 20 20 3a 20 62 72 69 6e 67 20 74 68 65 : bring the
0e90: 20 64 61 74 61 62 61 73 65 20 73 63 68 65 6d 61 database schema
0ea0: 20 75 70 20 74 6f 20 64 61 74 65 0a 20 20 2d 72 up to date. -r
0eb0: 6f 6c 6c 75 70 20 20 20 20 20 20 20 20 20 20 20 ollup
0ec0: 20 20 20 20 20 20 3a 20 66 69 6c 6c 20 72 75 6e : fill run
0ed0: 20 28 73 65 74 20 62 79 20 3a 72 75 6e 6e 61 6d (set by :runnam
0ee0: 65 29 20 20 77 69 74 68 20 6c 61 74 65 73 74 20 e) with latest
0ef0: 74 65 73 74 28 73 29 20 66 72 6f 6d 0a 20 20 20 test(s) from.
0f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f10: 20 20 20 20 20 20 20 20 20 70 72 69 6f 72 20 72 prior r
0f20: 75 6e 73 20 77 69 74 68 20 73 61 6d 65 20 6b 65 uns with same ke
0f30: 79 73 0a 20 20 2d 72 65 6e 61 6d 65 2d 72 75 6e ys. -rename-run
0f40: 20 3c 72 75 6e 62 3e 20 20 20 20 20 20 3a 20 72 <runb> : r
0f50: 65 6e 61 6d 65 20 72 75 6e 20 28 73 65 74 20 62 ename run (set b
0f60: 79 20 3a 72 75 6e 6e 61 6d 65 29 20 74 6f 20 3c y :runname) to <
0f70: 72 75 6e 62 3e 2c 20 72 65 71 75 69 72 65 73 20 runb>, requires
0f80: 6b 65 79 73 0a 20 20 2d 75 70 64 61 74 65 2d 6d keys. -update-m
0f90: 65 74 61 20 20 20 20 20 20 20 20 20 20 20 20 3a eta :
0fa0: 20 75 70 64 61 74 65 20 74 68 65 20 74 65 73 74 update the test
0fb0: 73 20 6d 65 74 61 64 61 74 61 20 66 6f 72 20 61 s metadata for a
0fc0: 6c 6c 20 74 65 73 74 73 0a 20 20 2d 65 78 74 72 ll tests. -extr
0fd0: 61 63 74 2d 6f 64 73 20 20 20 20 20 20 20 20 20 act-ods
0fe0: 20 20 20 3a 20 65 78 74 72 61 63 74 20 61 6e 20 : extract an
0ff0: 6f 70 65 6e 20 64 6f 63 75 6d 65 6e 74 20 73 70 open document sp
1000: 72 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 74 readsheet from t
1010: 68 65 20 64 61 74 61 62 61 73 65 0a 0a 48 65 6c he database..Hel
1020: 70 65 72 73 0a 20 20 2d 72 75 6e 73 74 65 70 20 pers. -runstep
1030: 73 74 65 70 6e 61 6d 65 20 20 2e 2e 2e 20 20 3a stepname ... :
1040: 20 74 61 6b 65 20 72 65 6d 61 69 6e 69 6e 67 20 take remaining
1050: 70 61 72 61 6d 73 20 61 73 20 63 6f 6d 61 6e 64 params as comand
1060: 20 61 6e 64 20 65 78 65 63 75 74 65 20 61 73 20 and execute as
1070: 73 74 65 70 6e 61 6d 65 0a 20 20 20 20 20 20 20 stepname.
1080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1090: 20 20 20 20 20 6c 6f 67 20 77 69 6c 6c 20 62 65 log will be
10a0: 20 69 6e 20 73 74 65 70 6e 61 6d 65 2e 6c 6f 67 in stepname.log
10b0: 2e 20 42 65 73 74 20 74 6f 20 70 75 74 20 63 6f . Best to put co
10c0: 6d 6d 61 6e 64 20 69 6e 20 71 75 6f 74 65 73 0a mmand in quotes.
10d0: 20 20 2d 6c 6f 67 70 72 6f 20 66 69 6c 65 20 20 -logpro file
10e0: 20 20 20 20 20 20 20 20 20 20 3a 20 77 69 74 68 : with
10f0: 20 2d 65 78 65 63 20 61 70 70 6c 79 20 6c 6f 67 -exec apply log
1100: 70 72 6f 20 66 69 6c 65 20 74 6f 20 73 74 65 70 pro file to step
1110: 6e 61 6d 65 2e 6c 6f 67 2c 20 63 72 65 61 74 65 name.log, create
1120: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
1130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 st
1140: 65 70 6e 61 6d 65 2e 68 74 6d 6c 20 61 6e 64 20 epname.html and
1150: 73 65 74 73 20 6c 6f 67 20 74 6f 20 73 61 6d 65 sets log to same
1160: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1170: 20 20 20 20 20 20 20 20 20 20 20 20 20 49 66 20 If
1180: 75 73 69 6e 67 20 6d 61 6b 65 20 75 73 65 20 73 using make use s
1190: 74 65 70 6e 61 6d 65 5f 6c 6f 67 70 72 6f 2e 6c tepname_logpro.l
11a0: 6f 67 20 61 73 20 79 6f 75 72 20 74 61 72 67 65 og as your targe
11b0: 74 0a 0a 43 61 6c 6c 65 64 20 61 73 20 22 20 28 t..Called as " (
11c0: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
11d0: 73 65 20 28 61 72 67 76 29 20 22 20 22 29 29 29 se (argv) " ")))
11e0: 0a 0a 3b 3b 20 20 2d 67 75 69 20 20 20 20 20 20 ..;; -gui
11f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
1200: 73 74 61 72 74 20 61 20 67 75 69 20 69 6e 74 65 start a gui inte
1210: 72 66 61 63 65 0a 3b 3b 20 20 2d 63 6f 6e 66 69 rface.;; -confi
1220: 67 20 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 g fname
1230: 20 20 3a 20 6f 76 65 72 72 69 64 65 20 74 68 65 : override the
1240: 20 72 75 6e 63 6f 6e 66 69 67 20 66 69 6c 65 20 runconfig file
1250: 77 69 74 68 20 66 6e 61 6d 65 0a 0a 3b 3b 20 70 with fname..;; p
1260: 72 6f 63 65 73 73 20 61 72 67 73 0a 28 64 65 66 rocess args.(def
1270: 69 6e 65 20 72 65 6d 61 72 67 73 20 28 61 72 67 ine remargs (arg
1280: 73 3a 67 65 74 2d 61 72 67 73 20 0a 09 09 20 28 s:get-args ... (
1290: 61 72 67 76 29 0a 09 09 20 28 6c 69 73 74 20 20 argv)... (list
12a0: 22 2d 72 75 6e 74 65 73 74 73 22 20 20 3b 3b 20 "-runtests" ;;
12b0: 72 75 6e 20 61 20 73 70 65 63 69 66 69 63 20 74 run a specific t
12c0: 65 73 74 0a 09 09 09 22 2d 63 6f 6e 66 69 67 22 est...."-config"
12d0: 20 20 20 20 3b 3b 20 6f 76 65 72 72 69 64 65 20 ;; override
12e0: 74 68 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 the config file
12f0: 6e 61 6d 65 0a 09 09 09 22 2d 65 78 65 63 75 74 name...."-execut
1300: 65 22 20 20 20 3b 3b 20 72 75 6e 20 74 68 65 20 e" ;; run the
1310: 63 6f 6d 6d 61 6e 64 20 65 6e 63 6f 64 65 64 20 command encoded
1320: 69 6e 20 74 68 65 20 62 61 73 65 36 34 20 70 61 in the base64 pa
1330: 72 61 6d 65 74 65 72 0a 09 09 09 22 2d 73 74 65 rameter...."-ste
1340: 70 22 0a 09 09 09 22 3a 72 75 6e 6e 61 6d 65 22 p"....":runname"
1350: 20 20 20 0a 09 09 09 22 3a 69 74 65 6d 22 0a 09 ....":item"..
1360: 09 09 22 3a 72 75 6e 6e 61 6d 65 22 20 20 20 0a ..":runname" .
1370: 09 09 09 22 3a 73 74 61 74 65 22 20 20 0a 09 09 ...":state" ...
1380: 09 22 3a 73 74 61 74 75 73 22 0a 09 09 09 22 2d .":status"...."-
1390: 6c 69 73 74 2d 72 75 6e 73 22 0a 09 09 09 22 2d list-runs"...."-
13a0: 74 65 73 74 70 61 74 74 22 20 0a 09 09 09 22 2d testpatt" ...."-
13b0: 69 74 65 6d 70 61 74 74 22 0a 09 09 09 22 2d 73 itempatt"...."-s
13c0: 65 74 6c 6f 67 22 0a 09 09 09 22 2d 73 65 74 2d etlog"...."-set-
13d0: 74 6f 70 6c 6f 67 22 0a 09 09 09 22 2d 72 75 6e toplog"...."-run
13e0: 73 74 65 70 22 0a 09 09 09 22 2d 6c 6f 67 70 72 step"...."-logpr
13f0: 6f 22 0a 09 09 09 22 2d 6d 22 0a 09 09 09 22 2d o"...."-m"...."-
1400: 72 65 72 75 6e 22 0a 09 09 09 22 2d 64 61 79 73 rerun"...."-days
1410: 22 0a 09 09 09 22 2d 72 65 6e 61 6d 65 2d 72 75 "...."-rename-ru
1420: 6e 22 0a 09 09 09 22 2d 74 6f 22 0a 09 09 09 3b n"...."-to"....;
1430: 3b 20 76 61 6c 75 65 73 20 61 6e 64 20 6d 65 73 ; values and mes
1440: 73 61 67 65 73 0a 09 09 09 22 3a 63 61 74 65 67 sages....":categ
1450: 6f 72 79 22 0a 09 09 09 22 3a 76 61 72 69 61 62 ory"....":variab
1460: 6c 65 22 0a 09 09 09 22 3a 66 69 72 73 74 5f 65 le"....":first_e
1470: 72 72 22 0a 09 09 09 22 3a 66 69 72 73 74 5f 77 rr"....":first_w
1480: 61 72 6e 22 0a 09 09 09 22 3a 76 61 6c 75 65 22 arn"....":value"
1490: 0a 09 09 09 22 3a 65 78 70 65 63 74 65 64 22 0a ....":expected".
14a0: 09 09 09 22 3a 74 6f 6c 22 0a 09 09 09 22 3a 75 ...":tol"....":u
14b0: 6e 69 74 73 22 0a 09 09 09 3b 3b 20 6d 69 73 63 nits"....;; misc
14c0: 0a 09 09 09 22 2d 65 78 74 72 61 63 74 2d 6f 64 ...."-extract-od
14d0: 73 22 0a 09 09 09 22 2d 64 65 62 75 67 22 20 3b s"...."-debug" ;
14e0: 3b 20 66 6f 72 20 2a 76 65 72 62 6f 73 69 74 79 ; for *verbosity
14f0: 2a 20 3e 20 32 0a 09 09 09 29 20 0a 09 09 20 28 * > 2....) ... (
1500: 6c 69 73 74 20 20 22 2d 68 22 0a 09 09 20 20 20 list "-h"...
1510: 20 20 20 20 20 22 2d 66 6f 72 63 65 22 0a 09 09 "-force"...
1520: 20 20 20 20 20 20 20 20 22 2d 78 74 65 72 6d 22 "-xterm"
1530: 0a 09 09 20 20 20 20 20 20 20 20 22 2d 73 68 6f ... "-sho
1540: 77 6b 65 79 73 22 0a 09 09 20 20 20 20 20 20 20 wkeys"...
1550: 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 0a "-test-status".
1560: 09 09 09 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 ..."-set-values"
1570: 0a 09 09 09 22 2d 6c 6f 61 64 2d 74 65 73 74 2d ...."-load-test-
1580: 64 61 74 61 22 0a 09 09 09 22 2d 73 75 6d 6d 61 data"...."-summa
1590: 72 69 7a 65 2d 69 74 65 6d 73 22 0a 09 09 20 20 rize-items"...
15a0: 20 20 20 20 20 20 22 2d 67 75 69 22 0a 09 09 09 "-gui"....
15b0: 22 2d 72 75 6e 61 6c 6c 22 20 20 20 20 3b 3b 20 "-runall" ;;
15c0: 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 0a 09 09 run all tests...
15d0: 09 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 0a ."-remove-runs".
15e0: 09 09 09 22 2d 6b 65 65 70 67 6f 69 6e 67 22 0a ..."-keepgoing".
15f0: 09 09 09 22 2d 75 73 65 71 75 65 75 65 22 0a 09 ..."-usequeue"..
1600: 09 09 22 2d 72 65 62 75 69 6c 64 2d 64 62 22 0a .."-rebuild-db".
1610: 09 09 09 22 2d 72 6f 6c 6c 75 70 22 0a 09 09 09 ..."-rollup"....
1620: 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 22 0a 09 "-update-meta"..
1630: 09 09 22 2d 76 22 20 3b 3b 20 76 65 72 62 6f 73 .."-v" ;; verbos
1640: 65 20 32 2c 20 6d 6f 72 65 20 74 68 61 6e 20 6e e 2, more than n
1650: 6f 72 6d 61 6c 20 28 6e 6f 72 6d 61 6c 20 69 73 ormal (normal is
1660: 20 31 29 0a 09 09 09 22 2d 71 22 20 3b 3b 20 71 1)...."-q" ;; q
1670: 75 69 65 74 20 30 2c 20 65 72 72 6f 72 73 2f 77 uiet 0, errors/w
1680: 61 72 6e 69 6e 67 73 20 6f 6e 6c 79 0a 09 09 20 arnings only...
1690: 20 20 20 20 20 20 29 0a 09 09 20 61 72 67 73 3a )... args:
16a0: 61 72 67 2d 68 61 73 68 0a 09 09 20 30 29 29 0a arg-hash... 0)).
16b0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
16c0: 72 67 20 22 2d 68 22 29 0a 20 20 20 20 28 62 65 rg "-h"). (be
16d0: 67 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 gin. (print
16e0: 20 68 65 6c 70 29 0a 20 20 20 20 20 20 28 65 78 help). (ex
16f0: 69 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a it)))..(define *
1700: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 66 didsomething* #f
1710: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
1720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 4d ===========.;; M
1760: 69 73 63 20 73 65 74 75 70 20 73 74 75 66 66 0a isc setup stuff.
1770: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
1780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 73 65 74 21 20 ========..(set!
17c0: 2a 76 65 72 62 6f 73 69 74 79 2a 20 28 63 6f 6e *verbosity* (con
17d0: 64 0a 09 09 20 20 20 28 28 61 72 67 73 3a 67 65 d... ((args:ge
17e0: 74 2d 61 72 67 20 22 2d 64 65 62 75 67 22 29 28 t-arg "-debug")(
17f0: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
1800: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
1810: 65 62 75 67 22 29 29 29 0a 09 09 20 20 20 28 28 ebug")))... ((
1820: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 args:get-arg "-v
1830: 22 29 20 20 20 20 32 29 0a 09 09 20 20 20 28 28 ") 2)... ((
1840: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 71 args:get-arg "-q
1850: 22 29 20 20 20 20 30 29 0a 09 09 20 20 20 28 65 ") 0)... (e
1860: 6c 73 65 20 20 20 20 20 20 20 20 20 20 20 20 20 lse
1870: 20 20 20 20 20 20 31 29 29 29 0a 0a 3b 3b 3d 3d 1)))..;;==
1880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
18a0: 3d 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 0a 3b 3b 20 52 65 6d 6f 76 65 20 6f ====.;; Remove o
18d0: 6c 64 20 72 75 6e 28 73 29 0a 3b 3b 3d 3d 3d 3d ld run(s).;;====
18e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
18f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 3b 3b 20 73 69 6e 63 65 20 73 65 76 ==..;; since sev
1930: 65 72 61 6c 20 61 63 74 69 6f 6e 73 20 63 61 6e eral actions can
1940: 20 62 65 20 73 70 65 63 69 66 69 65 64 20 6f 6e be specified on
1950: 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e the command lin
1960: 65 20 74 68 65 20 72 65 6d 6f 76 61 6c 0a 3b 3b e the removal.;;
1970: 20 69 73 20 64 6f 6e 65 20 66 69 72 73 74 0a 28 is done first.(
1980: 64 65 66 69 6e 65 20 28 72 65 6d 6f 76 65 2d 72 define (remove-r
1990: 75 6e 73 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 uns). (cond.
19a0: 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d ((not (args:get-
19b0: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 arg ":runname"))
19c0: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
19d0: 74 20 30 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 t 0 "ERROR: Miss
19e0: 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 ing required par
19f0: 61 6d 65 74 65 72 20 66 6f 72 20 2d 72 65 6d 6f ameter for -remo
1a00: 76 65 2d 72 75 6e 73 2c 20 79 6f 75 20 6d 75 73 ve-runs, you mus
1a10: 74 20 73 70 65 63 69 66 79 20 74 68 65 20 72 75 t specify the ru
1a20: 6e 20 6e 61 6d 65 20 70 61 74 74 65 72 6e 20 77 n name pattern w
1a30: 69 74 68 20 3a 72 75 6e 6e 61 6d 65 20 70 61 74 ith :runname pat
1a40: 74 22 29 0a 20 20 20 20 28 65 78 69 74 20 32 29 t"). (exit 2)
1a50: 29 0a 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 ). ((not (args
1a60: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 :get-arg "-testp
1a70: 61 74 74 22 29 29 0a 20 20 20 20 28 64 65 62 75 att")). (debu
1a80: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
1a90: 3a 20 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 : Missing requir
1aa0: 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 ed parameter for
1ab0: 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 2c 20 79 -remove-runs, y
1ac0: 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 ou must specify
1ad0: 74 68 65 20 74 65 73 74 20 70 61 74 74 65 72 6e the test pattern
1ae0: 20 77 69 74 68 20 2d 74 65 73 74 70 61 74 74 22 with -testpatt"
1af0: 29 0a 20 20 20 20 28 65 78 69 74 20 33 29 29 0a ). (exit 3)).
1b00: 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 ((not (args:g
1b10: 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 74 et-arg "-itempat
1b20: 74 22 29 29 0a 20 20 20 20 28 70 72 69 6e 74 20 t")). (print
1b30: 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 20 "ERROR: Missing
1b40: 72 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 74 required paramet
1b50: 65 72 20 66 6f 72 20 2d 72 65 6d 6f 76 65 2d 72 er for -remove-r
1b60: 75 6e 73 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 uns, you must sp
1b70: 65 63 69 66 79 20 74 68 65 20 69 74 65 6d 73 20 ecify the items
1b80: 77 69 74 68 20 2d 69 74 65 6d 70 61 74 74 22 29 with -itempatt")
1b90: 0a 20 20 20 20 28 65 78 69 74 20 34 29 29 0a 20 . (exit 4)).
1ba0: 20 20 28 28 6c 65 74 20 28 28 64 62 20 23 66 29 ((let ((db #f)
1bb0: 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 ). (if (not
1bc0: 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 (setup-for-run)
1bd0: 29 0a 09 20 20 28 62 65 67 69 6e 20 0a 09 20 20 ).. (begin ..
1be0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
1bf0: 20 70 72 69 6e 74 20 22 46 61 69 6c 65 64 20 74 print "Failed t
1c00: 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
1c10: 22 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ").. (exit 1)
1c20: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 64 )). (set! d
1c30: 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 20 20 20 b (open-db)).
1c40: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 63 61 72 (if (not (car
1c50: 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 29 0a *configinfo*)).
1c60: 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
1c70: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
1c80: 52 52 4f 52 3a 20 41 74 74 65 6d 70 74 65 64 20 RROR: Attempted
1c90: 74 6f 20 72 65 6d 6f 76 65 20 74 65 73 74 28 73 to remove test(s
1ca0: 29 20 62 75 74 20 72 75 6e 20 61 72 65 61 20 63 ) but run area c
1cb0: 6f 6e 66 69 67 20 66 69 6c 65 20 6e 6f 74 20 66 onfig file not f
1cc0: 6f 75 6e 64 22 29 0a 09 20 20 20 20 28 65 78 69 ound").. (exi
1cd0: 74 20 31 29 29 0a 09 20 20 3b 3b 20 70 75 74 20 t 1)).. ;; put
1ce0: 74 65 73 74 20 70 61 72 61 6d 65 74 65 72 73 20 test parameters
1cf0: 69 6e 74 6f 20 63 6f 6e 76 65 6e 69 65 6e 74 20 into convenient
1d00: 76 61 72 69 61 62 6c 65 73 0a 09 20 20 28 72 75 variables.. (ru
1d10: 6e 73 3a 72 65 6d 6f 76 65 2d 72 75 6e 73 20 64 ns:remove-runs d
1d20: 62 0a 09 09 09 20 20 20 20 28 61 72 67 73 3a 67 b.... (args:g
1d30: 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 et-arg ":runname
1d40: 22 29 0a 09 09 09 20 20 20 20 28 61 72 67 73 3a ").... (args:
1d50: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
1d60: 74 74 22 29 0a 09 09 09 20 20 20 20 28 61 72 67 tt").... (arg
1d70: 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d s:get-arg "-item
1d80: 70 61 74 74 22 29 29 29 0a 20 20 20 20 20 20 28 patt"))). (
1d90: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
1da0: 21 20 64 62 29 0a 20 20 20 20 20 20 28 73 65 74 ! db). (set
1db0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
1dc0: 20 23 74 29 29 29 29 29 0a 09 20 20 0a 28 69 66 #t))))).. .(if
1dd0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
1de0: 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a 20 -remove-runs").
1df0: 20 20 20 28 72 65 6d 6f 76 65 2d 72 75 6e 73 29 (remove-runs)
1e00: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
1e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 51 ===========.;; Q
1e50: 75 65 72 79 20 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d uery runs.;;====
1e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ==..(if (args:ge
1eb0: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e t-arg "-list-run
1ec0: 73 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 s"). (let* ((
1ed0: 64 62 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a db (begin.
1ee0: 09 09 20 20 20 20 20 20 20 28 73 65 74 75 70 2d .. (setup-
1ef0: 66 6f 72 2d 72 75 6e 29 0a 09 09 20 20 20 20 20 for-run)...
1f00: 20 20 28 6f 70 65 6e 2d 64 62 29 29 29 0a 09 20 (open-db)))..
1f10: 20 20 28 72 75 6e 70 61 74 74 20 20 28 61 72 67 (runpatt (arg
1f20: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
1f30: 2d 72 75 6e 73 22 29 29 0a 09 20 20 20 28 74 65 -runs")).. (te
1f40: 73 74 70 61 74 74 20 28 61 72 67 73 3a 67 65 74 stpatt (args:get
1f50: 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 -arg "-testpatt"
1f60: 29 29 0a 09 20 20 20 28 69 74 65 6d 70 61 74 74 )).. (itempatt
1f70: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
1f80: 2d 69 74 65 6d 70 61 74 74 22 29 29 0a 09 20 20 -itempatt"))..
1f90: 20 28 72 75 6e 73 64 61 74 20 20 28 64 62 3a 67 (runsdat (db:g
1fa0: 65 74 2d 72 75 6e 73 20 64 62 20 72 75 6e 70 61 et-runs db runpa
1fb0: 74 74 20 23 66 20 23 66 20 27 28 29 29 29 0a 09 tt #f #f '()))..
1fc0: 20 20 20 28 72 75 6e 73 20 20 20 20 20 28 64 62 (runs (db
1fd0: 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e 73 64 61 :get-rows runsda
1fe0: 74 29 29 0a 09 20 20 20 28 68 65 61 64 65 72 20 t)).. (header
1ff0: 20 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 (db:get-header
2000: 20 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 28 runsdat)).. (
2010: 6b 65 79 73 20 20 20 20 20 28 64 62 2d 67 65 74 keys (db-get
2020: 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 20 20 28 -keys db)).. (
2030: 6b 65 79 6e 61 6d 65 73 20 28 6d 61 70 20 6b 65 keynames (map ke
2040: 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 y:get-fieldname
2050: 6b 65 79 73 29 29 29 0a 20 20 20 20 20 20 3b 3b keys))). ;;
2060: 20 45 61 63 68 20 72 75 6e 0a 20 20 20 20 20 20 Each run.
2070: 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 (for-each .
2080: 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a (lambda (run).
2090: 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 . (debug:print 2
20a0: 20 22 52 75 6e 3a 20 22 0a 09 09 28 73 74 72 69 "Run: "...(stri
20b0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
20c0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a map (lambda (x).
20d0: 09 09 09 09 09 20 20 20 28 64 62 3a 67 65 74 2d ..... (db:get-
20e0: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
20f0: 72 75 6e 20 68 65 61 64 65 72 20 78 29 29 0a 09 run header x))..
2100: 09 09 09 09 20 6b 65 79 6e 61 6d 65 73 29 20 22 .... keynames) "
2110: 2f 22 29 0a 09 09 22 2f 22 0a 09 09 28 64 62 3a /")..."/"...(db:
2120: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
2130: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 der run header "
2140: 72 75 6e 6e 61 6d 65 22 29 29 0a 09 20 28 6c 65 runname")).. (le
2150: 74 20 28 28 72 75 6e 2d 69 64 20 28 64 62 3a 67 t ((run-id (db:g
2160: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
2170: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 er run header "i
2180: 64 22 29 29 29 0a 09 20 20 20 28 6c 65 74 20 28 d"))).. (let (
2190: 28 74 65 73 74 73 20 28 64 62 2d 67 65 74 2d 74 (tests (db-get-t
21a0: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 20 ests-for-run db
21b0: 72 75 6e 2d 69 64 20 74 65 73 74 70 61 74 74 20 run-id testpatt
21c0: 69 74 65 6d 70 61 74 74 29 29 29 0a 09 20 20 20 itempatt)))..
21d0: 20 20 3b 3b 20 45 61 63 68 20 74 65 73 74 0a 09 ;; Each test..
21e0: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
21f0: 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
2200: 74 65 73 74 29 0a 09 09 28 66 6f 72 6d 61 74 20 test)...(format
2210: 23 74 0a 09 09 09 22 20 20 54 65 73 74 3a 20 7e #t...." Test: ~
2220: 32 35 61 20 53 74 61 74 65 3a 20 7e 31 35 61 20 25a State: ~15a
2230: 53 74 61 74 75 73 3a 20 7e 31 35 61 20 52 75 6e Status: ~15a Run
2240: 74 69 6d 65 3a 20 7e 35 40 61 73 20 54 69 6d 65 time: ~5@as Time
2250: 3a 20 7e 32 32 61 20 48 6f 73 74 3a 20 7e 31 30 : ~22a Host: ~10
2260: 61 5c 6e 22 0a 09 09 09 28 63 6f 6e 63 20 28 64 a\n"....(conc (d
2270: 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn
2280: 61 6d 65 20 74 65 73 74 29 0a 09 09 09 20 20 20 ame test)....
2290: 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 (if (equal? (
22a0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d db:test-get-item
22b0: 2d 70 61 74 68 20 74 65 73 74 29 20 22 22 29 0a -path test) "").
22c0: 09 09 09 09 20 20 22 22 20 0a 09 09 09 09 20 20 .... "" .....
22d0: 28 63 6f 6e 63 20 22 28 22 20 28 64 62 3a 74 65 (conc "(" (db:te
22e0: 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 st-get-item-path
22f0: 20 74 65 73 74 29 20 22 29 22 29 29 29 0a 09 09 test) ")")))...
2300: 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 .(db:test-get-st
2310: 61 74 65 20 74 65 73 74 29 0a 09 09 09 28 64 62 ate test)....(db
2320: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
2330: 20 74 65 73 74 29 0a 09 09 09 28 64 62 3a 74 65 test)....(db:te
2340: 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 st-get-run_durat
2350: 69 6f 6e 20 74 65 73 74 29 0a 09 09 09 28 64 62 ion test)....(db
2360: 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f :test-get-event_
2370: 74 69 6d 65 20 74 65 73 74 29 0a 09 09 09 28 64 time test)....(d
2380: 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 20 b:test-get-host
2390: 74 65 73 74 29 29 0a 20 09 09 28 69 66 20 28 6e test)). ..(if (n
23a0: 6f 74 20 28 6f 72 20 28 65 71 75 61 6c 3f 20 28 ot (or (equal? (
23b0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
23c0: 75 73 20 74 65 73 74 29 20 22 50 41 53 53 22 29 us test) "PASS")
23d0: 0a 09 09 09 20 20 20 20 20 28 65 71 75 61 6c 3f .... (equal?
23e0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st
23f0: 61 74 75 73 20 74 65 73 74 29 20 22 57 41 52 4e atus test) "WARN
2400: 22 29 0a 09 09 09 20 20 20 20 20 28 65 71 75 61 ").... (equa
2410: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
2420: 73 74 61 74 65 20 74 65 73 74 29 20 20 22 4e 4f state test) "NO
2430: 54 5f 53 54 41 52 54 45 44 22 29 29 29 0a 09 09 T_STARTED")))...
2440: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 (begin...
2450: 20 20 20 28 70 72 69 6e 74 20 22 20 20 20 20 20 (print "
2460: 20 20 20 20 63 70 75 6c 6f 61 64 3a 20 20 22 20 cpuload: "
2470: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 70 75 (db:test-get-cpu
2480: 6c 6f 61 64 20 74 65 73 74 29 0a 09 09 09 20 20 load test)....
2490: 20 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 64 "\n d
24a0: 69 73 6b 66 72 65 65 3a 20 22 20 28 64 62 3a 74 iskfree: " (db:t
24b0: 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 65 est-get-diskfree
24c0: 20 74 65 73 74 29 0a 09 09 09 20 20 20 20 20 22 test).... "
24d0: 5c 6e 20 20 20 20 20 20 20 20 20 75 6e 61 6d 65 \n uname
24e0: 3a 20 20 20 20 22 20 28 64 62 3a 74 65 73 74 2d : " (db:test-
24f0: 67 65 74 2d 75 6e 61 6d 65 20 74 65 73 74 29 0a get-uname test).
2500: 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 ... "\n
2510: 20 20 20 20 72 75 6e 64 69 72 3a 20 20 20 22 20 rundir: "
2520: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e (db:test-get-run
2530: 64 69 72 20 74 65 73 74 29 0a 09 09 09 20 20 20 dir test)....
2540: 20 20 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 45 )... ;; E
2550: 61 63 68 20 74 65 73 74 0a 09 09 20 20 20 20 20 ach test...
2560: 20 28 6c 65 74 20 28 28 73 74 65 70 73 20 28 64 (let ((steps (d
2570: 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d b:get-steps-for-
2580: 74 65 73 74 20 64 62 20 28 64 62 3a 74 65 73 74 test db (db:test
2590: 2d 67 65 74 2d 69 64 20 74 65 73 74 29 29 29 29 -get-id test))))
25a0: 0a 09 09 09 28 66 6f 72 2d 65 61 63 68 20 0a 09 ....(for-each ..
25b0: 09 09 20 28 6c 61 6d 62 64 61 20 28 73 74 65 70 .. (lambda (step
25c0: 29 0a 09 09 09 20 20 20 28 66 6f 72 6d 61 74 20 ).... (format
25d0: 23 74 20 0a 09 09 09 09 20 20 20 22 20 20 20 20 #t ..... "
25e0: 53 74 65 70 3a 20 7e 32 30 61 20 53 74 61 74 65 Step: ~20a State
25f0: 3a 20 7e 31 30 61 20 53 74 61 74 75 73 3a 20 7e : ~10a Status: ~
2600: 31 30 61 20 54 69 6d 65 20 7e 32 32 61 5c 6e 22 10a Time ~22a\n"
2610: 0a 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 ..... (db:step
2620: 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 -get-stepname st
2630: 65 70 29 0a 09 09 09 09 20 20 20 28 64 62 3a 73 ep)..... (db:s
2640: 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 74 tep-get-state st
2650: 65 70 29 0a 09 09 09 09 20 20 20 28 64 62 3a 73 ep)..... (db:s
2660: 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 tep-get-status s
2670: 74 65 70 29 0a 09 09 09 09 20 20 20 28 64 62 3a tep)..... (db:
2680: 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
2690: 69 6d 65 20 73 74 65 70 29 29 29 0a 09 09 09 20 ime step)))....
26a0: 73 74 65 70 73 29 29 29 29 29 0a 09 09 74 65 73 steps)))))...tes
26b0: 74 73 29 29 29 29 0a 20 20 20 20 20 20 20 72 75 ts)))). ru
26c0: 6e 73 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ns). (set!
26d0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
26e0: 74 29 0a 20 20 20 20 20 20 29 29 0a 0a 3b 3b 3d t). ))..;;=
26f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2730: 3d 3d 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 72 75 =====.;; full ru
2740: 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d n.;;============
2750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 ==========..;; g
2790: 65 74 20 6c 6f 63 6b 20 69 6e 20 64 62 20 66 6f et lock in db fo
27a0: 72 20 66 75 6c 6c 20 72 75 6e 20 66 6f 72 20 74 r full run for t
27b0: 68 69 73 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b his directory.;;
27c0: 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 20 77 for all tests w
27d0: 69 74 68 20 64 65 70 73 0a 3b 3b 20 20 20 77 61 ith deps.;; wa
27e0: 6c 6b 20 74 72 65 65 20 6f 66 20 74 65 73 74 73 lk tree of tests
27f0: 20 74 6f 20 66 69 6e 64 20 68 65 61 64 20 74 61 to find head ta
2800: 73 6b 73 0a 3b 3b 20 20 20 61 64 64 20 68 65 61 sks.;; add hea
2810: 64 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 d tasks to task
2820: 71 75 65 75 65 0a 3b 3b 20 20 20 61 64 64 20 64 queue.;; add d
2830: 65 70 65 6e 64 61 6e 74 20 74 61 73 6b 73 20 74 ependant tasks t
2840: 6f 20 74 61 73 6b 20 71 75 65 75 65 20 0a 3b 3b o task queue .;;
2850: 20 20 20 61 64 64 20 72 65 6d 61 69 6e 69 6e 67 add remaining
2860: 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 tasks to task q
2870: 75 65 75 65 0a 3b 3b 20 66 6f 72 20 65 61 63 68 ueue.;; for each
2880: 20 74 61 73 6b 20 69 6e 20 74 61 73 6b 20 71 75 task in task qu
2890: 65 75 65 0a 3b 3b 20 20 20 69 66 20 68 61 76 65 eue.;; if have
28a0: 20 61 64 65 71 75 61 74 65 20 72 65 73 6f 75 72 adequate resour
28b0: 63 65 73 0a 3b 3b 20 20 20 20 20 6c 61 75 6e 63 ces.;; launc
28c0: 68 20 74 61 73 6b 0a 3b 3b 20 20 20 65 6c 73 65 h task.;; else
28d0: 0a 3b 3b 20 20 20 20 20 70 75 74 20 74 61 73 6b .;; put task
28e0: 20 69 6e 20 64 65 66 65 72 72 65 64 20 71 75 65 in deferred que
28f0: 75 65 0a 3b 3b 20 69 66 20 73 74 69 6c 6c 20 6f ue.;; if still o
2900: 6b 20 74 6f 20 72 75 6e 20 74 61 73 6b 73 0a 3b k to run tasks.;
2910: 3b 20 20 20 70 72 6f 63 65 73 73 20 64 65 66 65 ; process defe
2920: 72 72 65 64 20 74 61 73 6b 73 20 70 65 72 20 61 rred tasks per a
2930: 62 6f 76 65 20 73 74 65 70 73 0a 0a 3b 3b 20 72 bove steps..;; r
2940: 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 61 72 65 un all tests are
2950: 20 61 72 65 20 4e 6f 74 20 43 4f 4d 50 4c 45 54 are Not COMPLET
2960: 45 44 20 61 6e 64 20 50 41 53 53 20 6f 72 20 43 ED and PASS or C
2970: 48 45 43 4b 0a 28 69 66 20 28 61 72 67 73 3a 67 HECK.(if (args:g
2980: 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 et-arg "-runall"
2990: 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 ). (general-r
29a0: 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d un-call . "-
29b0: 72 75 6e 61 6c 6c 22 0a 20 20 20 20 20 22 72 75 runall". "ru
29c0: 6e 20 61 6c 6c 20 74 65 73 74 73 22 0a 20 20 20 n all tests".
29d0: 20 20 28 6c 61 6d 62 64 61 20 28 64 62 20 6b 65 (lambda (db ke
29e0: 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 ys keynames keyv
29f0: 61 6c 6c 73 74 29 0a 20 20 20 20 20 20 20 28 6c allst). (l
2a00: 65 74 2a 20 28 28 74 65 73 74 2d 6e 61 6d 65 73 et* ((test-names
2a10: 20 28 67 65 74 2d 61 6c 6c 2d 6c 65 67 61 6c 2d (get-all-legal-
2a20: 74 65 73 74 73 29 29 29 20 3b 3b 20 22 50 52 4f tests))) ;; "PRO
2a30: 44 22 20 69 73 20 69 67 6e 6f 72 65 64 20 66 6f D" is ignored fo
2a40: 72 20 6e 6f 77 0a 09 20 28 64 65 62 75 67 3a 70 r now.. (debug:p
2a50: 72 69 6e 74 20 31 20 22 49 4e 46 4f 3a 20 41 74 rint 1 "INFO: At
2a60: 74 65 6d 70 74 69 6e 67 20 74 6f 20 73 74 61 72 tempting to star
2a70: 74 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 t the following
2a80: 74 65 73 74 73 2e 2e 2e 22 29 0a 09 20 28 64 65 tests...").. (de
2a90: 62 75 67 3a 70 72 69 6e 74 20 31 20 22 20 20 20 bug:print 1 "
2aa0: 20 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 " (string-inte
2ab0: 72 73 70 65 72 73 65 20 74 65 73 74 2d 6e 61 6d rsperse test-nam
2ac0: 65 73 20 22 2c 22 29 29 0a 09 20 28 72 75 6e 2d es ",")).. (run-
2ad0: 74 65 73 74 73 20 64 62 20 74 65 73 74 2d 6e 61 tests db test-na
2ae0: 6d 65 73 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d mes)))))..;;====
2af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b30: 3d 3d 0a 3b 3b 20 52 6f 6c 6c 75 70 20 69 6e 74 ==.;; Rollup int
2b40: 6f 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d o a run.;;======
2b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
2ba0: 72 67 20 22 2d 72 6f 6c 6c 75 70 22 29 0a 20 20 rg "-rollup").
2bb0: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
2bc0: 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 6f 6c 6c all . "-roll
2bd0: 75 70 22 20 0a 20 20 20 20 20 22 72 6f 6c 6c 75 up" . "rollu
2be0: 70 20 74 65 73 74 73 22 20 0a 20 20 20 20 20 28 p tests" . (
2bf0: 6c 61 6d 62 64 61 20 28 64 62 20 6b 65 79 73 20 lambda (db keys
2c00: 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c keynames keyvall
2c10: 73 74 29 0a 20 20 20 20 20 20 20 28 72 75 6e 73 st). (runs
2c20: 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 64 62 20 6b :rollup-run db k
2c30: 65 79 73 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d eys))))..;;=====
2c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c80: 3d 0a 3b 3b 20 45 78 74 72 61 63 74 20 61 20 73 =.;; Extract a s
2c90: 70 72 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 preadsheet from
2ca0: 74 68 65 20 72 75 6e 73 20 64 61 74 61 62 61 73 the runs databas
2cb0: 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d e.;;============
2cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
2d00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
2d10: 65 78 74 72 61 63 74 2d 6f 64 73 22 29 0a 20 20 extract-ods").
2d20: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
2d30: 61 6c 6c 0a 20 20 20 20 20 22 2d 65 78 74 72 61 all. "-extra
2d40: 63 74 2d 6f 64 73 22 0a 20 20 20 20 20 22 4d 61 ct-ods". "Ma
2d50: 6b 65 20 6f 64 73 20 73 70 72 65 61 64 73 68 65 ke ods spreadshe
2d60: 65 74 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 et". (lambda
2d70: 20 28 64 62 20 6b 65 79 73 20 6b 65 79 6e 61 6d (db keys keynam
2d80: 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 es keyvallst).
2d90: 20 20 20 20 20 28 6c 65 74 20 28 28 6f 75 74 70 (let ((outp
2da0: 75 74 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 utfile (args:get
2db0: 2d 61 72 67 20 22 2d 65 78 74 72 61 63 74 2d 6f -arg "-extract-o
2dc0: 64 73 22 29 29 0a 09 20 20 20 20 20 28 72 75 6e ds")).. (run
2dd0: 73 70 61 74 74 20 20 20 28 61 72 67 73 3a 67 65 spatt (args:ge
2de0: 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 t-arg ":runname"
2df0: 29 29 0a 09 20 20 20 20 20 28 6b 65 79 76 61 6c )).. (keyval
2e00: 61 6c 69 73 74 20 28 6b 65 79 73 2d 3e 61 6c 69 alist (keys->ali
2e10: 73 74 20 6b 65 79 73 20 22 25 22 29 29 29 0a 09 st keys "%")))..
2e20: 20 28 64 62 3a 65 78 74 72 61 63 74 2d 6f 64 73 (db:extract-ods
2e30: 2d 66 69 6c 65 20 64 62 20 6f 75 74 70 75 74 66 -file db outputf
2e40: 69 6c 65 20 6b 65 79 76 61 6c 61 6c 69 73 74 20 ile keyvalalist
2e50: 28 69 66 20 72 75 6e 73 70 61 74 74 20 72 75 6e (if runspatt run
2e60: 73 70 61 74 74 20 22 25 22 29 29 29 29 29 29 0a spatt "%")))))).
2e70: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
2e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e =========.;; run
2ec0: 20 6f 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d 3d 3d one test.;;====
2ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f10: 3d 3d 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 20 74 ==..;; 1. find t
2f20: 68 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b he config file.;
2f30: 3b 20 32 2e 20 63 68 61 6e 67 65 20 74 6f 20 74 ; 2. change to t
2f40: 68 65 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 he test director
2f50: 79 0a 3b 3b 20 33 2e 20 75 70 64 61 74 65 20 74 y.;; 3. update t
2f60: 68 65 20 64 62 20 77 69 74 68 20 22 74 65 73 74 he db with "test
2f70: 20 73 74 61 72 74 65 64 22 20 73 74 61 74 75 73 started" status
2f80: 2c 20 73 65 74 20 72 75 6e 6e 69 6e 67 20 68 6f , set running ho
2f90: 73 74 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 73 73 st.;; 4. process
2fa0: 20 6c 61 75 6e 63 68 20 74 68 65 20 74 65 73 74 launch the test
2fb0: 0a 3b 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 6f 72 .;; - monitor
2fc0: 20 74 68 65 20 70 72 6f 63 65 73 73 2c 20 75 70 the process, up
2fd0: 64 61 74 65 20 73 74 61 74 73 20 69 6e 20 74 68 date stats in th
2fe0: 65 20 64 62 20 65 76 65 72 79 20 32 5e 6e 20 6d e db every 2^n m
2ff0: 69 6e 75 74 65 73 0a 3b 3b 20 35 2e 20 61 73 20 inutes.;; 5. as
3000: 74 68 65 20 74 65 73 74 20 70 72 6f 63 65 65 64 the test proceed
3010: 73 20 69 6e 74 65 72 6e 61 6c 6c 79 20 69 74 20 s internally it
3020: 63 61 6c 6c 73 20 6d 65 67 61 74 65 73 74 20 61 calls megatest a
3030: 73 20 65 61 63 68 20 73 74 65 70 20 69 73 0a 3b s each step is.;
3040: 3b 20 20 20 20 73 74 61 72 74 65 64 20 61 6e 64 ; started and
3050: 20 63 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 20 20 completed.;;
3060: 20 2d 20 73 74 65 70 20 73 74 61 72 74 65 64 2c - step started,
3070: 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 20 20 timestamp.;;
3080: 20 2d 20 73 74 65 70 20 63 6f 6d 70 6c 65 74 65 - step complete
3090: 64 2c 20 65 78 69 74 20 73 74 61 74 75 73 2c 20 d, exit status,
30a0: 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 2e 20 timestamp.;; 6.
30b0: 74 65 73 74 20 70 68 6f 6e 65 20 68 6f 6d 65 0a test phone home.
30c0: 3b 3b 20 20 20 20 2d 20 69 66 20 74 65 73 74 20 ;; - if test
30d0: 72 75 6e 20 74 69 6d 65 20 3e 20 61 6c 6c 6f 77 run time > allow
30e0: 65 64 20 72 75 6e 20 74 69 6d 65 20 74 68 65 6e ed run time then
30f0: 20 6b 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 20 20 kill job.;;
3100: 2d 20 69 66 20 63 61 6e 6e 6f 74 20 61 63 63 65 - if cannot acce
3110: 73 73 20 64 62 20 3e 20 61 6c 6c 6f 77 65 64 20 ss db > allowed
3120: 64 69 73 63 6f 6e 6e 65 63 74 20 74 69 6d 65 20 disconnect time
3130: 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 0a 28 then kill job..(
3140: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
3150: 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 20 20 "-runtests").
3160: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
3170: 6c 20 0a 20 20 20 22 2d 72 75 6e 74 65 73 74 73 l . "-runtests
3180: 22 20 0a 20 20 20 22 72 75 6e 20 61 20 74 65 73 " . "run a tes
3190: 74 22 20 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 t" . (lambda (
31a0: 64 62 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 db keys keynames
31b0: 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 keyvallst).
31c0: 20 28 6c 65 74 20 28 28 74 65 73 74 2d 6e 61 6d (let ((test-nam
31d0: 65 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 es (string-split
31e0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
31f0: 2d 72 75 6e 74 65 73 74 73 22 29 20 22 2c 22 29 -runtests") ",")
3200: 29 29 0a 20 20 20 20 20 20 20 28 72 75 6e 2d 74 )). (run-t
3210: 65 73 74 73 20 64 62 20 74 65 73 74 2d 6e 61 6d ests db test-nam
3220: 65 73 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d es)))))..;;=====
3230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3270: 3d 0a 3b 3b 20 65 78 65 63 75 74 65 20 74 68 65 =.;; execute the
3280: 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 67 65 test.;; - ge
3290: 74 73 20 63 61 6c 6c 65 64 20 6f 6e 20 72 65 6d ts called on rem
32a0: 6f 74 65 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d ote host.;; -
32b0: 20 72 65 63 65 69 76 65 73 20 69 6e 66 6f 20 66 receives info f
32c0: 72 6f 6d 20 74 68 65 20 2d 65 78 65 63 75 74 65 rom the -execute
32d0: 20 70 61 72 61 6d 0a 3b 3b 20 20 20 20 2d 20 70 param.;; - p
32e0: 61 73 73 65 73 20 69 6e 66 6f 20 74 6f 20 73 74 asses info to st
32f0: 65 70 73 20 76 69 61 20 4d 54 5f 43 4d 44 49 4e eps via MT_CMDIN
3300: 46 4f 20 65 6e 76 20 76 61 72 20 28 66 75 74 75 FO env var (futu
3310: 72 65 20 69 73 20 74 6f 20 75 73 65 20 61 20 64 re is to use a d
3320: 6f 74 20 66 69 6c 65 29 0a 3b 3b 20 20 20 20 2d ot file).;; -
3330: 20 67 61 74 68 65 72 73 20 68 6f 73 74 20 69 6e gathers host in
3340: 66 6f 20 61 6e 64 20 0a 3b 3b 3d 3d 3d 3d 3d 3d fo and .;;======
3350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
33a0: 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 0a arg "-execute").
33b0: 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 69 (let* ((cmdi
33c0: 6e 66 6f 20 20 20 28 72 65 61 64 20 28 6f 70 65 nfo (read (ope
33d0: 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 n-input-string (
33e0: 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 base64:base64-de
33f0: 63 6f 64 65 20 28 61 72 67 73 3a 67 65 74 2d 61 code (args:get-a
3400: 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 29 29 rg "-execute")))
3410: 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 65 6e ))). (seten
3420: 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 20 28 v "MT_CMDINFO" (
3430: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
3440: 78 65 63 75 74 65 22 29 29 0a 20 20 20 20 20 20 xecute")).
3450: 28 69 66 20 28 6c 69 73 74 3f 20 63 6d 64 69 6e (if (list? cmdin
3460: 66 6f 29 20 3b 3b 20 28 28 74 65 73 74 70 61 74 fo) ;; ((testpat
3470: 68 20 2f 74 6d 70 2f 6d 72 77 65 6c 6c 61 6e 2f h /tmp/mrwellan/
3480: 6a 61 7a 7a 6d 69 6e 64 2f 73 72 63 2f 65 78 61 jazzmind/src/exa
3490: 6d 70 6c 65 5f 72 75 6e 2f 74 65 73 74 73 2f 73 mple_run/tests/s
34a0: 71 6c 69 74 65 73 70 65 65 64 29 20 28 74 65 73 qlitespeed) (tes
34b0: 74 2d 6e 61 6d 65 20 73 71 6c 69 74 65 73 70 65 t-name sqlitespe
34c0: 65 64 29 20 28 72 75 6e 73 63 72 69 70 74 20 72 ed) (runscript r
34d0: 75 6e 73 63 72 69 70 74 2e 72 62 29 20 28 64 62 unscript.rb) (db
34e0: 2d 68 6f 73 74 20 6c 6f 63 61 6c 68 6f 73 74 29 -host localhost)
34f0: 20 28 72 75 6e 2d 69 64 20 31 29 29 0a 09 20 20 (run-id 1))..
3500: 28 6c 65 74 2a 20 28 28 74 65 73 74 70 61 74 68 (let* ((testpath
3510: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
3520: 20 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 'testpath cmdi
3530: 6e 66 6f 29 29 0a 09 09 20 28 77 6f 72 6b 2d 61 nfo))... (work-a
3540: 72 65 61 20 28 61 73 73 6f 63 2f 64 65 66 61 75 rea (assoc/defau
3550: 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 63 6d lt 'work-area cm
3560: 64 69 6e 66 6f 29 29 0a 09 09 20 28 74 65 73 74 dinfo))... (test
3570: 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 -name (assoc/def
3580: 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 ault 'test-name
3590: 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 72 75 cmdinfo))... (ru
35a0: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
35b0: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
35c0: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 t cmdinfo))... (
35d0: 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 db-host (assoc
35e0: 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 /default 'db-hos
35f0: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 t cmdinfo))...
3600: 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 (run-id (ass
3610: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d oc/default 'run-
3620: 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a id cmdinfo)).
3630: 09 09 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 .. (itemdat (a
3640: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 ssoc/default 'it
3650: 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 emdat cmdinfo)
3660: 29 0a 09 09 20 28 65 6e 76 2d 6f 76 72 64 20 20 )... (env-ovrd
3670: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
3680: 65 6e 76 2d 6f 76 72 64 20 20 63 6d 64 69 6e 66 env-ovrd cmdinf
3690: 6f 29 29 0a 09 09 20 28 72 75 6e 6e 61 6d 65 20 o))... (runname
36a0: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
36b0: 20 27 72 75 6e 6e 61 6d 65 20 20 20 63 6d 64 69 'runname cmdi
36c0: 6e 66 6f 29 29 0a 09 09 20 28 6d 65 67 61 74 65 nfo))... (megate
36d0: 73 74 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 st (assoc/defau
36e0: 6c 74 20 27 6d 65 67 61 74 65 73 74 20 20 63 6d lt 'megatest cm
36f0: 64 69 6e 66 6f 29 29 0a 09 09 20 28 6d 74 2d 62 dinfo))... (mt-b
3700: 69 6e 64 69 72 2d 70 61 74 68 20 28 61 73 73 6f indir-path (asso
3710: 63 2f 64 65 66 61 75 6c 74 20 27 6d 74 2d 62 69 c/default 'mt-bi
3720: 6e 64 69 72 2d 70 61 74 68 20 63 6d 64 69 6e 66 ndir-path cmdinf
3730: 6f 29 29 0a 09 09 20 28 66 75 6c 6c 72 75 6e 73 o))... (fullruns
3740: 63 72 69 70 74 20 28 63 6f 6e 63 20 74 65 73 74 cript (conc test
3750: 70 61 74 68 20 22 2f 22 20 72 75 6e 73 63 72 69 path "/" runscri
3760: 70 74 29 29 0a 09 09 20 28 64 62 20 20 20 20 20 pt))... (db
3770: 20 20 20 23 66 29 29 0a 09 20 20 20 20 28 64 65 #f)).. (de
3780: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 45 78 65 bug:print 2 "Exe
3790: 63 74 75 69 6e 67 20 22 20 74 65 73 74 2d 6e 61 ctuing " test-na
37a0: 6d 65 20 22 20 6f 6e 20 22 20 28 67 65 74 2d 68 me " on " (get-h
37b0: 6f 73 74 2d 6e 61 6d 65 29 29 0a 09 20 20 20 20 ost-name))..
37c0: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
37d0: 79 20 74 65 73 74 70 61 74 68 29 0a 09 20 20 20 y testpath)..
37e0: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 (setenv "MT_TES
37f0: 54 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d T_RUN_DIR" work-
3800: 61 72 65 61 29 0a 09 20 20 20 20 28 73 65 74 65 area).. (sete
3810: 6e 76 20 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 nv "MT_TEST_NAME
3820: 22 20 74 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 " test-name)..
3830: 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 49 54 (setenv "MT_IT
3840: 45 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 EM_INFO" (conc i
3850: 74 65 6d 64 61 74 29 29 0a 09 20 20 20 20 28 73 temdat)).. (s
3860: 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d etenv "MT_RUNNAM
3870: 45 22 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 20 E" runname)..
3880: 20 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 4d (setenv "MT_M
3890: 45 47 41 54 45 53 54 22 20 20 6d 65 67 61 74 65 EGATEST" megate
38a0: 73 74 29 0a 09 20 20 20 20 28 69 66 20 6d 74 2d st).. (if mt-
38b0: 62 69 6e 64 69 72 2d 70 61 74 68 20 28 73 65 74 bindir-path (set
38c0: 65 6e 76 20 22 50 41 54 48 22 20 28 63 6f 6e 63 env "PATH" (conc
38d0: 20 28 67 65 74 65 6e 76 20 22 50 41 54 48 22 29 (getenv "PATH")
38e0: 20 22 3a 22 20 6d 74 2d 62 69 6e 64 69 72 2d 70 ":" mt-bindir-p
38f0: 61 74 68 29 29 29 0a 09 20 20 20 20 0a 09 20 20 ath))).. ..
3900: 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 (if (not (setu
3910: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 09 28 62 p-for-run))...(b
3920: 65 67 69 6e 0a 09 09 20 20 28 64 65 62 75 67 3a egin... (debug:
3930: 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 print 0 "Failed
3940: 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
3950: 67 22 29 20 0a 09 09 20 20 28 65 78 69 74 20 31 g") ... (exit 1
3960: 29 29 29 0a 09 20 20 20 20 3b 3b 20 6e 6f 77 20 ))).. ;; now
3970: 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 64 62 0a can find our db.
3980: 09 20 20 20 20 28 73 65 74 21 20 64 62 20 28 6f . (set! db (o
3990: 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 28 63 pen-db)).. (c
39a0: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
39b0: 77 6f 72 6b 2d 61 72 65 61 29 20 0a 09 20 20 20 work-area) ..
39c0: 20 28 73 65 74 2d 72 75 6e 2d 63 6f 6e 66 69 67 (set-run-config
39d0: 2d 76 61 72 73 20 64 62 20 72 75 6e 2d 69 64 29 -vars db run-id)
39e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 . ;;
39f0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 6f 76 65 72 environment over
3a00: 72 69 64 65 73 20 61 72 65 20 64 6f 6e 65 20 2a rides are done *
3a10: 62 65 66 6f 72 65 2a 20 74 68 65 20 72 65 6d 61 before* the rema
3a20: 69 6e 69 6e 67 20 63 72 69 74 69 63 61 6c 20 65 ining critical e
3a30: 6e 76 61 72 73 2e 0a 20 20 20 20 20 20 20 20 20 nvars..
3a40: 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 (alist->env-v
3a50: 61 72 73 20 65 6e 76 2d 6f 76 72 64 29 0a 09 20 ars env-ovrd)..
3a60: 20 20 20 28 73 65 74 2d 6d 65 67 61 74 65 73 74 (set-megatest
3a70: 2d 65 6e 76 2d 76 61 72 73 20 64 62 20 72 75 6e -env-vars db run
3a80: 2d 69 64 29 0a 09 20 20 20 20 28 73 65 74 2d 69 -id).. (set-i
3a90: 74 65 6d 2d 65 6e 76 2d 76 61 72 73 20 69 74 65 tem-env-vars ite
3aa0: 6d 64 61 74 29 0a 20 20 20 20 20 20 20 20 20 20 mdat).
3ab0: 20 20 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d (save-environm
3ac0: 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 22 6d 65 ent-as-files "me
3ad0: 67 61 74 65 73 74 22 29 0a 09 20 20 20 20 28 74 gatest").. (t
3ae0: 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 est-set-meta-inf
3af0: 6f 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 o db run-id test
3b00: 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 09 -name itemdat)..
3b10: 20 20 20 20 28 74 65 73 74 2d 73 65 74 2d 73 74 (test-set-st
3b20: 61 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 atus! db run-id
3b30: 74 65 73 74 2d 6e 61 6d 65 20 22 52 45 4d 4f 54 test-name "REMOT
3b40: 45 48 4f 53 54 53 54 41 52 54 22 20 22 6e 2f 61 EHOSTSTART" "n/a
3b50: 22 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a " itemdat (args:
3b60: 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 get-arg "-m") #f
3b70: 29 0a 09 20 20 20 20 28 69 66 20 28 61 72 67 73 ).. (if (args
3b80: 3a 67 65 74 2d 61 72 67 20 22 2d 78 74 65 72 6d :get-arg "-xterm
3b90: 22 29 0a 09 09 28 73 65 74 21 20 66 75 6c 6c 72 ")...(set! fullr
3ba0: 75 6e 73 63 72 69 70 74 20 22 78 74 65 72 6d 22 unscript "xterm"
3bb0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3bc0: 20 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 (if (not (file
3bd0: 2d 65 78 65 63 75 74 65 2d 61 63 63 65 73 73 3f -execute-access?
3be0: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 fullrunscript))
3bf0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3c00: 20 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f (system (co
3c10: 6e 63 20 22 63 68 6d 6f 64 20 75 67 2b 78 20 22 nc "chmod ug+x "
3c20: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 fullrunscript))
3c30: 29 29 0a 09 20 20 20 20 3b 3b 20 57 65 20 61 72 )).. ;; We ar
3c40: 65 20 61 62 6f 75 74 20 74 6f 20 61 63 74 75 61 e about to actua
3c50: 6c 6c 79 20 6b 69 63 6b 20 6f 66 66 20 74 68 65 lly kick off the
3c60: 20 74 65 73 74 0a 09 20 20 20 20 3b 3b 20 73 6f test.. ;; so
3c70: 20 74 68 69 73 20 69 73 20 61 20 67 6f 6f 64 20 this is a good
3c80: 70 6c 61 63 65 20 74 6f 20 72 65 6d 6f 76 65 20 place to remove
3c90: 74 68 65 20 72 65 63 6f 72 64 73 20 66 6f 72 20 the records for
3ca0: 0a 09 20 20 20 20 3b 3b 20 61 6e 79 20 70 72 65 .. ;; any pre
3cb0: 76 69 6f 75 73 20 72 75 6e 73 0a 09 20 20 20 20 vious runs..
3cc0: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 72 65 6d 6f ;; (db:test-remo
3cd0: 76 65 2d 73 74 65 70 73 20 64 62 20 72 75 6e 2d ve-steps db run-
3ce0: 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d id testname item
3cf0: 64 61 74 29 0a 09 20 20 20 20 0a 09 20 20 20 20 dat).. ..
3d00: 3b 3b 20 66 72 6f 6d 20 68 65 72 65 20 6f 6e 20 ;; from here on
3d10: 6f 75 74 20 77 65 20 77 69 6c 6c 20 6f 70 65 6e out we will open
3d20: 20 61 6e 64 20 63 6c 6f 73 65 20 74 68 65 20 64 and close the d
3d30: 62 0a 09 20 20 20 20 3b 3b 20 6f 6e 20 65 76 65 b.. ;; on eve
3d40: 72 79 20 61 63 63 65 73 73 20 74 6f 20 72 65 64 ry access to red
3d50: 75 63 65 20 74 68 65 20 70 72 6f 62 61 62 6c 69 uce the probabli
3d60: 74 69 79 20 6f 66 20 0a 09 20 20 20 20 3b 3b 20 tiy of .. ;;
3d70: 63 6f 6e 74 65 6e 74 69 6f 6e 20 6f 72 20 73 74 contention or st
3d80: 75 63 6b 20 61 63 63 65 73 73 20 6f 6e 20 6e 66 uck access on nf
3d90: 73 2e 0a 09 20 20 20 20 28 73 71 6c 69 74 65 33 s... (sqlite3
3da0: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 0a :finalize! db)..
3db0: 09 20 20 20 20 28 6c 65 74 2a 20 28 28 6d 20 20 . (let* ((m
3dc0: 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d (make-
3dd0: 6d 75 74 65 78 29 29 0a 09 09 20 20 20 28 6b 69 mutex))... (ki
3de0: 6c 6c 2d 6a 6f 62 3f 20 20 20 20 23 66 29 0a 09 ll-job? #f)..
3df0: 09 20 20 20 28 65 78 69 74 2d 69 6e 66 6f 20 20 . (exit-info
3e00: 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 33 (make-vector 3
3e10: 29 29 0a 09 09 20 20 20 28 6a 6f 62 2d 74 68 72 ))... (job-thr
3e20: 65 61 64 20 20 20 23 66 29 0a 09 09 20 20 20 28 ead #f)... (
3e30: 72 75 6e 69 74 20 20 20 20 20 20 20 20 28 6c 61 runit (la
3e40: 6d 62 64 61 20 28 29 0a 09 09 09 09 20 20 20 3b mbda ()..... ;
3e50: 3b 20 28 6c 65 74 2d 76 61 6c 75 65 73 0a 09 09 ; (let-values...
3e60: 09 09 20 20 20 3b 3b 20 20 28 28 28 70 69 64 20 .. ;; (((pid
3e70: 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 exit-status exit
3e80: 2d 63 6f 64 65 29 0a 09 09 09 09 20 20 20 3b 3b -code)..... ;;
3e90: 20 20 20 20 28 72 75 6e 2d 6e 2d 77 61 69 74 20 (run-n-wait
3ea0: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 fullrunscript)))
3eb0: 0a 09 09 09 09 20 20 20 28 6c 65 74 20 28 28 70 ..... (let ((p
3ec0: 69 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 id (process-run
3ed0: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 fullrunscript)))
3ee0: 0a 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 6c ..... (let l
3ef0: 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 09 09 09 oop ((i 0)).....
3f00: 20 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 (let-valu
3f10: 65 73 0a 09 09 09 09 09 28 28 28 70 69 64 2d 76 es......(((pid-v
3f20: 61 6c 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 al exit-status e
3f30: 78 69 74 2d 63 6f 64 65 29 20 28 70 72 6f 63 65 xit-code) (proce
3f40: 73 73 2d 77 61 69 74 20 70 69 64 20 23 74 29 29 ss-wait pid #t))
3f50: 29 0a 09 09 09 09 09 28 6d 75 74 65 78 2d 6c 6f )......(mutex-lo
3f60: 63 6b 21 20 6d 29 0a 09 09 09 09 09 28 76 65 63 ck! m)......(vec
3f70: 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e tor-set! exit-in
3f80: 66 6f 20 30 20 70 69 64 29 0a 09 09 09 09 09 28 fo 0 pid)......(
3f90: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit
3fa0: 2d 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 61 -info 1 exit-sta
3fb0: 74 75 73 29 0a 09 09 09 09 09 28 76 65 63 74 6f tus)......(vecto
3fc0: 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f r-set! exit-info
3fd0: 20 32 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 2 exit-code)...
3fe0: 09 09 09 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b ...(mutex-unlock
3ff0: 21 20 6d 29 0a 09 09 09 09 09 28 69 66 20 28 65 ! m)......(if (e
4000: 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 09 q? pid-val 0)...
4010: 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ... (begin...
4020: 09 09 09 20 20 20 20 20 20 28 74 68 72 65 61 64 ... (thread
4030: 2d 73 6c 65 65 70 21 20 32 29 0a 09 09 09 09 09 -sleep! 2)......
4040: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 2b 20 69 (loop (+ i
4050: 20 31 29 29 29 0a 09 09 09 09 09 20 20 20 20 29 1)))...... )
4060: 29 29 29 29 29 0a 09 09 20 20 20 28 6d 6f 6e 69 )))))... (moni
4070: 74 6f 72 6a 6f 62 20 20 20 28 6c 61 6d 62 64 61 torjob (lambda
4080: 20 28 29 0a 09 09 09 09 20 20 20 28 6c 65 74 2a ()..... (let*
4090: 20 28 28 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 ((start-seconds
40a0: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
40b0: 73 29 29 0a 09 09 09 09 09 20 20 28 63 61 6c 63 s))...... (calc
40c0: 2d 6d 69 6e 75 74 65 73 20 20 28 6c 61 6d 62 64 -minutes (lambd
40d0: 61 20 28 29 0a 09 09 09 09 09 09 09 20 20 20 28 a ()........ (
40e0: 69 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 20 0a inexact->exact .
40f0: 09 09 09 09 09 09 09 20 20 20 20 28 72 6f 75 6e ....... (roun
4100: 64 20 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 d ........ (
4110: 2d 20 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 - ........
4120: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
4130: 29 20 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 ) ........
4140: 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 29 29 29 start-seconds)))
4150: 29 29 0a 09 09 09 09 09 20 20 28 6b 69 6c 6c 2d ))...... (kill-
4160: 74 72 69 65 73 20 30 29 29 0a 09 09 09 09 20 20 tries 0)).....
4170: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6d (let loop ((m
4180: 69 6e 75 74 65 73 20 20 20 28 63 61 6c 63 2d 6d inutes (calc-m
4190: 69 6e 75 74 65 73 29 29 29 0a 09 09 09 09 20 20 inutes))).....
41a0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 64 62 20 (let* ((db
41b0: 20 20 20 20 20 20 28 6f 70 65 6e 2d 64 62 29 29 (open-db))
41c0: 0a 09 09 09 09 09 20 20 20 20 20 20 28 63 70 75 ...... (cpu
41d0: 6c 6f 61 64 20 20 28 67 65 74 2d 63 70 75 2d 6c load (get-cpu-l
41e0: 6f 61 64 29 29 0a 09 09 09 09 09 20 20 20 20 20 oad))......
41f0: 20 28 64 69 73 6b 66 72 65 65 20 28 67 65 74 2d (diskfree (get-
4200: 64 66 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 df (current-dire
4210: 63 74 6f 72 79 29 29 29 0a 09 09 09 09 09 20 20 ctory)))......
4220: 20 20 20 20 28 74 6d 70 66 72 65 65 20 20 28 67 (tmpfree (g
4230: 65 74 2d 64 66 20 22 2f 74 6d 70 22 29 29 29 0a et-df "/tmp"))).
4240: 09 09 09 09 09 20 28 69 66 20 28 6e 6f 74 20 63 ..... (if (not c
4250: 70 75 6c 6f 61 64 29 20 20 28 62 65 67 69 6e 20 puload) (begin
4260: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
4270: 57 41 52 4e 49 4e 47 3a 20 43 50 55 4c 4f 41 44 WARNING: CPULOAD
4280: 20 6e 6f 74 20 66 6f 75 6e 64 2e 22 29 20 20 28 not found.") (
4290: 73 65 74 21 20 63 70 75 6c 6f 61 64 20 22 6e 2f set! cpuload "n/
42a0: 61 22 29 29 29 0a 09 09 09 09 09 20 28 69 66 20 a")))...... (if
42b0: 28 6e 6f 74 20 64 69 73 6b 66 72 65 65 29 20 28 (not diskfree) (
42c0: 62 65 67 69 6e 20 28 64 65 62 75 67 3a 70 72 69 begin (debug:pri
42d0: 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 44 nt 0 "WARNING: D
42e0: 49 53 4b 46 52 45 45 20 6e 6f 74 20 66 6f 75 6e ISKFREE not foun
42f0: 64 2e 22 29 20 28 73 65 74 21 20 64 69 73 6b 66 d.") (set! diskf
4300: 72 65 65 20 22 6e 2f 61 22 29 29 29 0a 09 09 09 ree "n/a")))....
4310: 09 09 20 28 73 65 74 21 20 6b 69 6c 6c 2d 6a 6f .. (set! kill-jo
4320: 62 3f 20 28 74 65 73 74 2d 67 65 74 2d 6b 69 6c b? (test-get-kil
4330: 6c 2d 72 65 71 75 65 73 74 20 64 62 20 72 75 6e l-request db run
4340: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
4350: 65 6d 64 61 74 29 29 0a 09 09 09 09 09 20 28 74 emdat))...... (t
4360: 65 73 74 2d 75 70 64 61 74 65 2d 6d 65 74 61 2d est-update-meta-
4370: 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 20 74 info db run-id t
4380: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 est-name itemdat
4390: 20 6d 69 6e 75 74 65 73 20 63 70 75 6c 6f 61 64 minutes cpuload
43a0: 20 64 69 73 6b 66 72 65 65 20 74 6d 70 66 72 65 diskfree tmpfre
43b0: 65 29 0a 09 09 09 09 09 20 28 69 66 20 6b 69 6c e)...... (if kil
43c0: 6c 2d 6a 6f 62 3f 20 0a 09 09 09 09 09 20 20 20 l-job? ......
43d0: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 (begin......
43e0: 20 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b (mutex-lock
43f0: 21 20 6d 29 0a 09 09 09 09 09 20 20 20 20 20 20 ! m)......
4400: 20 28 6c 65 74 2a 20 28 28 70 69 64 20 28 76 65 (let* ((pid (ve
4410: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
4420: 66 6f 20 30 29 29 29 0a 09 09 09 09 09 09 20 28 fo 0)))....... (
4430: 69 66 20 28 6e 75 6d 62 65 72 3f 20 70 69 64 29 if (number? pid)
4440: 0a 09 09 09 09 09 09 20 20 20 20 20 28 62 65 67 ....... (beg
4450: 69 6e 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 in.......
4460: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
4470: 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 WARNING: Request
4480: 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 6c received to kil
4490: 6c 20 6a 6f 62 20 28 61 74 74 65 6d 70 74 20 23 l job (attempt #
44a0: 20 22 20 6b 69 6c 6c 2d 74 72 69 65 73 20 22 29 " kill-tries ")
44b0: 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 ").......
44c0: 28 6c 65 74 20 28 28 70 72 6f 63 65 73 73 65 73 (let ((processes
44d0: 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 (cmd-run->list
44e0: 28 63 6f 6e 63 20 22 70 67 72 65 70 20 2d 6c 20 (conc "pgrep -l
44f0: 2d 50 20 22 20 70 69 64 29 29 29 29 0a 09 09 09 -P " pid))))....
4500: 09 09 09 09 20 28 66 6f 72 2d 65 61 63 68 20 0a .... (for-each .
4510: 09 09 09 09 09 09 09 20 20 28 6c 61 6d 62 64 61 ....... (lambda
4520: 20 28 70 29 0a 09 09 09 09 09 09 09 20 20 20 20 (p)........
4530: 28 6c 65 74 2a 20 28 28 70 61 72 74 73 20 20 28 (let* ((parts (
4540: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 29 29 string-split p))
4550: 0a 09 09 09 09 09 09 09 09 20 20 20 28 70 2d 69 ......... (p-i
4560: 64 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 d (if (> (leng
4570: 74 68 20 70 61 72 74 73 29 20 30 29 0a 09 09 09 th parts) 0)....
4580: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 73 74 ...... (st
4590: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 ring->number (ca
45a0: 72 20 70 61 72 74 73 29 29 0a 09 09 09 09 09 09 r parts)).......
45b0: 09 09 09 20 20 20 20 20 20 20 23 66 29 29 29 0a ... #f))).
45c0: 09 09 09 09 09 09 09 20 20 20 20 20 20 28 69 66 ....... (if
45d0: 20 70 2d 69 64 0a 09 09 09 09 09 09 09 09 20 20 p-id.........
45e0: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 09 20 (begin.........
45f0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
4600: 30 20 22 4b 69 6c 6c 69 6e 67 20 22 20 28 63 61 0 "Killing " (ca
4610: 64 72 20 70 61 72 74 73 29 20 22 3b 20 6b 69 6c dr parts) "; kil
4620: 6c 20 2d 39 20 20 22 20 70 2d 69 64 29 0a 09 09 l -9 " p-id)...
4630: 09 09 09 09 09 09 20 20 20 20 28 73 79 73 74 65 ...... (syste
4640: 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d 39 m (conc "kill -9
4650: 20 22 20 70 2d 69 64 29 29 29 29 29 29 0a 09 09 " p-id))))))...
4660: 09 09 09 09 09 20 20 28 63 61 72 20 70 72 6f 63 ..... (car proc
4670: 65 73 73 65 73 29 29 0a 09 09 09 09 09 09 09 20 esses))........
4680: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6b (system (conc "k
4690: 69 6c 6c 20 2d 39 20 22 20 70 69 64 29 29 29 29 ill -9 " pid))))
46a0: 0a 09 09 09 09 09 09 20 20 20 20 20 28 62 65 67 ....... (beg
46b0: 69 6e 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 in.......
46c0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
46d0: 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 WARNING: Request
46e0: 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 6c received to kil
46f0: 6c 20 6a 6f 62 20 62 75 74 20 70 72 6f 62 6c 65 l job but proble
4700: 6d 20 77 69 74 68 20 70 72 6f 63 65 73 73 2c 20 m with process,
4710: 61 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 6b 69 attempting to ki
4720: 6c 6c 20 6d 61 6e 61 67 65 72 20 70 72 6f 63 65 ll manager proce
4730: 73 73 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 ss").......
4740: 20 20 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 (test-set-stat
4750: 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 us! db run-id te
4760: 73 74 2d 6e 61 6d 65 20 22 4b 49 4c 4c 45 44 22 st-name "KILLED"
4770: 20 20 22 46 41 49 4c 22 0a 09 09 09 09 09 09 09 "FAIL"........
4780: 09 09 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 .. itemdat (args
4790: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 23 :get-arg "-m") #
47a0: 66 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 f).......
47b0: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
47c0: 65 21 20 64 62 29 0a 09 09 09 09 09 09 20 20 20 e! db).......
47d0: 20 20 20 20 28 65 78 69 74 20 31 29 29 29 29 0a (exit 1)))).
47e0: 09 09 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ..... (set
47f0: 21 20 6b 69 6c 6c 2d 74 72 69 65 73 20 28 2b 20 ! kill-tries (+
4800: 31 20 6b 69 6c 6c 2d 74 72 69 65 73 29 29 0a 09 1 kill-tries))..
4810: 09 09 09 09 20 20 20 20 20 20 20 28 6d 75 74 65 .... (mute
4820: 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 29 29 0a 09 x-unlock! m)))..
4830: 09 09 09 09 20 28 73 71 6c 69 74 65 33 3a 66 69 .... (sqlite3:fi
4840: 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 09 09 nalize! db).....
4850: 09 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 . (thread-sleep!
4860: 20 28 2b 20 38 20 28 72 61 6e 64 6f 6d 20 34 29 (+ 8 (random 4)
4870: 29 29 20 3b 3b 20 61 64 64 20 73 6f 6d 65 20 6a )) ;; add some j
4880: 69 74 74 65 72 20 74 6f 20 74 68 65 20 63 61 6c itter to the cal
4890: 6c 20 68 6f 6d 65 20 74 69 6d 65 20 74 6f 20 73 l home time to s
48a0: 70 72 65 61 64 20 6f 75 74 20 74 68 65 20 64 62 pread out the db
48b0: 20 61 63 63 65 73 73 65 73 0a 09 09 09 09 09 20 accesses......
48c0: 28 6c 6f 6f 70 20 28 63 61 6c 63 2d 6d 69 6e 75 (loop (calc-minu
48d0: 74 65 73 29 29 29 29 29 29 29 0a 09 09 20 20 20 tes)))))))...
48e0: 28 74 68 31 20 20 20 20 20 20 20 20 20 20 28 6d (th1 (m
48f0: 61 6b 65 2d 74 68 72 65 61 64 20 6d 6f 6e 69 74 ake-thread monit
4900: 6f 72 6a 6f 62 29 29 0a 09 09 20 20 20 28 74 68 orjob))... (th
4910: 32 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2 (make
4920: 2d 74 68 72 65 61 64 20 72 75 6e 69 74 29 29 29 -thread runit)))
4930: 0a 09 20 20 20 20 20 20 28 73 65 74 21 20 6a 6f .. (set! jo
4940: 62 2d 74 68 72 65 61 64 20 74 68 32 29 0a 09 20 b-thread th2)..
4950: 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 (thread-sta
4960: 72 74 21 20 74 68 31 29 0a 09 20 20 20 20 20 20 rt! th1)..
4970: 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 (thread-start! t
4980: 68 32 29 0a 09 20 20 20 20 20 20 28 74 68 72 65 h2).. (thre
4990: 61 64 2d 6a 6f 69 6e 21 20 74 68 32 29 0a 09 20 ad-join! th2)..
49a0: 20 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b (mutex-lock
49b0: 21 20 6d 29 0a 09 20 20 20 20 20 20 28 73 65 74 ! m).. (set
49c0: 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a ! db (open-db)).
49d0: 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 69 . (let* ((i
49e0: 74 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c tem-path (item-l
49f0: 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 ist->path itemda
4a00: 74 29 29 0a 09 09 20 20 20 20 20 28 74 65 73 74 t))... (test
4a10: 69 6e 66 6f 20 20 28 64 62 3a 67 65 74 2d 74 65 info (db:get-te
4a20: 73 74 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 st-info db run-i
4a30: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
4a40: 2d 70 61 74 68 29 29 29 0a 09 09 28 69 66 20 28 -path)))...(if (
4a50: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 3a not (equal? (db:
4a60: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
4a70: 65 73 74 69 6e 66 6f 29 20 22 43 4f 4d 50 4c 45 estinfo) "COMPLE
4a80: 54 45 44 22 29 29 0a 09 09 20 20 20 20 28 62 65 TED"))... (be
4a90: 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 gin... (deb
4aa0: 75 67 3a 70 72 69 6e 74 20 32 20 22 54 65 73 74 ug:print 2 "Test
4ab0: 20 4e 4f 54 20 6c 6f 67 67 65 64 20 61 73 20 43 NOT logged as C
4ac0: 4f 4d 50 4c 45 54 45 44 2c 20 28 73 74 61 74 65 OMPLETED, (state
4ad0: 3d 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d =" (db:test-get-
4ae0: 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 20 state testinfo)
4af0: 22 29 2c 20 75 70 64 61 74 69 6e 67 20 72 65 73 "), updating res
4b00: 75 6c 74 22 29 0a 09 09 20 20 20 20 20 20 28 74 ult")... (t
4b10: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
4b20: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
4b30: 61 6d 65 0a 09 09 09 09 09 28 69 66 20 6b 69 6c ame......(if kil
4b40: 6c 2d 6a 6f 62 3f 20 22 4b 49 4c 4c 45 44 22 20 l-job? "KILLED"
4b50: 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 09 09 09 "COMPLETED")....
4b60: 09 09 28 69 66 20 28 76 65 63 74 6f 72 2d 72 65 ..(if (vector-re
4b70: 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 20 3b f exit-info 1) ;
4b80: 3b 20 6c 6f 6f 6b 20 61 74 20 74 68 65 20 65 78 ; look at the ex
4b90: 69 74 2d 73 74 61 74 75 73 0a 09 09 09 09 09 20 it-status......
4ba0: 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 (if (and (not
4bb0: 20 6b 69 6c 6c 2d 6a 6f 62 3f 29 20 0a 09 09 09 kill-job?) ....
4bc0: 09 09 09 20 20 20 20 20 28 65 71 3f 20 28 76 65 ... (eq? (ve
4bd0: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
4be0: 66 6f 20 32 29 20 30 29 29 0a 09 09 09 09 09 09 fo 2) 0)).......
4bf0: 22 50 41 53 53 22 0a 09 09 09 09 09 09 22 46 41 "PASS"......."FA
4c00: 49 4c 22 29 0a 09 09 09 09 09 20 20 20 20 22 46 IL")...... "F
4c10: 41 49 4c 22 29 20 69 74 65 6d 64 61 74 20 28 61 AIL") itemdat (a
4c20: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
4c30: 29 20 23 66 29 29 29 0a 09 09 3b 3b 20 66 6f 72 ) #f)))...;; for
4c40: 20 61 75 74 6f 6d 61 74 65 64 20 63 72 65 61 74 automated creat
4c50: 69 6f 6e 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 ion of the rollu
4c60: 70 20 68 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 p html file this
4c70: 20 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 is a good place
4c80: 2e 2e 2e 0a 09 09 28 69 66 20 28 6e 6f 74 20 28 ......(if (not (
4c90: 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 equal? item-path
4ca0: 20 22 22 29 29 0a 09 09 20 20 20 28 74 65 73 74 ""))... (test
4cb0: 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d s:summarize-item
4cc0: 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 s db run-id test
4cd0: 2d 6e 61 6d 65 20 23 66 29 29 20 3b 3b 20 64 6f -name #f)) ;; do
4ce0: 6e 27 74 20 66 6f 72 63 65 20 2d 20 6a 75 73 74 n't force - just
4cf0: 20 75 70 64 61 74 65 20 69 66 20 6e 6f 0a 09 09 update if no...
4d00: 29 0a 09 20 20 20 20 20 20 28 6d 75 74 65 78 2d ).. (mutex-
4d10: 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 unlock! m)..
4d20: 20 20 3b 3b 20 28 65 78 65 63 2d 72 65 73 75 6c ;; (exec-resul
4d30: 74 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 ts (cmd-run->lis
4d40: 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 t fullrunscript)
4d50: 29 20 3b 3b 20 20 28 6c 69 73 74 20 22 3e 22 20 ) ;; (list ">"
4d60: 28 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 (conc test-name
4d70: 22 2d 72 75 6e 2e 6c 6f 67 22 29 29 29 29 0a 09 "-run.log"))))..
4d80: 20 20 20 20 20 20 3b 3b 20 28 73 75 63 63 65 73 ;; (succes
4d90: 73 20 20 20 20 20 20 65 78 65 63 2d 72 65 73 75 s exec-resu
4da0: 6c 74 73 29 29 20 3b 3b 20 28 65 71 3f 20 28 63 lts)) ;; (eq? (c
4db0: 61 64 72 20 65 78 65 63 2d 72 65 73 75 6c 74 73 adr exec-results
4dc0: 29 20 30 29 29 29 0a 09 20 20 20 20 20 20 28 64 ) 0))).. (d
4dd0: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4f 75 ebug:print 2 "Ou
4de0: 74 70 75 74 20 66 72 6f 6d 20 72 75 6e 6e 69 6e tput from runnin
4df0: 67 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 g " fullrunscrip
4e00: 74 20 22 2c 20 70 69 64 20 22 20 28 76 65 63 74 t ", pid " (vect
4e10: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
4e20: 20 30 29 20 22 20 69 6e 20 77 6f 72 6b 20 61 72 0) " in work ar
4e30: 65 61 20 22 20 0a 09 09 20 20 20 20 20 77 6f 72 ea " ... wor
4e40: 6b 2d 61 72 65 61 20 22 3a 5c 6e 3d 3d 3d 3d 5c k-area ":\n====\
4e50: 6e 20 65 78 69 74 20 63 6f 64 65 20 22 20 28 76 n exit code " (v
4e60: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
4e70: 6e 66 6f 20 32 29 20 22 5c 6e 22 20 22 3d 3d 3d nfo 2) "\n" "===
4e80: 3d 5c 6e 22 29 0a 09 20 20 20 20 20 20 28 73 71 =\n").. (sq
4e90: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
4ea0: 64 62 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 db).. (if (
4eb0: 6e 6f 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 not (vector-ref
4ec0: 65 78 69 74 2d 69 6e 66 6f 20 31 29 29 0a 09 09 exit-info 1))...
4ed0: 20 20 28 65 78 69 74 20 34 29 29 29 29 29 0a 20 (exit 4))))).
4ee0: 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
4ef0: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
4f00: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
4f10: 72 67 20 22 2d 73 74 65 70 22 29 0a 20 20 20 20 rg "-step").
4f20: 28 69 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 (if (not (getenv
4f30: 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a "MT_CMDINFO")).
4f40: 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 .(begin.. (debu
4f50: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
4f60: 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 : MT_CMDINFO env
4f70: 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 2d 73 var not set, -s
4f80: 74 65 70 20 6d 75 73 74 20 62 65 20 63 61 6c 6c tep must be call
4f90: 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 ed *inside* a me
4fa0: 67 61 74 65 73 74 20 69 6e 76 6f 6b 65 64 20 65 gatest invoked e
4fb0: 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 20 nvironment!")..
4fc0: 20 28 65 78 69 74 20 35 29 29 0a 09 28 6c 65 74 (exit 5))..(let
4fd0: 2a 20 28 28 73 74 65 70 20 20 20 20 20 20 28 61 * ((step (a
4fe0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
4ff0: 65 70 22 29 29 0a 09 20 20 20 20 20 20 20 28 63 ep")).. (c
5000: 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 mdinfo (read (
5010: 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e open-input-strin
5020: 67 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 g (base64:base64
5030: 2d 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 -decode (getenv
5040: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 "MT_CMDINFO"))))
5050: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 ).. (testp
5060: 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
5070: 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
5080: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
5090: 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 (test-name (ass
50a0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
50b0: 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a -name cmdinfo)).
50c0: 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 . (runscri
50d0: 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c pt (assoc/defaul
50e0: 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 t 'runscript cmd
50f0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
5100: 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 db-host (assoc
5110: 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 /default 'db-hos
5120: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
5130: 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id
5140: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
5150: 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 'run-id cmdin
5160: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 fo)).. (it
5170: 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 emdat (assoc/d
5180: 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 efault 'itemdat
5190: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
51a0: 20 20 20 20 28 64 62 20 20 20 20 20 20 20 20 23 (db #
51b0: 66 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 f).. (stat
51c0: 65 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 e (args:get-a
51d0: 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 rg ":state"))..
51e0: 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 (status
51f0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
5200: 73 74 61 74 75 73 22 29 29 29 0a 09 20 20 28 63 status"))).. (c
5210: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
5220: 74 65 73 74 70 61 74 68 29 0a 09 20 20 28 69 66 testpath).. (if
5230: 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 (not (setup-for
5240: 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 28 62 -run)).. (b
5250: 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 egin...(debug:pr
5260: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f int 0 "Failed to
5270: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
5280: 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 )...(exit 1)))..
5290: 20 20 28 73 65 74 21 20 64 62 20 28 6f 70 65 6e (set! db (open
52a0: 2d 64 62 29 29 0a 09 20 20 28 69 66 20 28 61 6e -db)).. (if (an
52b0: 64 20 73 74 61 74 65 20 73 74 61 74 75 73 29 0a d state status).
52c0: 09 20 20 20 20 20 20 28 74 65 73 74 73 74 65 70 . (teststep
52d0: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 -set-status! db
52e0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
52f0: 20 73 74 65 70 20 73 74 61 74 65 20 73 74 61 74 step state stat
5300: 75 73 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 us itemdat (args
5310: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a :get-arg "-m")).
5320: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
5330: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
5340: 45 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 20 ERROR: You must
5350: 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 specify :state a
5360: 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 nd :status with
5370: 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 73 every call to -s
5380: 74 65 70 22 29 0a 09 09 28 65 78 69 74 20 36 29 tep")...(exit 6)
5390: 29 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 66 )).. (sqlite3:f
53a0: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 inalize! db)..
53b0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
53c0: 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 28 69 66 ing* #t))))..(if
53d0: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
53e0: 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 20 20 20 rg "-setlog")
53f0: 20 20 20 20 3b 3b 20 73 69 6e 63 65 20 73 65 74 ;; since set
5400: 74 69 6e 67 20 75 70 20 69 73 20 73 6f 20 63 6f ting up is so co
5410: 73 74 6c 79 20 6c 65 74 73 20 70 69 67 67 79 62 stly lets piggyb
5420: 61 63 6b 20 6f 6e 20 2d 74 65 73 74 2d 73 74 61 ack on -test-sta
5430: 74 75 73 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 tus..(args:get-a
5440: 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 rg "-set-toplog"
5450: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
5460: 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 "-test-status")
5470: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
5480: 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 0a 09 "-set-values")..
5490: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
54a0: 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 load-test-data")
54b0: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
54c0: 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 28 61 72 "-runstep")..(ar
54d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d gs:get-arg "-sum
54e0: 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 29 0a marize-items")).
54f0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 (if (not (ge
5500: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
5510: 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 "))..(begin.. (
5520: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
5530: 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f RROR: MT_CMDINFO
5540: 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74 env var not set
5550: 2c 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 65 73 74 , commands -test
5560: 2d 73 74 61 74 75 73 2c 20 2d 72 75 6e 73 74 65 -status, -runste
5570: 70 20 61 6e 64 20 2d 73 65 74 6c 6f 67 20 6d 75 p and -setlog mu
5580: 73 74 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e st be called *in
5590: 73 69 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74 side* a megatest
55a0: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a environment!").
55b0: 09 20 20 28 65 78 69 74 20 35 29 29 0a 09 28 6c . (exit 5))..(l
55c0: 65 74 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69 et* ((startingdi
55d0: 72 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 r (current-direc
55e0: 74 6f 72 79 29 29 0a 09 20 20 20 20 20 20 20 28 tory)).. (
55f0: 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 cmdinfo (read
5600: 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 (open-input-stri
5610: 6e 67 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 ng (base64:base6
5620: 34 2d 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 4-decode (getenv
5630: 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 "MT_CMDINFO")))
5640: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
5650: 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 path (assoc/def
5660: 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 ault 'testpath
5670: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
5680: 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 (test-name (as
5690: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
56a0: 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 t-name cmdinfo))
56b0: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 .. (runscr
56c0: 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ipt (assoc/defau
56d0: 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d lt 'runscript cm
56e0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
56f0: 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f (db-host (asso
5700: 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f c/default 'db-ho
5710: 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 st cmdinfo))..
5720: 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 (run-id
5730: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
5740: 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 'run-id cmdi
5750: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 nfo)).. (i
5760: 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f temdat (assoc/
5770: 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 default 'itemdat
5780: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
5790: 20 20 20 20 20 28 64 62 20 20 20 20 20 20 20 20 (db
57a0: 23 66 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 #f).. (sta
57b0: 74 65 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 te (args:get
57c0: 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a -arg ":state")).
57d0: 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 20 . (status
57e0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
57f0: 20 22 3a 73 74 61 74 75 73 22 29 29 29 0a 09 20 ":status")))..
5800: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
5810: 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 20 20 ry testpath)..
5820: 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d (if (not (setup-
5830: 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 for-run))..
5840: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
5850: 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 :print 0 "Failed
5860: 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 to setup, exiti
5870: 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 ng")...(exit 1))
5880: 29 0a 09 20 20 28 73 65 74 21 20 64 62 20 28 6f ).. (set! db (o
5890: 70 65 6e 2d 64 62 29 29 0a 09 20 20 28 69 66 20 pen-db)).. (if
58a0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
58b0: 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 load-test-data")
58c0: 0a 09 20 20 20 20 20 20 28 64 62 3a 6c 6f 61 64 .. (db:load
58d0: 2d 74 65 73 74 2d 64 61 74 61 20 64 62 20 72 75 -test-data db ru
58e0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
58f0: 74 65 6d 64 61 74 29 29 0a 09 20 20 28 69 66 20 temdat)).. (if
5900: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5910: 73 65 74 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 setlog")..
5920: 28 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 64 (test-set-log! d
5930: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
5940: 6d 65 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 me itemdat (args
5950: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f :get-arg "-setlo
5960: 67 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 g"))).. (if (ar
5970: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
5980: 2d 74 6f 70 6c 6f 67 22 29 0a 09 20 20 20 20 20 -toplog")..
5990: 20 28 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f (test-set-toplo
59a0: 67 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 g! db run-id tes
59b0: 74 2d 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 t-name (args:get
59c0: 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f -arg "-set-toplo
59d0: 67 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 g"))).. (if (ar
59e0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d gs:get-arg "-sum
59f0: 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 0a 09 marize-items")..
5a00: 20 20 20 20 20 20 28 74 65 73 74 73 3a 73 75 6d (tests:sum
5a10: 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 64 62 20 marize-items db
5a20: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
5a30: 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 6f 72 63 #t)) ;; do forc
5a40: 65 20 68 65 72 65 0a 09 20 20 28 69 66 20 28 61 e here.. (if (a
5a50: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
5a60: 6e 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 28 nstep").. (
5a70: 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 if (null? remarg
5a80: 73 29 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 s)... (begin...
5a90: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
5aa0: 20 30 20 22 45 52 52 4f 52 3a 20 6e 6f 74 68 69 0 "ERROR: nothi
5ab0: 6e 67 20 73 70 65 63 69 66 69 65 64 20 74 6f 20 ng specified to
5ac0: 72 75 6e 21 22 29 0a 09 09 20 20 20 20 28 73 71 run!")... (sq
5ad0: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
5ae0: 64 62 29 0a 09 09 20 20 20 20 28 65 78 69 74 20 db)... (exit
5af0: 36 29 29 0a 09 09 20 20 28 6c 65 74 2a 20 28 28 6))... (let* ((
5b00: 73 74 65 70 6e 61 6d 65 20 20 20 28 61 72 67 73 stepname (args
5b10: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 :get-arg "-runst
5b20: 65 70 22 29 29 0a 09 09 09 20 28 6c 6f 67 70 72 ep")).... (logpr
5b30: 6f 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d ofile (args:get-
5b40: 61 72 67 20 22 2d 6c 6f 67 70 72 6f 22 29 29 0a arg "-logpro")).
5b50: 09 09 09 20 28 6c 6f 67 66 69 6c 65 20 20 20 20 ... (logfile
5b60: 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 (conc stepname "
5b70: 2e 6c 6f 67 22 29 29 0a 09 09 09 20 28 63 6d 64 .log")).... (cmd
5b80: 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c (if (nul
5b90: 6c 3f 20 72 65 6d 61 72 67 73 29 20 23 66 20 28 l? remargs) #f (
5ba0: 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 0a 09 car remargs)))..
5bb0: 09 09 20 28 70 61 72 61 6d 73 20 20 20 20 20 28 .. (params (
5bc0: 69 66 20 63 6d 64 20 28 63 64 72 20 72 65 6d 61 if cmd (cdr rema
5bd0: 72 67 73 29 20 27 28 29 29 29 0a 09 09 09 20 28 rgs) '())).... (
5be0: 65 78 69 74 73 74 61 74 20 20 20 23 66 29 0a 09 exitstat #f)..
5bf0: 09 09 20 28 73 68 65 6c 6c 20 20 20 20 20 20 28 .. (shell (
5c00: 6c 61 73 74 20 28 73 74 72 69 6e 67 2d 73 70 6c last (string-spl
5c10: 69 74 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d it (get-environm
5c20: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 53 48 ent-variable "SH
5c30: 45 4c 4c 22 29 20 22 2f 22 29 29 29 0a 09 09 09 ELL") "/")))....
5c40: 20 28 72 65 64 69 72 20 20 20 20 20 20 28 63 61 (redir (ca
5c50: 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 se (string->symb
5c60: 6f 6c 20 73 68 65 6c 6c 29 0a 09 09 09 09 20 20 ol shell).....
5c70: 20 20 20 20 20 28 28 74 63 73 68 20 63 73 68 20 ((tcsh csh
5c80: 6b 73 68 29 20 20 20 20 22 3e 26 22 29 0a 09 09 ksh) ">&")...
5c90: 09 09 20 20 20 20 20 20 20 28 28 7a 73 68 20 62 .. ((zsh b
5ca0: 61 73 68 20 73 68 20 61 73 68 29 20 22 32 3e 26 ash sh ash) "2>&
5cb0: 31 20 3e 22 29 29 29 0a 09 09 09 20 28 66 75 6c 1 >"))).... (ful
5cc0: 6c 63 6d 64 20 20 20 20 28 63 6f 6e 63 20 22 28 lcmd (conc "(
5cd0: 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 " (string-inters
5ce0: 70 65 72 73 65 20 0a 09 09 09 09 09 09 28 63 6f perse .......(co
5cf0: 6e 73 20 63 6d 64 20 70 61 72 61 6d 73 29 20 22 ns cmd params) "
5d00: 20 22 29 0a 09 09 09 09 09 20 20 20 22 29 20 22 ")...... ") "
5d10: 20 72 65 64 69 72 20 22 20 22 20 6c 6f 67 66 69 redir " " logfi
5d20: 6c 65 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 6d le)))... ;; m
5d30: 61 72 6b 20 74 68 65 20 73 74 61 72 74 20 6f 66 ark the start of
5d40: 20 74 68 65 20 74 65 73 74 0a 09 09 20 20 20 20 the test...
5d50: 28 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 (teststep-set-st
5d60: 61 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 atus! db run-id
5d70: 74 65 73 74 2d 6e 61 6d 65 20 73 74 65 70 6e 61 test-name stepna
5d80: 6d 65 20 22 73 74 61 72 74 22 20 22 6e 2f 61 22 me "start" "n/a"
5d90: 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67 itemdat (args:g
5da0: 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 et-arg "-m"))...
5db0: 20 20 20 20 3b 3b 20 63 6c 6f 73 65 20 74 68 65 ;; close the
5dc0: 20 64 62 0a 09 09 20 20 20 20 28 73 71 6c 69 74 db... (sqlit
5dd0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
5de0: 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 74 68 ... ;; run th
5df0: 65 20 74 65 73 74 20 73 74 65 70 0a 09 09 20 20 e test step...
5e00: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
5e10: 20 22 49 4e 46 4f 3a 20 52 75 6e 6e 69 6e 67 20 "INFO: Running
5e20: 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 5c 22 22 \"" fullcmd "\""
5e30: 29 0a 09 09 20 20 20 20 28 63 68 61 6e 67 65 2d )... (change-
5e40: 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 directory starti
5e50: 6e 67 64 69 72 29 0a 09 09 20 20 20 20 28 73 65 ngdir)... (se
5e60: 74 21 20 65 78 69 74 73 74 61 74 20 28 73 79 73 t! exitstat (sys
5e70: 74 65 6d 20 66 75 6c 6c 63 6d 64 29 29 20 3b 3b tem fullcmd)) ;;
5e80: 20 63 6d 64 20 70 61 72 61 6d 73 29 29 0a 09 09 cmd params))...
5e90: 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 (set! *globa
5ea0: 6c 65 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 lexitstatus* exi
5eb0: 74 73 74 61 74 29 0a 09 09 20 20 20 20 28 63 68 tstat)... (ch
5ec0: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
5ed0: 65 73 74 70 61 74 68 29 0a 09 09 20 20 20 20 3b estpath)... ;
5ee0: 3b 20 72 65 2d 6f 70 65 6e 20 74 68 65 20 64 62 ; re-open the db
5ef0: 0a 09 09 20 20 20 20 28 73 65 74 21 20 64 62 20 ... (set! db
5f00: 28 6f 70 65 6e 2d 64 62 29 29 20 0a 09 09 20 20 (open-db)) ...
5f10: 20 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 ;; run logpro
5f20: 69 66 20 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b if applicable ;;
5f30: 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c (process-run "l
5f40: 73 22 20 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20 s" (list "/foo"
5f50: 22 32 3e 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67 "2>&1" "blah.log
5f60: 22 29 29 0a 09 09 20 20 20 20 28 69 66 20 6c 6f "))... (if lo
5f70: 67 70 72 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74 gprofile....(let
5f80: 2a 20 28 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 * ((htmllogfile
5f90: 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 (conc stepname "
5fa0: 2e 68 74 6d 6c 22 29 29 0a 09 09 09 20 20 20 20 .html"))....
5fb0: 20 20 20 28 6f 6c 64 65 78 69 74 73 74 61 74 20 (oldexitstat
5fc0: 65 78 69 74 73 74 61 74 29 0a 09 09 09 20 20 20 exitstat)....
5fd0: 20 20 20 20 28 63 6d 64 20 20 20 20 20 20 20 20 (cmd
5fe0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
5ff0: 65 72 73 65 20 28 6c 69 73 74 20 22 6c 6f 67 70 erse (list "logp
6000: 72 6f 22 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68 ro" logprofile h
6010: 74 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c tmllogfile "<" l
6020: 6f 67 66 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63 ogfile ">" (conc
6030: 20 73 74 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70 stepname "_logp
6040: 72 6f 2e 6c 6f 67 22 29 29 20 22 20 22 29 29 29 ro.log")) " ")))
6050: 0a 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 .... (debug:pri
6060: 6e 74 20 32 20 22 49 4e 46 4f 3a 20 72 75 6e 6e nt 2 "INFO: runn
6070: 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 ing \"" cmd "\""
6080: 29 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 ).... (change-d
6090: 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e irectory startin
60a0: 67 64 69 72 29 0a 09 09 09 20 20 28 73 65 74 21 gdir).... (set!
60b0: 20 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65 exitstat (syste
60c0: 6d 20 63 6d 64 29 29 0a 09 09 09 20 20 28 73 65 m cmd)).... (se
60d0: 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 t! *globalexitst
60e0: 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 20 atus* exitstat)
60f0: 3b 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 0a ;; no necessary.
6100: 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 ... (change-dir
6110: 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 ectory testpath)
6120: 0a 09 09 09 20 20 28 74 65 73 74 2d 73 65 74 2d .... (test-set-
6130: 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 74 log! db run-id t
6140: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 est-name itemdat
6150: 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 29 29 29 0a htmllogfile))).
6160: 09 09 20 20 20 20 28 74 65 73 74 73 74 65 70 2d .. (teststep-
6170: 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 72 set-status! db r
6180: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
6190: 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 stepname "end" e
61a0: 78 69 74 73 74 61 74 20 69 74 65 6d 64 61 74 20 xitstat itemdat
61b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
61c0: 6d 22 29 29 0a 09 09 20 20 20 20 28 73 71 6c 69 m"))... (sqli
61d0: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
61e0: 29 0a 09 09 20 20 20 20 28 69 66 20 28 6e 6f 74 )... (if (not
61f0: 20 28 65 71 3f 20 65 78 69 74 73 74 61 74 20 30 (eq? exitstat 0
6200: 29 29 0a 09 09 09 28 65 78 69 74 20 32 35 34 29 ))....(exit 254)
6210: 29 20 3b 3b 20 28 65 78 69 74 20 65 78 69 74 73 ) ;; (exit exits
6220: 74 61 74 29 20 64 6f 65 73 6e 27 74 20 77 6f 72 tat) doesn't wor
6230: 6b 3f 21 3f 0a 09 09 20 20 3b 3b 20 6f 70 65 6e k?!?... ;; open
6240: 20 74 68 65 20 64 62 0a 09 09 20 20 3b 3b 20 6d the db... ;; m
6250: 61 72 6b 20 74 68 65 20 65 6e 64 20 6f 66 20 74 ark the end of t
6260: 68 65 20 74 65 73 74 0a 09 09 20 20 29 29 29 0a he test... ))).
6270: 09 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 . (if (or (args
6280: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d :get-arg "-test-
6290: 73 74 61 74 75 73 22 29 0a 09 09 20 20 28 61 72 status")... (ar
62a0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
62b0: 2d 76 61 6c 75 65 73 22 29 29 0a 09 20 20 20 20 -values"))..
62c0: 20 20 28 6c 65 74 20 28 28 6e 65 77 73 74 61 74 (let ((newstat
62d0: 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e us (cond.....((n
62e0: 75 6d 62 65 72 3f 20 73 74 61 74 75 73 29 20 20 umber? status)
62f0: 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f (if (equal?
6300: 20 73 74 61 74 75 73 20 30 29 20 22 50 41 53 53 status 0) "PASS
6310: 22 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 28 " "FAIL")).....(
6320: 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 74 (and (string? st
6330: 61 74 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 atus).....
6340: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
6350: 73 74 61 74 75 73 29 29 28 69 66 20 28 65 71 75 status))(if (equ
6360: 61 6c 3f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d al? (string->num
6370: 62 65 72 20 73 74 61 74 75 73 29 20 30 29 20 22 ber status) 0) "
6380: 50 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 PASS" "FAIL"))..
6390: 09 09 09 28 65 6c 73 65 20 73 74 61 74 75 73 29 ...(else status)
63a0: 29 29 0a 09 09 20 20 20 20 3b 3b 20 74 72 61 6e ))... ;; tran
63b0: 73 66 65 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 sfer relevant ke
63c0: 79 73 20 69 6e 74 6f 20 61 20 68 61 73 68 20 74 ys into a hash t
63d0: 6f 20 62 65 20 70 61 73 73 65 64 20 74 6f 20 74 o be passed to t
63e0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a est-set-status!.
63f0: 09 09 20 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 .. ;; could u
6400: 73 65 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 se an assoc list
6410: 20 49 20 67 75 65 73 73 2e 20 0a 09 09 20 20 20 I guess. ...
6420: 20 28 6f 74 68 65 72 64 61 74 61 20 28 6c 65 74 (otherdata (let
6430: 20 28 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 ((res (make-has
6440: 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 09 20 h-table))).....
6450: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
6460: 61 20 28 6b 65 79 29 0a 09 09 09 09 09 20 20 20 a (key)......
6470: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
6480: 61 72 67 20 6b 65 79 29 0a 09 09 09 09 09 09 20 arg key).......
6490: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
64a0: 20 72 65 73 20 6b 65 79 20 28 61 72 67 73 3a 67 res key (args:g
64b0: 65 74 2d 61 72 67 20 6b 65 79 29 29 29 29 0a 09 et-arg key))))..
64c0: 09 09 09 09 20 20 20 28 6c 69 73 74 20 22 3a 76 .... (list ":v
64d0: 61 6c 75 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 alue" ":tol" ":e
64e0: 78 70 65 63 74 65 64 22 20 22 3a 66 69 72 73 74 xpected" ":first
64f0: 5f 65 72 72 22 20 22 3a 66 69 72 73 74 5f 77 61 _err" ":first_wa
6500: 72 6e 22 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 rn" ":units" ":c
6510: 61 74 65 67 6f 72 79 22 20 22 3a 76 61 72 69 61 ategory" ":varia
6520: 62 6c 65 22 29 29 0a 09 09 09 09 20 72 65 73 29 ble"))..... res)
6530: 29 29 0a 09 09 28 69 66 20 28 61 6e 64 20 28 61 ))...(if (and (a
6540: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
6550: 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 09 20 st-status")....
6560: 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 65 29 0a (or (not state).
6570: 09 09 09 20 20 20 20 20 28 6e 6f 74 20 73 74 61 ... (not sta
6580: 74 75 73 29 29 29 0a 09 09 20 20 20 20 28 62 65 tus)))... (be
6590: 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 gin... (deb
65a0: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
65b0: 52 3a 20 59 6f 75 20 6d 75 73 74 20 73 70 65 63 R: You must spec
65c0: 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a ify :state and :
65d0: 73 74 61 74 75 73 20 77 69 74 68 20 65 76 65 72 status with ever
65e0: 79 20 63 61 6c 6c 20 74 6f 20 2d 74 65 73 74 2d y call to -test-
65f0: 73 74 61 74 75 73 5c 6e 22 20 68 65 6c 70 29 0a status\n" help).
6600: 09 09 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 .. (sqlite3
6610: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 :finalize! db)..
6620: 09 20 20 20 20 20 20 28 65 78 69 74 20 36 29 29 . (exit 6))
6630: 29 0a 09 09 28 74 65 73 74 2d 73 65 74 2d 73 74 )...(test-set-st
6640: 61 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 atus! db run-id
6650: 74 65 73 74 2d 6e 61 6d 65 20 73 74 61 74 65 20 test-name state
6660: 6e 65 77 73 74 61 74 75 73 20 69 74 65 6d 64 61 newstatus itemda
6670: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
6680: 22 2d 6d 22 29 20 6f 74 68 65 72 64 61 74 61 29 "-m") otherdata)
6690: 29 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 66 )).. (sqlite3:f
66a0: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 inalize! db)..
66b0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
66c0: 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 28 69 66 ing* #t))))..(if
66d0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
66e0: 2d 73 68 6f 77 6b 65 79 73 22 29 0a 20 20 20 20 -showkeys").
66f0: 28 6c 65 74 20 28 28 64 62 20 23 66 29 0a 09 20 (let ((db #f)..
6700: 20 28 6b 65 79 73 20 23 66 29 29 0a 20 20 20 20 (keys #f)).
6710: 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 (if (not (setu
6720: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 p-for-run)).. (
6730: 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 begin.. (debu
6740: 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 g:print 0 "Faile
6750: 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit
6760: 69 6e 67 22 29 0a 09 20 20 20 20 28 65 78 69 74 ing").. (exit
6770: 20 31 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 1))). (set
6780: 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a ! db (open-db)).
6790: 20 20 20 20 20 20 28 73 65 74 21 20 6b 65 79 73 (set! keys
67a0: 20 28 64 62 2d 67 65 74 2d 6b 65 79 73 20 64 62 (db-get-keys db
67b0: 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a )). (debug:
67c0: 70 72 69 6e 74 20 31 20 22 4b 65 79 73 3a 20 22 print 1 "Keys: "
67d0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
67e0: 65 72 73 65 20 28 6d 61 70 20 6b 65 79 3a 67 65 erse (map key:ge
67f0: 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 t-fieldname keys
6800: 29 20 22 2c 20 22 29 29 0a 20 20 20 20 20 20 28 ) ", ")). (
6810: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
6820: 21 20 64 62 29 0a 20 20 20 20 20 20 28 73 65 74 ! db). (set
6830: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
6840: 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
6850: 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 75 69 22 s:get-arg "-gui"
6860: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
6870: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
6880: 30 20 22 4c 6f 6f 6b 20 61 74 20 74 68 65 20 64 0 "Look at the d
6890: 61 73 68 62 6f 61 72 64 20 66 6f 72 20 6e 6f 77 ashboard for now
68a0: 22 29 0a 20 20 20 20 20 20 3b 3b 20 28 6d 65 67 "). ;; (meg
68b0: 61 74 65 73 74 2d 67 75 69 29 0a 20 20 20 20 20 atest-gui).
68c0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
68d0: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d hing* #t)))..;;=
68e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
68f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 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 0a 3b 3b 20 55 70 64 61 74 65 20 =====.;; Update
6930: 74 68 65 20 64 61 74 61 62 61 73 65 20 73 63 68 the database sch
6940: 65 6d 61 20 6f 6e 20 72 65 71 75 65 73 74 0a 3b ema on request.;
6950: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
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 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
69a0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 62 gs:get-arg "-reb
69b0: 75 69 6c 64 2d 64 62 22 29 0a 20 20 20 20 28 62 uild-db"). (b
69c0: 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 egin. (if (
69d0: 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 not (setup-for-r
69e0: 75 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 un)).. (begin..
69f0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6a00: 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 0 "Failed to se
6a10: 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a tup, exiting") .
6a20: 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a . (exit 1))).
6a30: 20 20 20 20 20 20 3b 3b 20 6e 6f 77 20 63 61 6e ;; now can
6a40: 20 66 69 6e 64 20 6f 75 72 20 64 62 0a 20 20 20 find our db.
6a50: 20 20 20 28 73 65 74 21 20 64 62 20 28 6f 70 65 (set! db (ope
6a60: 6e 2d 64 62 29 29 0a 20 20 20 20 20 20 28 70 61 n-db)). (pa
6a70: 74 63 68 2d 64 62 20 64 62 29 0a 20 20 20 20 20 tch-db db).
6a80: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
6a90: 7a 65 21 20 64 62 29 0a 20 20 20 20 20 20 28 73 ze! db). (s
6aa0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
6ab0: 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d g* #t)))..;;====
6ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6b00: 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 65 ==.;; Update the
6b10: 20 74 65 73 74 73 20 6d 65 74 61 20 64 61 74 61 tests meta data
6b20: 20 66 72 6f 6d 20 74 68 65 20 74 65 73 74 63 6f from the testco
6b30: 6e 66 69 67 20 66 69 6c 65 73 0a 3b 3b 0a 0a 28 nfig files.;;..(
6b40: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
6b50: 20 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 22 29 "-update-meta")
6b60: 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 . (begin.
6b70: 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 (if (not (setu
6b80: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 p-for-run)).. (
6b90: 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 begin.. (debu
6ba0: 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 g:print 0 "Faile
6bb0: 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit
6bc0: 69 6e 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 ing") .. (exi
6bd0: 74 20 31 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 t 1))). ;;
6be0: 6e 6f 77 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 now can find our
6bf0: 20 64 62 0a 20 20 20 20 20 20 28 73 65 74 21 20 db. (set!
6c00: 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 20 20 db (open-db)).
6c10: 20 20 20 20 28 72 75 6e 73 3a 75 70 64 61 74 65 (runs:update
6c20: 2d 61 6c 6c 2d 74 65 73 74 5f 6d 65 74 61 20 64 -all-test_meta d
6c30: 62 29 0a 20 20 20 20 20 20 28 73 71 6c 69 74 65 b). (sqlite
6c40: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
6c50: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
6c60: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
6c70: 0a 0a 28 69 66 20 28 6e 6f 74 20 2a 64 69 64 73 ..(if (not *dids
6c80: 6f 6d 65 74 68 69 6e 67 2a 29 0a 20 20 20 20 28 omething*). (
6c90: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 68 65 debug:print 0 he
6ca0: 6c 70 29 29 0a 0a 28 69 66 20 28 6e 6f 74 20 28 lp))..(if (not (
6cb0: 65 71 3f 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 eq? *globalexits
6cc0: 74 61 74 75 73 2a 20 30 29 29 0a 20 20 20 20 28 tatus* 0)). (
6cd0: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
6ce0: 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 -arg "-runtests"
6cf0: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
6d00: 2d 72 75 6e 61 6c 6c 22 29 29 0a 20 20 20 20 20 -runall")).
6d10: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
6d20: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
6d30: 74 20 30 20 22 4e 4f 54 45 3a 20 53 75 62 70 72 t 0 "NOTE: Subpr
6d40: 6f 63 65 73 73 65 73 20 77 69 74 68 20 6e 6f 6e ocesses with non
6d50: 2d 7a 65 72 6f 20 65 78 69 74 20 63 6f 64 65 20 -zero exit code
6d60: 64 65 74 65 63 74 65 64 3a 20 22 20 2a 67 6c 6f detected: " *glo
6d70: 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 29 0a balexitstatus*).
6d80: 20 20 20 20 20 20 20 20 20 20 20 28 65 78 69 74 (exit
6d90: 20 30 29 29 0a 20 20 20 20 20 20 20 20 28 63 61 0)). (ca
6da0: 73 65 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 se *globalexitst
6db0: 61 74 75 73 2a 0a 20 20 20 20 20 20 20 20 20 28 atus*. (
6dc0: 28 30 29 28 65 78 69 74 20 30 29 29 0a 20 20 20 (0)(exit 0)).
6dd0: 20 20 20 20 20 20 28 28 31 29 28 65 78 69 74 20 ((1)(exit
6de0: 31 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 32 1)). ((2
6df0: 29 28 65 78 69 74 20 32 29 29 0a 20 20 20 20 20 )(exit 2)).
6e00: 20 20 20 20 28 65 6c 73 65 20 28 65 78 69 74 20 (else (exit
6e10: 33 29 29 29 29 29 0a 3))))).