Megatest

Artifact fdec59eebfaf27dc2324fb30bab63504a275c726:

• File megatest.scm — part of check-in [40fcb78bd6] at 2011-08-02 23:27:07 on branch trunk — Added auto-rolling up of item status into an html file (user: matt size: 26820)

0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30  ;; Copyright 200
0010: 36 2d 32 30 31 31 2c 20 4d 61 74 74 68 65 77 20  6-2011, Matthew 
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20  Welland..;; .;; 
0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73   This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20   made available 
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50  under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72  L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65  .;;  greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69  e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20  ng file COPYING 
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20  for details..;; 
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61  .;;  This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64  m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52   WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65  RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c  ven the.;;  impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20  ied warranty of 
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20  MERCHANTABILITY 
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41  or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20   PARTICULAR.;;  
0140: 50 55 52 50 4f 53 45 2e 0a 0a 28 69 6e 63 6c 75  PURPOSE...(inclu
0150: 64 65 20 22 63 6f 6d 6d 6f 6e 2e 73 63 6d 22 29  de "common.scm")
0160: 0a 28 69 6e 63 6c 75 64 65 20 22 6d 65 67 61 74  .(include "megat
0170: 65 73 74 2d 76 65 72 73 69 6f 6e 2e 73 63 6d 22  est-version.scm"
0180: 29 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20  )..(define help 
0190: 28 63 6f 6e 63 20 22 0a 4d 65 67 61 74 65 73 74  (conc ".Megatest
01a0: 2c 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20  , documentation 
01b0: 61 74 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69  at http://www.ki
01c0: 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73  atoa.com/fossils
01d0: 2f 6d 65 67 61 74 65 73 74 0a 20 20 76 65 72 73  /megatest.  vers
01e0: 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 2d 76  ion " megatest-v
01f0: 65 72 73 69 6f 6e 20 22 0a 20 20 6c 69 63 65 6e  ersion ".  licen
0200: 73 65 20 47 50 4c 2c 20 43 6f 70 79 72 69 67 68  se GPL, Copyrigh
0210: 74 20 4d 61 74 74 20 57 65 6c 6c 61 6e 64 20 32  t Matt Welland 2
0220: 30 30 36 2d 32 30 31 31 0a 0a 55 73 61 67 65 3a  006-2011..Usage:
0230: 20 6d 65 67 61 74 65 73 74 20 5b 6f 70 74 69 6f   megatest [optio
0240: 6e 73 5d 0a 20 20 2d 68 20 20 20 20 20 20 20 20  ns].  -h        
0250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20                : 
0260: 74 68 69 73 20 68 65 6c 70 0a 0a 50 72 6f 63 65  this help..Proce
0270: 73 73 20 61 6e 64 20 74 65 73 74 20 72 75 6e 6e  ss and test runn
0280: 69 6e 67 0a 20 20 2d 72 75 6e 61 6c 6c 20 20 20  ing.  -runall   
0290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20                : 
02a0: 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 74 68  run all tests th
02b0: 61 74 20 61 72 65 20 6e 6f 74 20 73 74 61 74 65  at are not state
02c0: 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 73   COMPLETED and s
02d0: 74 61 74 75 73 20 50 41 53 53 2c 20 0a 20 20 20  tatus PASS, .   
02e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
02f0: 20 20 20 20 20 20 20 20 20 43 48 45 43 4b 20 6f           CHECK o
0300: 72 20 4b 49 4c 4c 45 44 0a 20 20 2d 72 75 6e 74  r KILLED.  -runt
0310: 65 73 74 73 20 74 73 74 31 2c 74 73 74 32 20 2e  ests tst1,tst2 .
0320: 2e 2e 20 3a 20 72 75 6e 20 74 65 73 74 73 0a 0a  .. : run tests..
0330: 52 75 6e 20 73 74 61 74 75 73 20 75 70 64 61 74  Run status updat
0340: 65 73 20 28 74 68 65 73 65 20 72 65 71 75 69 72  es (these requir
0350: 65 20 74 68 61 74 20 79 6f 75 20 61 72 65 20 69  e that you are i
0360: 6e 20 61 20 74 65 73 74 20 64 69 72 65 63 74 6f  n a test directo
0370: 72 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  ry.             
0380: 20 20 20 20 20 20 20 61 6e 64 20 79 6f 75 20 68         and you h
0390: 61 76 65 20 73 6f 75 72 63 65 64 20 74 68 65 20  ave sourced the 
03a0: 5c 22 6d 65 67 61 74 65 73 74 2e 63 73 68 5c 22  \"megatest.csh\"
03b0: 20 6f 72 0a 20 20 20 20 20 20 20 20 20 20 20 20   or.            
03c0: 20 20 20 20 20 20 20 20 5c 22 6d 65 67 61 74 65          \"megate
03d0: 73 74 2e 73 68 5c 22 20 66 69 6c 65 2e 29 0a 20  st.sh\" file.). 
03e0: 20 2d 73 74 65 70 20 73 74 65 70 6e 61 6d 65 0a   -step stepname.
03f0: 20 20 2d 74 65 73 74 2d 73 74 61 74 75 73 20 20    -test-status  
0400: 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20            : set 
0410: 74 68 65 20 73 74 61 74 65 20 61 6e 64 20 73 74  the state and st
0420: 61 74 75 73 20 6f 66 20 61 20 74 65 73 74 20 28  atus of a test (
0430: 75 73 65 20 3a 73 74 61 74 65 20 61 6e 64 20 3a  use :state and :
0440: 73 74 61 74 75 73 29 0a 20 20 2d 73 65 74 6c 6f  status).  -setlo
0450: 67 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 20 20  g logfname      
0460: 20 20 3a 20 73 65 74 20 74 68 65 20 70 61 74 68    : set the path
0470: 2f 66 69 6c 65 6e 61 6d 65 20 74 6f 20 74 68 65  /filename to the
0480: 20 66 69 6e 61 6c 20 6c 6f 67 20 72 65 6c 61 74   final log relat
0490: 69 76 65 20 74 6f 20 74 68 65 20 74 65 73 74 0a  ive to the test.
04a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
04b0: 20 20 20 20 20 20 20 20 20 20 20 20 64 69 72 65              dire
04c0: 63 74 6f 72 79 2e 20 6d 61 79 20 62 65 20 75 73  ctory. may be us
04d0: 65 64 20 77 69 74 68 20 2d 74 65 73 74 2d 73 74  ed with -test-st
04e0: 61 74 75 73 0a 20 20 2d 73 65 74 2d 74 6f 70 6c  atus.  -set-topl
04f0: 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 3a  og logfname    :
0500: 20 73 65 74 20 74 68 65 20 6f 76 65 72 61 6c 6c   set the overall
0510: 20 6c 6f 67 20 66 6f 72 20 61 20 73 75 69 74 65   log for a suite
0520: 20 6f 66 20 73 75 62 2d 74 65 73 74 73 0a 20 20   of sub-tests.  
0530: 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73  -summarize-items
0540: 20 20 20 20 20 20 20 20 3a 20 66 6f 72 20 61 6e          : for an
0550: 20 69 74 65 6d 69 7a 65 64 20 74 65 73 74 20 63   itemized test c
0560: 72 65 61 74 65 20 61 20 73 75 6d 6d 61 72 79 20  reate a summary 
0570: 68 74 6d 6c 20 0a 20 20 2d 6d 20 63 6f 6d 6d 65  html .  -m comme
0580: 6e 74 20 20 20 20 20 20 20 20 20 20 20 20 20 20  nt              
0590: 3a 20 69 6e 73 65 72 74 20 61 20 63 6f 6d 6d 65  : insert a comme
05a0: 6e 74 20 66 6f 72 20 74 68 69 73 20 74 65 73 74  nt for this test
05b0: 0a 0a 52 75 6e 20 64 61 74 61 0a 20 20 3a 72 75  ..Run data.  :ru
05c0: 6e 6e 61 6d 65 20 20 20 20 20 20 20 20 20 20 20  nname           
05d0: 20 20 20 20 20 3a 20 72 65 71 75 69 72 65 64 2c       : required,
05e0: 20 6e 61 6d 65 20 66 6f 72 20 74 68 69 73 20 70   name for this p
05f0: 61 72 74 69 63 75 6c 61 72 20 74 65 73 74 20 72  articular test r
0600: 75 6e 0a 20 20 3a 73 74 61 74 65 20 20 20 20 20  un.  :state     
0610: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72               : r
0620: 65 71 75 69 72 65 64 20 69 66 20 75 70 64 61 74  equired if updat
0630: 69 6e 67 20 73 74 65 70 20 73 74 61 74 65 3b 20  ing step state; 
0640: 65 2e 67 2e 20 73 74 61 72 74 2c 20 65 6e 64 2c  e.g. start, end,
0650: 20 63 6f 6d 70 6c 65 74 65 64 0a 20 20 3a 73 74   completed.  :st
0660: 61 74 75 73 20 20 20 20 20 20 20 20 20 20 20 20  atus            
0670: 20 20 20 20 20 3a 20 72 65 71 75 69 72 65 64 20       : required 
0680: 69 66 20 75 70 64 61 74 69 6e 67 20 73 74 65 70  if updating step
0690: 20 73 74 61 74 75 73 3b 20 65 2e 67 2e 20 70 61   status; e.g. pa
06a0: 73 73 2c 20 66 61 69 6c 2c 20 6e 2f 61 0a 0a 51  ss, fail, n/a..Q
06b0: 75 65 72 69 65 73 0a 20 20 2d 6c 69 73 74 2d 72  ueries.  -list-r
06c0: 75 6e 73 20 70 61 74 74 20 20 20 20 20 20 20 20  uns patt        
06d0: 20 3a 20 6c 69 73 74 20 72 75 6e 73 20 6d 61 74   : list runs mat
06e0: 63 68 69 6e 67 20 70 61 74 74 65 72 6e 20 5c 22  ching pattern \"
06f0: 70 61 74 74 5c 22 2c 20 25 20 69 73 20 74 68 65  patt\", % is the
0700: 20 77 69 6c 64 63 61 72 64 0a 20 20 2d 74 65 73   wildcard.  -tes
0710: 74 70 61 74 74 20 70 61 74 74 20 20 20 20 20 20  tpatt patt      
0720: 20 20 20 20 3a 20 69 6e 20 6c 69 73 74 2d 72 75      : in list-ru
0730: 6e 73 20 73 68 6f 77 20 6f 6e 6c 79 20 74 68 65  ns show only the
0740: 73 65 20 74 65 73 74 73 2c 20 25 20 69 73 20 74  se tests, % is t
0750: 68 65 20 77 69 6c 64 63 61 72 64 0a 20 20 2d 69  he wildcard.  -i
0760: 74 65 6d 70 61 74 74 20 70 61 74 74 20 20 20 20  tempatt patt    
0770: 20 20 20 20 20 20 3a 20 69 6e 20 6c 69 73 74 2d        : in list-
0780: 72 75 6e 73 20 73 68 6f 77 20 6f 6e 6c 79 20 74  runs show only t
0790: 65 73 74 73 20 77 69 74 68 20 69 74 65 6d 73 20  ests with items 
07a0: 74 68 61 74 20 6d 61 74 63 68 20 70 61 74 74 0a  that match patt.
07b0: 20 20 2d 73 68 6f 77 6b 65 79 73 20 20 20 20 20    -showkeys     
07c0: 20 20 20 20 20 20 20 20 20 20 3a 20 73 68 6f 77            : show
07d0: 20 74 68 65 20 6b 65 79 73 20 75 73 65 64 20 69   the keys used i
07e0: 6e 20 74 68 69 73 20 6d 65 67 61 74 65 73 74 20  n this megatest 
07f0: 73 65 74 75 70 0a 0a 4d 69 73 63 20 0a 20 20 2d  setup..Misc .  -
0800: 66 6f 72 63 65 20 20 20 20 20 20 20 20 20 20 20  force           
0810: 20 20 20 20 20 20 20 3a 20 6f 76 65 72 72 69 64         : overrid
0820: 65 20 73 6f 6d 65 20 63 68 65 63 6b 73 0a 20 20  e some checks.  
0830: 2d 78 74 65 72 6d 20 20 20 20 20 20 20 20 20 20  -xterm          
0840: 20 20 20 20 20 20 20 20 3a 20 73 74 61 72 74 20          : start 
0850: 61 6e 20 78 74 65 72 6d 20 69 6e 73 74 65 61 64  an xterm instead
0860: 20 6f 66 20 6c 61 75 6e 63 68 69 6e 67 20 74 68   of launching th
0870: 65 20 74 65 73 74 0a 20 20 2d 72 65 6d 6f 76 65  e test.  -remove
0880: 2d 72 75 6e 73 20 20 20 20 20 20 20 20 20 20 20  -runs           
0890: 20 3a 20 72 65 6d 6f 76 65 20 74 68 65 20 64 61   : remove the da
08a0: 74 61 20 66 6f 72 20 61 20 72 75 6e 2c 20 72 65  ta for a run, re
08b0: 71 75 69 72 65 73 20 61 6c 6c 20 66 69 65 6c 64  quires all field
08c0: 73 20 62 65 20 73 70 65 63 69 66 69 65 64 0a 20  s be specified. 
08d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
08e0: 20 20 20 20 20 20 20 20 20 20 20 61 6e 64 20 3a             and :
08f0: 72 75 6e 6e 61 6d 65 20 2c 2d 74 65 73 74 70 61  runname ,-testpa
0900: 74 74 20 61 6e 64 20 2d 69 74 65 6d 70 61 74 74  tt and -itempatt
0910: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
0920: 20 20 20 20 20 20 20 20 20 20 20 20 20 61 6e 64               and
0930: 20 2d 74 65 73 74 70 61 74 74 0a 20 20 2d 6b 65   -testpatt.  -ke
0940: 65 70 67 6f 69 6e 67 20 20 20 20 20 20 20 20 20  epgoing         
0950: 20 20 20 20 20 3a 20 63 6f 6e 74 69 6e 75 65 20       : continue 
0960: 72 75 6e 6e 69 6e 67 20 75 6e 74 69 6c 20 6e 6f  running until no
0970: 20 6a 6f 62 73 20 61 72 65 20 5c 22 4c 41 55 4e   jobs are \"LAUN
0980: 43 48 45 44 5c 22 20 6f 72 0a 20 20 20 20 20 20  CHED\" or.      
0990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
09a0: 20 20 20 20 20 20 5c 22 4e 4f 54 5f 53 54 41 52        \"NOT_STAR
09b0: 54 45 44 5c 22 0a 20 20 2d 72 65 72 75 6e 20 46  TED\".  -rerun F
09c0: 41 49 4c 2c 57 41 52 4e 2e 2e 2e 20 20 20 20 20  AIL,WARN...     
09d0: 3a 20 72 65 2d 72 75 6e 20 69 66 20 63 61 6c 6c  : re-run if call
09e0: 65 64 20 6f 6e 20 61 20 74 65 73 74 20 74 68 61  ed on a test tha
09f0: 74 20 70 72 65 76 69 6f 75 73 6c 79 20 72 61 6e  t previously ran
0a00: 20 28 6e 75 6c 6c 69 66 69 65 64 0a 20 20 20 20   (nullified.    
0a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0a20: 20 20 20 20 20 20 20 20 69 66 20 2d 6b 65 65 70          if -keep
0a30: 67 6f 69 6e 67 20 69 73 20 61 6c 73 6f 20 73 70  going is also sp
0a40: 65 63 69 66 69 65 64 29 0a 20 20 2d 72 65 62 75  ecified).  -rebu
0a50: 69 6c 64 2d 64 62 20 20 20 20 20 20 20 20 20 20  ild-db          
0a60: 20 20 20 3a 20 62 72 69 6e 67 20 74 68 65 20 64     : bring the d
0a70: 61 74 61 62 61 73 65 20 73 63 68 65 6d 61 20 75  atabase schema u
0a80: 70 20 74 6f 20 64 61 74 65 0a 0a 48 65 6c 70 65  p to date..Helpe
0a90: 72 73 0a 20 20 2d 72 75 6e 73 74 65 70 20 73 74  rs.  -runstep st
0aa0: 65 70 6e 61 6d 65 20 20 2e 2e 2e 20 20 3a 20 74  epname  ...  : t
0ab0: 61 6b 65 20 72 65 6d 61 69 6e 69 6e 67 20 70 61  ake remaining pa
0ac0: 72 61 6d 73 20 61 73 20 63 6f 6d 61 6e 64 20 61  rams as comand a
0ad0: 6e 64 20 65 78 65 63 75 74 65 20 61 73 20 73 74  nd execute as st
0ae0: 65 70 6e 61 6d 65 0a 20 20 20 20 20 20 20 20 20  epname.         
0af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0b00: 20 20 20 6c 6f 67 20 77 69 6c 6c 20 62 65 20 69     log will be i
0b10: 6e 20 73 74 65 70 6e 61 6d 65 2e 6c 6f 67 2e 20  n stepname.log. 
0b20: 42 65 73 74 20 74 6f 20 70 75 74 20 63 6f 6d 6d  Best to put comm
0b30: 61 6e 64 20 69 6e 20 71 75 6f 74 65 73 0a 20 20  and in quotes.  
0b40: 2d 6c 6f 67 70 72 6f 20 66 69 6c 65 20 20 20 20  -logpro file    
0b50: 20 20 20 20 20 20 20 20 3a 20 77 69 74 68 20 2d          : with -
0b60: 65 78 65 63 20 61 70 70 6c 79 20 6c 6f 67 70 72  exec apply logpr
0b70: 6f 20 66 69 6c 65 20 74 6f 20 73 74 65 70 6e 61  o file to stepna
0b80: 6d 65 2e 6c 6f 67 2c 20 63 72 65 61 74 65 73 0a  me.log, creates.
0b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0ba0: 20 20 20 20 20 20 20 20 20 20 20 20 73 74 65 70              step
0bb0: 6e 61 6d 65 2e 68 74 6d 6c 20 61 6e 64 20 73 65  name.html and se
0bc0: 74 73 20 6c 6f 67 20 74 6f 20 73 61 6d 65 0a 20  ts log to same. 
0bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0be0: 20 20 20 20 20 20 20 20 20 20 20 49 66 20 75 73             If us
0bf0: 69 6e 67 20 6d 61 6b 65 20 75 73 65 20 73 74 65  ing make use ste
0c00: 70 6e 61 6d 65 5f 6c 6f 67 70 72 6f 2e 6c 6f 67  pname_logpro.log
0c10: 20 61 73 20 79 6f 75 72 20 74 61 72 67 65 74 0a   as your target.
0c20: 0a 43 61 6c 6c 65 64 20 61 73 20 22 20 28 73 74  .Called as " (st
0c30: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65  ring-intersperse
0c40: 20 28 61 72 67 76 29 20 22 20 22 29 29 29 0a 0a   (argv) " ")))..
0c50: 3b 3b 20 20 2d 67 75 69 20 20 20 20 20 20 20 20  ;;  -gui        
0c60: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 74              : st
0c70: 61 72 74 20 61 20 67 75 69 20 69 6e 74 65 72 66  art a gui interf
0c80: 61 63 65 0a 3b 3b 20 20 2d 63 6f 6e 66 69 67 20  ace.;;  -config 
0c90: 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 20 20  fname           
0ca0: 3a 20 6f 76 65 72 72 69 64 65 20 74 68 65 20 72  : override the r
0cb0: 75 6e 63 6f 6e 66 69 67 20 66 69 6c 65 20 77 69  unconfig file wi
0cc0: 74 68 20 66 6e 61 6d 65 0a 0a 3b 3b 20 70 72 6f  th fname..;; pro
0cd0: 63 65 73 73 20 61 72 67 73 0a 28 64 65 66 69 6e  cess args.(defin
0ce0: 65 20 72 65 6d 61 72 67 73 20 28 61 72 67 73 3a  e remargs (args:
0cf0: 67 65 74 2d 61 72 67 73 20 0a 09 09 20 28 61 72  get-args ... (ar
0d00: 67 76 29 0a 09 09 20 28 6c 69 73 74 20 20 22 2d  gv)... (list  "-
0d10: 72 75 6e 74 65 73 74 73 22 20 20 3b 3b 20 72 75  runtests"  ;; ru
0d20: 6e 20 61 20 73 70 65 63 69 66 69 63 20 74 65 73  n a specific tes
0d30: 74 0a 09 09 09 22 2d 63 6f 6e 66 69 67 22 20 20  t...."-config"  
0d40: 20 20 3b 3b 20 6f 76 65 72 72 69 64 65 20 74 68    ;; override th
0d50: 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e 61  e config file na
0d60: 6d 65 0a 09 09 09 22 2d 65 78 65 63 75 74 65 22  me...."-execute"
0d70: 20 20 20 3b 3b 20 72 75 6e 20 74 68 65 20 63 6f     ;; run the co
0d80: 6d 6d 61 6e 64 20 65 6e 63 6f 64 65 64 20 69 6e  mmand encoded in
0d90: 20 74 68 65 20 62 61 73 65 36 34 20 70 61 72 61   the base64 para
0da0: 6d 65 74 65 72 0a 09 09 09 22 2d 73 74 65 70 22  meter...."-step"
0db0: 0a 09 09 09 22 3a 72 75 6e 6e 61 6d 65 22 20 20  ....":runname"  
0dc0: 20 0a 09 09 09 22 3a 69 74 65 6d 22 0a 09 09 09   ....":item"....
0dd0: 22 3a 72 75 6e 6e 61 6d 65 22 20 20 20 0a 09 09  ":runname"   ...
0de0: 09 22 3a 73 74 61 74 65 22 20 20 0a 09 09 09 22  .":state"  ...."
0df0: 3a 73 74 61 74 75 73 22 0a 09 09 09 22 2d 6c 69  :status"...."-li
0e00: 73 74 2d 72 75 6e 73 22 0a 09 09 09 22 2d 74 65  st-runs"...."-te
0e10: 73 74 70 61 74 74 22 20 0a 09 09 09 22 2d 69 74  stpatt" ...."-it
0e20: 65 6d 70 61 74 74 22 0a 09 09 09 22 2d 73 65 74  empatt"...."-set
0e30: 6c 6f 67 22 0a 09 09 09 22 2d 73 65 74 2d 74 6f  log"...."-set-to
0e40: 70 6c 6f 67 22 0a 09 09 09 22 2d 72 75 6e 73 74  plog"...."-runst
0e50: 65 70 22 0a 09 09 09 22 2d 6c 6f 67 70 72 6f 22  ep"...."-logpro"
0e60: 0a 09 09 09 22 2d 6d 22 0a 09 09 09 22 2d 72 65  ...."-m"...."-re
0e70: 72 75 6e 22 0a 09 09 09 22 2d 64 65 62 75 67 22  run"...."-debug"
0e80: 20 3b 3b 20 66 6f 72 20 2a 76 65 72 62 6f 73 69   ;; for *verbosi
0e90: 74 79 2a 20 3e 20 32 0a 09 09 09 29 20 0a 09 09  ty* > 2....) ...
0ea0: 20 28 6c 69 73 74 20 20 22 2d 68 22 0a 09 09 20   (list  "-h"... 
0eb0: 20 20 20 20 20 20 20 22 2d 66 6f 72 63 65 22 0a         "-force".
0ec0: 09 09 20 20 20 20 20 20 20 20 22 2d 78 74 65 72  ..        "-xter
0ed0: 6d 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d 73  m"...        "-s
0ee0: 68 6f 77 6b 65 79 73 22 0a 09 09 20 20 20 20 20  howkeys"...     
0ef0: 20 20 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73     "-test-status
0f00: 22 0a 09 09 09 22 2d 73 75 6d 6d 61 72 69 7a 65  "...."-summarize
0f10: 2d 69 74 65 6d 73 22 0a 09 09 20 20 20 20 20 20  -items"...      
0f20: 20 20 22 2d 67 75 69 22 0a 09 09 09 22 2d 72 75    "-gui"...."-ru
0f30: 6e 61 6c 6c 22 20 20 20 20 3b 3b 20 72 75 6e 20  nall"    ;; run 
0f40: 61 6c 6c 20 74 65 73 74 73 0a 09 09 09 22 2d 72  all tests...."-r
0f50: 65 6d 6f 76 65 2d 72 75 6e 73 22 0a 09 09 09 22  emove-runs"...."
0f60: 2d 6b 65 65 70 67 6f 69 6e 67 22 0a 09 09 09 22  -keepgoing"...."
0f70: 2d 75 73 65 71 75 65 75 65 22 0a 09 09 09 22 2d  -usequeue"...."-
0f80: 72 65 62 75 69 6c 64 2d 64 62 22 0a 09 09 09 22  rebuild-db"...."
0f90: 2d 76 22 20 3b 3b 20 76 65 72 62 6f 73 65 20 32  -v" ;; verbose 2
0fa0: 2c 20 6d 6f 72 65 20 74 68 61 6e 20 6e 6f 72 6d  , more than norm
0fb0: 61 6c 20 28 6e 6f 72 6d 61 6c 20 69 73 20 31 29  al (normal is 1)
0fc0: 0a 09 09 09 22 2d 71 22 20 3b 3b 20 71 75 69 65  ...."-q" ;; quie
0fd0: 74 20 30 2c 20 65 72 72 6f 72 73 2f 77 61 72 6e  t 0, errors/warn
0fe0: 69 6e 67 73 20 6f 6e 6c 79 0a 09 09 20 20 20 20  ings only...    
0ff0: 20 20 20 29 0a 09 09 20 61 72 67 73 3a 61 72 67     )... args:arg
1000: 2d 68 61 73 68 0a 09 09 20 30 29 29 0a 0a 28 69  -hash... 0))..(i
1010: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20  f (args:get-arg 
1020: 22 2d 68 22 29 0a 20 20 20 20 28 62 65 67 69 6e  "-h").    (begin
1030: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 68 65  .      (print he
1040: 6c 70 29 0a 20 20 20 20 20 20 28 65 78 69 74 29  lp).      (exit)
1050: 29 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 6b 65  ))..(include "ke
1060: 79 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64  ys.scm").(includ
1070: 65 20 22 69 74 65 6d 73 2e 73 63 6d 22 29 0a 28  e "items.scm").(
1080: 69 6e 63 6c 75 64 65 20 22 64 62 2e 73 63 6d 22  include "db.scm"
1090: 29 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6e 66  ).(include "conf
10a0: 69 67 66 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75  igf.scm").(inclu
10b0: 64 65 20 22 70 72 6f 63 65 73 73 2e 73 63 6d 22  de "process.scm"
10c0: 29 0a 28 69 6e 63 6c 75 64 65 20 22 6c 61 75 6e  ).(include "laun
10d0: 63 68 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64  ch.scm").(includ
10e0: 65 20 22 72 75 6e 73 2e 73 63 6d 22 29 0a 28 69  e "runs.scm").(i
10f0: 6e 63 6c 75 64 65 20 22 72 75 6e 63 6f 6e 66 69  nclude "runconfi
1100: 67 2e 73 63 6d 22 29 0a 0a 28 64 65 66 69 6e 65  g.scm")..(define
1110: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20   *didsomething* 
1120: 23 66 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d  #f)..;;=========
1130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b  =============.;;
1170: 20 4d 69 73 63 20 73 65 74 75 70 20 73 74 75 66   Misc setup stuf
1180: 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  f.;;============
1190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
11a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
11b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
11c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 73 65 74  ==========..(set
11d0: 21 20 2a 76 65 72 62 6f 73 69 74 79 2a 20 28 63  ! *verbosity* (c
11e0: 6f 6e 64 0a 09 09 20 20 20 28 28 61 72 67 73 3a  ond...   ((args:
11f0: 67 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 22  get-arg "-debug"
1200: 29 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72  )(string->number
1210: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22   (args:get-arg "
1220: 2d 64 65 62 75 67 22 29 29 29 0a 09 09 20 20 20  -debug")))...   
1230: 28 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22  ((args:get-arg "
1240: 2d 76 22 29 20 20 20 20 32 29 0a 09 09 20 20 20  -v")    2)...   
1250: 28 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22  ((args:get-arg "
1260: 2d 71 22 29 20 20 20 20 30 29 0a 09 09 20 20 20  -q")    0)...   
1270: 28 65 6c 73 65 20 20 20 20 20 20 20 20 20 20 20  (else           
1280: 20 20 20 20 20 20 20 20 31 29 29 29 0a 0a 3b 3b          1)))..;;
1290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
12a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
12b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
12c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
12d0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 65 6d 6f 76 65  ======.;; Remove
12e0: 20 6f 6c 64 20 72 75 6e 28 73 29 0a 3b 3b 3d 3d   old run(s).;;==
12f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1330: 3d 3d 3d 3d 0a 0a 3b 3b 20 73 69 6e 63 65 20 73  ====..;; since s
1340: 65 76 65 72 61 6c 20 61 63 74 69 6f 6e 73 20 63  everal actions c
1350: 61 6e 20 62 65 20 73 70 65 63 69 66 69 65 64 20  an be specified 
1360: 6f 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 6c  on the command l
1370: 69 6e 65 20 74 68 65 20 72 65 6d 6f 76 61 6c 0a  ine the removal.
1380: 3b 3b 20 69 73 20 64 6f 6e 65 20 66 69 72 73 74  ;; is done first
1390: 0a 28 64 65 66 69 6e 65 20 28 72 65 6d 6f 76 65  .(define (remove
13a0: 2d 72 75 6e 73 29 0a 20 20 28 63 6f 6e 64 0a 20  -runs).  (cond. 
13b0: 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65    ((not (args:ge
13c0: 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22  t-arg ":runname"
13d0: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72  )).    (debug:pr
13e0: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4d 69  int 0 "ERROR: Mi
13f0: 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 70  ssing required p
1400: 61 72 61 6d 65 74 65 72 20 66 6f 72 20 2d 72 65  arameter for -re
1410: 6d 6f 76 65 2d 72 75 6e 73 2c 20 79 6f 75 20 6d  move-runs, you m
1420: 75 73 74 20 73 70 65 63 69 66 79 20 74 68 65 20  ust specify the 
1430: 72 75 6e 20 6e 61 6d 65 20 70 61 74 74 65 72 6e  run name pattern
1440: 20 77 69 74 68 20 3a 72 75 6e 6e 61 6d 65 20 70   with :runname p
1450: 61 74 74 22 29 0a 20 20 20 20 28 65 78 69 74 20  att").    (exit 
1460: 32 29 29 0a 20 20 20 28 28 6e 6f 74 20 28 61 72  2)).   ((not (ar
1470: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73  gs:get-arg "-tes
1480: 74 70 61 74 74 22 29 29 0a 20 20 20 20 28 64 65  tpatt")).    (de
1490: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52  bug:print 0 "ERR
14a0: 4f 52 3a 20 4d 69 73 73 69 6e 67 20 72 65 71 75  OR: Missing requ
14b0: 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 66  ired parameter f
14c0: 6f 72 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 2c  or -remove-runs,
14d0: 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66   you must specif
14e0: 79 20 74 68 65 20 74 65 73 74 20 70 61 74 74 65  y the test patte
14f0: 72 6e 20 77 69 74 68 20 2d 74 65 73 74 70 61 74  rn with -testpat
1500: 74 22 29 0a 20 20 20 20 28 65 78 69 74 20 33 29  t").    (exit 3)
1510: 29 0a 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73  ).   ((not (args
1520: 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70  :get-arg "-itemp
1530: 61 74 74 22 29 29 0a 20 20 20 20 28 70 72 69 6e  att")).    (prin
1540: 74 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 6e  t "ERROR: Missin
1550: 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d  g required param
1560: 65 74 65 72 20 66 6f 72 20 2d 72 65 6d 6f 76 65  eter for -remove
1570: 2d 72 75 6e 73 2c 20 79 6f 75 20 6d 75 73 74 20  -runs, you must 
1580: 73 70 65 63 69 66 79 20 74 68 65 20 69 74 65 6d  specify the item
1590: 73 20 77 69 74 68 20 2d 69 74 65 6d 70 61 74 74  s with -itempatt
15a0: 22 29 0a 20 20 20 20 28 65 78 69 74 20 34 29 29  ").    (exit 4))
15b0: 0a 20 20 20 28 28 6c 65 74 20 28 28 64 62 20 23  .   ((let ((db #
15c0: 66 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e  f)).      (if (n
15d0: 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75  ot (setup-for-ru
15e0: 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 20 0a 09  n))..  (begin ..
15f0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74      (debug:print
1600: 20 30 20 70 72 69 6e 74 20 22 46 61 69 6c 65 64   0 print "Failed
1610: 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69   to setup, exiti
1620: 6e 67 22 29 0a 09 20 20 20 20 28 65 78 69 74 20  ng")..    (exit 
1630: 31 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 21  1))).      (set!
1640: 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 20   db (open-db)). 
1650: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 63       (if (not (c
1660: 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29  ar *configinfo*)
1670: 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20  )..  (begin..   
1680: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20   (debug:print 0 
1690: 22 45 52 52 4f 52 3a 20 41 74 74 65 6d 70 74 65  "ERROR: Attempte
16a0: 64 20 74 6f 20 72 65 6d 6f 76 65 20 74 65 73 74  d to remove test
16b0: 28 73 29 20 62 75 74 20 72 75 6e 20 61 72 65 61  (s) but run area
16c0: 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e 6f 74   config file not
16d0: 20 66 6f 75 6e 64 22 29 0a 09 20 20 20 20 28 65   found")..    (e
16e0: 78 69 74 20 31 29 29 0a 09 20 20 3b 3b 20 70 75  xit 1))..  ;; pu
16f0: 74 20 74 65 73 74 20 70 61 72 61 6d 65 74 65 72  t test parameter
1700: 73 20 69 6e 74 6f 20 63 6f 6e 76 65 6e 69 65 6e  s into convenien
1710: 74 20 76 61 72 69 61 62 6c 65 73 0a 09 20 20 28  t variables..  (
1720: 72 75 6e 73 3a 72 65 6d 6f 76 65 2d 72 75 6e 73  runs:remove-runs
1730: 20 64 62 0a 09 09 09 20 20 20 20 28 61 72 67 73   db....    (args
1740: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61  :get-arg ":runna
1750: 6d 65 22 29 0a 09 09 09 20 20 20 20 28 61 72 67  me")....    (arg
1760: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74  s:get-arg "-test
1770: 70 61 74 74 22 29 0a 09 09 09 20 20 20 20 28 61  patt")....    (a
1780: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74  rgs:get-arg "-it
1790: 65 6d 70 61 74 74 22 29 29 29 0a 20 20 20 20 20  empatt"))).     
17a0: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69   (sqlite3:finali
17b0: 7a 65 21 20 64 62 29 0a 20 20 20 20 20 20 28 73  ze! db).      (s
17c0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e  et! *didsomethin
17d0: 67 2a 20 23 74 29 29 29 29 29 0a 09 20 20 0a 28  g* #t)))))..  .(
17e0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67  if (args:get-arg
17f0: 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29   "-remove-runs")
1800: 0a 20 20 20 20 28 72 65 6d 6f 76 65 2d 72 75 6e  .    (remove-run
1810: 73 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d  s))..;;=========
1820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b  =============.;;
1860: 20 51 75 65 72 79 20 72 75 6e 73 0a 3b 3b 3d 3d   Query runs.;;==
1870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
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 0a 0a 28 69 66 20 28 61 72 67 73 3a  ====..(if (args:
18c0: 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72  get-arg "-list-r
18d0: 75 6e 73 22 29 0a 20 20 20 20 28 6c 65 74 2a 20  uns").    (let* 
18e0: 28 28 64 62 20 20 20 20 20 20 20 28 62 65 67 69  ((db       (begi
18f0: 6e 0a 09 09 20 20 20 20 20 20 20 28 73 65 74 75  n...       (setu
1900: 70 2d 66 6f 72 2d 72 75 6e 29 0a 09 09 20 20 20  p-for-run)...   
1910: 20 20 20 20 28 6f 70 65 6e 2d 64 62 29 29 29 0a      (open-db))).
1920: 09 20 20 20 28 72 75 6e 70 61 74 74 20 20 28 61  .   (runpatt  (a
1930: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69  rgs:get-arg "-li
1940: 73 74 2d 72 75 6e 73 22 29 29 0a 09 20 20 20 28  st-runs"))..   (
1950: 74 65 73 74 70 61 74 74 20 28 61 72 67 73 3a 67  testpatt (args:g
1960: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74  et-arg "-testpat
1970: 74 22 29 29 0a 09 20 20 20 28 69 74 65 6d 70 61  t"))..   (itempa
1980: 74 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67  tt (args:get-arg
1990: 20 22 2d 69 74 65 6d 70 61 74 74 22 29 29 0a 09   "-itempatt"))..
19a0: 20 20 20 28 72 75 6e 73 64 61 74 20 20 28 64 62     (runsdat  (db
19b0: 2d 67 65 74 2d 72 75 6e 73 20 64 62 20 72 75 6e  -get-runs db run
19c0: 70 61 74 74 29 29 0a 09 20 20 20 28 72 75 6e 73  patt))..   (runs
19d0: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f 77       (db:get-row
19e0: 73 20 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20  s runsdat))..   
19f0: 28 68 65 61 64 65 72 20 20 20 28 64 62 3a 67 65  (header   (db:ge
1a00: 74 2d 68 65 61 64 65 72 20 72 75 6e 73 64 61 74  t-header runsdat
1a10: 29 29 0a 09 20 20 20 28 6b 65 79 73 20 20 20 20  ))..   (keys    
1a20: 20 28 64 62 2d 67 65 74 2d 6b 65 79 73 20 64 62   (db-get-keys db
1a30: 29 29 0a 09 20 20 20 28 6b 65 79 6e 61 6d 65 73  ))..   (keynames
1a40: 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 69   (map key:get-fi
1a50: 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 29 0a  eldname keys))).
1a60: 20 20 20 20 20 20 3b 3b 20 45 61 63 68 20 72 75        ;; Each ru
1a70: 6e 0a 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63  n.      (for-eac
1a80: 68 20 0a 20 20 20 20 20 20 20 28 6c 61 6d 62 64  h .       (lambd
1a90: 61 20 28 72 75 6e 29 0a 09 20 28 64 65 62 75 67  a (run).. (debug
1aa0: 3a 70 72 69 6e 74 20 32 20 22 52 75 6e 3a 20 22  :print 2 "Run: "
1ab0: 0a 09 09 28 73 74 72 69 6e 67 2d 69 6e 74 65 72  ...(string-inter
1ac0: 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d  sperse (map (lam
1ad0: 62 64 61 20 28 78 29 0a 09 09 09 09 09 20 20 20  bda (x)......   
1ae0: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79  (db:get-value-by
1af0: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64  -header run head
1b00: 65 72 20 78 29 29 0a 09 09 09 09 09 20 6b 65 79  er x))...... key
1b10: 6e 61 6d 65 73 29 20 22 2f 22 29 0a 09 09 22 2f  names) "/")..."/
1b20: 22 0a 09 09 28 64 62 3a 67 65 74 2d 76 61 6c 75  "...(db:get-valu
1b30: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20  e-by-header run 
1b40: 68 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 22  header "runname"
1b50: 29 29 0a 09 20 28 6c 65 74 20 28 28 72 75 6e 2d  )).. (let ((run-
1b60: 69 64 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65  id (db:get-value
1b70: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68  -by-header run h
1b80: 65 61 64 65 72 20 22 69 64 22 29 29 29 0a 09 20  eader "id"))).. 
1b90: 20 20 28 6c 65 74 20 28 28 74 65 73 74 73 20 28    (let ((tests (
1ba0: 64 62 2d 67 65 74 2d 74 65 73 74 73 2d 66 6f 72  db-get-tests-for
1bb0: 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 20 74  -run db run-id t
1bc0: 65 73 74 70 61 74 74 20 69 74 65 6d 70 61 74 74  estpatt itempatt
1bd0: 29 29 29 0a 09 20 20 20 20 20 3b 3b 20 45 61 63  )))..     ;; Eac
1be0: 68 20 74 65 73 74 0a 09 20 20 20 20 20 28 66 6f  h test..     (fo
1bf0: 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 20 28  r-each ..      (
1c00: 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09  lambda (test)...
1c10: 28 66 6f 72 6d 61 74 20 23 74 0a 09 09 09 22 20  (format #t...." 
1c20: 20 54 65 73 74 3a 20 7e 32 35 61 20 53 74 61 74   Test: ~25a Stat
1c30: 65 3a 20 7e 31 35 61 20 53 74 61 74 75 73 3a 20  e: ~15a Status: 
1c40: 7e 31 35 61 20 52 75 6e 74 69 6d 65 3a 20 7e 35  ~15a Runtime: ~5
1c50: 40 61 73 20 54 69 6d 65 3a 20 7e 32 32 61 20 48  @as Time: ~22a H
1c60: 6f 73 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 09  ost: ~10a\n"....
1c70: 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67  (conc (db:test-g
1c80: 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74  et-testname test
1c90: 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28  )....      (if (
1ca0: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d  equal? (db:test-
1cb0: 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65  get-item-path te
1cc0: 73 74 29 20 22 22 29 0a 09 09 09 09 20 20 22 22  st) "").....  ""
1cd0: 20 0a 09 09 09 09 20 20 28 63 6f 6e 63 20 22 28   .....  (conc "(
1ce0: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69  " (db:test-get-i
1cf0: 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 20 22  tem-path test) "
1d00: 29 22 29 29 29 0a 09 09 09 28 64 62 3a 74 65 73  )")))....(db:tes
1d10: 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74  t-get-state test
1d20: 29 0a 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65  )....(db:test-ge
1d30: 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 0a 09  t-status test)..
1d40: 09 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72  ..(db:test-get-r
1d50: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74  un_duration test
1d60: 29 0a 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65  )....(db:test-ge
1d70: 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73  t-event_time tes
1d80: 74 29 0a 09 09 09 28 64 62 3a 74 65 73 74 2d 67  t)....(db:test-g
1d90: 65 74 2d 68 6f 73 74 20 74 65 73 74 29 29 0a 20  et-host test)). 
1da0: 09 09 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28  ..(if (not (or (
1db0: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d  equal? (db:test-
1dc0: 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 29  get-status test)
1dd0: 20 22 50 41 53 53 22 29 0a 09 09 09 20 20 20 20   "PASS")....    
1de0: 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73   (equal? (db:tes
1df0: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73  t-get-status tes
1e00: 74 29 20 22 57 41 52 4e 22 29 0a 09 09 09 20 20  t) "WARN")....  
1e10: 20 20 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74     (equal? (db:t
1e20: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65  est-get-state te
1e30: 73 74 29 20 20 22 4e 4f 54 5f 53 54 41 52 54 45  st)  "NOT_STARTE
1e40: 44 22 29 29 29 0a 09 09 20 20 20 20 28 62 65 67  D")))...    (beg
1e50: 69 6e 0a 09 09 20 20 20 20 20 20 28 70 72 69 6e  in...      (prin
1e60: 74 20 22 20 20 20 20 20 20 20 20 20 63 70 75 6c  t "         cpul
1e70: 6f 61 64 3a 20 20 22 20 28 64 62 3a 74 65 73 74  oad:  " (db:test
1e80: 2d 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 73  -get-cpuload tes
1e90: 74 29 0a 09 09 09 20 20 20 20 20 22 5c 6e 20 20  t)....     "\n  
1ea0: 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 3a         diskfree:
1eb0: 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d   " (db:test-get-
1ec0: 64 69 73 6b 66 72 65 65 20 74 65 73 74 29 0a 09  diskfree test)..
1ed0: 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 20  ..     "\n      
1ee0: 20 20 20 75 6e 61 6d 65 3a 20 20 20 20 22 20 28     uname:    " (
1ef0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 75 6e 61 6d  db:test-get-unam
1f00: 65 20 74 65 73 74 29 0a 09 09 09 20 20 20 20 20  e test)....     
1f10: 22 5c 6e 20 20 20 20 20 20 20 20 20 72 75 6e 64  "\n         rund
1f20: 69 72 3a 20 20 20 22 20 28 64 62 3a 74 65 73 74  ir:   " (db:test
1f30: 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74  -get-rundir test
1f40: 29 0a 09 09 09 20 20 20 20 20 29 0a 09 09 20 20  )....     )...  
1f50: 20 20 20 20 3b 3b 20 45 61 63 68 20 74 65 73 74      ;; Each test
1f60: 0a 09 09 20 20 20 20 20 20 28 6c 65 74 20 28 28  ...      (let ((
1f70: 73 74 65 70 73 20 28 64 62 2d 67 65 74 2d 74 65  steps (db-get-te
1f80: 73 74 2d 73 74 65 70 73 2d 66 6f 72 2d 72 75 6e  st-steps-for-run
1f90: 20 64 62 20 28 64 62 3a 74 65 73 74 2d 67 65 74   db (db:test-get
1fa0: 2d 69 64 20 74 65 73 74 29 29 29 29 0a 09 09 09  -id test))))....
1fb0: 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 28  (for-each .... (
1fc0: 6c 61 6d 62 64 61 20 28 73 74 65 70 29 0a 09 09  lambda (step)...
1fd0: 09 20 20 20 28 66 6f 72 6d 61 74 20 23 74 20 0a  .   (format #t .
1fe0: 09 09 09 09 20 20 20 22 20 20 20 20 53 74 65 70  ....   "    Step
1ff0: 3a 20 7e 32 30 61 20 53 74 61 74 65 3a 20 7e 31  : ~20a State: ~1
2000: 30 61 20 53 74 61 74 75 73 3a 20 7e 31 30 61 20  0a Status: ~10a 
2010: 54 69 6d 65 20 7e 32 32 61 5c 6e 22 0a 09 09 09  Time ~22a\n"....
2020: 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74  .   (db:step-get
2030: 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 70 29 0a  -stepname step).
2040: 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 2d  ....   (db:step-
2050: 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a  get-state step).
2060: 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 2d  ....   (db:step-
2070: 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 70 29  get-status step)
2080: 0a 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 70  .....   (db:step
2090: 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20  -get-event_time 
20a0: 73 74 65 70 29 29 29 0a 09 09 09 20 73 74 65 70  step))).... step
20b0: 73 29 29 29 29 29 0a 09 09 74 65 73 74 73 29 29  s)))))...tests))
20c0: 29 29 0a 20 20 20 20 20 20 20 72 75 6e 73 29 0a  )).       runs).
20d0: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64        (set! *did
20e0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 20  something* #t). 
20f0: 20 20 20 20 20 29 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d  ================
2130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2140: 3d 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e 0a 3b 3b  =.;; full run.;;
2150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2190: 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 20 6c  ======..;; get l
21a0: 6f 63 6b 20 69 6e 20 64 62 20 66 6f 72 20 66 75  ock in db for fu
21b0: 6c 6c 20 72 75 6e 20 66 6f 72 20 74 68 69 73 20  ll run for this 
21c0: 64 69 72 65 63 74 6f 72 79 0a 3b 3b 20 66 6f 72  directory.;; for
21d0: 20 61 6c 6c 20 74 65 73 74 73 20 77 69 74 68 20   all tests with 
21e0: 64 65 70 73 0a 3b 3b 20 20 20 77 61 6c 6b 20 74  deps.;;   walk t
21f0: 72 65 65 20 6f 66 20 74 65 73 74 73 20 74 6f 20  ree of tests to 
2200: 66 69 6e 64 20 68 65 61 64 20 74 61 73 6b 73 0a  find head tasks.
2210: 3b 3b 20 20 20 61 64 64 20 68 65 61 64 20 74 61  ;;   add head ta
2220: 73 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75  sks to task queu
2230: 65 0a 3b 3b 20 20 20 61 64 64 20 64 65 70 65 6e  e.;;   add depen
2240: 64 61 6e 74 20 74 61 73 6b 73 20 74 6f 20 74 61  dant tasks to ta
2250: 73 6b 20 71 75 65 75 65 20 0a 3b 3b 20 20 20 61  sk queue .;;   a
2260: 64 64 20 72 65 6d 61 69 6e 69 6e 67 20 74 61 73  dd remaining tas
2270: 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65  ks to task queue
2280: 0a 3b 3b 20 66 6f 72 20 65 61 63 68 20 74 61 73  .;; for each tas
2290: 6b 20 69 6e 20 74 61 73 6b 20 71 75 65 75 65 0a  k in task queue.
22a0: 3b 3b 20 20 20 69 66 20 68 61 76 65 20 61 64 65  ;;   if have ade
22b0: 71 75 61 74 65 20 72 65 73 6f 75 72 63 65 73 0a  quate resources.
22c0: 3b 3b 20 20 20 20 20 6c 61 75 6e 63 68 20 74 61  ;;     launch ta
22d0: 73 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b 20  sk.;;   else.;; 
22e0: 20 20 20 20 70 75 74 20 74 61 73 6b 20 69 6e 20      put task in 
22f0: 64 65 66 65 72 72 65 64 20 71 75 65 75 65 0a 3b  deferred queue.;
2300: 3b 20 69 66 20 73 74 69 6c 6c 20 6f 6b 20 74 6f  ; if still ok to
2310: 20 72 75 6e 20 74 61 73 6b 73 0a 3b 3b 20 20 20   run tasks.;;   
2320: 70 72 6f 63 65 73 73 20 64 65 66 65 72 72 65 64  process deferred
2330: 20 74 61 73 6b 73 20 70 65 72 20 61 62 6f 76 65   tasks per above
2340: 20 73 74 65 70 73 0a 0a 3b 3b 20 72 75 6e 20 61   steps..;; run a
2350: 6c 6c 20 74 65 73 74 73 20 61 72 65 20 61 72 65  ll tests are are
2360: 20 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 44 20 61   Not COMPLETED a
2370: 6e 64 20 50 41 53 53 20 6f 72 20 43 48 45 43 4b  nd PASS or CHECK
2380: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61  .(if (args:get-a
2390: 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 0a 20 20  rg "-runall").  
23a0: 20 20 28 69 66 20 28 6e 6f 74 20 28 61 72 67 73    (if (not (args
23b0: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61  :get-arg ":runna
23c0: 6d 65 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 20  me"))..(begin.. 
23d0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20   (debug:print 0 
23e0: 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 20  "ERROR: Missing 
23f0: 72 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 74  required paramet
2400: 65 72 20 66 6f 72 20 2d 72 75 6e 74 65 73 74 73  er for -runtests
2410: 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 69  , you must speci
2420: 66 79 20 74 68 65 20 72 75 6e 20 6e 61 6d 65 20  fy the run name 
2430: 77 69 74 68 20 3a 72 75 6e 6e 61 6d 65 20 72 75  with :runname ru
2440: 6e 6e 61 6d 65 22 29 0a 09 20 20 28 65 78 69 74  nname")..  (exit
2450: 20 32 29 29 0a 09 28 6c 65 74 2a 20 28 28 64 62   2))..(let* ((db
2460: 20 20 20 20 20 20 28 69 66 20 28 73 65 74 75 70        (if (setup
2470: 2d 66 6f 72 2d 72 75 6e 29 0a 09 09 09 20 20 20  -for-run)....   
2480: 20 28 6f 70 65 6e 2d 64 62 29 0a 09 09 09 20 20   (open-db)....  
2490: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20    (begin....    
24a0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30    (debug:print 0
24b0: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75   "Failed to setu
24c0: 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 09  p, exiting")....
24d0: 20 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29        (exit 1)))
24e0: 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28  ))..  (if (not (
24f0: 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a  car *configinfo*
2500: 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e  ))..      (begin
2510: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20  ...(debug:print 
2520: 30 20 22 45 52 52 4f 52 3a 20 41 74 74 65 6d 70  0 "ERROR: Attemp
2530: 74 65 64 20 74 6f 20 72 75 6e 20 61 20 74 65 73  ted to run a tes
2540: 74 20 62 75 74 20 72 75 6e 20 61 72 65 61 20 63  t but run area c
2550: 6f 6e 66 69 67 20 66 69 6c 65 20 6e 6f 74 20 66  onfig file not f
2560: 6f 75 6e 64 22 29 0a 09 09 28 65 78 69 74 20 31  ound")...(exit 1
2570: 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 70 75 74  ))..      ;; put
2580: 20 74 65 73 74 20 70 61 72 61 6d 65 74 65 72 73   test parameters
2590: 20 69 6e 74 6f 20 63 6f 6e 76 65 6e 69 65 6e 74   into convenient
25a0: 20 76 61 72 69 61 62 6c 65 73 0a 09 20 20 20 20   variables..    
25b0: 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 6e    (let* ((test-n
25c0: 61 6d 65 73 20 28 67 65 74 2d 61 6c 6c 2d 6c 65  ames (get-all-le
25d0: 67 61 6c 2d 74 65 73 74 73 29 29 29 20 3b 3b 20  gal-tests))) ;; 
25e0: 22 50 52 4f 44 22 20 69 73 20 69 67 6e 6f 72 65  "PROD" is ignore
25f0: 64 20 66 6f 72 20 6e 6f 77 0a 09 09 28 64 65 62  d for now...(deb
2600: 75 67 3a 70 72 69 6e 74 20 31 20 22 49 4e 46 4f  ug:print 1 "INFO
2610: 3a 20 41 74 74 65 6d 70 74 69 6e 67 20 74 6f 20  : Attempting to 
2620: 73 74 61 72 74 20 74 68 65 20 66 6f 6c 6c 6f 77  start the follow
2630: 69 6e 67 20 74 65 73 74 73 2e 2e 2e 22 29 0a 09  ing tests...")..
2640: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20  .(debug:print 1 
2650: 22 20 20 20 20 20 22 20 28 73 74 72 69 6e 67 2d  "     " (string-
2660: 69 6e 74 65 72 73 70 65 72 73 65 20 74 65 73 74  intersperse test
2670: 2d 6e 61 6d 65 73 20 22 2c 22 29 29 0a 09 09 28  -names ","))...(
2680: 72 75 6e 2d 74 65 73 74 73 20 64 62 20 74 65 73  run-tests db tes
2690: 74 2d 6e 61 6d 65 73 29 29 29 0a 09 20 20 3b 3b  t-names)))..  ;;
26a0: 20 28 72 75 6e 2d 77 61 69 74 69 6e 67 2d 74 65   (run-waiting-te
26b0: 73 74 73 20 64 62 29 0a 09 20 20 28 73 71 6c 69  sts db)..  (sqli
26c0: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62  te3:finalize! db
26d0: 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 73  )..  (set! *dids
26e0: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29  omething* #t))))
26f0: 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75  ==========.;; ru
2740: 6e 20 6f 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d 3d  n one test.;;===
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 3d 3d 3d 3d 3d 3d  ================
2790: 3d 3d 3d 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 20  ===..;; 1. find 
27a0: 74 68 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a  the config file.
27b0: 3b 3b 20 32 2e 20 63 68 61 6e 67 65 20 74 6f 20  ;; 2. change to 
27c0: 74 68 65 20 74 65 73 74 20 64 69 72 65 63 74 6f  the test directo
27d0: 72 79 0a 3b 3b 20 33 2e 20 75 70 64 61 74 65 20  ry.;; 3. update 
27e0: 74 68 65 20 64 62 20 77 69 74 68 20 22 74 65 73  the db with "tes
27f0: 74 20 73 74 61 72 74 65 64 22 20 73 74 61 74 75  t started" statu
2800: 73 2c 20 73 65 74 20 72 75 6e 6e 69 6e 67 20 68  s, set running h
2810: 6f 73 74 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 73  ost.;; 4. proces
2820: 73 20 6c 61 75 6e 63 68 20 74 68 65 20 74 65 73  s launch the tes
2830: 74 0a 3b 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 6f  t.;;    - monito
2840: 72 20 74 68 65 20 70 72 6f 63 65 73 73 2c 20 75  r the process, u
2850: 70 64 61 74 65 20 73 74 61 74 73 20 69 6e 20 74  pdate stats in t
2860: 68 65 20 64 62 20 65 76 65 72 79 20 32 5e 6e 20  he db every 2^n 
2870: 6d 69 6e 75 74 65 73 0a 3b 3b 20 35 2e 20 61 73  minutes.;; 5. as
2880: 20 74 68 65 20 74 65 73 74 20 70 72 6f 63 65 65   the test procee
2890: 64 73 20 69 6e 74 65 72 6e 61 6c 6c 79 20 69 74  ds internally it
28a0: 20 63 61 6c 6c 73 20 6d 65 67 61 74 65 73 74 20   calls megatest 
28b0: 61 73 20 65 61 63 68 20 73 74 65 70 20 69 73 0a  as each step is.
28c0: 3b 3b 20 20 20 20 73 74 61 72 74 65 64 20 61 6e  ;;    started an
28d0: 64 20 63 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 20  d completed.;;  
28e0: 20 20 2d 20 73 74 65 70 20 73 74 61 72 74 65 64    - step started
28f0: 2c 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 20  , timestamp.;;  
2900: 20 20 2d 20 73 74 65 70 20 63 6f 6d 70 6c 65 74    - step complet
2910: 65 64 2c 20 65 78 69 74 20 73 74 61 74 75 73 2c  ed, exit status,
2920: 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 2e   timestamp.;; 6.
2930: 20 74 65 73 74 20 70 68 6f 6e 65 20 68 6f 6d 65   test phone home
2940: 0a 3b 3b 20 20 20 20 2d 20 69 66 20 74 65 73 74  .;;    - if test
2950: 20 72 75 6e 20 74 69 6d 65 20 3e 20 61 6c 6c 6f   run time > allo
2960: 77 65 64 20 72 75 6e 20 74 69 6d 65 20 74 68 65  wed run time the
2970: 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 20  n kill job.;;   
2980: 20 2d 20 69 66 20 63 61 6e 6e 6f 74 20 61 63 63   - if cannot acc
2990: 65 73 73 20 64 62 20 3e 20 61 6c 6c 6f 77 65 64  ess db > allowed
29a0: 20 64 69 73 63 6f 6e 6e 65 63 74 20 74 69 6d 65   disconnect time
29b0: 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 0a   then kill job..
29c0: 28 64 65 66 69 6e 65 20 28 72 75 6e 74 65 73 74  (define (runtest
29d0: 73 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 61  s).  (if (not (a
29e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75  rgs:get-arg ":ru
29f0: 6e 6e 61 6d 65 22 29 29 0a 20 20 20 20 20 20 28  nname")).      (
2a00: 62 65 67 69 6e 0a 09 28 64 65 62 75 67 3a 70 72  begin..(debug:pr
2a10: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4d 69  int 0 "ERROR: Mi
2a20: 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 70  ssing required p
2a30: 61 72 61 6d 65 74 65 72 20 66 6f 72 20 2d 72 75  arameter for -ru
2a40: 6e 74 65 73 74 73 2c 20 79 6f 75 20 6d 75 73 74  ntests, you must
2a50: 20 73 70 65 63 69 66 79 20 74 68 65 20 72 75 6e   specify the run
2a60: 20 6e 61 6d 65 20 77 69 74 68 20 3a 72 75 6e 6e   name with :runn
2a70: 61 6d 65 20 72 75 6e 6e 61 6d 65 22 29 0a 09 28  ame runname")..(
2a80: 65 78 69 74 20 32 29 29 0a 20 20 20 20 20 20 28  exit 2)).      (
2a90: 6c 65 74 20 28 28 64 62 20 23 66 29 29 0a 09 28  let ((db #f))..(
2aa0: 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66  if (not (setup-f
2ab0: 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 28 62  or-run))..    (b
2ac0: 65 67 69 6e 20 0a 09 20 20 20 20 20 20 28 64 65  egin ..      (de
2ad0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69  bug:print 0 "Fai
2ae0: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78  led to setup, ex
2af0: 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 20 28  iting")..      (
2b00: 65 78 69 74 20 31 29 29 29 0a 09 28 73 65 74 21  exit 1)))..(set!
2b10: 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09   db (open-db))..
2b20: 28 69 66 20 28 6e 6f 74 20 28 63 61 72 20 2a 63  (if (not (car *c
2b30: 6f 6e 66 69 67 69 6e 66 6f 2a 29 29 0a 09 20 20  onfiginfo*))..  
2b40: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20    (begin..      
2b50: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22  (debug:print 0 "
2b60: 45 52 52 4f 52 3a 20 41 74 74 65 6d 70 74 65 64  ERROR: Attempted
2b70: 20 74 6f 20 72 75 6e 20 61 20 74 65 73 74 20 62   to run a test b
2b80: 75 74 20 72 75 6e 20 61 72 65 61 20 63 6f 6e 66  ut run area conf
2b90: 69 67 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e  ig file not foun
2ba0: 64 22 29 0a 09 20 20 20 20 20 20 28 65 78 69 74  d")..      (exit
2bb0: 20 31 29 29 0a 09 20 20 20 20 3b 3b 20 70 75 74   1))..    ;; put
2bc0: 20 74 65 73 74 20 70 61 72 61 6d 65 74 65 72 73   test parameters
2bd0: 20 69 6e 74 6f 20 63 6f 6e 76 65 6e 69 65 6e 74   into convenient
2be0: 20 76 61 72 69 61 62 6c 65 73 0a 09 20 20 20 20   variables..    
2bf0: 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 6e 61 6d  (let* ((test-nam
2c00: 65 73 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c  es   (string-spl
2c10: 69 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67  it (args:get-arg
2c20: 20 22 2d 72 75 6e 74 65 73 74 73 22 29 20 22 2c   "-runtests") ",
2c30: 22 29 29 29 0a 09 20 20 20 20 20 20 28 72 75 6e  ")))..      (run
2c40: 2d 74 65 73 74 73 20 64 62 20 74 65 73 74 2d 6e  -tests db test-n
2c50: 61 6d 65 73 29 29 29 0a 09 3b 3b 20 72 75 6e 2d  ames)))..;; run-
2c60: 77 61 69 74 69 6e 67 2d 74 65 73 74 73 20 64 62  waiting-tests db
2c70: 29 0a 09 28 73 71 6c 69 74 65 33 3a 66 69 6e 61  )..(sqlite3:fina
2c80: 6c 69 7a 65 21 20 64 62 29 0a 09 3b 3b 20 28 72  lize! db)..;; (r
2c90: 75 6e 2d 77 61 69 74 69 6e 67 2d 74 65 73 74 73  un-waiting-tests
2ca0: 20 23 66 29 0a 09 28 73 65 74 21 20 2a 64 69 64   #f)..(set! *did
2cb0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29  something* #t)))
2cc0: 29 0a 09 20 20 0a 28 69 66 20 28 61 72 67 73 3a  )..  .(if (args:
2cd0: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73  get-arg "-runtes
2ce0: 74 73 22 29 0a 20 20 20 20 28 72 75 6e 74 65 73  ts").    (runtes
2cf0: 74 73 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d  ts))..;;========
2d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b  ==============.;
2d40: 3b 20 65 78 65 63 75 74 65 20 74 68 65 20 74 65  ; execute the te
2d50: 73 74 0a 3b 3b 20 20 20 20 2d 20 67 65 74 73 20  st.;;    - gets 
2d60: 63 61 6c 6c 65 64 20 6f 6e 20 72 65 6d 6f 74 65  called on remote
2d70: 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 72 65   host.;;    - re
2d80: 63 65 69 76 65 73 20 69 6e 66 6f 20 66 72 6f 6d  ceives info from
2d90: 20 74 68 65 20 2d 65 78 65 63 75 74 65 20 70 61   the -execute pa
2da0: 72 61 6d 0a 3b 3b 20 20 20 20 2d 20 70 61 73 73  ram.;;    - pass
2db0: 65 73 20 69 6e 66 6f 20 74 6f 20 73 74 65 70 73  es info to steps
2dc0: 20 76 69 61 20 4d 54 5f 43 4d 44 49 4e 46 4f 20   via MT_CMDINFO 
2dd0: 65 6e 76 20 76 61 72 20 28 66 75 74 75 72 65 20  env var (future 
2de0: 69 73 20 74 6f 20 75 73 65 20 61 20 64 6f 74 20  is to use a dot 
2df0: 66 69 6c 65 29 0a 3b 3b 20 20 20 20 2d 20 67 61  file).;;    - ga
2e00: 74 68 65 72 73 20 68 6f 73 74 20 69 6e 66 6f 20  thers host info 
2e10: 61 6e 64 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d  and .;;=========
2e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28  =============..(
2e60: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67  if (args:get-arg
2e70: 20 22 2d 65 78 65 63 75 74 65 22 29 0a 20 20 20   "-execute").   
2e80: 20 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e 66 6f   (let* ((cmdinfo
2e90: 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69     (read (open-i
2ea0: 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73  nput-string (bas
2eb0: 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64  e64:base64-decod
2ec0: 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20  e (args:get-arg 
2ed0: 22 2d 65 78 65 63 75 74 65 22 29 29 29 29 29 29  "-execute"))))))
2ee0: 0a 20 20 20 20 20 20 28 73 65 74 65 6e 76 20 22  .      (setenv "
2ef0: 4d 54 5f 43 4d 44 49 4e 46 4f 22 20 28 61 72 67  MT_CMDINFO" (arg
2f00: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63  s:get-arg "-exec
2f10: 75 74 65 22 29 29 0a 20 20 20 20 20 20 28 69 66  ute")).      (if
2f20: 20 28 6c 69 73 74 3f 20 63 6d 64 69 6e 66 6f 29   (list? cmdinfo)
2f30: 20 3b 3b 20 28 28 74 65 73 74 70 61 74 68 20 2f   ;; ((testpath /
2f40: 74 6d 70 2f 6d 72 77 65 6c 6c 61 6e 2f 6a 61 7a  tmp/mrwellan/jaz
2f50: 7a 6d 69 6e 64 2f 73 72 63 2f 65 78 61 6d 70 6c  zmind/src/exampl
2f60: 65 5f 72 75 6e 2f 74 65 73 74 73 2f 73 71 6c 69  e_run/tests/sqli
2f70: 74 65 73 70 65 65 64 29 20 28 74 65 73 74 2d 6e  tespeed) (test-n
2f80: 61 6d 65 20 73 71 6c 69 74 65 73 70 65 65 64 29  ame sqlitespeed)
2f90: 20 28 72 75 6e 73 63 72 69 70 74 20 72 75 6e 73   (runscript runs
2fa0: 63 72 69 70 74 2e 72 62 29 20 28 64 62 2d 68 6f  cript.rb) (db-ho
2fb0: 73 74 20 6c 6f 63 61 6c 68 6f 73 74 29 20 28 72  st localhost) (r
2fc0: 75 6e 2d 69 64 20 31 29 29 0a 09 20 20 28 6c 65  un-id 1))..  (le
2fd0: 74 2a 20 28 28 74 65 73 74 70 61 74 68 20 20 28  t* ((testpath  (
2fe0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74  assoc/default 't
2ff0: 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f  estpath  cmdinfo
3000: 29 29 0a 09 09 20 28 77 6f 72 6b 2d 61 72 65 61  ))... (work-area
3010: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20   (assoc/default 
3020: 27 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e  'work-area cmdin
3030: 66 6f 29 29 0a 09 09 20 28 74 65 73 74 2d 6e 61  fo))... (test-na
3040: 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c  me (assoc/defaul
3050: 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64  t 'test-name cmd
3060: 69 6e 66 6f 29 29 0a 09 09 20 28 72 75 6e 73 63  info))... (runsc
3070: 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61  ript (assoc/defa
3080: 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 63  ult 'runscript c
3090: 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 64 62 2d  mdinfo))... (db-
30a0: 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65  host   (assoc/de
30b0: 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20  fault 'db-host  
30c0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20 28 72   cmdinfo))... (r
30d0: 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f  un-id    (assoc/
30e0: 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20  default 'run-id 
30f0: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 09 20     cmdinfo))... 
3100: 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f  (itemdat   (asso
3110: 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64  c/default 'itemd
3120: 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09  at   cmdinfo))..
3130: 09 20 28 65 6e 76 2d 6f 76 72 64 20 20 28 61 73  . (env-ovrd  (as
3140: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 6e 76  soc/default 'env
3150: 2d 6f 76 72 64 20 20 63 6d 64 69 6e 66 6f 29 29  -ovrd  cmdinfo))
3160: 0a 09 09 20 28 72 75 6e 6e 61 6d 65 20 20 20 28  ... (runname   (
3170: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72  assoc/default 'r
3180: 75 6e 6e 61 6d 65 20 20 20 63 6d 64 69 6e 66 6f  unname   cmdinfo
3190: 29 29 0a 09 09 20 28 6d 65 67 61 74 65 73 74 20  ))... (megatest 
31a0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20   (assoc/default 
31b0: 27 6d 65 67 61 74 65 73 74 20 20 63 6d 64 69 6e  'megatest  cmdin
31c0: 66 6f 29 29 0a 09 09 20 28 6d 74 2d 62 69 6e 64  fo))... (mt-bind
31d0: 69 72 2d 70 61 74 68 20 28 61 73 73 6f 63 2f 64  ir-path (assoc/d
31e0: 65 66 61 75 6c 74 20 27 6d 74 2d 62 69 6e 64 69  efault 'mt-bindi
31f0: 72 2d 70 61 74 68 20 63 6d 64 69 6e 66 6f 29 29  r-path cmdinfo))
3200: 0a 09 09 20 28 66 75 6c 6c 72 75 6e 73 63 72 69  ... (fullrunscri
3210: 70 74 20 28 63 6f 6e 63 20 74 65 73 74 70 61 74  pt (conc testpat
3220: 68 20 22 2f 22 20 72 75 6e 73 63 72 69 70 74 29  h "/" runscript)
3230: 29 0a 09 09 20 28 64 62 20 20 20 20 20 20 20 20  )... (db        
3240: 23 66 29 29 0a 09 20 20 20 20 28 64 65 62 75 67  #f))..    (debug
3250: 3a 70 72 69 6e 74 20 32 20 22 45 78 65 63 74 75  :print 2 "Exectu
3260: 69 6e 67 20 22 20 74 65 73 74 2d 6e 61 6d 65 20  ing " test-name 
3270: 22 20 6f 6e 20 22 20 28 67 65 74 2d 68 6f 73 74  " on " (get-host
3280: 2d 6e 61 6d 65 29 29 0a 09 20 20 20 20 28 63 68  -name))..    (ch
3290: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74  ange-directory t
32a0: 65 73 74 70 61 74 68 29 0a 09 20 20 20 20 28 73  estpath)..    (s
32b0: 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 5f 52  etenv "MT_TEST_R
32c0: 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 65  UN_DIR" work-are
32d0: 61 29 0a 09 20 20 20 20 28 73 65 74 65 6e 76 20  a)..    (setenv 
32e0: 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74  "MT_TEST_NAME" t
32f0: 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 20 20 28  est-name)..    (
3300: 73 65 74 65 6e 76 20 22 4d 54 5f 49 54 45 4d 5f  setenv "MT_ITEM_
3310: 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d  INFO" (conc item
3320: 64 61 74 29 29 0a 09 20 20 20 20 28 73 65 74 65  dat))..    (sete
3330: 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20  nv "MT_RUNNAME" 
3340: 20 20 72 75 6e 6e 61 6d 65 29 0a 09 20 20 20 20    runname)..    
3350: 28 73 65 74 65 6e 76 20 22 4d 54 5f 4d 45 47 41  (setenv "MT_MEGA
3360: 54 45 53 54 22 20 20 6d 65 67 61 74 65 73 74 29  TEST"  megatest)
3370: 0a 09 20 20 20 20 28 73 65 74 65 6e 76 20 22 50  ..    (setenv "P
3380: 41 54 48 22 20 28 63 6f 6e 63 20 28 67 65 74 65  ATH" (conc (gete
3390: 6e 76 20 22 50 41 54 48 22 29 20 22 3a 22 20 6d  nv "PATH") ":" m
33a0: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 29 29 0a  t-bindir-path)).
33b0: 09 20 20 20 20 0a 09 20 20 20 20 28 69 66 20 28  .    ..    (if (
33c0: 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72  not (setup-for-r
33d0: 75 6e 29 29 0a 09 09 28 62 65 67 69 6e 0a 09 09  un))...(begin...
33e0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30    (debug:print 0
33f0: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75   "Failed to setu
3400: 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 09  p, exiting") ...
3410: 20 20 28 65 78 69 74 20 31 29 29 29 0a 09 20 20    (exit 1)))..  
3420: 20 20 3b 3b 20 6e 6f 77 20 63 61 6e 20 66 69 6e    ;; now can fin
3430: 64 20 6f 75 72 20 64 62 0a 09 20 20 20 20 28 73  d our db..    (s
3440: 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29  et! db (open-db)
3450: 29 0a 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64  )..    (change-d
3460: 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72  irectory work-ar
3470: 65 61 29 20 0a 09 20 20 20 20 28 73 65 74 2d 72  ea) ..    (set-r
3480: 75 6e 2d 63 6f 6e 66 69 67 2d 76 61 72 73 20 64  un-config-vars d
3490: 62 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 20 20  b run-id).      
34a0: 20 20 20 20 20 20 3b 3b 20 65 6e 76 69 72 6f 6e        ;; environ
34b0: 6d 65 6e 74 20 6f 76 65 72 72 69 64 65 73 20 61  ment overrides a
34c0: 72 65 20 64 6f 6e 65 20 2a 62 65 66 6f 72 65 2a  re done *before*
34d0: 20 74 68 65 20 72 65 6d 61 69 6e 69 6e 67 20 63   the remaining c
34e0: 72 69 74 69 63 61 6c 20 65 6e 76 61 72 73 2e 0a  ritical envars..
34f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6c 69              (ali
3500: 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 65 6e 76  st->env-vars env
3510: 2d 6f 76 72 64 29 0a 09 20 20 20 20 28 73 65 74  -ovrd)..    (set
3520: 2d 6d 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 61  -megatest-env-va
3530: 72 73 20 64 62 20 72 75 6e 2d 69 64 29 0a 09 20  rs db run-id).. 
3540: 20 20 20 28 73 65 74 2d 69 74 65 6d 2d 65 6e 76     (set-item-env
3550: 2d 76 61 72 73 20 69 74 65 6d 64 61 74 29 0a 20  -vars itemdat). 
3560: 20 20 20 20 20 20 20 20 20 20 20 28 73 61 76 65             (save
3570: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d  -environment-as-
3580: 66 69 6c 65 73 20 22 6d 65 67 61 74 65 73 74 22  files "megatest"
3590: 29 0a 09 20 20 20 20 28 74 65 73 74 2d 73 65 74  )..    (test-set
35a0: 2d 6d 65 74 61 2d 69 6e 66 6f 20 64 62 20 72 75  -meta-info db ru
35b0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69  n-id test-name i
35c0: 74 65 6d 64 61 74 29 0a 09 20 20 20 20 28 74 65  temdat)..    (te
35d0: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64  st-set-status! d
35e0: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61  b run-id test-na
35f0: 6d 65 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54  me "REMOTEHOSTST
3600: 41 52 54 22 20 22 6e 2f 61 22 20 69 74 65 6d 64  ART" "n/a" itemd
3610: 61 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67  at (args:get-arg
3620: 20 22 2d 6d 22 29 29 0a 09 20 20 20 20 28 69 66   "-m"))..    (if
3630: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22   (args:get-arg "
3640: 2d 78 74 65 72 6d 22 29 0a 09 09 28 73 65 74 21  -xterm")...(set!
3650: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 22   fullrunscript "
3660: 78 74 65 72 6d 22 29 0a 20 20 20 20 20 20 20 20  xterm").        
3670: 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74          (if (not
3680: 20 28 66 69 6c 65 2d 65 78 65 63 75 74 65 2d 61   (file-execute-a
3690: 63 63 65 73 73 3f 20 66 75 6c 6c 72 75 6e 73 63  ccess? fullrunsc
36a0: 72 69 70 74 29 29 0a 20 20 20 20 20 20 20 20 20  ript)).         
36b0: 20 20 20 20 20 20 20 20 20 20 20 28 73 79 73 74             (syst
36c0: 65 6d 20 28 63 6f 6e 63 20 22 63 68 6d 6f 64 20  em (conc "chmod 
36d0: 75 67 2b 78 20 22 20 66 75 6c 6c 72 75 6e 73 63  ug+x " fullrunsc
36e0: 72 69 70 74 29 29 29 29 0a 09 20 20 20 20 3b 3b  ript))))..    ;;
36f0: 20 57 65 20 61 72 65 20 61 62 6f 75 74 20 74 6f   We are about to
3700: 20 61 63 74 75 61 6c 6c 79 20 6b 69 63 6b 20 6f   actually kick o
3710: 66 66 20 74 68 65 20 74 65 73 74 0a 09 20 20 20  ff the test..   
3720: 20 3b 3b 20 73 6f 20 74 68 69 73 20 69 73 20 61   ;; so this is a
3730: 20 67 6f 6f 64 20 70 6c 61 63 65 20 74 6f 20 72   good place to r
3740: 65 6d 6f 76 65 20 74 68 65 20 72 65 63 6f 72 64  emove the record
3750: 73 20 66 6f 72 20 0a 09 20 20 20 20 3b 3b 20 61  s for ..    ;; a
3760: 6e 79 20 70 72 65 76 69 6f 75 73 20 72 75 6e 73  ny previous runs
3770: 0a 09 20 20 20 20 3b 3b 20 28 64 62 3a 74 65 73  ..    ;; (db:tes
3780: 74 2d 72 65 6d 6f 76 65 2d 73 74 65 70 73 20 64  t-remove-steps d
3790: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d  b run-id testnam
37a0: 65 20 69 74 65 6d 64 61 74 29 0a 09 20 20 20 20  e itemdat)..    
37b0: 0a 09 20 20 20 20 3b 3b 20 66 72 6f 6d 20 68 65  ..    ;; from he
37c0: 72 65 20 6f 6e 20 6f 75 74 20 77 65 20 77 69 6c  re on out we wil
37d0: 6c 20 6f 70 65 6e 20 61 6e 64 20 63 6c 6f 73 65  l open and close
37e0: 20 74 68 65 20 64 62 0a 09 20 20 20 20 3b 3b 20   the db..    ;; 
37f0: 6f 6e 20 65 76 65 72 79 20 61 63 63 65 73 73 20  on every access 
3800: 74 6f 20 72 65 64 75 63 65 20 74 68 65 20 70 72  to reduce the pr
3810: 6f 62 61 62 6c 69 74 69 79 20 6f 66 20 0a 09 20  obablitiy of .. 
3820: 20 20 20 3b 3b 20 63 6f 6e 74 65 6e 74 69 6f 6e     ;; contention
3830: 20 6f 72 20 73 74 75 63 6b 20 61 63 63 65 73 73   or stuck access
3840: 20 6f 6e 20 6e 66 73 2e 0a 09 20 20 20 20 28 73   on nfs...    (s
3850: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21  qlite3:finalize!
3860: 20 64 62 29 0a 0a 09 20 20 20 20 28 6c 65 74 2a   db)...    (let*
3870: 20 28 28 6d 20 20 20 20 20 20 20 20 20 20 20 20   ((m            
3880: 28 6d 61 6b 65 2d 6d 75 74 65 78 29 29 0a 09 09  (make-mutex))...
3890: 20 20 20 28 6b 69 6c 6c 2d 6a 6f 62 3f 20 20 20     (kill-job?   
38a0: 20 23 66 29 0a 09 09 20 20 20 28 65 78 69 74 2d   #f)...   (exit-
38b0: 69 6e 66 6f 20 20 20 20 28 6d 61 6b 65 2d 76 65  info    (make-ve
38c0: 63 74 6f 72 20 33 29 29 0a 09 09 20 20 20 28 6a  ctor 3))...   (j
38d0: 6f 62 2d 74 68 72 65 61 64 20 20 20 23 66 29 0a  ob-thread   #f).
38e0: 09 09 20 20 20 28 72 75 6e 69 74 20 20 20 20 20  ..   (runit     
38f0: 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09     (lambda ()...
3900: 09 09 20 20 20 3b 3b 20 28 6c 65 74 2d 76 61 6c  ..   ;; (let-val
3910: 75 65 73 0a 09 09 09 09 20 20 20 3b 3b 20 20 28  ues.....   ;;  (
3920: 28 28 70 69 64 20 65 78 69 74 2d 73 74 61 74 75  ((pid exit-statu
3930: 73 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 09  s exit-code)....
3940: 09 20 20 20 3b 3b 20 20 20 20 28 72 75 6e 2d 6e  .   ;;    (run-n
3950: 2d 77 61 69 74 20 66 75 6c 6c 72 75 6e 73 63 72  -wait fullrunscr
3960: 69 70 74 29 29 29 0a 09 09 09 09 20 20 20 28 6c  ipt))).....   (l
3970: 65 74 20 28 28 70 69 64 20 28 70 72 6f 63 65 73  et ((pid (proces
3980: 73 2d 72 75 6e 20 66 75 6c 6c 72 75 6e 73 63 72  s-run fullrunscr
3990: 69 70 74 29 29 29 0a 09 09 09 09 20 20 20 20 20  ipt))).....     
39a0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 30 29  (let loop ((i 0)
39b0: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c 65  ).....       (le
39c0: 74 2d 76 61 6c 75 65 73 0a 09 09 09 09 09 28 28  t-values......((
39d0: 28 70 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 74  (pid-val exit-st
39e0: 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 20  atus exit-code) 
39f0: 28 70 72 6f 63 65 73 73 2d 77 61 69 74 20 70 69  (process-wait pi
3a00: 64 20 23 74 29 29 29 0a 09 09 09 09 09 28 6d 75  d #t)))......(mu
3a10: 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09  tex-lock! m)....
3a20: 09 09 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65  ..(vector-set! e
3a30: 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 64 29 0a  xit-info 0 pid).
3a40: 09 09 09 09 09 28 76 65 63 74 6f 72 2d 73 65 74  .....(vector-set
3a50: 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78  ! exit-info 1 ex
3a60: 69 74 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09  it-status)......
3a70: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69  (vector-set! exi
3a80: 74 2d 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f  t-info 2 exit-co
3a90: 64 65 29 0a 09 09 09 09 09 28 6d 75 74 65 78 2d  de)......(mutex-
3aa0: 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09  unlock! m)......
3ab0: 28 69 66 20 28 65 71 3f 20 70 69 64 2d 76 61 6c  (if (eq? pid-val
3ac0: 20 30 29 0a 09 09 09 09 09 20 20 20 20 28 62 65   0)......    (be
3ad0: 67 69 6e 0a 09 09 09 09 09 20 20 20 20 20 20 28  gin......      (
3ae0: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 29  thread-sleep! 2)
3af0: 0a 09 09 09 09 09 20 20 20 20 20 20 28 6c 6f 6f  ......      (loo
3b00: 70 20 28 2b 20 69 20 31 29 29 29 0a 09 09 09 09  p (+ i 1))).....
3b10: 09 20 20 20 20 29 29 29 29 29 29 0a 09 09 20 20  .    ))))))...  
3b20: 20 28 6d 6f 6e 69 74 6f 72 6a 6f 62 20 20 20 28   (monitorjob   (
3b30: 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 20 20  lambda ().....  
3b40: 20 28 6c 65 74 2a 20 28 28 73 74 61 72 74 2d 73   (let* ((start-s
3b50: 65 63 6f 6e 64 73 20 28 63 75 72 72 65 6e 74 2d  econds (current-
3b60: 73 65 63 6f 6e 64 73 29 29 0a 09 09 09 09 09 20  seconds))...... 
3b70: 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 20 20   (calc-minutes  
3b80: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09  (lambda ()......
3b90: 09 09 20 20 20 28 69 6e 65 78 61 63 74 2d 3e 65  ..   (inexact->e
3ba0: 78 61 63 74 20 0a 09 09 09 09 09 09 09 20 20 20  xact ........   
3bb0: 20 28 72 6f 75 6e 64 20 0a 09 09 09 09 09 09 09   (round ........
3bc0: 20 20 20 20 20 28 2d 20 0a 09 09 09 09 09 09 09       (- ........
3bd0: 20 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 73        (current-s
3be0: 65 63 6f 6e 64 73 29 20 0a 09 09 09 09 09 09 09  econds) ........
3bf0: 20 20 20 20 20 20 73 74 61 72 74 2d 73 65 63 6f        start-seco
3c00: 6e 64 73 29 29 29 29 29 0a 09 09 09 09 09 20 20  nds)))))......  
3c10: 28 6b 69 6c 6c 2d 74 72 69 65 73 20 30 29 29 0a  (kill-tries 0)).
3c20: 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 6c 6f  ....     (let lo
3c30: 6f 70 20 28 28 6d 69 6e 75 74 65 73 20 20 20 28  op ((minutes   (
3c40: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 0a  calc-minutes))).
3c50: 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20  ....       (let 
3c60: 28 28 64 62 20 20 20 20 28 6f 70 65 6e 2d 64 62  ((db    (open-db
3c70: 29 29 29 0a 09 09 09 09 09 20 28 73 65 74 21 20  )))...... (set! 
3c80: 6b 69 6c 6c 2d 6a 6f 62 3f 20 28 74 65 73 74 2d  kill-job? (test-
3c90: 67 65 74 2d 6b 69 6c 6c 2d 72 65 71 75 65 73 74  get-kill-request
3ca0: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d   db run-id test-
3cb0: 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 29 0a 09  name itemdat))..
3cc0: 09 09 09 09 20 28 74 65 73 74 2d 75 70 64 61 74  .... (test-updat
3cd0: 65 2d 6d 65 74 61 2d 69 6e 66 6f 20 64 62 20 72  e-meta-info db r
3ce0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20  un-id test-name 
3cf0: 69 74 65 6d 64 61 74 20 6d 69 6e 75 74 65 73 29  itemdat minutes)
3d00: 0a 09 09 09 09 09 20 28 69 66 20 6b 69 6c 6c 2d  ...... (if kill-
3d10: 6a 6f 62 3f 20 0a 09 09 09 09 09 20 20 20 20 20  job? ......     
3d20: 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 20  (begin......    
3d30: 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20     (mutex-lock! 
3d40: 6d 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28  m)......       (
3d50: 6c 65 74 2a 20 28 28 70 69 64 20 28 76 65 63 74  let* ((pid (vect
3d60: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f  or-ref exit-info
3d70: 20 30 29 29 29 0a 09 09 09 09 09 09 20 28 69 66   0)))....... (if
3d80: 20 28 6e 75 6d 62 65 72 3f 20 70 69 64 29 0a 09   (number? pid)..
3d90: 09 09 09 09 09 20 20 20 20 20 28 62 65 67 69 6e  .....     (begin
3da0: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 64  .......       (d
3db0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41  ebug:print 0 "WA
3dc0: 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 20 72  RNING: Request r
3dd0: 65 63 65 69 76 65 64 20 74 6f 20 6b 69 6c 6c 20  eceived to kill 
3de0: 6a 6f 62 20 28 61 74 74 65 6d 70 74 20 23 20 22  job (attempt # "
3df0: 20 6b 69 6c 6c 2d 74 72 69 65 73 20 22 29 22 29   kill-tries ")")
3e00: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 3b 3b  .......       ;;
3e10: 28 63 6f 6e 64 0a 09 09 09 09 09 09 20 20 20 20  (cond.......    
3e20: 20 20 20 3b 3b 28 28 3e 20 20 20 6b 69 6c 6c 2d     ;;((>   kill-
3e30: 74 72 69 65 73 20 30 29 20 3b 20 32 29 0a 09 09  tries 0) ; 2)...
3e40: 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20  ....       (let 
3e50: 28 28 70 72 6f 63 65 73 73 65 73 20 28 63 6d 64  ((processes (cmd
3e60: 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 63 6f 6e 63  -run->list (conc
3e70: 20 22 70 67 72 65 70 20 2d 6c 20 2d 50 20 22 20   "pgrep -l -P " 
3e80: 70 69 64 29 29 29 29 0a 09 09 09 09 09 09 09 20  pid))))........ 
3e90: 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 09  (for-each ......
3ea0: 09 09 20 20 28 6c 61 6d 62 64 61 20 28 70 29 0a  ..  (lambda (p).
3eb0: 09 09 09 09 09 09 09 20 20 20 20 28 6c 65 74 2a  .......    (let*
3ec0: 20 28 28 70 61 72 74 73 20 20 28 73 74 72 69 6e   ((parts  (strin
3ed0: 67 2d 73 70 6c 69 74 20 70 29 29 0a 09 09 09 09  g-split p)).....
3ee0: 09 09 09 09 20 20 20 28 70 2d 69 64 20 20 20 28  ....   (p-id   (
3ef0: 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61  if (> (length pa
3f00: 72 74 73 29 20 30 29 0a 09 09 09 09 09 09 09 09  rts) 0).........
3f10: 09 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d  .       (string-
3f20: 3e 6e 75 6d 62 65 72 20 28 63 61 72 20 70 61 72  >number (car par
3f30: 74 73 29 29 0a 09 09 09 09 09 09 09 09 09 20 20  ts))..........  
3f40: 20 20 20 20 20 23 66 29 29 29 0a 09 09 09 09 09       #f)))......
3f50: 09 09 20 20 20 20 20 20 28 69 66 20 70 2d 69 64  ..      (if p-id
3f60: 0a 09 09 09 09 09 09 09 09 20 20 28 62 65 67 69  .........  (begi
3f70: 6e 0a 09 09 09 09 09 09 09 09 20 20 20 20 28 64  n.........    (d
3f80: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 4b 69  ebug:print 0 "Ki
3f90: 6c 6c 69 6e 67 20 22 20 28 63 61 64 72 20 70 61  lling " (cadr pa
3fa0: 72 74 73 29 20 22 3b 20 6b 69 6c 6c 20 2d 39 20  rts) "; kill -9 
3fb0: 20 22 20 70 2d 69 64 29 0a 09 09 09 09 09 09 09   " p-id)........
3fc0: 09 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f  .    (system (co
3fd0: 6e 63 20 22 6b 69 6c 6c 20 2d 39 20 22 20 70 2d  nc "kill -9 " p-
3fe0: 69 64 29 29 29 29 29 29 0a 09 09 09 09 09 09 09  id))))))........
3ff0: 20 20 28 63 61 72 20 70 72 6f 63 65 73 73 65 73    (car processes
4000: 29 29 0a 09 09 09 09 09 09 09 20 28 73 79 73 74  ))........ (syst
4010: 65 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d  em (conc "kill -
4020: 39 20 22 20 70 69 64 29 29 29 29 0a 09 09 09 09  9 " pid)))).....
4030: 09 09 20 20 20 20 20 3b 3b 28 6c 65 74 2a 20 28  ..     ;;(let* (
4040: 28 70 70 69 64 20 28 70 72 6f 63 65 73 73 2d 67  (ppid (process-g
4050: 72 6f 75 70 2d 69 64 20 70 69 64 29 29 0a 09 09  roup-id pid))...
4060: 09 09 09 09 20 20 20 20 20 3b 3b 20 20 20 20 20  ....     ;;     
4070: 20 20 28 6b 63 6d 64 20 28 63 6f 6e 63 20 22 70    (kcmd (conc "p
4080: 6b 69 6c 6c 20 2d 39 20 2d 67 20 22 20 70 70 69  kill -9 -g " ppi
4090: 64 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20  d))).......     
40a0: 3b 3b 20 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d  ;;  ;; (process-
40b0: 73 69 67 6e 61 6c 20 70 69 64 20 73 69 67 6e 61  signal pid signa
40c0: 6c 2f 74 65 72 6d 29 0a 09 09 09 09 09 09 20 20  l/term).......  
40d0: 20 20 20 3b 3b 20 20 3b 3b 20 28 70 72 6f 63 65     ;;  ;; (proce
40e0: 73 73 2d 73 69 67 6e 61 6c 20 70 69 64 20 73 69  ss-signal pid si
40f0: 67 6e 61 6c 2f 6b 69 6c 6c 29 0a 09 09 09 09 09  gnal/kill)......
4100: 09 20 20 20 20 20 3b 3b 20 20 28 64 65 62 75 67  .     ;;  (debug
4110: 3a 70 72 69 6e 74 20 30 20 22 41 74 74 65 6d 70  :print 0 "Attemp
4120: 74 69 6e 67 20 74 6f 20 6b 69 6c 6c 20 70 69 64  ting to kill pid
4130: 20 22 20 70 69 64 20 22 20 61 6e 64 20 63 68 69   " pid " and chi
4140: 6c 64 72 65 6e 20 69 6e 20 70 72 6f 63 65 73 73  ldren in process
4150: 20 67 72 6f 75 70 20 22 20 70 70 69 64 20 22 20   group " ppid " 
4160: 77 69 74 68 20 63 6f 6d 6d 61 6e 64 3a 5c 6e 20  with command:\n 
4170: 20 20 20 22 20 6b 63 6d 64 29 0a 09 09 09 09 09     " kcmd)......
4180: 09 20 20 20 20 20 3b 3b 20 20 28 64 65 62 75 67  .     ;;  (debug
4190: 3a 70 72 69 6e 74 20 30 20 22 43 68 69 6c 64 72  :print 0 "Childr
41a0: 65 6e 3a 22 29 0a 09 09 09 09 09 09 20 20 20 20  en:").......    
41b0: 20 3b 3b 20 20 28 73 79 73 74 65 6d 20 28 63 6f   ;;  (system (co
41c0: 6e 63 20 22 70 67 72 65 70 20 2d 67 20 2d 6c 20  nc "pgrep -g -l 
41d0: 22 20 70 70 69 64 29 29 0a 09 09 09 09 09 09 20  " ppid))....... 
41e0: 20 20 20 20 3b 3b 20 20 28 73 79 73 74 65 6d 20      ;;  (system 
41f0: 6b 63 6d 64 29 0a 09 09 09 09 09 09 20 20 20 20  kcmd).......    
4200: 20 3b 3b 20 20 28 73 6c 65 65 70 20 31 29 20 3b   ;;  (sleep 1) ;
4210: 3b 20 67 69 76 65 20 69 74 20 61 20 72 65 73 74  ; give it a rest
4220: 0a 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 20  .......     ;;  
4230: 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73  (test-set-status
4240: 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74  ! db run-id test
4250: 2d 6e 61 6d 65 20 22 4b 49 4c 4c 45 44 22 20 20  -name "KILLED"  
4260: 22 46 41 49 4c 22 0a 09 09 09 09 09 09 20 20 20  "FAIL".......   
4270: 20 20 3b 3b 20 20 20 20 20 20 20 09 20 20 20 20    ;;       .    
4280: 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67   itemdat (args:g
4290: 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09  et-arg "-m"))...
42a0: 09 09 09 09 20 20 20 20 20 3b 3b 20 20 28 73 71  ....     ;;  (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 09 09 09 09 20 20 20 20 20 3b  db).......     ;
42d0: 3b 20 20 28 65 78 69 74 20 31 29 29 29 29 29 0a  ;  (exit 1))))).
42e0: 09 09 09 09 09 09 20 20 20 20 20 28 62 65 67 69  ......     (begi
42f0: 6e 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28  n.......       (
4300: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57  debug:print 0 "W
4310: 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 20  ARNING: Request 
4320: 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 6c 6c  received to kill
4330: 20 6a 6f 62 20 62 75 74 20 70 72 6f 62 6c 65 6d   job but problem
4340: 20 77 69 74 68 20 70 72 6f 63 65 73 73 2c 20 61   with process, a
4350: 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 6b 69 6c  ttempting to kil
4360: 6c 20 6d 61 6e 61 67 65 72 20 70 72 6f 63 65 73  l manager proces
4370: 73 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 20  s").......      
4380: 20 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75   (test-set-statu
4390: 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73  s! db run-id tes
43a0: 74 2d 6e 61 6d 65 20 22 4b 49 4c 4c 45 44 22 20  t-name "KILLED" 
43b0: 20 22 46 41 49 4c 22 0a 09 09 09 09 09 09 09 09   "FAIL".........
43c0: 09 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a  . itemdat (args:
43d0: 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09  get-arg "-m"))..
43e0: 09 09 09 09 09 20 20 20 20 20 20 20 28 73 71 6c  .....       (sql
43f0: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64  ite3:finalize! d
4400: 62 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20  b).......       
4410: 28 65 78 69 74 20 31 29 29 29 29 0a 09 09 09 09  (exit 1)))).....
4420: 09 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 28  .       ;;     (
4430: 74 68 72 65 61 64 2d 74 65 72 6d 69 6e 61 74 65  thread-terminate
4440: 21 20 6a 6f 62 2d 74 68 72 65 61 64 29 29 29 0a  ! job-thread))).
4450: 09 09 09 09 09 20 20 20 20 20 20 20 28 73 65 74  .....       (set
4460: 21 20 6b 69 6c 6c 2d 74 72 69 65 73 20 28 2b 20  ! kill-tries (+ 
4470: 31 20 6b 69 6c 6c 2d 74 72 69 65 73 29 29 0a 09  1 kill-tries))..
4480: 09 09 09 09 20 20 20 20 20 20 20 28 6d 75 74 65  ....       (mute
4490: 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 29 29 0a 09  x-unlock! m)))..
44a0: 09 09 09 09 20 3b 3b 20 28 68 61 6e 64 6c 65 2d  .... ;; (handle-
44b0: 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 09 09  exceptions......
44c0: 20 20 20 20 20 20 20 3b 3b 20 20 65 78 6e 0a 09         ;;  exn..
44d0: 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 20 28  ....       ;;  (
44e0: 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 20 20  begin......     
44f0: 20 20 3b 3b 20 20 20 20 28 64 65 62 75 67 3a 70    ;;    (debug:p
4500: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 50  rint 0 "ERROR: P
4510: 72 6f 62 6c 65 6d 20 6b 69 6c 6c 69 6e 67 20 70  roblem killing p
4520: 72 6f 63 65 73 73 20 22 20 28 76 65 63 74 6f 72  rocess " (vector
4530: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 30  -ref exit-info 0
4540: 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 3b  ))......       ;
4550: 3b 20 20 20 20 28 61 62 6f 72 74 20 65 78 6e 29  ;    (abort exn)
4560: 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 3b 3b  )......       ;;
4570: 20 20 28 6c 65 74 2a 20 28 28 70 69 64 20 20 20    (let* ((pid   
4580: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74  (vector-ref exit
4590: 2d 69 6e 66 6f 20 30 29 29 0a 09 09 09 09 09 20  -info 0))...... 
45a0: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20        ;;        
45b0: 20 3b 3b 20 28 70 67 69 64 20 20 28 70 72 6f 63   ;; (pgid  (proc
45c0: 65 73 73 2d 67 72 6f 75 70 2d 69 64 20 70 69 64  ess-group-id pid
45d0: 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 3b  ))......       ;
45e0: 3b 20 20 20 20 20 20 20 20 20 3b 3b 20 28 63 6d  ;         ;; (cm
45f0: 64 20 20 28 63 6f 6e 63 20 22 70 6b 69 6c 6c 20  d  (conc "pkill 
4600: 2d 39 20 2d 50 20 22 20 70 67 69 64 29 29 0a 09  -9 -P " pgid))..
4610: 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 20 20  ....       ;;   
4620: 20 20 20 20 20 20 29 0a 09 09 09 09 09 20 20 20        )......   
4630: 20 20 20 20 3b 3b 20 20 20 20 3b 3b 20 28 64 65      ;;    ;; (de
4640: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 52 75 6e  bug:print 0 "Run
4650: 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22  ning \"" cmd "\"
4660: 22 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 3b  ")......       ;
4670: 3b 20 20 20 20 3b 3b 20 28 73 79 73 74 65 6d 20  ;    ;; (system 
4680: 63 6d 64 29 0a 09 09 09 09 09 20 20 20 20 20 20  cmd)......      
4690: 20 3b 3b 20 20 20 20 28 64 65 62 75 67 3a 70 72   ;;    (debug:pr
46a0: 69 6e 74 20 30 20 22 52 75 6e 6e 69 6e 67 20 5c  int 0 "Running \
46b0: 22 6b 69 6c 6c 20 2d 39 20 22 20 70 69 64 20 22  "kill -9 " pid "
46c0: 5c 22 22 29 0a 09 09 09 09 09 20 20 20 20 20 20  \"")......      
46d0: 20 3b 3b 20 20 20 20 28 73 79 73 74 65 6d 20 28   ;;    (system (
46e0: 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d 39 20 22 20  conc "kill -9 " 
46f0: 70 69 64 29 29 0a 09 09 09 09 09 20 20 20 20 20  pid))......     
4700: 20 20 3b 3b 20 20 20 20 3b 3b 20 28 70 72 6f 63    ;;    ;; (proc
4710: 65 73 73 2d 73 69 67 6e 61 6c 20 28 76 65 63 74  ess-signal (vect
4720: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f  or-ref exit-info
4730: 20 30 29 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29   0) signal/kill)
4740: 0a 09 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20  ......       ;; 
4750: 20 20 20 29 29 29 29 0a 09 09 09 09 09 20 28 73     ))))...... (s
4760: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21  qlite3:finalize!
4770: 20 64 62 29 0a 09 09 09 09 09 20 28 74 68 72 65   db)...... (thre
4780: 61 64 2d 73 6c 65 65 70 21 20 28 2b 20 38 20 28  ad-sleep! (+ 8 (
4790: 72 61 6e 64 6f 6d 20 34 29 29 29 20 3b 3b 20 61  random 4))) ;; a
47a0: 64 64 20 73 6f 6d 65 20 6a 69 74 74 65 72 20 74  dd some jitter t
47b0: 6f 20 74 68 65 20 63 61 6c 6c 20 68 6f 6d 65 20  o the call home 
47c0: 74 69 6d 65 20 74 6f 20 73 70 72 65 61 64 20 6f  time to spread o
47d0: 75 74 20 74 68 65 20 64 62 20 61 63 63 65 73 73  ut the db access
47e0: 65 73 0a 09 09 09 09 09 20 28 6c 6f 6f 70 20 28  es...... (loop (
47f0: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 29  calc-minutes))))
4800: 29 29 29 0a 09 09 20 20 20 28 74 68 31 20 20 20  )))...   (th1   
4810: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72         (make-thr
4820: 65 61 64 20 6d 6f 6e 69 74 6f 72 6a 6f 62 29 29  ead monitorjob))
4830: 0a 09 09 20 20 20 28 74 68 32 20 20 20 20 20 20  ...   (th2      
4840: 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 64      (make-thread
4850: 20 72 75 6e 69 74 29 29 29 0a 09 20 20 20 20 20   runit)))..     
4860: 20 28 73 65 74 21 20 6a 6f 62 2d 74 68 72 65 61   (set! job-threa
4870: 64 20 74 68 32 29 0a 09 20 20 20 20 20 20 28 74  d th2)..      (t
4880: 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31  hread-start! th1
4890: 29 0a 09 20 20 20 20 20 20 28 74 68 72 65 61 64  )..      (thread
48a0: 2d 73 74 61 72 74 21 20 74 68 32 29 0a 09 20 20  -start! th2)..  
48b0: 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e      (thread-join
48c0: 21 20 74 68 32 29 0a 09 20 20 20 20 20 20 28 6d  ! th2)..      (m
48d0: 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 20  utex-lock! m).. 
48e0: 20 20 20 20 20 28 73 65 74 21 20 64 62 20 28 6f       (set! db (o
48f0: 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 20 20  pen-db))..      
4900: 28 6c 65 74 2a 20 28 28 69 74 65 6d 2d 70 61 74  (let* ((item-pat
4910: 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61  h (item-list->pa
4920: 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 09 20  th itemdat))... 
4930: 20 20 20 20 28 74 65 73 74 69 6e 66 6f 20 20 28      (testinfo  (
4940: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f  db:get-test-info
4950: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d   db run-id test-
4960: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29  name item-path))
4970: 29 0a 09 09 28 69 66 20 28 6e 6f 74 20 28 65 71  )...(if (not (eq
4980: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65  ual? (db:test-ge
4990: 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f  t-state testinfo
49a0: 29 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 0a  ) "COMPLETED")).
49b0: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20  ..    (begin... 
49c0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e       (debug:prin
49d0: 74 20 32 20 22 54 65 73 74 20 4e 4f 54 20 6c 6f  t 2 "Test NOT lo
49e0: 67 67 65 64 20 61 73 20 43 4f 4d 50 4c 45 54 45  gged as COMPLETE
49f0: 44 2c 20 28 73 74 61 74 65 3d 22 20 28 64 62 3a  D, (state=" (db:
4a00: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74  test-get-state t
4a10: 65 73 74 69 6e 66 6f 29 20 22 29 2c 20 75 70 64  estinfo) "), upd
4a20: 61 74 69 6e 67 20 72 65 73 75 6c 74 22 29 0a 09  ating result")..
4a30: 09 20 20 20 20 20 20 28 74 65 73 74 2d 73 65 74  .      (test-set
4a40: 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 6e 2d  -status! db run-
4a50: 69 64 20 74 65 73 74 2d 6e 61 6d 65 0a 09 09 09  id test-name....
4a60: 09 09 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20  ..(if kill-job? 
4a70: 22 4b 49 4c 4c 45 44 22 20 22 43 4f 4d 50 4c 45  "KILLED" "COMPLE
4a80: 54 45 44 22 29 0a 09 09 09 09 09 28 69 66 20 28  TED")......(if (
4a90: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d  vector-ref exit-
4aa0: 69 6e 66 6f 20 31 29 20 3b 3b 20 6c 6f 6f 6b 20  info 1) ;; look 
4ab0: 61 74 20 74 68 65 20 65 78 69 74 2d 73 74 61 74  at the exit-stat
4ac0: 75 73 0a 09 09 09 09 09 20 20 20 20 28 69 66 20  us......    (if 
4ad0: 28 61 6e 64 20 28 6e 6f 74 20 6b 69 6c 6c 2d 6a  (and (not kill-j
4ae0: 6f 62 3f 29 20 0a 09 09 09 09 09 09 20 20 20 20  ob?) .......    
4af0: 20 28 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 65   (eq? (vector-re
4b00: 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 30  f exit-info 2) 0
4b10: 29 29 0a 09 09 09 09 09 09 22 50 41 53 53 22 0a  ))......."PASS".
4b20: 09 09 09 09 09 09 22 46 41 49 4c 22 29 0a 09 09  ......"FAIL")...
4b30: 09 09 09 20 20 20 20 22 46 41 49 4c 22 29 20 69  ...    "FAIL") i
4b40: 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67 65 74  temdat (args:get
4b50: 2d 61 72 67 20 22 2d 6d 22 29 29 29 29 0a 09 09  -arg "-m"))))...
4b60: 3b 3b 20 66 6f 72 20 61 75 74 6f 6d 61 74 65 64  ;; for automated
4b70: 20 63 72 65 61 74 69 6f 6e 20 6f 66 20 74 68 65   creation of the
4b80: 20 72 6f 6c 6c 75 70 20 68 74 6d 6c 20 66 69 6c   rollup html fil
4b90: 65 20 74 68 69 73 20 69 73 20 61 20 67 6f 6f 64  e this is a good
4ba0: 20 70 6c 61 63 65 2e 2e 2e 0a 09 09 28 74 65 73   place......(tes
4bb0: 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65  ts:summarize-ite
4bc0: 6d 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73  ms db run-id tes
4bd0: 74 2d 6e 61 6d 65 20 23 66 29 20 3b 3b 20 64 6f  t-name #f) ;; do
4be0: 6e 27 74 20 66 6f 72 63 65 20 2d 20 6a 75 73 74  n't force - just
4bf0: 20 75 70 64 61 74 65 20 69 66 20 6e 6f 0a 09 09   update if no...
4c00: 29 0a 09 20 20 20 20 20 20 28 6d 75 74 65 78 2d  )..      (mutex-
4c10: 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20  unlock! m)..    
4c20: 20 20 3b 3b 20 28 65 78 65 63 2d 72 65 73 75 6c    ;; (exec-resul
4c30: 74 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73  ts (cmd-run->lis
4c40: 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29  t fullrunscript)
4c50: 29 20 3b 3b 20 20 28 6c 69 73 74 20 22 3e 22 20  ) ;;  (list ">" 
4c60: 28 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20  (conc test-name 
4c70: 22 2d 72 75 6e 2e 6c 6f 67 22 29 29 29 29 0a 09  "-run.log"))))..
4c80: 20 20 20 20 20 20 3b 3b 20 28 73 75 63 63 65 73        ;; (succes
4c90: 73 20 20 20 20 20 20 65 78 65 63 2d 72 65 73 75  s      exec-resu
4ca0: 6c 74 73 29 29 20 3b 3b 20 28 65 71 3f 20 28 63  lts)) ;; (eq? (c
4cb0: 61 64 72 20 65 78 65 63 2d 72 65 73 75 6c 74 73  adr exec-results
4cc0: 29 20 30 29 29 29 0a 09 20 20 20 20 20 20 28 64  ) 0)))..      (d
4cd0: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4f 75  ebug:print 2 "Ou
4ce0: 74 70 75 74 20 66 72 6f 6d 20 72 75 6e 6e 69 6e  tput from runnin
4cf0: 67 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 70  g " fullrunscrip
4d00: 74 20 22 2c 20 70 69 64 20 22 20 28 76 65 63 74  t ", pid " (vect
4d10: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f  or-ref exit-info
4d20: 20 30 29 20 22 20 69 6e 20 77 6f 72 6b 20 61 72   0) " in work ar
4d30: 65 61 20 22 20 0a 09 09 20 20 20 20 20 77 6f 72  ea " ...     wor
4d40: 6b 2d 61 72 65 61 20 22 3a 5c 6e 3d 3d 3d 3d 5c  k-area ":\n====\
4d50: 6e 20 65 78 69 74 20 63 6f 64 65 20 22 20 28 76  n exit code " (v
4d60: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69  ector-ref exit-i
4d70: 6e 66 6f 20 32 29 20 22 5c 6e 22 20 22 3d 3d 3d  nfo 2) "\n" "===
4d80: 3d 5c 6e 22 29 0a 09 20 20 20 20 20 20 28 73 71  =\n")..      (sq
4d90: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20  lite3:finalize! 
4da0: 64 62 29 0a 09 20 20 20 20 20 20 28 69 66 20 28  db)..      (if (
4db0: 6e 6f 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20  not (vector-ref 
4dc0: 65 78 69 74 2d 69 6e 66 6f 20 31 29 29 0a 09 09  exit-info 1))...
4dd0: 20 20 28 65 78 69 74 20 34 29 29 29 29 29 0a 20    (exit 4))))). 
4de0: 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73       (set! *dids
4df0: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a  omething* #t))).
4e00: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61  .(if (args:get-a
4e10: 72 67 20 22 2d 73 74 65 70 22 29 0a 20 20 20 20  rg "-step").    
4e20: 28 69 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76  (if (not (getenv
4e30: 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a   "MT_CMDINFO")).
4e40: 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75  .(begin..  (debu
4e50: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52  g:print 0 "ERROR
4e60: 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76  : MT_CMDINFO env
4e70: 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 2d 73   var not set, -s
4e80: 74 65 70 20 6d 75 73 74 20 62 65 20 63 61 6c 6c  tep must be call
4e90: 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65  ed *inside* a me
4ea0: 67 61 74 65 73 74 20 69 6e 76 6f 6b 65 64 20 65  gatest invoked e
4eb0: 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 20  nvironment!").. 
4ec0: 20 28 65 78 69 74 20 35 29 29 0a 09 28 6c 65 74   (exit 5))..(let
4ed0: 2a 20 28 28 73 74 65 70 20 20 20 20 20 20 28 61  * ((step      (a
4ee0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74  rgs:get-arg "-st
4ef0: 65 70 22 29 29 0a 09 20 20 20 20 20 20 20 28 63  ep"))..       (c
4f00: 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28  mdinfo   (read (
4f10: 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e  open-input-strin
4f20: 67 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34  g (base64:base64
4f30: 2d 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20  -decode (getenv 
4f40: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29  "MT_CMDINFO"))))
4f50: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70  )..       (testp
4f60: 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61  ath  (assoc/defa
4f70: 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63  ult 'testpath  c
4f80: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20  mdinfo))..      
4f90: 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73   (test-name (ass
4fa0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74  oc/default 'test
4fb0: 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a  -name cmdinfo)).
4fc0: 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69  .       (runscri
4fd0: 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c  pt (assoc/defaul
4fe0: 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64  t 'runscript cmd
4ff0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28  info))..       (
5000: 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63  db-host   (assoc
5010: 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73  /default 'db-hos
5020: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20  t   cmdinfo)).. 
5030: 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20        (run-id   
5040: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20   (assoc/default 
5050: 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e  'run-id    cmdin
5060: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74  fo))..       (it
5070: 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64  emdat   (assoc/d
5080: 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20  efault 'itemdat 
5090: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20    cmdinfo))..   
50a0: 20 20 20 20 28 64 62 20 20 20 20 20 20 20 20 23      (db        #
50b0: 66 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74  f)..       (stat
50c0: 65 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61  e    (args:get-a
50d0: 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20  rg ":state")).. 
50e0: 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20        (status   
50f0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a  (args:get-arg ":
5100: 73 74 61 74 75 73 22 29 29 29 0a 09 20 20 28 63  status")))..  (c
5110: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20  hange-directory 
5120: 74 65 73 74 70 61 74 68 29 0a 09 20 20 28 69 66  testpath)..  (if
5130: 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72   (not (setup-for
5140: 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 28 62  -run))..      (b
5150: 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72  egin...(debug:pr
5160: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f  int 0 "Failed to
5170: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22   setup, exiting"
5180: 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09  )...(exit 1)))..
5190: 20 20 28 73 65 74 21 20 64 62 20 28 6f 70 65 6e    (set! db (open
51a0: 2d 64 62 29 29 0a 09 20 20 28 69 66 20 28 61 6e  -db))..  (if (an
51b0: 64 20 73 74 61 74 65 20 73 74 61 74 75 73 29 0a  d state status).
51c0: 09 20 20 20 20 20 20 28 74 65 73 74 73 74 65 70  .      (teststep
51d0: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20  -set-status! db 
51e0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65  run-id test-name
51f0: 20 73 74 65 70 20 73 74 61 74 65 20 73 74 61 74   step state stat
5200: 75 73 20 69 74 65 6d 64 61 74 20 28 61 72 67 73  us itemdat (args
5210: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a  :get-arg "-m")).
5220: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09  .      (begin...
5230: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22  (debug:print 0 "
5240: 45 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 20  ERROR: You must 
5250: 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 61  specify :state a
5260: 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 20  nd :status with 
5270: 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 73  every call to -s
5280: 74 65 70 22 29 0a 09 09 28 65 78 69 74 20 36 29  tep")...(exit 6)
5290: 29 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 66  ))..  (sqlite3:f
52a0: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 20  inalize! db)..  
52b0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68  (set! *didsometh
52c0: 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 28 69 66  ing* #t))))..(if
52d0: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61   (or (args:get-a
52e0: 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 20 20 20  rg "-setlog")   
52f0: 20 20 20 20 3b 3b 20 73 69 6e 63 65 20 73 65 74      ;; since set
5300: 74 69 6e 67 20 75 70 20 69 73 20 73 6f 20 63 6f  ting up is so co
5310: 73 74 6c 79 20 6c 65 74 73 20 70 69 67 67 79 62  stly lets piggyb
5320: 61 63 6b 20 6f 6e 20 2d 74 65 73 74 2d 73 74 61  ack on -test-sta
5330: 74 75 73 0a 09 28 61 72 67 73 3a 67 65 74 2d 61  tus..(args:get-a
5340: 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22  rg "-set-toplog"
5350: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67  )..(args:get-arg
5360: 20 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29   "-test-status")
5370: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20  ..(args:get-arg 
5380: 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 28 61 72  "-runstep")..(ar
5390: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d  gs:get-arg "-sum
53a0: 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 29 0a  marize-items")).
53b0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65      (if (not (ge
53c0: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f  tenv "MT_CMDINFO
53d0: 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28  "))..(begin..  (
53e0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45  debug:print 0 "E
53f0: 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f  RROR: MT_CMDINFO
5400: 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 73 65 74   env var not set
5410: 2c 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 65 73 74  , commands -test
5420: 2d 73 74 61 74 75 73 2c 20 2d 72 75 6e 73 74 65  -status, -runste
5430: 70 20 61 6e 64 20 2d 73 65 74 6c 6f 67 20 6d 75  p and -setlog mu
5440: 73 74 20 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e  st be called *in
5450: 73 69 64 65 2a 20 61 20 6d 65 67 61 74 65 73 74  side* a megatest
5460: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a   environment!").
5470: 09 20 20 28 65 78 69 74 20 35 29 29 0a 09 28 6c  .  (exit 5))..(l
5480: 65 74 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69  et* ((startingdi
5490: 72 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63  r (current-direc
54a0: 74 6f 72 79 29 29 0a 09 20 20 20 20 20 20 20 28  tory))..       (
54b0: 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20  cmdinfo   (read 
54c0: 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69  (open-input-stri
54d0: 6e 67 20 28 62 61 73 65 36 34 3a 62 61 73 65 36  ng (base64:base6
54e0: 34 2d 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76  4-decode (getenv
54f0: 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29   "MT_CMDINFO")))
5500: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74  ))..       (test
5510: 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66  path  (assoc/def
5520: 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20  ault 'testpath  
5530: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20  cmdinfo))..     
5540: 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73    (test-name (as
5550: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73  soc/default 'tes
5560: 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29  t-name cmdinfo))
5570: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72  ..       (runscr
5580: 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75  ipt (assoc/defau
5590: 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d  lt 'runscript cm
55a0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20  dinfo))..       
55b0: 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f  (db-host   (asso
55c0: 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f  c/default 'db-ho
55d0: 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09  st   cmdinfo))..
55e0: 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20         (run-id  
55f0: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74    (assoc/default
5600: 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69   'run-id    cmdi
5610: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69  nfo))..       (i
5620: 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f  temdat   (assoc/
5630: 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74  default 'itemdat
5640: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20     cmdinfo))..  
5650: 20 20 20 20 20 28 64 62 20 20 20 20 20 20 20 20       (db        
5660: 23 66 29 0a 09 20 20 20 20 20 20 20 28 73 74 61  #f)..       (sta
5670: 74 65 20 20 20 20 20 28 61 72 67 73 3a 67 65 74  te     (args:get
5680: 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 29 0a  -arg ":state")).
5690: 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 20  .       (status 
56a0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67     (args:get-arg
56b0: 20 22 3a 73 74 61 74 75 73 22 29 29 29 0a 09 20   ":status"))).. 
56c0: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f   (change-directo
56d0: 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 20 20  ry testpath)..  
56e0: 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d  (if (not (setup-
56f0: 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20  for-run))..     
5700: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67   (begin...(debug
5710: 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64  :print 0 "Failed
5720: 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69   to setup, exiti
5730: 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29  ng")...(exit 1))
5740: 29 0a 09 20 20 28 73 65 74 21 20 64 62 20 28 6f  )..  (set! db (o
5750: 70 65 6e 2d 64 62 29 29 0a 09 20 20 28 69 66 20  pen-db))..  (if 
5760: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d  (args:get-arg "-
5770: 73 65 74 6c 6f 67 22 29 0a 09 20 20 20 20 20 20  setlog")..      
5780: 28 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 64  (test-set-log! d
5790: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61  b run-id test-na
57a0: 6d 65 20 69 74 65 6d 64 61 74 20 28 61 72 67 73  me itemdat (args
57b0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f  :get-arg "-setlo
57c0: 67 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 72  g")))..  (if (ar
57d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74  gs:get-arg "-set
57e0: 2d 74 6f 70 6c 6f 67 22 29 0a 09 20 20 20 20 20  -toplog")..     
57f0: 20 28 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f   (test-set-toplo
5800: 67 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73  g! db run-id tes
5810: 74 2d 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74  t-name (args:get
5820: 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f  -arg "-set-toplo
5830: 67 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 72  g")))..  (if (ar
5840: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d  gs:get-arg "-sum
5850: 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 0a 09  marize-items")..
5860: 20 20 20 20 20 20 28 74 65 73 74 73 3a 73 75 6d        (tests:sum
5870: 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 64 62 20  marize-items db 
5880: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65  run-id test-name
5890: 20 23 74 29 29 20 3b 3b 20 64 6f 20 66 6f 72 63   #t)) ;; do forc
58a0: 65 20 68 65 72 65 0a 09 20 20 28 69 66 20 28 61  e here..  (if (a
58b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75  rgs:get-arg "-ru
58c0: 6e 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 28  nstep")..      (
58d0: 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67  if (null? remarg
58e0: 73 29 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09  s)...  (begin...
58f0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74      (debug:print
5900: 20 30 20 22 45 52 52 4f 52 3a 20 6e 6f 74 68 69   0 "ERROR: nothi
5910: 6e 67 20 73 70 65 63 69 66 69 65 64 20 74 6f 20  ng specified to 
5920: 72 75 6e 21 22 29 0a 09 09 20 20 20 20 28 73 71  run!")...    (sq
5930: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20  lite3:finalize! 
5940: 64 62 29 0a 09 09 20 20 20 20 28 65 78 69 74 20  db)...    (exit 
5950: 36 29 29 0a 09 09 20 20 28 6c 65 74 2a 20 28 28  6))...  (let* ((
5960: 73 74 65 70 6e 61 6d 65 20 20 20 28 61 72 67 73  stepname   (args
5970: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74  :get-arg "-runst
5980: 65 70 22 29 29 0a 09 09 09 20 28 6c 6f 67 70 72  ep")).... (logpr
5990: 6f 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d  ofile (args:get-
59a0: 61 72 67 20 22 2d 6c 6f 67 70 72 6f 22 29 29 0a  arg "-logpro")).
59b0: 09 09 09 20 28 6c 6f 67 66 69 6c 65 20 20 20 20  ... (logfile    
59c0: 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22  (conc stepname "
59d0: 2e 6c 6f 67 22 29 29 0a 09 09 09 20 28 63 6d 64  .log")).... (cmd
59e0: 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c          (if (nul
59f0: 6c 3f 20 72 65 6d 61 72 67 73 29 20 23 66 20 28  l? remargs) #f (
5a00: 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 0a 09  car remargs)))..
5a10: 09 09 20 28 70 61 72 61 6d 73 20 20 20 20 20 28  .. (params     (
5a20: 69 66 20 63 6d 64 20 28 63 64 72 20 72 65 6d 61  if cmd (cdr rema
5a30: 72 67 73 29 20 27 28 29 29 29 0a 09 09 09 20 28  rgs) '())).... (
5a40: 65 78 69 74 73 74 61 74 20 20 20 23 66 29 0a 09  exitstat   #f)..
5a50: 09 09 20 28 73 68 65 6c 6c 20 20 20 20 20 20 28  .. (shell      (
5a60: 6c 61 73 74 20 28 73 74 72 69 6e 67 2d 73 70 6c  last (string-spl
5a70: 69 74 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d  it (get-environm
5a80: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 53 48  ent-variable "SH
5a90: 45 4c 4c 22 29 20 22 2f 22 29 29 29 0a 09 09 09  ELL") "/")))....
5aa0: 20 28 72 65 64 69 72 20 20 20 20 20 20 28 63 61   (redir      (ca
5ab0: 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62  se (string->symb
5ac0: 6f 6c 20 73 68 65 6c 6c 29 0a 09 09 09 09 20 20  ol shell).....  
5ad0: 20 20 20 20 20 28 28 74 63 73 68 20 63 73 68 20       ((tcsh csh 
5ae0: 6b 73 68 29 20 20 20 20 22 3e 26 22 29 0a 09 09  ksh)    ">&")...
5af0: 09 09 20 20 20 20 20 20 20 28 28 7a 73 68 20 62  ..       ((zsh b
5b00: 61 73 68 20 73 68 20 61 73 68 29 20 22 32 3e 26  ash sh ash) "2>&
5b10: 31 20 3e 22 29 29 29 0a 09 09 09 20 28 66 75 6c  1 >"))).... (ful
5b20: 6c 63 6d 64 20 20 20 20 28 63 6f 6e 63 20 22 28  lcmd    (conc "(
5b30: 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73  " (string-inters
5b40: 70 65 72 73 65 20 0a 09 09 09 09 09 09 28 63 6f  perse .......(co
5b50: 6e 73 20 63 6d 64 20 70 61 72 61 6d 73 29 20 22  ns cmd params) "
5b60: 20 22 29 0a 09 09 09 09 09 20 20 20 22 29 20 22   ")......   ") "
5b70: 20 72 65 64 69 72 20 22 20 22 20 6c 6f 67 66 69   redir " " logfi
5b80: 6c 65 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 6d  le)))...    ;; m
5b90: 61 72 6b 20 74 68 65 20 73 74 61 72 74 20 6f 66  ark the start of
5ba0: 20 74 68 65 20 74 65 73 74 0a 09 09 20 20 20 20   the test...    
5bb0: 28 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74  (teststep-set-st
5bc0: 61 74 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20  atus! db run-id 
5bd0: 74 65 73 74 2d 6e 61 6d 65 20 73 74 65 70 6e 61  test-name stepna
5be0: 6d 65 20 22 73 74 61 72 74 22 20 22 6e 2f 61 22  me "start" "n/a"
5bf0: 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67   itemdat (args:g
5c00: 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09  et-arg "-m"))...
5c10: 20 20 20 20 3b 3b 20 63 6c 6f 73 65 20 74 68 65      ;; close the
5c20: 20 64 62 0a 09 09 20 20 20 20 28 73 71 6c 69 74   db...    (sqlit
5c30: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29  e3:finalize! db)
5c40: 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e 20 74 68  ...    ;; run th
5c50: 65 20 74 65 73 74 20 73 74 65 70 0a 09 09 20 20  e test step...  
5c60: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32    (debug:print 2
5c70: 20 22 49 4e 46 4f 3a 20 52 75 6e 6e 69 6e 67 20   "INFO: Running 
5c80: 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 5c 22 22  \"" fullcmd "\""
5c90: 29 0a 09 09 20 20 20 20 28 63 68 61 6e 67 65 2d  )...    (change-
5ca0: 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 69  directory starti
5cb0: 6e 67 64 69 72 29 0a 09 09 20 20 20 20 28 73 65  ngdir)...    (se
5cc0: 74 21 20 65 78 69 74 73 74 61 74 20 28 73 79 73  t! exitstat (sys
5cd0: 74 65 6d 20 66 75 6c 6c 63 6d 64 29 29 20 3b 3b  tem fullcmd)) ;;
5ce0: 20 63 6d 64 20 70 61 72 61 6d 73 29 29 0a 09 09   cmd params))...
5cf0: 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61      (set! *globa
5d00: 6c 65 78 69 74 73 74 61 74 75 73 2a 20 65 78 69  lexitstatus* exi
5d10: 74 73 74 61 74 29 0a 09 09 20 20 20 20 28 63 68  tstat)...    (ch
5d20: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74  ange-directory t
5d30: 65 73 74 70 61 74 68 29 0a 09 09 20 20 20 20 3b  estpath)...    ;
5d40: 3b 20 72 65 2d 6f 70 65 6e 20 74 68 65 20 64 62  ; re-open the db
5d50: 0a 09 09 20 20 20 20 28 73 65 74 21 20 64 62 20  ...    (set! db 
5d60: 28 6f 70 65 6e 2d 64 62 29 29 20 0a 09 09 20 20  (open-db)) ...  
5d70: 20 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20    ;; run logpro 
5d80: 69 66 20 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b  if applicable ;;
5d90: 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c   (process-run "l
5da0: 73 22 20 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20  s" (list "/foo" 
5db0: 22 32 3e 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67  "2>&1" "blah.log
5dc0: 22 29 29 0a 09 09 20 20 20 20 28 69 66 20 6c 6f  "))...    (if lo
5dd0: 67 70 72 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74  gprofile....(let
5de0: 2a 20 28 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20  * ((htmllogfile 
5df0: 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22  (conc stepname "
5e00: 2e 68 74 6d 6c 22 29 29 0a 09 09 09 20 20 20 20  .html"))....    
5e10: 20 20 20 28 6f 6c 64 65 78 69 74 73 74 61 74 20     (oldexitstat 
5e20: 65 78 69 74 73 74 61 74 29 0a 09 09 09 20 20 20  exitstat)....   
5e30: 20 20 20 20 28 63 6d 64 20 20 20 20 20 20 20 20      (cmd        
5e40: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70   (string-intersp
5e50: 65 72 73 65 20 28 6c 69 73 74 20 22 6c 6f 67 70  erse (list "logp
5e60: 72 6f 22 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68  ro" logprofile h
5e70: 74 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c  tmllogfile "<" l
5e80: 6f 67 66 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63  ogfile ">" (conc
5e90: 20 73 74 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70   stepname "_logp
5ea0: 72 6f 2e 6c 6f 67 22 29 29 20 22 20 22 29 29 29  ro.log")) " ")))
5eb0: 0a 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69  ....  (debug:pri
5ec0: 6e 74 20 32 20 22 49 4e 46 4f 3a 20 72 75 6e 6e  nt 2 "INFO: runn
5ed0: 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 22  ing \"" cmd "\""
5ee0: 29 0a 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64  )....  (change-d
5ef0: 69 72 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e  irectory startin
5f00: 67 64 69 72 29 0a 09 09 09 20 20 28 73 65 74 21  gdir)....  (set!
5f10: 20 65 78 69 74 73 74 61 74 20 28 73 79 73 74 65   exitstat (syste
5f20: 6d 20 63 6d 64 29 29 0a 09 09 09 20 20 28 73 65  m cmd))....  (se
5f30: 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74  t! *globalexitst
5f40: 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 29 20  atus* exitstat) 
5f50: 3b 3b 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 0a  ;; no necessary.
5f60: 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72  ...  (change-dir
5f70: 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 68 29  ectory testpath)
5f80: 0a 09 09 09 20 20 28 74 65 73 74 2d 73 65 74 2d  ....  (test-set-
5f90: 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 74  log! db run-id t
5fa0: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74  est-name itemdat
5fb0: 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 29 29 29 0a   htmllogfile))).
5fc0: 09 09 20 20 20 20 28 74 65 73 74 73 74 65 70 2d  ..    (teststep-
5fd0: 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 72  set-status! db r
5fe0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20  un-id test-name 
5ff0: 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65  stepname "end" e
6000: 78 69 74 73 74 61 74 20 69 74 65 6d 64 61 74 20  xitstat itemdat 
6010: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d  (args:get-arg "-
6020: 6d 22 29 29 0a 09 09 20 20 20 20 28 73 71 6c 69  m"))...    (sqli
6030: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62  te3:finalize! db
6040: 29 0a 09 09 20 20 20 20 28 69 66 20 28 6e 6f 74  )...    (if (not
6050: 20 28 65 71 3f 20 65 78 69 74 73 74 61 74 20 30   (eq? exitstat 0
6060: 29 29 0a 09 09 09 28 65 78 69 74 20 32 35 34 29  ))....(exit 254)
6070: 29 20 3b 3b 20 28 65 78 69 74 20 65 78 69 74 73  ) ;; (exit exits
6080: 74 61 74 29 20 64 6f 65 73 6e 27 74 20 77 6f 72  tat) doesn't wor
6090: 6b 3f 21 3f 0a 09 09 20 20 3b 3b 20 6f 70 65 6e  k?!?...  ;; open
60a0: 20 74 68 65 20 64 62 0a 09 09 20 20 3b 3b 20 6d   the db...  ;; m
60b0: 61 72 6b 20 74 68 65 20 65 6e 64 20 6f 66 20 74  ark the end of t
60c0: 68 65 20 74 65 73 74 0a 09 09 20 20 29 29 29 0a  he test...  ))).
60d0: 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74  .  (if (args:get
60e0: 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74  -arg "-test-stat
60f0: 75 73 22 29 0a 09 20 20 20 20 20 20 28 6c 65 74  us")..      (let
6100: 20 28 28 6e 65 77 73 74 61 74 75 73 20 28 63 6f   ((newstatus (co
6110: 6e 64 0a 09 09 09 09 28 28 6e 75 6d 62 65 72 3f  nd.....((number?
6120: 20 73 74 61 74 75 73 29 20 20 20 20 20 20 20 28   status)       (
6130: 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75  if (equal? statu
6140: 73 20 30 29 20 22 50 41 53 53 22 20 22 46 41 49  s 0) "PASS" "FAI
6150: 4c 22 29 29 0a 09 09 09 09 28 28 73 74 72 69 6e  L")).....((strin
6160: 67 2d 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 73  g->number status
6170: 29 28 69 66 20 28 65 71 75 61 6c 3f 20 28 73 74  )(if (equal? (st
6180: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 61  ring->number sta
6190: 74 75 73 29 20 30 29 20 22 50 41 53 53 22 20 22  tus) 0) "PASS" "
61a0: 46 41 49 4c 22 29 29 0a 09 09 09 09 28 65 6c 73  FAIL")).....(els
61b0: 65 20 73 74 61 74 75 73 29 29 29 29 0a 09 09 28  e status))))...(
61c0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21  test-set-status!
61d0: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d   db run-id test-
61e0: 6e 61 6d 65 20 73 74 61 74 65 20 6e 65 77 73 74  name state newst
61f0: 61 74 75 73 20 69 74 65 6d 64 61 74 20 28 61 72  atus itemdat (ar
6200: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29  gs:get-arg "-m")
6210: 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 61  ))..      (if (a
6220: 6e 64 20 73 74 61 74 65 20 73 74 61 74 75 73 29  nd state status)
6230: 0a 09 09 20 20 28 69 66 20 28 6e 6f 74 20 28 61  ...  (if (not (a
6240: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65  rgs:get-arg "-se
6250: 74 6c 6f 67 22 29 29 0a 09 09 20 20 20 20 20 20  tlog"))...      
6260: 28 62 65 67 69 6e 0a 09 09 09 28 64 65 62 75 67  (begin....(debug
6270: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a  :print 0 "ERROR:
6280: 20 59 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66   You must specif
6290: 79 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74  y :state and :st
62a0: 61 74 75 73 20 77 69 74 68 20 65 76 65 72 79 20  atus with every 
62b0: 63 61 6c 6c 20 74 6f 20 2d 74 65 73 74 2d 73 74  call to -test-st
62c0: 61 74 75 73 5c 6e 22 20 68 65 6c 70 29 0a 09 09  atus\n" help)...
62d0: 09 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69  .(sqlite3:finali
62e0: 7a 65 21 20 64 62 29 0a 09 09 09 28 65 78 69 74  ze! db)....(exit
62f0: 20 36 29 29 29 29 29 0a 09 20 20 28 73 71 6c 69   6)))))..  (sqli
6300: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62  te3:finalize! db
6310: 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 73  )..  (set! *dids
6320: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29  omething* #t))))
6330: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d  ..(if (args:get-
6340: 61 72 67 20 22 2d 73 68 6f 77 6b 65 79 73 22 29  arg "-showkeys")
6350: 0a 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 23  .    (let ((db #
6360: 66 29 0a 09 20 20 28 6b 65 79 73 20 23 66 29 29  f)..  (keys #f))
6370: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20  .      (if (not 
6380: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29  (setup-for-run))
6390: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20  ..  (begin..    
63a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22  (debug:print 0 "
63b0: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c  Failed to setup,
63c0: 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20   exiting")..    
63d0: 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20  (exit 1))).     
63e0: 20 28 73 65 74 21 20 64 62 20 28 6f 70 65 6e 2d   (set! db (open-
63f0: 64 62 29 29 0a 20 20 20 20 20 20 28 73 65 74 21  db)).      (set!
6400: 20 6b 65 79 73 20 28 64 62 2d 67 65 74 2d 6b 65   keys (db-get-ke
6410: 79 73 20 64 62 29 29 0a 20 20 20 20 20 20 28 64  ys db)).      (d
6420: 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 4b 65  ebug:print 1 "Ke
6430: 79 73 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e  ys: " (string-in
6440: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 6b  tersperse (map k
6450: 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65  ey:get-fieldname
6460: 20 6b 65 79 73 29 20 22 2c 20 22 29 29 0a 20 20   keys) ", ")).  
6470: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e      (sqlite3:fin
6480: 61 6c 69 7a 65 21 20 64 62 29 0a 20 20 20 20 20  alize! db).     
6490: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74   (set! *didsomet
64a0: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66  hing* #t)))..(if
64b0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22   (args:get-arg "
64c0: 2d 67 75 69 22 29 0a 20 20 20 20 28 62 65 67 69  -gui").    (begi
64d0: 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70  n.      (debug:p
64e0: 72 69 6e 74 20 30 20 22 4c 6f 6f 6b 20 61 74 20  rint 0 "Look at 
64f0: 74 68 65 20 64 61 73 68 62 6f 61 72 64 20 66 6f  the dashboard fo
6500: 72 20 6e 6f 77 22 29 0a 20 20 20 20 20 20 3b 3b  r now").      ;;
6510: 20 28 6d 65 67 61 74 65 73 74 2d 67 75 69 29 0a   (megatest-gui).
6520: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64        (set! *did
6530: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29  something* #t)))
6540: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ..;;============
6550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
6560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
6570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
6580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70  ==========.;; Up
6590: 64 61 74 65 20 74 68 65 20 64 61 74 61 62 61 73  date the databas
65a0: 65 20 73 63 68 65 6d 61 20 6f 6e 20 72 65 71 75  e schema on requ
65b0: 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  est.;;==========
65c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
65d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
65e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
65f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69  ============..(i
6600: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20  f (args:get-arg 
6610: 22 2d 72 65 62 75 69 6c 64 2d 64 62 22 29 0a 20  "-rebuild-db"). 
6620: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20     (begin.      
6630: 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d  (if (not (setup-
6640: 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 62 65  for-run))..  (be
6650: 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a  gin..    (debug:
6660: 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20  print 0 "Failed 
6670: 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e  to setup, exitin
6680: 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20  g") ..    (exit 
6690: 31 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6e 6f  1))).      ;; no
66a0: 77 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 64  w can find our d
66b0: 62 0a 20 20 20 20 20 20 28 73 65 74 21 20 64 62  b.      (set! db
66c0: 20 28 6f 70 65 6e 2d 64 62 29 29 0a 20 20 20 20   (open-db)).    
66d0: 20 20 28 70 61 74 63 68 2d 64 62 20 64 62 29 0a    (patch-db db).
66e0: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66        (sqlite3:f
66f0: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 20 20 20  inalize! db).   
6700: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d     (set! *didsom
6710: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28  ething* #t)))..(
6720: 69 66 20 28 6e 6f 74 20 2a 64 69 64 73 6f 6d 65  if (not *didsome
6730: 74 68 69 6e 67 2a 29 0a 20 20 20 20 28 64 65 62  thing*).    (deb
6740: 75 67 3a 70 72 69 6e 74 20 30 20 68 65 6c 70 29  ug:print 0 help)
6750: 29 0a 0a 28 69 66 20 28 6e 6f 74 20 28 65 71 3f  )..(if (not (eq?
6760: 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74   *globalexitstat
6770: 75 73 2a 20 30 29 29 0a 20 20 20 20 28 69 66 20  us* 0)).    (if 
6780: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72  (or (args:get-ar
6790: 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 28 61  g "-runtests")(a
67a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75  rgs:get-arg "-ru
67b0: 6e 61 6c 6c 22 29 29 0a 20 20 20 20 20 20 20 20  nall")).        
67c0: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20  (begin.         
67d0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30    (debug:print 0
67e0: 20 22 4e 4f 54 45 3a 20 53 75 62 70 72 6f 63 65   "NOTE: Subproce
67f0: 73 73 65 73 20 77 69 74 68 20 6e 6f 6e 2d 7a 65  sses with non-ze
6800: 72 6f 20 65 78 69 74 20 63 6f 64 65 20 64 65 74  ro exit code det
6810: 65 63 74 65 64 3a 20 22 20 2a 67 6c 6f 62 61 6c  ected: " *global
6820: 65 78 69 74 73 74 61 74 75 73 2a 29 0a 20 20 20  exitstatus*).   
6830: 20 20 20 20 20 20 20 20 28 65 78 69 74 20 30 29          (exit 0)
6840: 29 0a 20 20 20 20 20 20 20 20 28 63 61 73 65 20  ).        (case 
6850: 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75  *globalexitstatu
6860: 73 2a 0a 20 20 20 20 20 20 20 20 20 28 28 30 29  s*.         ((0)
6870: 28 65 78 69 74 20 30 29 29 0a 20 20 20 20 20 20  (exit 0)).      
6880: 20 20 20 28 28 31 29 28 65 78 69 74 20 31 29 29     ((1)(exit 1))
6890: 0a 20 20 20 20 20 20 20 20 20 28 28 32 29 28 65  .         ((2)(e
68a0: 78 69 74 20 32 29 29 0a 20 20 20 20 20 20 20 20  xit 2)).        
68b0: 20 28 65 6c 73 65 20 28 65 78 69 74 20 33 29 29   (else (exit 3))
68c0: 29 29 29 0a                                      ))).