Artifact c2c2ba6e88bbfe631045b6daf085be0de3642003:
- File megatest.scm — part of check-in [40c71a6d65] at 2011-05-03 10:00:17 on branch trunk — Bumping the megatest version to 1.0.1 (user: mrwellan size: 17776)
0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200 0010: 36 2d 32 30 31 31 2c 20 4d 61 74 74 68 65 77 20 6-2011, Matthew 0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;; 0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is 0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 made available 0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 under the GNU GP 0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 L version 2.0 or 0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 .;; greater. Se 0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 e the accompanyi 0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 ng file COPYING 00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 for details..;; 00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 .;; This progra 00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed 00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR 00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e 00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c ven the.;; impl 0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 ied warranty of 0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY 0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A 0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 PARTICULAR.;; 0140: 50 55 52 50 4f 53 45 2e 0a 0a 28 69 6e 63 6c 75 PURPOSE...(inclu 0150: 64 65 20 22 63 6f 6d 6d 6f 6e 2e 73 63 6d 22 29 de "common.scm") 0160: 0a 28 64 65 66 69 6e 65 20 6d 65 67 61 74 65 73 .(define megates 0170: 74 2d 76 65 72 73 69 6f 6e 20 31 2e 30 2e 31 29 t-version 1.0.1) 0180: 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 28 ..(define help ( 0190: 63 6f 6e 63 20 22 0a 4d 65 67 61 74 65 73 74 2c conc ".Megatest, 01a0: 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20 61 documentation a 01b0: 74 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 t http://www.kia 01c0: 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f toa.com/fossils/ 01d0: 6f 70 65 6e 73 72 63 0a 20 20 76 65 72 73 69 6f opensrc. versio 01e0: 6e 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 n " megatest-ver 01f0: 73 69 6f 6e 20 22 0a 20 20 6c 69 63 65 6e 73 65 sion ". license 0200: 20 47 50 4c 2c 20 43 6f 70 79 72 69 67 68 74 20 GPL, Copyright 0210: 4d 61 74 74 20 57 65 6c 6c 61 6e 64 20 32 30 30 Matt Welland 200 0220: 36 2d 32 30 31 31 0a 0a 55 73 61 67 65 3a 20 6d 6-2011..Usage: m 0230: 65 67 61 74 65 73 74 20 5b 6f 70 74 69 6f 6e 73 egatest [options 0240: 5d 0a 20 20 2d 68 20 20 20 20 20 20 20 20 20 20 ]. -h 0250: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 74 68 : th 0260: 69 73 20 68 65 6c 70 0a 0a 50 72 6f 63 65 73 73 is help..Process 0270: 20 61 6e 64 20 74 65 73 74 20 72 75 6e 6e 69 6e and test runnin 0280: 67 0a 20 20 2d 72 75 6e 61 6c 6c 20 20 20 20 20 g. -runall 0290: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 75 : ru 02a0: 6e 20 61 6c 6c 20 74 65 73 74 73 20 74 68 61 74 n all tests that 02b0: 20 61 72 65 20 6e 6f 74 20 73 74 61 74 65 20 43 are not state C 02c0: 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 73 74 61 OMPLETED and sta 02d0: 74 75 73 20 50 41 53 53 0a 20 20 2d 72 75 6e 74 tus PASS. -runt 02e0: 65 73 74 73 20 74 73 74 31 2c 74 73 74 32 20 2e ests tst1,tst2 . 02f0: 2e 2e 20 3a 20 72 75 6e 20 74 65 73 74 73 0a 0a .. : run tests.. 0300: 52 75 6e 20 73 74 61 74 75 73 20 75 70 64 61 74 Run status updat 0310: 65 73 20 28 74 68 65 73 65 20 72 65 71 75 69 72 es (these requir 0320: 65 20 74 68 61 74 20 79 6f 75 20 61 72 65 20 69 e that you are i 0330: 6e 20 61 20 74 65 73 74 20 64 69 72 65 63 74 6f n a test directo 0340: 72 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ry. 0350: 20 20 20 20 20 20 20 61 6e 64 20 79 6f 75 20 68 and you h 0360: 61 76 65 20 73 6f 75 72 63 65 64 20 74 68 65 20 ave sourced the 0370: 5c 22 6d 65 67 61 74 65 73 74 2e 63 73 68 5c 22 \"megatest.csh\" 0380: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 0390: 20 20 20 20 20 5c 22 6d 65 67 61 74 65 73 74 2e \"megatest. 03a0: 73 68 5c 22 20 66 69 6c 65 2e 29 0a 20 20 2d 73 sh\" file.). -s 03b0: 74 65 70 20 73 74 65 70 6e 61 6d 65 0a 20 20 2d tep stepname. - 03c0: 74 65 73 74 2d 73 74 61 74 75 73 20 20 20 20 20 test-status 03d0: 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 : set the 03e0: 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 state and statu 03f0: 73 20 6f 66 20 61 20 74 65 73 74 20 28 75 73 65 s of a test (use 0400: 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 :state and :sta 0410: 74 75 73 29 0a 20 20 2d 73 65 74 6c 6f 67 20 6c tus). -setlog l 0420: 6f 67 66 6e 61 6d 65 20 20 20 20 20 20 20 20 3a ogfname : 0430: 20 73 65 74 20 74 68 65 20 70 61 74 68 2f 66 69 set the path/fi 0440: 6c 65 6e 61 6d 65 20 74 6f 20 74 68 65 20 66 69 lename to the fi 0450: 6e 61 6c 20 6c 6f 67 20 72 65 6c 61 74 69 76 65 nal log relative 0460: 20 74 6f 20 74 68 65 20 74 65 73 74 0a 20 20 20 to the test. 0470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0480: 20 20 20 20 20 20 20 20 20 64 69 72 65 63 74 6f directo 0490: 72 79 2e 20 6d 61 79 20 62 65 20 75 73 65 64 20 ry. may be used 04a0: 77 69 74 68 20 2d 74 65 73 74 2d 73 74 61 74 75 with -test-statu 04b0: 73 0a 20 20 2d 6d 20 63 6f 6d 6d 65 6e 74 20 20 s. -m comment 04c0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 69 6e : in 04d0: 73 65 72 74 20 61 20 63 6f 6d 6d 65 6e 74 20 66 sert a comment f 04e0: 6f 72 20 74 68 69 73 20 74 65 73 74 0a 0a 52 75 or this test..Ru 04f0: 6e 20 64 61 74 61 3a 0a 0a 20 20 3a 72 75 6e 6e n data:.. :runn 0500: 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 20 20 ame 0510: 20 20 20 3a 20 72 65 71 75 69 72 65 64 2c 20 6e : required, n 0520: 61 6d 65 20 66 6f 72 20 74 68 69 73 20 70 61 72 ame for this par 0530: 74 69 63 75 6c 61 72 20 74 65 73 74 20 72 75 6e ticular test run 0540: 0a 20 20 3a 73 74 61 74 65 20 20 20 20 20 20 20 . :state 0550: 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 71 : req 0560: 75 69 72 65 64 20 69 66 20 75 70 64 61 74 69 6e uired if updatin 0570: 67 20 73 74 65 70 20 73 74 61 74 65 3b 20 65 2e g step state; e. 0580: 67 2e 20 73 74 61 72 74 2c 20 65 6e 64 2c 20 63 g. start, end, c 0590: 6f 6d 70 6c 65 74 65 64 0a 20 20 3a 73 74 61 74 ompleted. :stat 05a0: 75 73 20 20 20 20 20 20 20 20 20 20 20 20 20 20 us 05b0: 20 20 20 3a 20 72 65 71 75 69 72 65 64 20 69 66 : required if 05c0: 20 75 70 64 61 74 69 6e 67 20 73 74 65 70 20 73 updating step s 05d0: 74 61 74 75 73 3b 20 65 2e 67 2e 20 70 61 73 73 tatus; e.g. pass 05e0: 2c 20 66 61 69 6c 2c 20 6e 2f 61 0a 0a 51 75 65 , fail, n/a..Que 05f0: 72 69 65 73 0a 20 20 2d 6c 69 73 74 2d 72 75 6e ries. -list-run 0600: 73 20 70 61 74 74 20 20 20 20 20 20 20 20 20 3a s patt : 0610: 20 6c 69 73 74 20 72 75 6e 73 20 6d 61 74 63 68 list runs match 0620: 69 6e 67 20 70 61 74 74 65 72 6e 20 5c 22 70 61 ing pattern \"pa 0630: 74 74 5c 22 2c 20 25 20 69 73 20 74 68 65 20 77 tt\", % is the w 0640: 69 6c 64 63 61 72 64 0a 20 20 2d 73 68 6f 77 6b ildcard. -showk 0650: 65 79 73 20 20 20 20 20 20 20 20 20 20 20 20 20 eys 0660: 20 20 3a 20 73 68 6f 77 20 74 68 65 20 6b 65 79 : show the key 0670: 73 20 75 73 65 64 20 69 6e 20 74 68 69 73 20 6d s used in this m 0680: 65 67 61 74 65 73 74 20 73 65 74 75 70 0a 0a 4d egatest setup..M 0690: 69 73 63 20 0a 20 20 2d 66 6f 72 63 65 20 20 20 isc . -force 06a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a : 06b0: 20 6f 76 65 72 72 69 64 65 20 73 6f 6d 65 20 63 override some c 06c0: 68 65 63 6b 73 0a 20 20 2d 78 74 65 72 6d 20 20 hecks. -xterm 06d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 06e0: 3a 20 73 74 61 72 74 20 61 6e 20 78 74 65 72 6d : start an xterm 06f0: 20 69 6e 73 74 65 61 64 20 6f 66 20 6c 61 75 6e instead of laun 0700: 63 68 69 6e 67 20 74 68 65 20 74 65 73 74 0a 0a ching the test.. 0710: 48 65 6c 70 65 72 73 0a 0a 20 20 2d 72 75 6e 73 Helpers.. -runs 0720: 74 65 70 20 73 74 65 70 6e 61 6d 65 20 20 2e 2e tep stepname .. 0730: 2e 20 20 3a 20 74 61 6b 65 20 6c 65 66 74 6f 76 . : take leftov 0740: 65 72 20 70 61 72 61 6d 73 20 61 73 20 63 6f 6d er params as com 0750: 61 6e 64 20 61 6e 64 20 65 78 65 63 75 74 65 20 and and execute 0760: 61 73 20 73 74 65 70 6e 61 6d 65 0a 20 20 20 20 as stepname. 0770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0780: 20 20 20 20 20 20 20 20 6c 6f 67 20 77 69 6c 6c log will 0790: 20 62 65 20 69 6e 20 73 74 65 70 6e 61 6d 65 2e be in stepname. 07a0: 6c 6f 67 0a 20 20 2d 6c 6f 67 70 72 6f 20 66 69 log. -logpro fi 07b0: 6c 65 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 le : 07c0: 77 69 74 68 20 2d 65 78 65 63 20 61 70 70 6c 79 with -exec apply 07d0: 20 6c 6f 67 70 72 6f 20 66 69 6c 65 20 74 6f 20 logpro file to 07e0: 73 74 65 70 6e 61 6d 65 2e 6c 6f 67 2c 20 63 72 stepname.log, cr 07f0: 65 61 74 65 73 0a 20 20 20 20 20 20 20 20 20 20 eates. 0800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0810: 20 20 73 74 65 70 6e 61 6d 65 2e 68 74 6d 6c 20 stepname.html 0820: 61 6e 64 20 73 65 74 73 20 6c 6f 67 20 74 6f 20 and sets log to 0830: 73 61 6d 65 0a 0a 43 61 6c 6c 65 64 20 61 73 20 same..Called as 0840: 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 " (string-inters 0850: 70 65 72 73 65 20 28 61 72 67 76 29 20 22 20 22 perse (argv) " " 0860: 29 29 29 0a 0a 3b 3b 20 20 2d 67 75 69 20 20 20 )))..;; -gui 0870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0880: 20 3a 20 73 74 61 72 74 20 61 20 67 75 69 20 69 : start a gui i 0890: 6e 74 65 72 66 61 63 65 0a 3b 3b 20 20 2d 63 6f nterface.;; -co 08a0: 6e 66 69 67 20 66 6e 61 6d 65 20 20 20 20 20 20 nfig fname 08b0: 20 20 20 20 20 3a 20 6f 76 65 72 72 69 64 65 20 : override 08c0: 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 20 66 69 the runconfig fi 08d0: 6c 65 20 77 69 74 68 20 66 6e 61 6d 65 0a 0a 3b le with fname..; 08e0: 3b 20 70 72 6f 63 65 73 73 20 61 72 67 73 0a 28 ; process args.( 08f0: 64 65 66 69 6e 65 20 72 65 6d 61 72 67 73 20 28 define remargs ( 0900: 61 72 67 73 3a 67 65 74 2d 61 72 67 73 20 0a 09 args:get-args .. 0910: 09 20 28 61 72 67 76 29 0a 09 09 20 28 6c 69 73 . (argv)... (lis 0920: 74 20 20 22 2d 72 75 6e 74 65 73 74 73 22 20 20 t "-runtests" 0930: 3b 3b 20 72 75 6e 20 61 20 73 70 65 63 69 66 69 ;; run a specifi 0940: 63 20 74 65 73 74 0a 09 09 09 22 2d 63 6f 6e 66 c test...."-conf 0950: 69 67 22 20 20 20 20 3b 3b 20 6f 76 65 72 72 69 ig" ;; overri 0960: 64 65 20 74 68 65 20 63 6f 6e 66 69 67 20 66 69 de the config fi 0970: 6c 65 20 6e 61 6d 65 0a 09 09 09 22 2d 65 78 65 le name...."-exe 0980: 63 75 74 65 22 20 20 20 3b 3b 20 72 75 6e 20 74 cute" ;; run t 0990: 68 65 20 63 6f 6d 6d 61 6e 64 20 65 6e 63 6f 64 he command encod 09a0: 65 64 20 69 6e 20 74 68 65 20 62 61 73 65 36 34 ed in the base64 09b0: 20 70 61 72 61 6d 65 74 65 72 0a 09 09 09 22 2d parameter...."- 09c0: 73 74 65 70 22 0a 09 09 09 22 3a 72 75 6e 6e 61 step"....":runna 09d0: 6d 65 22 20 20 20 0a 09 09 09 22 3a 69 74 65 6d me" ....":item 09e0: 22 0a 09 09 09 22 3a 72 75 6e 6e 61 6d 65 22 20 "....":runname" 09f0: 20 20 0a 09 09 09 22 3a 73 74 61 74 65 22 20 20 ....":state" 0a00: 0a 09 09 09 22 3a 73 74 61 74 75 73 22 0a 09 09 ....":status"... 0a10: 09 22 2d 6c 69 73 74 2d 72 75 6e 73 22 0a 09 09 ."-list-runs"... 0a20: 09 22 2d 73 65 74 6c 6f 67 22 0a 09 09 09 22 2d ."-setlog"...."- 0a30: 72 75 6e 73 74 65 70 22 0a 09 09 09 22 2d 6c 6f runstep"...."-lo 0a40: 67 70 72 6f 22 0a 09 09 09 29 20 0a 09 09 20 28 gpro"....) ... ( 0a50: 6c 69 73 74 20 20 22 2d 68 22 0a 09 09 20 20 20 list "-h"... 0a60: 20 20 20 20 20 22 2d 66 6f 72 63 65 22 0a 09 09 "-force"... 0a70: 20 20 20 20 20 20 20 20 22 2d 78 74 65 72 6d 22 "-xterm" 0a80: 0a 09 09 20 20 20 20 20 20 20 20 22 2d 73 68 6f ... "-sho 0a90: 77 6b 65 79 73 22 0a 09 09 20 20 20 20 20 20 20 wkeys"... 0aa0: 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 0a "-test-status". 0ab0: 09 09 20 20 20 20 20 20 20 20 22 2d 67 75 69 22 .. "-gui" 0ac0: 0a 09 09 09 22 2d 72 75 6e 61 6c 6c 22 20 20 20 ...."-runall" 0ad0: 20 3b 3b 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 ;; run all test 0ae0: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s. 0af0: 20 20 20 20 20 20 20 20 20 20 0a 09 09 20 20 20 ... 0b00: 20 20 20 20 29 0a 09 09 20 61 72 67 73 3a 61 72 )... args:ar 0b10: 67 2d 68 61 73 68 0a 09 09 20 30 29 29 0a 0a 28 g-hash... 0))..( 0b20: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg 0b30: 20 22 2d 68 22 29 0a 20 20 20 20 28 62 65 67 69 "-h"). (begi 0b40: 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 68 n. (print h 0b50: 65 6c 70 29 0a 20 20 20 20 20 20 28 65 78 69 74 elp). (exit 0b60: 29 29 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 6b )))..(include "k 0b70: 65 79 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 eys.scm").(inclu 0b80: 64 65 20 22 69 74 65 6d 73 2e 73 63 6d 22 29 0a de "items.scm"). 0b90: 28 69 6e 63 6c 75 64 65 20 22 64 62 2e 73 63 6d (include "db.scm 0ba0: 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6e ").(include "con 0bb0: 66 69 67 66 2e 73 63 6d 22 29 0a 28 69 6e 63 6c figf.scm").(incl 0bc0: 75 64 65 20 22 70 72 6f 63 65 73 73 2e 73 63 6d ude "process.scm 0bd0: 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 6c 61 75 ").(include "lau 0be0: 6e 63 68 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 nch.scm").(inclu 0bf0: 64 65 20 22 72 75 6e 73 2e 73 63 6d 22 29 0a 3b de "runs.scm").; 0c00: 3b 20 28 69 6e 63 6c 75 64 65 20 22 67 75 69 2e ; (include "gui. 0c10: 73 63 6d 22 29 0a 0a 28 64 65 66 69 6e 65 20 2a scm")..(define * 0c20: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 66 didsomething* #f 0c30: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;=========== 0c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 ===========.;; Q 0c80: 75 65 72 79 20 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d uery runs.;;==== 0c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0cd0: 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ==..(if (args:ge 0ce0: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e t-arg "-list-run 0cf0: 73 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 s"). (let* (( 0d00: 64 62 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a db (begin. 0d10: 09 09 20 20 20 20 20 20 20 28 73 65 74 75 70 2d .. (setup- 0d20: 66 6f 72 2d 72 75 6e 29 0a 09 09 20 20 20 20 20 for-run)... 0d30: 20 20 28 6f 70 65 6e 2d 64 62 29 29 29 0a 09 20 (open-db))).. 0d40: 20 20 28 72 75 6e 70 61 74 74 20 20 28 61 72 67 (runpatt (arg 0d50: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list 0d60: 2d 72 75 6e 73 22 29 29 0a 09 20 20 20 28 72 75 -runs")).. (ru 0d70: 6e 73 64 61 74 20 20 28 64 62 2d 67 65 74 2d 72 nsdat (db-get-r 0d80: 75 6e 73 20 64 62 20 72 75 6e 70 61 74 74 29 29 uns db runpatt)) 0d90: 0a 09 20 20 20 28 72 75 6e 73 20 20 20 20 20 28 .. (runs ( 0da0: 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e 73 db:get-rows runs 0db0: 64 61 74 29 29 0a 09 20 20 20 28 68 65 61 64 65 dat)).. (heade 0dc0: 72 20 20 20 28 64 62 3a 67 65 74 2d 68 65 61 64 r (db:get-head 0dd0: 65 72 20 72 75 6e 73 64 61 74 29 29 0a 09 20 20 er runsdat)).. 0de0: 20 28 6b 65 79 73 20 20 20 20 20 28 64 62 2d 67 (keys (db-g 0df0: 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 20 et-keys db)).. 0e00: 20 28 6b 65 79 6e 61 6d 65 73 20 28 6d 61 70 20 (keynames (map 0e10: 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d key:get-fieldnam 0e20: 65 20 6b 65 79 73 29 29 29 0a 20 20 20 20 20 20 e keys))). 0e30: 3b 3b 20 45 61 63 68 20 72 75 6e 0a 20 20 20 20 ;; Each run. 0e40: 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 (for-each . 0e50: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e (lambda (run 0e60: 29 0a 09 20 28 70 72 69 6e 74 20 22 52 75 6e 3a ).. (print "Run: 0e70: 20 22 0a 09 09 28 73 74 72 69 6e 67 2d 69 6e 74 "...(string-int 0e80: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c ersperse (map (l 0e90: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 20 ambda (x)...... 0ea0: 20 20 28 64 62 2d 67 65 74 2d 76 61 6c 75 65 2d (db-get-value- 0eb0: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he 0ec0: 61 64 65 72 20 78 29 29 0a 09 09 09 09 09 20 6b ader x))...... k 0ed0: 65 79 6e 61 6d 65 73 29 20 22 2f 22 29 0a 09 09 eynames) "/")... 0ee0: 22 2f 22 0a 09 09 28 64 62 2d 67 65 74 2d 76 61 "/"...(db-get-va 0ef0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru 0f00: 6e 20 68 65 61 64 65 72 20 22 72 75 6e 6e 61 6d n header "runnam 0f10: 65 22 29 29 0a 09 20 28 6c 65 74 20 28 28 72 75 e")).. (let ((ru 0f20: 6e 2d 69 64 20 28 64 62 2d 67 65 74 2d 76 61 6c n-id (db-get-val 0f30: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run 0f40: 20 68 65 61 64 65 72 20 22 69 64 22 29 29 29 0a header "id"))). 0f50: 09 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 73 . (let ((tests 0f60: 20 28 64 62 2d 67 65 74 2d 74 65 73 74 73 2d 66 (db-get-tests-f 0f70: 6f 72 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 or-run db run-id 0f80: 29 29 29 0a 09 20 20 20 20 20 3b 3b 20 45 61 63 ))).. ;; Eac 0f90: 68 20 74 65 73 74 0a 09 20 20 20 20 20 28 66 6f h test.. (fo 0fa0: 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 20 28 r-each .. ( 0fb0: 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 lambda (test)... 0fc0: 28 66 6f 72 6d 61 74 20 23 74 0a 09 09 09 22 20 (format #t...." 0fd0: 20 54 65 73 74 3a 20 7e 32 35 61 20 53 74 61 74 Test: ~25a Stat 0fe0: 65 3a 20 7e 31 35 61 20 53 74 61 74 75 73 3a 20 e: ~15a Status: 0ff0: 7e 31 35 61 20 52 75 6e 74 69 6d 65 3a 20 7e 35 ~15a Runtime: ~5 1000: 40 61 73 20 54 69 6d 65 3a 20 7e 32 32 61 20 48 @as Time: ~22a H 1010: 6f 73 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 09 ost: ~10a\n".... 1020: 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 (conc (db:test-g 1030: 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 et-testname test 1040: 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 ).... (if ( 1050: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d equal? (db:test- 1060: 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 get-item-path te 1070: 73 74 29 20 22 22 29 0a 09 09 09 09 20 20 22 22 st) "")..... "" 1080: 20 0a 09 09 09 09 20 20 28 63 6f 6e 63 20 22 28 ..... (conc "( 1090: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 " (db:test-get-i 10a0: 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 20 22 tem-path test) " 10b0: 29 22 29 29 29 0a 09 09 09 28 64 62 3a 74 65 73 )")))....(db:tes 10c0: 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 t-get-state test 10d0: 29 0a 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65 )....(db:test-ge 10e0: 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 0a 09 t-status test).. 10f0: 09 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 ..(db:test-get-r 1100: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 un_duration test 1110: 29 0a 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65 )....(db:test-ge 1120: 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 t-event_time tes 1130: 74 29 0a 09 09 09 28 64 62 3a 74 65 73 74 2d 67 t)....(db:test-g 1140: 65 74 2d 68 6f 73 74 20 74 65 73 74 29 29 0a 20 et-host test)). 1150: 09 09 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 ..(if (not (or ( 1160: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d equal? (db:test- 1170: 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 get-status test) 1180: 20 22 50 41 53 53 22 29 0a 09 09 09 20 20 20 20 "PASS").... 1190: 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 (equal? (db:tes 11a0: 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 t-get-state test 11b0: 29 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 ) "NOT_STARTED") 11c0: 29 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a ))... (begin. 11d0: 09 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 .. (print " 11e0: 20 20 20 20 20 20 20 20 20 63 70 75 6c 6f 61 64 cpuload 11f0: 3a 20 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 : " (db:test-ge 1200: 74 2d 63 70 75 6c 6f 61 64 20 74 65 73 74 29 0a t-cpuload test). 1210: 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 ... "\n 1220: 20 20 20 20 64 69 73 6b 66 72 65 65 3a 20 22 20 diskfree: " 1230: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 64 69 73 (db:test-get-dis 1240: 6b 66 72 65 65 20 74 65 73 74 29 0a 09 09 09 20 kfree test).... 1250: 20 20 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 "\n 1260: 75 6e 61 6d 65 3a 20 20 20 20 22 20 28 64 62 3a uname: " (db: 1270: 74 65 73 74 2d 67 65 74 2d 75 6e 61 6d 65 20 74 test-get-uname t 1280: 65 73 74 29 0a 09 09 09 20 20 20 20 20 22 5c 6e est).... "\n 1290: 20 20 20 20 20 20 20 20 20 72 75 6e 64 69 72 3a rundir: 12a0: 20 20 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 " (db:test-ge 12b0: 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 0a 09 t-rundir test).. 12c0: 09 09 20 20 20 20 20 29 0a 09 09 20 20 20 20 20 .. )... 12d0: 20 3b 3b 20 45 61 63 68 20 74 65 73 74 0a 09 09 ;; Each test... 12e0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 65 (let ((ste 12f0: 70 73 20 28 64 62 2d 67 65 74 2d 74 65 73 74 2d ps (db-get-test- 1300: 73 74 65 70 73 2d 66 6f 72 2d 72 75 6e 20 64 62 steps-for-run db 1310: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 (db:test-get-id 1320: 20 74 65 73 74 29 29 29 29 0a 09 09 09 28 66 6f test))))....(fo 1330: 72 2d 65 61 63 68 20 0a 09 09 09 20 28 6c 61 6d r-each .... (lam 1340: 62 64 61 20 28 73 74 65 70 29 0a 09 09 09 20 20 bda (step).... 1350: 20 28 66 6f 72 6d 61 74 20 23 74 20 0a 09 09 09 (format #t .... 1360: 09 20 20 20 22 20 20 20 20 53 74 65 70 3a 20 7e . " Step: ~ 1370: 32 30 61 20 53 74 61 74 65 3a 20 7e 31 30 61 20 20a State: ~10a 1380: 53 74 61 74 75 73 3a 20 7e 31 30 61 20 54 69 6d Status: ~10a Tim 1390: 65 20 7e 32 32 61 5c 6e 22 0a 09 09 09 09 20 20 e ~22a\n"..... 13a0: 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 (db:step-get-st 13b0: 65 70 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 09 epname step).... 13c0: 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 . (db:step-get 13d0: 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 09 09 -state step).... 13e0: 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 . (db:step-get 13f0: 2d 73 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 -status step)... 1400: 09 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 .. (db:step-ge 1410: 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 t-event_time ste 1420: 70 29 29 29 0a 09 09 09 3b 3b 20 20 20 20 28 70 p)))....;; (p 1430: 72 69 6e 74 20 22 20 20 20 20 53 74 65 70 3a 20 rint " Step: 1440: 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 " (db:step-get-s 1450: 74 65 70 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 tepname step)... 1460: 09 3b 3b 20 09 20 20 22 20 22 20 28 64 62 3a 73 .;; . " " (db:s 1470: 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 74 tep-get-state st 1480: 65 70 29 0a 09 09 09 3b 3b 20 09 20 20 22 20 22 ep)....;; . " " 1490: 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 (db:step-get-st 14a0: 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 3b 3b atus step)....;; 14b0: 20 09 20 20 22 20 22 20 28 64 62 3a 73 74 65 70 . " " (db:step 14c0: 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -get-event_time 14d0: 73 74 65 70 29 29 29 0a 09 09 09 20 73 74 65 70 step))).... step 14e0: 73 29 29 29 29 29 0a 09 09 74 65 73 74 73 29 29 s)))))...tests)) 14f0: 29 29 0a 20 20 20 20 20 20 20 72 75 6e 73 29 0a )). runs). 1500: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did 1510: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 20 something* #t). 1520: 20 20 20 20 20 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d ))..;;===== 1530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1570: 3d 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e 0a 3b 3b =.;; full run.;; 1580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 15a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 15b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 15c0: 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 20 6c ======..;; get l 15d0: 6f 63 6b 20 69 6e 20 64 62 20 66 6f 72 20 66 75 ock in db for fu 15e0: 6c 6c 20 72 75 6e 20 66 6f 72 20 74 68 69 73 20 ll run for this 15f0: 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 66 6f 72 directory.;; for 1600: 20 61 6c 6c 20 74 65 73 74 73 20 77 69 74 68 20 all tests with 1610: 64 65 70 73 0a 3b 3b 20 20 20 77 61 6c 6b 20 74 deps.;; walk t 1620: 72 65 65 20 6f 66 20 74 65 73 74 73 20 74 6f 20 ree of tests to 1630: 66 69 6e 64 20 68 65 61 64 20 74 61 73 6b 73 0a find head tasks. 1640: 3b 3b 20 20 20 61 64 64 20 68 65 61 64 20 74 61 ;; add head ta 1650: 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 sks to task queu 1660: 65 0a 3b 3b 20 20 20 61 64 64 20 64 65 70 65 6e e.;; add depen 1670: 64 61 6e 74 20 74 61 73 6b 73 20 74 6f 20 74 61 dant tasks to ta 1680: 73 6b 20 71 75 65 75 65 20 0a 3b 3b 20 20 20 61 sk queue .;; a 1690: 64 64 20 72 65 6d 61 69 6e 69 6e 67 20 74 61 73 dd remaining tas 16a0: 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 ks to task queue 16b0: 0a 3b 3b 20 66 6f 72 20 65 61 63 68 20 74 61 73 .;; for each tas 16c0: 6b 20 69 6e 20 74 61 73 6b 20 71 75 65 75 65 0a k in task queue. 16d0: 3b 3b 20 20 20 69 66 20 68 61 76 65 20 61 64 65 ;; if have ade 16e0: 71 75 61 74 65 20 72 65 73 6f 75 72 63 65 73 0a quate resources. 16f0: 3b 3b 20 20 20 20 20 6c 61 75 6e 63 68 20 74 61 ;; launch ta 1700: 73 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b 20 sk.;; else.;; 1710: 20 20 20 20 70 75 74 20 74 61 73 6b 20 69 6e 20 put task in 1720: 64 65 66 65 72 72 65 64 20 71 75 65 75 65 0a 3b deferred queue.; 1730: 3b 20 69 66 20 73 74 69 6c 6c 20 6f 6b 20 74 6f ; if still ok to 1740: 20 72 75 6e 20 74 61 73 6b 73 0a 3b 3b 20 20 20 run tasks.;; 1750: 70 72 6f 63 65 73 73 20 64 65 66 65 72 72 65 64 process deferred 1760: 20 74 61 73 6b 73 20 70 65 72 20 61 62 6f 76 65 tasks per above 1770: 20 73 74 65 70 73 0a 0a 3b 3b 20 72 75 6e 20 61 steps..;; run a 1780: 6c 6c 20 74 65 73 74 73 20 61 72 65 20 61 72 65 ll tests are are 1790: 20 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 44 20 61 Not COMPLETED a 17a0: 6e 64 20 50 41 53 53 20 6f 72 20 43 48 45 43 4b nd PASS or CHECK 17b0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a 17c0: 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 0a 20 20 rg "-runall"). 17d0: 20 20 28 69 66 20 28 6e 6f 74 20 28 61 72 67 73 (if (not (args 17e0: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna 17f0: 6d 65 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 me"))..(begin.. 1800: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR: 1810: 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 Missing required 1820: 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 2d parameter for - 1830: 72 75 6e 74 65 73 74 73 2c 20 79 6f 75 20 6d 75 runtests, you mu 1840: 73 74 20 73 70 65 63 69 66 79 20 74 68 65 20 72 st specify the r 1850: 75 6e 20 6e 61 6d 65 20 77 69 74 68 20 3a 72 75 un name with :ru 1860: 6e 6e 61 6d 65 20 72 75 6e 6e 61 6d 65 22 29 0a nname runname"). 1870: 09 20 20 28 65 78 69 74 20 32 29 29 0a 09 28 6c . (exit 2))..(l 1880: 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 28 69 et* ((db (i 1890: 66 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e f (setup-for-run 18a0: 29 0a 09 09 09 20 20 20 20 28 6f 70 65 6e 2d 64 ).... (open-d 18b0: 62 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e b).... (begin 18c0: 0a 09 09 09 20 20 20 20 20 20 28 70 72 69 6e 74 .... (print 18d0: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu 18e0: 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 09 p, exiting").... 18f0: 20 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 (exit 1))) 1900: 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 )).. (if (not ( 1910: 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a car *configinfo* 1920: 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e )).. (begin 1930: 0a 09 09 28 70 72 69 6e 74 20 22 45 52 52 4f 52 ...(print "ERROR 1940: 3a 20 41 74 74 65 6d 70 74 65 64 20 74 6f 20 72 : Attempted to r 1950: 75 6e 20 61 20 74 65 73 74 20 62 75 74 20 72 75 un a test but ru 1960: 6e 20 61 72 65 61 20 63 6f 6e 66 69 67 20 66 69 n area config fi 1970: 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 09 le not found").. 1980: 09 28 65 78 69 74 20 31 29 29 0a 09 20 20 20 20 .(exit 1)).. 1990: 20 20 3b 3b 20 70 75 74 20 74 65 73 74 20 70 61 ;; put test pa 19a0: 72 61 6d 65 74 65 72 73 20 69 6e 74 6f 20 63 6f rameters into co 19b0: 6e 76 65 6e 69 65 6e 74 20 76 61 72 69 61 62 6c nvenient variabl 19c0: 65 73 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 es.. (let* 19d0: 28 28 74 65 73 74 2d 6e 61 6d 65 73 20 28 67 65 ((test-names (ge 19e0: 74 2d 61 6c 6c 2d 6c 65 67 61 6c 2d 74 65 73 74 t-all-legal-test 19f0: 73 29 29 29 20 3b 3b 20 22 50 52 4f 44 22 20 69 s))) ;; "PROD" i 1a00: 73 20 69 67 6e 6f 72 65 64 20 66 6f 72 20 6e 6f s ignored for no 1a10: 77 0a 09 09 28 70 72 69 6e 74 20 22 49 4e 46 4f w...(print "INFO 1a20: 3a 20 41 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 : Attempting to 1a30: 73 74 61 72 74 20 74 68 65 20 66 6f 6c 6c 6f 77 start the follow 1a40: 69 6e 67 20 74 65 73 74 73 2e 2e 2e 22 29 0a 09 ing tests...").. 1a50: 09 28 70 72 69 6e 74 20 22 20 20 20 20 20 22 20 .(print " " 1a60: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe 1a70: 72 73 65 20 74 65 73 74 2d 6e 61 6d 65 73 20 22 rse test-names " 1a80: 2c 22 29 29 0a 09 09 28 72 75 6e 2d 74 65 73 74 ,"))...(run-test 1a90: 73 20 64 62 20 74 65 73 74 2d 6e 61 6d 65 73 29 s db test-names) 1aa0: 29 29 0a 09 20 20 28 72 75 6e 2d 77 61 69 74 69 )).. (run-waiti 1ab0: 6e 67 2d 74 65 73 74 73 20 64 62 29 0a 09 20 20 ng-tests db).. 1ac0: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz 1ad0: 65 21 20 64 62 29 0a 09 20 20 28 73 65 74 21 20 e! db).. (set! 1ae0: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* # 1af0: 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d t))))..;;======= 1b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============. 1b40: 3b 3b 20 72 75 6e 20 6f 6e 65 20 74 65 73 74 0a ;; run one test. 1b50: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============== 1b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1b90: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e 20 ========..;; 1. 1ba0: 66 69 6e 64 20 74 68 65 20 63 6f 6e 66 69 67 20 find the config 1bb0: 66 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 61 6e 67 file.;; 2. chang 1bc0: 65 20 74 6f 20 74 68 65 20 74 65 73 74 20 64 69 e to the test di 1bd0: 72 65 63 74 6f 72 79 0a 3b 3b 20 33 2e 20 75 70 rectory.;; 3. up 1be0: 64 61 74 65 20 74 68 65 20 64 62 20 77 69 74 68 date the db with 1bf0: 20 22 74 65 73 74 20 73 74 61 72 74 65 64 22 20 "test started" 1c00: 73 74 61 74 75 73 2c 20 73 65 74 20 72 75 6e 6e status, set runn 1c10: 69 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 2e 20 70 ing host.;; 4. p 1c20: 72 6f 63 65 73 73 20 6c 61 75 6e 63 68 20 74 68 rocess launch th 1c30: 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 6d e test.;; - m 1c40: 6f 6e 69 74 6f 72 20 74 68 65 20 70 72 6f 63 65 onitor the proce 1c50: 73 73 2c 20 75 70 64 61 74 65 20 73 74 61 74 73 ss, update stats 1c60: 20 69 6e 20 74 68 65 20 64 62 20 65 76 65 72 79 in the db every 1c70: 20 32 5e 6e 20 6d 69 6e 75 74 65 73 0a 3b 3b 20 2^n minutes.;; 1c80: 35 2e 20 61 73 20 74 68 65 20 74 65 73 74 20 70 5. as the test p 1c90: 72 6f 63 65 65 64 73 20 69 6e 74 65 72 6e 61 6c roceeds internal 1ca0: 6c 79 20 69 74 20 63 61 6c 6c 73 20 6d 65 67 61 ly it calls mega 1cb0: 74 65 73 74 20 61 73 20 65 61 63 68 20 73 74 65 test as each ste 1cc0: 70 20 69 73 0a 3b 3b 20 20 20 20 73 74 61 72 74 p is.;; start 1cd0: 65 64 20 61 6e 64 20 63 6f 6d 70 6c 65 74 65 64 ed and completed 1ce0: 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 73 74 .;; - step st 1cf0: 61 72 74 65 64 2c 20 74 69 6d 65 73 74 61 6d 70 arted, timestamp 1d00: 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 63 6f .;; - step co 1d10: 6d 70 6c 65 74 65 64 2c 20 65 78 69 74 20 73 74 mpleted, exit st 1d20: 61 74 75 73 2c 20 74 69 6d 65 73 74 61 6d 70 0a atus, timestamp. 1d30: 3b 3b 20 36 2e 20 74 65 73 74 20 70 68 6f 6e 65 ;; 6. test phone 1d40: 20 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d 20 69 66 home.;; - if 1d50: 20 74 65 73 74 20 72 75 6e 20 74 69 6d 65 20 3e test run time > 1d60: 20 61 6c 6c 6f 77 65 64 20 72 75 6e 20 74 69 6d allowed run tim 1d70: 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a e then kill job. 1d80: 3b 3b 20 20 20 20 2d 20 69 66 20 63 61 6e 6e 6f ;; - if canno 1d90: 74 20 61 63 63 65 73 73 20 64 62 20 3e 20 61 6c t access db > al 1da0: 6c 6f 77 65 64 20 64 69 73 63 6f 6e 6e 65 63 74 lowed disconnect 1db0: 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 time then kill 1dc0: 6a 6f 62 0a 0a 28 64 65 66 69 6e 65 20 28 72 75 job..(define (ru 1dd0: 6e 74 65 73 74 73 29 0a 20 20 28 69 66 20 28 6e ntests). (if (n 1de0: 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg 1df0: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 20 20 ":runname")). 1e00: 20 20 20 20 28 62 65 67 69 6e 0a 09 28 70 72 69 (begin..(pri 1e10: 6e 74 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 nt "ERROR: Missi 1e20: 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 ng required para 1e30: 6d 65 74 65 72 20 66 6f 72 20 2d 72 75 6e 74 65 meter for -runte 1e40: 73 74 73 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 sts, you must sp 1e50: 65 63 69 66 79 20 74 68 65 20 72 75 6e 20 6e 61 ecify the run na 1e60: 6d 65 20 77 69 74 68 20 3a 72 75 6e 6e 61 6d 65 me with :runname 1e70: 20 72 75 6e 6e 61 6d 65 22 29 0a 09 28 65 78 69 runname")..(exi 1e80: 74 20 32 29 29 0a 20 20 20 20 20 20 28 6c 65 74 t 2)). (let 1e90: 20 28 28 64 62 20 23 66 29 29 0a 09 28 69 66 20 ((db #f))..(if 1ea0: 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d (not (setup-for- 1eb0: 72 75 6e 29 29 0a 09 20 20 20 20 28 62 65 67 69 run)).. (begi 1ec0: 6e 20 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 n .. (print 1ed0: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu 1ee0: 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 p, exiting").. 1ef0: 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 09 (exit 1))).. 1f00: 28 73 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 (set! db (open-d 1f10: 62 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 63 b))..(if (not (c 1f20: 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 ar *configinfo*) 1f30: 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 ).. (begin.. 1f40: 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 (print "ERR 1f50: 4f 52 3a 20 41 74 74 65 6d 70 74 65 64 20 74 6f OR: Attempted to 1f60: 20 72 75 6e 20 61 20 74 65 73 74 20 62 75 74 20 run a test but 1f70: 72 75 6e 20 61 72 65 61 20 63 6f 6e 66 69 67 20 run area config 1f80: 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 22 29 file not found") 1f90: 0a 09 20 20 20 20 20 20 28 65 78 69 74 20 31 29 .. (exit 1) 1fa0: 29 0a 09 20 20 20 20 3b 3b 20 70 75 74 20 74 65 ).. ;; put te 1fb0: 73 74 20 70 61 72 61 6d 65 74 65 72 73 20 69 6e st parameters in 1fc0: 74 6f 20 63 6f 6e 76 65 6e 69 65 6e 74 20 76 61 to convenient va 1fd0: 72 69 61 62 6c 65 73 0a 09 20 20 20 20 28 6c 65 riables.. (le 1fe0: 74 2a 20 28 28 74 65 73 74 2d 6e 61 6d 65 73 20 t* ((test-names 1ff0: 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 (string-split 2000: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "- 2010: 72 75 6e 74 65 73 74 73 22 29 20 22 2c 22 29 29 runtests") ",")) 2020: 29 0a 09 20 20 20 20 20 20 28 72 75 6e 2d 74 65 ).. (run-te 2030: 73 74 73 20 64 62 20 74 65 73 74 2d 6e 61 6d 65 sts db test-name 2040: 73 29 29 29 0a 09 3b 3b 20 72 75 6e 2d 77 61 69 s)))..;; run-wai 2050: 74 69 6e 67 2d 74 65 73 74 73 20 64 62 29 0a 09 ting-tests db).. 2060: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz 2070: 65 21 20 64 62 29 0a 09 28 72 75 6e 2d 77 61 69 e! db)..(run-wai 2080: 74 69 6e 67 2d 74 65 73 74 73 20 23 66 29 0a 09 ting-tests #f).. 2090: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh 20a0: 69 6e 67 2a 20 23 74 29 29 29 29 0a 09 20 20 0a ing* #t)))).. . 20b0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar 20c0: 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 20 g "-runtests"). 20d0: 20 20 20 28 72 75 6e 74 65 73 74 73 29 29 0a 0a (runtests)).. 20e0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============== 20f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2120: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 63 ========.;; exec 2130: 75 74 65 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 ute the test.;; 2140: 20 20 20 2d 20 67 65 74 73 20 63 61 6c 6c 65 64 - gets called 2150: 20 6f 6e 20 72 65 6d 6f 74 65 20 68 6f 73 74 0a on remote host. 2160: 3b 3b 20 20 20 20 2d 20 72 65 63 65 69 76 65 73 ;; - receives 2170: 20 69 6e 66 6f 20 66 72 6f 6d 20 74 68 65 20 2d info from the - 2180: 65 78 65 63 75 74 65 20 70 61 72 61 6d 0a 3b 3b execute param.;; 2190: 20 20 20 20 2d 20 70 61 73 73 65 73 20 69 6e 66 - passes inf 21a0: 6f 20 74 6f 20 73 74 65 70 73 20 76 69 61 20 4d o to steps via M 21b0: 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 T_CMDINFO env va 21c0: 72 20 28 66 75 74 75 72 65 20 69 73 20 74 6f 20 r (future is to 21d0: 75 73 65 20 61 20 64 6f 74 20 66 69 6c 65 29 0a use a dot file). 21e0: 3b 3b 20 20 20 20 2d 20 67 61 74 68 65 72 73 20 ;; - gathers 21f0: 68 6f 73 74 20 69 6e 66 6f 20 61 6e 64 20 0a 3b host info and .; 2200: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;=============== 2210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2240: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar 2250: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 gs:get-arg "-exe 2260: 63 75 74 65 22 29 0a 20 20 20 20 28 6c 65 74 2a cute"). (let* 2270: 20 28 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 ((cmdinfo (re 2280: 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 ad (open-input-s 2290: 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 tring (base64:ba 22a0: 73 65 36 34 2d 64 65 63 6f 64 65 20 28 61 72 67 se64-decode (arg 22b0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 s:get-arg "-exec 22c0: 75 74 65 22 29 29 29 29 29 29 0a 20 20 20 20 20 ute")))))). 22d0: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (setenv "MT_CMD 22e0: 49 4e 46 4f 22 20 28 61 72 67 73 3a 67 65 74 2d INFO" (args:get- 22f0: 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 29 arg "-execute")) 2300: 0a 20 20 20 20 20 20 28 69 66 20 28 6c 69 73 74 . (if (list 2310: 3f 20 63 6d 64 69 6e 66 6f 29 20 3b 3b 20 28 28 ? cmdinfo) ;; (( 2320: 74 65 73 74 70 61 74 68 20 2f 74 6d 70 2f 6d 72 testpath /tmp/mr 2330: 77 65 6c 6c 61 6e 2f 6a 61 7a 7a 6d 69 6e 64 2f wellan/jazzmind/ 2340: 73 72 63 2f 65 78 61 6d 70 6c 65 5f 72 75 6e 2f src/example_run/ 2350: 74 65 73 74 73 2f 73 71 6c 69 74 65 73 70 65 65 tests/sqlitespee 2360: 64 29 20 28 74 65 73 74 2d 6e 61 6d 65 20 73 71 d) (test-name sq 2370: 6c 69 74 65 73 70 65 65 64 29 20 28 72 75 6e 73 litespeed) (runs 2380: 63 72 69 70 74 20 72 75 6e 73 63 72 69 70 74 2e cript runscript. 2390: 72 62 29 20 28 64 62 2d 68 6f 73 74 20 6c 6f 63 rb) (db-host loc 23a0: 61 6c 68 6f 73 74 29 20 28 72 75 6e 2d 69 64 20 alhost) (run-id 23b0: 31 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 74 1)).. (let* ((t 23c0: 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f estpath (assoc/ 23d0: 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 default 'testpat 23e0: 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 h cmdinfo))... 23f0: 28 77 6f 72 6b 2d 61 72 65 61 20 28 61 73 73 6f (work-area (asso 2400: 63 2f 64 65 66 61 75 6c 74 20 27 77 6f 72 6b 2d c/default 'work- 2410: 61 72 65 61 20 63 6d 64 69 6e 66 6f 29 29 0a 09 area cmdinfo)).. 2420: 09 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 . (test-name (as 2430: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes 2440: 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 t-name cmdinfo)) 2450: 0a 09 09 20 28 72 75 6e 73 63 72 69 70 74 20 28 ... (runscript ( 2460: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r 2470: 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f unscript cmdinfo 2480: 29 29 0a 09 09 20 28 64 62 2d 68 6f 73 74 20 20 ))... (db-host 2490: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default 24a0: 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 'db-host cmdin 24b0: 66 6f 29 29 0a 09 09 20 28 72 75 6e 2d 69 64 20 fo))... (run-id 24c0: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul 24d0: 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 t 'run-id cmd 24e0: 69 6e 66 6f 29 29 0a 09 09 20 28 69 74 65 6d 64 info))... (itemd 24f0: 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 at (assoc/defa 2500: 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 ult 'itemdat c 2510: 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 6d 74 2d mdinfo))... (mt- 2520: 62 69 6e 64 69 72 2d 70 61 74 68 20 28 61 73 73 bindir-path (ass 2530: 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d 74 2d 62 oc/default 'mt-b 2540: 69 6e 64 69 72 2d 70 61 74 68 20 63 6d 64 69 6e indir-path cmdin 2550: 66 6f 29 29 0a 09 09 20 28 66 75 6c 6c 72 75 6e fo))... (fullrun 2560: 73 63 72 69 70 74 20 28 63 6f 6e 63 20 74 65 73 script (conc tes 2570: 74 70 61 74 68 20 22 2f 22 20 72 75 6e 73 63 72 tpath "/" runscr 2580: 69 70 74 29 29 0a 09 09 20 28 64 62 20 20 20 20 ipt))... (db 2590: 20 20 20 20 23 66 29 29 0a 09 20 20 20 20 28 70 #f)).. (p 25a0: 72 69 6e 74 20 22 45 78 65 63 74 75 69 6e 67 20 rint "Exectuing 25b0: 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 6f 6e " test-name " on 25c0: 20 22 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d " (get-host-nam 25d0: 65 29 29 0a 09 20 20 20 20 28 63 68 61 6e 67 65 e)).. (change 25e0: 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 -directory testp 25f0: 61 74 68 29 0a 09 20 20 20 20 28 73 65 74 65 6e ath).. (seten 2600: 76 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 v "MT_TEST_RUN_D 2610: 49 52 22 20 74 65 73 74 70 61 74 68 29 0a 09 20 IR" testpath).. 2620: 20 20 20 28 73 65 74 65 6e 76 20 22 50 41 54 48 (setenv "PATH 2630: 22 20 28 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 " (conc (getenv 2640: 22 50 41 54 48 22 29 20 22 3a 22 20 6d 74 2d 62 "PATH") ":" mt-b 2650: 69 6e 64 69 72 2d 70 61 74 68 29 29 0a 09 20 20 indir-path)).. 2660: 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 (if (not (setu 2670: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 09 28 62 p-for-run))...(b 2680: 65 67 69 6e 0a 09 09 20 20 28 70 72 69 6e 74 20 egin... (print 2690: 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 "Failed to setup 26a0: 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 09 20 , exiting") ... 26b0: 20 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 20 (exit 1))).. 26c0: 20 3b 3b 20 6e 6f 77 20 63 61 6e 20 66 69 6e 64 ;; now can find 26d0: 20 6f 75 72 20 64 62 0a 09 20 20 20 20 28 73 65 our db.. (se 26e0: 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 t! db (open-db)) 26f0: 0a 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 .. (change-di 2700: 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 rectory work-are 2710: 61 29 20 0a 09 20 20 20 20 28 6c 65 74 20 28 28 a) .. (let (( 2720: 72 75 6e 63 6f 6e 66 69 67 66 20 28 63 6f 6e 63 runconfigf (conc 2730: 20 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 *toppath* "/ru 2740: 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 nconfigs.config" 2750: 29 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 ))).. (if ( 2760: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 72 75 6e file-exists? run 2770: 63 6f 6e 66 69 67 66 29 0a 09 09 20 20 28 73 65 configf)... (se 2780: 74 75 70 2d 65 6e 76 2d 64 65 66 61 75 6c 74 73 tup-env-defaults 2790: 20 64 62 20 72 75 6e 63 6f 6e 66 69 67 66 20 72 db runconfigf r 27a0: 75 6e 2d 69 64 29 0a 09 09 20 20 28 70 72 69 6e un-id)... (prin 27b0: 74 20 22 57 41 52 4e 49 4e 47 3a 20 59 6f 75 20 t "WARNING: You 27c0: 64 6f 20 6e 6f 74 20 68 61 76 65 20 61 20 72 75 do not have a ru 27d0: 6e 20 63 6f 6e 66 69 67 20 66 69 6c 65 3a 20 22 n config file: " 27e0: 20 72 75 6e 63 6f 6e 66 69 67 66 29 29 29 0a 09 runconfigf))).. 27f0: 20 20 20 20 28 73 65 74 2d 6d 65 67 61 74 65 73 (set-megates 2800: 74 2d 65 6e 76 2d 76 61 72 73 20 64 62 20 72 75 t-env-vars db ru 2810: 6e 2d 69 64 29 0a 09 20 20 20 20 28 73 65 74 2d n-id).. (set- 2820: 69 74 65 6d 2d 65 6e 76 2d 76 61 72 73 20 69 74 item-env-vars it 2830: 65 6d 64 61 74 29 0a 20 20 20 20 20 20 20 20 20 emdat). 2840: 20 20 20 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e (save-environ 2850: 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 22 6d ment-as-files "m 2860: 65 67 61 74 65 73 74 22 29 0a 09 20 20 20 20 28 egatest").. ( 2870: 74 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e test-set-meta-in 2880: 66 6f 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 fo db run-id tes 2890: 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 0a t-name itemdat). 28a0: 09 20 20 20 20 28 74 65 73 74 2d 73 65 74 2d 73 . (test-set-s 28b0: 74 61 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 tatus! db run-id 28c0: 20 74 65 73 74 2d 6e 61 6d 65 20 22 52 45 4d 4f test-name "REMO 28d0: 54 45 48 4f 53 54 53 54 41 52 54 22 20 22 6e 2f TEHOSTSTART" "n/ 28e0: 61 22 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 a" itemdat (args 28f0: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a :get-arg "-m")). 2900: 09 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 . (if (args:g 2910: 65 74 2d 61 72 67 20 22 2d 78 74 65 72 6d 22 29 et-arg "-xterm") 2920: 0a 09 09 28 73 65 74 21 20 66 75 6c 6c 72 75 6e ...(set! fullrun 2930: 73 63 72 69 70 74 20 22 78 74 65 72 6d 22 29 0a script "xterm"). 2940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2950: 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 (if (not (file-e 2960: 78 65 63 75 74 65 2d 61 63 63 65 73 73 3f 20 66 xecute-access? f 2970: 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 0a 20 ullrunscript)). 2980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2990: 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 (system (conc 29a0: 20 22 63 68 6d 6f 64 20 75 67 2b 78 20 22 20 66 "chmod ug+x " f 29b0: 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 29 ullrunscript)))) 29c0: 0a 09 20 20 20 20 3b 3b 20 57 65 20 61 72 65 20 .. ;; We are 29d0: 61 62 6f 75 74 20 74 6f 20 61 63 74 75 61 6c 6c about to actuall 29e0: 79 20 6b 69 63 6b 20 6f 66 66 20 74 68 65 20 74 y kick off the t 29f0: 65 73 74 0a 09 20 20 20 20 3b 3b 20 73 6f 20 74 est.. ;; so t 2a00: 68 69 73 20 69 73 20 61 20 67 6f 6f 64 20 70 6c his is a good pl 2a10: 61 63 65 20 74 6f 20 72 65 6d 6f 76 65 20 74 68 ace to remove th 2a20: 65 20 72 65 63 6f 72 64 73 20 66 6f 72 20 0a 09 e records for .. 2a30: 20 20 20 20 3b 3b 20 61 6e 79 20 70 72 65 76 69 ;; any previ 2a40: 6f 75 73 20 72 75 6e 73 0a 09 20 20 20 20 3b 3b ous runs.. ;; 2a50: 20 28 64 62 3a 74 65 73 74 2d 72 65 6d 6f 76 65 (db:test-remove 2a60: 2d 73 74 65 70 73 20 64 62 20 72 75 6e 2d 69 64 -steps db run-id 2a70: 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 64 61 testname itemda 2a80: 74 29 0a 09 20 20 20 20 0a 09 20 20 20 20 3b 3b t).. .. ;; 2a90: 20 66 72 6f 6d 20 68 65 72 65 20 6f 6e 20 6f 75 from here on ou 2aa0: 74 20 77 65 20 77 69 6c 6c 20 6f 70 65 6e 20 61 t we will open a 2ab0: 6e 64 20 63 6c 6f 73 65 20 74 68 65 20 64 62 0a nd close the db. 2ac0: 09 20 20 20 20 3b 3b 20 6f 6e 20 65 76 65 72 79 . ;; on every 2ad0: 20 61 63 63 65 73 73 20 74 6f 20 72 65 64 75 63 access to reduc 2ae0: 65 20 74 68 65 20 70 72 6f 62 61 62 6c 69 74 69 e the probabliti 2af0: 79 20 6f 66 20 0a 09 20 20 20 20 3b 3b 20 63 6f y of .. ;; co 2b00: 6e 74 65 6e 74 69 6f 6e 20 6f 72 20 73 74 75 63 ntention or stuc 2b10: 6b 20 61 63 63 65 73 73 20 6f 6e 20 6e 66 73 2e k access on nfs. 2b20: 0a 09 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 .. (sqlite3:f 2b30: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 0a 09 20 inalize! db)... 2b40: 20 20 20 28 6c 65 74 2a 20 28 28 6d 20 20 20 20 (let* ((m 2b50: 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 6d 75 (make-mu 2b60: 74 65 78 29 29 0a 09 09 20 20 20 28 6b 69 6c 6c tex))... (kill 2b70: 2d 6a 6f 62 3f 20 20 20 20 23 66 29 0a 09 09 20 -job? #f)... 2b80: 20 20 28 65 78 69 74 2d 69 6e 66 6f 20 20 20 20 (exit-info 2b90: 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 33 29 29 (make-vector 3)) 2ba0: 0a 09 09 20 20 20 28 72 75 6e 69 74 20 20 20 20 ... (runit 2bb0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 (lambda ().. 2bc0: 09 09 09 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 ... (let-value 2bd0: 73 0a 09 09 09 09 20 20 20 20 28 28 28 70 69 64 s..... (((pid 2be0: 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 exit-status exi 2bf0: 74 2d 63 6f 64 65 29 0a 09 09 09 09 20 20 20 20 t-code)..... 2c00: 20 20 28 72 75 6e 2d 6e 2d 77 61 69 74 20 66 75 (run-n-wait fu 2c10: 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 llrunscript))).. 2c20: 09 09 09 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f ... (mutex-lo 2c30: 63 6b 21 20 6d 29 0a 09 09 09 09 20 20 20 20 28 ck! m)..... ( 2c40: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit 2c50: 2d 69 6e 66 6f 20 30 20 70 69 64 29 0a 09 09 09 -info 0 pid).... 2c60: 09 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 . (vector-set 2c70: 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 ! exit-info 1 ex 2c80: 69 74 2d 73 74 61 74 75 73 29 0a 09 09 09 09 20 it-status)..... 2c90: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set! 2ca0: 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 78 69 74 exit-info 2 exit 2cb0: 2d 63 6f 64 65 29 0a 09 09 09 09 20 20 20 20 28 -code)..... ( 2cc0: 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 mutex-unlock! m) 2cd0: 29 29 29 0a 09 09 20 20 20 28 6d 6f 6e 69 74 6f )))... (monito 2ce0: 72 6a 6f 62 20 20 20 28 6c 61 6d 62 64 61 20 28 rjob (lambda ( 2cf0: 29 0a 09 09 09 09 20 20 20 28 6c 65 74 2a 20 28 )..... (let* ( 2d00: 28 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 20 28 (start-seconds ( 2d10: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds) 2d20: 29 0a 09 09 09 09 09 20 20 28 63 61 6c 63 2d 6d )...... (calc-m 2d30: 69 6e 75 74 65 73 20 20 28 6c 61 6d 62 64 61 20 inutes (lambda 2d40: 28 29 0a 09 09 09 09 09 09 09 20 20 20 28 69 6e ()........ (in 2d50: 65 78 61 63 74 2d 3e 65 78 61 63 74 20 0a 09 09 exact->exact ... 2d60: 09 09 09 09 09 20 20 20 20 28 72 6f 75 6e 64 20 ..... (round 2d70: 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 2d 20 ........ (- 2d80: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 28 63 ........ (c 2d90: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 urrent-seconds) 2da0: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 73 74 ........ st 2db0: 61 72 74 2d 73 65 63 6f 6e 64 73 29 29 29 29 29 art-seconds))))) 2dc0: 29 0a 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 )..... (let 2dd0: 6c 6f 6f 70 20 28 28 6d 69 6e 75 74 65 73 20 20 loop ((minutes 2de0: 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 (calc-minutes)) 2df0: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 )..... (le 2e00: 74 20 28 28 64 62 20 20 20 20 28 6f 70 65 6e 2d t ((db (open- 2e10: 64 62 29 29 29 0a 09 09 09 09 09 20 28 73 65 74 db)))...... (set 2e20: 21 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 28 74 65 73 ! kill-job? (tes 2e30: 74 2d 67 65 74 2d 6b 69 6c 6c 2d 72 65 71 75 65 t-get-kill-reque 2e40: 73 74 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 st db run-id tes 2e50: 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 29 t-name itemdat)) 2e60: 0a 09 09 09 09 09 20 28 74 65 73 74 2d 75 70 64 ...... (test-upd 2e70: 61 74 65 2d 6d 65 74 61 2d 69 6e 66 6f 20 64 62 ate-meta-info db 2e80: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam 2e90: 65 20 69 74 65 6d 64 61 74 20 6d 69 6e 75 74 65 e itemdat minute 2ea0: 73 29 0a 09 09 09 09 09 20 28 69 66 20 6b 69 6c s)...... (if kil 2eb0: 6c 2d 6a 6f 62 3f 20 28 70 72 6f 63 65 73 73 2d l-job? (process- 2ec0: 73 69 67 6e 61 6c 20 28 76 65 63 74 6f 72 2d 72 signal (vector-r 2ed0: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 20 ef exit-info 0) 2ee0: 73 69 67 6e 61 6c 2f 74 65 72 6d 29 29 0a 09 09 signal/term))... 2ef0: 09 09 09 20 28 73 71 6c 69 74 65 33 3a 66 69 6e ... (sqlite3:fin 2f00: 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 09 09 09 alize! db)...... 2f10: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep! 2f20: 28 2b 20 38 20 28 72 61 6e 64 6f 6d 20 34 29 29 (+ 8 (random 4)) 2f30: 29 20 3b 3b 20 61 64 64 20 73 6f 6d 65 20 6a 69 ) ;; add some ji 2f40: 74 74 65 72 20 74 6f 20 74 68 65 20 63 61 6c 6c tter to the call 2f50: 20 68 6f 6d 65 20 74 69 6d 65 20 74 6f 20 73 70 home time to sp 2f60: 72 65 61 64 20 6f 75 74 20 74 68 65 20 64 62 20 read out the db 2f70: 61 63 63 65 73 73 65 73 0a 09 09 09 09 09 20 28 accesses...... ( 2f80: 6c 6f 6f 70 20 28 63 61 6c 63 2d 6d 69 6e 75 74 loop (calc-minut 2f90: 65 73 29 29 29 29 29 29 29 0a 09 09 20 20 20 28 es)))))))... ( 2fa0: 74 68 31 20 20 20 20 20 20 20 20 20 20 28 6d 61 th1 (ma 2fb0: 6b 65 2d 74 68 72 65 61 64 20 6d 6f 6e 69 74 6f ke-thread monito 2fc0: 72 6a 6f 62 29 29 0a 09 09 20 20 20 28 74 68 32 rjob))... (th2 2fd0: 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d (make- 2fe0: 74 68 72 65 61 64 20 72 75 6e 69 74 29 29 29 0a thread runit))). 2ff0: 09 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 . (thread-s 3000: 74 61 72 74 21 20 74 68 31 29 0a 09 20 20 20 20 tart! th1).. 3010: 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 (thread-start! 3020: 20 74 68 32 29 0a 09 20 20 20 20 20 20 28 74 68 th2).. (th 3030: 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 32 29 0a read-join! th2). 3040: 09 20 20 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f . (mutex-lo 3050: 63 6b 21 20 6d 29 0a 09 20 20 20 20 20 20 28 73 ck! m).. (s 3060: 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 et! db (open-db) 3070: 29 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 ).. (let* ( 3080: 28 74 65 73 74 69 6e 66 6f 20 28 72 75 6e 73 3a (testinfo (runs: 3090: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 64 62 get-test-info db 30a0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam 30b0: 65 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 e (item-list->pa 30c0: 74 68 20 69 74 65 6d 64 61 74 29 29 29 29 0a 09 th itemdat)))).. 30d0: 09 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c .(if (not (equal 30e0: 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ? (db:test-get-s 30f0: 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 20 22 tate testinfo) " 3100: 43 4f 4d 50 4c 45 54 45 44 22 29 29 0a 09 09 20 COMPLETED"))... 3110: 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 (begin... 3120: 20 20 28 70 72 69 6e 74 20 22 54 65 73 74 20 4e (print "Test N 3130: 4f 54 20 6c 6f 67 67 65 64 20 61 73 20 43 4f 4d OT logged as COM 3140: 50 4c 45 54 45 44 2c 20 28 73 74 61 74 65 3d 22 PLETED, (state=" 3150: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st 3160: 61 74 65 20 74 65 73 74 69 6e 66 6f 29 20 22 29 ate testinfo) ") 3170: 2c 20 75 70 64 61 74 69 6e 67 20 72 65 73 75 6c , updating resul 3180: 74 22 29 0a 09 09 20 20 20 20 20 20 28 74 65 73 t")... (tes 3190: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 t-set-status! db 31a0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam 31b0: 65 0a 09 09 09 09 09 28 69 66 20 6b 69 6c 6c 2d e......(if kill- 31c0: 6a 6f 62 3f 20 22 4b 49 4c 4c 45 44 22 20 22 43 job? "KILLED" "C 31d0: 4f 4d 50 4c 45 54 45 44 22 29 0a 09 09 09 09 09 OMPLETED")...... 31e0: 28 69 66 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (if (vector-ref 31f0: 65 78 69 74 2d 69 6e 66 6f 20 31 29 20 3b 3b 20 exit-info 1) ;; 3200: 6c 6f 6f 6b 20 61 74 20 74 68 65 20 65 78 69 74 look at the exit 3210: 2d 73 74 61 74 75 73 0a 09 09 09 09 09 20 20 20 -status...... 3220: 20 28 69 66 20 28 65 71 3f 20 28 76 65 63 74 6f (if (eq? (vecto 3230: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info 3240: 32 29 20 30 29 0a 09 09 09 09 09 09 22 50 41 53 2) 0)......."PAS 3250: 53 22 0a 09 09 09 09 09 09 22 46 41 49 4c 22 29 S"......."FAIL") 3260: 0a 09 09 09 09 09 20 20 20 20 22 46 41 49 4c 22 ...... "FAIL" 3270: 29 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a ) itemdat (args: 3280: 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 29 29 get-arg "-m")))) 3290: 29 0a 09 20 20 20 20 20 20 28 6d 75 74 65 78 2d ).. (mutex- 32a0: 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 unlock! m).. 32b0: 20 20 3b 3b 20 28 65 78 65 63 2d 72 65 73 75 6c ;; (exec-resul 32c0: 74 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 ts (cmd-run->lis 32d0: 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 t fullrunscript) 32e0: 29 20 3b 3b 20 20 28 6c 69 73 74 20 22 3e 22 20 ) ;; (list ">" 32f0: 28 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 (conc test-name 3300: 22 2d 72 75 6e 2e 6c 6f 67 22 29 29 29 29 0a 09 "-run.log")))).. 3310: 20 20 20 20 20 20 3b 3b 20 28 73 75 63 63 65 73 ;; (succes 3320: 73 20 20 20 20 20 20 65 78 65 63 2d 72 65 73 75 s exec-resu 3330: 6c 74 73 29 29 20 3b 3b 20 28 65 71 3f 20 28 63 lts)) ;; (eq? (c 3340: 61 64 72 20 65 78 65 63 2d 72 65 73 75 6c 74 73 adr exec-results 3350: 29 20 30 29 29 29 0a 09 20 20 20 20 20 20 28 70 ) 0))).. (p 3360: 72 69 6e 74 20 22 4f 75 74 70 75 74 20 66 72 6f rint "Output fro 3370: 6d 20 72 75 6e 6e 69 6e 67 20 22 20 66 75 6c 6c m running " full 3380: 72 75 6e 73 63 72 69 70 74 20 22 2c 20 70 69 64 runscript ", pid 3390: 20 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 " (vector-ref e 33a0: 78 69 74 2d 69 6e 66 6f 20 30 29 20 22 20 69 6e xit-info 0) " in 33b0: 20 77 6f 72 6b 20 61 72 65 61 20 22 20 0a 09 09 work area " ... 33c0: 20 20 20 20 20 77 6f 72 6b 2d 61 72 65 61 20 22 work-area " 33d0: 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 65 78 69 74 20 63 :\n====\n exit c 33e0: 6f 64 65 20 22 20 28 76 65 63 74 6f 72 2d 72 65 ode " (vector-re 33f0: 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 22 f exit-info 2) " 3400: 5c 6e 22 20 22 3d 3d 3d 3d 5c 6e 22 29 0a 09 20 \n" "====\n").. 3410: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 (sqlite3:fi 3420: 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 20 nalize! db).. 3430: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 76 65 63 (if (not (vec 3440: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf 3450: 6f 20 31 29 29 0a 09 09 20 20 28 65 78 69 74 20 o 1))... (exit 3460: 34 29 29 29 29 29 0a 20 20 20 20 20 20 28 73 65 4))))). (se 3470: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething 3480: 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 * #t)))..(if (ar 3490: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 gs:get-arg "-ste 34a0: 70 22 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 p"). (if (not 34b0: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD 34c0: 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e 0a INFO"))..(begin. 34d0: 09 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 . (print "ERROR 34e0: 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 : MT_CMDINFO env 34f0: 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 2d 73 var not set, -s 3500: 74 65 70 20 6d 75 73 74 20 62 65 20 63 61 6c 6c tep must be call 3510: 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 ed *inside* a me 3520: 67 61 74 65 73 74 20 69 6e 76 6f 6b 65 64 20 65 gatest invoked e 3530: 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 20 nvironment!").. 3540: 20 28 65 78 69 74 20 35 29 29 0a 09 28 6c 65 74 (exit 5))..(let 3550: 2a 20 28 28 73 74 65 70 20 20 20 20 20 20 28 61 * ((step (a 3560: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st 3570: 65 70 22 29 29 0a 09 20 20 20 20 20 20 20 28 63 ep")).. (c 3580: 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 mdinfo (read ( 3590: 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e open-input-strin 35a0: 67 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 g (base64:base64 35b0: 2d 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 -decode (getenv 35c0: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 "MT_CMDINFO")))) 35d0: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 ).. (testp 35e0: 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa 35f0: 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c 3600: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo)).. 3610: 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 (test-name (ass 3620: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test 3630: 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a -name cmdinfo)). 3640: 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 . (runscri 3650: 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c pt (assoc/defaul 3660: 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 t 'runscript cmd 3670: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. ( 3680: 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 db-host (assoc 3690: 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 /default 'db-hos 36a0: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo)).. 36b0: 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id 36c0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default 36d0: 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 'run-id cmdin 36e0: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 fo)).. (it 36f0: 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 emdat (assoc/d 3700: 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 efault 'itemdat 3710: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo)).. 3720: 20 20 20 20 28 64 62 20 20 20 20 20 20 20 20 23 (db # 3730: 66 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 f).. (stat 3740: 65 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 e (args:get-a 3750: 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 rg ":state")).. 3760: 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 (status 3770: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ": 3780: 73 74 61 74 75 73 22 29 29 29 0a 09 20 20 28 63 status"))).. (c 3790: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory 37a0: 74 65 73 74 70 61 74 68 29 0a 09 20 20 28 69 66 testpath).. (if 37b0: 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 (not (setup-for 37c0: 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 28 62 -run)).. (b 37d0: 65 67 69 6e 0a 09 09 28 70 72 69 6e 74 20 22 46 egin...(print "F 37e0: 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 ailed to setup, 37f0: 65 78 69 74 69 6e 67 22 29 0a 09 09 28 65 78 69 exiting")...(exi 3800: 74 20 31 29 29 29 0a 09 20 20 28 73 65 74 21 20 t 1))).. (set! 3810: 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 20 db (open-db)).. 3820: 20 28 69 66 20 28 61 6e 64 20 73 74 61 74 65 20 (if (and state 3830: 73 74 61 74 75 73 29 0a 09 20 20 20 20 20 20 28 status).. ( 3840: 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta 3850: 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 tus! db run-id t 3860: 65 73 74 2d 6e 61 6d 65 20 73 74 65 70 20 73 74 est-name step st 3870: 61 74 65 20 73 74 61 74 75 73 20 69 74 65 6d 64 ate status itemd 3880: 61 74 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 at).. (begi 3890: 6e 0a 09 09 28 70 72 69 6e 74 20 22 45 52 52 4f n...(print "ERRO 38a0: 52 3a 20 59 6f 75 20 6d 75 73 74 20 73 70 65 63 R: You must spec 38b0: 69 66 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a ify :state and : 38c0: 73 74 61 74 75 73 20 77 69 74 68 20 65 76 65 72 status with ever 38d0: 79 20 63 61 6c 6c 20 74 6f 20 2d 73 74 65 70 22 y call to -step" 38e0: 29 0a 09 09 28 65 78 69 74 20 36 29 29 29 0a 09 )...(exit 6))).. 38f0: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final 3900: 69 7a 65 21 20 64 62 29 0a 09 20 20 28 73 65 74 ize! db).. (set 3910: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething* 3920: 20 23 74 29 29 29 29 0a 0a 28 69 66 20 28 6f 72 #t))))..(if (or 3930: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg " 3940: 2d 73 65 74 6c 6f 67 22 29 20 20 20 20 20 20 20 -setlog") 3950: 3b 3b 20 73 69 6e 63 65 20 73 65 74 74 69 6e 67 ;; since setting 3960: 20 75 70 20 69 73 20 73 6f 20 63 6f 73 74 6c 79 up is so costly 3970: 20 6c 65 74 73 20 70 69 67 67 79 62 61 63 6b 20 lets piggyback 3980: 6f 6e 20 2d 74 65 73 74 2d 73 74 61 74 75 73 0a on -test-status. 3990: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg " 39a0: 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a 09 -test-status").. 39b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "- 39c0: 72 75 6e 73 74 65 70 22 29 29 0a 20 20 20 20 28 runstep")). ( 39d0: 69 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 if (not (getenv 39e0: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 "MT_CMDINFO")).. 39f0: 28 62 65 67 69 6e 0a 09 20 20 28 70 72 69 6e 74 (begin.. (print 3a00: 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 "ERROR: MT_CMDI 3a10: 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 NFO env var not 3a20: 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 set, commands -t 3a30: 65 73 74 2d 73 74 61 74 75 73 2c 20 2d 72 75 6e est-status, -run 3a40: 73 74 65 70 20 61 6e 64 20 2d 73 65 74 6c 6f 67 step and -setlog 3a50: 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 20 must be called 3a60: 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 74 *inside* a megat 3a70: 65 73 74 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 est environment! 3a80: 22 29 0a 09 20 20 28 65 78 69 74 20 35 29 29 0a ").. (exit 5)). 3a90: 09 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e 66 6f .(let* ((cmdinfo 3aa0: 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 (read (open-i 3ab0: 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 nput-string (bas 3ac0: 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 e64:base64-decod 3ad0: 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d e (getenv "MT_CM 3ae0: 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 20 DINFO"))))).. 3af0: 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 (testpath ( 3b00: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't 3b10: 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo 3b20: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test 3b30: 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 -name (assoc/def 3b40: 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 ault 'test-name 3b50: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo)).. 3b60: 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 (runscript (as 3b70: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run 3b80: 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 script cmdinfo)) 3b90: 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 .. (db-hos 3ba0: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau 3bb0: 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d lt 'db-host cm 3bc0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo)).. 3bd0: 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f (run-id (asso 3be0: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 c/default 'run-i 3bf0: 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 d cmdinfo)).. 3c00: 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 (itemdat 3c10: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default 3c20: 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 'itemdat cmdi 3c30: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 nfo)).. (d 3c40: 62 20 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 b #f).. 3c50: 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 20 (state 3c60: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ": 3c70: 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 state")).. 3c80: 20 28 73 74 61 74 75 73 20 20 20 20 28 61 72 67 (status (arg 3c90: 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat 3ca0: 75 73 22 29 29 29 0a 09 20 20 28 63 68 61 6e 67 us"))).. (chang 3cb0: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test 3cc0: 70 61 74 68 29 0a 09 20 20 28 69 66 20 28 6e 6f path).. (if (no 3cd0: 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e t (setup-for-run 3ce0: 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e )).. (begin 3cf0: 0a 09 09 28 70 72 69 6e 74 20 22 46 61 69 6c 65 ...(print "Faile 3d00: 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit 3d10: 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 ing")...(exit 1) 3d20: 29 29 0a 09 20 20 28 73 65 74 21 20 64 62 20 28 )).. (set! db ( 3d30: 6f 70 65 6e 2d 64 62 29 29 0a 09 20 20 28 69 66 open-db)).. (if 3d40: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg " 3d50: 2d 73 65 74 6c 6f 67 22 29 0a 09 20 20 20 20 20 -setlog").. 3d60: 20 28 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 (test-set-log! 3d70: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n 3d80: 61 6d 65 20 69 74 65 6d 64 61 74 20 28 61 72 67 ame itemdat (arg 3d90: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c s:get-arg "-setl 3da0: 6f 67 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 og"))).. (if (a 3db0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te 3dc0: 73 74 2d 73 74 61 74 75 73 22 29 0a 09 20 20 20 st-status").. 3dd0: 20 20 20 28 74 65 73 74 2d 73 65 74 2d 73 74 61 (test-set-sta 3de0: 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 tus! db run-id t 3df0: 65 73 74 2d 6e 61 6d 65 20 73 74 61 74 65 20 73 est-name state s 3e00: 74 61 74 75 73 20 69 74 65 6d 64 61 74 20 28 61 tatus itemdat (a 3e10: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m" 3e20: 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 )).. (if (a 3e30: 6e 64 20 73 74 61 74 65 20 73 74 61 74 75 73 29 nd state status) 3e40: 0a 09 09 20 20 28 69 66 20 28 6e 6f 74 20 28 61 ... (if (not (a 3e50: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se 3e60: 74 6c 6f 67 22 29 29 0a 09 09 20 20 20 20 20 20 tlog"))... 3e70: 28 62 65 67 69 6e 0a 09 09 09 28 70 72 69 6e 74 (begin....(print 3e80: 20 22 45 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 "ERROR: You mus 3e90: 74 20 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 t specify :state 3ea0: 20 61 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 and :status wit 3eb0: 68 20 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 h every call to 3ec0: 2d 74 65 73 74 2d 73 74 61 74 75 73 5c 6e 22 20 -test-status\n" 3ed0: 68 65 6c 70 29 0a 09 09 09 28 73 71 6c 69 74 65 help)....(sqlite 3ee0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db). 3ef0: 09 09 09 28 65 78 69 74 20 36 29 29 29 29 29 0a ...(exit 6))))). 3f00: 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 . (if (args:get 3f10: 2d 61 72 67 20 22 2d 72 75 6e 2d 73 74 65 70 22 -arg "-run-step" 3f20: 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e 75 ).. (if (nu 3f30: 6c 6c 3f 20 72 65 6d 61 72 67 73 29 0a 09 09 20 ll? remargs)... 3f40: 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 70 (begin... (p 3f50: 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 6e 6f 74 rint "ERROR: not 3f60: 68 69 6e 67 20 73 70 65 63 69 66 69 65 64 20 74 hing specified t 3f70: 6f 20 72 75 6e 21 22 29 0a 09 09 20 20 20 20 28 o run!")... ( 3f80: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize 3f90: 21 20 64 62 29 0a 09 09 20 20 20 20 28 65 78 69 ! db)... (exi 3fa0: 74 20 36 29 29 0a 09 09 20 20 28 6c 65 74 2a 20 t 6))... (let* 3fb0: 28 28 6c 6f 67 70 72 6f 66 69 6c 65 20 28 61 72 ((logprofile (ar 3fc0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 gs:get-arg "-log 3fd0: 70 72 6f 22 29 29 0a 09 09 09 20 28 63 6d 64 20 pro")).... (cmd 3fe0: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null 3ff0: 3f 20 72 65 6d 61 72 67 73 29 20 23 66 20 28 63 ? remargs) #f (c 4000: 61 72 20 72 65 6d 61 72 67 73 29 29 29 0a 09 09 ar remargs)))... 4010: 09 20 28 70 61 72 61 6d 73 20 20 20 20 20 28 69 . (params (i 4020: 66 20 63 6d 64 20 28 63 64 72 20 72 65 6d 61 72 f cmd (cdr remar 4030: 67 73 29 20 23 66 29 29 0a 09 09 09 20 28 65 78 gs) #f)).... (ex 4040: 69 74 73 74 61 74 20 20 20 23 66 29 29 0a 09 09 itstat #f))... 4050: 20 20 20 20 3b 3b 20 6d 61 72 6b 20 74 68 65 20 ;; mark the 4060: 73 74 61 72 74 20 6f 66 20 74 68 65 20 74 65 73 start of the tes 4070: 74 0a 09 09 20 20 20 20 28 74 65 73 74 2d 73 65 t... (test-se 4080: 74 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 6e t-status! db run 4090: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 22 73 -id test-name "s 40a0: 74 61 72 74 22 20 22 6e 2f 61 22 20 69 74 65 6d tart" "n/a" item 40b0: 64 61 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 dat (args:get-ar 40c0: 67 20 22 2d 6d 22 29 29 0a 09 09 20 20 20 20 3b g "-m"))... ; 40d0: 3b 20 63 6c 6f 73 65 20 74 68 65 20 64 62 0a 09 ; close the db.. 40e0: 09 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 . (sqlite3:fi 40f0: 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 20 20 nalize! db)... 4100: 20 20 3b 3b 20 72 75 6e 20 74 68 65 20 74 65 73 ;; run the tes 4110: 74 20 73 74 65 70 0a 09 09 20 20 20 20 28 73 65 t step... (se 4120: 74 21 20 65 78 69 74 73 74 61 74 20 28 70 72 6f t! exitstat (pro 4130: 63 65 73 73 2d 72 75 6e 20 63 6d 64 20 70 61 72 cess-run cmd par 4140: 61 6d 73 29 29 0a 09 09 20 20 20 20 3b 3b 20 72 ams))... ;; r 4150: 65 2d 6f 70 65 6e 20 74 68 65 20 64 62 0a 09 09 e-open the db... 4160: 20 20 20 20 28 73 65 74 21 20 64 62 20 28 6f 70 (set! db (op 4170: 65 6e 2d 64 62 29 29 20 0a 09 09 20 20 20 20 3b en-db)) ... ; 4180: 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 66 20 ; run logpro if 4190: 61 70 70 6c 69 63 61 62 6c 65 0a 09 09 20 20 20 applicable... 41a0: 20 28 69 66 20 6c 6f 67 70 72 6f 0a 09 09 09 28 (if logpro....( 41b0: 6c 65 74 20 28 28 6c 6f 67 66 69 6c 65 20 28 63 let ((logfile (c 41c0: 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 2e onc test-name ". 41d0: 68 74 6d 6c 22 29 29 29 0a 09 09 09 20 20 28 73 html"))).... (s 41e0: 65 74 21 20 65 78 69 74 73 74 61 74 20 28 70 72 et! exitstat (pr 41f0: 6f 63 65 73 73 2d 72 75 6e 20 22 6c 6f 67 70 72 ocess-run "logpr 4200: 6f 22 20 6c 6f 67 70 72 6f 20 6c 6f 67 66 69 6c o" logpro logfil 4210: 65 29 29 0a 09 09 09 20 20 28 74 65 73 74 2d 73 e)).... (test-s 4220: 65 74 2d 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 et-log! db run-i 4230: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item 4240: 64 61 74 20 6c 6f 67 66 69 6c 65 29 29 29 0a 09 dat logfile))).. 4250: 09 20 20 20 20 28 74 65 73 74 2d 73 65 74 2d 73 . (test-set-s 4260: 74 61 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 tatus! db run-id 4270: 20 74 65 73 74 2d 6e 61 6d 65 20 22 65 6e 64 22 test-name "end" 4280: 20 65 78 69 74 73 74 61 74 20 69 74 65 6d 64 61 exitstat itemda 4290: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg 42a0: 22 2d 6d 22 29 29 0a 09 09 20 20 20 20 28 73 71 "-m"))... (sq 42b0: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize! 42c0: 64 62 29 0a 09 09 20 20 20 20 28 65 78 69 74 20 db)... (exit 42d0: 65 78 69 74 73 74 61 74 29 0a 09 09 20 20 20 20 exitstat)... 42e0: 3b 3b 20 6f 70 65 6e 20 74 68 65 20 64 62 0a 09 ;; open the db.. 42f0: 09 3b 3b 20 6d 61 72 6b 20 74 68 65 20 65 6e 64 .;; mark the end 4300: 20 6f 66 20 74 68 65 20 74 65 73 74 0a 09 09 29 of the test...) 4310: 29 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 66 )).. (sqlite3:f 4320: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 inalize! db).. 4330: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh 4340: 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 28 69 66 ing* #t))))..(if 4350: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg " 4360: 2d 73 68 6f 77 6b 65 79 73 22 29 0a 20 20 20 20 -showkeys"). 4370: 28 6c 65 74 20 28 28 64 62 20 23 66 29 0a 09 20 (let ((db #f).. 4380: 20 28 6b 65 79 73 20 23 66 29 29 0a 20 20 20 20 (keys #f)). 4390: 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 (if (not (setu 43a0: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 p-for-run)).. ( 43b0: 62 65 67 69 6e 0a 09 20 20 20 20 28 70 72 69 6e begin.. (prin 43c0: 74 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 t "Failed to set 43d0: 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 up, exiting").. 43e0: 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))). 43f0: 20 20 20 20 28 73 65 74 21 20 64 62 20 28 6f 70 (set! db (op 4400: 65 6e 2d 64 62 29 29 0a 20 20 20 20 20 20 28 73 en-db)). (s 4410: 65 74 21 20 6b 65 79 73 20 28 64 62 2d 67 65 74 et! keys (db-get 4420: 2d 6b 65 79 73 20 64 62 29 29 0a 20 20 20 20 20 -keys db)). 4430: 20 28 70 72 69 6e 74 20 22 4b 65 79 73 3a 20 22 (print "Keys: " 4440: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp 4450: 65 72 73 65 20 28 6d 61 70 20 6b 65 79 3a 67 65 erse (map key:ge 4460: 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 t-fieldname keys 4470: 29 20 22 2c 20 22 29 29 0a 20 20 20 20 20 20 28 ) ", ")). ( 4480: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize 4490: 21 20 64 62 29 0a 20 20 20 20 20 20 28 73 65 74 ! db). (set 44a0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething* 44b0: 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg 44c0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 75 69 22 s:get-arg "-gui" 44d0: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin. 44e0: 20 20 20 28 70 72 69 6e 74 20 22 4c 6f 6f 6b 20 (print "Look 44f0: 61 74 20 74 68 65 20 64 61 73 68 62 6f 61 72 64 at the dashboard 4500: 20 66 6f 72 20 6e 6f 77 22 29 0a 20 20 20 20 20 for now"). 4510: 20 3b 3b 20 28 6d 65 67 61 74 65 73 74 2d 67 75 ;; (megatest-gu 4520: 69 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a i). (set! * 4530: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t 4540: 29 29 29 0a 0a 28 69 66 20 28 6e 6f 74 20 2a 64 )))..(if (not *d 4550: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 29 0a 20 20 idsomething*). 4560: 20 20 28 70 72 69 6e 74 20 68 65 6c 70 29 29 0a (print help)).