Megatest

Hex Artifact Content
Login

Artifact fe4e95ca0af8fec8fdb5a48003f83d70b049c7fe:


0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79  ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c  right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64   Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70  ..;; .;;  This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61  rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74  vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69  he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72  on 2.0 or.;;  gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61  eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65  ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74   COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68  ails..;; .;;  Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69  is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55  stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20  T ANY WARRANTY; 
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65  without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72  .;;  implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e  ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e  TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43  ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45  ULAR.;;  PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d  ==========..;;==
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0220: 3d 3d 3d 3d 0a 3b 3b 20 44 61 74 61 62 61 73 65  ====.;; Database
0230: 20 61 63 63 65 73 73 0a 3b 3b 3d 3d 3d 3d 3d 3d   access.;;======
0240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0280: 0a 0a 28 72 65 71 75 69 72 65 2d 65 78 74 65 6e  ..(require-exten
0290: 73 69 6f 6e 20 28 73 72 66 69 20 31 38 29 20 65  sion (srfi 18) e
02a0: 78 74 72 61 73 20 74 63 70 29 20 3b 3b 20 20 72  xtras tcp) ;;  r
02b0: 70 63 29 0a 3b 3b 20 28 69 6d 70 6f 72 74 20 28  pc).;; (import (
02c0: 70 72 65 66 69 78 20 72 70 63 20 72 70 63 3a 29  prefix rpc rpc:)
02d0: 29 0a 0a 28 75 73 65 20 73 71 6c 69 74 65 33 20  )..(use sqlite3 
02e0: 73 72 66 69 2d 31 20 70 6f 73 69 78 20 72 65 67  srfi-1 posix reg
02f0: 65 78 20 72 65 67 65 78 2d 63 61 73 65 20 73 72  ex regex-case sr
0300: 66 69 2d 36 39 20 63 73 76 2d 78 6d 6c 20 73 31  fi-69 csv-xml s1
0310: 31 6e 20 6d 64 35 20 6d 65 73 73 61 67 65 2d 64  1n md5 message-d
0320: 69 67 65 73 74 20 62 61 73 65 36 34 29 0a 28 69  igest base64).(i
0330: 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 73 71  mport (prefix sq
0340: 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a 29 29  lite3 sqlite3:))
0350: 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78  .(import (prefix
0360: 20 62 61 73 65 36 34 20 62 61 73 65 36 34 3a 29   base64 base64:)
0370: 29 0a 0a 3b 3b 20 4e 6f 74 65 2c 20 74 72 79 20  )..;; Note, try 
0380: 74 6f 20 72 65 6d 6f 76 65 20 74 68 69 73 20 64  to remove this d
0390: 65 70 65 6e 64 65 6e 63 79 20 0a 28 75 73 65 20  ependency .(use 
03a0: 7a 6d 71 29 0a 0a 28 64 65 63 6c 61 72 65 20 28  zmq)..(declare (
03b0: 75 6e 69 74 20 64 62 29 29 0a 28 64 65 63 6c 61  unit db)).(decla
03c0: 72 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29  re (uses common)
03d0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73  ).(declare (uses
03e0: 20 6b 65 79 73 29 29 0a 28 64 65 63 6c 61 72 65   keys)).(declare
03f0: 20 28 75 73 65 73 20 6f 64 73 29 29 0a 28 64 65   (uses ods)).(de
0400: 63 6c 61 72 65 20 28 75 73 65 73 20 66 73 2d 74  clare (uses fs-t
0410: 72 61 6e 73 70 6f 72 74 29 29 0a 28 64 65 63 6c  ransport)).(decl
0420: 61 72 65 20 28 75 73 65 73 20 63 6c 69 65 6e 74  are (uses client
0430: 29 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f  ))..(include "co
0440: 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d  mmon_records.scm
0450: 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 5f  ").(include "db_
0460: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69  records.scm").(i
0470: 6e 63 6c 75 64 65 20 22 6b 65 79 5f 72 65 63 6f  nclude "key_reco
0480: 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75  rds.scm").(inclu
0490: 64 65 20 22 72 75 6e 5f 72 65 63 6f 72 64 73 2e  de "run_records.
04a0: 73 63 6d 22 29 0a 0a 3b 3b 20 74 69 6d 65 73 74  scm")..;; timest
04b0: 61 6d 70 20 74 79 70 65 20 28 76 61 6c 31 20 76  amp type (val1 v
04c0: 61 6c 32 20 2e 2e 2e 29 0a 3b 3b 20 74 79 70 65  al2 ...).;; type
04d0: 3a 20 6d 65 74 61 2d 69 6e 66 6f 2c 20 73 74 65  : meta-info, ste
04e0: 70 0a 28 64 65 66 69 6e 65 20 2a 69 6e 63 6f 6d  p.(define *incom
04f0: 69 6e 67 2d 77 72 69 74 65 73 2a 20 20 20 20 20  ing-writes*     
0500: 20 27 28 29 29 0a 28 64 65 66 69 6e 65 20 2a 63   '()).(define *c
0510: 6f 6d 70 6c 65 74 65 64 2d 77 72 69 74 65 73 2a  ompleted-writes*
0520: 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61     (make-hash-ta
0530: 62 6c 65 29 29 0a 28 64 65 66 69 6e 65 20 2a 69  ble)).(define *i
0540: 6e 63 6f 6d 69 6e 67 2d 6c 61 73 74 2d 74 69 6d  ncoming-last-tim
0550: 65 2a 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f  e* (current-seco
0560: 6e 64 73 29 29 0a 28 64 65 66 69 6e 65 20 2a 69  nds)).(define *i
0570: 6e 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 2a 20 20  ncoming-mutex*  
0580: 20 20 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 29     (make-mutex))
0590: 0a 28 64 65 66 69 6e 65 20 2a 63 6f 6d 70 6c 65  .(define *comple
05a0: 74 65 64 2d 6d 75 74 65 78 2a 20 20 20 20 28 6d  ted-mutex*    (m
05b0: 61 6b 65 2d 6d 75 74 65 78 29 29 0a 28 64 65 66  ake-mutex)).(def
05c0: 69 6e 65 20 2a 63 61 63 68 65 2d 6f 6e 2a 20 23  ine *cache-on* #
05d0: 66 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a  f)..(define (db:
05e0: 73 65 74 2d 73 79 6e 63 20 64 62 29 0a 20 20 28  set-sync db).  (
05f0: 6c 65 74 2a 20 28 28 73 79 6e 63 76 61 6c 20 20  let* ((syncval  
0600: 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a  (config-lookup *
0610: 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75  configdat* "setu
0620: 70 22 20 20 20 20 20 22 73 79 6e 63 68 72 6f 6e  p"     "synchron
0630: 6f 75 73 22 29 29 0a 09 20 28 76 61 6c 20 20 20  ous")).. (val   
0640: 20 20 20 28 63 6f 6e 64 20 20 20 3b 3b 20 30 20     (cond   ;; 0 
0650: 7c 20 4f 46 46 20 7c 20 31 20 7c 20 4e 4f 52 4d  | OFF | 1 | NORM
0660: 41 4c 20 7c 20 32 20 7c 20 46 55 4c 4c 3b 0a 09  AL | 2 | FULL;..
0670: 09 20 20 20 20 28 28 6e 6f 74 20 73 79 6e 63 76  .    ((not syncv
0680: 61 6c 29 20 23 66 29 0a 09 09 20 20 20 20 28 28  al) #f)...    ((
0690: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73  string->number s
06a0: 79 6e 63 76 61 6c 29 0a 09 09 20 20 20 20 20 28  yncval)...     (
06b0: 6c 65 74 20 28 28 76 61 6c 20 28 73 74 72 69 6e  let ((val (strin
06c0: 67 2d 3e 6e 75 6d 62 65 72 20 73 79 6e 63 76 61  g->number syncva
06d0: 6c 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 69  l)))...       (i
06e0: 66 20 28 6d 65 6d 62 65 72 20 76 61 6c 20 27 28  f (member val '(
06f0: 30 20 31 20 32 29 29 20 76 61 6c 20 23 66 29 29  0 1 2)) val #f))
0700: 29 0a 09 09 20 20 20 20 28 28 73 74 72 69 6e 67  )...    ((string
0710: 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 22  -match (regexp "
0720: 79 65 73 22 20 23 74 29 20 73 79 6e 63 76 61 6c  yes" #t) syncval
0730: 29 20 31 29 0a 09 09 20 20 20 20 28 28 73 74 72  ) 1)...    ((str
0740: 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78  ing-match (regex
0750: 70 20 22 6e 6f 22 20 20 23 74 29 20 73 79 6e 63  p "no"  #t) sync
0760: 76 61 6c 29 20 30 29 0a 09 09 20 20 20 20 28 28  val) 0)...    ((
0770: 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65  string-match (re
0780: 67 65 78 70 20 22 28 6f 66 66 7c 6e 6f 72 6d 61  gexp "(off|norma
0790: 6c 7c 66 75 6c 6c 29 22 20 23 74 29 20 73 79 6e  l|full)" #t) syn
07a0: 63 76 61 6c 29 20 73 79 6e 63 76 61 6c 29 0a 09  cval) syncval)..
07b0: 09 20 20 20 20 28 65 6c 73 65 20 0a 09 09 20 20  .    (else ...  
07c0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20     (debug:print 
07d0: 30 20 22 45 52 52 4f 52 3a 20 73 79 6e 63 68 72  0 "ERROR: synchr
07e0: 6f 6e 6f 75 73 20 6d 75 73 74 20 62 65 20 30 2c  onous must be 0,
07f0: 31 2c 32 2c 4f 46 46 2c 4e 4f 52 4d 41 4c 20 6f  1,2,OFF,NORMAL o
0800: 72 20 46 55 4c 4c 2c 20 79 6f 75 20 70 72 6f 76  r FULL, you prov
0810: 69 64 65 64 3a 20 22 20 73 79 6e 63 76 61 6c 29  ided: " syncval)
0820: 0a 09 09 20 20 20 20 20 23 66 29 29 29 29 0a 20  ...     #f)))). 
0830: 20 20 20 28 69 66 20 76 61 6c 0a 09 28 62 65 67     (if val..(beg
0840: 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69  in..  (debug:pri
0850: 6e 74 2d 69 6e 66 6f 20 39 20 22 64 62 3a 73 65  nt-info 9 "db:se
0860: 74 2d 73 79 6e 63 2c 20 73 65 74 74 69 6e 67 20  t-sync, setting 
0870: 70 72 61 67 6d 61 20 73 79 6e 63 68 72 6f 6e 6f  pragma synchrono
0880: 75 73 20 74 6f 20 22 20 76 61 6c 29 0a 09 20 20  us to " val)..  
0890: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65  (sqlite3:execute
08a0: 20 64 62 20 28 63 6f 6e 63 20 22 50 52 41 47 4d   db (conc "PRAGM
08b0: 41 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 3d 20  A synchronous = 
08c0: 27 22 20 76 61 6c 20 22 27 3b 22 29 29 29 29 29  '" val "';")))))
08d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e  )..(define (open
08e0: 2d 64 62 29 20 3b 3b 20 20 28 63 6f 6e 63 20 2a  -db) ;;  (conc *
08f0: 74 6f 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 74  toppath* "/megat
0900: 65 73 74 2e 64 62 22 29 20 28 63 61 72 20 2a 63  est.db") (car *c
0910: 6f 6e 66 69 67 69 6e 66 6f 2a 29 29 29 0a 20 20  onfiginfo*))).  
0920: 28 69 66 20 28 6e 6f 74 20 2a 74 6f 70 70 61 74  (if (not *toppat
0930: 68 2a 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e  h*).      (if (n
0940: 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75  ot (setup-for-ru
0950: 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20  n))..  (begin.. 
0960: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20     (debug:print 
0970: 30 20 22 45 52 52 4f 52 3a 20 41 74 74 65 6d 70  0 "ERROR: Attemp
0980: 74 65 64 20 74 6f 20 6f 70 65 6e 20 64 62 20 77  ted to open db w
0990: 68 65 6e 20 6e 6f 74 20 69 6e 20 6d 65 67 61 74  hen not in megat
09a0: 65 73 74 20 61 72 65 61 2e 20 45 78 69 74 69 6e  est area. Exitin
09b0: 67 2e 22 29 0a 09 20 20 20 20 28 65 78 69 74 29  g.")..    (exit)
09c0: 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 62  ))).  (let* ((db
09d0: 70 61 74 68 20 20 20 20 28 63 6f 6e 63 20 2a 74  path    (conc *t
09e0: 6f 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65  oppath* "/megate
09f0: 73 74 2e 64 62 22 29 29 20 3b 3b 20 66 6e 61 6d  st.db")) ;; fnam
0a00: 65 29 0a 09 20 28 64 62 65 78 69 73 74 73 20 20  e).. (dbexists  
0a10: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 62  (file-exists? db
0a20: 70 61 74 68 29 29 0a 09 20 28 64 62 20 20 20 20  path)).. (db    
0a30: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 6f 70 65      (sqlite3:ope
0a40: 6e 2d 64 61 74 61 62 61 73 65 20 64 62 70 61 74  n-database dbpat
0a50: 68 29 29 20 3b 3b 20 28 6e 65 76 65 72 2d 67 69  h)) ;; (never-gi
0a60: 76 65 2d 75 70 2d 6f 70 65 6e 2d 64 62 20 64 62  ve-up-open-db db
0a70: 70 61 74 68 29 29 0a 09 20 28 68 61 6e 64 6c 65  path)).. (handle
0a80: 72 20 20 20 28 6d 61 6b 65 2d 62 75 73 79 2d 74  r   (make-busy-t
0a90: 69 6d 65 6f 75 74 20 28 69 66 20 28 61 72 67 73  imeout (if (args
0aa0: 3a 67 65 74 2d 61 72 67 20 22 2d 6f 76 65 72 72  :get-arg "-overr
0ab0: 69 64 65 2d 74 69 6d 65 6f 75 74 22 29 0a 09 09  ide-timeout")...
0ac0: 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e  ...   (string->n
0ad0: 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d  umber (args:get-
0ae0: 61 72 67 20 22 2d 6f 76 65 72 72 69 64 65 2d 74  arg "-override-t
0af0: 69 6d 65 6f 75 74 22 29 29 0a 09 09 09 09 09 20  imeout"))...... 
0b00: 20 20 31 33 36 30 30 30 29 29 29 29 20 3b 3b 20    136000)))) ;; 
0b10: 31 33 36 30 30 30 29 29 29 20 3b 3b 20 31 33 36  136000))) ;; 136
0b20: 30 30 30 20 3d 20 32 2e 32 20 6d 69 6e 75 74 65  000 = 2.2 minute
0b30: 73 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69  s.    (debug:pri
0b40: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e  nt-info 11 "open
0b50: 2d 64 62 2c 20 64 62 70 61 74 68 3d 22 20 64 62  -db, dbpath=" db
0b60: 70 61 74 68 20 22 20 61 72 67 76 3d 22 20 28 61  path " argv=" (a
0b70: 72 67 76 29 29 0a 20 20 20 20 28 73 71 6c 69 74  rgv)).    (sqlit
0b80: 65 33 3a 73 65 74 2d 62 75 73 79 2d 68 61 6e 64  e3:set-busy-hand
0b90: 6c 65 72 21 20 64 62 20 68 61 6e 64 6c 65 72 29  ler! db handler)
0ba0: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 64 62  .    (if (not db
0bb0: 65 78 69 73 74 73 29 0a 09 28 64 62 3a 69 6e 69  exists)..(db:ini
0bc0: 74 69 61 6c 69 7a 65 20 64 62 29 29 0a 20 20 20  tialize db)).   
0bd0: 20 28 64 62 3a 73 65 74 2d 73 79 6e 63 20 64 62   (db:set-sync db
0be0: 29 0a 20 20 20 20 64 62 29 29 0a 0a 3b 3b 20 6b  ).    db))..;; k
0bf0: 65 65 70 69 6e 67 20 69 74 20 61 72 6f 75 6e 64  eeping it around
0c00: 20 66 6f 72 20 64 65 62 75 67 67 69 6e 67 20 70   for debugging p
0c10: 75 72 70 6f 73 65 73 20 6f 6e 6c 79 0a 28 64 65  urposes only.(de
0c20: 66 69 6e 65 20 28 6f 70 65 6e 2d 72 75 6e 2d 63  fine (open-run-c
0c30: 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f  lose-no-exceptio
0c40: 6e 2d 68 61 6e 64 6c 69 6e 67 20 20 70 72 6f 63  n-handling  proc
0c50: 20 69 64 62 20 2e 20 70 61 72 61 6d 73 29 0a 20   idb . params). 
0c60: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e   (debug:print-in
0c70: 66 6f 20 31 31 20 22 6f 70 65 6e 2d 72 75 6e 2d  fo 11 "open-run-
0c80: 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69  close-no-excepti
0c90: 6f 6e 2d 68 61 6e 64 6c 69 6e 67 20 53 54 41 52  on-handling STAR
0ca0: 54 20 67 69 76 65 6e 20 61 20 64 62 3d 22 20 28  T given a db=" (
0cb0: 69 66 20 69 64 62 20 22 79 65 73 20 22 20 22 6e  if idb "yes " "n
0cc0: 6f 20 22 29 20 22 2c 20 70 61 72 61 6d 73 3d 22  o ") ", params="
0cd0: 20 70 61 72 61 6d 73 29 0a 20 20 28 6c 65 74 2a   params).  (let*
0ce0: 20 28 28 64 62 20 20 20 28 69 66 20 69 64 62 20   ((db   (if idb 
0cf0: 0a 09 09 20 20 20 28 69 66 20 28 70 72 6f 63 65  ...   (if (proce
0d00: 64 75 72 65 3f 20 69 64 62 29 0a 09 09 20 20 20  dure? idb)...   
0d10: 20 20 20 20 28 69 64 62 29 0a 09 09 20 20 20 20      (idb)...    
0d20: 20 20 20 69 64 62 29 0a 09 09 20 20 20 28 6f 70     idb)...   (op
0d30: 65 6e 2d 64 62 29 29 29 0a 09 20 28 72 65 73 20  en-db))).. (res 
0d40: 23 66 29 29 0a 20 20 20 20 28 73 65 74 21 20 72  #f)).    (set! r
0d50: 65 73 20 28 61 70 70 6c 79 20 70 72 6f 63 20 64  es (apply proc d
0d60: 62 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28  b params)).    (
0d70: 69 66 20 28 6e 6f 74 20 69 64 62 29 28 73 71 6c  if (not idb)(sql
0d80: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64  ite3:finalize! d
0d90: 62 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70  b)).    (debug:p
0da0: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70  rint-info 11 "op
0db0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d  en-run-close-no-
0dc0: 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69  exception-handli
0dd0: 6e 67 20 45 4e 44 22 20 29 0a 20 20 20 20 72 65  ng END" ).    re
0de0: 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6f 70  s))..(define (op
0df0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 65 78 63  en-run-close-exc
0e00: 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 20  eption-handling 
0e10: 70 72 6f 63 20 69 64 62 20 2e 20 70 61 72 61 6d  proc idb . param
0e20: 73 29 0a 20 20 28 68 61 6e 64 6c 65 2d 65 78 63  s).  (handle-exc
0e30: 65 70 74 69 6f 6e 73 0a 20 20 20 65 78 6e 0a 20  eptions.   exn. 
0e40: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 28 64    (begin.     (d
0e50: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 58  ebug:print 0 "EX
0e60: 43 45 50 54 49 4f 4e 3a 20 64 61 74 61 62 61 73  CEPTION: databas
0e70: 65 20 70 72 6f 62 61 62 6c 79 20 6f 76 65 72 6c  e probably overl
0e80: 6f 61 64 65 64 3f 22 29 0a 20 20 20 20 20 28 64  oaded?").     (d
0e90: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 20 20  ebug:print 0 "  
0ea0: 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72  " ((condition-pr
0eb0: 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20  operty-accessor 
0ec0: 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65  'exn 'message) e
0ed0: 78 6e 29 29 0a 20 20 20 20 20 28 70 72 69 6e 74  xn)).     (print
0ee0: 2d 63 61 6c 6c 2d 63 68 61 69 6e 29 0a 20 20 20  -call-chain).   
0ef0: 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21    (thread-sleep!
0f00: 20 28 72 61 6e 64 6f 6d 20 31 32 30 29 29 0a 20   (random 120)). 
0f10: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74      (debug:print
0f20: 2d 69 6e 66 6f 20 30 20 22 74 72 79 69 6e 67 20  -info 0 "trying 
0f30: 64 62 20 63 61 6c 6c 20 6f 6e 65 20 6d 6f 72 65  db call one more
0f40: 20 74 69 6d 65 2e 2e 2e 2e 22 29 0a 20 20 20 20   time....").    
0f50: 20 28 61 70 70 6c 79 20 6f 70 65 6e 2d 72 75 6e   (apply open-run
0f60: 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74  -close-no-except
0f70: 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 20 70 72 6f  ion-handling pro
0f80: 63 20 69 64 62 20 70 61 72 61 6d 73 29 29 0a 20  c idb params)). 
0f90: 20 20 28 61 70 70 6c 79 20 6f 70 65 6e 2d 72 75    (apply open-ru
0fa0: 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70  n-close-no-excep
0fb0: 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 20 70 72  tion-handling pr
0fc0: 6f 63 20 69 64 62 20 70 61 72 61 6d 73 29 29 29  oc idb params)))
0fd0: 0a 0a 3b 3b 20 28 64 65 66 69 6e 65 20 6f 70 65  ..;; (define ope
0fe0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 6f 70 65 6e  n-run-close open
0ff0: 2d 72 75 6e 2d 63 6c 6f 73 65 2d 65 78 63 65 70  -run-close-excep
1000: 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 29 0a 28  tion-handling).(
1010: 64 65 66 69 6e 65 20 6f 70 65 6e 2d 72 75 6e 2d  define open-run-
1020: 63 6c 6f 73 65 20 6f 70 65 6e 2d 72 75 6e 2d 63  close open-run-c
1030: 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f  lose-no-exceptio
1040: 6e 2d 68 61 6e 64 6c 69 6e 67 29 0a 0a 28 64 65  n-handling)..(de
1050: 66 69 6e 65 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c  fine *global-del
1060: 74 61 2a 20 30 29 0a 28 64 65 66 69 6e 65 20 2a  ta* 0).(define *
1070: 6c 61 73 74 2d 67 6c 6f 62 61 6c 2d 64 65 6c 74  last-global-delt
1080: 61 2d 70 72 69 6e 74 65 64 2a 20 30 29 0a 0a 28  a-printed* 0)..(
1090: 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 72 75 6e  define (open-run
10a0: 2d 63 6c 6f 73 65 2d 6d 65 61 73 75 72 65 20 20  -close-measure  
10b0: 70 72 6f 63 20 69 64 62 20 2e 20 70 61 72 61 6d  proc idb . param
10c0: 73 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e  s).  (debug:prin
10d0: 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e 2d  t-info 11 "open-
10e0: 72 75 6e 2d 63 6c 6f 73 65 2d 6d 65 61 73 75 72  run-close-measur
10f0: 65 20 53 54 41 52 54 2c 20 69 64 62 3d 22 20 69  e START, idb=" i
1100: 64 62 20 22 2c 20 70 61 72 61 6d 73 3d 22 20 70  db ", params=" p
1110: 61 72 61 6d 73 29 0a 20 20 28 6c 65 74 2a 20 28  arams).  (let* (
1120: 28 73 74 61 72 74 2d 6d 73 20 28 63 75 72 72 65  (start-ms (curre
1130: 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29  nt-milliseconds)
1140: 29 0a 09 20 28 64 62 20 20 20 20 20 20 20 28 69  ).. (db       (i
1150: 66 20 69 64 62 20 69 64 62 20 28 6f 70 65 6e 2d  f idb idb (open-
1160: 64 62 29 29 29 0a 20 20 20 20 20 20 20 20 20 28  db))).         (
1170: 74 68 72 6f 74 74 6c 65 20 28 73 74 72 69 6e 67  throttle (string
1180: 2d 3e 6e 75 6d 62 65 72 20 28 63 6f 6e 66 69 67  ->number (config
1190: 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64  -lookup *configd
11a0: 61 74 2a 20 22 73 65 74 75 70 22 20 22 74 68 72  at* "setup" "thr
11b0: 6f 74 74 6c 65 22 29 29 29 29 0a 20 20 20 20 3b  ottle")))).    ;
11c0: 3b 20 28 64 62 3a 73 65 74 2d 73 79 6e 63 20 64  ; (db:set-sync d
11d0: 62 29 0a 20 20 20 20 28 73 65 74 21 20 72 65 73  b).    (set! res
11e0: 20 20 20 20 20 20 28 61 70 70 6c 79 20 70 72 6f        (apply pro
11f0: 63 20 64 62 20 70 61 72 61 6d 73 29 29 0a 20 20  c db params)).  
1200: 20 20 28 69 66 20 28 6e 6f 74 20 69 64 62 29 28    (if (not idb)(
1210: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65  sqlite3:finalize
1220: 21 20 64 62 29 29 0a 20 20 20 20 3b 3b 20 73 63  ! db)).    ;; sc
1230: 61 6c 65 20 62 79 20 31 30 2c 20 61 76 65 72 61  ale by 10, avera
1240: 67 65 20 77 69 74 68 20 63 75 72 72 65 6e 74 20  ge with current 
1250: 76 61 6c 75 65 2e 0a 20 20 20 20 28 73 65 74 21  value..    (set!
1260: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 20   *global-delta* 
1270: 28 2f 20 28 2b 20 2a 67 6c 6f 62 61 6c 2d 64 65  (/ (+ *global-de
1280: 6c 74 61 2a 20 28 2a 20 28 2d 20 28 63 75 72 72  lta* (* (- (curr
1290: 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73  ent-milliseconds
12a0: 29 20 73 74 61 72 74 2d 6d 73 29 0a 09 09 09 09  ) start-ms).....
12b0: 09 09 20 28 69 66 20 74 68 72 6f 74 74 6c 65 20  .. (if throttle 
12c0: 74 68 72 6f 74 74 6c 65 20 30 2e 30 31 29 29 29  throttle 0.01)))
12d0: 0a 09 09 09 20 20 20 20 32 29 29 0a 20 20 20 20  ....    2)).    
12e0: 28 69 66 20 28 3e 20 28 61 62 73 20 28 2d 20 2a  (if (> (abs (- *
12f0: 6c 61 73 74 2d 67 6c 6f 62 61 6c 2d 64 65 6c 74  last-global-delt
1300: 61 2d 70 72 69 6e 74 65 64 2a 20 2a 67 6c 6f 62  a-printed* *glob
1310: 61 6c 2d 64 65 6c 74 61 2a 29 29 20 30 2e 30 38  al-delta*)) 0.08
1320: 29 20 3b 3b 20 64 6f 6e 27 74 20 70 72 69 6e 74  ) ;; don't print
1330: 20 61 6c 6c 20 74 68 65 20 74 69 6d 65 2c 20 6f   all the time, o
1340: 6e 6c 79 20 69 66 20 69 74 20 63 68 61 6e 67 65  nly if it change
1350: 73 20 61 20 62 69 74 0a 09 28 62 65 67 69 6e 0a  s a bit..(begin.
1360: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d  .  (debug:print-
1370: 69 6e 66 6f 20 31 20 22 6c 61 75 6e 63 68 20 74  info 1 "launch t
1380: 68 72 6f 74 74 6c 65 20 66 61 63 74 6f 72 3d 22  hrottle factor="
1390: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29   *global-delta*)
13a0: 0a 09 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d  ..  (set! *last-
13b0: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 72 69  global-delta-pri
13c0: 6e 74 65 64 2a 20 2a 67 6c 6f 62 61 6c 2d 64 65  nted* *global-de
13d0: 6c 74 61 2a 29 29 29 0a 20 20 20 20 28 64 65 62  lta*))).    (deb
13e0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31  ug:print-info 11
13f0: 20 22 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65   "open-run-close
1400: 2d 6d 65 61 73 75 72 65 20 45 4e 44 22 20 29 0a  -measure END" ).
1410: 20 20 20 20 72 65 73 29 29 0a 0a 28 64 65 66 69      res))..(defi
1420: 6e 65 20 28 64 62 3a 69 6e 69 74 69 61 6c 69 7a  ne (db:initializ
1430: 65 20 64 62 29 0a 20 20 28 64 65 62 75 67 3a 70  e db).  (debug:p
1440: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62  rint-info 11 "db
1450: 3a 69 6e 69 74 69 61 6c 69 7a 65 20 53 54 41 52  :initialize STAR
1460: 54 22 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 6f  T").  (let* ((co
1470: 6e 66 69 67 64 61 74 20 28 63 61 72 20 2a 63 6f  nfigdat (car *co
1480: 6e 66 69 67 69 6e 66 6f 2a 29 29 20 20 3b 3b 20  nfiginfo*))  ;; 
1490: 74 75 74 20 74 75 74 2c 20 67 6c 6f 62 61 6c 20  tut tut, global 
14a0: 77 61 72 6e 69 6e 67 2e 2e 2e 0a 09 20 28 6b 65  warning..... (ke
14b0: 79 73 20 20 20 20 20 28 63 6f 6e 66 69 67 2d 67  ys     (config-g
14c0: 65 74 2d 66 69 65 6c 64 73 20 63 6f 6e 66 69 67  et-fields config
14d0: 64 61 74 29 29 0a 09 20 28 68 61 76 65 6b 65 79  dat)).. (havekey
14e0: 73 20 28 3e 20 28 6c 65 6e 67 74 68 20 6b 65 79  s (> (length key
14f0: 73 29 20 30 29 29 0a 09 20 28 6b 65 79 73 74 72  s) 0)).. (keystr
1500: 20 20 20 28 6b 65 79 73 2d 3e 6b 65 79 73 74 72     (keys->keystr
1510: 20 6b 65 79 73 29 29 0a 09 20 28 66 69 65 6c 64   keys)).. (field
1520: 73 74 72 20 28 6b 65 79 73 2d 3e 6b 65 79 2f 66  str (keys->key/f
1530: 69 65 6c 64 20 6b 65 79 73 29 29 29 0a 20 20 20  ield keys))).   
1540: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62   (for-each (lamb
1550: 64 61 20 28 6b 65 79 29 0a 09 09 28 6c 65 74 20  da (key)...(let 
1560: 28 28 6b 65 79 6e 20 28 76 65 63 74 6f 72 2d 72  ((keyn (vector-r
1570: 65 66 20 6b 65 79 20 30 29 29 29 0a 09 09 20 20  ef key 0)))...  
1580: 28 69 66 20 28 6d 65 6d 62 65 72 20 28 73 74 72  (if (member (str
1590: 69 6e 67 2d 64 6f 77 6e 63 61 73 65 20 6b 65 79  ing-downcase key
15a0: 6e 29 0a 09 09 09 20 20 20 20 20 20 28 6c 69 73  n)....      (lis
15b0: 74 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 61  t "runname" "sta
15c0: 74 65 22 20 22 73 74 61 74 75 73 22 20 22 6f 77  te" "status" "ow
15d0: 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 69 6d 65  ner" "event_time
15e0: 22 20 22 63 6f 6d 6d 65 6e 74 22 20 22 66 61 69  " "comment" "fai
15f0: 6c 5f 63 6f 75 6e 74 22 0a 09 09 09 09 20 20 20  l_count".....   
1600: 20 22 70 61 73 73 5f 63 6f 75 6e 74 22 29 29 0a   "pass_count")).
1610: 09 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09  ..      (begin..
1620: 09 09 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a  ..(print "ERROR:
1630: 20 79 6f 75 72 20 6b 65 79 20 63 61 6e 6e 6f 74   your key cannot
1640: 20 62 65 20 6e 61 6d 65 64 20 22 20 6b 65 79 6e   be named " keyn
1650: 20 22 20 61 73 20 74 68 69 73 20 63 6f 6e 66 6c   " as this confl
1660: 69 63 74 73 20 77 69 74 68 20 74 68 65 20 73 61  icts with the sa
1670: 6d 65 20 6e 61 6d 65 64 20 66 69 65 6c 64 20 69  me named field i
1680: 6e 20 74 68 65 20 72 75 6e 73 20 74 61 62 6c 65  n the runs table
1690: 22 29 0a 09 09 09 28 73 79 73 74 65 6d 20 28 63  ")....(system (c
16a0: 6f 6e 63 20 22 72 6d 20 2d 66 20 22 20 64 62 70  onc "rm -f " dbp
16b0: 61 74 68 29 29 0a 09 09 09 28 65 78 69 74 20 31  ath))....(exit 1
16c0: 29 29 29 29 29 0a 09 20 20 20 20 20 20 6b 65 79  )))))..      key
16d0: 73 29 0a 20 20 20 20 3b 3b 20 28 73 71 6c 69 74  s).    ;; (sqlit
16e0: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 50  e3:execute db "P
16f0: 52 41 47 4d 41 20 73 79 6e 63 68 72 6f 6e 6f 75  RAGMA synchronou
1700: 73 20 3d 20 4f 46 46 3b 22 29 0a 20 20 20 20 28  s = OFF;").    (
1710: 64 62 3a 73 65 74 2d 73 79 6e 63 20 64 62 29 0a  db:set-sync db).
1720: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65      (sqlite3:exe
1730: 63 75 74 65 20 64 62 20 22 43 52 45 41 54 45 20  cute db "CREATE 
1740: 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49  TABLE IF NOT EXI
1750: 53 54 53 20 6b 65 79 73 20 28 69 64 20 49 4e 54  STS keys (id INT
1760: 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59  EGER PRIMARY KEY
1770: 2c 20 66 69 65 6c 64 6e 61 6d 65 20 54 45 58 54  , fieldname TEXT
1780: 2c 20 66 69 65 6c 64 74 79 70 65 20 54 45 58 54  , fieldtype TEXT
1790: 2c 20 43 4f 4e 53 54 52 41 49 4e 54 20 6b 65 79  , CONSTRAINT key
17a0: 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55  constraint UNIQU
17b0: 45 20 28 66 69 65 6c 64 6e 61 6d 65 29 29 3b 22  E (fieldname));"
17c0: 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20  ).    (for-each 
17d0: 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09  (lambda (key)...
17e0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65  (sqlite3:execute
17f0: 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e 54 4f   db "INSERT INTO
1800: 20 6b 65 79 73 20 28 66 69 65 6c 64 6e 61 6d 65   keys (fieldname
1810: 2c 66 69 65 6c 64 74 79 70 65 29 20 56 41 4c 55  ,fieldtype) VALU
1820: 45 53 20 28 3f 2c 3f 29 3b 22 20 28 6b 65 79 3a  ES (?,?);" (key:
1830: 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65  get-fieldname ke
1840: 79 29 28 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64  y)(key:get-field
1850: 74 79 70 65 20 6b 65 79 29 29 29 0a 09 20 20 20  type key)))..   
1860: 20 20 20 6b 65 79 73 29 0a 20 20 20 20 28 73 71     keys).    (sq
1870: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62  lite3:execute db
1880: 20 28 63 6f 6e 63 20 0a 09 09 09 20 22 43 52 45   (conc .... "CRE
1890: 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54  ATE TABLE IF NOT
18a0: 20 45 58 49 53 54 53 20 72 75 6e 73 20 28 69 64   EXISTS runs (id
18b0: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59   INTEGER PRIMARY
18c0: 20 4b 45 59 2c 20 22 20 0a 09 09 09 20 66 69 65   KEY, " .... fie
18d0: 6c 64 73 74 72 20 28 69 66 20 68 61 76 65 6b 65  ldstr (if haveke
18e0: 79 73 20 22 2c 22 20 22 22 29 0a 09 09 09 20 22  ys "," "").... "
18f0: 72 75 6e 6e 61 6d 65 20 54 45 58 54 2c 22 0a 09  runname TEXT,"..
1900: 09 09 20 22 73 74 61 74 65 20 54 45 58 54 20 44  .. "state TEXT D
1910: 45 46 41 55 4c 54 20 27 27 2c 22 0a 09 09 09 20  EFAULT '',".... 
1920: 22 73 74 61 74 75 73 20 54 45 58 54 20 44 45 46  "status TEXT DEF
1930: 41 55 4c 54 20 27 27 2c 22 0a 09 09 09 20 22 6f  AULT '',".... "o
1940: 77 6e 65 72 20 54 45 58 54 20 44 45 46 41 55 4c  wner TEXT DEFAUL
1950: 54 20 27 27 2c 22 0a 09 09 09 20 22 65 76 65 6e  T '',".... "even
1960: 74 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 4d 50  t_time TIMESTAMP
1970: 2c 22 0a 09 09 09 20 22 63 6f 6d 6d 65 6e 74 20  ,".... "comment 
1980: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c  TEXT DEFAULT '',
1990: 22 0a 09 09 09 20 22 66 61 69 6c 5f 63 6f 75 6e  ".... "fail_coun
19a0: 74 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 4c  t INTEGER DEFAUL
19b0: 54 20 30 2c 22 0a 09 09 09 20 22 70 61 73 73 5f  T 0,".... "pass_
19c0: 63 6f 75 6e 74 20 49 4e 54 45 47 45 52 20 44 45  count INTEGER DE
19d0: 46 41 55 4c 54 20 30 2c 22 0a 09 09 09 20 22 43  FAULT 0,".... "C
19e0: 4f 4e 53 54 52 41 49 4e 54 20 72 75 6e 73 63 6f  ONSTRAINT runsco
19f0: 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 20  nstraint UNIQUE 
1a00: 28 72 75 6e 6e 61 6d 65 22 20 28 69 66 20 68 61  (runname" (if ha
1a10: 76 65 6b 65 79 73 20 22 2c 22 20 22 22 29 20 6b  vekeys "," "") k
1a20: 65 79 73 74 72 20 22 29 29 3b 22 29 29 0a 20 20  eystr "));")).  
1a30: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75    (sqlite3:execu
1a40: 74 65 20 64 62 20 28 63 6f 6e 63 20 22 43 52 45  te db (conc "CRE
1a50: 41 54 45 20 49 4e 44 45 58 20 72 75 6e 73 5f 69  ATE INDEX runs_i
1a60: 6e 64 65 78 20 4f 4e 20 72 75 6e 73 20 28 72 75  ndex ON runs (ru
1a70: 6e 6e 61 6d 65 22 20 28 69 66 20 68 61 76 65 6b  nname" (if havek
1a80: 65 79 73 20 22 2c 22 20 22 22 29 20 6b 65 79 73  eys "," "") keys
1a90: 74 72 20 22 29 3b 22 29 29 0a 20 20 20 20 28 73  tr ");")).    (s
1aa0: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64  qlite3:execute d
1ab0: 62 20 0a 09 09 20 20 20 20 20 22 43 52 45 41 54  b ...     "CREAT
1ac0: 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45  E TABLE IF NOT E
1ad0: 58 49 53 54 53 20 74 65 73 74 73 20 0a 20 20 20  XISTS tests .   
1ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1af0: 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49   (id INTEGER PRI
1b00: 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20  MARY KEY,.      
1b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72                 r
1b20: 75 6e 5f 69 64 20 20 20 20 20 49 4e 54 45 47 45  un_id     INTEGE
1b30: 52 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  R,.             
1b40: 20 20 20 20 20 20 20 20 74 65 73 74 6e 61 6d 65          testname
1b50: 20 20 20 54 45 58 54 2c 0a 20 20 20 20 20 20 20     TEXT,.       
1b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 68 6f                ho
1b70: 73 74 20 20 20 20 20 20 20 54 45 58 54 20 44 45  st       TEXT DE
1b80: 46 41 55 4c 54 20 27 6e 2f 61 27 2c 0a 20 20 20  FAULT 'n/a',.   
1b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1ba0: 20 20 63 70 75 6c 6f 61 64 20 20 20 20 52 45 41    cpuload    REA
1bb0: 4c 20 44 45 46 41 55 4c 54 20 2d 31 2c 0a 20 20  L DEFAULT -1,.  
1bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1bd0: 20 20 20 64 69 73 6b 66 72 65 65 20 20 20 49 4e     diskfree   IN
1be0: 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 2d 31  TEGER DEFAULT -1
1bf0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ,.              
1c00: 20 20 20 20 20 20 20 75 6e 61 6d 65 20 20 20 20         uname    
1c10: 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27    TEXT DEFAULT '
1c20: 6e 2f 61 27 2c 20 0a 20 20 20 20 20 20 20 20 20  n/a', .         
1c30: 20 20 20 20 20 20 20 20 20 20 20 20 72 75 6e 64              rund
1c40: 69 72 20 20 20 20 20 54 45 58 54 20 44 45 46 41  ir     TEXT DEFA
1c50: 55 4c 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20  ULT 'n/a',.     
1c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1c70: 73 68 6f 72 74 64 69 72 20 20 20 54 45 58 54 20  shortdir   TEXT 
1c80: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20  DEFAULT '',.    
1c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1ca0: 20 69 74 65 6d 5f 70 61 74 68 20 20 54 45 58 54   item_path  TEXT
1cb0: 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20   DEFAULT '',.   
1cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1cd0: 20 20 73 74 61 74 65 20 20 20 20 20 20 54 45 58    state      TEX
1ce0: 54 20 44 45 46 41 55 4c 54 20 27 4e 4f 54 5f 53  T DEFAULT 'NOT_S
1cf0: 54 41 52 54 45 44 27 2c 0a 20 20 20 20 20 20 20  TARTED',.       
1d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74                st
1d10: 61 74 75 73 20 20 20 20 20 54 45 58 54 20 44 45  atus     TEXT DE
1d20: 46 41 55 4c 54 20 27 46 41 49 4c 27 2c 0a 20 20  FAULT 'FAIL',.  
1d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1d40: 20 20 20 61 74 74 65 6d 70 74 6e 75 6d 20 49 4e     attemptnum IN
1d50: 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 30 2c  TEGER DEFAULT 0,
1d60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
1d70: 20 20 20 20 20 20 66 69 6e 61 6c 5f 6c 6f 67 66        final_logf
1d80: 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 6c   TEXT DEFAULT 'l
1d90: 6f 67 73 2f 66 69 6e 61 6c 2e 6c 6f 67 27 2c 0a  ogs/final.log',.
1da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1db0: 20 20 20 20 20 6c 6f 67 64 61 74 20 20 20 20 20       logdat     
1dc0: 42 4c 4f 42 2c 20 0a 20 20 20 20 20 20 20 20 20  BLOB, .         
1dd0: 20 20 20 20 20 20 20 20 20 20 20 20 72 75 6e 5f              run_
1de0: 64 75 72 61 74 69 6f 6e 20 49 4e 54 45 47 45 52  duration INTEGER
1df0: 20 44 45 46 41 55 4c 54 20 30 2c 0a 20 20 20 20   DEFAULT 0,.    
1e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1e10: 20 63 6f 6d 6d 65 6e 74 20 20 20 20 54 45 58 54   comment    TEXT
1e20: 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20   DEFAULT '',.   
1e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1e40: 20 20 65 76 65 6e 74 5f 74 69 6d 65 20 54 49 4d    event_time TIM
1e50: 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20  ESTAMP,.        
1e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 66 61 69               fai
1e70: 6c 5f 63 6f 75 6e 74 20 49 4e 54 45 47 45 52 20  l_count INTEGER 
1e80: 44 45 46 41 55 4c 54 20 30 2c 0a 20 20 20 20 20  DEFAULT 0,.     
1e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1ea0: 70 61 73 73 5f 63 6f 75 6e 74 20 49 4e 54 45 47  pass_count INTEG
1eb0: 45 52 20 44 45 46 41 55 4c 54 20 30 2c 0a 20 20  ER DEFAULT 0,.  
1ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1ed0: 20 20 20 61 72 63 68 69 76 65 64 20 20 20 49 4e     archived   IN
1ee0: 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 30 2c  TEGER DEFAULT 0,
1ef0: 20 2d 2d 20 30 3d 6e 6f 2c 20 31 3d 69 6e 20 70   -- 0=no, 1=in p
1f00: 72 6f 67 72 65 73 73 2c 20 32 3d 79 65 73 0a 20  rogress, 2=yes. 
1f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1f20: 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 74      CONSTRAINT t
1f30: 65 73 74 73 63 6f 6e 73 74 72 61 69 6e 74 20 55  estsconstraint U
1f40: 4e 49 51 55 45 20 28 72 75 6e 5f 69 64 2c 20 74  NIQUE (run_id, t
1f50: 65 73 74 6e 61 6d 65 2c 20 69 74 65 6d 5f 70 61  estname, item_pa
1f60: 74 68 29 0a 20 20 20 20 20 20 20 20 20 20 29 3b  th).          );
1f70: 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a  ").    (sqlite3:
1f80: 65 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41  execute db "CREA
1f90: 54 45 20 49 4e 44 45 58 20 74 65 73 74 73 5f 69  TE INDEX tests_i
1fa0: 6e 64 65 78 20 4f 4e 20 74 65 73 74 73 20 28 72  ndex ON tests (r
1fb0: 75 6e 5f 69 64 2c 20 74 65 73 74 6e 61 6d 65 2c  un_id, testname,
1fc0: 20 69 74 65 6d 5f 70 61 74 68 29 3b 22 29 0a 20   item_path);"). 
1fd0: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63     (sqlite3:exec
1fe0: 75 74 65 20 64 62 20 22 43 52 45 41 54 45 20 56  ute db "CREATE V
1ff0: 49 45 57 20 72 75 6e 73 5f 74 65 73 74 73 20 41  IEW runs_tests A
2000: 53 20 53 45 4c 45 43 54 20 2a 20 46 52 4f 4d 20  S SELECT * FROM 
2010: 72 75 6e 73 20 49 4e 4e 45 52 20 4a 4f 49 4e 20  runs INNER JOIN 
2020: 74 65 73 74 73 20 4f 4e 20 72 75 6e 73 2e 69 64  tests ON runs.id
2030: 3d 74 65 73 74 73 2e 72 75 6e 5f 69 64 3b 22 29  =tests.run_id;")
2040: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78  .    (sqlite3:ex
2050: 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 45  ecute db "CREATE
2060: 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58   TABLE IF NOT EX
2070: 49 53 54 53 20 74 65 73 74 5f 73 74 65 70 73 20  ISTS test_steps 
2080: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
2090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
20a0: 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41  id INTEGER PRIMA
20b0: 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20  RY KEY,.        
20c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
20d0: 20 20 20 20 20 20 20 74 65 73 74 5f 69 64 20 49         test_id I
20e0: 4e 54 45 47 45 52 2c 20 0a 20 20 20 20 20 20 20  NTEGER, .       
20f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2100: 20 20 20 20 20 20 20 20 73 74 65 70 6e 61 6d 65          stepname
2110: 20 54 45 58 54 2c 20 0a 20 20 20 20 20 20 20 20   TEXT, .        
2120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2130: 20 20 20 20 20 20 20 73 74 61 74 65 20 54 45 58         state TEX
2140: 54 20 44 45 46 41 55 4c 54 20 27 4e 4f 54 5f 53  T DEFAULT 'NOT_S
2150: 54 41 52 54 45 44 27 2c 20 0a 20 20 20 20 20 20  TARTED', .      
2160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2170: 20 20 20 20 20 20 20 20 20 73 74 61 74 75 73 20           status 
2180: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f  TEXT DEFAULT 'n/
2190: 61 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20  a',.            
21a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
21b0: 20 20 20 65 76 65 6e 74 5f 74 69 6d 65 20 54 49     event_time TI
21c0: 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20  MESTAMP,.       
21d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
21e0: 20 20 20 20 20 20 20 20 63 6f 6d 6d 65 6e 74 20          comment 
21f0: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c  TEXT DEFAULT '',
2200: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
2210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2220: 6c 6f 67 66 69 6c 65 20 54 45 58 54 20 44 45 46  logfile TEXT DEF
2230: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20  AULT '',.       
2240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2250: 20 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49          CONSTRAI
2260: 4e 54 20 74 65 73 74 5f 73 74 65 70 73 5f 63 6f  NT test_steps_co
2270: 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 20  nstraint UNIQUE 
2280: 28 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 6d  (test_id,stepnam
2290: 65 2c 73 74 61 74 65 29 29 3b 22 29 0a 20 20 20  e,state));").   
22a0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74   (sqlite3:execut
22b0: 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42  e db "CREATE TAB
22c0: 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53  LE IF NOT EXISTS
22d0: 20 65 78 74 72 61 64 61 74 20 28 69 64 20 49 4e   extradat (id IN
22e0: 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45  TEGER PRIMARY KE
22f0: 59 2c 20 72 75 6e 5f 69 64 20 49 4e 54 45 47 45  Y, run_id INTEGE
2300: 52 2c 20 6b 65 79 20 54 45 58 54 2c 20 76 61 6c  R, key TEXT, val
2310: 20 54 45 58 54 29 3b 22 29 0a 20 20 20 20 28 73   TEXT);").    (s
2320: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64  qlite3:execute d
2330: 62 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20  b "CREATE TABLE 
2340: 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 6d 65  IF NOT EXISTS me
2350: 74 61 64 61 74 20 28 69 64 20 49 4e 54 45 47 45  tadat (id INTEGE
2360: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 20 76  R PRIMARY KEY, v
2370: 61 72 20 54 45 58 54 2c 20 76 61 6c 20 54 45 58  ar TEXT, val TEX
2380: 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  T,.             
2390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
23a0: 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20       CONSTRAINT 
23b0: 6d 65 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 69  metadat_constrai
23c0: 6e 74 20 55 4e 49 51 55 45 20 28 76 61 72 29 29  nt UNIQUE (var))
23d0: 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33  ;").    (sqlite3
23e0: 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 52 45  :execute db "CRE
23f0: 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54  ATE TABLE IF NOT
2400: 20 45 58 49 53 54 53 20 61 63 63 65 73 73 5f 6c   EXISTS access_l
2410: 6f 67 20 28 69 64 20 49 4e 54 45 47 45 52 20 50  og (id INTEGER P
2420: 52 49 4d 41 52 59 20 4b 45 59 2c 20 75 73 65 72  RIMARY KEY, user
2430: 20 54 45 58 54 2c 20 61 63 63 65 73 73 65 64 20   TEXT, accessed 
2440: 54 49 4d 45 53 54 41 4d 50 2c 20 61 72 67 73 20  TIMESTAMP, args 
2450: 54 45 58 54 29 3b 22 29 0a 20 20 20 20 28 73 71  TEXT);").    (sq
2460: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62  lite3:execute db
2470: 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49   "CREATE TABLE I
2480: 46 20 4e 4f 54 20 45 58 49 53 54 53 20 74 65 73  F NOT EXISTS tes
2490: 74 5f 6d 65 74 61 20 28 69 64 20 49 4e 54 45 47  t_meta (id INTEG
24a0: 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a  ER PRIMARY KEY,.
24b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
24c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
24d0: 20 20 20 20 20 74 65 73 74 6e 61 6d 65 20 20 20       testname   
24e0: 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27   TEXT DEFAULT ''
24f0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ,.              
2500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2510: 20 20 20 20 20 20 20 61 75 74 68 6f 72 20 20 20         author   
2520: 20 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20     TEXT DEFAULT 
2530: 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20  '',.            
2540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2550: 20 20 20 20 20 20 20 20 20 6f 77 6e 65 72 20 20           owner  
2560: 20 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c       TEXT DEFAUL
2570: 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20  T '',.          
2580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2590: 20 20 20 20 20 20 20 20 20 20 20 64 65 73 63 72             descr
25a0: 69 70 74 69 6f 6e 20 54 45 58 54 20 44 45 46 41  iption TEXT DEFA
25b0: 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20  ULT '',.        
25c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
25d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 76               rev
25e0: 69 65 77 65 64 20 20 20 20 54 49 4d 45 53 54 41  iewed    TIMESTA
25f0: 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20  MP,.            
2600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2610: 20 20 20 20 20 20 20 20 20 69 74 65 72 61 74 65           iterate
2620: 64 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c  d    TEXT DEFAUL
2630: 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20  T '',.          
2640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2650: 20 20 20 20 20 20 20 20 20 20 20 61 76 67 5f 72             avg_r
2660: 75 6e 74 69 6d 65 20 52 45 41 4c 2c 0a 20 20 20  untime REAL,.   
2670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2690: 20 20 61 76 67 5f 64 69 73 6b 20 20 20 20 52 45    avg_disk    RE
26a0: 41 4c 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20  AL,.            
26b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
26c0: 20 20 20 20 20 20 20 20 20 74 61 67 73 20 20 20           tags   
26d0: 20 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c       TEXT DEFAUL
26e0: 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20  T '',.          
26f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2700: 20 20 20 20 20 20 20 20 20 20 20 6a 6f 62 67 72             jobgr
2710: 6f 75 70 20 20 20 20 54 45 58 54 20 44 45 46 41  oup    TEXT DEFA
2720: 55 4c 54 20 27 64 65 66 61 75 6c 74 27 2c 0a 20  ULT 'default',. 
2730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 43                 C
2750: 4f 4e 53 54 52 41 49 4e 54 20 74 65 73 74 5f 6d  ONSTRAINT test_m
2760: 65 74 61 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55  eta_constraint U
2770: 4e 49 51 55 45 20 28 74 65 73 74 6e 61 6d 65 29  NIQUE (testname)
2780: 29 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65  );").    (sqlite
2790: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 52  3:execute db "CR
27a0: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f  EATE TABLE IF NO
27b0: 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 64 61  T EXISTS test_da
27c0: 74 61 20 28 69 64 20 49 4e 54 45 47 45 52 20 50  ta (id INTEGER P
27d0: 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20  RIMARY KEY,.    
27e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
27f0: 20 20 20 20 20 20 20 20 20 20 20 20 74 65 73 74              test
2800: 5f 69 64 20 49 4e 54 45 47 45 52 2c 0a 20 20 20  _id INTEGER,.   
2810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2820: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 61 74               cat
2830: 65 67 6f 72 79 20 54 45 58 54 20 44 45 46 41 55  egory TEXT DEFAU
2840: 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20  LT '',.         
2850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2860: 20 20 20 20 20 20 20 76 61 72 69 61 62 6c 65 20         variable 
2870: 54 45 58 54 2c 0a 09 20 20 20 20 20 20 20 20 20  TEXT,..         
2880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76                 v
2890: 61 6c 75 65 20 52 45 41 4c 2c 0a 09 20 20 20 20  alue REAL,..    
28a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
28b0: 20 20 20 20 65 78 70 65 63 74 65 64 20 52 45 41      expected REA
28c0: 4c 2c 0a 09 20 20 20 20 20 20 20 20 20 20 20 20  L,..            
28d0: 20 20 20 20 20 20 20 20 20 20 20 20 74 6f 6c 20              tol 
28e0: 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 20 20 20  REAL,.          
28f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2900: 20 20 20 20 20 20 75 6e 69 74 73 20 54 45 58 54        units TEXT
2910: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ,.              
2920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2930: 20 20 63 6f 6d 6d 65 6e 74 20 54 45 58 54 20 44    comment TEXT D
2940: 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20  EFAULT '',.     
2950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2960: 20 20 20 20 20 20 20 20 20 20 20 73 74 61 74 75             statu
2970: 73 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27  s TEXT DEFAULT '
2980: 6e 2f 61 27 2c 0a 20 20 20 20 20 20 20 20 20 20  n/a',.          
2990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
29a0: 20 20 20 20 20 20 74 79 70 65 20 54 45 58 54 20        type TEXT 
29b0: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20  DEFAULT '',.    
29c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
29d0: 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 54 52            CONSTR
29e0: 41 49 4e 54 20 74 65 73 74 5f 64 61 74 61 5f 63  AINT test_data_c
29f0: 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45  onstraint UNIQUE
2a00: 20 28 74 65 73 74 5f 69 64 2c 63 61 74 65 67 6f   (test_id,catego
2a10: 72 79 2c 76 61 72 69 61 62 6c 65 29 29 3b 22 29  ry,variable));")
2a20: 0a 20 20 20 20 3b 3b 20 4d 75 73 74 20 64 6f 20  .    ;; Must do 
2a30: 74 68 69 73 20 2a 61 66 74 65 72 2a 20 72 75 6e  this *after* run
2a40: 6e 69 6e 67 20 70 61 74 63 68 20 64 62 20 21 21  ning patch db !!
2a50: 20 4e 6f 20 6d 6f 72 65 2e 20 0a 20 20 20 20 28   No more. .    (
2a60: 64 62 3a 73 65 74 2d 76 61 72 20 64 62 20 22 4d  db:set-var db "M
2a70: 45 47 41 54 45 53 54 5f 56 45 52 53 49 4f 4e 22  EGATEST_VERSION"
2a80: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f   megatest-versio
2a90: 6e 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72  n).    (debug:pr
2aa0: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a  int-info 11 "db:
2ab0: 69 6e 69 74 69 61 6c 69 7a 65 20 45 4e 44 22 29  initialize END")
2ac0: 0a 20 20 20 20 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d  .    ))..;;=====
2ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2b10: 3d 0a 3b 3b 20 54 20 45 20 53 20 54 20 20 20 53  =.;; T E S T   S
2b20: 20 50 20 45 20 43 20 49 20 46 20 49 20 43 20 20   P E C I F I C  
2b30: 20 44 20 42 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d   D B .;;========
2b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a  ==============..
2b80: 3b 3b 20 43 72 65 61 74 65 20 74 68 65 20 73 71  ;; Create the sq
2b90: 6c 69 74 65 20 64 62 20 66 6f 72 20 74 68 65 20  lite db for the 
2ba0: 69 6e 64 69 76 69 64 75 61 6c 20 74 65 73 74 28  individual test(
2bb0: 73 29 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e  s).(define (open
2bc0: 2d 74 65 73 74 2d 64 62 20 74 65 73 74 70 61 74  -test-db testpat
2bd0: 68 29 20 0a 20 20 28 64 65 62 75 67 3a 70 72 69  h) .  (debug:pri
2be0: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e  nt-info 11 "open
2bf0: 2d 74 65 73 74 2d 64 62 20 22 20 74 65 73 74 70  -test-db " testp
2c00: 61 74 68 29 0a 20 20 28 69 66 20 28 61 6e 64 20  ath).  (if (and 
2c10: 74 65 73 74 70 61 74 68 20 0a 09 20 20 20 28 64  testpath ..   (d
2c20: 69 72 65 63 74 6f 72 79 3f 20 74 65 73 74 70 61  irectory? testpa
2c30: 74 68 29 0a 09 20 20 20 28 66 69 6c 65 2d 72 65  th)..   (file-re
2c40: 61 64 2d 61 63 63 65 73 73 3f 20 74 65 73 74 70  ad-access? testp
2c50: 61 74 68 29 29 0a 20 20 20 20 20 20 28 6c 65 74  ath)).      (let
2c60: 2a 20 28 28 64 62 70 61 74 68 20 20 20 20 28 63  * ((dbpath    (c
2c70: 6f 6e 63 20 74 65 73 74 70 61 74 68 20 22 2f 74  onc testpath "/t
2c80: 65 73 74 64 61 74 2e 64 62 22 29 29 0a 09 20 20  estdat.db"))..  
2c90: 20 20 20 28 64 62 65 78 69 73 74 73 20 20 28 66     (dbexists  (f
2ca0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 62 70 61  ile-exists? dbpa
2cb0: 74 68 29 29 0a 09 20 20 20 20 20 28 64 62 20 20  th))..     (db  
2cc0: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 6f        (sqlite3:o
2cd0: 70 65 6e 2d 64 61 74 61 62 61 73 65 20 64 62 70  pen-database dbp
2ce0: 61 74 68 29 29 20 3b 3b 20 28 6e 65 76 65 72 2d  ath)) ;; (never-
2cf0: 67 69 76 65 2d 75 70 2d 6f 70 65 6e 2d 64 62 20  give-up-open-db 
2d00: 64 62 70 61 74 68 29 29 0a 09 20 20 20 20 20 28  dbpath))..     (
2d10: 68 61 6e 64 6c 65 72 20 20 20 28 6d 61 6b 65 2d  handler   (make-
2d20: 62 75 73 79 2d 74 69 6d 65 6f 75 74 20 28 69 66  busy-timeout (if
2d30: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22   (args:get-arg "
2d40: 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75  -override-timeou
2d50: 74 22 29 0a 09 09 09 09 09 20 20 20 20 20 20 20  t")......       
2d60: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20  (string->number 
2d70: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d  (args:get-arg "-
2d80: 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 74  override-timeout
2d90: 22 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20  "))......       
2da0: 31 33 36 30 30 30 29 29 29 29 0a 09 28 73 71 6c  136000))))..(sql
2db0: 69 74 65 33 3a 73 65 74 2d 62 75 73 79 2d 68 61  ite3:set-busy-ha
2dc0: 6e 64 6c 65 72 21 20 64 62 20 68 61 6e 64 6c 65  ndler! db handle
2dd0: 72 29 0a 09 28 69 66 20 28 6e 6f 74 20 64 62 65  r)..(if (not dbe
2de0: 78 69 73 74 73 29 0a 09 20 20 20 20 28 62 65 67  xists)..    (beg
2df0: 69 6e 0a 09 20 20 20 20 20 20 28 73 71 6c 69 74  in..      (sqlit
2e00: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 50  e3:execute db "P
2e10: 52 41 47 4d 41 20 73 79 6e 63 68 72 6f 6e 6f 75  RAGMA synchronou
2e20: 73 20 3d 20 46 55 4c 4c 3b 22 29 0a 09 20 20 20  s = FULL;")..   
2e30: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d     (debug:print-
2e40: 69 6e 66 6f 20 31 31 20 22 49 6e 69 74 69 61 6c  info 11 "Initial
2e50: 69 7a 65 64 20 74 65 73 74 20 64 61 74 61 62 61  ized test databa
2e60: 73 65 20 22 20 64 62 70 61 74 68 29 0a 09 20 20  se " dbpath)..  
2e70: 20 20 20 20 28 64 62 3a 74 65 73 74 64 62 2d 69      (db:testdb-i
2e80: 6e 69 74 69 61 6c 69 7a 65 20 64 62 29 29 29 0a  nitialize db))).
2e90: 09 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 78 65  .;; (sqlite3:exe
2ea0: 63 75 74 65 20 64 62 20 22 50 52 41 47 4d 41 20  cute db "PRAGMA 
2eb0: 73 79 6e 63 68 72 6f 6e 6f 75 73 20 3d 20 30 3b  synchronous = 0;
2ec0: 22 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74  ")..(debug:print
2ed0: 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e 2d 74  -info 11 "open-t
2ee0: 65 73 74 2d 64 62 20 45 4e 44 20 28 73 75 63 65  est-db END (suce
2ef0: 73 73 66 75 6c 29 22 20 74 65 73 74 70 61 74 68  ssful)" testpath
2f00: 29 0a 09 3b 3b 20 6e 6f 77 20 6c 65 74 27 73 20  )..;; now let's 
2f10: 74 65 73 74 20 74 68 61 74 20 65 76 65 72 79 74  test that everyt
2f20: 68 69 6e 67 20 69 73 20 63 6f 72 72 65 63 74 0a  hing is correct.
2f30: 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69  .(handle-excepti
2f40: 6f 6e 73 0a 09 20 65 78 6e 0a 09 20 28 62 65 67  ons.. exn.. (beg
2f50: 69 6e 0a 09 20 20 20 28 64 65 62 75 67 3a 70 72  in..   (debug:pr
2f60: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 70 72  int 0 "ERROR: pr
2f70: 6f 62 6c 65 6d 20 61 63 63 65 73 73 69 6e 67 20  oblem accessing 
2f80: 74 65 73 74 20 64 62 20 22 20 74 65 73 74 70 61  test db " testpa
2f90: 74 68 20 22 2c 20 79 6f 75 20 70 72 6f 62 61 62  th ", you probab
2fa0: 6c 79 20 73 68 6f 75 6c 64 20 63 6c 65 61 6e 20  ly should clean 
2fb0: 61 6e 64 20 72 65 2d 72 75 6e 20 74 68 69 73 20  and re-run this 
2fc0: 74 65 73 74 22 0a 09 09 09 28 28 63 6f 6e 64 69  test"....((condi
2fd0: 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63  tion-property-ac
2fe0: 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73  cessor 'exn 'mes
2ff0: 73 61 67 65 29 20 65 78 6e 29 29 0a 09 20 20 20  sage) exn))..   
3000: 23 66 29 0a 09 20 3b 3b 20 49 73 20 74 68 65 72  #f).. ;; Is ther
3010: 65 20 61 20 63 68 65 61 70 65 72 20 73 69 6e 67  e a cheaper sing
3020: 6c 65 20 6c 69 6e 65 20 6f 70 65 72 61 74 69 6f  le line operatio
3030: 6e 20 74 68 61 74 20 77 69 6c 6c 20 63 68 65 63  n that will chec
3040: 6b 20 66 6f 72 20 65 78 69 73 74 61 6e 63 65 20  k for existance 
3050: 6f 66 20 61 20 74 61 62 6c 65 0a 09 20 3b 3b 20  of a table.. ;; 
3060: 61 6e 64 20 72 61 69 73 65 20 61 6e 20 65 78 63  and raise an exc
3070: 65 70 74 69 6f 6e 20 3f 0a 09 20 28 73 71 6c 69  eption ?.. (sqli
3080: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22  te3:execute db "
3090: 53 45 4c 45 43 54 20 69 64 20 46 52 4f 4d 20 74  SELECT id FROM t
30a0: 65 73 74 5f 64 61 74 61 20 4c 49 4d 49 54 20 31  est_data LIMIT 1
30b0: 3b 22 29 29 0a 09 64 62 29 0a 20 20 20 20 20 20  ;"))..db).      
30c0: 28 62 65 67 69 6e 0a 09 28 64 65 62 75 67 3a 70  (begin..(debug:p
30d0: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70  rint-info 11 "op
30e0: 65 6e 2d 74 65 73 74 2d 64 62 20 45 4e 44 20 28  en-test-db END (
30f0: 75 6e 73 75 63 65 73 73 66 75 6c 29 22 20 74 65  unsucessful)" te
3100: 73 74 70 61 74 68 29 0a 09 23 66 29 29 29 0a 0a  stpath)..#f)))..
3110: 3b 3b 20 66 69 6e 64 20 61 6e 64 20 6f 70 65 6e  ;; find and open
3120: 20 74 68 65 20 74 65 73 74 64 61 74 2e 64 62 20   the testdat.db 
3130: 66 69 6c 65 20 66 6f 72 20 61 6e 20 65 78 69 73  file for an exis
3140: 74 69 6e 67 20 74 65 73 74 0a 28 64 65 66 69 6e  ting test.(defin
3150: 65 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d  e (db:open-test-
3160: 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 64 62  db-by-test-id db
3170: 20 74 65 73 74 2d 69 64 29 0a 20 20 28 6c 65 74   test-id).  (let
3180: 2a 20 28 28 74 65 73 74 2d 70 61 74 68 20 28 63  * ((test-path (c
3190: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62  db:remote-run db
31a0: 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72  :test-get-rundir
31b0: 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 64 20 64 62  -from-test-id db
31c0: 20 74 65 73 74 2d 69 64 29 29 29 0a 20 20 20 20   test-id))).    
31d0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20 22  (debug:print 3 "
31e0: 54 45 53 54 20 50 41 54 48 3a 20 22 20 74 65 73  TEST PATH: " tes
31f0: 74 2d 70 61 74 68 29 0a 20 20 20 20 28 6f 70 65  t-path).    (ope
3200: 6e 2d 74 65 73 74 2d 64 62 20 74 65 73 74 2d 70  n-test-db test-p
3210: 61 74 68 29 29 29 0a 0a 28 64 65 66 69 6e 65 20  ath)))..(define 
3220: 28 64 62 3a 74 65 73 74 64 62 2d 69 6e 69 74 69  (db:testdb-initi
3230: 61 6c 69 7a 65 20 64 62 29 0a 20 20 28 64 65 62  alize db).  (deb
3240: 75 67 3a 70 72 69 6e 74 20 31 31 20 22 64 62 3a  ug:print 11 "db:
3250: 74 65 73 74 64 62 2d 69 6e 69 74 69 61 6c 69 7a  testdb-initializ
3260: 65 20 53 54 41 52 54 22 29 0a 20 20 28 66 6f 72  e START").  (for
3270: 2d 65 61 63 68 0a 20 20 20 28 6c 61 6d 62 64 61  -each.   (lambda
3280: 20 28 73 71 6c 63 6d 64 29 0a 20 20 20 20 20 28   (sqlcmd).     (
3290: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20  sqlite3:execute 
32a0: 64 62 20 73 71 6c 63 6d 64 29 29 0a 20 20 20 28  db sqlcmd)).   (
32b0: 6c 69 73 74 20 22 43 52 45 41 54 45 20 54 41 42  list "CREATE TAB
32c0: 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53  LE IF NOT EXISTS
32d0: 20 74 65 73 74 5f 72 75 6e 64 61 74 20 28 0a 20   test_rundat (. 
32e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 64 20               id 
32f0: 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20  INTEGER PRIMARY 
3300: 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20  KEY,.           
3310: 20 20 20 75 70 64 61 74 65 5f 74 69 6d 65 20 54     update_time T
3320: 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20  IMESTAMP,.      
3330: 20 20 20 20 20 20 20 20 63 70 75 6c 6f 61 64 20          cpuload 
3340: 49 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 20  INTEGER DEFAULT 
3350: 2d 31 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20  -1,.            
3360: 20 20 64 69 73 6b 66 72 65 65 20 49 4e 54 45 47    diskfree INTEG
3370: 45 52 20 44 45 46 41 55 4c 54 20 2d 31 2c 0a 20  ER DEFAULT -1,. 
3380: 20 20 20 20 20 20 20 20 20 20 20 20 20 64 69 73               dis
3390: 6b 75 73 61 67 65 20 49 4e 54 47 45 52 20 44 45  kusage INTGER DE
33a0: 46 41 55 4c 54 20 2d 31 2c 0a 20 20 20 20 20 20  FAULT -1,.      
33b0: 20 20 20 20 20 20 20 20 72 75 6e 5f 64 75 72 61          run_dura
33c0: 74 69 6f 6e 20 49 4e 54 45 47 45 52 20 44 45 46  tion INTEGER DEF
33d0: 41 55 4c 54 20 30 29 3b 22 0a 09 20 22 43 52 45  AULT 0);".. "CRE
33e0: 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54  ATE TABLE IF NOT
33f0: 20 45 58 49 53 54 53 20 74 65 73 74 5f 64 61 74   EXISTS test_dat
3400: 61 20 28 0a 20 20 20 20 20 20 20 20 20 20 20 20  a (.            
3410: 20 20 69 64 20 49 4e 54 45 47 45 52 20 50 52 49    id INTEGER PRI
3420: 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20  MARY KEY,.      
3430: 20 20 20 20 20 20 20 20 74 65 73 74 5f 69 64 20          test_id 
3440: 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 20 20  INTEGER,.       
3450: 20 20 20 20 20 20 20 63 61 74 65 67 6f 72 79 20         category 
3460: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c  TEXT DEFAULT '',
3470: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76  .              v
3480: 61 72 69 61 62 6c 65 20 54 45 58 54 2c 0a 09 20  ariable TEXT,.. 
3490: 20 20 20 20 20 76 61 6c 75 65 20 52 45 41 4c 2c       value REAL,
34a0: 0a 09 20 20 20 20 20 20 65 78 70 65 63 74 65 64  ..      expected
34b0: 20 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 74 6f   REAL,..      to
34c0: 6c 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 20  l REAL,.        
34d0: 20 20 20 20 20 20 75 6e 69 74 73 20 54 45 58 54        units TEXT
34e0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ,.              
34f0: 63 6f 6d 6d 65 6e 74 20 54 45 58 54 20 44 45 46  comment TEXT DEF
3500: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20  AULT '',.       
3510: 20 20 20 20 20 20 20 73 74 61 74 75 73 20 54 45         status TE
3520: 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 27  XT DEFAULT 'n/a'
3530: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ,.              
3540: 74 79 70 65 20 54 45 58 54 20 44 45 46 41 55 4c  type TEXT DEFAUL
3550: 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20  T '',.          
3560: 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 74      CONSTRAINT t
3570: 65 73 74 5f 64 61 74 61 5f 63 6f 6e 73 74 72 61  est_data_constra
3580: 69 6e 74 20 55 4e 49 51 55 45 20 28 74 65 73 74  int UNIQUE (test
3590: 5f 69 64 2c 63 61 74 65 67 6f 72 79 2c 76 61 72  _id,category,var
35a0: 69 61 62 6c 65 29 29 3b 22 0a 09 20 22 43 52 45  iable));".. "CRE
35b0: 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54  ATE TABLE IF NOT
35c0: 20 45 58 49 53 54 53 20 74 65 73 74 5f 73 74 65   EXISTS test_ste
35d0: 70 73 20 28 0a 20 20 20 20 20 20 20 20 20 20 20  ps (.           
35e0: 20 20 20 69 64 20 49 4e 54 45 47 45 52 20 50 52     id INTEGER PR
35f0: 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20  IMARY KEY,.     
3600: 20 20 20 20 20 20 20 20 20 74 65 73 74 5f 69 64           test_id
3610: 20 49 4e 54 45 47 45 52 2c 20 0a 20 20 20 20 20   INTEGER, .     
3620: 20 20 20 20 20 20 20 20 20 73 74 65 70 6e 61 6d           stepnam
3630: 65 20 54 45 58 54 2c 20 0a 20 20 20 20 20 20 20  e TEXT, .       
3640: 20 20 20 20 20 20 20 73 74 61 74 65 20 54 45 58         state TEX
3650: 54 20 44 45 46 41 55 4c 54 20 27 4e 4f 54 5f 53  T DEFAULT 'NOT_S
3660: 54 41 52 54 45 44 27 2c 20 0a 20 20 20 20 20 20  TARTED', .      
3670: 20 20 20 20 20 20 20 20 73 74 61 74 75 73 20 54          status T
3680: 45 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f 61  EXT DEFAULT 'n/a
3690: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  ',.             
36a0: 20 65 76 65 6e 74 5f 74 69 6d 65 20 54 49 4d 45   event_time TIME
36b0: 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 20  STAMP,.         
36c0: 20 20 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 58       comment TEX
36d0: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20  T DEFAULT '',.  
36e0: 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f 67 66              logf
36f0: 69 6c 65 20 54 45 58 54 20 44 45 46 41 55 4c 54  ile TEXT DEFAULT
3700: 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20   '',.           
3710: 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 74 65     CONSTRAINT te
3720: 73 74 5f 73 74 65 70 73 5f 63 6f 6e 73 74 72 61  st_steps_constra
3730: 69 6e 74 20 55 4e 49 51 55 45 20 28 74 65 73 74  int UNIQUE (test
3740: 5f 69 64 2c 73 74 65 70 6e 61 6d 65 2c 73 74 61  _id,stepname,sta
3750: 74 65 29 29 3b 22 0a 09 20 3b 3b 20 74 65 73 74  te));".. ;; test
3760: 5f 6d 65 74 61 20 63 61 6e 20 62 65 20 75 73 65  _meta can be use
3770: 64 20 66 6f 72 20 68 61 6e 64 69 6e 67 20 63 6f  d for handing co
3780: 6d 6d 61 6e 64 73 20 74 6f 20 74 68 65 20 74 65  mmands to the te
3790: 73 74 0a 09 20 3b 3b 20 65 2e 67 2e 20 4b 49 4c  st.. ;; e.g. KIL
37a0: 4c 52 45 51 0a 09 20 3b 3b 20 20 20 20 20 20 74  LREQ.. ;;      t
37b0: 68 65 20 61 63 6b 73 74 61 74 65 20 69 73 20 73  he ackstate is s
37c0: 65 74 20 74 6f 20 31 20 6f 6e 63 65 20 74 68 65  et to 1 once the
37d0: 20 63 6f 6d 6d 61 6e 64 20 68 61 73 20 62 65 65   command has bee
37e0: 6e 20 63 6f 6d 70 6c 65 74 65 64 0a 09 20 22 43  n completed.. "C
37f0: 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e  REATE TABLE IF N
3800: 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 6d  OT EXISTS test_m
3810: 65 74 61 20 28 0a 20 20 20 20 20 20 20 20 20 20  eta (.          
3820: 20 20 20 20 69 64 20 49 4e 54 45 47 45 52 20 50      id INTEGER P
3830: 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20  RIMARY KEY,.    
3840: 20 20 20 20 20 20 20 20 20 20 76 61 72 20 54 45            var TE
3850: 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20  XT,.            
3860: 20 20 76 61 6c 20 54 45 58 54 2c 0a 20 20 20 20    val TEXT,.    
3870: 20 20 20 20 20 20 20 20 20 20 61 63 6b 73 74 61            acksta
3880: 74 65 20 49 4e 54 45 47 45 52 20 44 45 46 41 55  te INTEGER DEFAU
3890: 4c 54 20 30 2c 0a 20 20 20 20 20 20 20 20 20 20  LT 0,.          
38a0: 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 6d      CONSTRAINT m
38b0: 65 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 69 6e  etadat_constrain
38c0: 74 20 55 4e 49 51 55 45 20 28 76 61 72 29 29 3b  t UNIQUE (var));
38d0: 22 29 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69  ")).  (debug:pri
38e0: 6e 74 20 31 31 20 22 64 62 3a 74 65 73 74 64 62  nt 11 "db:testdb
38f0: 2d 69 6e 69 74 69 61 6c 69 7a 65 20 45 4e 44 22  -initialize END"
3900: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ))..;;==========
3910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20  ============.;; 
3950: 4c 20 4f 20 47 20 47 20 49 20 4e 20 47 20 20 20  L O G G I N G   
3960: 20 44 20 42 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d   D B .;;========
3970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
39a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a  ==============..
39b0: 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 6c 6f  (define (open-lo
39c0: 67 67 69 6e 67 2d 64 62 29 20 3b 3b 20 20 28 63  gging-db) ;;  (c
39d0: 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f  onc *toppath* "/
39e0: 6d 65 67 61 74 65 73 74 2e 64 62 22 29 20 28 63  megatest.db") (c
39f0: 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29  ar *configinfo*)
3a00: 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 62 70  )).  (let* ((dbp
3a10: 61 74 68 20 20 20 20 28 63 6f 6e 63 20 28 69 66  ath    (conc (if
3a20: 20 2a 74 6f 70 70 61 74 68 2a 20 28 63 6f 6e 63   *toppath* (conc
3a30: 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 22 29 20   *toppath* "/") 
3a40: 22 22 29 20 22 6c 6f 67 67 69 6e 67 2e 64 62 22  "") "logging.db"
3a50: 29 29 20 3b 3b 20 66 6e 61 6d 65 29 0a 09 20 28  )) ;; fname).. (
3a60: 64 62 65 78 69 73 74 73 20 20 28 66 69 6c 65 2d  dbexists  (file-
3a70: 65 78 69 73 74 73 3f 20 64 62 70 61 74 68 29 29  exists? dbpath))
3a80: 0a 09 20 28 64 62 20 20 20 20 20 20 20 20 28 73  .. (db        (s
3a90: 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 74 61  qlite3:open-data
3aa0: 62 61 73 65 20 64 62 70 61 74 68 29 29 20 3b 3b  base dbpath)) ;;
3ab0: 20 28 6e 65 76 65 72 2d 67 69 76 65 2d 75 70 2d   (never-give-up-
3ac0: 6f 70 65 6e 2d 64 62 20 64 62 70 61 74 68 29 29  open-db dbpath))
3ad0: 0a 09 20 28 68 61 6e 64 6c 65 72 20 20 20 28 6d  .. (handler   (m
3ae0: 61 6b 65 2d 62 75 73 79 2d 74 69 6d 65 6f 75 74  ake-busy-timeout
3af0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61   (if (args:get-a
3b00: 72 67 20 22 2d 6f 76 65 72 72 69 64 65 2d 74 69  rg "-override-ti
3b10: 6d 65 6f 75 74 22 29 0a 09 09 09 09 09 20 20 20  meout")......   
3b20: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20  (string->number 
3b30: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d  (args:get-arg "-
3b40: 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 74  override-timeout
3b50: 22 29 29 0a 09 09 09 09 09 20 20 20 31 33 36 30  "))......   1360
3b60: 30 30 29 29 29 29 20 3b 3b 20 31 33 36 30 30 30  00)))) ;; 136000
3b70: 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33  ))).    (sqlite3
3b80: 3a 73 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c 65  :set-busy-handle
3b90: 72 21 20 64 62 20 68 61 6e 64 6c 65 72 29 0a 20  r! db handler). 
3ba0: 20 20 20 28 69 66 20 28 6e 6f 74 20 64 62 65 78     (if (not dbex
3bb0: 69 73 74 73 29 0a 09 28 62 65 67 69 6e 0a 09 20  ists)..(begin.. 
3bc0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74   (sqlite3:execut
3bd0: 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42  e db "CREATE TAB
3be0: 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53  LE IF NOT EXISTS
3bf0: 20 6c 6f 67 20 28 69 64 20 49 4e 54 45 47 45 52   log (id INTEGER
3c00: 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 65 76 65   PRIMARY KEY,eve
3c10: 6e 74 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 4d  nt_time TIMESTAM
3c20: 50 20 44 45 46 41 55 4c 54 20 28 73 74 72 66 74  P DEFAULT (strft
3c30: 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 29  ime('%s','now'))
3c40: 2c 6c 6f 67 6c 69 6e 65 20 54 45 58 54 2c 70 77  ,logline TEXT,pw
3c50: 64 20 54 45 58 54 2c 63 6d 64 6c 69 6e 65 20 54  d TEXT,cmdline T
3c60: 45 58 54 2c 70 69 64 20 49 4e 54 45 47 45 52 29  EXT,pid INTEGER)
3c70: 3b 22 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a  ;")..  (sqlite3:
3c80: 65 78 65 63 75 74 65 20 64 62 20 28 63 6f 6e 63  execute db (conc
3c90: 20 22 50 52 41 47 4d 41 20 73 79 6e 63 68 72 6f   "PRAGMA synchro
3ca0: 6e 6f 75 73 20 3d 20 30 3b 22 29 29 29 29 0a 20  nous = 0;")))). 
3cb0: 20 20 20 64 62 29 29 0a 0a 28 64 65 66 69 6e 65     db))..(define
3cc0: 20 28 64 62 3a 6c 6f 67 2d 6c 6f 63 61 6c 2d 65   (db:log-local-e
3cd0: 76 65 6e 74 20 2e 20 6c 6f 67 6c 73 74 29 0a 20  vent . loglst). 
3ce0: 20 28 6c 65 74 20 28 28 6c 6f 67 6c 69 6e 65 20   (let ((logline 
3cf0: 28 61 70 70 6c 79 20 63 6f 6e 63 20 6c 6f 67 6c  (apply conc logl
3d00: 73 74 29 29 0a 09 28 70 77 64 20 20 20 20 20 28  st))..(pwd     (
3d10: 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72  current-director
3d20: 79 29 29 0a 09 28 63 6d 64 6c 69 6e 65 20 28 73  y))..(cmdline (s
3d30: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73  tring-interspers
3d40: 65 20 28 61 72 67 76 29 20 22 20 22 29 29 0a 09  e (argv) " "))..
3d50: 28 70 69 64 20 20 20 20 20 28 63 75 72 72 65 6e  (pid     (curren
3d60: 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 29 0a  t-process-id))).
3d70: 20 20 20 20 28 64 62 3a 6c 6f 67 2d 65 76 65 6e      (db:log-even
3d80: 74 20 6c 6f 67 6c 69 6e 65 20 70 77 64 20 63 6d  t logline pwd cm
3d90: 64 6c 69 6e 65 20 70 69 64 29 29 29 0a 0a 28 64  dline pid)))..(d
3da0: 65 66 69 6e 65 20 28 64 62 3a 6c 6f 67 2d 65 76  efine (db:log-ev
3db0: 65 6e 74 20 6c 6f 67 6c 69 6e 65 20 70 77 64 20  ent logline pwd 
3dc0: 63 6d 64 6c 69 6e 65 20 70 69 64 29 0a 20 20 28  cmdline pid).  (
3dd0: 6c 65 74 20 28 28 64 62 20 28 6f 70 65 6e 2d 6c  let ((db (open-l
3de0: 6f 67 67 69 6e 67 2d 64 62 29 29 29 0a 20 20 20  ogging-db))).   
3df0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74   (sqlite3:execut
3e00: 65 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e 54  e db "INSERT INT
3e10: 4f 20 6c 6f 67 20 28 6c 6f 67 6c 69 6e 65 2c 70  O log (logline,p
3e20: 77 64 2c 63 6d 64 6c 69 6e 65 2c 70 69 64 29 20  wd,cmdline,pid) 
3e30: 56 41 4c 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 29  VALUES (?,?,?,?)
3e40: 3b 22 20 6c 6f 67 6c 69 6e 65 20 28 63 75 72 72  ;" logline (curr
3e50: 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 28 73  ent-directory)(s
3e60: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73  tring-interspers
3e70: 65 20 28 61 72 67 76 29 20 22 20 22 29 28 63 75  e (argv) " ")(cu
3e80: 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64  rrent-process-id
3e90: 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a  )).    (sqlite3:
3ea0: 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 20 20  finalize! db).  
3eb0: 20 20 6c 6f 67 6c 69 6e 65 29 29 0a 0a 3b 3b 3d    logline))..;;=
3ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3f00: 3d 3d 3d 3d 3d 0a 3b 3b 20 54 4f 44 4f 3a 0a 3b  =====.;; TODO:.;
3f10: 3b 20 20 20 70 75 74 20 64 65 6c 74 61 73 20 69  ;   put deltas i
3f20: 6e 74 6f 20 61 6e 20 61 73 73 6f 63 20 6c 69 73  nto an assoc lis
3f30: 74 20 77 69 74 68 20 76 65 72 73 69 6f 6e 20 6e  t with version n
3f40: 75 6d 62 65 72 73 0a 3b 3b 20 20 20 61 70 70 6c  umbers.;;   appl
3f50: 79 20 61 6c 6c 20 66 72 6f 6d 20 6c 61 73 74 20  y all from last 
3f60: 74 6f 20 63 75 72 72 65 6e 74 0a 3b 3b 3d 3d 3d  to current.;;===
3f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3fb0: 3d 3d 3d 0a 28 64 65 66 69 6e 65 20 28 70 61 74  ===.(define (pat
3fc0: 63 68 2d 64 62 20 64 62 29 0a 20 20 28 68 61 6e  ch-db db).  (han
3fd0: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20  dle-exceptions. 
3fe0: 20 20 65 78 6e 0a 20 20 20 28 62 65 67 69 6e 0a    exn.   (begin.
3ff0: 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 78 63       (print "Exc
4000: 65 70 74 69 6f 6e 3a 20 22 20 65 78 6e 29 0a 20  eption: " exn). 
4010: 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f      (print "ERRO
4020: 52 3a 20 50 6f 73 73 69 62 6c 65 20 6f 75 74 20  R: Possible out 
4030: 6f 66 20 64 61 74 65 20 73 63 68 65 6d 61 2c 20  of date schema, 
4040: 61 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 61 64  attempting to ad
4050: 64 20 74 61 62 6c 65 20 6d 65 74 61 64 61 74 61  d table metadata
4060: 2e 2e 2e 22 29 0a 20 20 20 20 20 28 73 71 6c 69  ...").     (sqli
4070: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22  te3:execute db "
4080: 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20  CREATE TABLE IF 
4090: 4e 4f 54 20 45 58 49 53 54 53 20 6d 65 74 61 64  NOT EXISTS metad
40a0: 61 74 20 28 69 64 20 49 4e 54 45 47 45 52 2c 20  at (id INTEGER, 
40b0: 76 61 72 20 54 45 58 54 2c 20 76 61 6c 20 54 45  var TEXT, val TE
40c0: 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20  XT,.            
40d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
40e0: 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20       CONSTRAINT 
40f0: 6d 65 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 69  metadat_constrai
4100: 6e 74 20 55 4e 49 51 55 45 20 28 76 61 72 29 29  nt UNIQUE (var))
4110: 3b 22 29 0a 20 20 20 20 20 28 69 66 20 28 6e 6f  ;").     (if (no
4120: 74 20 28 64 62 3a 67 65 74 2d 76 61 72 20 64 62  t (db:get-var db
4130: 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49   "MEGATEST_VERSI
4140: 4f 4e 22 29 29 0a 09 20 28 64 62 3a 73 65 74 2d  ON")).. (db:set-
4150: 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54  var db "MEGATEST
4160: 5f 56 45 52 53 49 4f 4e 22 20 31 2e 31 37 29 29  _VERSION" 1.17))
4170: 29 0a 20 20 20 28 6c 65 74 20 28 28 6d 76 65 72  ).   (let ((mver
4180: 20 28 64 62 3a 67 65 74 2d 76 61 72 20 64 62 20   (db:get-var db 
4190: 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49 4f  "MEGATEST_VERSIO
41a0: 4e 22 29 29 0a 09 20 28 74 65 73 74 2d 6d 65 74  N")).. (test-met
41b0: 61 2d 64 65 66 20 22 43 52 45 41 54 45 20 54 41  a-def "CREATE TA
41c0: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54  BLE IF NOT EXIST
41d0: 53 20 74 65 73 74 5f 6d 65 74 61 20 28 69 64 20  S test_meta (id 
41e0: 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20  INTEGER PRIMARY 
41f0: 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20  KEY,.           
4200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4210: 20 20 20 20 20 20 20 20 20 20 74 65 73 74 6e 61            testna
4220: 6d 65 20 20 20 20 54 45 58 54 20 44 45 46 41 55  me    TEXT DEFAU
4230: 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20  LT '',.         
4240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4250: 20 20 20 20 20 20 20 20 20 20 20 20 61 75 74 68              auth
4260: 6f 72 20 20 20 20 20 20 54 45 58 54 20 44 45 46  or      TEXT DEF
4270: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20  AULT '',.       
4280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6f 77                ow
42a0: 6e 65 72 20 20 20 20 20 20 20 54 45 58 54 20 44  ner       TEXT D
42b0: 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20  EFAULT '',.     
42c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
42d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
42e0: 64 65 73 63 72 69 70 74 69 6f 6e 20 54 45 58 54  description TEXT
42f0: 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20   DEFAULT '',.   
4300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4320: 20 20 72 65 76 69 65 77 65 64 20 20 20 20 54 49    reviewed    TI
4330: 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20  MESTAMP,.       
4340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 74                it
4360: 65 72 61 74 65 64 20 20 20 20 54 45 58 54 20 44  erated    TEXT D
4370: 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20  EFAULT '',.     
4380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
43a0: 61 76 67 5f 72 75 6e 74 69 6d 65 20 52 45 41 4c  avg_runtime REAL
43b0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ,.              
43c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
43d0: 20 20 20 20 20 20 20 61 76 67 5f 64 69 73 6b 20         avg_disk 
43e0: 20 20 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20     REAL,.       
43f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 61                ta
4410: 67 73 20 20 20 20 20 20 20 20 54 45 58 54 20 44  gs        TEXT D
4420: 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20  EFAULT '',.     
4430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4440: 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 54             CONST
4450: 52 41 49 4e 54 20 74 65 73 74 5f 6d 65 74 61 5f  RAINT test_meta_
4460: 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55  constraint UNIQU
4470: 45 20 28 74 65 73 74 6e 61 6d 65 29 29 3b 22 29  E (testname));")
4480: 29 0a 20 20 20 20 20 28 70 72 69 6e 74 20 22 43  ).     (print "C
4490: 75 72 72 65 6e 74 20 73 63 68 65 6d 61 20 76 65  urrent schema ve
44a0: 72 73 69 6f 6e 3a 20 22 20 6d 76 65 72 20 22 20  rsion: " mver " 
44b0: 63 75 72 72 65 6e 74 20 6d 65 67 61 74 65 73 74  current megatest
44c0: 20 76 65 72 73 69 6f 6e 3a 20 22 20 6d 65 67 61   version: " mega
44d0: 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 20  test-version).  
44e0: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 28     (cond.      (
44f0: 28 6e 6f 74 20 6d 76 65 72 29 0a 20 20 20 20 20  (not mver).     
4500: 20 20 28 70 72 69 6e 74 20 22 41 64 64 69 6e 67    (print "Adding
4510: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f   megatest-versio
4520: 6e 20 74 6f 20 6d 65 74 61 64 61 74 61 22 29 20  n to metadata") 
4530: 3b 3b 20 4e 65 65 64 20 74 6f 20 72 65 63 72 65  ;; Need to recre
4540: 61 74 65 20 74 68 65 20 74 61 62 6c 65 0a 20 20  ate the table.  
4550: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78       (sqlite3:ex
4560: 65 63 75 74 65 20 64 62 20 22 44 52 4f 50 20 54  ecute db "DROP T
4570: 41 42 4c 45 20 49 46 20 45 58 49 53 54 53 20 6d  ABLE IF EXISTS m
4580: 65 74 61 64 61 74 3b 22 29 0a 20 20 20 20 20 20  etadat;").      
4590: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74   (sqlite3:execut
45a0: 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42  e db "CREATE TAB
45b0: 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53  LE IF NOT EXISTS
45c0: 20 6d 65 74 61 64 61 74 20 28 69 64 20 49 4e 54   metadat (id INT
45d0: 45 47 45 52 2c 20 76 61 72 20 54 45 58 54 2c 20  EGER, var TEXT, 
45e0: 76 61 6c 20 54 45 58 54 2c 0a 20 20 20 20 20 20  val TEXT,.      
45f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4600: 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53              CONS
4610: 54 52 41 49 4e 54 20 6d 65 74 61 64 61 74 5f 63  TRAINT metadat_c
4620: 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45  onstraint UNIQUE
4630: 20 28 76 61 72 29 29 3b 22 29 0a 20 20 20 20 20   (var));").     
4640: 20 20 28 64 62 3a 73 65 74 2d 76 61 72 20 64 62    (db:set-var db
4650: 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49   "MEGATEST_VERSI
4660: 4f 4e 22 20 31 2e 31 37 29 0a 20 20 20 20 20 20  ON" 1.17).      
4670: 20 28 70 61 74 63 68 2d 64 62 29 29 0a 20 20 20   (patch-db)).   
4680: 20 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 32 31     ((< mver 1.21
4690: 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65  ).       (sqlite
46a0: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 44 52  3:execute db "DR
46b0: 4f 50 20 54 41 42 4c 45 20 49 46 20 45 58 49 53  OP TABLE IF EXIS
46c0: 54 53 20 6d 65 74 61 64 61 74 3b 22 29 0a 20 20  TS metadat;").  
46d0: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78       (sqlite3:ex
46e0: 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 45  ecute db "CREATE
46f0: 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58   TABLE IF NOT EX
4700: 49 53 54 53 20 6d 65 74 61 64 61 74 20 28 69 64  ISTS metadat (id
4710: 20 49 4e 54 45 47 45 52 2c 20 76 61 72 20 54 45   INTEGER, var TE
4720: 58 54 2c 20 76 61 6c 20 54 45 58 54 2c 0a 20 20  XT, val TEXT,.  
4730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4750: 43 4f 4e 53 54 52 41 49 4e 54 20 6d 65 74 61 64  CONSTRAINT metad
4760: 61 74 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e  at_constraint UN
4770: 49 51 55 45 20 28 76 61 72 29 29 3b 22 29 0a 20  IQUE (var));"). 
4780: 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 61        (db:set-va
4790: 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f 56  r db "MEGATEST_V
47a0: 45 52 53 49 4f 4e 22 20 31 2e 32 31 29 20 3b 3b  ERSION" 1.21) ;;
47b0: 20 73 65 74 20 62 65 66 6f 72 65 2c 20 6a 75 73   set before, jus
47c0: 74 20 69 6e 20 63 61 73 65 20 74 68 65 20 63 68  t in case the ch
47d0: 61 6e 67 65 73 20 61 72 65 20 61 6c 72 65 61 64  anges are alread
47e0: 79 20 61 70 70 6c 69 65 64 0a 20 20 20 20 20 20  y applied.      
47f0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74   (sqlite3:execut
4800: 65 20 64 62 20 74 65 73 74 2d 6d 65 74 61 2d 64  e db test-meta-d
4810: 65 66 29 0a 09 09 09 09 09 3b 28 66 6f 72 2d 65  ef)......;(for-e
4820: 61 63 68 20 0a 09 09 09 09 09 3b 20 28 6c 61 6d  ach ......; (lam
4830: 62 64 61 20 28 73 74 6d 74 29 0a 09 09 09 09 09  bda (stmt)......
4840: 3b 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65  ;   (sqlite3:exe
4850: 63 75 74 65 20 64 62 20 73 74 6d 74 29 29 0a 09  cute db stmt))..
4860: 09 09 09 09 3b 20 28 6c 69 73 74 20 0a 09 09 09  ....; (list ....
4870: 09 09 3b 20 20 22 41 4c 54 45 52 20 54 41 42 4c  ..;  "ALTER TABL
4880: 45 20 74 65 73 74 73 20 41 44 44 20 43 4f 4c 55  E tests ADD COLU
4890: 4d 4e 20 66 69 72 73 74 5f 65 72 72 20 54 45 58  MN first_err TEX
48a0: 54 3b 22 0a 09 09 09 09 09 3b 20 20 22 41 4c 54  T;"......;  "ALT
48b0: 45 52 20 54 41 42 4c 45 20 74 65 73 74 73 20 41  ER TABLE tests A
48c0: 44 44 20 43 4f 4c 55 4d 4e 20 66 69 72 73 74 5f  DD COLUMN first_
48d0: 77 61 72 6e 20 54 45 58 54 3b 22 0a 09 09 09 09  warn TEXT;".....
48e0: 09 3b 20 20 29 29 0a 20 20 20 20 20 20 20 28 70  .;  )).       (p
48f0: 61 74 63 68 2d 64 62 29 29 0a 20 20 20 20 20 20  atch-db)).      
4900: 28 28 3c 20 6d 76 65 72 20 31 2e 32 34 29 0a 20  ((< mver 1.24). 
4910: 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 61        (db:set-va
4920: 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f 56  r db "MEGATEST_V
4930: 45 52 53 49 4f 4e 22 20 31 2e 32 34 29 0a 20 20  ERSION" 1.24).  
4940: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78       (sqlite3:ex
4950: 65 63 75 74 65 20 64 62 20 22 44 52 4f 50 20 54  ecute db "DROP T
4960: 41 42 4c 45 20 49 46 20 45 58 49 53 54 53 20 74  ABLE IF EXISTS t
4970: 65 73 74 5f 64 61 74 61 3b 22 29 0a 20 20 20 20  est_data;").    
4980: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63     (sqlite3:exec
4990: 75 74 65 20 64 62 20 22 44 52 4f 50 20 54 41 42  ute db "DROP TAB
49a0: 4c 45 20 49 46 20 45 58 49 53 54 53 20 74 65 73  LE IF EXISTS tes
49b0: 74 5f 6d 65 74 61 3b 22 29 0a 20 20 20 20 20 20  t_meta;").      
49c0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74   (sqlite3:execut
49d0: 65 20 64 62 20 74 65 73 74 2d 6d 65 74 61 2d 64  e db test-meta-d
49e0: 65 66 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69  ef).       (sqli
49f0: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22  te3:execute db "
4a00: 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20  CREATE TABLE IF 
4a10: 4e 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 5f  NOT EXISTS test_
4a20: 64 61 74 61 20 28 69 64 20 49 4e 54 45 47 45 52  data (id INTEGER
4a30: 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20   PRIMARY KEY,.  
4a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 65                te
4a60: 73 74 5f 69 64 20 49 4e 54 45 47 45 52 2c 0a 20  st_id INTEGER,. 
4a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63                 c
4a90: 61 74 65 67 6f 72 79 20 54 45 58 54 20 44 45 46  ategory TEXT DEF
4aa0: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20  AULT '',.       
4ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4ac0: 20 20 20 20 20 20 20 20 20 76 61 72 69 61 62 6c           variabl
4ad0: 65 20 54 45 58 54 2c 0a 09 20 20 20 20 20 20 20  e TEXT,..       
4ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4af0: 20 76 61 6c 75 65 20 52 45 41 4c 2c 0a 09 20 20   value REAL,..  
4b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4b10: 20 20 20 20 20 20 65 78 70 65 63 74 65 64 20 52        expected R
4b20: 45 41 4c 2c 0a 09 20 20 20 20 20 20 20 20 20 20  EAL,..          
4b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 6f                to
4b40: 6c 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 20  l REAL,.        
4b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4b60: 20 20 20 20 20 20 20 20 75 6e 69 74 73 20 54 45          units TE
4b70: 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20  XT,.            
4b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4b90: 20 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 58 54      comment TEXT
4ba0: 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20   DEFAULT '',.   
4bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 61               sta
4bd0: 74 75 73 20 54 45 58 54 20 44 45 46 41 55 4c 54  tus TEXT DEFAULT
4be0: 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 20 20 20   'n/a',.        
4bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4c00: 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54        CONSTRAINT
4c10: 20 74 65 73 74 5f 64 61 74 61 20 55 4e 49 51 55   test_data UNIQU
4c20: 45 20 28 74 65 73 74 5f 69 64 2c 63 61 74 65 67  E (test_id,categ
4c30: 6f 72 79 2c 76 61 72 69 61 62 6c 65 29 29 3b 22  ory,variable));"
4c40: 29 0a 20 20 20 20 20 20 20 28 70 72 69 6e 74 20  ).       (print 
4c50: 22 57 41 52 4e 49 4e 47 3a 20 54 61 62 6c 65 20  "WARNING: Table 
4c60: 74 65 73 74 5f 64 61 74 61 20 61 6e 64 20 74 65  test_data and te
4c70: 73 74 5f 6d 65 74 61 20 77 65 72 65 20 72 65 63  st_meta were rec
4c80: 72 65 61 74 65 64 2e 20 50 6c 65 61 73 65 20 64  reated. Please d
4c90: 6f 20 6d 65 67 61 74 65 73 74 20 2d 75 70 64 61  o megatest -upda
4ca0: 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 20 20 20  te-meta").      
4cb0: 20 28 70 61 74 63 68 2d 64 62 29 29 0a 20 20 20   (patch-db)).   
4cc0: 20 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 32 37     ((< mver 1.27
4cd0: 29 0a 20 20 20 20 20 20 20 28 64 62 3a 73 65 74  ).       (db:set
4ce0: 2d 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 53  -var db "MEGATES
4cf0: 54 5f 56 45 52 53 49 4f 4e 22 20 31 2e 32 37 29  T_VERSION" 1.27)
4d00: 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33  .       (sqlite3
4d10: 3a 65 78 65 63 75 74 65 20 64 62 20 22 41 4c 54  :execute db "ALT
4d20: 45 52 20 54 41 42 4c 45 20 74 65 73 74 5f 64 61  ER TABLE test_da
4d30: 74 61 20 41 44 44 20 43 4f 4c 55 4d 4e 20 74 79  ta ADD COLUMN ty
4d40: 70 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 20  pe TEXT DEFAULT 
4d50: 27 27 3b 22 29 0a 20 20 20 20 20 20 20 28 70 61  '';").       (pa
4d60: 74 63 68 2d 64 62 29 29 0a 20 20 20 20 20 20 28  tch-db)).      (
4d70: 28 3c 20 6d 76 65 72 20 31 2e 32 39 29 0a 20 20  (< mver 1.29).  
4d80: 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 61 72       (db:set-var
4d90: 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f 56 45   db "MEGATEST_VE
4da0: 52 53 49 4f 4e 22 20 31 2e 32 39 29 0a 20 20 20  RSION" 1.29).   
4db0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65      (sqlite3:exe
4dc0: 63 75 74 65 20 64 62 20 22 41 4c 54 45 52 20 54  cute db "ALTER T
4dd0: 41 42 4c 45 20 74 65 73 74 5f 73 74 65 70 73 20  ABLE test_steps 
4de0: 41 44 44 20 43 4f 4c 55 4d 4e 20 6c 6f 67 66 69  ADD COLUMN logfi
4df0: 6c 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 20  le TEXT DEFAULT 
4e00: 27 27 3b 22 29 0a 20 20 20 20 20 20 20 28 73 71  '';").       (sq
4e10: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62  lite3:execute db
4e20: 20 22 41 4c 54 45 52 20 54 41 42 4c 45 20 74 65   "ALTER TABLE te
4e30: 73 74 73 20 41 44 44 20 43 4f 4c 55 4d 4e 20 73  sts ADD COLUMN s
4e40: 68 6f 72 74 64 69 72 20 54 45 58 54 20 44 45 46  hortdir TEXT DEF
4e50: 41 55 4c 54 20 27 27 3b 22 29 29 0a 20 20 20 20  AULT '';")).    
4e60: 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 33 36 29    ((< mver 1.36)
4e70: 0a 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d  .       (db:set-
4e80: 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54  var db "MEGATEST
4e90: 5f 56 45 52 53 49 4f 4e 22 20 31 2e 33 36 29 0a  _VERSION" 1.36).
4ea0: 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a         (sqlite3:
4eb0: 65 78 65 63 75 74 65 20 64 62 20 22 41 4c 54 45  execute db "ALTE
4ec0: 52 20 54 41 42 4c 45 20 74 65 73 74 5f 6d 65 74  R TABLE test_met
4ed0: 61 20 41 44 44 20 43 4f 4c 55 4d 4e 20 6a 6f 62  a ADD COLUMN job
4ee0: 67 72 6f 75 70 20 54 45 58 54 20 44 45 46 41 55  group TEXT DEFAU
4ef0: 4c 54 20 27 64 65 66 61 75 6c 74 27 3b 22 29 29  LT 'default';"))
4f00: 0a 20 20 20 20 20 20 28 28 3c 20 6d 76 65 72 20  .      ((< mver 
4f10: 31 2e 33 37 29 0a 20 20 20 20 20 20 20 28 64 62  1.37).       (db
4f20: 3a 73 65 74 2d 76 61 72 20 64 62 20 22 4d 45 47  :set-var db "MEG
4f30: 41 54 45 53 54 5f 56 45 52 53 49 4f 4e 22 20 31  ATEST_VERSION" 1
4f40: 2e 33 37 29 0a 20 20 20 20 20 20 20 28 73 71 6c  .37).       (sql
4f50: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20  ite3:execute db 
4f60: 22 41 4c 54 45 52 20 54 41 42 4c 45 20 74 65 73  "ALTER TABLE tes
4f70: 74 73 20 41 44 44 20 43 4f 4c 55 4d 4e 20 61 72  ts ADD COLUMN ar
4f80: 63 68 69 76 65 64 20 49 4e 54 45 47 45 52 20 44  chived INTEGER D
4f90: 45 46 41 55 4c 54 20 30 3b 22 29 29 20 0a 20 20  EFAULT 0;")) .  
4fa0: 20 20 20 20 28 28 3c 20 6d 76 65 72 20 6d 65 67      ((< mver meg
4fb0: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20  atest-version). 
4fc0: 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 61        (db:set-va
4fd0: 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f 56  r db "MEGATEST_V
4fe0: 45 52 53 49 4f 4e 22 20 6d 65 67 61 74 65 73 74  ERSION" megatest
4ff0: 2d 76 65 72 73 69 6f 6e 29 29 29 29 29 29 0a 0a  -version))))))..
5000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ;;==============
5010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 6d 65 74 61  ========.;; meta
5050: 20 67 65 74 20 61 6e 64 20 73 65 74 20 76 61 72   get and set var
5060: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  s.;;============
5070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
50a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 72  ==========..;; r
50b0: 65 74 75 72 6e 73 20 6e 75 6d 62 65 72 20 69 66  eturns number if
50c0: 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20   string->number 
50d0: 69 73 20 73 75 63 63 65 73 73 66 75 6c 2c 20 73  is successful, s
50e0: 74 72 69 6e 67 20 6f 74 68 65 72 77 69 73 65 0a  tring otherwise.
50f0: 3b 3b 20 61 6c 73 6f 20 75 70 64 61 74 65 73 20  ;; also updates 
5100: 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 0a 28  *global-delta*.(
5110: 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 76  define (db:get-v
5120: 61 72 20 64 62 20 76 61 72 29 0a 20 20 28 64 65  ar db var).  (de
5130: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31  bug:print-info 1
5140: 31 20 22 64 62 3a 67 65 74 2d 76 61 72 20 53 54  1 "db:get-var ST
5150: 41 52 54 20 22 20 76 61 72 29 0a 20 20 28 6c 65  ART " var).  (le
5160: 74 2a 20 28 28 73 74 61 72 74 2d 6d 73 20 28 63  t* ((start-ms (c
5170: 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f  urrent-milliseco
5180: 6e 64 73 29 29 0a 20 20 20 20 20 20 20 20 20 28  nds)).         (
5190: 74 68 72 6f 74 74 6c 65 20 28 6c 65 74 20 28 28  throttle (let ((
51a0: 74 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75  t  (config-looku
51b0: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73  p *configdat* "s
51c0: 65 74 75 70 22 20 22 74 68 72 6f 74 74 6c 65 22  etup" "throttle"
51d0: 29 29 29 0a 09 09 20 20 20 20 20 28 69 66 20 74  )))...     (if t
51e0: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72   (string->number
51f0: 20 74 29 20 74 29 29 29 0a 09 20 28 72 65 73 20   t) t))).. (res 
5200: 20 20 20 20 20 23 66 29 29 0a 20 20 20 20 28 73       #f)).    (s
5210: 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d  qlite3:for-each-
5220: 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61  row.     (lambda
5230: 20 28 76 61 6c 29 0a 20 20 20 20 20 20 20 28 73   (val).       (s
5240: 65 74 21 20 72 65 73 20 76 61 6c 29 29 0a 20 20  et! res val)).  
5250: 20 20 20 64 62 20 22 53 45 4c 45 43 54 20 76 61     db "SELECT va
5260: 6c 20 46 52 4f 4d 20 6d 65 74 61 64 61 74 20 57  l FROM metadat W
5270: 48 45 52 45 20 76 61 72 3d 3f 3b 22 20 76 61 72  HERE var=?;" var
5280: 29 0a 20 20 20 20 3b 3b 20 63 6f 6e 76 65 72 74  ).    ;; convert
5290: 20 74 6f 20 6e 75 6d 62 65 72 20 69 66 20 63 61   to number if ca
52a0: 6e 0a 20 20 20 20 28 69 66 20 28 73 74 72 69 6e  n.    (if (strin
52b0: 67 3f 20 72 65 73 29 0a 09 28 6c 65 74 20 28 28  g? res)..(let ((
52c0: 76 61 6c 6e 75 6d 20 28 73 74 72 69 6e 67 2d 3e  valnum (string->
52d0: 6e 75 6d 62 65 72 20 72 65 73 29 29 29 0a 09 20  number res))).. 
52e0: 20 28 69 66 20 76 61 6c 6e 75 6d 20 28 73 65 74   (if valnum (set
52f0: 21 20 72 65 73 20 76 61 6c 6e 75 6d 29 29 29 29  ! res valnum))))
5300: 0a 20 20 20 20 3b 3b 20 73 63 61 6c 65 20 62 79  .    ;; scale by
5310: 20 31 30 2c 20 61 76 65 72 61 67 65 20 77 69 74   10, average wit
5320: 68 20 63 75 72 72 65 6e 74 20 76 61 6c 75 65 2e  h current value.
5330: 0a 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f 62  .    (set! *glob
5340: 61 6c 2d 64 65 6c 74 61 2a 20 28 2f 20 28 2b 20  al-delta* (/ (+ 
5350: 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 20 28  *global-delta* (
5360: 2a 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d 69  * (- (current-mi
5370: 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 72  lliseconds) star
5380: 74 2d 6d 73 29 0a 09 09 09 09 09 09 20 28 69 66  t-ms)....... (if
5390: 20 74 68 72 6f 74 74 6c 65 20 74 68 72 6f 74 74   throttle thrott
53a0: 6c 65 20 30 2e 30 31 29 29 29 0a 09 09 09 20 20  le 0.01)))....  
53b0: 20 20 32 29 29 0a 20 20 20 20 28 69 66 20 28 3e    2)).    (if (>
53c0: 20 28 61 62 73 20 28 2d 20 2a 6c 61 73 74 2d 67   (abs (- *last-g
53d0: 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 72 69 6e  lobal-delta-prin
53e0: 74 65 64 2a 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c  ted* *global-del
53f0: 74 61 2a 29 29 20 30 2e 30 38 29 20 3b 3b 20 64  ta*)) 0.08) ;; d
5400: 6f 6e 27 74 20 70 72 69 6e 74 20 61 6c 6c 20 74  on't print all t
5410: 68 65 20 74 69 6d 65 2c 20 6f 6e 6c 79 20 69 66  he time, only if
5420: 20 69 74 20 63 68 61 6e 67 65 73 20 61 20 62 69   it changes a bi
5430: 74 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65  t..(begin..  (de
5440: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34  bug:print-info 4
5450: 20 22 6c 61 75 6e 63 68 20 74 68 72 6f 74 74 6c   "launch throttl
5460: 65 20 66 61 63 74 6f 72 3d 22 20 2a 67 6c 6f 62  e factor=" *glob
5470: 61 6c 2d 64 65 6c 74 61 2a 29 0a 09 20 20 28 73  al-delta*)..  (s
5480: 65 74 21 20 2a 6c 61 73 74 2d 67 6c 6f 62 61 6c  et! *last-global
5490: 2d 64 65 6c 74 61 2d 70 72 69 6e 74 65 64 2a 20  -delta-printed* 
54a0: 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 29  *global-delta*))
54b0: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69  ).    (debug:pri
54c0: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67  nt-info 11 "db:g
54d0: 65 74 2d 76 61 72 20 45 4e 44 20 22 20 76 61 72  et-var END " var
54e0: 20 22 20 76 61 6c 3d 22 20 72 65 73 29 0a 20 20   " val=" res).  
54f0: 20 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65    res))..(define
5500: 20 28 64 62 3a 73 65 74 2d 76 61 72 20 64 62 20   (db:set-var db 
5510: 76 61 72 20 76 61 6c 29 0a 20 20 28 64 65 62 75  var val).  (debu
5520: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20  g:print-info 11 
5530: 22 64 62 3a 73 65 74 2d 76 61 72 20 53 54 41 52  "db:set-var STAR
5540: 54 20 22 20 76 61 72 20 22 20 22 20 76 61 6c 29  T " var " " val)
5550: 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63  .  (sqlite3:exec
5560: 75 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 4f  ute db "INSERT O
5570: 52 20 52 45 50 4c 41 43 45 20 49 4e 54 4f 20 6d  R REPLACE INTO m
5580: 65 74 61 64 61 74 20 28 76 61 72 2c 76 61 6c 29  etadat (var,val)
5590: 20 56 41 4c 55 45 53 20 28 3f 2c 3f 29 3b 22 20   VALUES (?,?);" 
55a0: 76 61 72 20 76 61 6c 29 0a 20 20 28 64 65 62 75  var val).  (debu
55b0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20  g:print-info 11 
55c0: 22 64 62 3a 73 65 74 2d 76 61 72 20 45 4e 44 20  "db:set-var END 
55d0: 22 20 76 61 72 20 22 20 22 20 76 61 6c 29 29 0a  " var " " val)).
55e0: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 64 65 6c  .(define (db:del
55f0: 2d 76 61 72 20 64 62 20 76 61 72 29 0a 20 20 28  -var db var).  (
5600: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f  debug:print-info
5610: 20 31 31 20 22 64 62 3a 64 65 6c 2d 76 61 72 20   11 "db:del-var 
5620: 53 54 41 52 54 20 22 20 76 61 72 29 0a 20 20 28  START " var).  (
5630: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20  sqlite3:execute 
5640: 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20  db "DELETE FROM 
5650: 6d 65 74 61 64 61 74 20 57 48 45 52 45 20 76 61  metadat WHERE va
5660: 72 3d 3f 3b 22 20 76 61 72 29 0a 20 20 28 64 65  r=?;" var).  (de
5670: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31  bug:print-info 1
5680: 31 20 22 64 62 3a 64 65 6c 2d 76 61 72 20 45 4e  1 "db:del-var EN
5690: 44 20 22 20 76 61 72 29 29 0a 0a 3b 3b 20 75 73  D " var))..;; us
56a0: 65 20 61 20 67 6c 6f 62 61 6c 20 66 6f 72 20 73  e a global for s
56b0: 6f 6d 65 20 70 72 69 6d 69 74 69 76 65 20 63 61  ome primitive ca
56c0: 63 68 69 6e 67 2c 20 69 74 20 69 73 20 6a 75 73  ching, it is jus
56d0: 74 20 73 69 6c 6c 79 20 74 6f 20 72 65 2d 72 65  t silly to re-re
56e0: 61 64 20 74 68 65 20 64 62 20 0a 3b 3b 20 6f 76  ad the db .;; ov
56f0: 65 72 20 61 6e 64 20 6f 76 65 72 20 61 67 61 69  er and over agai
5700: 6e 20 66 6f 72 20 74 68 65 20 6b 65 79 73 20 73  n for the keys s
5710: 69 6e 63 65 20 74 68 65 79 20 6e 65 76 65 72 20  ince they never 
5720: 63 68 61 6e 67 65 0a 0a 28 64 65 66 69 6e 65 20  change..(define 
5730: 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 29  (db:get-keys db)
5740: 0a 20 20 28 69 66 20 2a 64 62 2d 6b 65 79 73 2a  .  (if *db-keys*
5750: 20 2a 64 62 2d 6b 65 79 73 2a 20 0a 20 20 20 20   *db-keys* .    
5760: 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 28 29    (let ((res '()
5770: 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74  ))..(debug:print
5780: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74  -info 11 "db:get
5790: 2d 6b 65 79 73 20 53 54 41 52 54 20 28 63 61 63  -keys START (cac
57a0: 68 65 20 6d 69 73 73 29 22 29 0a 09 28 73 71 6c  he miss)")..(sql
57b0: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f  ite3:for-each-ro
57c0: 77 20 0a 09 20 28 6c 61 6d 62 64 61 20 28 6b 65  w .. (lambda (ke
57d0: 79 20 6b 65 79 74 79 70 65 29 0a 09 20 20 20 28  y keytype)..   (
57e0: 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28  set! res (cons (
57f0: 76 65 63 74 6f 72 20 6b 65 79 20 6b 65 79 74 79  vector key keyty
5800: 70 65 29 20 72 65 73 29 29 29 0a 09 20 64 62 0a  pe) res))).. db.
5810: 09 20 22 53 45 4c 45 43 54 20 66 69 65 6c 64 6e  . "SELECT fieldn
5820: 61 6d 65 2c 66 69 65 6c 64 74 79 70 65 20 46 52  ame,fieldtype FR
5830: 4f 4d 20 6b 65 79 73 20 4f 52 44 45 52 20 42 59  OM keys ORDER BY
5840: 20 69 64 20 44 45 53 43 3b 22 29 0a 09 28 73 65   id DESC;")..(se
5850: 74 21 20 2a 64 62 2d 6b 65 79 73 2a 20 72 65 73  t! *db-keys* res
5860: 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d  )..(debug:print-
5870: 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d  info 11 "db:get-
5880: 6b 65 79 73 20 45 4e 44 20 28 63 61 63 68 65 20  keys END (cache 
5890: 6d 69 73 73 29 22 29 0a 09 72 65 73 29 29 29 0a  miss)")..res))).
58a0: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74  .(define (db:get
58b0: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72  -value-by-header
58c0: 20 72 6f 77 20 68 65 61 64 65 72 20 66 69 65 6c   row header fiel
58d0: 64 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e  d).  (debug:prin
58e0: 74 2d 69 6e 66 6f 20 34 20 22 64 62 3a 67 65 74  t-info 4 "db:get
58f0: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72  -value-by-header
5900: 20 72 6f 77 3a 20 22 20 72 6f 77 20 22 20 68 65   row: " row " he
5910: 61 64 65 72 3a 20 22 20 68 65 61 64 65 72 20 22  ader: " header "
5920: 20 66 69 65 6c 64 3a 20 22 20 66 69 65 6c 64 29   field: " field)
5930: 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 68 65  .  (if (null? he
5940: 61 64 65 72 29 20 23 66 0a 20 20 20 20 20 20 28  ader) #f.      (
5950: 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28  let loop ((hed (
5960: 63 61 72 20 68 65 61 64 65 72 29 29 0a 09 09 20  car header))... 
5970: 28 74 61 6c 20 28 63 64 72 20 68 65 61 64 65 72  (tal (cdr header
5980: 29 29 0a 09 09 20 28 6e 20 20 20 30 29 29 0a 09  ))... (n   0))..
5990: 28 69 66 20 28 65 71 75 61 6c 3f 20 68 65 64 20  (if (equal? hed 
59a0: 66 69 65 6c 64 29 0a 09 20 20 20 20 28 76 65 63  field)..    (vec
59b0: 74 6f 72 2d 72 65 66 20 72 6f 77 20 6e 29 0a 09  tor-ref row n)..
59c0: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74      (if (null? t
59d0: 61 6c 29 20 23 66 20 28 6c 6f 6f 70 20 28 63 61  al) #f (loop (ca
59e0: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 28  r tal)(cdr tal)(
59f0: 2b 20 6e 20 31 29 29 29 29 29 29 29 0a 0a 3b 3b  + n 1)))))))..;;
5a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5a40: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 52 20 55 20 4e  ======.;;  R U N
5a50: 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d   S.;;===========
5a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20  ===========..;; 
5aa0: 6b 65 79 73 20 6c 69 73 74 20 74 6f 20 6b 65 79  keys list to key
5ab0: 31 2c 6b 65 79 32 2c 6b 65 79 33 20 2e 2e 2e 0a  1,key2,key3 ....
5ac0: 28 64 65 66 69 6e 65 20 28 72 75 6e 73 3a 67 65  (define (runs:ge
5ad0: 74 2d 73 74 64 2d 72 75 6e 2d 66 69 65 6c 64 73  t-std-run-fields
5ae0: 20 6b 65 79 73 20 72 65 6d 66 69 65 6c 64 73 29   keys remfields)
5af0: 0a 20 20 28 6c 65 74 2a 20 28 28 68 65 61 64 65  .  (let* ((heade
5b00: 72 20 20 20 20 28 61 70 70 65 6e 64 20 28 6d 61  r    (append (ma
5b10: 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e  p key:get-fieldn
5b20: 61 6d 65 20 6b 65 79 73 29 0a 09 09 09 20 20 20  ame keys)....   
5b30: 20 72 65 6d 66 69 65 6c 64 73 29 29 0a 09 20 28   remfields)).. (
5b40: 6b 65 79 73 74 72 20 20 20 20 28 63 6f 6e 63 20  keystr    (conc 
5b50: 28 6b 65 79 73 2d 3e 6b 65 79 73 74 72 20 6b 65  (keys->keystr ke
5b60: 79 73 29 20 22 2c 22 0a 09 09 09 20 20 28 73 74  ys) ","....  (st
5b70: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65  ring-intersperse
5b80: 20 72 65 6d 66 69 65 6c 64 73 20 22 2c 22 29 29   remfields ","))
5b90: 29 29 0a 20 20 20 20 28 6c 69 73 74 20 6b 65 79  )).    (list key
5ba0: 73 74 72 20 68 65 61 64 65 72 29 29 29 0a 0a 3b  str header)))..;
5bb0: 3b 20 6d 61 6b 65 20 61 20 71 75 65 72 79 20 28  ; make a query (
5bc0: 66 69 65 6c 64 6e 61 6d 65 20 6c 69 6b 65 20 27  fieldname like '
5bd0: 70 61 74 74 31 27 20 4f 52 20 66 69 65 6c 64 6e  patt1' OR fieldn
5be0: 61 6d 65 20 0a 28 64 65 66 69 6e 65 20 28 64 62  ame .(define (db
5bf0: 3a 70 61 74 74 2d 3e 6c 69 6b 65 20 66 69 65 6c  :patt->like fiel
5c00: 64 6e 61 6d 65 20 70 61 74 74 73 74 72 20 23 21  dname pattstr #!
5c10: 6b 65 79 20 28 63 6f 6d 70 61 72 61 74 6f 72 20  key (comparator 
5c20: 22 20 4f 52 20 22 29 29 0a 20 20 28 6c 65 74 20  " OR ")).  (let 
5c30: 28 28 70 61 74 74 73 20 28 69 66 20 28 73 74 72  ((patts (if (str
5c40: 69 6e 67 3f 20 70 61 74 74 73 74 72 29 0a 09 09  ing? pattstr)...
5c50: 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74     (string-split
5c60: 20 70 61 74 74 73 74 72 20 22 2c 22 29 0a 09 09   pattstr ",")...
5c70: 20 20 20 27 28 22 25 22 29 29 29 29 0a 20 20 20     '("%")))).   
5c80: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70   (string-intersp
5c90: 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64  erse (map (lambd
5ca0: 61 20 28 70 61 74 74 29 0a 09 09 09 20 20 20 20  a (patt)....    
5cb0: 20 20 20 28 6c 65 74 20 28 28 77 69 6c 64 74 79     (let ((wildty
5cc0: 70 65 20 28 69 66 20 28 73 75 62 73 74 72 69 6e  pe (if (substrin
5cd0: 67 2d 69 6e 64 65 78 20 22 25 22 20 70 61 74 74  g-index "%" patt
5ce0: 29 20 22 4c 49 4b 45 22 20 22 47 4c 4f 42 22 29  ) "LIKE" "GLOB")
5cf0: 29 29 0a 09 09 09 09 20 28 63 6f 6e 63 20 66 69  ))..... (conc fi
5d00: 65 6c 64 6e 61 6d 65 20 22 20 22 20 77 69 6c 64  eldname " " wild
5d10: 74 79 70 65 20 22 20 27 22 20 70 61 74 74 20 22  type " '" patt "
5d20: 27 22 29 29 29 0a 09 09 09 20 20 20 20 20 28 69  '")))....     (i
5d30: 66 20 28 6e 75 6c 6c 3f 20 70 61 74 74 73 29 0a  f (null? patts).
5d40: 09 09 09 09 20 27 28 22 22 29 0a 09 09 09 09 20  .... '("")..... 
5d50: 70 61 74 74 73 29 29 0a 09 09 09 63 6f 6d 70 61  patts))....compa
5d60: 72 61 74 6f 72 29 29 29 0a 0a 3b 3b 20 72 65 70  rator)))..;; rep
5d70: 6c 61 63 65 20 68 65 61 64 65 72 20 61 6e 64 20  lace header and 
5d80: 6b 65 79 73 74 72 20 77 69 74 68 20 61 20 63 61  keystr with a ca
5d90: 6c 6c 20 74 6f 20 72 75 6e 73 3a 67 65 74 2d 73  ll to runs:get-s
5da0: 74 64 2d 72 75 6e 2d 66 69 65 6c 64 73 0a 3b 3b  td-run-fields.;;
5db0: 0a 3b 3b 20 6b 65 79 70 61 74 74 73 3a 20 28 20  .;; keypatts: ( 
5dc0: 28 4b 45 59 31 20 22 61 62 63 25 64 65 66 22 29  (KEY1 "abc%def")
5dd0: 28 4b 45 59 32 20 22 25 22 29 20 29 0a 3b 3b 20  (KEY2 "%") ).;; 
5de0: 72 75 6e 70 61 74 74 73 3a 20 70 61 74 74 31 2c  runpatts: patt1,
5df0: 70 61 74 74 32 20 2e 2e 2e 0a 3b 3b 0a 28 64 65  patt2 ....;;.(de
5e00: 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 72 75 6e  fine (db:get-run
5e10: 73 20 64 62 20 72 75 6e 70 61 74 74 20 63 6f 75  s db runpatt cou
5e20: 6e 74 20 6f 66 66 73 65 74 20 6b 65 79 70 61 74  nt offset keypat
5e30: 74 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 65  ts).  (let* ((re
5e40: 73 20 20 20 20 20 20 20 27 28 29 29 0a 09 20 28  s       '()).. (
5e50: 6b 65 79 73 20 20 20 20 20 20 20 28 64 62 3a 67  keys       (db:g
5e60: 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 28  et-keys db)).. (
5e70: 72 75 6e 70 61 74 74 73 74 72 20 28 64 62 3a 70  runpattstr (db:p
5e80: 61 74 74 2d 3e 6c 69 6b 65 20 22 72 75 6e 6e 61  att->like "runna
5e90: 6d 65 22 20 72 75 6e 70 61 74 74 29 29 0a 09 20  me" runpatt)).. 
5ea0: 28 72 65 6d 66 69 65 6c 64 73 20 20 28 6c 69 73  (remfields  (lis
5eb0: 74 20 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22  t "id" "runname"
5ec0: 20 22 73 74 61 74 65 22 20 22 73 74 61 74 75 73   "state" "status
5ed0: 22 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74  " "owner" "event
5ee0: 5f 74 69 6d 65 22 29 29 0a 09 20 28 68 65 61 64  _time")).. (head
5ef0: 65 72 20 20 20 20 20 28 61 70 70 65 6e 64 20 28  er     (append (
5f00: 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c  map key:get-fiel
5f10: 64 6e 61 6d 65 20 6b 65 79 73 29 0a 09 09 20 20  dname keys)...  
5f20: 20 20 20 20 20 20 20 20 20 20 20 72 65 6d 66 69             remfi
5f30: 65 6c 64 73 29 29 0a 09 20 28 6b 65 79 73 74 72  elds)).. (keystr
5f40: 20 20 20 20 20 28 63 6f 6e 63 20 28 6b 65 79 73       (conc (keys
5f50: 2d 3e 6b 65 79 73 74 72 20 6b 65 79 73 29 20 22  ->keystr keys) "
5f60: 2c 22 0a 09 09 20 20 20 20 20 20 20 20 20 20 20  ,"...           
5f70: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65  (string-interspe
5f80: 72 73 65 20 72 65 6d 66 69 65 6c 64 73 20 22 2c  rse remfields ",
5f90: 22 29 29 29 0a 09 20 28 71 72 79 73 74 72 20 20  "))).. (qrystr  
5fa0: 20 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54     (conc "SELECT
5fb0: 20 22 20 6b 65 79 73 74 72 20 22 20 46 52 4f 4d   " keystr " FROM
5fc0: 20 72 75 6e 73 20 57 48 45 52 45 20 28 22 20 72   runs WHERE (" r
5fd0: 75 6e 70 61 74 74 73 74 72 20 22 29 20 22 20 3b  unpattstr ") " ;
5fe0: 3b 20 72 75 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f  ; runname LIKE ?
5ff0: 20 22 0a 09 09 20 20 20 20 20 20 20 20 20 20 20   "...           
6000: 3b 3b 20 47 65 6e 65 72 61 74 65 3a 20 22 20 41  ;; Generate: " A
6010: 4e 44 20 78 20 4c 49 4b 45 20 27 6b 65 79 70 61  ND x LIKE 'keypa
6020: 74 74 27 20 2e 2e 2e 22 0a 09 09 20 20 20 20 20  tt' ..."...     
6030: 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f        (if (null?
6040: 20 6b 65 79 70 61 74 74 73 29 20 22 22 0a 09 09   keypatts) ""...
6050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
6060: 63 6f 6e 63 20 22 20 41 4e 44 20 22 0a 09 09 09  conc " AND "....
6070: 09 20 20 20 20 20 28 73 74 72 69 6e 67 2d 6a 6f  .     (string-jo
6080: 69 6e 20 0a 09 09 09 09 20 20 20 20 20 20 28 6d  in .....      (m
6090: 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 70  ap (lambda (keyp
60a0: 61 74 74 29 0a 09 09 09 09 09 20 20 20 20 20 28  att)......     (
60b0: 6c 65 74 20 28 28 6b 65 79 20 20 28 63 61 72 20  let ((key  (car 
60c0: 6b 65 79 70 61 74 74 29 29 0a 09 09 09 09 09 09  keypatt)).......
60d0: 20 20 20 28 70 61 74 74 20 28 63 61 64 72 20 6b     (patt (cadr k
60e0: 65 79 70 61 74 74 29 29 29 0a 09 09 09 09 09 20  eypatt)))...... 
60f0: 20 20 20 20 20 20 28 64 62 3a 70 61 74 74 2d 3e        (db:patt->
6100: 6c 69 6b 65 20 6b 65 79 20 70 61 74 74 29 29 29  like key patt)))
6110: 0a 09 09 09 09 09 20 20 20 6b 65 79 70 61 74 74  ......   keypatt
6120: 73 29 0a 09 09 09 09 20 20 20 20 20 20 22 20 41  s).....      " A
6130: 4e 44 20 22 29 29 29 0a 09 09 20 20 20 20 20 20  ND ")))...      
6140: 20 20 20 20 20 22 20 4f 52 44 45 52 20 42 59 20       " ORDER BY 
6150: 65 76 65 6e 74 5f 74 69 6d 65 20 44 45 53 43 20  event_time DESC 
6160: 22 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 28  "...           (
6170: 69 66 20 28 6e 75 6d 62 65 72 3f 20 63 6f 75 6e  if (number? coun
6180: 74 29 0a 09 09 20 20 20 20 20 20 20 20 20 20 20  t)...           
6190: 20 20 20 20 28 63 6f 6e 63 20 22 20 4c 49 4d 49      (conc " LIMI
61a0: 54 20 22 20 63 6f 75 6e 74 29 0a 09 09 20 20 20  T " count)...   
61b0: 20 20 20 20 20 20 20 20 20 20 20 20 22 22 29 0a              "").
61c0: 09 09 20 20 20 20 20 20 20 20 20 20 20 28 69 66  ..           (if
61d0: 20 28 6e 75 6d 62 65 72 3f 20 6f 66 66 73 65 74   (number? offset
61e0: 29 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 20  )...            
61f0: 20 20 20 28 63 6f 6e 63 20 22 20 4f 46 46 53 45     (conc " OFFSE
6200: 54 20 22 20 6f 66 66 73 65 74 29 0a 09 09 20 20  T " offset)...  
6210: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 22 29               "")
6220: 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70  ))).    (debug:p
6230: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62  rint-info 11 "db
6240: 3a 67 65 74 2d 72 75 6e 73 20 53 54 41 52 54 20  :get-runs START 
6250: 71 72 79 73 74 72 3a 20 22 20 71 72 79 73 74 72  qrystr: " qrystr
6260: 20 22 20 6b 65 79 70 61 74 74 73 3a 20 22 20 6b   " keypatts: " k
6270: 65 79 70 61 74 74 73 20 22 20 6f 66 66 73 65 74  eypatts " offset
6280: 3a 20 22 20 6f 66 66 73 65 74 20 22 20 6c 69 6d  : " offset " lim
6290: 69 74 3a 20 22 20 63 6f 75 6e 74 29 0a 20 20 20  it: " count).   
62a0: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61   (sqlite3:for-ea
62b0: 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d  ch-row.     (lam
62c0: 62 64 61 20 28 61 20 2e 20 78 29 0a 20 20 20 20  bda (a . x).    
62d0: 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f     (set! res (co
62e0: 6e 73 20 28 61 70 70 6c 79 20 76 65 63 74 6f 72  ns (apply vector
62f0: 20 61 20 78 29 20 72 65 73 29 29 29 0a 20 20 20   a x) res))).   
6300: 20 20 64 62 0a 20 20 20 20 20 71 72 79 73 74 72    db.     qrystr
6310: 0a 20 20 20 20 20 29 0a 20 20 20 20 28 64 65 62  .     ).    (deb
6320: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31  ug:print-info 11
6330: 20 22 64 62 3a 67 65 74 2d 72 75 6e 73 20 45 4e   "db:get-runs EN
6340: 44 20 71 72 79 73 74 72 3a 20 22 20 71 72 79 73  D qrystr: " qrys
6350: 74 72 20 22 20 6b 65 79 70 61 74 74 73 3a 20 22  tr " keypatts: "
6360: 20 6b 65 79 70 61 74 74 73 20 22 20 6f 66 66 73   keypatts " offs
6370: 65 74 3a 20 22 20 6f 66 66 73 65 74 20 22 20 6c  et: " offset " l
6380: 69 6d 69 74 3a 20 22 20 63 6f 75 6e 74 29 0a 20  imit: " count). 
6390: 20 20 20 28 76 65 63 74 6f 72 20 68 65 61 64 65     (vector heade
63a0: 72 20 72 65 73 29 29 29 0a 0a 3b 3b 20 6a 75 73  r res)))..;; jus
63b0: 74 20 67 65 74 20 63 6f 75 6e 74 20 6f 66 20 72  t get count of r
63c0: 75 6e 73 0a 28 64 65 66 69 6e 65 20 28 64 62 3a  uns.(define (db:
63d0: 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 20 64 62 20  get-num-runs db 
63e0: 72 75 6e 70 61 74 74 29 0a 20 20 28 6c 65 74 20  runpatt).  (let 
63f0: 28 28 6e 75 6d 72 75 6e 73 20 30 29 29 0a 20 20  ((numruns 0)).  
6400: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69    (debug:print-i
6410: 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 6e  nfo 11 "db:get-n
6420: 75 6d 2d 72 75 6e 73 20 53 54 41 52 54 20 22 20  um-runs START " 
6430: 72 75 6e 70 61 74 74 29 0a 20 20 20 20 28 73 71  runpatt).    (sq
6440: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72  lite3:for-each-r
6450: 6f 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61  ow .     (lambda
6460: 20 28 63 6f 75 6e 74 29 0a 20 20 20 20 20 20 20   (count).       
6470: 28 73 65 74 21 20 6e 75 6d 72 75 6e 73 20 63 6f  (set! numruns co
6480: 75 6e 74 29 29 0a 20 20 20 20 20 64 62 0a 20 20  unt)).     db.  
6490: 20 20 20 22 53 45 4c 45 43 54 20 43 4f 55 4e 54     "SELECT COUNT
64a0: 28 69 64 29 20 46 52 4f 4d 20 72 75 6e 73 20 57  (id) FROM runs W
64b0: 48 45 52 45 20 72 75 6e 6e 61 6d 65 20 4c 49 4b  HERE runname LIK
64c0: 45 20 3f 3b 22 20 72 75 6e 70 61 74 74 29 0a 20  E ?;" runpatt). 
64d0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d     (debug:print-
64e0: 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d  info 11 "db:get-
64f0: 6e 75 6d 2d 72 75 6e 73 20 45 4e 44 20 22 20 72  num-runs END " r
6500: 75 6e 70 61 74 74 29 0a 20 20 20 20 6e 75 6d 72  unpatt).    numr
6510: 75 6e 73 29 29 0a 0a 3b 3b 20 75 73 65 20 28 67  uns))..;; use (g
6520: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64  et-value-by-head
6530: 65 72 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65  er (db:get-heade
6540: 72 20 72 75 6e 69 6e 66 6f 29 28 64 62 3a 67 65  r runinfo)(db:ge
6550: 74 2d 72 6f 77 20 72 75 6e 69 6e 66 6f 29 29 0a  t-row runinfo)).
6560: 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d  (define (db:get-
6570: 72 75 6e 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d  run-info db run-
6580: 69 64 29 0a 20 20 3b 3b 28 69 66 20 28 68 61 73  id).  ;;(if (has
6590: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61  h-table-ref/defa
65a0: 75 6c 74 20 2a 72 75 6e 2d 69 6e 66 6f 2d 63 61  ult *run-info-ca
65b0: 63 68 65 2a 20 72 75 6e 2d 69 64 20 23 66 29 0a  che* run-id #f).
65c0: 20 20 3b 3b 20 20 20 20 28 68 61 73 68 2d 74 61    ;;    (hash-ta
65d0: 62 6c 65 2d 72 65 66 20 2a 72 75 6e 2d 69 6e 66  ble-ref *run-inf
65e0: 6f 2d 63 61 63 68 65 2a 20 72 75 6e 2d 69 64 29  o-cache* run-id)
65f0: 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72  .      (let* ((r
6600: 65 73 20 20 20 20 20 20 23 66 29 0a 09 20 20 20  es      #f)..   
6610: 20 20 28 6b 65 79 73 20 20 20 20 20 20 28 64 62    (keys      (db
6620: 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09  :get-keys db))..
6630: 20 20 20 20 20 28 72 65 6d 66 69 65 6c 64 73 20       (remfields 
6640: 28 6c 69 73 74 20 22 69 64 22 20 22 72 75 6e 6e  (list "id" "runn
6650: 61 6d 65 22 20 22 73 74 61 74 65 22 20 22 73 74  ame" "state" "st
6660: 61 74 75 73 22 20 22 6f 77 6e 65 72 22 20 22 65  atus" "owner" "e
6670: 76 65 6e 74 5f 74 69 6d 65 22 29 29 0a 09 20 20  vent_time"))..  
6680: 20 20 20 28 68 65 61 64 65 72 20 20 20 20 28 61     (header    (a
6690: 70 70 65 6e 64 20 28 6d 61 70 20 6b 65 79 3a 67  ppend (map key:g
66a0: 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79  et-fieldname key
66b0: 73 29 0a 09 09 09 09 72 65 6d 66 69 65 6c 64 73  s).....remfields
66c0: 29 29 0a 09 20 20 20 20 20 28 6b 65 79 73 74 72  ))..     (keystr
66d0: 20 20 20 20 28 63 6f 6e 63 20 28 6b 65 79 73 2d      (conc (keys-
66e0: 3e 6b 65 79 73 74 72 20 6b 65 79 73 29 20 22 2c  >keystr keys) ",
66f0: 22 0a 09 09 09 20 20 20 20 20 20 28 73 74 72 69  "....      (stri
6700: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 72  ng-intersperse r
6710: 65 6d 66 69 65 6c 64 73 20 22 2c 22 29 29 29 29  emfields ","))))
6720: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69  ..(debug:print-i
6730: 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 72  nfo 11 "db:get-r
6740: 75 6e 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 3a 20  un-info run-id: 
6750: 22 20 72 75 6e 2d 69 64 20 22 20 68 65 61 64 65  " run-id " heade
6760: 72 3a 20 22 20 68 65 61 64 65 72 20 22 20 6b 65  r: " header " ke
6770: 79 73 74 72 3a 20 22 20 6b 65 79 73 74 72 29 0a  ystr: " keystr).
6780: 09 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61  .(sqlite3:for-ea
6790: 63 68 2d 72 6f 77 0a 09 20 28 6c 61 6d 62 64 61  ch-row.. (lambda
67a0: 20 28 61 20 2e 20 78 29 0a 09 20 20 20 28 73 65   (a . x)..   (se
67b0: 74 21 20 72 65 73 20 28 61 70 70 6c 79 20 76 65  t! res (apply ve
67c0: 63 74 6f 72 20 61 20 78 29 29 29 0a 09 20 64 62  ctor a x))).. db
67d0: 0a 09 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54  .. (conc "SELECT
67e0: 20 22 20 6b 65 79 73 74 72 20 22 20 46 52 4f 4d   " keystr " FROM
67f0: 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 3d 3f   runs WHERE id=?
6800: 3b 22 29 0a 09 20 72 75 6e 2d 69 64 29 0a 09 28  ;").. run-id)..(
6810: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f  debug:print-info
6820: 20 31 31 20 22 64 62 3a 67 65 74 2d 72 75 6e 2d   11 "db:get-run-
6830: 69 6e 66 6f 20 72 75 6e 2d 69 64 3a 20 22 20 72  info run-id: " r
6840: 75 6e 2d 69 64 20 22 20 68 65 61 64 65 72 3a 20  un-id " header: 
6850: 22 20 68 65 61 64 65 72 20 22 20 6b 65 79 73 74  " header " keyst
6860: 72 3a 20 22 20 6b 65 79 73 74 72 29 0a 09 28 6c  r: " keystr)..(l
6870: 65 74 20 28 28 66 69 6e 61 6c 72 65 73 20 28 76  et ((finalres (v
6880: 65 63 74 6f 72 20 68 65 61 64 65 72 20 72 65 73  ector header res
6890: 29 29 29 0a 09 20 20 3b 3b 20 28 68 61 73 68 2d  )))..  ;; (hash-
68a0: 74 61 62 6c 65 2d 73 65 74 21 20 2a 72 75 6e 2d  table-set! *run-
68b0: 69 6e 66 6f 2d 63 61 63 68 65 2a 20 72 75 6e 2d  info-cache* run-
68c0: 69 64 20 66 69 6e 61 6c 72 65 73 29 0a 09 20 20  id finalres)..  
68d0: 66 69 6e 61 6c 72 65 73 29 29 29 0a 0a 28 64 65  finalres)))..(de
68e0: 66 69 6e 65 20 28 64 62 3a 73 65 74 2d 63 6f 6d  fine (db:set-com
68f0: 6d 65 6e 74 2d 66 6f 72 2d 72 75 6e 20 64 62 20  ment-for-run db 
6900: 72 75 6e 2d 69 64 20 63 6f 6d 6d 65 6e 74 29 0a  run-id comment).
6910: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69    (debug:print-i
6920: 6e 66 6f 20 31 31 20 22 64 62 3a 73 65 74 2d 63  nfo 11 "db:set-c
6930: 6f 6d 6d 65 6e 74 2d 66 6f 72 2d 72 75 6e 20 53  omment-for-run S
6940: 54 41 52 54 20 72 75 6e 2d 69 64 3a 20 22 20 72  TART run-id: " r
6950: 75 6e 2d 69 64 20 22 20 63 6f 6d 6d 65 6e 74 3a  un-id " comment:
6960: 20 22 20 63 6f 6d 6d 65 6e 74 29 0a 20 20 28 73   " comment).  (s
6970: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64  qlite3:execute d
6980: 62 20 22 55 50 44 41 54 45 20 72 75 6e 73 20 53  b "UPDATE runs S
6990: 45 54 20 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45  ET comment=? WHE
69a0: 52 45 20 69 64 3d 3f 3b 22 20 63 6f 6d 6d 65 6e  RE id=?;" commen
69b0: 74 20 72 75 6e 2d 69 64 29 0a 20 20 28 64 65 62  t run-id).  (deb
69c0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31  ug:print-info 11
69d0: 20 22 64 62 3a 73 65 74 2d 63 6f 6d 6d 65 6e 74   "db:set-comment
69e0: 2d 66 6f 72 2d 72 75 6e 20 45 4e 44 20 72 75 6e  -for-run END run
69f0: 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 20  -id: " run-id " 
6a00: 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f 6d 6d 65  comment: " comme
6a10: 6e 74 29 29 0a 0a 3b 3b 20 64 6f 65 73 20 6e 6f  nt))..;; does no
6a20: 74 20 28 6f 62 76 69 6f 75 73 6c 79 21 29 20 72  t (obviously!) r
6a30: 65 6d 6f 76 65 64 20 64 65 70 65 6e 64 65 6e 74  emoved dependent
6a40: 20 64 61 74 61 2e 20 42 75 74 20 77 68 79 20 6e   data. But why n
6a50: 6f 74 21 21 3f 0a 28 64 65 66 69 6e 65 20 28 64  ot!!?.(define (d
6a60: 62 3a 64 65 6c 65 74 65 2d 72 75 6e 20 64 62 20  b:delete-run db 
6a70: 72 75 6e 2d 69 64 29 0a 20 20 28 63 6f 6d 6d 6f  run-id).  (commo
6a80: 6e 3a 63 6c 65 61 72 2d 63 61 63 68 65 73 29 20  n:clear-caches) 
6a90: 3b 3b 20 64 6f 6e 27 74 20 74 72 75 73 74 20 63  ;; don't trust c
6aa0: 61 63 68 65 73 20 61 66 74 65 72 20 64 6f 69 6e  aches after doin
6ab0: 67 20 61 6e 79 20 64 65 6c 65 74 69 6f 6e 0a 20  g any deletion. 
6ac0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74   (sqlite3:execut
6ad0: 65 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f  e db "DELETE FRO
6ae0: 4d 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 3d  M runs WHERE id=
6af0: 3f 3b 22 20 72 75 6e 2d 69 64 29 29 0a 0a 28 64  ?;" run-id))..(d
6b00: 65 66 69 6e 65 20 28 64 62 3a 75 70 64 61 74 65  efine (db:update
6b10: 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 20  -run-event_time 
6b20: 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 64 65  db run-id).  (de
6b30: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31  bug:print-info 1
6b40: 31 20 22 64 62 3a 75 70 64 61 74 65 2d 72 75 6e  1 "db:update-run
6b50: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 53 54 41 52  -event_time STAR
6b60: 54 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d  T run-id: " run-
6b70: 69 64 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65  id).  (sqlite3:e
6b80: 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54  xecute db "UPDAT
6b90: 45 20 72 75 6e 73 20 53 45 54 20 65 76 65 6e 74  E runs SET event
6ba0: 5f 74 69 6d 65 3d 73 74 72 66 74 69 6d 65 28 27  _time=strftime('
6bb0: 25 73 27 2c 27 6e 6f 77 27 29 20 57 48 45 52 45  %s','now') WHERE
6bc0: 20 69 64 3d 3f 3b 22 20 72 75 6e 2d 69 64 29 0a   id=?;" run-id).
6bd0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69    (debug:print-i
6be0: 6e 66 6f 20 31 31 20 22 64 62 3a 75 70 64 61 74  nfo 11 "db:updat
6bf0: 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65  e-run-event_time
6c00: 20 45 4e 44 20 72 75 6e 2d 69 64 3a 20 22 20 72   END run-id: " r
6c10: 75 6e 2d 69 64 29 29 20 0a 0a 28 64 65 66 69 6e  un-id)) ..(defin
6c20: 65 20 28 64 62 3a 6c 6f 63 6b 2f 75 6e 6c 6f 63  e (db:lock/unloc
6c30: 6b 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 20  k-run db run-id 
6c40: 6c 6f 63 6b 20 75 6e 6c 6f 63 6b 20 75 73 65 72  lock unlock user
6c50: 29 0a 20 20 28 6c 65 74 20 28 28 6e 65 77 6c 6f  ).  (let ((newlo
6c60: 63 6b 76 61 6c 20 28 69 66 20 6c 6f 63 6b 20 22  ckval (if lock "
6c70: 6c 6f 63 6b 65 64 22 0a 09 09 09 28 69 66 20 75  locked"....(if u
6c80: 6e 6c 6f 63 6b 0a 09 09 09 20 20 20 20 22 75 6e  nlock....    "un
6c90: 6c 6f 63 6b 65 64 22 0a 09 09 09 20 20 20 20 22  locked"....    "
6ca0: 6c 6f 63 6b 65 64 22 29 29 29 29 20 3b 3b 20 73  locked")))) ;; s
6cb0: 65 6d 69 2d 66 61 69 6c 73 61 66 65 0a 20 20 20  emi-failsafe.   
6cc0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74   (sqlite3:execut
6cd0: 65 20 64 62 20 22 55 50 44 41 54 45 20 72 75 6e  e db "UPDATE run
6ce0: 73 20 53 45 54 20 73 74 61 74 65 3d 3f 20 57 48  s SET state=? WH
6cf0: 45 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 6c 6f  ERE id=?;" newlo
6d00: 63 6b 76 61 6c 20 72 75 6e 2d 69 64 29 0a 20 20  ckval run-id).  
6d10: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75    (sqlite3:execu
6d20: 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e  te db "INSERT IN
6d30: 54 4f 20 61 63 63 65 73 73 5f 6c 6f 67 20 28 75  TO access_log (u
6d40: 73 65 72 2c 61 63 63 65 73 73 65 64 2c 61 72 67  ser,accessed,arg
6d50: 73 29 20 56 41 4c 55 45 53 28 3f 2c 73 74 72 66  s) VALUES(?,strf
6d60: 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29  time('%s','now')
6d70: 2c 3f 29 3b 22 0a 09 09 20 20 20 20 20 75 73 65  ,?);"...     use
6d80: 72 20 28 63 6f 6e 63 20 6e 65 77 6c 6f 63 6b 76  r (conc newlockv
6d90: 61 6c 20 22 20 22 20 72 75 6e 2d 69 64 29 29 0a  al " " run-id)).
6da0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74      (debug:print
6db0: 2d 69 6e 66 6f 20 31 20 22 22 20 6e 65 77 6c 6f  -info 1 "" newlo
6dc0: 63 6b 76 61 6c 20 22 20 72 75 6e 20 6e 75 6d 62  ckval " run numb
6dd0: 65 72 20 22 20 72 75 6e 2d 69 64 29 29 29 0a 0a  er " run-id)))..
6de0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ;;==============
6df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
6e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
6e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
6e20: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4b 20 45 20  ========.;; K E 
6e30: 59 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  Y S.;;==========
6e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
6e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
6e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
6e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b  ============..;;
6e80: 20 67 65 74 20 6b 65 79 20 76 61 6c 20 70 61 69   get key val pai
6e90: 72 73 20 66 6f 72 20 61 20 67 69 76 65 6e 20 72  rs for a given r
6ea0: 75 6e 2d 69 64 0a 3b 3b 20 28 20 28 46 49 45 4c  un-id.;; ( (FIEL
6eb0: 44 4e 41 4d 45 31 20 6b 65 79 76 61 6c 31 29 20  DNAME1 keyval1) 
6ec0: 28 46 49 45 4c 44 4e 41 4d 45 32 20 6b 65 79 76  (FIELDNAME2 keyv
6ed0: 61 6c 32 29 20 2e 2e 2e 20 29 0a 28 64 65 66 69  al2) ... ).(defi
6ee0: 6e 65 20 28 64 62 3a 67 65 74 2d 6b 65 79 2d 76  ne (db:get-key-v
6ef0: 61 6c 2d 70 61 69 72 73 20 64 62 20 72 75 6e 2d  al-pairs db run-
6f00: 69 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65  id).  (let* ((ke
6f10: 79 73 20 28 67 65 74 2d 6b 65 79 73 20 64 62 29  ys (get-keys db)
6f20: 29 0a 09 20 28 72 65 73 20 20 27 28 29 29 29 0a  ).. (res  '())).
6f30: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74      (debug:print
6f40: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74  -info 11 "db:get
6f50: 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 53  -key-val-pairs S
6f60: 54 41 52 54 20 6b 65 79 73 3a 20 22 20 6b 65 79  TART keys: " key
6f70: 73 20 22 20 72 75 6e 2d 69 64 3a 20 22 20 72 75  s " run-id: " ru
6f80: 6e 2d 69 64 29 0a 20 20 20 20 28 66 6f 72 2d 65  n-id).    (for-e
6f90: 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d 62 64  ach .     (lambd
6fa0: 61 20 28 6b 65 79 29 0a 20 20 20 20 20 20 20 28  a (key).       (
6fb0: 6c 65 74 20 28 28 71 72 79 20 28 63 6f 6e 63 20  let ((qry (conc 
6fc0: 22 53 45 4c 45 43 54 20 22 20 28 6b 65 79 3a 67  "SELECT " (key:g
6fd0: 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79  et-fieldname key
6fe0: 29 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 57 48  ) " FROM runs WH
6ff0: 45 52 45 20 69 64 3d 3f 3b 22 29 29 29 0a 09 20  ERE id=?;"))).. 
7000: 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20  ;; (debug:print 
7010: 30 20 22 71 72 79 3a 20 22 20 71 72 79 29 0a 09  0 "qry: " qry)..
7020: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61   (sqlite3:for-ea
7030: 63 68 2d 72 6f 77 20 0a 09 20 20 28 6c 61 6d 62  ch-row ..  (lamb
7040: 64 61 20 28 6b 65 79 2d 76 61 6c 29 0a 09 20 20  da (key-val)..  
7050: 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e    (set! res (con
7060: 73 20 28 6c 69 73 74 20 28 6b 65 79 3a 67 65 74  s (list (key:get
7070: 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 29 20  -fieldname key) 
7080: 6b 65 79 2d 76 61 6c 29 20 72 65 73 29 29 29 0a  key-val) res))).
7090: 09 20 20 64 62 20 71 72 79 20 72 75 6e 2d 69 64  .  db qry run-id
70a0: 29 29 29 0a 20 20 20 20 20 6b 65 79 73 29 0a 20  ))).     keys). 
70b0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d     (debug:print-
70c0: 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d  info 11 "db:get-
70d0: 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 45 4e  key-val-pairs EN
70e0: 44 20 6b 65 79 73 3a 20 22 20 6b 65 79 73 20 22  D keys: " keys "
70f0: 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69   run-id: " run-i
7100: 64 29 0a 20 20 20 20 28 72 65 76 65 72 73 65 20  d).    (reverse 
7110: 72 65 73 29 29 29 0a 0a 3b 3b 20 67 65 74 20 6b  res)))..;; get k
7120: 65 79 20 76 61 6c 73 20 66 6f 72 20 61 20 67 69  ey vals for a gi
7130: 76 65 6e 20 72 75 6e 2d 69 64 0a 28 64 65 66 69  ven run-id.(defi
7140: 6e 65 20 28 64 62 3a 67 65 74 2d 6b 65 79 2d 76  ne (db:get-key-v
7150: 61 6c 73 20 64 62 20 72 75 6e 2d 69 64 29 0a 20  als db run-id). 
7160: 20 28 6c 65 74 20 28 28 6d 79 6b 65 79 76 61 6c   (let ((mykeyval
7170: 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65  s (hash-table-re
7180: 66 2f 64 65 66 61 75 6c 74 20 2a 6b 65 79 76 61  f/default *keyva
7190: 6c 73 2a 20 72 75 6e 2d 69 64 20 23 66 29 29 29  ls* run-id #f)))
71a0: 0a 20 20 20 20 28 69 66 20 6d 79 6b 65 79 76 61  .    (if mykeyva
71b0: 6c 73 20 0a 09 6d 79 6b 65 79 76 61 6c 73 0a 09  ls ..mykeyvals..
71c0: 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 28 67 65  (let* ((keys (ge
71d0: 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 20 20  t-keys db))..   
71e0: 20 20 20 20 28 72 65 73 20 20 27 28 29 29 29 0a      (res  '())).
71f0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d  .  (debug:print-
7200: 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d  info 11 "db:get-
7210: 6b 65 79 2d 76 61 6c 73 20 53 54 41 52 54 20 6b  key-vals START k
7220: 65 79 73 3a 20 22 20 6b 65 79 73 20 22 20 72 75  eys: " keys " ru
7230: 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 29 0a  n-id: " run-id).
7240: 09 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20  .  (for-each .. 
7250: 20 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a    (lambda (key).
7260: 09 20 20 20 20 20 28 6c 65 74 20 28 28 71 72 79  .     (let ((qry
7270: 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22   (conc "SELECT "
7280: 20 28 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e   (key:get-fieldn
7290: 61 6d 65 20 6b 65 79 29 20 22 20 46 52 4f 4d 20  ame key) " FROM 
72a0: 72 75 6e 73 20 57 48 45 52 45 20 69 64 3d 3f 3b  runs WHERE id=?;
72b0: 22 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20  ")))..       ;; 
72c0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22  (debug:print 0 "
72d0: 71 72 79 3a 20 22 20 71 72 79 29 0a 09 20 20 20  qry: " qry)..   
72e0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72      (sqlite3:for
72f0: 2d 65 61 63 68 2d 72 6f 77 20 0a 09 09 28 6c 61  -each-row ...(la
7300: 6d 62 64 61 20 28 6b 65 79 2d 76 61 6c 29 0a 09  mbda (key-val)..
7310: 09 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f  .  (set! res (co
7320: 6e 73 20 6b 65 79 2d 76 61 6c 20 72 65 73 29 29  ns key-val res))
7330: 29 0a 09 09 64 62 20 71 72 79 20 72 75 6e 2d 69  )...db qry run-i
7340: 64 29 29 29 0a 09 20 20 20 6b 65 79 73 29 0a 09  d)))..   keys)..
7350: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69    (debug:print-i
7360: 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 6b  nfo 11 "db:get-k
7370: 65 79 2d 76 61 6c 73 20 45 4e 44 20 6b 65 79 73  ey-vals END keys
7380: 3a 20 22 20 6b 65 79 73 20 22 20 72 75 6e 2d 69  : " keys " run-i
7390: 64 3a 20 22 20 72 75 6e 2d 69 64 29 0a 09 20 20  d: " run-id)..  
73a0: 28 6c 65 74 20 28 28 66 69 6e 61 6c 2d 72 65 73  (let ((final-res
73b0: 20 28 72 65 76 65 72 73 65 20 72 65 73 29 29 29   (reverse res)))
73c0: 0a 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c  ..    (hash-tabl
73d0: 65 2d 73 65 74 21 20 2a 6b 65 79 76 61 6c 73 2a  e-set! *keyvals*
73e0: 20 72 75 6e 2d 69 64 20 66 69 6e 61 6c 2d 72 65   run-id final-re
73f0: 73 29 0a 09 20 20 20 20 66 69 6e 61 6c 2d 72 65  s)..    final-re
7400: 73 29 29 29 29 29 0a 0a 3b 3b 20 54 68 65 20 74  s)))))..;; The t
7410: 61 72 67 65 74 20 69 73 20 6b 65 79 76 61 6c 31  arget is keyval1
7420: 2f 6b 65 79 76 61 6c 32 2e 2e 2e 2c 20 63 61 63  /keyval2..., cac
7430: 68 65 64 20 69 6e 20 2a 74 61 72 67 65 74 2a 20  hed in *target* 
7440: 61 73 20 69 74 20 69 73 20 75 73 65 64 20 6f 66  as it is used of
7450: 74 65 6e 0a 28 64 65 66 69 6e 65 20 28 64 62 3a  ten.(define (db:
7460: 67 65 74 2d 74 61 72 67 65 74 20 64 62 20 72 75  get-target db ru
7470: 6e 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 6d  n-id).  (let ((m
7480: 79 74 61 72 67 20 28 68 61 73 68 2d 74 61 62 6c  ytarg (hash-tabl
7490: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 74  e-ref/default *t
74a0: 61 72 67 65 74 2a 20 72 75 6e 2d 69 64 20 23 66  arget* run-id #f
74b0: 29 29 29 0a 20 20 20 20 28 69 66 20 6d 79 74 61  ))).    (if myta
74c0: 72 67 0a 09 6d 79 74 61 72 67 0a 09 28 6c 65 74  rg..mytarg..(let
74d0: 2a 20 28 28 6b 65 79 76 61 6c 73 20 28 64 62 3a  * ((keyvals (db:
74e0: 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 64 62 20  get-key-vals db 
74f0: 72 75 6e 2d 69 64 29 29 0a 09 20 20 20 20 20 20  run-id))..      
7500: 20 28 74 68 65 6b 65 79 20 20 28 73 74 72 69 6e   (thekey  (strin
7510: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d  g-intersperse (m
7520: 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 69  ap (lambda (x)(i
7530: 66 20 78 20 78 20 22 2d 6e 61 2d 22 29 29 20 6b  f x x "-na-")) k
7540: 65 79 76 61 6c 73 29 20 22 2f 22 29 29 29 0a 09  eyvals) "/")))..
7550: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65    (hash-table-se
7560: 74 21 20 2a 74 61 72 67 65 74 2a 20 72 75 6e 2d  t! *target* run-
7570: 69 64 20 74 68 65 6b 65 79 29 0a 09 20 20 74 68  id thekey)..  th
7580: 65 6b 65 79 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d  ekey))))..;;====
7590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
75a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
75b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
75c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
75d0: 3d 3d 0a 3b 3b 20 20 54 20 45 20 53 20 54 20 53  ==.;;  T E S T S
75e0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  .;;=============
75f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
7600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
7610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
7620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69  =========..(defi
7630: 6e 65 20 28 64 62 3a 74 65 73 74 73 2d 72 65 67  ne (db:tests-reg
7640: 69 73 74 65 72 2d 74 65 73 74 20 64 62 20 72 75  ister-test db ru
7650: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69  n-id test-name i
7660: 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 64 65 62  tem-path).  (deb
7670: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31  ug:print-info 11
7680: 20 22 64 62 3a 74 65 73 74 73 2d 72 65 67 69 73   "db:tests-regis
7690: 74 65 72 2d 74 65 73 74 20 53 54 41 52 54 20 64  ter-test START d
76a0: 62 3d 22 20 64 62 20 22 2c 20 72 75 6e 2d 69 64  b=" db ", run-id
76b0: 3d 22 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 73  =" run-id ", tes
76c0: 74 2d 6e 61 6d 65 3d 22 20 74 65 73 74 2d 6e 61  t-name=" test-na
76d0: 6d 65 20 22 2c 20 69 74 65 6d 2d 70 61 74 68 3d  me ", item-path=
76e0: 5c 22 22 20 69 74 65 6d 2d 70 61 74 68 20 22 5c  \"" item-path "\
76f0: 22 22 29 0a 20 20 28 6c 65 74 20 28 28 69 74 65  "").  (let ((ite
7700: 6d 2d 70 61 74 68 73 20 28 69 66 20 28 65 71 75  m-paths (if (equ
7710: 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22  al? item-path ""
7720: 29 0a 09 09 09 28 6c 69 73 74 20 69 74 65 6d 2d  )....(list item-
7730: 70 61 74 68 29 0a 09 09 09 28 6c 69 73 74 20 69  path)....(list i
7740: 74 65 6d 2d 70 61 74 68 20 22 22 29 29 29 29 0a  tem-path "")))).
7750: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 20      (for-each . 
7760: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 74 68      (lambda (pth
7770: 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65  ).       (sqlite
7780: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 49 4e  3:execute db "IN
7790: 53 45 52 54 20 4f 52 20 49 47 4e 4f 52 45 20 49  SERT OR IGNORE I
77a0: 4e 54 4f 20 74 65 73 74 73 20 28 72 75 6e 5f 69  NTO tests (run_i
77b0: 64 2c 74 65 73 74 6e 61 6d 65 2c 65 76 65 6e 74  d,testname,event
77c0: 5f 74 69 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2c  _time,item_path,
77d0: 73 74 61 74 65 2c 73 74 61 74 75 73 29 20 56 41  state,status) VA
77e0: 4c 55 45 53 20 28 3f 2c 3f 2c 73 74 72 66 74 69  LUES (?,?,strfti
77f0: 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 3f  me('%s','now'),?
7800: 2c 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c 27  ,'NOT_STARTED','
7810: 6e 2f 61 27 29 3b 22 20 0a 09 09 09 72 75 6e 2d  n/a');" ....run-
7820: 69 64 20 0a 09 09 09 74 65 73 74 2d 6e 61 6d 65  id ....test-name
7830: 0a 09 09 09 70 74 68 29 29 0a 20 20 20 20 20 69  ....pth)).     i
7840: 74 65 6d 2d 70 61 74 68 73 29 0a 20 20 28 64 65  tem-paths).  (de
7850: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31  bug:print-info 1
7860: 31 20 22 64 62 3a 74 65 73 74 73 2d 72 65 67 69  1 "db:tests-regi
7870: 73 74 65 72 2d 74 65 73 74 20 45 4e 44 20 64 62  ster-test END db
7880: 3d 22 20 64 62 20 22 2c 20 72 75 6e 2d 69 64 3d  =" db ", run-id=
7890: 22 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 73 74  " run-id ", test
78a0: 2d 6e 61 6d 65 3d 22 20 74 65 73 74 2d 6e 61 6d  -name=" test-nam
78b0: 65 20 22 2c 20 69 74 65 6d 2d 70 61 74 68 3d 5c  e ", item-path=\
78c0: 22 22 20 69 74 65 6d 2d 70 61 74 68 20 22 5c 22  "" item-path "\"
78d0: 22 29 0a 20 20 20 20 23 66 29 29 0a 0a 3b 3b 20  ").    #f))..;; 
78e0: 73 74 61 74 65 73 20 61 6e 64 20 73 74 61 74 75  states and statu
78f0: 73 65 73 20 61 72 65 20 6c 69 73 74 73 2c 20 74  ses are lists, t
7900: 75 72 6e 20 74 68 65 6d 20 69 6e 74 6f 20 28 22  urn them into ("
7910: 50 41 53 53 22 2c 22 46 41 49 4c 22 2e 2e 2e 29  PASS","FAIL"...)
7920: 20 61 6e 64 20 75 73 65 20 4e 4f 54 20 49 4e 0a   and use NOT IN.
7930: 3b 3b 20 69 2e 65 2e 20 74 68 65 73 65 20 6c 69  ;; i.e. these li
7940: 73 74 73 20 64 65 66 69 6e 65 20 77 68 61 74 20  sts define what 
7950: 74 6f 20 4e 4f 54 20 73 68 6f 77 2e 0a 3b 3b 20  to NOT show..;; 
7960: 73 74 61 74 65 73 20 61 6e 64 20 73 74 61 74 75  states and statu
7970: 73 65 73 20 61 72 65 20 72 65 71 75 69 72 65 64  ses are required
7980: 20 74 6f 20 62 65 20 6c 69 73 74 73 2c 20 65 6d   to be lists, em
7990: 70 74 79 20 69 73 20 6f 6b 0a 3b 3b 20 6e 6f 74  pty is ok.;; not
79a0: 2d 69 6e 20 23 74 20 3d 20 61 62 6f 76 65 20 62  -in #t = above b
79b0: 65 68 61 76 69 6f 75 72 2c 20 23 66 20 3d 20 6d  ehaviour, #f = m
79c0: 75 73 74 20 6d 61 74 63 68 0a 28 64 65 66 69 6e  ust match.(defin
79d0: 65 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d  e (db:get-tests-
79e0: 66 6f 72 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69  for-run db run-i
79f0: 64 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65  d testpatt state
7a00: 73 20 73 74 61 74 75 73 65 73 20 0a 09 09 09 20  s statuses .... 
7a10: 20 20 20 20 20 23 21 6b 65 79 20 28 6e 6f 74 2d       #!key (not-
7a20: 69 6e 20 23 74 29 0a 09 09 09 20 20 20 20 20 20  in #t)....      
7a30: 28 73 6f 72 74 2d 62 79 20 23 66 29 20 3b 3b 20  (sort-by #f) ;; 
7a40: 27 72 75 6e 64 69 72 20 27 65 76 65 6e 74 5f 74  'rundir 'event_t
7a50: 69 6d 65 0a 09 09 09 20 20 20 20 20 20 28 71 72  ime....      (qr
7a60: 79 76 61 6c 73 20 22 69 64 2c 72 75 6e 5f 69 64  yvals "id,run_id
7a70: 2c 74 65 73 74 6e 61 6d 65 2c 73 74 61 74 65 2c  ,testname,state,
7a80: 73 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d  status,event_tim
7a90: 65 2c 68 6f 73 74 2c 63 70 75 6c 6f 61 64 2c 64  e,host,cpuload,d
7aa0: 69 73 6b 66 72 65 65 2c 75 6e 61 6d 65 2c 72 75  iskfree,uname,ru
7ab0: 6e 64 69 72 2c 69 74 65 6d 5f 70 61 74 68 2c 72  ndir,item_path,r
7ac0: 75 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 69 6e 61  un_duration,fina
7ad0: 6c 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 6e 74 22 29  l_logf,comment")
7ae0: 0a 09 09 09 20 20 20 20 20 20 29 0a 20 20 28 64  ....      ).  (d
7af0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20  ebug:print-info 
7b00: 31 31 20 22 64 62 3a 67 65 74 2d 74 65 73 74 73  11 "db:get-tests
7b10: 2d 66 6f 72 2d 72 75 6e 20 53 54 41 52 54 20 72  -for-run START r
7b20: 75 6e 2d 69 64 3d 22 20 72 75 6e 2d 69 64 20 22  un-id=" run-id "
7b30: 2c 20 74 65 73 74 70 61 74 74 3d 22 20 74 65 73  , testpatt=" tes
7b40: 74 70 61 74 74 20 22 2c 20 73 74 61 74 65 73 3d  tpatt ", states=
7b50: 22 20 73 74 61 74 65 73 20 22 2c 20 73 74 61 74  " states ", stat
7b60: 75 73 65 73 3d 22 20 73 74 61 74 75 73 65 73 20  uses=" statuses 
7b70: 22 2c 20 6e 6f 74 2d 69 6e 3d 22 20 6e 6f 74 2d  ", not-in=" not-
7b80: 69 6e 20 22 2c 20 73 6f 72 74 2d 62 79 3d 22 20  in ", sort-by=" 
7b90: 73 6f 72 74 2d 62 79 29 0a 20 20 28 6c 65 74 2a  sort-by).  (let*
7ba0: 20 28 28 72 65 73 20 27 28 29 29 0a 09 20 3b 3b   ((res '()).. ;;
7bb0: 20 69 66 20 73 74 61 74 65 73 20 6f 72 20 73 74   if states or st
7bc0: 61 74 75 73 65 73 20 61 72 65 20 6e 75 6c 6c 20  atuses are null 
7bd0: 74 68 65 6e 20 61 73 73 75 6d 65 20 6d 61 74 63  then assume matc
7be0: 68 20 61 6c 6c 20 77 68 65 6e 20 6e 6f 74 2d 69  h all when not-i
7bf0: 6e 20 69 73 20 66 61 6c 73 65 0a 09 20 28 73 74  n is false.. (st
7c00: 61 74 65 73 2d 71 72 79 20 20 20 20 20 20 28 69  ates-qry      (i
7c10: 66 20 28 6e 75 6c 6c 3f 20 73 74 61 74 65 73 29  f (null? states)
7c20: 20 0a 09 09 09 20 20 20 20 20 20 23 66 0a 09 09   ....      #f...
7c30: 09 20 20 20 20 20 20 28 63 6f 6e 63 20 22 20 73  .      (conc " s
7c40: 74 61 74 65 20 22 20 20 0a 09 09 09 09 20 20 20  tate "  .....   
7c50: 20 28 69 66 20 6e 6f 74 2d 69 6e 20 22 4e 4f 54   (if not-in "NOT
7c60: 22 20 22 22 29 20 0a 09 09 09 09 20 20 20 20 22  " "") .....    "
7c70: 20 49 4e 20 28 27 22 20 0a 09 09 09 09 20 20 20   IN ('" .....   
7c80: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70   (string-intersp
7c90: 65 72 73 65 20 73 74 61 74 65 73 20 20 20 22 27  erse states   "'
7ca0: 2c 27 22 29 0a 09 09 09 09 20 20 20 20 22 27 29  ,'").....    "')
7cb0: 22 29 29 29 0a 09 20 28 73 74 61 74 75 73 65 73  "))).. (statuses
7cc0: 2d 71 72 79 20 20 20 20 28 69 66 20 28 6e 75 6c  -qry    (if (nul
7cd0: 6c 3f 20 73 74 61 74 75 73 65 73 29 0a 09 09 09  l? statuses)....
7ce0: 20 20 20 20 20 20 23 66 0a 09 09 09 20 20 20 20        #f....    
7cf0: 20 20 28 63 6f 6e 63 20 22 20 73 74 61 74 75 73    (conc " status
7d00: 20 22 0a 09 09 09 09 20 20 20 20 28 69 66 20 6e   ".....    (if n
7d10: 6f 74 2d 69 6e 20 22 4e 4f 54 22 20 22 22 29 20  ot-in "NOT" "") 
7d20: 0a 09 09 09 09 20 20 20 20 22 20 49 4e 20 28 27  .....    " IN ('
7d30: 22 20 0a 09 09 09 09 20 20 20 20 28 73 74 72 69  " .....    (stri
7d40: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 73  ng-intersperse s
7d50: 74 61 74 75 73 65 73 20 22 27 2c 27 22 29 0a 09  tatuses "','")..
7d60: 09 09 09 20 20 20 20 22 27 29 22 29 29 29 0a 09  ...    "')")))..
7d70: 20 28 74 65 73 74 73 2d 6d 61 74 63 68 2d 71 72   (tests-match-qr
7d80: 79 20 28 74 65 73 74 73 3a 6d 61 74 63 68 2d 3e  y (tests:match->
7d90: 73 71 6c 71 72 79 20 74 65 73 74 70 61 74 74 29  sqlqry testpatt)
7da0: 29 0a 09 20 28 71 72 79 20 20 20 20 20 20 20 20  ).. (qry        
7db0: 20 20 20 20 20 28 63 6f 6e 63 20 22 53 45 4c 45       (conc "SELE
7dc0: 43 54 20 22 20 71 72 79 76 61 6c 73 0a 09 09 09  CT " qryvals....
7dd0: 09 22 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48  ." FROM tests WH
7de0: 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 22 0a 09  ERE run_id=? "..
7df0: 09 09 09 28 69 66 20 73 74 61 74 65 73 2d 71 72  ...(if states-qr
7e00: 79 20 20 20 28 63 6f 6e 63 20 22 20 41 4e 44 20  y   (conc " AND 
7e10: 22 20 73 74 61 74 65 73 2d 71 72 79 29 20 20 20  " states-qry)   
7e20: 22 22 29 0a 09 09 09 09 28 69 66 20 73 74 61 74  "").....(if stat
7e30: 75 73 65 73 2d 71 72 79 20 28 63 6f 6e 63 20 22  uses-qry (conc "
7e40: 20 41 4e 44 20 22 20 73 74 61 74 75 73 65 73 2d   AND " statuses-
7e50: 71 72 79 29 20 22 22 29 0a 09 09 09 09 28 69 66  qry) "").....(if
7e60: 20 74 65 73 74 73 2d 6d 61 74 63 68 2d 71 72 79   tests-match-qry
7e70: 20 28 63 6f 6e 63 20 22 20 41 4e 44 20 28 22 20   (conc " AND (" 
7e80: 74 65 73 74 73 2d 6d 61 74 63 68 2d 71 72 79 20  tests-match-qry 
7e90: 22 29 20 22 29 20 22 22 29 0a 09 09 09 09 28 63  ") ") "").....(c
7ea0: 61 73 65 20 73 6f 72 74 2d 62 79 0a 09 09 09 09  ase sort-by.....
7eb0: 20 20 28 28 72 75 6e 64 69 72 29 20 20 20 20 20    ((rundir)     
7ec0: 22 20 4f 52 44 45 52 20 42 59 20 6c 65 6e 67 74  " ORDER BY lengt
7ed0: 68 28 72 75 6e 64 69 72 29 20 44 45 53 43 3b 22  h(rundir) DESC;"
7ee0: 29 0a 09 09 09 09 20 20 28 28 65 76 65 6e 74 5f  ).....  ((event_
7ef0: 74 69 6d 65 29 20 22 20 4f 52 44 45 52 20 42 59  time) " ORDER BY
7f00: 20 65 76 65 6e 74 5f 74 69 6d 65 20 41 53 43 3b   event_time ASC;
7f10: 22 29 0a 09 09 09 09 20 20 28 65 6c 73 65 20 20  ").....  (else  
7f20: 20 20 20 20 20 20 20 22 3b 22 29 29 0a 09 09 09         ";"))....
7f30: 20 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a   ))).    (debug:
7f40: 70 72 69 6e 74 2d 69 6e 66 6f 20 38 20 22 64 62  print-info 8 "db
7f50: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72  :get-tests-for-r
7f60: 75 6e 20 71 72 79 3d 22 20 71 72 79 29 0a 20 20  un qry=" qry).  
7f70: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65    (sqlite3:for-e
7f80: 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c  ach-row .     (l
7f90: 61 6d 62 64 61 20 28 61 20 2e 20 62 29 20 3b 3b  ambda (a . b) ;;
7fa0: 20 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 6e   id run-id testn
7fb0: 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73  ame state status
7fc0: 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74   event-time host
7fd0: 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65   cpuload diskfre
7fe0: 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69  e uname rundir i
7ff0: 74 65 6d 2d 70 61 74 68 20 72 75 6e 2d 64 75 72  tem-path run-dur
8000: 61 74 69 6f 6e 20 66 69 6e 61 6c 2d 6c 6f 67 66  ation final-logf
8010: 20 63 6f 6d 6d 65 6e 74 29 0a 20 20 20 20 20 20   comment).      
8020: 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73   (set! res (cons
8030: 20 28 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61   (apply vector a
8040: 20 62 29 20 72 65 73 29 29 29 20 3b 3b 20 69 64   b) res))) ;; id
8050: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65   run-id testname
8060: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 65 76   state status ev
8070: 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70  ent-time host cp
8080: 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75  uload diskfree u
8090: 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 65 6d  name rundir item
80a0: 2d 70 61 74 68 20 72 75 6e 2d 64 75 72 61 74 69  -path run-durati
80b0: 6f 6e 20 66 69 6e 61 6c 2d 6c 6f 67 66 20 63 6f  on final-logf co
80c0: 6d 6d 65 6e 74 29 20 72 65 73 29 29 29 0a 20 20  mment) res))).  
80d0: 20 20 20 64 62 20 0a 20 20 20 20 20 71 72 79 0a     db .     qry.
80e0: 20 20 20 20 20 72 75 6e 2d 69 64 0a 20 20 20 20       run-id.    
80f0: 20 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72   ).    (debug:pr
8100: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a  int-info 11 "db:
8110: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75  get-tests-for-ru
8120: 6e 20 53 54 41 52 54 20 72 75 6e 2d 69 64 3d 22  n START run-id="
8130: 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 73 74 70   run-id ", testp
8140: 61 74 74 3d 22 20 74 65 73 74 70 61 74 74 20 22  att=" testpatt "
8150: 2c 20 73 74 61 74 65 73 3d 22 20 73 74 61 74 65  , states=" state
8160: 73 20 22 2c 20 73 74 61 74 75 73 65 73 3d 22 20  s ", statuses=" 
8170: 73 74 61 74 75 73 65 73 20 22 2c 20 6e 6f 74 2d  statuses ", not-
8180: 69 6e 3d 22 20 6e 6f 74 2d 69 6e 20 22 2c 20 73  in=" not-in ", s
8190: 6f 72 74 2d 62 79 3d 22 20 73 6f 72 74 2d 62 79  ort-by=" sort-by
81a0: 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20  ).    res))..;; 
81b0: 67 65 74 20 61 20 75 73 65 66 75 6c 20 73 75 62  get a useful sub
81c0: 73 65 74 20 6f 66 20 74 68 65 20 74 65 73 74 73  set of the tests
81d0: 20 64 61 74 61 20 28 75 73 65 64 20 69 6e 20 64   data (used in d
81e0: 61 73 68 62 6f 61 72 64 0a 3b 3b 20 75 73 65 20  ashboard.;; use 
81f0: 64 62 3a 6d 69 6e 74 65 73 74 73 2d 67 65 74 2d  db:mintests-get-
8200: 7b 69 64 20 2c 72 75 6e 5f 69 64 2c 74 65 73 74  {id ,run_id,test
8210: 6e 61 6d 65 20 2e 2e 2e 7d 0a 28 64 65 66 69 6e  name ...}.(defin
8220: 65 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d  e (db:get-tests-
8230: 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61  for-runs-mindata
8240: 20 64 62 20 72 75 6e 2d 69 64 73 20 74 65 73 74   db run-ids test
8250: 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74  patt states stat
8260: 75 73 29 0a 20 20 28 64 62 3a 67 65 74 2d 74 65  us).  (db:get-te
8270: 73 74 73 2d 66 6f 72 2d 72 75 6e 73 20 64 62 20  sts-for-runs db 
8280: 72 75 6e 2d 69 64 73 20 74 65 73 74 70 61 74 74  run-ids testpatt
8290: 20 73 74 61 74 65 73 20 73 74 61 74 75 73 20 71   states status q
82a0: 72 79 76 61 6c 73 3a 20 22 69 64 2c 72 75 6e 5f  ryvals: "id,run_
82b0: 69 64 2c 74 65 73 74 6e 61 6d 65 2c 73 74 61 74  id,testname,stat
82c0: 65 2c 73 74 61 74 75 73 2c 65 76 65 6e 74 5f 74  e,status,event_t
82d0: 69 6d 65 2c 69 74 65 6d 5f 70 61 74 68 22 29 29  ime,item_path"))
82e0: 0a 0a 3b 3b 20 4e 42 20 2f 2f 20 54 68 69 73 20  ..;; NB // This 
82f0: 69 73 20 67 65 74 20 74 65 73 74 73 20 66 6f 72  is get tests for
8300: 20 22 72 75 6e 73 22 20 28 6e 6f 74 65 20 74 68   "runs" (note th
8310: 65 20 70 6c 75 72 61 6c 21 21 29 0a 3b 3b 0a 3b  e plural!!).;;.;
8320: 3b 20 73 74 61 74 65 73 20 61 6e 64 20 73 74 61  ; states and sta
8330: 74 75 73 65 73 20 61 72 65 20 6c 69 73 74 73 2c  tuses are lists,
8340: 20 74 75 72 6e 20 74 68 65 6d 20 69 6e 74 6f 20   turn them into 
8350: 28 22 50 41 53 53 22 2c 22 46 41 49 4c 22 2e 2e  ("PASS","FAIL"..
8360: 2e 29 20 61 6e 64 20 75 73 65 20 4e 4f 54 20 49  .) and use NOT I
8370: 4e 0a 3b 3b 20 69 2e 65 2e 20 74 68 65 73 65 20  N.;; i.e. these 
8380: 6c 69 73 74 73 20 64 65 66 69 6e 65 20 77 68 61  lists define wha
8390: 74 20 74 6f 20 4e 4f 54 20 73 68 6f 77 2e 0a 3b  t to NOT show..;
83a0: 3b 20 73 74 61 74 65 73 20 61 6e 64 20 73 74 61  ; states and sta
83b0: 74 75 73 65 73 20 61 72 65 20 72 65 71 75 69 72  tuses are requir
83c0: 65 64 20 74 6f 20 62 65 20 6c 69 73 74 73 2c 20  ed to be lists, 
83d0: 65 6d 70 74 79 20 69 73 20 6f 6b 0a 3b 3b 20 6e  empty is ok.;; n
83e0: 6f 74 2d 69 6e 20 23 74 20 3d 20 61 62 6f 76 65  ot-in #t = above
83f0: 20 62 65 68 61 76 69 6f 75 72 2c 20 23 66 20 3d   behaviour, #f =
8400: 20 6d 75 73 74 20 6d 61 74 63 68 0a 3b 3b 20 72   must match.;; r
8410: 75 6e 2d 69 64 73 20 69 73 20 61 20 6c 69 73 74  un-ids is a list
8420: 20 6f 66 20 72 75 6e 2d 69 64 73 20 6f 72 20 61   of run-ids or a
8430: 20 73 69 6e 67 6c 65 20 6e 75 6d 62 65 72 0a 28   single number.(
8440: 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 74  define (db:get-t
8450: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 73 20 64 62  ests-for-runs db
8460: 20 72 75 6e 2d 69 64 73 20 74 65 73 74 70 61 74   run-ids testpat
8470: 74 20 73 74 61 74 65 73 20 73 74 61 74 75 73 65  t states statuse
8480: 73 20 0a 09 09 09 20 20 20 20 20 20 23 21 6b 65  s ....      #!ke
8490: 79 20 28 6e 6f 74 2d 69 6e 20 23 74 29 0a 09 09  y (not-in #t)...
84a0: 09 20 20 20 20 20 20 28 73 6f 72 74 2d 62 79 20  .      (sort-by 
84b0: 23 66 29 0a 09 09 09 20 20 20 20 20 20 28 71 72  #f)....      (qr
84c0: 79 76 61 6c 73 20 22 69 64 2c 72 75 6e 5f 69 64  yvals "id,run_id
84d0: 2c 74 65 73 74 6e 61 6d 65 2c 73 74 61 74 65 2c  ,testname,state,
84e0: 73 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d  status,event_tim
84f0: 65 2c 68 6f 73 74 2c 63 70 75 6c 6f 61 64 2c 64  e,host,cpuload,d
8500: 69 73 6b 66 72 65 65 2c 75 6e 61 6d 65 2c 72 75  iskfree,uname,ru
8510: 6e 64 69 72 2c 69 74 65 6d 5f 70 61 74 68 2c 72  ndir,item_path,r
8520: 75 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 69 6e 61  un_duration,fina
8530: 6c 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 6e 74 22 29  l_logf,comment")
8540: 29 20 3b 3b 20 27 72 75 6e 64 69 72 20 27 65 76  ) ;; 'rundir 'ev
8550: 65 6e 74 5f 74 69 6d 65 0a 20 20 28 64 65 62 75  ent_time.  (debu
8560: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20  g:print-info 11 
8570: 22 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f  "db:get-tests-fo
8580: 72 2d 72 75 6e 20 53 54 41 52 54 20 72 75 6e 2d  r-run START run-
8590: 69 64 73 3d 22 20 72 75 6e 2d 69 64 73 20 22 2c  ids=" run-ids ",
85a0: 20 74 65 73 74 70 61 74 74 3d 22 20 74 65 73 74   testpatt=" test
85b0: 70 61 74 74 20 22 2c 20 73 74 61 74 65 73 3d 22  patt ", states="
85c0: 20 73 74 61 74 65 73 20 22 2c 20 73 74 61 74 75   states ", statu
85d0: 73 65 73 3d 22 20 73 74 61 74 75 73 65 73 20 22  ses=" statuses "
85e0: 2c 20 6e 6f 74 2d 69 6e 3d 22 20 6e 6f 74 2d 69  , not-in=" not-i
85f0: 6e 20 22 2c 20 73 6f 72 74 2d 62 79 3d 22 20 73  n ", sort-by=" s
8600: 6f 72 74 2d 62 79 29 0a 20 20 28 6c 65 74 2a 20  ort-by).  (let* 
8610: 28 28 72 65 73 20 27 28 29 29 0a 09 20 3b 3b 20  ((res '()).. ;; 
8620: 69 66 20 73 74 61 74 65 73 20 6f 72 20 73 74 61  if states or sta
8630: 74 75 73 65 73 20 61 72 65 20 6e 75 6c 6c 20 74  tuses are null t
8640: 68 65 6e 20 61 73 73 75 6d 65 20 6d 61 74 63 68  hen assume match
8650: 20 61 6c 6c 20 77 68 65 6e 20 6e 6f 74 2d 69 6e   all when not-in
8660: 20 69 73 20 66 61 6c 73 65 0a 09 20 28 73 74 61   is false.. (sta
8670: 74 65 73 2d 71 72 79 20 20 20 20 20 20 28 69 66  tes-qry      (if
8680: 20 28 6e 75 6c 6c 3f 20 73 74 61 74 65 73 29 20   (null? states) 
8690: 0a 09 09 09 20 20 20 20 20 20 23 66 0a 09 09 09  ....      #f....
86a0: 20 20 20 20 20 20 28 63 6f 6e 63 20 22 20 73 74        (conc " st
86b0: 61 74 65 20 22 20 20 0a 09 09 09 09 20 20 20 20  ate "  .....    
86c0: 28 69 66 20 6e 6f 74 2d 69 6e 20 22 4e 4f 54 22  (if not-in "NOT"
86d0: 20 22 22 29 20 0a 09 09 09 09 20 20 20 20 22 20   "") .....    " 
86e0: 49 4e 20 28 27 22 20 0a 09 09 09 09 20 20 20 20  IN ('" .....    
86f0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65  (string-interspe
8700: 72 73 65 20 73 74 61 74 65 73 20 20 20 22 27 2c  rse states   "',
8710: 27 22 29 0a 09 09 09 09 20 20 20 20 22 27 29 22  '").....    "')"
8720: 29 29 29 0a 09 20 28 73 74 61 74 75 73 65 73 2d  ))).. (statuses-
8730: 71 72 79 20 20 20 20 28 69 66 20 28 6e 75 6c 6c  qry    (if (null
8740: 3f 20 73 74 61 74 75 73 65 73 29 0a 09 09 09 20  ? statuses).... 
8750: 20 20 20 20 20 23 66 0a 09 09 09 20 20 20 20 20       #f....     
8760: 20 28 63 6f 6e 63 20 22 20 73 74 61 74 75 73 20   (conc " status 
8770: 22 0a 09 09 09 09 20 20 20 20 28 69 66 20 6e 6f  ".....    (if no
8780: 74 2d 69 6e 20 22 4e 4f 54 22 20 22 22 29 20 0a  t-in "NOT" "") .
8790: 09 09 09 09 20 20 20 20 22 20 49 4e 20 28 27 22  ....    " IN ('"
87a0: 20 0a 09 09 09 09 20 20 20 20 28 73 74 72 69 6e   .....    (strin
87b0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 73 74  g-intersperse st
87c0: 61 74 75 73 65 73 20 22 27 2c 27 22 29 0a 09 09  atuses "','")...
87d0: 09 09 20 20 20 20 22 27 29 22 29 29 29 0a 09 20  ..    "')"))).. 
87e0: 28 74 65 73 74 73 2d 6d 61 74 63 68 2d 71 72 79  (tests-match-qry
87f0: 20 28 74 65 73 74 73 3a 6d 61 74 63 68 2d 3e 73   (tests:match->s
8800: 71 6c 71 72 79 20 74 65 73 74 70 61 74 74 29 29  qlqry testpatt))
8810: 0a 09 20 28 71 72 79 20 20 20 20 20 20 20 20 20  .. (qry         
8820: 20 20 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 43      (conc "SELEC
8830: 54 20 22 20 71 72 79 76 61 6c 73 20 0a 09 09 09  T " qryvals ....
8840: 09 22 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48  ." FROM tests WH
8850: 45 52 45 20 22 20 0a 09 09 09 09 28 69 66 20 72  ERE " .....(if r
8860: 75 6e 2d 69 64 73 0a 09 09 09 09 20 20 20 20 28  un-ids.....    (
8870: 69 66 20 28 6c 69 73 74 3f 20 72 75 6e 2d 69 64  if (list? run-id
8880: 73 29 0a 09 09 09 09 09 28 63 6f 6e 63 20 22 20  s)......(conc " 
8890: 72 75 6e 5f 69 64 20 69 6e 20 28 22 20 28 73 74  run_id in (" (st
88a0: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65  ring-intersperse
88b0: 20 28 6d 61 70 20 63 6f 6e 63 20 72 75 6e 2d 69   (map conc run-i
88c0: 64 73 29 20 22 2c 22 29 20 22 29 20 22 29 0a 09  ds) ",") ") ")..
88d0: 09 09 09 09 28 63 6f 6e 63 20 22 72 75 6e 5f 69  ....(conc "run_i
88e0: 64 3d 22 20 72 75 6e 2d 69 64 73 20 22 20 22 29  d=" run-ids " ")
88f0: 29 0a 09 09 09 09 20 20 20 20 22 20 22 29 20 3b  ).....    " ") ;
8900: 3b 20 23 66 20 3d 3e 20 72 75 6e 2d 69 64 73 20  ; #f => run-ids 
8910: 64 6f 6e 27 74 20 66 69 6c 74 65 72 20 6f 6e 20  don't filter on 
8920: 72 75 6e 2d 69 64 73 0a 09 09 09 09 28 69 66 20  run-ids.....(if 
8930: 73 74 61 74 65 73 2d 71 72 79 20 20 20 28 63 6f  states-qry   (co
8940: 6e 63 20 22 20 41 4e 44 20 22 20 73 74 61 74 65  nc " AND " state
8950: 73 2d 71 72 79 29 20 20 20 22 22 29 0a 09 09 09  s-qry)   "")....
8960: 09 28 69 66 20 73 74 61 74 75 73 65 73 2d 71 72  .(if statuses-qr
8970: 79 20 28 63 6f 6e 63 20 22 20 41 4e 44 20 22 20  y (conc " AND " 
8980: 73 74 61 74 75 73 65 73 2d 71 72 79 29 20 22 22  statuses-qry) ""
8990: 29 0a 09 09 09 09 28 69 66 20 74 65 73 74 73 2d  ).....(if tests-
89a0: 6d 61 74 63 68 2d 71 72 79 20 28 63 6f 6e 63 20  match-qry (conc 
89b0: 22 20 41 4e 44 20 28 22 20 74 65 73 74 73 2d 6d  " AND (" tests-m
89c0: 61 74 63 68 2d 71 72 79 20 22 29 20 22 29 20 22  atch-qry ") ") "
89d0: 22 29 0a 09 09 09 09 28 63 61 73 65 20 73 6f 72  ").....(case sor
89e0: 74 2d 62 79 0a 09 09 09 09 20 20 28 28 72 75 6e  t-by.....  ((run
89f0: 64 69 72 29 20 20 20 20 20 22 20 4f 52 44 45 52  dir)     " ORDER
8a00: 20 42 59 20 6c 65 6e 67 74 68 28 72 75 6e 64 69   BY length(rundi
8a10: 72 29 20 44 45 53 43 3b 22 29 0a 09 09 09 09 20  r) DESC;")..... 
8a20: 20 28 28 65 76 65 6e 74 5f 74 69 6d 65 29 20 22   ((event_time) "
8a30: 20 4f 52 44 45 52 20 42 59 20 65 76 65 6e 74 5f   ORDER BY event_
8a40: 74 69 6d 65 20 41 53 43 3b 22 29 0a 09 09 09 09  time ASC;").....
8a50: 20 20 28 65 6c 73 65 20 20 20 20 20 20 20 20 20    (else         
8a60: 22 3b 22 29 29 0a 09 09 09 20 29 29 29 0a 20 20  ";")).... ))).  
8a70: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69    (debug:print-i
8a80: 6e 66 6f 20 38 20 22 64 62 3a 67 65 74 2d 74 65  nfo 8 "db:get-te
8a90: 73 74 73 2d 66 6f 72 2d 72 75 6e 20 71 72 79 3d  sts-for-run qry=
8aa0: 22 20 71 72 79 29 0a 20 20 20 20 28 73 71 6c 69  " qry).    (sqli
8ab0: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77  te3:for-each-row
8ac0: 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28   .     (lambda (
8ad0: 61 20 2e 20 62 29 20 3b 3b 20 69 64 20 72 75 6e  a . b) ;; id run
8ae0: 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61  -id testname sta
8af0: 74 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d  te status event-
8b00: 74 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61  time host cpuloa
8b10: 64 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65  d diskfree uname
8b20: 20 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74   rundir item-pat
8b30: 68 20 72 75 6e 2d 64 75 72 61 74 69 6f 6e 20 66  h run-duration f
8b40: 69 6e 61 6c 2d 6c 6f 67 66 20 63 6f 6d 6d 65 6e  inal-logf commen
8b50: 74 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20  t).       (set! 
8b60: 72 65 73 20 28 63 6f 6e 73 20 28 61 70 70 6c 79  res (cons (apply
8b70: 20 76 65 63 74 6f 72 20 61 20 62 29 20 72 65 73   vector a b) res
8b80: 29 29 29 20 3b 3b 20 69 64 20 72 75 6e 2d 69 64  ))) ;; id run-id
8b90: 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20   testname state 
8ba0: 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d  status event-tim
8bb0: 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64  e host cpuload d
8bc0: 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75  iskfree uname ru
8bd0: 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72  ndir item-path r
8be0: 75 6e 2d 64 75 72 61 74 69 6f 6e 20 66 69 6e 61  un-duration fina
8bf0: 6c 2d 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 20  l-logf comment) 
8c00: 72 65 73 29 29 29 0a 20 20 20 20 20 64 62 20 0a  res))).     db .
8c10: 20 20 20 20 20 71 72 79 0a 20 20 20 20 20 29 0a       qry.     ).
8c20: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74      (debug:print
8c30: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74  -info 11 "db:get
8c40: 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 53  -tests-for-run S
8c50: 54 41 52 54 20 72 75 6e 2d 69 64 73 3d 22 20 72  TART run-ids=" r
8c60: 75 6e 2d 69 64 73 20 22 2c 20 74 65 73 74 70 61  un-ids ", testpa
8c70: 74 74 3d 22 20 74 65 73 74 70 61 74 74 20 22 2c  tt=" testpatt ",
8c80: 20 73 74 61 74 65 73 3d 22 20 73 74 61 74 65 73   states=" states
8c90: 20 22 2c 20 73 74 61 74 75 73 65 73 3d 22 20 73   ", statuses=" s
8ca0: 74 61 74 75 73 65 73 20 22 2c 20 6e 6f 74 2d 69  tatuses ", not-i
8cb0: 6e 3d 22 20 6e 6f 74 2d 69 6e 20 22 2c 20 73 6f  n=" not-in ", so
8cc0: 72 74 2d 62 79 3d 22 20 73 6f 72 74 2d 62 79 29  rt-by=" sort-by)
8cd0: 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 74  .    res))..;; t
8ce0: 68 69 73 20 6f 6e 65 20 69 73 20 61 20 62 69 74  his one is a bit
8cf0: 20 62 72 6f 6b 65 6e 20 42 55 47 20 46 49 58 4d   broken BUG FIXM
8d00: 45 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 64 65  E.(define (db:de
8d10: 6c 65 74 65 2d 74 65 73 74 2d 73 74 65 70 2d 72  lete-test-step-r
8d20: 65 63 6f 72 64 73 20 64 62 20 74 65 73 74 2d 69  ecords db test-i
8d30: 64 29 0a 20 20 3b 3b 20 42 72 65 61 6b 69 6e 67  d).  ;; Breaking
8d40: 20 69 74 20 69 6e 74 6f 20 74 77 6f 20 71 75 65   it into two que
8d50: 72 69 65 73 20 66 6f 72 20 62 65 74 74 65 72 20  ries for better 
8d60: 66 69 6c 65 20 61 63 63 65 73 73 20 69 6e 74 65  file access inte
8d70: 72 6c 65 61 76 69 6e 67 0a 20 20 28 6c 65 74 2a  rleaving.  (let*
8d80: 20 28 28 74 64 62 20 28 64 62 3a 6f 70 65 6e 2d   ((tdb (db:open-
8d90: 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d  test-db-by-test-
8da0: 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 29  id db test-id)))
8db0: 0a 20 20 20 20 3b 3b 20 74 65 73 74 20 64 62 27  .    ;; test db'
8dc0: 73 20 63 61 6e 20 67 6f 20 61 77 61 79 20 2d 20  s can go away - 
8dd0: 6d 75 73 74 20 63 68 65 63 6b 20 65 76 65 72 79  must check every
8de0: 20 74 69 6d 65 0a 20 20 20 20 28 69 66 20 74 64   time.    (if td
8df0: 62 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 71  b..(begin..  (sq
8e00: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 74 64  lite3:execute td
8e10: 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74  b "DELETE FROM t
8e20: 65 73 74 5f 73 74 65 70 73 3b 22 29 0a 09 20 20  est_steps;")..  
8e30: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65  (sqlite3:execute
8e40: 20 74 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f   tdb "DELETE FRO
8e50: 4d 20 74 65 73 74 5f 64 61 74 61 3b 22 29 0a 09  M test_data;")..
8e60: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c    (sqlite3:final
8e70: 69 7a 65 21 20 74 64 62 29 29 29 29 29 0a 0a 3b  ize! tdb)))))..;
8e80: 3b 20 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 64  ; .(define (db:d
8e90: 65 6c 65 74 65 2d 74 65 73 74 2d 72 65 63 6f 72  elete-test-recor
8ea0: 64 73 20 64 62 20 74 64 62 20 74 65 73 74 2d 69  ds db tdb test-i
8eb0: 64 20 23 21 6b 65 79 20 28 66 6f 72 63 65 20 23  d #!key (force #
8ec0: 66 29 29 0a 20 20 28 63 6f 6d 6d 6f 6e 3a 63 6c  f)).  (common:cl
8ed0: 65 61 72 2d 63 61 63 68 65 73 29 0a 20 20 28 69  ear-caches).  (i
8ee0: 66 20 74 64 62 20 0a 20 20 20 20 20 20 28 62 65  f tdb .      (be
8ef0: 67 69 6e 0a 09 28 73 71 6c 69 74 65 33 3a 65 78  gin..(sqlite3:ex
8f00: 65 63 75 74 65 20 74 64 62 20 22 44 45 4c 45 54  ecute tdb "DELET
8f10: 45 20 46 52 4f 4d 20 74 65 73 74 5f 73 74 65 70  E FROM test_step
8f20: 73 3b 22 29 0a 09 28 73 71 6c 69 74 65 33 3a 65  s;")..(sqlite3:e
8f30: 78 65 63 75 74 65 20 74 64 62 20 22 44 45 4c 45  xecute tdb "DELE
8f40: 54 45 20 46 52 4f 4d 20 74 65 73 74 5f 64 61 74  TE FROM test_dat
8f50: 61 3b 22 29 29 29 0a 20 20 3b 3b 20 28 73 71 6c  a;"))).  ;; (sql
8f60: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20  ite3:execute db 
8f70: 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73  "DELETE FROM tes
8f80: 74 73 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20  ts WHERE id=?;" 
8f90: 74 65 73 74 2d 69 64 29 29 0a 20 20 28 69 66 20  test-id)).  (if 
8fa0: 64 62 20 0a 20 20 20 20 20 20 28 62 65 67 69 6e  db .      (begin
8fb0: 0a 09 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75  ..(sqlite3:execu
8fc0: 74 65 20 64 62 20 22 44 45 4c 45 54 45 20 46 52  te db "DELETE FR
8fd0: 4f 4d 20 74 65 73 74 5f 73 74 65 70 73 20 57 48  OM test_steps WH
8fe0: 45 52 45 20 74 65 73 74 5f 69 64 3d 3f 3b 22 20  ERE test_id=?;" 
8ff0: 74 65 73 74 2d 69 64 29 0a 09 28 73 71 6c 69 74  test-id)..(sqlit
9000: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 44  e3:execute db "D
9010: 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 5f  ELETE FROM test_
9020: 64 61 74 61 20 20 57 48 45 52 45 20 74 65 73 74  data  WHERE test
9030: 5f 69 64 3d 3f 3b 22 20 74 65 73 74 2d 69 64 29  _id=?;" test-id)
9040: 0a 09 28 69 66 20 66 6f 72 63 65 0a 09 20 20 20  ..(if force..   
9050: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74   (sqlite3:execut
9060: 65 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f  e db "DELETE FRO
9070: 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 69 64  M tests WHERE id
9080: 3d 3f 3b 22 20 74 65 73 74 2d 69 64 29 0a 09 20  =?;" test-id).. 
9090: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63     (sqlite3:exec
90a0: 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74  ute db "UPDATE t
90b0: 65 73 74 73 20 53 45 54 20 73 74 61 74 65 3d 27  ests SET state='
90c0: 44 45 4c 45 54 45 44 27 2c 73 74 61 74 75 73 3d  DELETED',status=
90d0: 27 6e 2f 61 27 20 57 48 45 52 45 20 69 64 3d 3f  'n/a' WHERE id=?
90e0: 3b 22 20 74 65 73 74 2d 69 64 29 29 29 29 29 0a  ;" test-id))))).
90f0: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 64 65 6c  .(define (db:del
9100: 65 74 65 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75  ete-tests-for-ru
9110: 6e 20 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 28  n db run-id).  (
9120: 63 6f 6d 6d 6f 6e 3a 63 6c 65 61 72 2d 63 61 63  common:clear-cac
9130: 68 65 73 29 0a 20 20 28 73 71 6c 69 74 65 33 3a  hes).  (sqlite3:
9140: 65 78 65 63 75 74 65 20 64 62 20 22 44 45 4c 45  execute db "DELE
9150: 54 45 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48  TE FROM tests WH
9160: 45 52 45 20 72 75 6e 5f 69 64 3d 3f 3b 22 20 72  ERE run_id=?;" r
9170: 75 6e 2d 69 64 29 29 0a 0a 28 64 65 66 69 6e 65  un-id))..(define
9180: 20 28 64 62 3a 64 65 6c 65 74 65 2d 6f 6c 64 2d   (db:delete-old-
9190: 64 65 6c 65 74 65 64 2d 74 65 73 74 2d 72 65 63  deleted-test-rec
91a0: 6f 72 64 73 20 64 62 29 0a 20 20 28 6c 65 74 20  ords db).  (let 
91b0: 28 28 74 61 72 67 74 69 6d 65 20 28 2d 20 28 63  ((targtime (- (c
91c0: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 28  urrent-seconds)(
91d0: 2a 20 33 30 20 32 34 20 36 30 20 36 30 29 29 29  * 30 24 60 60)))
91e0: 29 20 3b 3b 20 6f 6e 65 20 6d 6f 6e 74 68 20 69  ) ;; one month i
91f0: 6e 20 74 68 65 20 70 61 73 74 0a 20 20 20 20 28  n the past.    (
9200: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20  sqlite3:execute 
9210: 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20  db "DELETE FROM 
9220: 74 65 73 74 73 20 57 48 45 52 45 20 73 74 61 74  tests WHERE stat
9230: 65 3d 27 44 45 4c 45 54 45 44 27 20 41 4e 44 20  e='DELETED' AND 
9240: 65 76 65 6e 74 5f 74 69 6d 65 3c 3f 3b 22 20 74  event_time<?;" t
9250: 61 72 67 74 69 6d 65 29 29 29 0a 0a 3b 3b 20 73  argtime)))..;; s
9260: 65 74 20 74 65 73 74 73 20 77 69 74 68 20 73 74  et tests with st
9270: 61 74 65 20 63 75 72 72 73 74 61 74 65 20 61 6e  ate currstate an
9280: 64 20 73 74 61 74 75 73 20 63 75 72 72 73 74 61  d status currsta
9290: 74 75 73 20 74 6f 20 6e 65 77 73 74 61 74 65 20  tus to newstate 
92a0: 61 6e 64 20 6e 65 77 73 74 61 74 75 73 0a 3b 3b  and newstatus.;;
92b0: 20 75 73 65 20 63 75 72 72 73 74 61 74 65 20 3d   use currstate =
92c0: 20 23 66 20 61 6e 64 20 6f 72 20 63 75 72 72 73   #f and or currs
92d0: 74 61 74 75 73 20 3d 20 23 66 20 74 6f 20 61 70  tatus = #f to ap
92e0: 70 6c 79 20 74 6f 20 61 6e 79 20 73 74 61 74 65  ply to any state
92f0: 20 6f 72 20 73 74 61 74 75 73 20 72 65 73 70 65   or status respe
9300: 63 74 69 76 65 6c 79 0a 3b 3b 20 57 41 52 4e 49  ctively.;; WARNI
9310: 4e 47 3a 20 53 51 4c 20 69 6e 6a 65 63 74 69 6f  NG: SQL injectio
9320: 6e 20 72 69 73 6b 0a 28 64 65 66 69 6e 65 20 28  n risk.(define (
9330: 64 62 3a 73 65 74 2d 74 65 73 74 73 2d 73 74 61  db:set-tests-sta
9340: 74 65 2d 73 74 61 74 75 73 20 64 62 20 72 75 6e  te-status db run
9350: 2d 69 64 20 74 65 73 74 6e 61 6d 65 73 20 63 75  -id testnames cu
9360: 72 72 73 74 61 74 65 20 63 75 72 72 73 74 61 74  rrstate currstat
9370: 75 73 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73  us newstate news
9380: 74 61 74 75 73 29 0a 20 20 28 66 6f 72 2d 65 61  tatus).  (for-ea
9390: 63 68 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74  ch (lambda (test
93a0: 6e 61 6d 65 29 0a 09 20 20 20 20 20 20 28 6c 65  name)..      (le
93b0: 74 20 28 28 71 72 79 20 28 63 6f 6e 63 20 22 55  t ((qry (conc "U
93c0: 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20  PDATE tests SET 
93d0: 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f  state=?,status=?
93e0: 20 57 48 45 52 45 20 22 0a 09 09 09 20 20 20 20   WHERE "....    
93f0: 20 20 20 28 69 66 20 63 75 72 72 73 74 61 74 65     (if currstate
9400: 20 20 28 63 6f 6e 63 20 22 73 74 61 74 65 3d 27    (conc "state='
9410: 22 20 63 75 72 72 73 74 61 74 65 20 22 27 20 41  " currstate "' A
9420: 4e 44 20 22 29 20 22 22 29 0a 09 09 09 20 20 20  ND ") "")....   
9430: 20 20 20 20 28 69 66 20 63 75 72 72 73 74 61 74      (if currstat
9440: 75 73 20 28 63 6f 6e 63 20 22 73 74 61 74 75 73  us (conc "status
9450: 3d 27 22 20 63 75 72 72 73 74 61 74 75 73 20 22  ='" currstatus "
9460: 27 20 41 4e 44 20 22 29 20 22 22 29 0a 09 09 09  ' AND ") "")....
9470: 20 20 20 20 20 20 20 22 20 72 75 6e 5f 69 64 3d         " run_id=
9480: 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f  ? AND testname=?
9490: 20 41 4e 44 20 4e 4f 54 20 28 69 74 65 6d 5f 70   AND NOT (item_p
94a0: 61 74 68 3d 27 27 20 41 4e 44 20 74 65 73 74 6e  ath='' AND testn
94b0: 61 6d 65 20 69 6e 20 28 53 45 4c 45 43 54 20 44  ame in (SELECT D
94c0: 49 53 54 49 4e 43 54 20 74 65 73 74 6e 61 6d 65  ISTINCT testname
94d0: 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52   FROM tests WHER
94e0: 45 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44  E testname=? AND
94f0: 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 27   item_path != ''
9500: 29 29 3b 22 29 29 29 0a 09 09 3b 3b 28 64 65 62  ));")))...;;(deb
9510: 75 67 3a 70 72 69 6e 74 20 30 20 22 51 52 59 3a  ug:print 0 "QRY:
9520: 20 22 20 71 72 79 29 0a 09 09 28 73 71 6c 69 74   " qry)...(sqlit
9530: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 71 72  e3:execute db qr
9540: 79 20 72 75 6e 2d 69 64 20 6e 65 77 73 74 61 74  y run-id newstat
9550: 65 20 6e 65 77 73 74 61 74 75 73 20 74 65 73 74  e newstatus test
9560: 6e 61 6d 65 20 74 65 73 74 6e 61 6d 65 29 29 29  name testname)))
9570: 0a 09 20 20 20 20 74 65 73 74 6e 61 6d 65 73 29  ..    testnames)
9580: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a  )..(define (cdb:
9590: 64 65 6c 65 74 65 2d 74 65 73 74 73 2d 69 6e 2d  delete-tests-in-
95a0: 73 74 61 74 65 20 73 65 72 76 65 72 64 61 74 20  state serverdat 
95b0: 72 75 6e 2d 69 64 20 73 74 61 74 65 29 0a 20 20  run-id state).  
95c0: 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c  (cdb:client-call
95d0: 20 73 65 72 76 65 72 64 61 74 20 27 64 65 6c 65   serverdat 'dele
95e0: 74 65 2d 74 65 73 74 73 2d 69 6e 2d 73 74 61 74  te-tests-in-stat
95f0: 65 20 23 74 20 2a 64 65 66 61 75 6c 74 2d 6e 75  e #t *default-nu
9600: 6d 74 72 69 65 73 2a 20 72 75 6e 2d 69 64 20 73  mtries* run-id s
9610: 74 61 74 65 29 29 0a 0a 3b 3b 20 73 70 65 65 64  tate))..;; speed
9620: 20 75 70 20 66 6f 72 20 63 6f 6d 6d 6f 6e 20 63   up for common c
9630: 61 73 65 73 20 77 69 74 68 20 61 20 6c 69 74 74  ases with a litt
9640: 6c 65 20 6c 6f 67 69 63 0a 28 64 65 66 69 6e 65  le logic.(define
9650: 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74   (db:test-set-st
9660: 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64  ate-status-by-id
9670: 20 64 62 20 74 65 73 74 2d 69 64 20 6e 65 77 73   db test-id news
9680: 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 20 6e  tate newstatus n
9690: 65 77 63 6f 6d 6d 65 6e 74 29 0a 20 20 28 63 6f  ewcomment).  (co
96a0: 6e 64 0a 20 20 20 28 28 61 6e 64 20 6e 65 77 73  nd.   ((and news
96b0: 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 20 6e  tate newstatus n
96c0: 65 77 63 6f 6d 6d 65 6e 74 29 0a 20 20 20 20 28  ewcomment).    (
96d0: 73 71 6c 69 74 65 33 3a 65 78 65 63 74 75 74 65  sqlite3:exectute
96e0: 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 74   db "UPDATE test
96f0: 73 20 53 45 54 20 73 74 61 74 65 3d 3f 2c 73 74  s SET state=?,st
9700: 61 74 75 73 3d 3f 2c 63 6f 6d 6d 65 6e 74 3d 3f  atus=?,comment=?
9710: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 6e 65   WHERE id=?;" ne
9720: 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 73  wstate newstatus
9730: 20 74 65 73 74 2d 69 64 29 29 0a 20 20 20 28 28   test-id)).   ((
9740: 61 6e 64 20 6e 65 77 73 74 61 74 65 20 6e 65 77  and newstate new
9750: 73 74 61 74 75 73 29 0a 20 20 20 20 28 73 71 6c  status).    (sql
9760: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20  ite3:execute db 
9770: 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45  "UPDATE tests SE
9780: 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 73  T state=?,status
9790: 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20  =? WHERE id=?;" 
97a0: 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 74  newstate newstat
97b0: 75 73 20 74 65 73 74 2d 69 64 29 29 0a 20 20 20  us test-id)).   
97c0: 28 65 6c 73 65 0a 20 20 20 20 28 69 66 20 6e 65  (else.    (if ne
97d0: 77 73 74 61 74 65 20 20 20 28 73 71 6c 69 74 65  wstate   (sqlite
97e0: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 50  3:execute db "UP
97f0: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 73  DATE tests SET s
9800: 74 61 74 65 3d 3f 20 20 20 57 48 45 52 45 20 69  tate=?   WHERE i
9810: 64 3d 3f 3b 22 20 6e 65 77 73 74 61 74 65 20 20  d=?;" newstate  
9820: 20 74 65 73 74 2d 69 64 29 29 0a 20 20 20 20 28   test-id)).    (
9830: 69 66 20 6e 65 77 73 74 61 74 75 73 20 20 28 73  if newstatus  (s
9840: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64  qlite3:execute d
9850: 62 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20  b "UPDATE tests 
9860: 53 45 54 20 73 74 61 74 75 73 3d 3f 20 20 57 48  SET status=?  WH
9870: 45 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 73 74  ERE id=?;" newst
9880: 61 74 75 73 20 20 74 65 73 74 2d 69 64 29 29 0a  atus  test-id)).
9890: 20 20 20 20 28 69 66 20 6e 65 77 63 6f 6d 6d 65      (if newcomme
98a0: 6e 74 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63  nt (sqlite3:exec
98b0: 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74  ute db "UPDATE t
98c0: 65 73 74 73 20 53 45 54 20 63 6f 6d 6d 65 6e 74  ests SET comment
98d0: 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20  =? WHERE id=?;" 
98e0: 6e 65 77 63 6f 6d 6d 65 6e 74 20 74 65 73 74 2d  newcomment test-
98f0: 69 64 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65  id)))))..(define
9900: 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74   (db:test-set-st
9910: 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 72 75  ate-status-by-ru
9920: 6e 2d 69 64 2d 74 65 73 74 6e 61 6d 65 20 64 62  n-id-testname db
9930: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d   run-id test-nam
9940: 65 20 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74  e item-path stat
9950: 75 73 20 73 74 61 74 65 29 0a 20 20 28 73 71 6c  us state).  (sql
9960: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20  ite3:execute db 
9970: 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45  "UPDATE tests SE
9980: 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 73  T state=?,status
9990: 3d 3f 2c 65 76 65 6e 74 5f 74 69 6d 65 3d 73 74  =?,event_time=st
99a0: 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77  rftime('%s','now
99b0: 27 29 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d  ') WHERE run_id=
99c0: 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f  ? AND testname=?
99d0: 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 3f   AND item_path=?
99e0: 3b 22 20 0a 09 09 20 20 20 73 74 61 74 65 20 73  ;" ...   state s
99f0: 74 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73  tatus run-id tes
9a00: 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68  t-name item-path
9a10: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a  ))..(define (db:
9a20: 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d  get-count-tests-
9a30: 72 75 6e 6e 69 6e 67 20 64 62 29 0a 20 20 28 6c  running db).  (l
9a40: 65 74 20 28 28 72 65 73 20 30 29 29 0a 20 20 20  et ((res 0)).   
9a50: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61   (sqlite3:for-ea
9a60: 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d  ch-row.     (lam
9a70: 62 64 61 20 28 63 6f 75 6e 74 29 0a 20 20 20 20  bda (count).    
9a80: 20 20 20 28 73 65 74 21 20 72 65 73 20 63 6f 75     (set! res cou
9a90: 6e 74 29 29 0a 20 20 20 20 20 64 62 0a 20 20 20  nt)).     db.   
9aa0: 20 20 22 53 45 4c 45 43 54 20 63 6f 75 6e 74 28    "SELECT count(
9ab0: 69 64 29 20 46 52 4f 4d 20 74 65 73 74 73 20 57  id) FROM tests W
9ac0: 48 45 52 45 20 73 74 61 74 65 20 69 6e 20 28 27  HERE state in ('
9ad0: 52 55 4e 4e 49 4e 47 27 2c 27 4c 41 55 4e 43 48  RUNNING','LAUNCH
9ae0: 45 44 27 2c 27 52 45 4d 4f 54 45 48 4f 53 54 53  ED','REMOTEHOSTS
9af0: 54 41 52 54 27 29 3b 22 29 0a 20 20 20 20 72 65  TART');").    re
9b00: 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62  s))..(define (db
9b10: 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73  :get-count-tests
9b20: 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67  -running-in-jobg
9b30: 72 6f 75 70 20 64 62 20 6a 6f 62 67 72 6f 75 70  roup db jobgroup
9b40: 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 6a 6f 62  ).  (if (not job
9b50: 67 72 6f 75 70 29 0a 20 20 20 20 20 20 30 20 3b  group).      0 ;
9b60: 3b 20 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28  ; .      (let ((
9b70: 72 65 73 20 30 29 29 0a 09 28 73 71 6c 69 74 65  res 0))..(sqlite
9b80: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09  3:for-each-row..
9b90: 20 28 6c 61 6d 62 64 61 20 28 63 6f 75 6e 74 29   (lambda (count)
9ba0: 0a 09 20 20 20 28 73 65 74 21 20 72 65 73 20 63  ..   (set! res c
9bb0: 6f 75 6e 74 29 29 0a 09 20 64 62 0a 09 20 22 53  ount)).. db.. "S
9bc0: 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20  ELECT count(id) 
9bd0: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45  FROM tests WHERE
9be0: 20 73 74 61 74 65 20 3d 20 27 52 55 4e 4e 49 4e   state = 'RUNNIN
9bf0: 47 27 20 4f 52 20 73 74 61 74 65 20 3d 20 27 4c  G' OR state = 'L
9c00: 41 55 4e 43 48 45 44 27 20 4f 52 20 73 74 61 74  AUNCHED' OR stat
9c10: 65 20 3d 20 27 52 45 4d 4f 54 45 48 4f 53 54 53  e = 'REMOTEHOSTS
9c20: 54 41 52 54 27 0a 20 20 20 20 20 20 20 20 20 20  TART'.          
9c30: 20 20 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 20     AND testname 
9c40: 69 6e 20 28 53 45 4c 45 43 54 20 74 65 73 74 6e  in (SELECT testn
9c50: 61 6d 65 20 46 52 4f 4d 20 74 65 73 74 5f 6d 65  ame FROM test_me
9c60: 74 61 20 57 48 45 52 45 20 6a 6f 62 67 72 6f 75  ta WHERE jobgrou
9c70: 70 3d 3f 3b 22 0a 09 20 6a 6f 62 67 72 6f 75 70  p=?;".. jobgroup
9c80: 29 0a 09 72 65 73 29 29 29 0a 0a 3b 3b 20 64 6f  )..res)))..;; do
9c90: 6e 65 20 77 69 74 68 20 72 75 6e 20 77 68 65 6e  ne with run when
9ca0: 3a 0a 3b 3b 20 20 20 30 20 74 65 73 74 73 20 69  :.;;   0 tests i
9cb0: 6e 20 4c 41 55 4e 43 48 45 44 2c 20 4e 4f 54 5f  n LAUNCHED, NOT_
9cc0: 53 54 41 52 54 45 44 2c 20 52 45 4d 4f 54 45 48  STARTED, REMOTEH
9cd0: 4f 53 54 53 54 41 52 54 2c 20 52 55 4e 4e 49 4e  OSTSTART, RUNNIN
9ce0: 47 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 65 73  G.(define (db:es
9cf0: 74 69 6d 61 74 65 64 2d 74 65 73 74 73 2d 72 65  timated-tests-re
9d00: 6d 61 69 6e 69 6e 67 20 64 62 20 72 75 6e 2d 69  maining db run-i
9d10: 64 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20  d).  (let ((res 
9d20: 30 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33  0)).    (sqlite3
9d30: 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20  :for-each-row.  
9d40: 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6f 75 6e     (lambda (coun
9d50: 74 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20  t).       (set! 
9d60: 72 65 73 20 63 6f 75 6e 74 29 29 0a 20 20 20 20  res count)).    
9d70: 20 64 62 20 3b 3b 20 4e 42 2f 2f 20 4b 49 4c 4c   db ;; NB// KILL
9d80: 52 45 51 20 6d 65 61 6e 73 20 74 68 65 20 6a 6f  REQ means the jo
9d90: 62 73 20 69 73 20 73 74 69 6c 6c 20 70 72 6f 62  bs is still prob
9da0: 61 62 6c 79 20 72 75 6e 6e 69 6e 67 0a 20 20 20  ably running.   
9db0: 20 20 22 53 45 4c 45 43 54 20 63 6f 75 6e 74 28    "SELECT count(
9dc0: 69 64 29 20 46 52 4f 4d 20 74 65 73 74 73 20 57  id) FROM tests W
9dd0: 48 45 52 45 20 73 74 61 74 65 20 69 6e 20 28 27  HERE state in ('
9de0: 4c 41 55 4e 43 48 45 44 27 2c 27 4e 4f 54 5f 53  LAUNCHED','NOT_S
9df0: 54 41 52 54 45 44 27 2c 27 52 45 4d 4f 54 45 48  TARTED','REMOTEH
9e00: 4f 53 54 53 54 41 52 54 27 2c 27 52 55 4e 4e 49  OSTSTART','RUNNI
9e10: 4e 47 27 2c 27 4b 49 4c 4c 52 45 51 27 29 20 41  NG','KILLREQ') A
9e20: 4e 44 20 72 75 6e 5f 69 64 3d 3f 3b 22 20 72 75  ND run_id=?;" ru
9e30: 6e 2d 69 64 29 0a 20 20 20 20 72 65 73 29 29 0a  n-id).    res)).
9e40: 0a 3b 3b 20 6d 61 70 20 72 75 6e 2d 69 64 2c 20  .;; map run-id, 
9e50: 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61  testname item-pa
9e60: 74 68 20 74 6f 20 74 65 73 74 2d 69 64 0a 28 64  th to test-id.(d
9e70: 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 74 65  efine (db:get-te
9e80: 73 74 2d 69 64 2d 63 61 63 68 65 64 20 64 62 20  st-id-cached db 
9e90: 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20  run-id testname 
9ea0: 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 6c 65  item-path).  (le
9eb0: 74 2a 20 28 28 74 65 73 74 2d 6b 65 79 20 28 63  t* ((test-key (c
9ec0: 6f 6e 63 20 72 75 6e 2d 69 64 20 22 2d 22 20 74  onc run-id "-" t
9ed0: 65 73 74 6e 61 6d 65 20 22 2d 22 20 69 74 65 6d  estname "-" item
9ee0: 2d 70 61 74 68 29 29 0a 09 20 28 72 65 73 20 20  -path)).. (res  
9ef0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d      (hash-table-
9f00: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 74 65 73  ref/default *tes
9f10: 74 2d 69 64 73 2a 20 74 65 73 74 2d 6b 65 79 20  t-ids* test-key 
9f20: 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 72 65  #f))).    (if re
9f30: 73 20 0a 09 72 65 73 0a 09 28 62 65 67 69 6e 0a  s ..res..(begin.
9f40: 09 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d  .  (sqlite3:for-
9f50: 65 61 63 68 2d 72 6f 77 0a 09 20 20 20 28 6c 61  each-row..   (la
9f60: 6d 62 64 61 20 28 69 64 29 20 3b 3b 20 20 72 75  mbda (id) ;;  ru
9f70: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74  n-id testname st
9f80: 61 74 65 20 73 74 61 74 75 73 20 65 76 65 6e 74  ate status event
9f90: 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f  -time host cpulo
9fa0: 61 64 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d  ad diskfree unam
9fb0: 65 20 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61  e rundir item-pa
9fc0: 74 68 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20  th run_duration 
9fd0: 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65  final_logf comme
9fe0: 6e 74 20 29 0a 09 20 20 20 20 20 28 73 65 74 21  nt )..     (set!
9ff0: 20 72 65 73 20 69 64 29 29 20 3b 3b 20 28 76 65   res id)) ;; (ve
a000: 63 74 6f 72 20 69 64 20 72 75 6e 2d 69 64 20 74  ctor id run-id t
a010: 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74  estname state st
a020: 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20  atus event-time 
a030: 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73  host cpuload dis
a040: 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64  kfree uname rund
a050: 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e  ir item-path run
a060: 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f  _duration final_
a070: 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 20 29 29 29  logf comment )))
a080: 0a 09 20 20 20 64 62 20 0a 09 20 20 20 22 53 45  ..   db ..   "SE
a090: 4c 45 43 54 20 69 64 20 46 52 4f 4d 20 74 65 73  LECT id FROM tes
a0a0: 74 73 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d  ts WHERE run_id=
a0b0: 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f  ? AND testname=?
a0c0: 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 3f   AND item_path=?
a0d0: 3b 22 0a 09 20 20 20 72 75 6e 2d 69 64 20 74 65  ;"..   run-id te
a0e0: 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68  stname item-path
a0f0: 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65  )..  (hash-table
a100: 2d 73 65 74 21 20 2a 74 65 73 74 2d 69 64 73 2a  -set! *test-ids*
a110: 20 74 65 73 74 2d 6b 65 79 20 72 65 73 29 0a 09   test-key res)..
a120: 20 20 72 65 73 29 29 29 29 0a 0a 3b 3b 20 6d 61    res))))..;; ma
a130: 70 20 72 75 6e 2d 69 64 2c 20 74 65 73 74 6e 61  p run-id, testna
a140: 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 74 6f 20  me item-path to 
a150: 74 65 73 74 2d 69 64 0a 28 64 65 66 69 6e 65 20  test-id.(define 
a160: 28 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 2d  (db:get-test-id-
a170: 6e 6f 74 2d 63 61 63 68 65 64 20 64 62 20 72 75  not-cached db ru
a180: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74  n-id testname it
a190: 65 6d 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 2a  em-path).  (let*
a1a0: 20 28 28 72 65 73 20 23 66 29 29 0a 20 20 20 20   ((res #f)).    
a1b0: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63  (sqlite3:for-eac
a1c0: 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62  h-row.     (lamb
a1d0: 64 61 20 28 69 64 29 20 3b 3b 20 20 72 75 6e 2d  da (id) ;;  run-
a1e0: 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74  id testname stat
a1f0: 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74  e status event-t
a200: 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64  ime host cpuload
a210: 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20   diskfree uname 
a220: 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68  rundir item-path
a230: 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69   run_duration fi
a240: 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74  nal_logf comment
a250: 20 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20   ).       (set! 
a260: 72 65 73 20 69 64 29 29 20 3b 3b 20 28 76 65 63  res id)) ;; (vec
a270: 74 6f 72 20 69 64 20 72 75 6e 2d 69 64 20 74 65  tor id run-id te
a280: 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61  stname state sta
a290: 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68  tus event-time h
a2a0: 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b  ost cpuload disk
a2b0: 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69  free uname rundi
a2c0: 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f  r item-path run_
a2d0: 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c  duration final_l
a2e0: 6f 67 66 20 63 6f 6d 6d 65 6e 74 20 29 29 29 0a  ogf comment ))).
a2f0: 20 20 20 20 20 64 62 20 0a 20 20 20 20 20 22 53       db .     "S
a300: 45 4c 45 43 54 20 69 64 20 46 52 4f 4d 20 74 65  ELECT id FROM te
a310: 73 74 73 20 57 48 45 52 45 20 72 75 6e 5f 69 64  sts WHERE run_id
a320: 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d  =? AND testname=
a330: 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d  ? AND item_path=
a340: 3f 3b 22 0a 20 20 20 20 20 72 75 6e 2d 69 64 20  ?;".     run-id 
a350: 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61  testname item-pa
a360: 74 68 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 28  th).    res))..(
a370: 64 65 66 69 6e 65 20 64 62 3a 67 65 74 2d 74 65  define db:get-te
a380: 73 74 2d 69 64 20 64 62 3a 67 65 74 2d 74 65 73  st-id db:get-tes
a390: 74 2d 69 64 2d 6e 6f 74 2d 63 61 63 68 65 64 29  t-id-not-cached)
a3a0: 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 74 65 73  ..;; given a tes
a3b0: 74 2d 69 6e 66 6f 20 72 65 63 6f 72 64 2c 20 70  t-info record, p
a3c0: 61 74 63 68 20 69 6e 20 74 68 65 20 6c 61 74 65  atch in the late
a3d0: 73 74 20 64 61 74 61 20 66 72 6f 6d 20 74 68 65  st data from the
a3e0: 20 74 65 73 74 64 61 74 2e 64 62 20 66 69 6c 65   testdat.db file
a3f0: 0a 3b 3b 20 66 6f 75 6e 64 20 69 6e 20 74 68 65  .;; found in the
a400: 20 74 65 73 74 20 72 75 6e 20 64 69 72 65 63 74   test run direct
a410: 6f 72 79 0a 28 64 65 66 69 6e 65 20 28 64 62 3a  ory.(define (db:
a420: 70 61 74 63 68 2d 74 64 62 2d 64 61 74 61 2d 69  patch-tdb-data-i
a430: 6e 74 6f 2d 74 65 73 74 2d 69 6e 66 6f 20 64 62  nto-test-info db
a440: 20 74 65 73 74 2d 69 64 20 72 65 73 29 0a 20 20   test-id res).  
a450: 28 6c 65 74 20 28 28 74 64 62 20 28 64 62 3a 6f  (let ((tdb (db:o
a460: 70 65 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74  pen-test-db-by-t
a470: 65 73 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69  est-id db test-i
a480: 64 29 29 29 0a 20 20 20 20 3b 3b 20 67 65 74 20  d))).    ;; get 
a490: 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 73  state and status
a4a0: 20 66 72 6f 6d 20 6d 65 67 61 74 65 73 74 2e 64   from megatest.d
a4b0: 62 20 69 6e 20 72 65 61 6c 20 74 69 6d 65 0a 20  b in real time. 
a4c0: 20 20 20 3b 3b 20 6f 74 68 65 72 20 66 69 65 6c     ;; other fiel
a4d0: 64 73 20 74 68 61 74 20 70 65 72 68 61 70 73 20  ds that perhaps 
a4e0: 73 68 6f 75 6c 64 20 62 65 20 75 70 64 61 74 65  should be update
a4f0: 64 3a 0a 20 20 20 20 3b 3b 20 20 20 66 61 69 6c  d:.    ;;   fail
a500: 5f 63 6f 75 6e 74 0a 20 20 20 20 3b 3b 20 20 20  _count.    ;;   
a510: 70 61 73 73 5f 63 6f 75 6e 74 0a 20 20 20 20 3b  pass_count.    ;
a520: 3b 20 20 20 66 69 6e 61 6c 5f 6c 6f 67 66 0a 20  ;   final_logf. 
a530: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d     (sqlite3:for-
a540: 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c  each-row.     (l
a550: 61 6d 62 64 61 20 28 73 74 61 74 65 20 73 74 61  ambda (state sta
a560: 74 75 73 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 0a  tus final_logf).
a570: 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d         (db:test-
a580: 73 65 74 2d 73 74 61 74 65 21 20 20 20 20 20 20  set-state!      
a590: 20 20 72 65 73 20 73 74 61 74 65 29 0a 20 20 20    res state).   
a5a0: 20 20 20 20 28 64 62 3a 74 65 73 74 2d 73 65 74      (db:test-set
a5b0: 2d 73 74 61 74 75 73 21 20 20 20 20 20 20 20 72  -status!       r
a5c0: 65 73 20 73 74 61 74 75 73 29 0a 20 20 20 20 20  es status).     
a5d0: 20 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 66    (db:test-set-f
a5e0: 69 6e 61 6c 5f 6c 6f 67 66 21 20 20 20 72 65 73  inal_logf!   res
a5f0: 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 29 0a 20 20   final_logf)).  
a600: 20 20 20 64 62 0a 20 20 20 20 20 22 53 45 4c 45     db.     "SELE
a610: 43 54 20 73 74 61 74 65 2c 73 74 61 74 75 73 2c  CT state,status,
a620: 66 69 6e 61 6c 5f 6c 6f 67 66 20 46 52 4f 4d 20  final_logf FROM 
a630: 74 65 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f  tests WHERE id=?
a640: 3b 22 0a 20 20 20 20 20 74 65 73 74 2d 69 64 29  ;".     test-id)
a650: 0a 20 20 20 20 28 69 66 20 74 64 62 0a 09 28 62  .    (if tdb..(b
a660: 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 33  egin..  (sqlite3
a670: 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20  :for-each-row.. 
a680: 20 20 28 6c 61 6d 62 64 61 20 28 75 70 64 61 74    (lambda (updat
a690: 65 5f 74 69 6d 65 20 63 70 75 6c 6f 61 64 20 64  e_time cpuload d
a6a0: 69 73 6b 5f 66 72 65 65 20 72 75 6e 5f 64 75 72  isk_free run_dur
a6b0: 61 74 69 6f 6e 29 0a 09 20 20 20 20 20 28 64 62  ation)..     (db
a6c0: 3a 74 65 73 74 2d 73 65 74 2d 63 70 75 6c 6f 61  :test-set-cpuloa
a6d0: 64 21 20 20 20 20 20 20 72 65 73 20 63 70 75 6c  d!      res cpul
a6e0: 6f 61 64 29 0a 09 20 20 20 20 20 28 64 62 3a 74  oad)..     (db:t
a6f0: 65 73 74 2d 73 65 74 2d 64 69 73 6b 66 72 65 65  est-set-diskfree
a700: 21 20 20 20 20 20 72 65 73 20 64 69 73 6b 5f 66  !     res disk_f
a710: 72 65 65 29 0a 09 20 20 20 20 20 28 64 62 3a 74  ree)..     (db:t
a720: 65 73 74 2d 73 65 74 2d 72 75 6e 5f 64 75 72 61  est-set-run_dura
a730: 74 69 6f 6e 21 20 72 65 73 20 72 75 6e 5f 64 75  tion! res run_du
a740: 72 61 74 69 6f 6e 29 29 0a 09 20 20 20 74 64 62  ration))..   tdb
a750: 0a 09 20 20 20 22 53 45 4c 45 43 54 20 75 70 64  ..   "SELECT upd
a760: 61 74 65 5f 74 69 6d 65 2c 63 70 75 6c 6f 61 64  ate_time,cpuload
a770: 2c 64 69 73 6b 66 72 65 65 2c 72 75 6e 5f 64 75  ,diskfree,run_du
a780: 72 61 74 69 6f 6e 20 46 52 4f 4d 20 74 65 73 74  ration FROM test
a790: 5f 72 75 6e 64 61 74 20 4f 52 44 45 52 20 42 59  _rundat ORDER BY
a7a0: 20 69 64 20 44 45 53 43 20 4c 49 4d 49 54 20 31   id DESC LIMIT 1
a7b0: 3b 22 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a  ;")..  (sqlite3:
a7c0: 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 29 0a  finalize! tdb)).
a7d0: 09 3b 3b 20 69 66 20 74 68 65 20 74 65 73 74 20  .;; if the test 
a7e0: 64 62 20 69 73 20 6e 6f 74 20 66 6f 75 6e 64 20  db is not found 
a7f0: 77 68 61 74 20 74 6f 20 64 6f 3f 0a 09 3b 3b 20  what to do?..;; 
a800: 31 2e 20 73 65 74 20 73 74 61 74 65 20 74 6f 20  1. set state to 
a810: 44 45 4c 45 54 45 44 0a 09 3b 3b 20 32 2e 20 73  DELETED..;; 2. s
a820: 65 74 20 73 74 61 74 75 73 20 74 6f 20 6e 2f 61  et status to n/a
a830: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 62 3a  ..(begin..  (db:
a840: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 21 20  test-set-state! 
a850: 20 72 65 73 20 22 4e 4f 54 5f 53 54 41 52 54 45   res "NOT_STARTE
a860: 44 22 29 0a 09 20 20 28 64 62 3a 74 65 73 74 2d  D")..  (db:test-
a870: 73 65 74 2d 73 74 61 74 75 73 21 20 72 65 73 20  set-status! res 
a880: 22 6e 2f 61 22 29 29 29 29 29 0a 0a 28 64 65 66  "n/a")))))..(def
a890: 69 6e 65 20 2a 6c 61 73 74 2d 74 65 73 74 2d 63  ine *last-test-c
a8a0: 61 63 68 65 2d 64 65 6c 65 74 65 2a 20 28 63 75  ache-delete* (cu
a8b0: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a  rrent-seconds)).
a8c0: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 63 6c 65  .(define (db:cle
a8d0: 61 6e 2d 61 6c 6c 2d 63 61 63 68 65 73 29 0a 20  an-all-caches). 
a8e0: 20 28 73 65 74 21 20 2a 74 65 73 74 2d 69 6e 66   (set! *test-inf
a8f0: 6f 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61  o* (make-hash-ta
a900: 62 6c 65 29 29 0a 20 20 28 73 65 74 21 20 2a 74  ble)).  (set! *t
a910: 65 73 74 2d 69 64 2d 63 61 63 68 65 2a 20 28 6d  est-id-cache* (m
a920: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29  ake-hash-table))
a930: 29 0a 0a 3b 3b 20 55 73 65 20 64 62 3a 74 65 73  )..;; Use db:tes
a940: 74 2d 67 65 74 2a 20 74 6f 20 61 63 63 65 73 73  t-get* to access
a950: 0a 3b 3b 0a 3b 3b 20 47 65 74 20 74 65 73 74 20  .;;.;; Get test 
a960: 64 61 74 61 20 75 73 69 6e 67 20 74 65 73 74 5f  data using test_
a970: 69 64 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67  id.(define (db:g
a980: 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d  et-test-info-by-
a990: 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 0a 20  id db test-id). 
a9a0: 20 28 69 66 20 28 6e 6f 74 20 74 65 73 74 2d 69   (if (not test-i
a9b0: 64 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a  d).      (begin.
a9c0: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e  .(debug:print-in
a9d0: 66 6f 20 34 20 22 64 62 3a 67 65 74 2d 74 65 73  fo 4 "db:get-tes
a9e0: 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 63 61 6c  t-info-by-id cal
a9f0: 6c 65 64 20 77 69 74 68 20 74 65 73 74 2d 69 64  led with test-id
aa00: 3d 22 20 74 65 73 74 2d 69 64 29 0a 09 23 66 29  =" test-id)..#f)
aa10: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65  .      (let ((re
aa20: 73 20 23 66 29 29 0a 09 28 73 71 6c 69 74 65 33  s #f))..(sqlite3
aa30: 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20  :for-each-row.. 
aa40: 28 6c 61 6d 62 64 61 20 28 69 64 20 72 75 6e 2d  (lambda (id run-
aa50: 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74  id testname stat
aa60: 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74  e status event-t
aa70: 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64  ime host cpuload
aa80: 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20   diskfree uname 
aa90: 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68  rundir item-path
aaa0: 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69   run_duration fi
aab0: 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74  nal_logf comment
aac0: 29 0a 09 20 20 20 3b 3b 20 20 20 20 20 20 20 20  )..   ;;        
aad0: 20 20 20 20 20 20 20 20 20 30 20 20 20 20 31 20           0    1 
aae0: 20 20 20 20 20 20 32 20 20 20 20 20 20 33 20 20        2      3  
aaf0: 20 20 20 20 34 20 20 20 20 20 20 20 20 35 20 20      4        5  
ab00: 20 20 20 20 20 36 20 20 20 20 20 20 37 20 20 20       6      7   
ab10: 20 20 20 20 20 38 20 20 20 20 20 39 20 20 20 20       8     9    
ab20: 20 31 30 20 20 20 20 20 20 31 31 20 20 20 20 20   10      11     
ab30: 20 20 20 20 20 31 32 20 20 20 20 20 20 20 20 20       12         
ab40: 20 31 33 20 20 20 20 20 20 20 31 34 0a 09 20 20   13       14..  
ab50: 20 28 73 65 74 21 20 72 65 73 20 28 76 65 63 74   (set! res (vect
ab60: 6f 72 20 69 64 20 72 75 6e 2d 69 64 20 74 65 73  or id run-id tes
ab70: 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74  tname state stat
ab80: 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f  us event-time ho
ab90: 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66  st cpuload diskf
aba0: 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72  ree uname rundir
abb0: 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64   item-path run_d
abc0: 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f  uration final_lo
abd0: 67 66 20 63 6f 6d 6d 65 6e 74 29 29 29 0a 09 20  gf comment))).. 
abe0: 64 62 20 0a 09 20 22 53 45 4c 45 43 54 20 69 64  db .. "SELECT id
abf0: 2c 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65  ,run_id,testname
ac00: 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 76  ,state,status,ev
ac10: 65 6e 74 5f 74 69 6d 65 2c 68 6f 73 74 2c 63 70  ent_time,host,cp
ac20: 75 6c 6f 61 64 2c 64 69 73 6b 66 72 65 65 2c 75  uload,diskfree,u
ac30: 6e 61 6d 65 2c 72 75 6e 64 69 72 2c 69 74 65 6d  name,rundir,item
ac40: 5f 70 61 74 68 2c 72 75 6e 5f 64 75 72 61 74 69  _path,run_durati
ac50: 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 2c 63 6f  on,final_logf,co
ac60: 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74 73  mment FROM tests
ac70: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a 09 20   WHERE id=?;".. 
ac80: 74 65 73 74 2d 69 64 29 0a 09 72 65 73 29 29 29  test-id)..res)))
ac90: 0a 0a 3b 3b 20 55 73 65 20 64 62 3a 74 65 73 74  ..;; Use db:test
aca0: 2d 67 65 74 2a 20 74 6f 20 61 63 63 65 73 73 0a  -get* to access.
acb0: 3b 3b 0a 3b 3b 20 47 65 74 20 74 65 73 74 20 64  ;;.;; Get test d
acc0: 61 74 61 20 75 73 69 6e 67 20 74 65 73 74 5f 69  ata using test_i
acd0: 64 73 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67  ds.(define (db:g
ace0: 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d  et-test-info-by-
acf0: 69 64 73 20 64 62 20 74 65 73 74 2d 69 64 73 29  ids db test-ids)
ad00: 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 65  .  (if (null? te
ad10: 73 74 2d 69 64 73 29 0a 20 20 20 20 20 20 28 62  st-ids).      (b
ad20: 65 67 69 6e 0a 09 28 64 65 62 75 67 3a 70 72 69  egin..(debug:pri
ad30: 6e 74 2d 69 6e 66 6f 20 34 20 22 64 62 3a 67 65  nt-info 4 "db:ge
ad40: 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69  t-test-info-by-i
ad50: 64 73 20 63 61 6c 6c 65 64 20 77 69 74 68 20 74  ds called with t
ad60: 65 73 74 2d 69 64 73 3d 22 20 74 65 73 74 2d 69  est-ids=" test-i
ad70: 64 73 29 0a 09 27 28 29 29 0a 20 20 20 20 20 20  ds)..'()).      
ad80: 28 6c 65 74 20 28 28 72 65 73 20 27 28 29 29 29  (let ((res '()))
ad90: 0a 09 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65  ..(sqlite3:for-e
ada0: 61 63 68 2d 72 6f 77 0a 09 20 28 6c 61 6d 62 64  ach-row.. (lambd
adb0: 61 20 28 69 64 20 72 75 6e 2d 69 64 20 74 65 73  a (id run-id tes
adc0: 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74  tname state stat
add0: 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f  us event-time ho
ade0: 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66  st cpuload diskf
adf0: 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72  ree uname rundir
ae00: 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64   item-path run_d
ae10: 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f  uration final_lo
ae20: 67 66 20 63 6f 6d 6d 65 6e 74 29 0a 09 20 20 20  gf comment)..   
ae30: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ;;              
ae40: 20 20 20 30 20 20 20 20 31 20 20 20 20 20 20 20     0    1       
ae50: 32 20 20 20 20 20 20 33 20 20 20 20 20 20 34 20  2      3      4 
ae60: 20 20 20 20 20 20 20 35 20 20 20 20 20 20 20 36         5       6
ae70: 20 20 20 20 20 20 37 20 20 20 20 20 20 20 20 38        7        8
ae80: 20 20 20 20 20 39 20 20 20 20 20 31 30 20 20 20       9     10   
ae90: 20 20 20 31 31 20 20 20 20 20 20 20 20 20 20 31     11          1
aea0: 32 20 20 20 20 20 20 20 20 20 20 31 33 20 20 20  2          13   
aeb0: 20 20 20 20 31 34 0a 09 20 20 20 28 73 65 74 21      14..   (set!
aec0: 20 72 65 73 20 28 63 6f 6e 73 20 28 76 65 63 74   res (cons (vect
aed0: 6f 72 20 69 64 20 72 75 6e 2d 69 64 20 74 65 73  or id run-id tes
aee0: 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74  tname state stat
aef0: 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f  us event-time ho
af00: 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66  st cpuload diskf
af10: 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72  ree uname rundir
af20: 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64   item-path run_d
af30: 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f  uration final_lo
af40: 67 66 20 63 6f 6d 6d 65 6e 74 29 0a 09 09 09 20  gf comment).... 
af50: 20 20 72 65 73 29 29 29 0a 09 20 64 62 20 0a 09    res))).. db ..
af60: 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 69   (conc "SELECT i
af70: 64 2c 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d  d,run_id,testnam
af80: 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65  e,state,status,e
af90: 76 65 6e 74 5f 74 69 6d 65 2c 68 6f 73 74 2c 63  vent_time,host,c
afa0: 70 75 6c 6f 61 64 2c 64 69 73 6b 66 72 65 65 2c  puload,diskfree,
afb0: 75 6e 61 6d 65 2c 72 75 6e 64 69 72 2c 69 74 65  uname,rundir,ite
afc0: 6d 5f 70 61 74 68 2c 72 75 6e 5f 64 75 72 61 74  m_path,run_durat
afd0: 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 2c 63  ion,final_logf,c
afe0: 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74  omment FROM test
aff0: 73 20 57 48 45 52 45 20 69 64 20 69 6e 20 28 22  s WHERE id in ("
b000: 0a 09 20 20 20 20 20 20 20 28 73 74 72 69 6e 67  ..       (string
b010: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61  -intersperse (ma
b020: 70 20 63 6f 6e 63 20 74 65 73 74 2d 69 64 73 29  p conc test-ids)
b030: 20 22 2c 22 29 20 22 29 3b 22 29 29 0a 09 72 65   ",") ");"))..re
b040: 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64  s)))..(define (d
b050: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20  b:get-test-info 
b060: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61  db run-id testna
b070: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20  me item-path).  
b080: 28 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66  (db:get-test-inf
b090: 6f 2d 62 79 2d 69 64 20 64 62 20 28 64 62 3a 67  o-by-id db (db:g
b0a0: 65 74 2d 74 65 73 74 2d 69 64 20 64 62 20 72 75  et-test-id db ru
b0b0: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74  n-id testname it
b0c0: 65 6d 2d 70 61 74 68 29 29 29 0a 0a 28 64 65 66  em-path)))..(def
b0d0: 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 73 65 74  ine (db:test-set
b0e0: 2d 63 6f 6d 6d 65 6e 74 20 64 62 20 74 65 73 74  -comment db test
b0f0: 2d 69 64 20 63 6f 6d 6d 65 6e 74 29 0a 20 20 28  -id comment).  (
b100: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20  sqlite3:execute 
b110: 0a 20 20 20 64 62 20 0a 20 20 20 22 55 50 44 41  .   db .   "UPDA
b120: 54 45 20 74 65 73 74 73 20 53 45 54 20 63 6f 6d  TE tests SET com
b130: 6d 65 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 3d  ment=? WHERE id=
b140: 3f 3b 22 0a 20 20 20 63 6f 6d 6d 65 6e 74 20 74  ?;".   comment t
b150: 65 73 74 2d 69 64 29 29 0a 0a 28 64 65 66 69 6e  est-id))..(defin
b160: 65 20 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d  e (cdb:test-set-
b170: 72 75 6e 64 69 72 21 20 73 65 72 76 65 72 64 61  rundir! serverda
b180: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61  t run-id test-na
b190: 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e  me item-path run
b1a0: 64 69 72 29 0a 20 20 28 63 64 62 3a 63 6c 69 65  dir).  (cdb:clie
b1b0: 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61  nt-call serverda
b1c0: 74 20 27 74 65 73 74 2d 73 65 74 2d 72 75 6e 64  t 'test-set-rund
b1d0: 69 72 20 23 74 20 2a 64 65 66 61 75 6c 74 2d 6e  ir #t *default-n
b1e0: 75 6d 74 72 69 65 73 2a 20 72 75 6e 64 69 72 20  umtries* rundir 
b1f0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65  run-id test-name
b200: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a 28 64   item-path))..(d
b210: 65 66 69 6e 65 20 28 63 64 62 3a 74 65 73 74 2d  efine (cdb:test-
b220: 73 65 74 2d 72 75 6e 64 69 72 2d 62 79 2d 74 65  set-rundir-by-te
b230: 73 74 2d 69 64 20 73 65 72 76 65 72 64 61 74 20  st-id serverdat 
b240: 74 65 73 74 2d 69 64 20 72 75 6e 64 69 72 29 0a  test-id rundir).
b250: 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61    (cdb:client-ca
b260: 6c 6c 20 73 65 72 76 65 72 64 61 74 20 27 74 65  ll serverdat 'te
b270: 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 2d 62 79  st-set-rundir-by
b280: 2d 74 65 73 74 2d 69 64 20 23 74 20 2a 64 65 66  -test-id #t *def
b290: 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 72  ault-numtries* r
b2a0: 75 6e 64 69 72 20 74 65 73 74 2d 69 64 29 29 0a  undir test-id)).
b2b0: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73  .(define (db:tes
b2c0: 74 2d 67 65 74 2d 72 75 6e 64 69 72 2d 66 72 6f  t-get-rundir-fro
b2d0: 6d 2d 74 65 73 74 2d 69 64 20 64 62 20 74 65 73  m-test-id db tes
b2e0: 74 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 72  t-id).  (let ((r
b2f0: 65 73 20 23 66 29 29 20 3b 3b 20 28 68 61 73 68  es #f)) ;; (hash
b300: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75  -table-ref/defau
b310: 6c 74 20 2a 74 65 73 74 2d 70 61 74 68 73 2a 20  lt *test-paths* 
b320: 74 65 73 74 2d 69 64 20 23 66 29 29 29 0a 20 20  test-id #f))).  
b330: 20 20 3b 3b 20 28 69 66 20 72 65 73 0a 20 20 20    ;; (if res.   
b340: 20 3b 3b 20 20 20 20 20 72 65 73 0a 20 20 20 20   ;;     res.    
b350: 3b 3b 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20  ;;     (begin.  
b360: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65    (sqlite3:for-e
b370: 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61  ach-row.     (la
b380: 6d 62 64 61 20 28 74 70 61 74 68 29 0a 20 20 20  mbda (tpath).   
b390: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 74 70      (set! res tp
b3a0: 61 74 68 29 29 0a 20 20 20 20 20 64 62 20 0a 20  ath)).     db . 
b3b0: 20 20 20 20 22 53 45 4c 45 43 54 20 72 75 6e 64      "SELECT rund
b3c0: 69 72 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48  ir FROM tests WH
b3d0: 45 52 45 20 69 64 3d 3f 3b 22 0a 20 20 20 20 20  ERE id=?;".     
b3e0: 74 65 73 74 2d 69 64 29 0a 20 20 20 20 3b 3b 20  test-id).    ;; 
b3f0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21  (hash-table-set!
b400: 20 2a 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65   *test-paths* te
b410: 73 74 2d 69 64 20 72 65 73 29 0a 20 20 20 20 72  st-id res).    r
b420: 65 73 29 29 20 3b 3b 20 29 29 0a 0a 28 64 65 66  es)) ;; ))..(def
b430: 69 6e 65 20 28 63 64 62 3a 74 65 73 74 2d 73 65  ine (cdb:test-se
b440: 74 2d 6c 6f 67 21 20 73 65 72 76 65 72 64 61 74  t-log! serverdat
b450: 20 74 65 73 74 2d 69 64 20 6c 6f 67 66 29 0a 20   test-id logf). 
b460: 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 6c 6f   (if (string? lo
b470: 67 66 29 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63  gf)(cdb:client-c
b480: 61 6c 6c 20 73 65 72 76 65 72 64 61 74 20 27 74  all serverdat 't
b490: 65 73 74 2d 73 65 74 2d 6c 6f 67 20 23 66 20 2a  est-set-log #f *
b4a0: 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73  default-numtries
b4b0: 2a 20 6c 6f 67 66 20 74 65 73 74 2d 69 64 29 29  * logf test-id))
b4c0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  )..;;===========
b4d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
b4e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
b4f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
b500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d  ===========.;; M
b510: 69 73 63 2e 20 74 65 73 74 20 72 65 6c 61 74 65  isc. test relate
b520: 64 20 71 75 65 72 69 65 73 0a 3b 3b 3d 3d 3d 3d  d queries.;;====
b530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
b540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
b550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
b560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
b570: 3d 3d 0a 0a 3b 3b 20 4d 55 53 54 20 42 45 20 43  ==..;; MUST BE C
b580: 41 4c 4c 45 44 20 6c 6f 63 61 6c 21 0a 28 64 65  ALLED local!.(de
b590: 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 67 65  fine (db:test-ge
b5a0: 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67  t-paths-matching
b5b0: 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 72   db keynames tar
b5c0: 67 65 74 20 66 6e 61 6d 65 70 61 74 74 20 23 21  get fnamepatt #!
b5d0: 6b 65 79 20 28 72 65 73 20 27 28 29 29 29 0a 20  key (res '())). 
b5e0: 20 3b 3b 20 42 55 47 3a 20 4d 6f 76 65 20 74 68   ;; BUG: Move th
b5f0: 65 20 76 61 6c 75 65 73 20 64 65 72 69 76 65 64  e values derived
b600: 20 66 72 6f 6d 20 61 72 67 73 20 74 6f 20 70 61   from args to pa
b610: 72 61 6d 65 74 65 72 73 20 61 6e 64 20 70 75 73  rameters and pus
b620: 68 20 74 6f 20 6d 65 67 61 74 65 73 74 2e 73 63  h to megatest.sc
b630: 6d 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74  m.  (let* ((test
b640: 70 61 74 74 20 20 20 28 69 66 20 28 61 72 67 73  patt   (if (args
b650: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70  :get-arg "-testp
b660: 61 74 74 22 29 28 61 72 67 73 3a 67 65 74 2d 61  att")(args:get-a
b670: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 20  rg "-testpatt") 
b680: 22 25 22 29 29 0a 09 20 28 73 74 61 74 65 70 61  "%")).. (statepa
b690: 74 74 20 20 28 69 66 20 28 61 72 67 73 3a 67 65  tt  (if (args:ge
b6a0: 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 20  t-arg ":state") 
b6b0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20    (args:get-arg 
b6c0: 22 3a 73 74 61 74 65 22 29 20 20 20 20 22 25 22  ":state")    "%"
b6d0: 29 29 0a 09 20 28 73 74 61 74 75 73 70 61 74 74  )).. (statuspatt
b6e0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61   (if (args:get-a
b6f0: 72 67 20 22 3a 73 74 61 74 75 73 22 29 20 20 28  rg ":status")  (
b700: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73  args:get-arg ":s
b710: 74 61 74 75 73 22 29 20 20 20 22 25 22 29 29 0a  tatus")   "%")).
b720: 09 20 28 72 75 6e 6e 61 6d 65 20 20 20 20 28 69  . (runname    (i
b730: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20  f (args:get-arg 
b740: 22 3a 72 75 6e 6e 61 6d 65 22 29 20 28 61 72 67  ":runname") (arg
b750: 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e  s:get-arg ":runn
b760: 61 6d 65 22 29 20 20 22 25 22 29 29 0a 09 20 28  ame")  "%")).. (
b770: 70 61 74 68 73 2d 66 72 6f 6d 2d 64 62 20 28 63  paths-from-db (c
b780: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62  db:remote-run db
b790: 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d  :test-get-paths-
b7a0: 6d 61 74 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65  matching-keyname
b7b0: 73 2d 74 61 72 67 65 74 20 64 62 20 6b 65 79 6e  s-target db keyn
b7c0: 61 6d 65 73 20 74 61 72 67 65 74 20 72 65 73 0a  ames target res.
b7d0: 09 09 09 09 09 74 65 73 74 70 61 74 74 3a 20 20  .....testpatt:  
b7e0: 20 74 65 73 74 70 61 74 74 0a 09 09 09 09 09 73   testpatt......s
b7f0: 74 61 74 65 70 61 74 74 3a 20 20 73 74 61 74 65  tatepatt:  state
b800: 70 61 74 74 0a 09 09 09 09 09 73 74 61 74 75 73  patt......status
b810: 70 61 74 74 3a 20 73 74 61 74 75 73 70 61 74 74  patt: statuspatt
b820: 0a 09 09 09 09 09 72 75 6e 6e 61 6d 65 3a 20 20  ......runname:  
b830: 20 20 72 75 6e 6e 61 6d 65 29 29 29 0a 20 20 20    runname))).   
b840: 20 28 69 66 20 66 6e 61 6d 65 70 61 74 74 0a 09   (if fnamepatt..
b850: 28 61 70 70 6c 79 20 61 70 70 65 6e 64 20 0a 09  (apply append ..
b860: 20 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d         (map (lam
b870: 62 64 61 20 28 70 29 0a 09 09 20 20 20 20 20 20  bda (p)...      
b880: 28 69 66 20 28 64 69 72 65 63 74 6f 72 79 2d 65  (if (directory-e
b890: 78 69 73 74 73 3f 20 70 29 0a 09 09 09 20 20 28  xists? p)....  (
b8a0: 67 6c 6f 62 20 28 63 6f 6e 63 20 70 20 22 2f 22  glob (conc p "/"
b8b0: 20 66 6e 61 6d 65 70 61 74 74 29 29 0a 09 09 09   fnamepatt))....
b8c0: 20 20 27 28 29 29 29 0a 09 09 20 20 20 20 70 61    '()))...    pa
b8d0: 74 68 73 2d 66 72 6f 6d 2d 64 62 29 29 0a 09 70  ths-from-db))..p
b8e0: 61 74 68 73 2d 66 72 6f 6d 2d 64 62 29 29 29 0a  aths-from-db))).
b8f0: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73  .(define (db:tes
b900: 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63  t-get-paths-matc
b910: 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 61  hing-keynames-ta
b920: 72 67 65 74 20 64 62 20 6b 65 79 6e 61 6d 65 73  rget db keynames
b930: 20 74 61 72 67 65 74 20 72 65 73 20 0a 09 09 09   target res ....
b940: 09 09 09 20 20 20 20 23 21 6b 65 79 0a 09 09 09  ...    #!key....
b950: 09 09 09 20 20 20 20 28 74 65 73 74 70 61 74 74  ...    (testpatt
b960: 20 20 20 22 25 22 29 0a 09 09 09 09 09 09 20 20     "%").......  
b970: 20 20 28 73 74 61 74 65 70 61 74 74 20 20 22 25    (statepatt  "%
b980: 22 29 0a 09 09 09 09 09 09 20 20 20 20 28 73 74  ").......    (st
b990: 61 74 75 73 70 61 74 74 20 22 25 22 29 0a 09 09  atuspatt "%")...
b9a0: 09 09 09 09 20 20 20 20 28 72 75 6e 6e 61 6d 65  ....    (runname
b9b0: 20 20 20 20 22 25 22 29 29 0a 20 20 28 6c 65 74      "%")).  (let
b9c0: 2a 20 28 28 6b 65 79 73 74 72 20 28 73 74 72 69  * ((keystr (stri
b9d0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a  ng-intersperse .
b9e0: 09 09 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61  ..  (map (lambda
b9f0: 20 28 6b 65 79 20 76 61 6c 29 0a 09 09 09 20 28   (key val).... (
ba00: 63 6f 6e 63 20 22 72 2e 22 20 6b 65 79 20 22 20  conc "r." key " 
ba10: 6c 69 6b 65 20 27 22 20 76 61 6c 20 22 27 22 29  like '" val "'")
ba20: 29 0a 09 09 20 20 20 20 20 20 20 6b 65 79 6e 61  )...       keyna
ba30: 6d 65 73 20 0a 09 09 20 20 20 20 20 20 20 28 73  mes ...       (s
ba40: 74 72 69 6e 67 2d 73 70 6c 69 74 20 74 61 72 67  tring-split targ
ba50: 65 74 20 22 2f 22 29 29 0a 09 09 20 20 22 20 41  et "/"))...  " A
ba60: 4e 44 20 22 29 29 0a 09 20 28 74 65 73 74 71 72  ND ")).. (testqr
ba70: 79 20 28 74 65 73 74 73 3a 6d 61 74 63 68 2d 3e  y (tests:match->
ba80: 73 71 6c 71 72 79 20 74 65 73 74 70 61 74 74 29  sqlqry testpatt)
ba90: 29 0a 09 20 28 71 72 79 73 74 72 20 28 63 6f 6e  ).. (qrystr (con
baa0: 63 20 22 53 45 4c 45 43 54 20 74 2e 72 75 6e 64  c "SELECT t.rund
bab0: 69 72 20 46 52 4f 4d 20 74 65 73 74 73 20 41 53  ir FROM tests AS
bac0: 20 74 20 49 4e 4e 45 52 20 4a 4f 49 4e 20 72 75   t INNER JOIN ru
bad0: 6e 73 20 41 53 20 72 20 4f 4e 20 74 2e 72 75 6e  ns AS r ON t.run
bae0: 5f 69 64 3d 72 2e 69 64 20 57 48 45 52 45 20 22  _id=r.id WHERE "
baf0: 0a 09 09 20 20 20 20 20 20 20 6b 65 79 73 74 72  ...       keystr
bb00: 20 22 20 41 4e 44 20 72 2e 72 75 6e 6e 61 6d 65   " AND r.runname
bb10: 20 4c 49 4b 45 20 27 22 20 72 75 6e 6e 61 6d 65   LIKE '" runname
bb20: 20 22 27 20 41 4e 44 20 22 20 74 65 73 74 71 72   "' AND " testqr
bb30: 79 0a 09 09 20 20 20 20 20 20 20 22 20 41 4e 44  y...       " AND
bb40: 20 74 2e 73 74 61 74 65 20 4c 49 4b 45 20 27 22   t.state LIKE '"
bb50: 20 73 74 61 74 65 70 61 74 74 20 22 27 20 41 4e   statepatt "' AN
bb60: 44 20 74 2e 73 74 61 74 75 73 20 4c 49 4b 45 20  D t.status LIKE 
bb70: 27 22 20 73 74 61 74 75 73 70 61 74 74 20 0a 09  '" statuspatt ..
bb80: 09 20 20 20 20 20 20 20 22 27 20 4f 52 44 45 52  .       "' ORDER
bb90: 20 42 59 20 74 2e 65 76 65 6e 74 5f 74 69 6d 65   BY t.event_time
bba0: 20 41 53 43 3b 22 29 29 29 0a 20 20 20 20 28 64   ASC;"))).    (d
bbb0: 65 62 75 67 3a 70 72 69 6e 74 20 33 20 22 71 72  ebug:print 3 "qr
bbc0: 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 29 0a  ystr: " qrystr).
bbd0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72      (sqlite3:for
bbe0: 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20  -each-row .     
bbf0: 28 6c 61 6d 62 64 61 20 28 70 29 0a 20 20 20 20  (lambda (p).    
bc00: 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f     (set! res (co
bc10: 6e 73 20 70 20 72 65 73 29 29 29 0a 20 20 20 20  ns p res))).    
bc20: 20 64 62 20 0a 20 20 20 20 20 71 72 79 73 74 72   db .     qrystr
bc30: 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20  ).    res))..;; 
bc40: 6c 6f 6f 6b 20 74 68 72 6f 75 67 68 20 74 65 73  look through tes
bc50: 74 73 20 66 72 6f 6d 20 6d 61 74 63 68 69 6e 67  ts from matching
bc60: 20 72 75 6e 73 20 66 6f 72 20 61 20 66 69 6c 65   runs for a file
bc70: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73  .(define (db:tes
bc80: 74 2d 67 65 74 2d 66 69 72 73 74 2d 70 61 74 68  t-get-first-path
bc90: 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79  -matching db key
bca0: 6e 61 6d 65 73 20 74 61 72 67 65 74 20 66 6e 61  names target fna
bcb0: 6d 65 29 0a 20 20 3b 3b 20 5b 72 65 66 70 61 74  me).  ;; [refpat
bcc0: 68 73 5d 20 69 73 20 74 68 65 20 73 65 63 74 69  hs] is the secti
bcd0: 6f 6e 20 77 68 65 72 65 20 72 65 66 65 72 65 6e  on where referen
bce0: 63 65 73 20 74 6f 20 6f 74 68 65 72 20 6d 65 67  ces to other meg
bcf0: 61 74 65 73 74 20 64 61 74 61 62 61 73 65 73 20  atest databases 
bd00: 61 72 65 20 73 74 6f 72 65 64 0a 20 20 28 6c 65  are stored.  (le
bd10: 74 20 28 28 6d 74 2d 70 61 74 68 73 20 28 63 6f  t ((mt-paths (co
bd20: 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 74 69 6f  nfigf:get-sectio
bd30: 6e 20 22 72 65 66 70 61 74 68 73 22 29 29 0a 09  n "refpaths"))..
bd40: 28 72 65 73 20 20 20 20 20 20 20 28 64 62 3a 74  (res       (db:t
bd50: 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61  est-get-paths-ma
bd60: 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d  tching db keynam
bd70: 65 73 20 74 61 72 67 65 74 20 66 6e 61 6d 65 29  es target fname)
bd80: 29 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70  )).    (let loop
bd90: 20 28 28 70 61 74 68 64 61 74 20 28 69 66 20 28   ((pathdat (if (
bda0: 6e 75 6c 6c 3f 20 70 61 74 68 73 29 20 23 66 20  null? paths) #f 
bdb0: 28 63 61 72 20 6d 74 2d 70 61 74 68 73 29 29 29  (car mt-paths)))
bdc0: 0a 09 20 20 20 20 20 20 20 28 74 61 6c 20 20 20  ..       (tal   
bdd0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 70 61 74    (if (null? pat
bde0: 68 73 29 20 27 28 29 28 63 64 72 20 6d 74 2d 70  hs) '()(cdr mt-p
bdf0: 61 74 68 73 29 29 29 29 0a 20 20 20 20 20 20 28  aths)))).      (
be00: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72  if (not (null? r
be10: 65 73 29 29 0a 09 20 20 28 63 61 72 20 72 65 73  es))..  (car res
be20: 29 20 3b 3b 20 72 65 74 75 72 6e 20 66 69 72 73  ) ;; return firs
be30: 74 20 66 6f 75 6e 64 0a 09 20 20 28 69 66 20 70  t found..  (if p
be40: 61 74 68 0a 09 20 20 20 20 20 20 28 6c 65 74 2a  ath..      (let*
be50: 20 28 28 64 62 20 20 20 20 20 28 6f 70 65 6e 2d   ((db     (open-
be60: 64 62 20 70 61 74 68 3a 20 28 63 61 64 72 20 70  db path: (cadr p
be70: 61 74 68 64 61 74 29 29 29 0a 09 09 20 20 20 20  athdat)))...    
be80: 20 28 6e 65 77 72 65 73 20 28 64 62 3a 74 65 73   (newres (db:tes
be90: 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63  t-get-paths-matc
bea0: 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 73  hing db keynames
beb0: 20 74 61 72 67 65 74 20 66 6e 61 6d 65 29 29 29   target fname)))
bec0: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d  ...(debug:print-
bed0: 69 6e 66 6f 20 34 20 22 54 72 79 69 6e 67 20 22  info 4 "Trying "
bee0: 20 28 63 61 72 20 70 61 74 68 64 61 74 29 20 22   (car pathdat) "
bef0: 20 61 74 20 22 20 28 63 61 64 72 20 70 61 74 68   at " (cadr path
bf00: 64 61 74 29 29 0a 09 09 28 73 71 6c 69 74 65 33  dat))...(sqlite3
bf10: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09  :finalize! db)..
bf20: 09 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f  .(if (not (null?
bf30: 20 6e 65 77 72 65 73 29 29 0a 09 09 20 20 20 20   newres))...    
bf40: 28 63 61 72 20 6e 65 77 72 65 73 29 0a 09 09 20  (car newres)... 
bf50: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61     (if (null? ta
bf60: 6c 29 0a 09 09 09 23 66 0a 09 09 09 28 6c 6f 6f  l)....#f....(loo
bf70: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20  p (car tal)(cdr 
bf80: 74 61 6c 29 29 29 29 29 29 29 29 29 29 0a 0a 3b  tal))))))))))..;
bf90: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ;===============
bfa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
bfb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
bfc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
bfd0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 55 45 55 45  =======.;; QUEUE
bfe0: 20 55 50 20 4d 45 54 41 2c 20 54 45 53 54 20 53   UP META, TEST S
bff0: 54 41 54 55 53 20 41 4e 44 20 53 54 45 50 53 20  TATUS AND STEPS 
c000: 52 45 4d 4f 54 45 20 41 43 43 45 53 53 0a 3b 3b  REMOTE ACCESS.;;
c010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
c020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
c030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
c040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
c050: 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f 54 45 3a  ======..;; NOTE:
c060: 20 43 61 6e 20 72 65 6d 6f 76 65 20 74 68 65 20   Can remove the 
c070: 72 65 67 65 78 20 61 6e 64 20 62 61 73 65 36 34  regex and base64
c080: 20 65 6e 63 6f 64 69 6e 67 20 66 6f 72 20 7a 6d   encoding for zm
c090: 71 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 6f 62  q.(define (db:ob
c0a0: 6a 2d 3e 73 74 72 69 6e 67 20 6f 62 6a 29 0a 20  j->string obj). 
c0b0: 20 28 63 61 73 65 20 2a 74 72 61 6e 73 70 6f 72   (case *transpor
c0c0: 74 2d 74 79 70 65 2a 0a 20 20 20 20 28 28 66 73  t-type*.    ((fs
c0d0: 29 20 6f 62 6a 29 0a 09 28 28 68 74 74 70 29 0a  ) obj)..((http).
c0e0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 75 62       (string-sub
c0f0: 73 74 69 74 75 74 65 0a 20 20 20 20 20 20 20 28  stitute.       (
c100: 72 65 67 65 78 70 20 22 3d 22 29 20 22 5f 22 0a  regexp "=") "_".
c110: 20 20 20 20 20 20 20 20 20 28 62 61 73 65 36 34           (base64
c120: 3a 62 61 73 65 36 34 2d 65 6e 63 6f 64 65 20 28  :base64-encode (
c130: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73  with-output-to-s
c140: 74 72 69 6e 67 20 28 6c 61 6d 62 64 61 20 28 29  tring (lambda ()
c150: 28 73 65 72 69 61 6c 69 7a 65 20 6f 62 6a 29 29  (serialize obj))
c160: 29 29 0a 20 20 20 20 20 20 20 20 23 74 29 29 0a  )).        #t)).
c170: 20 20 20 20 28 28 7a 6d 71 29 28 77 69 74 68 2d      ((zmq)(with-
c180: 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67  output-to-string
c190: 20 28 6c 61 6d 62 64 61 20 28 29 28 73 65 72 69   (lambda ()(seri
c1a0: 61 6c 69 7a 65 20 6f 62 6a 29 29 29 29 0a 20 20  alize obj)))).  
c1b0: 20 20 28 65 6c 73 65 20 6f 62 6a 29 29 29 0a 0a    (else obj)))..
c1c0: 28 64 65 66 69 6e 65 20 28 64 62 3a 73 74 72 69  (define (db:stri
c1d0: 6e 67 2d 3e 6f 62 6a 20 6d 73 67 29 0a 20 20 28  ng->obj msg).  (
c1e0: 63 61 73 65 20 2a 74 72 61 6e 73 70 6f 72 74 2d  case *transport-
c1f0: 74 79 70 65 2a 0a 20 20 20 28 28 66 73 29 20 6d  type*.   ((fs) m
c200: 73 67 29 0a 20 20 20 28 28 68 74 74 70 29 0a 20  sg).   ((http). 
c210: 20 20 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66     (with-input-f
c220: 72 6f 6d 2d 73 74 72 69 6e 67 20 0a 20 20 20 20  rom-string .    
c230: 20 20 20 28 62 61 73 65 36 34 3a 62 61 73 65 36     (base64:base6
c240: 34 2d 64 65 63 6f 64 65 0a 20 20 20 20 20 20 20  4-decode.       
c250: 20 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69    (string-substi
c260: 74 75 74 65 20 0a 09 20 20 20 28 72 65 67 65 78  tute ..   (regex
c270: 70 20 22 5f 22 29 20 22 3d 22 20 6d 73 67 20 23  p "_") "=" msg #
c280: 74 29 29 0a 20 20 20 20 20 20 20 28 6c 61 6d 62  t)).       (lamb
c290: 64 61 20 28 29 28 64 65 73 65 72 69 61 6c 69 7a  da ()(deserializ
c2a0: 65 29 29 29 29 0a 20 20 20 28 28 7a 6d 71 29 28  e)))).   ((zmq)(
c2b0: 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d  with-input-from-
c2c0: 73 74 72 69 6e 67 20 6d 73 67 20 28 6c 61 6d 62  string msg (lamb
c2d0: 64 61 20 28 29 28 64 65 73 65 72 69 61 6c 69 7a  da ()(deserializ
c2e0: 65 29 29 29 29 0a 20 20 20 28 65 6c 73 65 20 6d  e)))).   (else m
c2f0: 73 67 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28  sg)))..(define (
c300: 63 64 62 3a 75 73 65 2d 6e 6f 6e 2d 62 6c 6f 63  cdb:use-non-bloc
c310: 6b 69 6e 67 2d 6d 6f 64 65 20 70 72 6f 63 29 0a  king-mode proc).
c320: 20 20 28 73 65 74 21 20 2a 63 6c 69 65 6e 74 2d    (set! *client-
c330: 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 2d 6d 6f 64  non-blocking-mod
c340: 65 2a 20 23 74 29 0a 20 20 28 6c 65 74 20 28 28  e* #t).  (let ((
c350: 72 65 73 20 28 70 72 6f 63 29 29 29 0a 20 20 20  res (proc))).   
c360: 20 28 73 65 74 21 20 2a 63 6c 69 65 6e 74 2d 6e   (set! *client-n
c370: 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 2d 6d 6f 64 65  on-blocking-mode
c380: 2a 20 23 66 29 0a 20 20 20 20 72 65 73 29 29 0a  * #f).    res)).
c390: 20 20 0a 3b 3b 20 70 61 72 61 6d 73 20 3d 20 27    .;; params = '
c3a0: 74 61 72 67 65 74 20 63 61 63 68 65 64 20 72 65  target cached re
c3b0: 6d 70 61 72 61 6d 73 0a 3b 3b 0a 3b 3b 20 6d 61  mparams.;;.;; ma
c3c0: 6b 65 2d 76 65 63 74 6f 72 2d 72 65 63 6f 72 64  ke-vector-record
c3d0: 20 63 64 62 20 70 61 63 6b 65 74 20 63 6c 69 65   cdb packet clie
c3e0: 6e 74 2d 73 69 67 20 71 74 79 70 65 20 69 6d 6d  nt-sig qtype imm
c3f0: 65 64 69 61 74 65 20 71 75 65 72 79 2d 73 69 67  ediate query-sig
c400: 20 70 61 72 61 6d 73 20 71 74 69 6d 65 0a 3b 3b   params qtime.;;
c410: 0a 3b 3b 20 63 64 62 3a 63 6c 69 65 6e 74 2d 63  .;; cdb:client-c
c420: 61 6c 6c 20 69 73 20 74 68 65 20 75 6e 69 66 69  all is the unifi
c430: 65 64 20 69 6e 74 65 72 66 61 63 65 20 74 6f 20  ed interface to 
c440: 61 6c 6c 20 74 68 65 20 74 72 61 6e 73 70 6f 72  all the transpor
c450: 74 73 2e 20 49 74 20 64 69 73 70 61 74 63 68 65  ts. It dispatche
c460: 73 20 74 68 65 0a 3b 3b 20 20 20 20 20 20 20 20  s the.;;        
c470: 20 20 20 20 20 20 20 20 20 71 75 65 72 79 20 74           query t
c480: 6f 20 61 20 73 65 72 76 65 72 20 72 6f 75 74 69  o a server routi
c490: 6e 65 20 28 65 2e 67 2e 20 73 65 72 76 65 72 3a  ne (e.g. server:
c4a0: 63 6c 69 65 6e 74 2d 73 65 6e 64 2d 72 65 63 69  client-send-reci
c4b0: 65 76 65 29 20 74 68 61 74 20 0a 3b 3b 20 20 20  eve) that .;;   
c4c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 72                tr
c4d0: 61 6e 73 70 6f 72 74 73 20 74 68 65 20 64 61 74  ansports the dat
c4e0: 61 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 20  a to the server 
c4f0: 77 68 65 72 65 20 69 74 20 69 73 20 70 61 73 73  where it is pass
c500: 65 64 20 74 6f 20 64 62 3a 70 72 6f 63 65 73 73  ed to db:process
c510: 2d 71 75 65 75 65 2d 69 74 65 6d 0a 3b 3b 20 20  -queue-item.;;  
c520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 77                 w
c530: 68 69 63 68 20 65 69 74 68 65 72 20 72 65 74 75  hich either retu
c540: 72 6e 73 20 74 68 65 20 64 61 74 61 20 74 6f 20  rns the data to 
c550: 74 68 65 20 63 61 6c 6c 69 6e 67 20 73 65 72 76  the calling serv
c560: 65 72 20 72 6f 75 74 69 6e 65 20 6f 72 20 0a 3b  er routine or .;
c570: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ;               
c580: 20 20 64 69 72 65 63 74 6c 79 20 63 61 6c 6c 73    directly calls
c590: 20 74 68 65 20 72 65 74 75 72 6e 69 6e 67 20 70   the returning p
c5a0: 72 6f 63 65 64 75 72 65 20 28 65 2e 67 2e 20 7a  rocedure (e.g. z
c5b0: 6d 71 29 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20  mq)..;;.(define 
c5c0: 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c  (cdb:client-call
c5d0: 20 73 65 72 76 65 72 64 61 74 20 71 74 79 70 65   serverdat qtype
c5e0: 20 69 6d 6d 65 64 69 61 74 65 20 6e 75 6d 72 65   immediate numre
c5f0: 74 72 69 65 73 20 2e 20 70 61 72 61 6d 73 29 0a  tries . params).
c600: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69    (debug:print-i
c610: 6e 66 6f 20 31 31 20 22 63 64 62 3a 63 6c 69 65  nfo 11 "cdb:clie
c620: 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61  nt-call serverda
c630: 74 3d 22 20 73 65 72 76 65 72 64 61 74 20 22 2c  t=" serverdat ",
c640: 20 71 74 79 70 65 3d 22 20 71 74 79 70 65 20 22   qtype=" qtype "
c650: 2c 20 69 6d 6d 65 64 69 61 74 65 3d 22 20 69 6d  , immediate=" im
c660: 6d 65 64 69 61 74 65 20 22 2c 20 6e 75 6d 72 65  mediate ", numre
c670: 74 72 69 65 73 3d 22 20 6e 75 6d 72 65 74 72 69  tries=" numretri
c680: 65 73 20 22 2c 20 70 61 72 61 6d 73 3d 22 20 70  es ", params=" p
c690: 61 72 61 6d 73 29 0a 20 20 28 63 61 73 65 20 2a  arams).  (case *
c6a0: 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 2a 20  transport-type* 
c6b0: 0a 20 20 20 20 28 28 66 73 29 0a 20 20 20 20 20  .    ((fs).     
c6c0: 28 6c 65 74 20 28 28 70 61 63 6b 65 74 20 28 76  (let ((packet (v
c6d0: 65 63 74 6f 72 20 22 6e 61 22 20 71 74 79 70 65  ector "na" qtype
c6e0: 20 69 6d 6d 65 64 69 61 74 65 20 22 6e 61 22 20   immediate "na" 
c6f0: 70 61 72 61 6d 73 20 30 29 29 29 0a 20 20 20 20  params 0))).    
c700: 20 20 20 28 66 73 3a 70 72 6f 63 65 73 73 2d 71     (fs:process-q
c710: 75 65 75 65 2d 69 74 65 6d 20 70 61 63 6b 65 74  ueue-item packet
c720: 29 29 29 0a 20 20 20 20 28 28 68 74 74 70 29 0a  ))).    ((http).
c730: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6c 69       (let* ((cli
c740: 65 6e 74 2d 73 69 67 20 20 28 63 6c 69 65 6e 74  ent-sig  (client
c750: 3a 67 65 74 2d 73 69 67 6e 61 74 75 72 65 29 29  :get-signature))
c760: 0a 09 20 20 20 20 28 71 75 65 72 79 2d 73 69 67  ..    (query-sig
c770: 20 20 20 28 6d 65 73 73 61 67 65 2d 64 69 67 65     (message-dige
c780: 73 74 2d 73 74 72 69 6e 67 20 28 6d 64 35 2d 70  st-string (md5-p
c790: 72 69 6d 69 74 69 76 65 29 20 28 63 6f 6e 63 20  rimitive) (conc 
c7a0: 71 74 79 70 65 20 69 6d 6d 65 64 69 61 74 65 20  qtype immediate 
c7b0: 70 61 72 61 6d 73 29 29 29 0a 09 20 20 20 20 28  params)))..    (
c7c0: 7a 64 61 74 20 20 20 20 20 20 20 20 28 64 62 3a  zdat        (db:
c7d0: 6f 62 6a 2d 3e 73 74 72 69 6e 67 20 28 76 65 63  obj->string (vec
c7e0: 74 6f 72 20 63 6c 69 65 6e 74 2d 73 69 67 20 71  tor client-sig q
c7f0: 74 79 70 65 20 69 6d 6d 65 64 69 61 74 65 20 71  type immediate q
c800: 75 65 72 79 2d 73 69 67 20 70 61 72 61 6d 73 20  uery-sig params 
c810: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73  (current-seconds
c820: 29 29 29 29 29 20 3b 3b 20 28 77 69 74 68 2d 6f  ))))) ;; (with-o
c830: 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 20  utput-to-string 
c840: 28 6c 61 6d 62 64 61 20 28 29 28 73 65 72 69 61  (lambda ()(seria
c850: 6c 69 7a 65 20 70 61 72 61 6d 73 29 29 29 29 0a  lize params)))).
c860: 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72         (debug:pr
c870: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 7a 64 61  int-info 11 "zda
c880: 74 3d 22 20 7a 64 61 74 29 0a 20 20 20 20 20 20  t=" zdat).      
c890: 20 28 6c 65 74 2a 20 28 28 72 65 73 20 20 23 66   (let* ((res  #f
c8a0: 29 0a 09 20 20 20 20 20 20 28 72 61 77 64 61 74  )..      (rawdat
c8b0: 20 20 20 20 20 20 28 68 74 74 70 2d 74 72 61 6e        (http-tran
c8c0: 73 70 6f 72 74 3a 63 6c 69 65 6e 74 2d 73 65 6e  sport:client-sen
c8d0: 64 2d 72 65 63 65 69 76 65 20 73 65 72 76 65 72  d-receive server
c8e0: 64 61 74 20 7a 64 61 74 29 29 0a 09 20 20 20 20  dat zdat))..    
c8f0: 20 20 28 74 6d 70 20 20 20 20 20 20 20 20 20 23    (tmp         #
c900: 66 29 29 0a 09 20 28 64 65 62 75 67 3a 70 72 69  f)).. (debug:pri
c910: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 53 65 6e 74  nt-info 11 "Sent
c920: 20 22 20 7a 64 61 74 20 22 2c 20 72 65 63 65 69   " zdat ", recei
c930: 76 65 64 20 22 20 72 61 77 64 61 74 29 0a 09 20  ved " rawdat).. 
c940: 28 73 65 74 21 20 74 6d 70 20 28 64 62 3a 73 74  (set! tmp (db:st
c950: 72 69 6e 67 2d 3e 6f 62 6a 20 72 61 77 64 61 74  ring->obj rawdat
c960: 29 29 0a 09 20 28 76 65 63 74 6f 72 2d 72 65 66  )).. (vector-ref
c970: 20 74 6d 70 20 32 29 29 29 29 0a 20 20 20 20 28   tmp 2)))).    (
c980: 28 7a 6d 71 29 0a 20 20 20 20 20 28 68 61 6e 64  (zmq).     (hand
c990: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20  le-exceptions.  
c9a0: 20 20 20 20 65 78 6e 0a 20 20 20 20 20 20 28 62      exn.      (b
c9b0: 65 67 69 6e 0a 09 28 74 68 72 65 61 64 2d 73 6c  egin..(thread-sl
c9c0: 65 65 70 21 20 35 29 20 0a 09 28 69 66 20 28 3e  eep! 5) ..(if (>
c9d0: 20 6e 75 6d 72 65 74 72 69 65 73 20 30 29 28 61   numretries 0)(a
c9e0: 70 70 6c 79 20 63 64 62 3a 63 6c 69 65 6e 74 2d  pply cdb:client-
c9f0: 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 20 71  call serverdat q
ca00: 74 79 70 65 20 69 6d 6d 65 64 69 61 74 65 20 28  type immediate (
ca10: 2d 20 6e 75 6d 72 65 74 72 69 65 73 20 31 29 20  - numretries 1) 
ca20: 70 61 72 61 6d 73 29 29 29 0a 20 20 20 20 20 20  params))).      
ca30: 28 6c 65 74 2a 20 28 28 70 75 73 68 2d 73 6f 63  (let* ((push-soc
ca40: 6b 65 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20  ket (vector-ref 
ca50: 73 65 72 76 65 72 64 61 74 20 30 29 29 0a 09 20  serverdat 0)).. 
ca60: 20 20 20 20 28 73 75 62 2d 73 6f 63 6b 65 74 20      (sub-socket 
ca70: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72   (vector-ref ser
ca80: 76 65 72 64 61 74 20 31 29 29 0a 09 20 20 20 20  verdat 1))..    
ca90: 20 28 63 6c 69 65 6e 74 2d 73 69 67 20 20 28 63   (client-sig  (c
caa0: 6c 69 65 6e 74 3a 67 65 74 2d 73 69 67 6e 61 74  lient:get-signat
cab0: 75 72 65 29 29 0a 09 20 20 20 20 20 28 71 75 65  ure))..     (que
cac0: 72 79 2d 73 69 67 20 20 20 28 6d 65 73 73 61 67  ry-sig   (messag
cad0: 65 2d 64 69 67 65 73 74 2d 73 74 72 69 6e 67 20  e-digest-string 
cae0: 28 6d 64 35 2d 70 72 69 6d 69 74 69 76 65 29 20  (md5-primitive) 
caf0: 28 63 6f 6e 63 20 71 74 79 70 65 20 69 6d 6d 65  (conc qtype imme
cb00: 64 69 61 74 65 20 70 61 72 61 6d 73 29 29 29 0a  diate params))).
cb10: 09 20 20 20 20 20 28 7a 64 61 74 20 20 20 20 20  .     (zdat     
cb20: 20 20 20 28 64 62 3a 6f 62 6a 2d 3e 73 74 72 69     (db:obj->stri
cb30: 6e 67 20 28 76 65 63 74 6f 72 20 63 6c 69 65 6e  ng (vector clien
cb40: 74 2d 73 69 67 20 71 74 79 70 65 20 69 6d 6d 65  t-sig qtype imme
cb50: 64 69 61 74 65 20 71 75 65 72 79 2d 73 69 67 20  diate query-sig 
cb60: 70 61 72 61 6d 73 20 28 63 75 72 72 65 6e 74 2d  params (current-
cb70: 73 65 63 6f 6e 64 73 29 29 29 29 20 3b 3b 20 28  seconds)))) ;; (
cb80: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73  with-output-to-s
cb90: 74 72 69 6e 67 20 28 6c 61 6d 62 64 61 20 28 29  tring (lambda ()
cba0: 28 73 65 72 69 61 6c 69 7a 65 20 70 61 72 61 6d  (serialize param
cbb0: 73 29 29 29 29 0a 09 20 20 20 20 20 28 72 65 73  s))))..     (res
cbc0: 20 20 23 66 29 0a 09 20 20 20 20 20 28 73 65 6e    #f)..     (sen
cbd0: 64 2d 72 65 63 65 69 76 65 20 28 6c 61 6d 62 64  d-receive (lambd
cbe0: 61 20 28 29 0a 09 09 09 20 20 20 20 20 28 64 65  a ()....     (de
cbf0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31  bug:print-info 1
cc00: 31 20 22 73 65 6e 64 69 6e 67 20 6d 65 73 73 61  1 "sending messa
cc10: 67 65 22 29 0a 09 09 09 20 20 20 20 20 28 73 65  ge")....     (se
cc20: 6e 64 2d 6d 65 73 73 61 67 65 20 70 75 73 68 2d  nd-message push-
cc30: 73 6f 63 6b 65 74 20 7a 64 61 74 29 0a 09 09 09  socket zdat)....
cc40: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e       (debug:prin
cc50: 74 2d 69 6e 66 6f 20 31 31 20 22 6d 65 73 73 61  t-info 11 "messa
cc60: 67 65 20 73 65 6e 74 22 29 0a 09 09 09 20 20 20  ge sent")....   
cc70: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 29 0a 09    (let loop ()..
cc80: 09 09 20 20 20 20 20 20 20 3b 3b 20 67 65 74 20  ..       ;; get 
cc90: 74 68 65 20 73 65 6e 64 65 72 20 69 6e 66 6f 0a  the sender info.
cca0: 09 09 09 20 20 20 20 20 20 20 3b 3b 20 74 68 69  ...       ;; thi
ccb0: 73 20 73 68 6f 75 6c 64 20 6d 61 74 63 68 20 28  s should match (
ccc0: 63 6c 69 65 6e 74 3a 67 65 74 2d 73 69 67 6e 61  client:get-signa
ccd0: 74 75 72 65 29 0a 09 09 09 20 20 20 20 20 20 20  ture)....       
cce0: 3b 3b 20 77 65 20 77 69 6c 6c 20 6e 65 65 64 20  ;; we will need 
ccf0: 74 6f 20 70 72 6f 63 65 73 73 20 22 61 6c 6c 22  to process "all"
cd00: 20 6d 65 73 73 61 67 65 73 20 68 65 72 65 20 73   messages here s
cd10: 6f 6d 65 20 64 61 79 0a 09 09 09 20 20 20 20 20  ome day....     
cd20: 20 20 28 72 65 63 65 69 76 65 2d 6d 65 73 73 61    (receive-messa
cd30: 67 65 2a 20 73 75 62 2d 73 6f 63 6b 65 74 29 0a  ge* sub-socket).
cd40: 09 09 09 20 20 20 20 20 20 20 3b 3b 20 6e 6f 77  ...       ;; now
cd50: 20 67 65 74 20 74 68 65 20 61 63 74 75 61 6c 20   get the actual 
cd60: 6d 65 73 73 61 67 65 0a 09 09 09 20 20 20 20 20  message....     
cd70: 20 20 28 6c 65 74 20 28 28 6d 79 72 65 73 20 28    (let ((myres (
cd80: 64 62 3a 73 74 72 69 6e 67 2d 3e 6f 62 6a 20 28  db:string->obj (
cd90: 72 65 63 65 69 76 65 2d 6d 65 73 73 61 67 65 2a  receive-message*
cda0: 20 73 75 62 2d 73 6f 63 6b 65 74 29 29 29 29 0a   sub-socket)))).
cdb0: 09 09 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f  .... (if (equal?
cdc0: 20 71 75 65 72 79 2d 73 69 67 20 28 76 65 63 74   query-sig (vect
cdd0: 6f 72 2d 72 65 66 20 6d 79 72 65 73 20 31 29 29  or-ref myres 1))
cde0: 0a 09 09 09 09 20 20 20 20 20 28 73 65 74 21 20  .....     (set! 
cdf0: 72 65 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20  res (vector-ref 
ce00: 6d 79 72 65 73 20 32 29 29 0a 09 09 09 09 20 20  myres 2)).....  
ce10: 20 20 20 28 6c 6f 6f 70 29 29 29 29 29 29 0a 09     (loop))))))..
ce20: 20 20 20 20 20 28 74 69 6d 65 6f 75 74 20 28 6c       (timeout (l
ce30: 61 6d 62 64 61 20 28 29 0a 09 09 09 28 6c 65 74  ambda ()....(let
ce40: 20 6c 6f 6f 70 20 28 28 6e 20 6e 75 6d 72 65 74   loop ((n numret
ce50: 72 69 65 73 29 29 0a 09 09 09 20 20 28 74 68 72  ries))....  (thr
ce60: 65 61 64 2d 73 6c 65 65 70 21 20 31 35 29 0a 09  ead-sleep! 15)..
ce70: 09 09 20 20 28 69 66 20 28 6e 6f 74 20 72 65 73  ..  (if (not res
ce80: 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28  )....      (if (
ce90: 3e 20 6e 75 6d 72 65 74 72 69 65 73 20 30 29 0a  > numretries 0).
cea0: 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09  ....  (begin....
ceb0: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e  .    (debug:prin
cec0: 74 20 32 20 22 57 41 52 4e 49 4e 47 3a 20 6e 6f  t 2 "WARNING: no
ced0: 20 72 65 70 6c 79 20 74 6f 20 71 75 65 72 79 20   reply to query 
cee0: 22 20 70 61 72 61 6d 73 20 22 2c 20 74 72 79 69  " params ", tryi
cef0: 6e 67 20 72 65 73 65 6e 64 22 29 0a 09 09 09 09  ng resend").....
cf00: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74      (debug:print
cf10: 2d 69 6e 66 6f 20 31 31 20 22 72 65 2d 73 65 6e  -info 11 "re-sen
cf20: 64 69 6e 67 20 6d 65 73 73 61 67 65 22 29 0a 09  ding message")..
cf30: 09 09 09 20 20 20 20 28 73 65 6e 64 2d 6d 65 73  ...    (send-mes
cf40: 73 61 67 65 20 70 75 73 68 2d 73 6f 63 6b 65 74  sage push-socket
cf50: 20 7a 64 61 74 29 0a 09 09 09 09 20 20 20 20 28   zdat).....    (
cf60: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f  debug:print-info
cf70: 20 31 31 20 22 6d 65 73 73 61 67 65 20 72 65 2d   11 "message re-
cf80: 73 65 6e 74 22 29 0a 09 09 09 09 20 20 20 20 28  sent").....    (
cf90: 6c 6f 6f 70 20 28 2d 20 6e 20 31 29 29 29 0a 09  loop (- n 1)))..
cfa0: 09 09 09 20 20 3b 3b 20 28 61 70 70 6c 79 20 63  ...  ;; (apply c
cfb0: 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 2a  db:client-call *
cfc0: 72 75 6e 72 65 6d 6f 74 65 2a 20 71 74 79 70 65  runremote* qtype
cfd0: 20 69 6d 6d 65 64 69 61 74 65 20 28 2d 20 6e 75   immediate (- nu
cfe0: 6d 72 65 74 72 69 65 73 20 31 29 20 70 61 72 61  mretries 1) para
cff0: 6d 73 29 29 0a 09 09 09 09 20 20 28 62 65 67 69  ms)).....  (begi
d000: 6e 0a 09 09 09 09 20 20 20 20 28 64 65 62 75 67  n.....    (debug
d010: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a  :print 0 "ERROR:
d020: 20 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c   cdb:client-call
d030: 20 74 69 6d 65 64 20 6f 75 74 20 22 20 70 61 72   timed out " par
d040: 61 6d 73 20 22 2c 20 65 78 69 74 69 6e 67 2e 22  ams ", exiting."
d050: 29 0a 09 09 09 09 20 20 20 20 28 65 78 69 74 20  ).....    (exit 
d060: 35 29 29 29 29 29 29 29 29 0a 09 28 64 65 62 75  5))))))))..(debu
d070: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20  g:print-info 11 
d080: 22 53 74 61 72 74 69 6e 67 20 74 68 72 65 61 64  "Starting thread
d090: 73 22 29 0a 09 28 6c 65 74 20 28 28 74 68 31 20  s")..(let ((th1 
d0a0: 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 73 65 6e  (make-thread sen
d0b0: 64 2d 72 65 63 65 69 76 65 20 22 73 65 6e 64 20  d-receive "send 
d0c0: 72 65 63 65 69 76 65 22 29 29 0a 09 20 20 20 20  receive"))..    
d0d0: 20 20 28 74 68 32 20 28 6d 61 6b 65 2d 74 68 72    (th2 (make-thr
d0e0: 65 61 64 20 74 69 6d 65 6f 75 74 20 20 20 20 20  ead timeout     
d0f0: 20 22 74 69 6d 65 6f 75 74 22 29 29 29 0a 09 20   "timeout"))).. 
d100: 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20   (thread-start! 
d110: 74 68 31 29 0a 09 20 20 28 74 68 72 65 61 64 2d  th1)..  (thread-
d120: 73 74 61 72 74 21 20 74 68 32 29 0a 09 20 20 28  start! th2)..  (
d130: 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 20 74 68  thread-join!  th
d140: 31 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69  1)..  (debug:pri
d150: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 63 64 62 3a  nt-info 11 "cdb:
d160: 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 72 65 74 75  client-call retu
d170: 72 6e 69 6e 67 20 72 65 73 3d 22 20 72 65 73 29  rning res=" res)
d180: 0a 09 20 20 72 65 73 29 29 29 29 29 29 0a 20 20  ..  res)))))).  
d190: 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 73 65  .(define (cdb:se
d1a0: 74 2d 76 65 72 62 6f 73 69 74 79 20 73 65 72 76  t-verbosity serv
d1b0: 65 72 64 61 74 20 76 61 6c 29 0a 20 20 28 63 64  erdat val).  (cd
d1c0: 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65  b:client-call se
d1d0: 72 76 65 72 64 61 74 20 27 73 65 74 2d 76 65 72  rverdat 'set-ver
d1e0: 62 6f 73 69 74 79 20 23 66 20 2a 64 65 66 61 75  bosity #f *defau
d1f0: 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 76 61 6c  lt-numtries* val
d200: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62  ))..(define (cdb
d210: 3a 6c 6f 67 69 6e 20 73 65 72 76 65 72 64 61 74  :login serverdat
d220: 20 6b 65 79 76 61 6c 20 73 69 67 6e 61 74 75 72   keyval signatur
d230: 65 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74  e).  (cdb:client
d240: 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 20  -call serverdat 
d250: 27 6c 6f 67 69 6e 20 23 74 20 2a 64 65 66 61 75  'login #t *defau
d260: 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6b 65 79  lt-numtries* key
d270: 76 61 6c 20 6d 65 67 61 74 65 73 74 2d 76 65 72  val megatest-ver
d280: 73 69 6f 6e 20 73 69 67 6e 61 74 75 72 65 29 29  sion signature))
d290: 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 6c  ..(define (cdb:l
d2a0: 6f 67 6f 75 74 20 73 65 72 76 65 72 64 61 74 20  ogout serverdat 
d2b0: 6b 65 79 76 61 6c 20 73 69 67 6e 61 74 75 72 65  keyval signature
d2c0: 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d  ).  (cdb:client-
d2d0: 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 20 27  call serverdat '
d2e0: 6c 6f 67 6f 75 74 20 23 74 20 2a 64 65 66 61 75  logout #t *defau
d2f0: 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6b 65 79  lt-numtries* key
d300: 76 61 6c 20 73 69 67 6e 61 74 75 72 65 29 29 0a  val signature)).
d310: 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 6e 75  .(define (cdb:nu
d320: 6d 2d 63 6c 69 65 6e 74 73 20 73 65 72 76 65 72  m-clients server
d330: 64 61 74 29 0a 20 20 28 63 64 62 3a 63 6c 69 65  dat).  (cdb:clie
d340: 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61  nt-call serverda
d350: 74 20 27 6e 75 6d 63 6c 69 65 6e 74 73 20 23 74  t 'numclients #t
d360: 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69   *default-numtri
d370: 65 73 2a 29 29 0a 0a 28 64 65 66 69 6e 65 20 28  es*))..(define (
d380: 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61  cdb:test-set-sta
d390: 74 75 73 2d 73 74 61 74 65 20 73 65 72 76 65 72  tus-state server
d3a0: 64 61 74 20 74 65 73 74 2d 69 64 20 73 74 61 74  dat test-id stat
d3b0: 75 73 20 73 74 61 74 65 20 6d 73 67 29 0a 20 20  us state msg).  
d3c0: 28 69 66 20 6d 73 67 0a 20 20 20 20 20 20 28 63  (if msg.      (c
d3d0: 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73  db:client-call s
d3e0: 65 72 76 65 72 64 61 74 20 27 73 74 61 74 65 2d  erverdat 'state-
d3f0: 73 74 61 74 75 73 2d 6d 73 67 20 23 74 20 2a 64  status-msg #t *d
d400: 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a  efault-numtries*
d410: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 6d 73   state status ms
d420: 67 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 20  g test-id).     
d430: 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c   (cdb:client-cal
d440: 6c 20 73 65 72 76 65 72 64 61 74 20 27 73 74 61  l serverdat 'sta
d450: 74 65 2d 73 74 61 74 75 73 20 23 74 20 2a 64 65  te-status #t *de
d460: 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20  fault-numtries* 
d470: 73 74 61 74 65 20 73 74 61 74 75 73 20 74 65 73  state status tes
d480: 74 2d 69 64 29 29 29 20 3b 3b 20 72 75 6e 2d 69  t-id))) ;; run-i
d490: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d  d test-name item
d4a0: 2d 70 61 74 68 20 6d 69 6e 75 74 65 73 20 63 70  -path minutes cp
d4b0: 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 74  uload diskfree t
d4c0: 6d 70 66 72 65 65 29 20 0a 0a 28 64 65 66 69 6e  mpfree) ..(defin
d4d0: 65 20 28 63 64 62 3a 74 65 73 74 2d 72 6f 6c 6c  e (cdb:test-roll
d4e0: 75 70 2d 74 65 73 74 5f 64 61 74 61 2d 70 61 73  up-test_data-pas
d4f0: 73 2d 66 61 69 6c 20 73 65 72 76 65 72 64 61 74  s-fail serverdat
d500: 20 74 65 73 74 2d 69 64 29 0a 20 20 28 63 64 62   test-id).  (cdb
d510: 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 72  :client-call ser
d520: 76 65 72 64 61 74 20 27 74 65 73 74 5f 64 61 74  verdat 'test_dat
d530: 61 2d 70 66 2d 72 6f 6c 6c 75 70 20 23 74 20 2a  a-pf-rollup #t *
d540: 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73  default-numtries
d550: 2a 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d 69  * test-id test-i
d560: 64 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d 69  d test-id test-i
d570: 64 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64  d))..(define (cd
d580: 62 3a 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e  b:pass-fail-coun
d590: 74 73 20 73 65 72 76 65 72 64 61 74 20 74 65 73  ts serverdat tes
d5a0: 74 2d 69 64 20 66 61 69 6c 2d 63 6f 75 6e 74 20  t-id fail-count 
d5b0: 70 61 73 73 2d 63 6f 75 6e 74 29 0a 20 20 28 63  pass-count).  (c
d5c0: 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73  db:client-call s
d5d0: 65 72 76 65 72 64 61 74 20 27 70 61 73 73 2d 66  erverdat 'pass-f
d5e0: 61 69 6c 2d 63 6f 75 6e 74 73 20 23 74 20 2a 64  ail-counts #t *d
d5f0: 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a  efault-numtries*
d600: 20 66 61 69 6c 2d 63 6f 75 6e 74 20 70 61 73 73   fail-count pass
d610: 2d 63 6f 75 6e 74 20 74 65 73 74 2d 69 64 29 29  -count test-id))
d620: 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 74  ..(define (cdb:t
d630: 65 73 74 73 2d 72 65 67 69 73 74 65 72 2d 74 65  ests-register-te
d640: 73 74 20 73 65 72 76 65 72 64 61 74 20 72 75 6e  st serverdat run
d650: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74  -id test-name it
d660: 65 6d 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 20  em-path).  (let 
d670: 28 28 69 74 65 6d 2d 70 61 74 68 73 20 28 69 66  ((item-paths (if
d680: 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61   (equal? item-pa
d690: 74 68 20 22 22 29 0a 09 09 09 28 6c 69 73 74 20  th "")....(list 
d6a0: 69 74 65 6d 2d 70 61 74 68 29 0a 09 09 09 28 6c  item-path)....(l
d6b0: 69 73 74 20 69 74 65 6d 2d 70 61 74 68 20 22 22  ist item-path ""
d6c0: 29 29 29 29 0a 20 20 20 20 28 63 64 62 3a 63 6c  )))).    (cdb:cl
d6d0: 69 65 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 72  ient-call server
d6e0: 64 61 74 20 27 72 65 67 69 73 74 65 72 2d 74 65  dat 'register-te
d6f0: 73 74 20 23 74 20 2a 64 65 66 61 75 6c 74 2d 6e  st #t *default-n
d700: 75 6d 74 72 69 65 73 2a 20 72 75 6e 2d 69 64 20  umtries* run-id 
d710: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70  test-name item-p
d720: 61 74 68 29 29 29 0a 0a 28 64 65 66 69 6e 65 20  ath)))..(define 
d730: 28 63 64 62 3a 66 6c 75 73 68 2d 71 75 65 75 65  (cdb:flush-queue
d740: 20 73 65 72 76 65 72 64 61 74 29 0a 20 20 28 63   serverdat).  (c
d750: 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73  db:client-call s
d760: 65 72 76 65 72 64 61 74 20 27 66 6c 75 73 68 20  erverdat 'flush 
d770: 23 66 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74  #f *default-numt
d780: 72 69 65 73 2a 29 29 0a 0a 28 64 65 66 69 6e 65  ries*))..(define
d790: 20 28 63 64 62 3a 6b 69 6c 6c 2d 73 65 72 76 65   (cdb:kill-serve
d7a0: 72 20 73 65 72 76 65 72 64 61 74 29 0a 20 20 28  r serverdat).  (
d7b0: 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20  cdb:client-call 
d7c0: 73 65 72 76 65 72 64 61 74 20 27 6b 69 6c 6c 73  serverdat 'kills
d7d0: 65 72 76 65 72 20 23 66 20 2a 64 65 66 61 75 6c  erver #f *defaul
d7e0: 74 2d 6e 75 6d 74 72 69 65 73 2a 29 29 0a 0a 28  t-numtries*))..(
d7f0: 64 65 66 69 6e 65 20 28 63 64 62 3a 72 6f 6c 6c  define (cdb:roll
d800: 2d 75 70 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f  -up-pass-fail-co
d810: 75 6e 74 73 20 73 65 72 76 65 72 64 61 74 20 72  unts serverdat r
d820: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20  un-id test-name 
d830: 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 75 73  item-path status
d840: 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d  ).  (cdb:client-
d850: 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 20 27  call serverdat '
d860: 69 6d 6d 65 64 69 61 74 65 20 23 66 20 2a 64 65  immediate #f *de
d870: 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20  fault-numtries* 
d880: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64  open-run-close d
d890: 62 3a 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d 66  b:roll-up-pass-f
d8a0: 61 69 6c 2d 63 6f 75 6e 74 73 20 23 66 20 72 75  ail-counts #f ru
d8b0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69  n-id test-name i
d8c0: 74 65 6d 2d 70 61 74 68 20 73 74 61 74 75 73 29  tem-path status)
d8d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a  )..(define (cdb:
d8e0: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 73 65  get-test-info se
d8f0: 72 76 65 72 64 61 74 20 72 75 6e 2d 69 64 20 74  rverdat run-id t
d900: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61  est-name item-pa
d910: 74 68 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e  th).  (cdb:clien
d920: 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74  t-call serverdat
d930: 20 27 69 6d 6d 65 64 69 61 74 65 20 23 66 20 2a   'immediate #f *
d940: 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73  default-numtries
d950: 2a 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65  * open-run-close
d960: 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66   db:get-test-inf
d970: 6f 20 23 66 20 72 75 6e 2d 69 64 20 74 65 73 74  o #f run-id test
d980: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29  -name item-path)
d990: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a  )..(define (cdb:
d9a0: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79  get-test-info-by
d9b0: 2d 69 64 20 73 65 72 76 65 72 64 61 74 20 74 65  -id serverdat te
d9c0: 73 74 2d 69 64 29 0a 20 20 28 63 64 62 3a 63 6c  st-id).  (cdb:cl
d9d0: 69 65 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 72  ient-call server
d9e0: 64 61 74 20 27 69 6d 6d 65 64 69 61 74 65 20 23  dat 'immediate #
d9f0: 66 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72  f *default-numtr
da00: 69 65 73 2a 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c  ies* open-run-cl
da10: 6f 73 65 20 64 62 3a 67 65 74 2d 74 65 73 74 2d  ose db:get-test-
da20: 69 6e 66 6f 2d 62 79 2d 69 64 20 23 66 20 74 65  info-by-id #f te
da30: 73 74 2d 69 64 29 29 0a 0a 3b 3b 20 64 62 20 73  st-id))..;; db s
da40: 68 6f 75 6c 64 20 62 65 20 64 62 20 6f 70 65 6e  hould be db open
da50: 20 70 72 6f 63 20 6f 72 20 23 66 0a 28 64 65 66   proc or #f.(def
da60: 69 6e 65 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d  ine (cdb:remote-
da70: 72 75 6e 20 70 72 6f 63 20 64 62 20 2e 20 70 61  run proc db . pa
da80: 72 61 6d 73 29 0a 20 20 28 61 70 70 6c 79 20 63  rams).  (apply c
da90: 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 2a  db:client-call *
daa0: 72 75 6e 72 65 6d 6f 74 65 2a 20 27 69 6d 6d 65  runremote* 'imme
dab0: 64 69 61 74 65 20 23 66 20 2a 64 65 66 61 75 6c  diate #f *defaul
dac0: 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6f 70 65 6e  t-numtries* open
dad0: 2d 72 75 6e 2d 63 6c 6f 73 65 20 70 72 6f 63 20  -run-close proc 
dae0: 23 66 20 70 61 72 61 6d 73 29 29 0a 0a 28 64 65  #f params))..(de
daf0: 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 67 65  fine (db:test-ge
db00: 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 20 64  t-logfile-info d
db10: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61  b run-id test-na
db20: 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73  me).  (let ((res
db30: 20 23 66 29 29 0a 20 20 20 20 28 73 71 6c 69 74   #f)).    (sqlit
db40: 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20  e3:for-each-row 
db50: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70  .     (lambda (p
db60: 61 74 68 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 0a  ath final_logf).
db70: 20 20 20 20 20 20 20 28 73 65 74 21 20 6c 6f 67         (set! log
db80: 66 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 0a 20 20  f final_logf).  
db90: 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28       (set! res (
dba0: 6c 69 73 74 20 70 61 74 68 20 66 69 6e 61 6c 5f  list path final_
dbb0: 6c 6f 67 66 29 29 0a 20 20 20 20 20 20 20 28 69  logf)).       (i
dbc0: 66 20 28 64 69 72 65 63 74 6f 72 79 3f 20 70 61  f (directory? pa
dbd0: 74 68 29 0a 09 20 20 20 28 64 65 62 75 67 3a 70  th)..   (debug:p
dbe0: 72 69 6e 74 20 32 20 22 46 6f 75 6e 64 20 70 61  rint 2 "Found pa
dbf0: 74 68 3a 20 22 20 70 61 74 68 29 0a 09 20 20 20  th: " path)..   
dc00: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22  (debug:print 2 "
dc10: 4e 6f 20 73 75 63 68 20 70 61 74 68 3a 20 22 20  No such path: " 
dc20: 70 61 74 68 29 29 29 0a 20 20 20 20 20 64 62 0a  path))).     db.
dc30: 20 20 20 20 20 22 53 45 4c 45 43 54 20 72 75 6e       "SELECT run
dc40: 64 69 72 2c 66 69 6e 61 6c 5f 6c 6f 67 66 20 46  dir,final_logf F
dc50: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20  ROM tests WHERE 
dc60: 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73  run_id=? AND tes
dc70: 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d  tname=? AND item
dc80: 5f 70 61 74 68 3d 27 27 3b 22 0a 20 20 20 20 20  _path='';".     
dc90: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65  run-id test-name
dca0: 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 64 65  ).    res))..(de
dcb0: 66 69 6e 65 20 64 62 3a 71 75 65 72 69 65 73 20  fine db:queries 
dcc0: 0a 20 20 28 6c 69 73 74 20 27 28 72 65 67 69 73  .  (list '(regis
dcd0: 74 65 72 2d 74 65 73 74 20 20 20 20 20 20 20 20  ter-test        
dce0: 20 20 22 49 4e 53 45 52 54 20 4f 52 20 49 47 4e    "INSERT OR IGN
dcf0: 4f 52 45 20 49 4e 54 4f 20 74 65 73 74 73 20 28  ORE INTO tests (
dd00: 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c  run_id,testname,
dd10: 65 76 65 6e 74 5f 74 69 6d 65 2c 69 74 65 6d 5f  event_time,item_
dd20: 70 61 74 68 2c 73 74 61 74 65 2c 73 74 61 74 75  path,state,statu
dd30: 73 29 20 56 41 4c 55 45 53 20 28 3f 2c 3f 2c 73  s) VALUES (?,?,s
dd40: 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f  trftime('%s','no
dd50: 77 27 29 2c 3f 2c 27 4e 4f 54 5f 53 54 41 52 54  w'),?,'NOT_START
dd60: 45 44 27 2c 27 6e 2f 61 27 29 3b 22 29 0a 09 27  ED','n/a');")..'
dd70: 28 73 74 61 74 65 2d 73 74 61 74 75 73 20 20 20  (state-status   
dd80: 20 20 20 20 20 20 20 20 22 55 50 44 41 54 45 20          "UPDATE 
dd90: 74 65 73 74 73 20 53 45 54 20 73 74 61 74 65 3d  tests SET state=
dda0: 3f 2c 73 74 61 74 75 73 3d 3f 20 57 48 45 52 45  ?,status=? WHERE
ddb0: 20 69 64 3d 3f 3b 22 29 0a 09 27 28 73 74 61 74   id=?;")..'(stat
ddc0: 65 2d 73 74 61 74 75 73 2d 6d 73 67 20 20 20 20  e-status-msg    
ddd0: 20 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73     "UPDATE tests
dde0: 20 53 45 54 20 73 74 61 74 65 3d 3f 2c 73 74 61   SET state=?,sta
ddf0: 74 75 73 3d 3f 2c 63 6f 6d 6d 65 6e 74 3d 3f 20  tus=?,comment=? 
de00: 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 27  WHERE id=?;")..'
de10: 28 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74  (pass-fail-count
de20: 73 20 20 20 20 20 20 20 22 55 50 44 41 54 45 20  s       "UPDATE 
de30: 74 65 73 74 73 20 53 45 54 20 66 61 69 6c 5f 63  tests SET fail_c
de40: 6f 75 6e 74 3d 3f 2c 70 61 73 73 5f 63 6f 75 6e  ount=?,pass_coun
de50: 74 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22  t=? WHERE id=?;"
de60: 29 0a 09 3b 3b 20 74 65 73 74 5f 64 61 74 61 2d  )..;; test_data-
de70: 70 66 2d 72 6f 6c 6c 75 70 20 69 73 20 75 73 65  pf-rollup is use
de80: 64 20 74 6f 20 73 65 74 20 61 20 74 65 73 74 73  d to set a tests
de90: 20 50 41 53 53 2f 46 41 49 4c 20 62 61 73 65 64   PASS/FAIL based
dea0: 20 6f 6e 20 74 68 65 20 70 61 73 73 2f 66 61 69   on the pass/fai
deb0: 6c 20 69 6e 66 6f 20 66 72 6f 6d 20 74 68 65 20  l info from the 
dec0: 73 74 65 70 73 0a 09 27 28 74 65 73 74 5f 64 61  steps..'(test_da
ded0: 74 61 2d 70 66 2d 72 6f 6c 6c 75 70 20 20 20 20  ta-pf-rollup    
dee0: 22 55 50 44 41 54 45 20 74 65 73 74 73 0a 20 20  "UPDATE tests.  
def0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
df00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
df10: 20 20 53 45 54 20 73 74 61 74 75 73 3d 43 41 53    SET status=CAS
df20: 45 20 57 48 45 4e 20 28 53 45 4c 45 43 54 20 66  E WHEN (SELECT f
df30: 61 69 6c 5f 63 6f 75 6e 74 20 46 52 4f 4d 20 74  ail_count FROM t
df40: 65 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f 29  ests WHERE id=?)
df50: 20 3e 20 30 20 0a 20 20 20 20 20 20 20 20 20 20   > 0 .          
df60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
df70: 20 20 20 20 20 20 20 20 20 20 20 20 54 48 45 4e              THEN
df80: 20 27 46 41 49 4c 27 0a 20 20 20 20 20 20 20 20   'FAIL'.        
df90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
dfa0: 20 20 20 20 20 20 20 20 20 20 20 20 57 48 45 4e              WHEN
dfb0: 20 28 53 45 4c 45 43 54 20 70 61 73 73 5f 63 6f   (SELECT pass_co
dfc0: 75 6e 74 20 46 52 4f 4d 20 74 65 73 74 73 20 57  unt FROM tests W
dfd0: 48 45 52 45 20 69 64 3d 3f 29 20 3e 20 30 20 41  HERE id=?) > 0 A
dfe0: 4e 44 20 0a 20 20 20 20 20 20 20 20 20 20 20 20  ND .            
dff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
e000: 20 20 20 20 20 20 20 20 20 20 28 53 45 4c 45 43            (SELEC
e010: 54 20 73 74 61 74 75 73 20 46 52 4f 4d 20 74 65  T status FROM te
e020: 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f 29 20  sts WHERE id=?) 
e030: 4e 4f 54 20 49 4e 20 28 27 57 41 52 4e 27 2c 27  NOT IN ('WARN','
e040: 46 41 49 4c 27 29 0a 20 20 20 20 20 20 20 20 20  FAIL').         
e050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
e060: 20 20 20 20 20 20 20 20 20 20 20 54 48 45 4e 20             THEN 
e070: 27 50 41 53 53 27 0a 20 20 20 20 20 20 20 20 20  'PASS'.         
e080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
e090: 20 20 20 20 20 20 20 20 20 20 20 45 4c 53 45 20             ELSE 
e0a0: 73 74 61 74 75 73 0a 20 20 20 20 20 20 20 20 20  status.         
e0b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
e0c0: 20 20 20 20 20 20 20 20 20 20 20 45 4e 44 20 57             END W
e0d0: 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 27 28  HERE id=?;")..'(
e0e0: 74 65 73 74 2d 73 65 74 2d 6c 6f 67 20 20 20 20  test-set-log    
e0f0: 20 20 20 20 20 20 20 20 22 55 50 44 41 54 45 20          "UPDATE 
e100: 74 65 73 74 73 20 53 45 54 20 66 69 6e 61 6c 5f  tests SET final_
e110: 6c 6f 67 66 3d 3f 20 57 48 45 52 45 20 69 64 3d  logf=? WHERE id=
e120: 3f 3b 22 29 0a 09 27 28 74 65 73 74 2d 73 65 74  ?;")..'(test-set
e130: 2d 72 75 6e 64 69 72 2d 62 79 2d 74 65 73 74 2d  -rundir-by-test-
e140: 69 64 20 22 55 50 44 41 54 45 20 74 65 73 74 73  id "UPDATE tests
e150: 20 53 45 54 20 72 75 6e 64 69 72 3d 3f 20 57 48   SET rundir=? WH
e160: 45 52 45 20 69 64 3d 3f 22 29 0a 09 27 28 74 65  ERE id=?")..'(te
e170: 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 20 20 20  st-set-rundir   
e180: 20 20 20 20 20 20 22 55 50 44 41 54 45 20 74 65        "UPDATE te
e190: 73 74 73 20 53 45 54 20 72 75 6e 64 69 72 3d 3f  sts SET rundir=?
e1a0: 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20   WHERE run_id=? 
e1b0: 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41  AND testname=? A
e1c0: 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 3f 3b 22  ND item_path=?;"
e1d0: 29 0a 09 27 28 64 65 6c 65 74 65 2d 74 65 73 74  )..'(delete-test
e1e0: 73 2d 69 6e 2d 73 74 61 74 65 20 20 20 22 44 45  s-in-state   "DE
e1f0: 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 73 20  LETE FROM tests 
e200: 57 48 45 52 45 20 73 74 61 74 65 3d 3f 20 41 4e  WHERE state=? AN
e210: 44 20 72 75 6e 5f 69 64 3d 3f 3b 22 29 0a 09 27  D run_id=?;")..'
e220: 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d  (tests:test-set-
e230: 74 6f 70 6c 6f 67 20 20 20 22 55 50 44 41 54 45  toplog   "UPDATE
e240: 20 74 65 73 74 73 20 53 45 54 20 66 69 6e 61 6c   tests SET final
e250: 5f 6c 6f 67 66 3d 3f 20 57 48 45 52 45 20 72 75  _logf=? WHERE ru
e260: 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e  n_id=? AND testn
e270: 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70  ame=? AND item_p
e280: 61 74 68 3d 27 27 3b 22 29 0a 20 20 20 20 29 29  ath='';").    ))
e290: 0a 0a 3b 3b 20 64 6f 20 6e 6f 74 20 72 75 6e 20  ..;; do not run 
e2a0: 74 68 65 73 65 20 61 73 20 70 61 72 74 20 6f 66  these as part of
e2b0: 20 74 68 65 20 74 72 61 6e 73 61 63 74 69 6f 6e   the transaction
e2c0: 0a 28 64 65 66 69 6e 65 20 64 62 3a 73 70 65 63  .(define db:spec
e2d0: 69 61 6c 2d 71 75 65 72 69 65 73 20 20 20 27 28  ial-queries   '(
e2e0: 72 6f 6c 6c 75 70 2d 74 65 73 74 73 2d 70 61 73  rollup-tests-pas
e2f0: 73 2d 66 61 69 6c 0a 09 09 09 20 20 20 20 20 20  s-fail....      
e300: 20 64 62 3a 72 6f 6c 6c 2d 75 70 2d 70 61 73 73   db:roll-up-pass
e310: 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 0a 20 20 20  -fail-counts.   
e320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
e330: 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f 67 69              logi
e340: 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  n.              
e350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
e360: 20 69 6d 6d 65 64 69 61 74 65 0a 09 09 09 20 20   immediate....  
e370: 20 20 20 20 20 66 6c 75 73 68 0a 09 09 09 20 20       flush....  
e380: 20 20 20 20 20 73 79 6e 63 0a 09 09 09 20 20 20       sync....   
e390: 20 20 20 20 73 65 74 2d 76 65 72 62 6f 73 69 74      set-verbosit
e3a0: 79 0a 09 09 09 20 20 20 20 20 20 20 6b 69 6c 6c  y....       kill
e3b0: 73 65 72 76 65 72 29 29 0a 0a 3b 3b 20 6e 6f 74  server))..;; not
e3c0: 20 75 73 65 64 2c 20 69 6e 74 65 6e 64 65 64 20   used, intended 
e3d0: 74 6f 20 69 6e 64 69 63 61 74 65 20 74 6f 20 72  to indicate to r
e3e0: 75 6e 20 69 6e 20 63 61 6c 6c 69 6e 67 20 70 72  un in calling pr
e3f0: 6f 63 65 73 73 0a 28 64 65 66 69 6e 65 20 64 62  ocess.(define db
e400: 3a 72 75 6e 2d 6c 6f 63 61 6c 2d 71 75 65 72 69  :run-local-queri
e410: 65 73 20 27 28 29 29 20 3b 3b 20 72 6f 6c 6c 75  es '()) ;; rollu
e420: 70 2d 74 65 73 74 73 2d 70 61 73 73 2d 66 61 69  p-tests-pass-fai
e430: 6c 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62  l))..(define (db
e440: 3a 70 72 6f 63 65 73 73 2d 63 61 63 68 65 64 2d  :process-cached-
e450: 77 72 69 74 65 73 20 64 62 29 0a 20 20 28 6c 65  writes db).  (le
e460: 74 20 28 28 71 75 65 72 69 65 73 20 20 20 20 28  t ((queries    (
e470: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29  make-hash-table)
e480: 29 0a 09 28 64 61 74 61 20 20 20 20 20 20 20 23  )..(data       #
e490: 66 29 29 0a 20 20 20 20 28 6d 75 74 65 78 2d 6c  f)).    (mutex-l
e4a0: 6f 63 6b 21 20 2a 69 6e 63 6f 6d 69 6e 67 2d 6d  ock! *incoming-m
e4b0: 75 74 65 78 2a 29 0a 20 20 20 20 3b 3b 20 64 61  utex*).    ;; da
e4c0: 74 61 20 69 73 20 61 20 6c 69 73 74 20 6f 66 20  ta is a list of 
e4d0: 71 75 65 72 79 20 70 61 63 6b 65 74 73 20 3c 76  query packets <v
e4e0: 65 63 74 6f 72 20 71 72 79 2d 73 69 67 20 71 75  ector qry-sig qu
e4f0: 65 72 79 20 70 61 72 61 6d 73 0a 20 20 20 20 28  ery params.    (
e500: 73 65 74 21 20 64 61 74 61 20 28 72 65 76 65 72  set! data (rever
e510: 73 65 20 2a 69 6e 63 6f 6d 69 6e 67 2d 77 72 69  se *incoming-wri
e520: 74 65 73 2a 29 29 20 3b 3b 20 20 28 73 6f 72 74  tes*)) ;;  (sort
e530: 20 2e 2e 2e 20 28 6c 61 6d 62 64 61 20 28 61 20   ... (lambda (a 
e540: 62 29 28 3c 20 28 76 65 63 74 6f 72 2d 72 65 66  b)(< (vector-ref
e550: 20 61 20 31 29 28 76 65 63 74 6f 72 2d 72 65 66   a 1)(vector-ref
e560: 20 62 20 31 29 29 29 29 29 0a 20 20 20 20 28 73   b 1))))).    (s
e570: 65 74 21 20 2a 73 65 72 76 65 72 3a 6c 61 73 74  et! *server:last
e580: 2d 77 72 69 74 65 2d 66 6c 75 73 68 2a 20 28 63  -write-flush* (c
e590: 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f  urrent-milliseco
e5a0: 6e 64 73 29 29 0a 20 20 20 20 28 73 65 74 21 20  nds)).    (set! 
e5b0: 2a 69 6e 63 6f 6d 69 6e 67 2d 77 72 69 74 65 73  *incoming-writes
e5c0: 2a 20 27 28 29 29 0a 20 20 20 20 28 6d 75 74 65  * '()).    (mute
e5d0: 78 2d 75 6e 6c 6f 63 6b 21 20 2a 69 6e 63 6f 6d  x-unlock! *incom
e5e0: 69 6e 67 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20  ing-mutex*).    
e5f0: 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 64  (if (> (length d
e600: 61 74 61 29 20 30 29 0a 09 3b 3b 20 50 72 6f 63  ata) 0)..;; Proc
e610: 65 73 73 20 69 66 20 77 65 20 68 61 76 65 20 64  ess if we have d
e620: 61 74 61 0a 09 28 62 65 67 69 6e 0a 09 20 20 28  ata..(begin..  (
e630: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f  debug:print-info
e640: 20 37 20 22 57 72 69 74 69 6e 67 20 63 61 63 68   7 "Writing cach
e650: 65 64 20 64 61 74 61 20 22 20 64 61 74 61 29 0a  ed data " data).
e660: 20 20 20 20 0a 09 20 20 3b 3b 20 50 72 65 70 61      ..  ;; Prepa
e670: 72 65 20 74 68 65 20 6e 65 65 64 65 64 20 73 71  re the needed sq
e680: 6c 20 73 74 61 74 65 6d 65 6e 74 73 0a 09 20 20  l statements..  
e690: 3b 3b 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 20  ;;..  (for-each 
e6a0: 28 6c 61 6d 62 64 61 20 28 72 65 71 75 65 73 74  (lambda (request
e6b0: 2d 69 74 65 6d 29 0a 09 09 20 20 20 20 20 20 28  -item)...      (
e6c0: 6c 65 74 20 28 28 73 74 6d 74 2d 6b 65 79 20 28  let ((stmt-key (
e6d0: 76 65 63 74 6f 72 2d 72 65 66 20 72 65 71 75 65  vector-ref reque
e6e0: 73 74 2d 69 74 65 6d 20 30 29 29 0a 09 09 09 20  st-item 0)).... 
e6f0: 20 20 20 28 71 75 65 72 79 20 20 20 20 28 76 65     (query    (ve
e700: 63 74 6f 72 2d 72 65 66 20 72 65 71 75 65 73 74  ctor-ref request
e710: 2d 69 74 65 6d 20 31 29 29 29 0a 09 09 09 28 68  -item 1)))....(h
e720: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 71  ash-table-set! q
e730: 75 65 72 69 65 73 20 73 74 6d 74 2d 6b 65 79 20  ueries stmt-key 
e740: 28 73 71 6c 69 74 65 33 3a 70 72 65 70 61 72 65  (sqlite3:prepare
e750: 20 64 62 20 71 75 65 72 79 29 29 29 29 0a 09 09   db query))))...
e760: 20 20 20 20 64 61 74 61 29 0a 09 20 20 0a 09 20      data)..  .. 
e770: 20 3b 3b 20 4e 6f 20 6f 75 74 65 72 20 6c 6f 6f   ;; No outer loo
e780: 70 20 6e 65 65 64 65 64 2e 20 53 69 6e 67 6c 65  p needed. Single
e790: 20 6c 6f 6f 70 20 66 6f 72 20 77 72 69 74 65 20   loop for write 
e7a0: 69 74 65 6d 73 20 6f 6e 6c 79 2e 20 52 65 61 64  items only. Read
e7b0: 73 20 74 72 69 67 67 65 72 20 66 6c 75 73 68 20  s trigger flush 
e7c0: 6f 66 20 71 75 65 75 65 0a 09 20 20 3b 3b 20 61  of queue..  ;; a
e7d0: 6e 64 20 74 68 65 6e 20 61 72 65 20 65 78 65 63  nd then are exec
e7e0: 75 74 65 64 2e 0a 09 20 20 28 73 71 6c 69 74 65  uted...  (sqlite
e7f0: 33 3a 77 69 74 68 2d 74 72 61 6e 73 61 63 74 69  3:with-transacti
e800: 6f 6e 20 0a 09 20 20 20 64 62 0a 09 20 20 20 28  on ..   db..   (
e810: 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 20 20 20  lambda ()..     
e820: 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 20 20  (for-each..     
e830: 20 28 6c 61 6d 62 64 61 20 28 68 65 64 29 0a 09   (lambda (hed)..
e840: 09 28 6c 65 74 2a 20 28 28 70 61 72 61 6d 73 20  .(let* ((params 
e850: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 68 65    (vector-ref he
e860: 64 20 32 29 29 0a 09 09 20 20 20 20 20 20 20 28  d 2))...       (
e870: 73 74 6d 74 2d 6b 65 79 20 28 76 65 63 74 6f 72  stmt-key (vector
e880: 2d 72 65 66 20 68 65 64 20 30 29 29 0a 09 09 20  -ref hed 0))... 
e890: 20 20 20 20 20 20 28 73 74 6d 74 20 20 20 20 20        (stmt     
e8a0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f  (hash-table-ref/
e8b0: 64 65 66 61 75 6c 74 20 71 75 65 72 69 65 73 20  default queries 
e8c0: 73 74 6d 74 2d 6b 65 79 20 23 66 29 29 29 0a 09  stmt-key #f)))..
e8d0: 09 20 20 28 69 66 20 73 74 6d 74 0a 09 09 20 20  .  (if stmt...  
e8e0: 20 20 20 20 28 61 70 70 6c 79 20 73 71 6c 69 74      (apply sqlit
e8f0: 65 33 3a 65 78 65 63 75 74 65 20 73 74 6d 74 20  e3:execute stmt 
e900: 70 61 72 61 6d 73 29 0a 09 09 20 20 20 20 20 20  params)...      
e910: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22  (debug:print 0 "
e920: 45 52 52 4f 52 3a 20 50 72 6f 62 6c 65 6d 20 45  ERROR: Problem E
e930: 78 65 63 75 74 69 6e 67 20 22 20 73 74 6d 74 2d  xecuting " stmt-
e940: 6b 65 79 20 22 20 66 6f 72 20 22 20 70 61 72 61  key " for " para
e950: 6d 73 29 29 29 29 0a 09 20 20 20 20 20 20 64 61  ms))))..      da
e960: 74 61 29 29 29 0a 09 20 20 0a 09 20 20 3b 3b 20  ta)))..  ..  ;; 
e970: 6c 65 74 20 61 6c 6c 20 74 68 65 20 77 61 69 74  let all the wait
e980: 69 6e 67 20 63 61 6c 6c 73 20 6b 6e 6f 77 20 61  ing calls know a
e990: 6c 6c 20 69 73 20 64 6f 6e 65 0a 09 20 20 28 6d  ll is done..  (m
e9a0: 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 63 6f 6d 70  utex-lock! *comp
e9b0: 6c 65 74 65 64 2d 6d 75 74 65 78 2a 29 0a 09 20  leted-mutex*).. 
e9c0: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62   (for-each (lamb
e9d0: 64 61 20 28 69 74 65 6d 29 0a 09 09 20 20 20 20  da (item)...    
e9e0: 20 20 28 6c 65 74 20 28 28 71 72 79 2d 73 69 67    (let ((qry-sig
e9f0: 20 28 63 64 62 3a 70 61 63 6b 65 74 2d 67 65 74   (cdb:packet-get
ea00: 2d 63 6c 69 65 6e 74 2d 73 69 67 20 69 74 65 6d  -client-sig item
ea10: 29 29 29 0a 09 09 09 28 64 65 62 75 67 3a 70 72  )))....(debug:pr
ea20: 69 6e 74 2d 69 6e 66 6f 20 37 20 22 52 65 67 69  int-info 7 "Regi
ea30: 73 74 65 72 69 6e 67 20 71 75 65 72 79 20 22 20  stering query " 
ea40: 71 72 79 2d 73 69 67 20 22 20 61 73 20 64 6f 6e  qry-sig " as don
ea50: 65 22 29 0a 09 09 09 28 68 61 73 68 2d 74 61 62  e")....(hash-tab
ea60: 6c 65 2d 73 65 74 21 20 2a 63 6f 6d 70 6c 65 74  le-set! *complet
ea70: 65 64 2d 77 72 69 74 65 73 2a 20 71 72 79 2d 73  ed-writes* qry-s
ea80: 69 67 20 23 74 29 29 29 0a 09 09 20 20 20 20 64  ig #t)))...    d
ea90: 61 74 61 29 0a 09 20 20 28 6d 75 74 65 78 2d 75  ata)..  (mutex-u
eaa0: 6e 6c 6f 63 6b 21 20 2a 63 6f 6d 70 6c 65 74 65  nlock! *complete
eab0: 64 2d 6d 75 74 65 78 2a 29 0a 09 20 20 0a 09 20  d-mutex*)..  .. 
eac0: 20 3b 3b 20 46 69 6e 61 6c 69 7a 65 20 74 68 65   ;; Finalize the
ead0: 20 73 74 61 74 65 6d 65 6e 74 73 2e 20 53 68 6f   statements. Sho
eae0: 75 6c 64 20 74 68 69 73 20 62 65 20 64 6f 6e 65  uld this be done
eaf0: 20 69 6e 73 69 64 65 20 74 68 65 20 6d 75 74 65   inside the mute
eb00: 78 20 61 62 6f 76 65 3f 0a 09 20 20 3b 3b 20 49  x above?..  ;; I
eb10: 20 74 68 69 6e 6b 20 73 71 6c 69 74 65 33 20 6d   think sqlite3 m
eb20: 75 74 65 78 65 73 20 77 69 6c 6c 20 6b 65 65 70  utexes will keep
eb30: 20 74 68 65 20 64 61 74 61 20 73 61 66 65 0a 09   the data safe..
eb40: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d    (for-each (lam
eb50: 62 64 61 20 28 73 74 6d 74 2d 6b 65 79 29 0a 09  bda (stmt-key)..
eb60: 09 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a  .      (sqlite3:
eb70: 66 69 6e 61 6c 69 7a 65 21 20 28 68 61 73 68 2d  finalize! (hash-
eb80: 74 61 62 6c 65 2d 72 65 66 20 71 75 65 72 69 65  table-ref querie
eb90: 73 20 73 74 6d 74 2d 6b 65 79 29 29 29 0a 09 09  s stmt-key)))...
eba0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d      (hash-table-
ebb0: 6b 65 79 73 20 71 75 65 72 69 65 73 29 29 0a 09  keys queries))..
ebc0: 20 20 0a 09 20 20 3b 3b 20 44 6f 20 61 20 6c 69    ..  ;; Do a li
ebd0: 74 74 6c 65 20 72 65 63 6f 72 64 20 6b 65 65 70  ttle record keep
ebe0: 69 6e 67 0a 09 20 20 28 6c 65 74 20 28 28 63 61  ing..  (let ((ca
ebf0: 63 68 65 2d 73 69 7a 65 20 28 6c 65 6e 67 74 68  che-size (length
ec00: 20 64 61 74 61 29 29 29 0a 09 20 20 20 20 28 69   data)))..    (i
ec10: 66 20 28 3e 20 63 61 63 68 65 2d 73 69 7a 65 20  f (> cache-size 
ec20: 2a 6d 61 78 2d 63 61 63 68 65 2d 73 69 7a 65 2a  *max-cache-size*
ec30: 29 0a 09 09 28 73 65 74 21 20 2a 6d 61 78 2d 63  )...(set! *max-c
ec40: 61 63 68 65 2d 73 69 7a 65 2a 20 63 61 63 68 65  ache-size* cache
ec50: 2d 73 69 7a 65 29 29 29 0a 09 20 20 23 74 29 0a  -size)))..  #t).
ec60: 09 23 66 29 29 29 0a 0a 28 64 65 66 69 6e 65 20  .#f)))..(define 
ec70: 2a 64 62 3a 70 72 6f 63 65 73 73 2d 71 75 65 75  *db:process-queu
ec80: 65 2d 6d 75 74 65 78 2a 20 28 6d 61 6b 65 2d 6d  e-mutex* (make-m
ec90: 75 74 65 78 29 29 0a 0a 28 64 65 66 69 6e 65 20  utex))..(define 
eca0: 2a 6e 75 6d 62 65 72 2d 6f 66 2d 77 72 69 74 65  *number-of-write
ecb0: 73 2a 20 20 20 20 20 20 20 20 20 30 29 0a 28 64  s*         0).(d
ecc0: 65 66 69 6e 65 20 2a 77 72 69 74 65 73 2d 74 6f  efine *writes-to
ecd0: 74 61 6c 2d 64 65 6c 61 79 2a 20 20 20 20 20 20  tal-delay*      
ece0: 20 30 29 0a 28 64 65 66 69 6e 65 20 2a 74 6f 74   0).(define *tot
ecf0: 61 6c 2d 6e 6f 6e 2d 77 72 69 74 65 2d 64 65 6c  al-non-write-del
ed00: 61 79 2a 20 20 20 20 30 29 0a 28 64 65 66 69 6e  ay*    0).(defin
ed10: 65 20 2a 6e 75 6d 62 65 72 2d 6e 6f 6e 2d 77 72  e *number-non-wr
ed20: 69 74 65 2d 71 75 65 72 69 65 73 2a 20 30 29 0a  ite-queries* 0).
ed30: 0a 3b 3b 20 54 68 65 20 71 75 65 75 65 20 69 73  .;; The queue is
ed40: 20 61 20 6c 69 73 74 20 6f 66 20 76 65 63 74 6f   a list of vecto
ed50: 72 73 20 77 68 65 72 65 20 74 68 65 20 7a 65 72  rs where the zer
ed60: 6f 74 68 20 73 6c 6f 74 20 69 6e 64 69 63 61 74  oth slot indicat
ed70: 65 73 20 74 68 65 20 74 79 70 65 20 6f 66 20 71  es the type of q
ed80: 75 65 72 79 20 74 6f 0a 3b 3b 20 61 70 70 6c 79  uery to.;; apply
ed90: 20 61 6e 64 20 74 68 65 20 73 65 63 6f 6e 64 20   and the second 
eda0: 73 6c 6f 74 20 69 73 20 74 68 65 20 74 69 6d 65  slot is the time
edb0: 20 6f 66 20 74 68 65 20 71 75 65 72 79 20 61 6e   of the query an
edc0: 64 20 74 68 65 20 74 68 69 72 64 20 65 6e 74 72  d the third entr
edd0: 79 20 69 73 20 61 20 6c 69 73 74 20 6f 66 20 0a  y is a list of .
ede0: 3b 3b 20 76 61 6c 75 65 73 20 74 6f 20 62 65 20  ;; values to be 
edf0: 61 70 70 6c 69 65 64 0a 3b 3b 0a 28 64 65 66 69  applied.;;.(defi
ee00: 6e 65 20 28 64 62 3a 71 75 65 75 65 2d 77 72 69  ne (db:queue-wri
ee10: 74 65 2d 61 6e 64 2d 77 61 69 74 20 64 62 20 71  te-and-wait db q
ee20: 72 79 2d 73 69 67 20 71 75 65 72 79 20 70 61 72  ry-sig query par
ee30: 61 6d 73 29 0a 20 20 28 6c 65 74 20 28 28 71 75  ams).  (let ((qu
ee40: 65 75 65 2d 6c 65 6e 20 20 30 29 0a 09 28 72 65  eue-len  0)..(re
ee50: 73 20 20 20 20 20 20 20 20 23 66 29 0a 09 28 67  s        #f)..(g
ee60: 6f 74 2d 69 74 20 20 20 20 20 23 66 29 0a 09 28  ot-it     #f)..(
ee70: 71 72 79 2d 70 6b 74 20 20 20 20 28 76 65 63 74  qry-pkt    (vect
ee80: 6f 72 20 71 72 79 2d 73 69 67 20 71 75 65 72 79  or qry-sig query
ee90: 20 70 61 72 61 6d 73 29 29 0a 09 28 73 74 61 72   params))..(star
eea0: 74 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d  t-time (current-
eeb0: 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a 09  milliseconds))..
eec0: 28 74 69 6d 65 6f 75 74 20 20 20 20 28 2b 20 31  (timeout    (+ 1
eed0: 30 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e  0 (current-secon
eee0: 64 73 29 29 29 29 20 3b 3b 20 73 65 74 20 74 68  ds)))) ;; set th
eef0: 65 20 74 69 6d 65 20 6f 75 74 20 74 6f 20 31 30  e time out to 10
ef00: 20 73 65 63 73 20 69 6e 20 66 75 74 75 72 65 0a   secs in future.
ef10: 0a 20 20 20 20 3b 3b 20 50 75 74 20 74 68 65 20  .    ;; Put the 
ef20: 69 74 65 6d 20 69 6e 20 74 68 65 20 71 75 65 75  item in the queu
ef30: 65 20 2a 69 6e 63 6f 6d 69 6e 67 2d 77 72 69 74  e *incoming-writ
ef40: 65 73 2a 20 0a 20 20 20 20 28 6d 75 74 65 78 2d  es* .    (mutex-
ef50: 6c 6f 63 6b 21 20 2a 69 6e 63 6f 6d 69 6e 67 2d  lock! *incoming-
ef60: 6d 75 74 65 78 2a 29 0a 20 20 20 20 28 73 65 74  mutex*).    (set
ef70: 21 20 2a 69 6e 63 6f 6d 69 6e 67 2d 77 72 69 74  ! *incoming-writ
ef80: 65 73 2a 20 28 63 6f 6e 73 20 71 72 79 2d 70 6b  es* (cons qry-pk
ef90: 74 20 2a 69 6e 63 6f 6d 69 6e 67 2d 77 72 69 74  t *incoming-writ
efa0: 65 73 2a 29 29 0a 20 20 20 20 28 73 65 74 21 20  es*)).    (set! 
efb0: 71 75 65 75 65 2d 6c 65 6e 20 28 6c 65 6e 67 74  queue-len (lengt
efc0: 68 20 2a 69 6e 63 6f 6d 69 6e 67 2d 77 72 69 74  h *incoming-writ
efd0: 65 73 2a 29 29 0a 20 20 20 20 28 6d 75 74 65 78  es*)).    (mutex
efe0: 2d 75 6e 6c 6f 63 6b 21 20 2a 69 6e 63 6f 6d 69  -unlock! *incomi
eff0: 6e 67 2d 6d 75 74 65 78 2a 29 0a 0a 20 20 20 20  ng-mutex*)..    
f000: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66  (debug:print-inf
f010: 6f 20 37 20 22 43 75 72 72 65 6e 74 20 77 72 69  o 7 "Current wri
f020: 74 65 20 71 75 65 75 65 20 6c 65 6e 67 74 68 20  te queue length 
f030: 69 73 20 22 20 71 75 65 75 65 2d 6c 65 6e 29 0a  is " queue-len).
f040: 0a 20 20 20 20 3b 3b 20 70 6f 6c 6c 20 66 6f 72  .    ;; poll for
f050: 20 74 68 65 20 77 72 69 74 65 20 74 6f 20 63 6f   the write to co
f060: 6d 70 6c 65 74 65 2c 20 74 69 6d 65 6f 75 74 20  mplete, timeout 
f070: 61 66 74 65 72 20 31 30 20 73 65 63 6f 6e 64 73  after 10 seconds
f080: 0a 20 20 20 20 3b 3b 20 70 65 72 69 6f 64 69 63  .    ;; periodic
f090: 20 66 6c 75 73 68 69 6e 67 20 6f 66 20 74 68 65   flushing of the
f0a0: 20 71 75 65 75 65 20 69 73 20 74 61 6b 65 6e 20   queue is taken 
f0b0: 63 61 72 65 20 6f 66 20 62 79 20 0a 20 20 20 20  care of by .    
f0c0: 3b 3b 20 64 62 3a 66 6c 75 73 68 2d 71 75 65 75  ;; db:flush-queu
f0d0: 65 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20  e.    (let loop 
f0e0: 28 29 0a 20 20 20 20 20 20 28 74 68 72 65 61 64  ().      (thread
f0f0: 2d 73 6c 65 65 70 21 20 30 2e 31 29 0a 20 20 20  -sleep! 0.1).   
f100: 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20     (mutex-lock! 
f110: 2a 63 6f 6d 70 6c 65 74 65 64 2d 6d 75 74 65 78  *completed-mutex
f120: 2a 29 0a 20 20 20 20 20 20 28 69 66 20 28 68 61  *).      (if (ha
f130: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66  sh-table-ref/def
f140: 61 75 6c 74 20 2a 63 6f 6d 70 6c 65 74 65 64 2d  ault *completed-
f150: 77 72 69 74 65 73 2a 20 71 72 79 2d 73 69 67 20  writes* qry-sig 
f160: 23 66 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20  #f)..  (begin.. 
f170: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 64     (hash-table-d
f180: 65 6c 65 74 65 21 20 2a 63 6f 6d 70 6c 65 74 65  elete! *complete
f190: 64 2d 77 72 69 74 65 73 2a 20 71 72 79 2d 73 69  d-writes* qry-si
f1a0: 67 29 0a 09 20 20 20 20 28 73 65 74 21 20 67 6f  g)..    (set! go
f1b0: 74 2d 69 74 20 23 74 29 29 29 0a 20 20 20 20 20  t-it #t))).     
f1c0: 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20   (mutex-unlock! 
f1d0: 2a 63 6f 6d 70 6c 65 74 65 64 2d 6d 75 74 65 78  *completed-mutex
f1e0: 2a 29 0a 20 20 20 20 20 20 28 69 66 20 28 61 6e  *).      (if (an
f1f0: 64 20 28 6e 6f 74 20 67 6f 74 2d 69 74 29 0a 09  d (not got-it)..
f200: 20 20 20 20 20 20 20 28 3c 20 28 63 75 72 72 65         (< (curre
f210: 6e 74 2d 73 65 63 6f 6e 64 73 29 20 74 69 6d 65  nt-seconds) time
f220: 6f 75 74 29 29 0a 09 20 20 28 6c 6f 6f 70 29 29  out))..  (loop))
f230: 29 0a 20 20 20 20 28 73 65 74 21 20 2a 6e 75 6d  ).    (set! *num
f240: 62 65 72 2d 6f 66 2d 77 72 69 74 65 73 2a 20 20  ber-of-writes*  
f250: 20 28 2b 20 2a 6e 75 6d 62 65 72 2d 6f 66 2d 77   (+ *number-of-w
f260: 72 69 74 65 73 2a 20 20 20 31 29 29 0a 20 20 20  rites*   1)).   
f270: 20 28 73 65 74 21 20 2a 77 72 69 74 65 73 2d 74   (set! *writes-t
f280: 6f 74 61 6c 2d 64 65 6c 61 79 2a 20 28 2b 20 2a  otal-delay* (+ *
f290: 77 72 69 74 65 73 2d 74 6f 74 61 6c 2d 64 65 6c  writes-total-del
f2a0: 61 79 2a 20 31 29 29 0a 20 20 20 20 67 6f 74 2d  ay* 1)).    got-
f2b0: 69 74 29 29 0a 09 20 20 0a 28 64 65 66 69 6e 65  it))..  .(define
f2c0: 20 28 64 62 3a 70 72 6f 63 65 73 73 2d 71 75 65   (db:process-que
f2d0: 75 65 2d 69 74 65 6d 20 64 62 20 69 74 65 6d 29  ue-item db item)
f2e0: 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 6d 74 2d  .  (let* ((stmt-
f2f0: 6b 65 79 20 20 20 20 20 20 20 28 63 64 62 3a 70  key       (cdb:p
f300: 61 63 6b 65 74 2d 67 65 74 2d 71 74 79 70 65 20  acket-get-qtype 
f310: 69 74 65 6d 29 29 0a 09 20 28 71 72 79 2d 73 69  item)).. (qry-si
f320: 67 20 20 20 20 20 20 20 20 28 63 64 62 3a 70 61  g        (cdb:pa
f330: 63 6b 65 74 2d 67 65 74 2d 71 75 65 72 79 2d 73  cket-get-query-s
f340: 69 67 20 69 74 65 6d 29 29 0a 09 20 28 72 65 74  ig item)).. (ret
f350: 75 72 6e 2d 61 64 64 72 65 73 73 20 28 63 64 62  urn-address (cdb
f360: 3a 70 61 63 6b 65 74 2d 67 65 74 2d 63 6c 69 65  :packet-get-clie
f370: 6e 74 2d 73 69 67 20 69 74 65 6d 29 29 0a 09 20  nt-sig item)).. 
f380: 28 70 61 72 61 6d 73 20 20 20 20 20 20 20 20 20  (params         
f390: 28 63 64 62 3a 70 61 63 6b 65 74 2d 67 65 74 2d  (cdb:packet-get-
f3a0: 70 61 72 61 6d 73 20 69 74 65 6d 29 29 0a 09 20  params item)).. 
f3b0: 28 71 75 65 72 79 20 20 20 20 20 20 20 20 20 20  (query          
f3c0: 28 6c 65 74 20 28 28 71 20 28 61 6c 69 73 74 2d  (let ((q (alist-
f3d0: 72 65 66 20 73 74 6d 74 2d 6b 65 79 20 64 62 3a  ref stmt-key db:
f3e0: 71 75 65 72 69 65 73 29 29 29 0a 09 09 09 20 20  queries)))....  
f3f0: 20 28 69 66 20 71 20 28 63 61 72 20 71 29 20 23   (if q (car q) #
f400: 66 29 29 29 29 0a 20 20 20 20 28 64 65 62 75 67  f)))).    (debug
f410: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22  :print-info 11 "
f420: 53 70 65 63 69 61 6c 20 71 75 65 72 69 65 73 2f  Special queries/
f430: 72 65 71 75 65 73 74 73 20 73 74 6d 74 2d 6b 65  requests stmt-ke
f440: 79 3d 22 20 73 74 6d 74 2d 6b 65 79 20 22 2c 20  y=" stmt-key ", 
f450: 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 3d 22  return-address="
f460: 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20   return-address 
f470: 22 2c 20 71 75 65 72 79 3d 22 20 71 75 65 72 79  ", query=" query
f480: 20 22 2c 20 70 61 72 61 6d 73 3d 22 20 70 61 72   ", params=" par
f490: 61 6d 73 29 0a 20 20 20 20 28 69 66 20 71 75 65  ams).    (if que
f4a0: 72 79 0a 09 3b 3b 20 68 61 6e 64 20 71 75 65 72  ry..;; hand quer
f4b0: 69 65 73 20 6f 66 66 20 74 6f 20 74 68 65 20 77  ies off to the w
f4c0: 72 69 74 65 20 71 75 65 75 65 0a 09 28 6c 65 74  rite queue..(let
f4d0: 20 28 28 72 65 73 70 6f 6e 73 65 20 28 63 61 73   ((response (cas
f4e0: 65 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 70  e *transport-typ
f4f0: 65 2a 0a 09 09 09 20 20 28 28 68 74 74 70 29 0a  e*....  ((http).
f500: 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 69  ...   (debug:pri
f510: 6e 74 2d 69 6e 66 6f 20 37 20 22 51 75 65 75 69  nt-info 7 "Queui
f520: 6e 67 20 69 74 65 6d 20 22 20 69 74 65 6d 20 22  ng item " item "
f530: 20 66 6f 72 20 77 72 61 70 70 65 64 20 77 72 69   for wrapped wri
f540: 74 65 22 29 0a 09 09 09 20 20 20 28 64 62 3a 71  te")....   (db:q
f550: 75 65 75 65 2d 77 72 69 74 65 2d 61 6e 64 2d 77  ueue-write-and-w
f560: 61 69 74 20 64 62 20 71 72 79 2d 73 69 67 20 71  ait db qry-sig q
f570: 75 65 72 79 20 70 61 72 61 6d 73 29 29 0a 09 09  uery params))...
f580: 09 20 20 28 65 6c 73 65 20 20 0a 09 09 09 20 20  .  (else  ....  
f590: 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a   (apply sqlite3:
f5a0: 65 78 65 63 75 74 65 20 64 62 20 71 75 65 72 79  execute db query
f5b0: 20 70 61 72 61 6d 73 29 0a 09 09 09 20 20 20 23   params)....   #
f5c0: 74 29 29 29 29 0a 09 20 20 28 64 65 62 75 67 3a  t))))..  (debug:
f5d0: 70 72 69 6e 74 2d 69 6e 66 6f 20 37 20 22 52 65  print-info 7 "Re
f5e0: 63 65 69 76 65 64 20 22 20 72 65 73 70 6f 6e 73  ceived " respons
f5f0: 65 20 22 20 66 72 6f 6d 20 77 72 61 70 70 65 64  e " from wrapped
f600: 20 77 72 69 74 65 22 29 0a 09 20 20 28 73 65 72   write")..  (ser
f610: 76 65 72 3a 72 65 70 6c 79 20 72 65 74 75 72 6e  ver:reply return
f620: 2d 61 64 64 72 65 73 73 20 71 72 79 2d 73 69 67  -address qry-sig
f630: 20 72 65 73 70 6f 6e 73 65 20 72 65 73 70 6f 6e   response respon
f640: 73 65 29 29 0a 09 3b 3b 20 6f 74 68 65 72 77 69  se))..;; otherwi
f650: 73 65 20 69 66 20 61 70 70 72 6f 70 72 69 61 74  se if appropriat
f660: 65 20 66 6c 75 73 68 20 74 68 65 20 71 75 65 75  e flush the queu
f670: 65 20 28 74 68 69 73 20 69 73 20 61 20 72 65 61  e (this is a rea
f680: 64 20 6f 72 20 63 6f 6d 70 6c 65 78 20 71 75 65  d or complex que
f690: 72 79 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28  ry)..(begin..  (
f6a0: 63 6f 6e 64 0a 09 20 20 20 28 28 6d 65 6d 62 65  cond..   ((membe
f6b0: 72 20 73 74 6d 74 2d 6b 65 79 20 64 62 3a 73 70  r stmt-key db:sp
f6c0: 65 63 69 61 6c 2d 71 75 65 72 69 65 73 29 0a 09  ecial-queries)..
f6d0: 20 20 20 20 28 6c 65 74 20 28 28 73 74 61 72 74      (let ((start
f6e0: 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d 6d 69  time (current-mi
f6f0: 6c 6c 69 73 65 63 6f 6e 64 73 29 29 29 0a 09 20  lliseconds))).. 
f700: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e       (debug:prin
f710: 74 2d 69 6e 66 6f 20 31 31 20 22 48 61 6e 64 6c  t-info 11 "Handl
f720: 69 6e 67 20 73 70 65 63 69 61 6c 20 73 74 61 74  ing special stat
f730: 65 6d 65 6e 74 20 22 20 73 74 6d 74 2d 6b 65 79  ement " stmt-key
f740: 29 0a 09 20 20 20 20 20 20 28 63 61 73 65 20 73  )..      (case s
f750: 74 6d 74 2d 6b 65 79 0a 09 09 28 28 69 6d 6d 65  tmt-key...((imme
f760: 64 69 61 74 65 29 0a 09 09 20 3b 3b 20 54 68 69  diate)... ;; Thi
f770: 73 20 69 73 20 61 20 72 65 61 64 20 6f 72 20 6d  s is a read or m
f780: 69 78 65 64 20 72 65 61 64 2d 77 72 69 74 65 20  ixed read-write 
f790: 71 75 65 72 79 2c 20 6d 75 73 74 20 63 6c 65 61  query, must clea
f7a0: 72 20 74 68 65 20 63 61 63 68 65 0a 09 09 20 28  r the cache... (
f7b0: 63 61 73 65 20 2a 74 72 61 6e 73 70 6f 72 74 2d  case *transport-
f7c0: 74 79 70 65 2a 0a 09 09 20 20 20 28 28 68 74 74  type*...   ((htt
f7d0: 70 29 0a 09 09 20 20 20 20 28 6d 75 74 65 78 2d  p)...    (mutex-
f7e0: 6c 6f 63 6b 21 20 2a 64 62 3a 70 72 6f 63 65 73  lock! *db:proces
f7f0: 73 2d 71 75 65 75 65 2d 6d 75 74 65 78 2a 29 0a  s-queue-mutex*).
f800: 09 09 20 20 20 20 28 64 62 3a 70 72 6f 63 65 73  ..    (db:proces
f810: 73 2d 63 61 63 68 65 64 2d 77 72 69 74 65 73 20  s-cached-writes 
f820: 64 62 29 0a 09 09 20 20 20 20 28 6d 75 74 65 78  db)...    (mutex
f830: 2d 75 6e 6c 6f 63 6b 21 20 2a 64 62 3a 70 72 6f  -unlock! *db:pro
f840: 63 65 73 73 2d 71 75 65 75 65 2d 6d 75 74 65 78  cess-queue-mutex
f850: 2a 29 29 29 0a 09 09 20 28 6c 65 74 2a 20 28 28  *)))... (let* ((
f860: 70 72 6f 63 20 20 20 20 20 20 28 63 61 72 20 70  proc      (car p
f870: 61 72 61 6d 73 29 29 0a 09 09 09 28 72 65 6d 70  arams))....(remp
f880: 61 72 61 6d 73 20 28 63 64 72 20 70 61 72 61 6d  arams (cdr param
f890: 73 29 29 0a 09 09 09 3b 3b 20 77 65 20 61 72 65  s))....;; we are
f8a0: 20 62 65 69 6e 67 20 68 61 6e 64 65 64 20 61 20   being handed a 
f8b0: 70 72 6f 63 65 64 75 72 65 20 73 6f 20 63 61 6c  procedure so cal
f8c0: 6c 20 69 74 0a 09 09 09 3b 3b 20 28 64 65 62 75  l it....;; (debu
f8d0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20  g:print-info 11 
f8e0: 22 52 75 6e 6e 69 6e 67 20 28 61 70 70 6c 79 20  "Running (apply 
f8f0: 22 20 70 72 6f 63 20 22 20 22 20 72 65 6d 70 61  " proc " " rempa
f900: 72 61 6d 73 20 22 29 22 29 0a 09 09 09 28 72 65  rams ")")....(re
f910: 73 75 6c 74 20 28 73 65 72 76 65 72 3a 72 65 70  sult (server:rep
f920: 6c 79 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73  ly return-addres
f930: 73 20 71 72 79 2d 73 69 67 20 23 74 20 28 61 70  s qry-sig #t (ap
f940: 70 6c 79 20 70 72 6f 63 20 72 65 6d 70 61 72 61  ply proc rempara
f950: 6d 73 29 29 29 29 0a 09 09 20 20 20 28 73 65 74  ms))))...   (set
f960: 21 20 2a 74 6f 74 61 6c 2d 6e 6f 6e 2d 77 72 69  ! *total-non-wri
f970: 74 65 2d 64 65 6c 61 79 2a 20 28 2b 20 2a 74 6f  te-delay* (+ *to
f980: 74 61 6c 2d 6e 6f 6e 2d 77 72 69 74 65 2d 64 65  tal-non-write-de
f990: 6c 61 79 2a 20 28 2d 20 28 63 75 72 72 65 6e 74  lay* (- (current
f9a0: 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73  -milliseconds) s
f9b0: 74 61 72 74 74 69 6d 65 29 29 29 20 0a 09 09 20  tarttime))) ... 
f9c0: 20 20 28 73 65 74 21 20 2a 6e 75 6d 62 65 72 2d    (set! *number-
f9d0: 6e 6f 6e 2d 77 72 69 74 65 2d 71 75 65 72 69 65  non-write-querie
f9e0: 73 2a 20 28 2b 20 2a 6e 75 6d 62 65 72 2d 6e 6f  s* (+ *number-no
f9f0: 6e 2d 77 72 69 74 65 2d 71 75 65 72 69 65 73 2a  n-write-queries*
fa00: 20 31 29 29 0a 09 09 20 20 20 72 65 73 75 6c 74   1))...   result
fa10: 29 29 0a 09 09 28 28 6c 6f 67 69 6e 29 0a 09 09  ))...((login)...
fa20: 20 28 69 66 20 28 3c 20 28 6c 65 6e 67 74 68 20   (if (< (length 
fa30: 70 61 72 61 6d 73 29 20 33 29 20 3b 3b 20 73 68  params) 3) ;; sh
fa40: 6f 75 6c 64 20 67 65 74 20 74 6f 70 70 61 74 68  ould get toppath
fa50: 2c 20 76 65 72 73 69 6f 6e 20 61 6e 64 20 73 69  , version and si
fa60: 67 6e 61 74 75 72 65 0a 09 09 20 20 20 20 20 28  gnature...     (
fa70: 73 65 72 76 65 72 3a 72 65 70 6c 79 20 72 65 74  server:reply ret
fa80: 75 72 6e 2d 61 64 64 72 65 73 73 20 71 72 79 2d  urn-address qry-
fa90: 73 69 67 20 27 28 23 66 20 22 6c 6f 67 69 6e 20  sig '(#f "login 
faa0: 66 61 69 6c 65 64 20 64 75 65 20 74 6f 20 6d 69  failed due to mi
fab0: 73 73 69 6e 67 20 70 61 72 61 6d 73 22 29 29 20  ssing params")) 
fac0: 3b 3b 20 6d 69 73 73 69 6e 67 20 70 61 72 61 6d  ;; missing param
fad0: 73 0a 09 09 20 20 20 20 20 28 6c 65 74 20 28 28  s...     (let ((
fae0: 63 61 6c 6c 69 6e 67 2d 70 61 74 68 20 28 63 61  calling-path (ca
faf0: 72 20 20 20 70 61 72 61 6d 73 29 29 0a 09 09 09  r   params))....
fb00: 20 20 20 28 63 61 6c 6c 69 6e 67 2d 76 65 72 73     (calling-vers
fb10: 20 28 63 61 64 72 20 20 70 61 72 61 6d 73 29 29   (cadr  params))
fb20: 0a 09 09 09 20 20 20 28 63 6c 69 65 6e 74 2d 6b  ....   (client-k
fb30: 65 79 20 20 20 28 63 61 64 64 72 20 70 61 72 61  ey   (caddr para
fb40: 6d 73 29 29 29 0a 09 09 20 20 20 20 20 20 20 28  ms)))...       (
fb50: 69 66 20 28 61 6e 64 20 28 65 71 75 61 6c 3f 20  if (and (equal? 
fb60: 63 61 6c 6c 69 6e 67 2d 70 61 74 68 20 2a 74 6f  calling-path *to
fb70: 70 70 61 74 68 2a 29 0a 09 09 09 09 28 65 71 75  ppath*).....(equ
fb80: 61 6c 3f 20 6d 65 67 61 74 65 73 74 2d 76 65 72  al? megatest-ver
fb90: 73 69 6f 6e 20 63 61 6c 6c 69 6e 67 2d 76 65 72  sion calling-ver
fba0: 73 29 29 0a 09 09 09 20 20 20 28 62 65 67 69 6e  s))....   (begin
fbb0: 0a 09 09 09 20 20 20 20 20 28 68 61 73 68 2d 74  ....     (hash-t
fbc0: 61 62 6c 65 2d 73 65 74 21 20 2a 6c 6f 67 67 65  able-set! *logge
fbd0: 64 2d 69 6e 2d 63 6c 69 65 6e 74 73 2a 20 63 6c  d-in-clients* cl
fbe0: 69 65 6e 74 2d 6b 65 79 20 28 63 75 72 72 65 6e  ient-key (curren
fbf0: 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 09 09 20  t-seconds)).... 
fc00: 20 20 20 20 28 73 65 72 76 65 72 3a 72 65 70 6c      (server:repl
fc10: 79 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73  y return-address
fc20: 20 71 72 79 2d 73 69 67 20 23 74 20 27 28 23 74   qry-sig #t '(#t
fc30: 20 22 73 75 63 63 65 73 73 66 75 6c 20 6c 6f 67   "successful log
fc40: 69 6e 22 29 29 29 20 20 20 20 20 20 3b 3b 20 70  in")))      ;; p
fc50: 61 74 68 20 6d 61 74 63 68 65 73 20 2d 20 70 61  ath matches - pa
fc60: 73 73 21 20 53 68 6f 75 6c 64 20 76 65 74 20 74  ss! Should vet t
fc70: 68 65 20 63 61 6c 6c 65 72 20 61 74 20 74 68 69  he caller at thi
fc80: 73 20 74 69 6d 65 20 2e 2e 2e 0a 09 09 09 20 20  s time .......  
fc90: 20 28 73 65 72 76 65 72 3a 72 65 70 6c 79 20 72   (server:reply r
fca0: 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 71 72  eturn-address qr
fcb0: 79 2d 73 69 67 20 23 66 20 28 6c 69 73 74 20 23  y-sig #f (list #
fcc0: 66 20 28 63 6f 6e 63 20 22 4c 6f 67 69 6e 20 66  f (conc "Login f
fcd0: 61 69 6c 65 64 20 64 75 65 20 74 6f 20 6d 69 73  ailed due to mis
fce0: 6d 61 74 63 68 20 70 61 74 68 73 3a 20 22 20 63  match paths: " c
fcf0: 61 6c 6c 69 6e 67 2d 70 61 74 68 20 22 2c 20 22  alling-path ", "
fd00: 20 2a 74 6f 70 70 61 74 68 2a 29 29 29 29 29 29   *toppath*))))))
fd10: 29 0a 09 09 28 28 66 6c 75 73 68 20 73 79 6e 63  )...((flush sync
fd20: 29 0a 09 09 20 28 73 65 72 76 65 72 3a 72 65 70  )... (server:rep
fd30: 6c 79 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73  ly return-addres
fd40: 73 20 71 72 79 2d 73 69 67 20 23 74 20 31 29 29  s qry-sig #t 1))
fd50: 20 3b 3b 20 28 6c 65 6e 67 74 68 20 64 61 74 61   ;; (length data
fd60: 29 29 29 0a 09 09 28 28 73 65 74 2d 76 65 72 62  )))...((set-verb
fd70: 6f 73 69 74 79 29 0a 09 09 20 28 73 65 74 21 20  osity)... (set! 
fd80: 2a 76 65 72 62 6f 73 69 74 79 2a 20 28 63 61 72  *verbosity* (car
fd90: 20 70 61 72 61 6d 73 29 29 0a 09 09 20 28 73 65   params))... (se
fda0: 72 76 65 72 3a 72 65 70 6c 79 20 72 65 74 75 72  rver:reply retur
fdb0: 6e 2d 61 64 64 72 65 73 73 20 71 72 79 2d 73 69  n-address qry-si
fdc0: 67 20 23 74 20 27 28 23 74 20 2a 76 65 72 62 6f  g #t '(#t *verbo
fdd0: 73 69 74 79 2a 29 29 29 0a 09 09 28 28 6b 69 6c  sity*)))...((kil
fde0: 6c 73 65 72 76 65 72 29 0a 09 09 20 28 64 65 62  lserver)... (deb
fdf0: 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e  ug:print 0 "WARN
fe00: 49 4e 47 3a 20 53 65 72 76 65 72 20 67 6f 69 6e  ING: Server goin
fe10: 67 20 64 6f 77 6e 20 69 6e 20 31 35 20 73 65 63  g down in 15 sec
fe20: 6f 6e 64 73 20 62 79 20 75 73 65 72 20 72 65 71  onds by user req
fe30: 75 65 73 74 21 22 29 0a 09 09 20 28 6f 70 65 6e  uest!")... (open
fe40: 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73  -run-close tasks
fe50: 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74  :server-deregist
fe60: 65 72 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62  er tasks:open-db
fe70: 20 0a 09 09 09 09 20 28 63 61 72 20 2a 72 75 6e   ..... (car *run
fe80: 72 65 6d 6f 74 65 2a 29 0a 09 09 09 09 20 70 75  remote*)..... pu
fe90: 6c 6c 70 6f 72 74 3a 20 28 63 61 64 72 20 2a 72  llport: (cadr *r
fea0: 75 6e 72 65 6d 6f 74 65 2a 29 29 0a 09 09 20 28  unremote*))... (
feb0: 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 28 6d  thread-start! (m
fec0: 61 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 6d 62  ake-thread (lamb
fed0: 64 61 20 28 29 28 74 68 72 65 61 64 2d 73 6c 65  da ()(thread-sle
fee0: 65 70 21 20 31 35 29 28 65 78 69 74 29 29 29 29  ep! 15)(exit))))
fef0: 0a 09 09 20 28 73 65 72 76 65 72 3a 72 65 70 6c  ... (server:repl
ff00: 79 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73  y return-address
ff10: 20 71 72 79 2d 73 69 67 20 23 74 20 27 28 23 74   qry-sig #t '(#t
ff20: 20 22 65 78 69 74 20 70 72 6f 63 65 73 73 20 73   "exit process s
ff30: 74 61 72 74 65 64 22 29 29 29 0a 09 09 28 65 6c  tarted")))...(el
ff40: 73 65 20 3b 3b 20 6e 6f 74 20 61 20 63 6f 6d 6d  se ;; not a comm
ff50: 61 6e 64 2c 20 69 2e 65 2e 20 69 73 20 61 20 71  and, i.e. is a q
ff60: 75 65 72 79 0a 09 09 20 28 64 65 62 75 67 3a 70  uery... (debug:p
ff70: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 55  rint 0 "ERROR: U
ff80: 6e 72 65 63 6f 67 6e 69 73 65 64 20 71 75 65 72  nrecognised quer
ff90: 79 2f 63 6f 6d 6d 61 6e 64 20 22 20 73 74 6d 74  y/command " stmt
ffa0: 2d 6b 65 79 29 0a 09 09 20 28 73 65 72 76 65 72  -key)... (server
ffb0: 3a 72 65 70 6c 79 20 72 65 74 75 72 6e 2d 61 64  :reply return-ad
ffc0: 64 72 65 73 73 20 71 72 79 2d 73 69 67 20 23 66  dress qry-sig #f
ffd0: 20 27 66 61 69 6c 65 64 29 29 29 29 29 0a 09 20   'failed))))).. 
ffe0: 20 20 28 65 6c 73 65 0a 09 20 20 20 20 28 64 65    (else..    (de
fff0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31  bug:print-info 1
10000 31 20 22 45 78 65 63 75 74 69 6e 67 20 22 20 73  1 "Executing " s
10010 74 6d 74 2d 6b 65 79 20 22 20 66 6f 72 20 22 20  tmt-key " for " 
10020 70 61 72 61 6d 73 29 0a 09 20 20 20 20 28 61 70  params)..    (ap
10030 70 6c 79 20 73 71 6c 69 74 65 33 3a 65 78 65 63  ply sqlite3:exec
10040 75 74 65 20 28 68 61 73 68 2d 74 61 62 6c 65 2d  ute (hash-table-
10050 72 65 66 20 71 75 65 72 69 65 73 20 73 74 6d 74  ref queries stmt
10060 2d 6b 65 79 29 20 70 61 72 61 6d 73 29 0a 09 20  -key) params).. 
10070 20 20 20 28 73 65 72 76 65 72 3a 72 65 70 6c 79     (server:reply
10080 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20   return-address 
10090 71 72 79 2d 73 69 67 20 23 74 20 23 74 29 29 29  qry-sig #t #t)))
100a0 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64  ))))..(define (d
100b0 62 3a 74 65 73 74 2d 67 65 74 2d 72 65 63 6f 72  b:test-get-recor
100c0 64 73 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 69 6c  ds-for-index-fil
100d0 65 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74  e db run-id test
100e0 2d 6e 61 6d 65 29 0a 20 20 28 6c 65 74 20 28 28  -name).  (let ((
100f0 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 73  res '())).    (s
10100 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d  qlite3:for-each-
10110 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 64  row .     (lambd
10120 61 20 28 69 64 20 69 74 65 6d 70 61 74 68 20 73  a (id itempath s
10130 74 61 74 65 20 73 74 61 74 75 73 20 72 75 6e 5f  tate status run_
10140 64 75 72 61 74 69 6f 6e 20 6c 6f 67 66 20 63 6f  duration logf co
10150 6d 6d 65 6e 74 29 0a 20 20 20 20 20 20 20 28 73  mment).       (s
10160 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 76  et! res (cons (v
10170 65 63 74 6f 72 20 69 64 20 69 74 65 6d 70 61 74  ector id itempat
10180 68 20 73 74 61 74 65 20 73 74 61 74 75 73 20 72  h state status r
10190 75 6e 5f 64 75 72 61 74 69 6f 6e 20 6c 6f 67 66  un_duration logf
101a0 20 63 6f 6d 6d 65 6e 74 29 20 72 65 73 29 29 29   comment) res)))
101b0 0a 20 20 20 20 20 64 62 0a 20 20 20 20 20 22 53  .     db.     "S
101c0 45 4c 45 43 54 20 69 64 2c 69 74 65 6d 5f 70 61  ELECT id,item_pa
101d0 74 68 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c  th,state,status,
101e0 72 75 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 69 6e  run_duration,fin
101f0 61 6c 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 6e 74 20  al_logf,comment 
10200 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45  FROM tests WHERE
10210 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65   run_id=? AND te
10220 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65  stname=? AND ite
10230 6d 5f 70 61 74 68 20 21 3d 20 27 27 3b 22 0a 20  m_path != '';". 
10240 20 20 20 20 72 75 6e 2d 69 64 20 74 65 73 74 2d      run-id test-
10250 6e 61 6d 65 29 0a 20 20 20 20 72 65 73 29 29 0a  name).    res)).
10260 0a 3b 3b 20 52 6f 6c 6c 75 70 20 74 68 65 20 70  .;; Rollup the p
10270 61 73 73 2f 66 61 69 6c 20 63 6f 75 6e 74 73 20  ass/fail counts 
10280 66 72 6f 6d 20 69 74 65 6d 69 7a 65 64 20 74 65  from itemized te
10290 73 74 73 20 69 6e 74 6f 20 66 61 69 6c 5f 63 6f  sts into fail_co
102a0 75 6e 74 20 61 6e 64 20 70 61 73 73 5f 63 6f 75  unt and pass_cou
102b0 6e 74 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 72  nt.(define (db:r
102c0 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 61 69 6c  oll-up-pass-fail
102d0 2d 63 6f 75 6e 74 73 20 64 62 20 72 75 6e 2d 69  -counts db run-i
102e0 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d  d test-name item
102f0 2d 70 61 74 68 20 73 74 61 74 75 73 29 0a 20 20  -path status).  
10300 3b 3b 20 28 63 64 62 3a 66 6c 75 73 68 2d 71 75  ;; (cdb:flush-qu
10310 65 75 65 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29  eue *runremote*)
10320 0a 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74  .  (if (and (not
10330 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61   (equal? item-pa
10340 74 68 20 22 22 29 29 0a 09 20 20 20 28 6d 65 6d  th ""))..   (mem
10350 62 65 72 20 73 74 61 74 75 73 20 27 28 22 50 41  ber status '("PA
10360 53 53 22 20 22 57 41 52 4e 22 20 22 46 41 49 4c  SS" "WARN" "FAIL
10370 22 20 22 57 41 49 56 45 44 22 20 22 52 55 4e 4e  " "WAIVED" "RUNN
10380 49 4e 47 22 20 22 43 48 45 43 4b 22 20 22 53 4b  ING" "CHECK" "SK
10390 49 50 22 29 29 29 0a 20 20 20 20 20 20 28 62 65  IP"))).      (be
103a0 67 69 6e 0a 09 28 73 71 6c 69 74 65 33 3a 65 78  gin..(sqlite3:ex
103b0 65 63 75 74 65 20 0a 09 20 64 62 0a 09 20 22 55  ecute .. db.. "U
103c0 50 44 41 54 45 20 74 65 73 74 73 20 0a 20 20 20  PDATE tests .   
103d0 20 20 20 20 20 20 20 20 20 20 53 45 54 20 66 61            SET fa
103e0 69 6c 5f 63 6f 75 6e 74 3d 28 53 45 4c 45 43 54  il_count=(SELECT
103f0 20 63 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20   count(id) FROM 
10400 74 65 73 74 73 20 57 48 45 52 45 20 72 75 6e 5f  tests WHERE run_
10410 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d  id=? AND testnam
10420 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74  e=? AND item_pat
10430 68 20 21 3d 20 27 27 20 41 4e 44 20 73 74 61 74  h != '' AND stat
10440 75 73 3d 27 46 41 49 4c 27 29 2c 0a 20 20 20 20  us='FAIL'),.    
10450 20 20 20 20 20 20 20 20 20 20 20 20 20 70 61 73               pas
10460 73 5f 63 6f 75 6e 74 3d 28 53 45 4c 45 43 54 20  s_count=(SELECT 
10470 63 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 74  count(id) FROM t
10480 65 73 74 73 20 57 48 45 52 45 20 72 75 6e 5f 69  ests WHERE run_i
10490 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65  d=? AND testname
104a0 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68  =? AND item_path
104b0 20 21 3d 20 27 27 20 41 4e 44 20 73 74 61 74 75   != '' AND statu
104c0 73 20 49 4e 20 28 27 50 41 53 53 27 2c 27 57 41  s IN ('PASS','WA
104d0 52 4e 27 2c 27 57 41 49 56 45 44 27 29 29 0a 20  RN','WAIVED')). 
104e0 20 20 20 20 20 20 20 20 20 20 20 20 57 48 45 52              WHER
104f0 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74  E run_id=? AND t
10500 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74  estname=? AND it
10510 65 6d 5f 70 61 74 68 3d 27 27 3b 22 0a 09 20 72  em_path='';".. r
10520 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20  un-id test-name 
10530 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65  run-id test-name
10540 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d   run-id test-nam
10550 65 29 0a 20 20 20 20 20 20 20 20 3b 3b 20 28 74  e).        ;; (t
10560 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 31  hread-sleep! 0.1
10570 29 20 3b 3b 20 67 69 76 65 20 6f 74 68 65 72 20  ) ;; give other 
10580 70 72 6f 63 65 73 73 65 73 20 61 20 63 68 61 6e  processes a chan
10590 63 65 20 68 65 72 65 2c 20 6e 6f 2c 20 62 65 74  ce here, no, bet
105a0 74 65 72 20 74 6f 20 62 65 20 64 6f 6e 65 20 41  ter to be done A
105b0 53 41 50 3f 0a 09 28 69 66 20 28 65 71 75 61 6c  SAP?..(if (equal
105c0 3f 20 73 74 61 74 75 73 20 22 52 55 4e 4e 49 4e  ? status "RUNNIN
105d0 47 22 29 20 3b 3b 20 72 75 6e 6e 69 6e 67 20 74  G") ;; running t
105e0 61 6b 65 73 20 70 72 69 6f 72 69 74 79 20 6f 76  akes priority ov
105f0 65 72 20 61 6c 6c 20 6f 74 68 65 72 20 73 74 61  er all other sta
10600 74 65 73 2c 20 66 6f 72 63 65 20 74 68 65 20 74  tes, force the t
10610 65 73 74 20 73 74 61 74 65 20 74 6f 20 52 55 4e  est state to RUN
10620 4e 49 4e 47 0a 09 20 20 20 20 28 73 71 6c 69 74  NING..    (sqlit
10630 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 55  e3:execute db "U
10640 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20  PDATE tests SET 
10650 73 74 61 74 65 3d 3f 20 57 48 45 52 45 20 72 75  state=? WHERE ru
10660 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e  n_id=? AND testn
10670 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70  ame=? AND item_p
10680 61 74 68 3d 27 27 3b 22 20 22 52 55 4e 4e 49 4e  ath='';" "RUNNIN
10690 47 22 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e  G" run-id test-n
106a0 61 6d 65 29 0a 09 20 20 20 20 28 73 71 6c 69 74  ame)..    (sqlit
106b0 65 33 3a 65 78 65 63 75 74 65 0a 09 20 20 20 20  e3:execute..    
106c0 20 64 62 0a 09 20 20 20 20 20 22 55 50 44 41 54   db..     "UPDAT
106d0 45 20 74 65 73 74 73 0a 20 20 20 20 20 20 20 20  E tests.        
106e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 53                 S
106f0 45 54 20 73 74 61 74 65 3d 43 41 53 45 20 0a 20  ET state=CASE . 
10700 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10710 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10720 20 20 57 48 45 4e 20 28 53 45 4c 45 43 54 20 63    WHEN (SELECT c
10730 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 74 65  ount(id) FROM te
10740 73 74 73 20 0a 20 20 20 20 20 20 20 20 20 20 20  sts .           
10750 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10760 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10770 20 20 20 20 20 57 48 45 52 45 20 72 75 6e 5f 69       WHERE run_i
10780 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65  d=? AND testname
10790 3d 3f 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  =?.             
107a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
107b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
107c0 20 20 20 20 20 20 20 20 41 4e 44 20 69 74 65 6d          AND item
107d0 5f 70 61 74 68 20 21 3d 20 27 27 20 0a 20 20 20  _path != '' .   
107e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
107f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10800 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10810 20 20 41 4e 44 20 73 74 61 74 65 20 69 6e 20 28    AND state in (
10820 27 52 55 4e 4e 49 4e 47 27 2c 27 4e 4f 54 5f 53  'RUNNING','NOT_S
10830 54 41 52 54 45 44 27 29 29 20 3e 20 30 20 54 48  TARTED')) > 0 TH
10840 45 4e 20 27 52 55 4e 4e 49 4e 47 27 0a 20 20 20  EN 'RUNNING'.   
10850 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10860 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10870 45 4c 53 45 20 27 43 4f 4d 50 4c 45 54 45 44 27  ELSE 'COMPLETED'
10880 20 45 4e 44 2c 0a 20 20 20 20 20 20 20 20 20 20   END,.          
10890 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
108a0 20 20 20 20 20 20 20 20 20 20 20 20 73 74 61 74              stat
108b0 75 73 3d 43 41 53 45 20 0a 20 20 20 20 20 20 20  us=CASE .       
108c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
108d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
108e0 20 20 20 20 20 57 48 45 4e 20 66 61 69 6c 5f 63       WHEN fail_c
108f0 6f 75 6e 74 20 3e 20 30 20 54 48 45 4e 20 27 46  ount > 0 THEN 'F
10900 41 49 4c 27 20 0a 20 20 20 20 20 20 20 20 20 20  AIL' .          
10910 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10920 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10930 20 20 57 48 45 4e 20 70 61 73 73 5f 63 6f 75 6e    WHEN pass_coun
10940 74 20 3e 20 30 20 41 4e 44 20 66 61 69 6c 5f 63  t > 0 AND fail_c
10950 6f 75 6e 74 3d 30 20 54 48 45 4e 20 27 50 41 53  ount=0 THEN 'PAS
10960 53 27 20 0a 20 20 20 20 20 20 20 20 20 20 20 20  S' .            
10970 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10980 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
10990 45 4c 53 45 20 27 55 4e 4b 4e 4f 57 4e 27 20 45  ELSE 'UNKNOWN' E
109a0 4e 44 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  ND.             
109b0 20 20 20 20 20 20 20 20 20 20 57 48 45 52 45 20            WHERE 
109c0 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73  run_id=? AND tes
109d0 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d  tname=? AND item
109e0 5f 70 61 74 68 3d 27 27 3b 22 0a 09 20 20 20 20  _path='';"..    
109f0 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d   run-id test-nam
10a00 65 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61  e run-id test-na
10a10 6d 65 29 29 0a 09 23 66 29 0a 20 20 20 20 20 20  me))..#f).      
10a20 23 66 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d  #f))..;;========
10a30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10a40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10a50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10a60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b  ==============.;
10a70 3b 20 54 65 73 74 73 20 6d 65 74 61 20 64 61 74  ; Tests meta dat
10a80 61 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  a.;;============
10a90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10aa0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10ab0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10ac0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 72  ==========..;; r
10ad0 65 61 64 20 74 68 65 20 72 65 63 6f 72 64 20 67  ead the record g
10ae0 69 76 65 6e 20 61 20 74 65 73 74 6e 61 6d 65 0a  iven a testname.
10af0 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74  (define (db:test
10b00 6d 65 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 20  meta-get-record 
10b10 64 62 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 28  db testname).  (
10b20 6c 65 74 20 28 28 72 65 73 20 23 66 29 29 0a 20  let ((res #f)). 
10b30 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d     (sqlite3:for-
10b40 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c  each-row.     (l
10b50 61 6d 62 64 61 20 28 69 64 20 74 65 73 74 6e 61  ambda (id testna
10b60 6d 65 20 61 75 74 68 6f 72 20 6f 77 6e 65 72 20  me author owner 
10b70 64 65 73 63 72 69 70 74 69 6f 6e 20 72 65 76 69  description revi
10b80 65 77 65 64 20 69 74 65 72 61 74 65 64 20 61 76  ewed iterated av
10b90 67 5f 72 75 6e 74 69 6d 65 20 61 76 67 5f 64 69  g_runtime avg_di
10ba0 73 6b 20 74 61 67 73 29 0a 20 20 20 20 20 20 20  sk tags).       
10bb0 28 73 65 74 21 20 72 65 73 20 28 76 65 63 74 6f  (set! res (vecto
10bc0 72 20 69 64 20 74 65 73 74 6e 61 6d 65 20 61 75  r id testname au
10bd0 74 68 6f 72 20 6f 77 6e 65 72 20 64 65 73 63 72  thor owner descr
10be0 69 70 74 69 6f 6e 20 72 65 76 69 65 77 65 64 20  iption reviewed 
10bf0 69 74 65 72 61 74 65 64 20 61 76 67 5f 72 75 6e  iterated avg_run
10c00 74 69 6d 65 20 61 76 67 5f 64 69 73 6b 20 74 61  time avg_disk ta
10c10 67 73 29 29 29 0a 20 20 20 20 20 64 62 20 22 53  gs))).     db "S
10c20 45 4c 45 43 54 20 69 64 2c 74 65 73 74 6e 61 6d  ELECT id,testnam
10c30 65 2c 61 75 74 68 6f 72 2c 6f 77 6e 65 72 2c 64  e,author,owner,d
10c40 65 73 63 72 69 70 74 69 6f 6e 2c 72 65 76 69 65  escription,revie
10c50 77 65 64 2c 69 74 65 72 61 74 65 64 2c 61 76 67  wed,iterated,avg
10c60 5f 72 75 6e 74 69 6d 65 2c 61 76 67 5f 64 69 73  _runtime,avg_dis
10c70 6b 2c 74 61 67 73 20 46 52 4f 4d 20 74 65 73 74  k,tags FROM test
10c80 5f 6d 65 74 61 20 57 48 45 52 45 20 74 65 73 74  _meta WHERE test
10c90 6e 61 6d 65 3d 3f 3b 22 0a 20 20 20 20 20 74 65  name=?;".     te
10ca0 73 74 6e 61 6d 65 29 0a 20 20 20 20 72 65 73 29  stname).    res)
10cb0 29 0a 0a 3b 3b 20 63 72 65 61 74 65 20 61 20 6e  )..;; create a n
10cc0 65 77 20 72 65 63 6f 72 64 20 66 6f 72 20 61 20  ew record for a 
10cd0 67 69 76 65 6e 20 74 65 73 74 6e 61 6d 65 0a 28  given testname.(
10ce0 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 6d  define (db:testm
10cf0 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 20 64  eta-add-record d
10d00 62 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 28 73  b testname).  (s
10d10 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64  qlite3:execute d
10d20 62 20 22 49 4e 53 45 52 54 20 4f 52 20 49 47 4e  b "INSERT OR IGN
10d30 4f 52 45 20 49 4e 54 4f 20 74 65 73 74 5f 6d 65  ORE INTO test_me
10d40 74 61 20 28 74 65 73 74 6e 61 6d 65 2c 61 75 74  ta (testname,aut
10d50 68 6f 72 2c 6f 77 6e 65 72 2c 64 65 73 63 72 69  hor,owner,descri
10d60 70 74 69 6f 6e 2c 72 65 76 69 65 77 65 64 2c 69  ption,reviewed,i
10d70 74 65 72 61 74 65 64 2c 61 76 67 5f 72 75 6e 74  terated,avg_runt
10d80 69 6d 65 2c 61 76 67 5f 64 69 73 6b 2c 74 61 67  ime,avg_disk,tag
10d90 73 29 20 56 41 4c 55 45 53 20 28 3f 2c 27 27 2c  s) VALUES (?,'',
10da0 27 27 2c 27 27 2c 27 27 2c 27 27 2c 27 27 2c 27  '','','','','','
10db0 27 2c 27 27 29 3b 22 20 74 65 73 74 6e 61 6d 65  ','');" testname
10dc0 29 29 0a 0a 3b 3b 20 75 70 64 61 74 65 20 6f 6e  ))..;; update on
10dd0 65 20 6f 66 20 74 68 65 20 74 65 73 74 6d 65 74  e of the testmet
10de0 61 20 66 69 65 6c 64 73 0a 28 64 65 66 69 6e 65  a fields.(define
10df0 20 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 75 70   (db:testmeta-up
10e00 64 61 74 65 2d 66 69 65 6c 64 20 64 62 20 74 65  date-field db te
10e10 73 74 6e 61 6d 65 20 66 69 65 6c 64 20 76 61 6c  stname field val
10e20 75 65 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65  ue).  (sqlite3:e
10e30 78 65 63 75 74 65 20 64 62 20 28 63 6f 6e 63 20  xecute db (conc 
10e40 22 55 50 44 41 54 45 20 74 65 73 74 5f 6d 65 74  "UPDATE test_met
10e50 61 20 53 45 54 20 22 20 66 69 65 6c 64 20 22 3d  a SET " field "=
10e60 3f 20 57 48 45 52 45 20 74 65 73 74 6e 61 6d 65  ? WHERE testname
10e70 3d 3f 3b 22 29 20 76 61 6c 75 65 20 74 65 73 74  =?;") value test
10e80 6e 61 6d 65 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d  name))..;;======
10e90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10ea0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10eb0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10ec0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10ed0 0a 3b 3b 20 54 20 45 20 53 20 54 20 20 20 44 20  .;; T E S T   D 
10ee0 41 20 54 20 41 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d  A T A .;;=======
10ef0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10f00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10f10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10f20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a  ===============.
10f30 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 63 73 76  .(define (db:csv
10f40 2d 3e 74 65 73 74 2d 64 61 74 61 20 64 62 20 74  ->test-data db t
10f50 65 73 74 2d 69 64 20 63 73 76 64 61 74 61 29 0a  est-id csvdata).
10f60 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34    (debug:print 4
10f70 20 22 74 65 73 74 2d 69 64 20 22 20 74 65 73 74   "test-id " test
10f80 2d 69 64 20 22 2c 20 63 73 76 64 61 74 61 3a 20  -id ", csvdata: 
10f90 22 20 63 73 76 64 61 74 61 29 0a 20 20 28 6c 65  " csvdata).  (le
10fa0 74 20 28 28 74 64 62 20 20 20 20 20 28 64 62 3a  t ((tdb     (db:
10fb0 6f 70 65 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d  open-test-db-by-
10fc0 74 65 73 74 2d 69 64 20 64 62 20 74 65 73 74 2d  test-id db test-
10fd0 69 64 29 29 29 0a 20 20 20 20 28 69 66 20 74 64  id))).    (if td
10fe0 62 0a 09 28 6c 65 74 20 28 28 63 73 76 6c 69 73  b..(let ((csvlis
10ff0 74 20 28 63 73 76 2d 3e 6c 69 73 74 20 28 6d 61  t (csv->list (ma
11000 6b 65 2d 63 73 76 2d 72 65 61 64 65 72 0a 09 09  ke-csv-reader...
11010 09 09 20 20 20 28 6f 70 65 6e 2d 69 6e 70 75 74  ..   (open-input
11020 2d 73 74 72 69 6e 67 20 63 73 76 64 61 74 61 29  -string csvdata)
11030 0a 09 09 09 09 20 20 20 27 28 28 73 74 72 69 70  .....   '((strip
11040 2d 6c 65 61 64 69 6e 67 2d 77 68 69 74 65 73 70  -leading-whitesp
11050 61 63 65 3f 20 23 74 29 0a 09 09 09 09 20 20 20  ace? #t).....   
11060 20 20 28 73 74 72 69 70 2d 74 72 61 69 6c 69 6e    (strip-trailin
11070 67 2d 77 68 69 74 65 73 70 61 63 65 3f 20 23 74  g-whitespace? #t
11080 29 29 20 29 29 29 29 20 3b 3b 20 28 63 73 76 2d  )) )))) ;; (csv-
11090 3e 6c 69 73 74 20 63 73 76 64 61 74 61 29 29 29  >list csvdata)))
110a0 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09  ..  (for-each ..
110b0 20 20 20 28 6c 61 6d 62 64 61 20 28 63 73 76 72     (lambda (csvr
110c0 6f 77 29 0a 09 20 20 20 20 20 28 6c 65 74 2a 20  ow)..     (let* 
110d0 28 28 70 61 64 64 65 64 2d 72 6f 77 20 20 28 74  ((padded-row  (t
110e0 61 6b 65 20 28 61 70 70 65 6e 64 20 63 73 76 72  ake (append csvr
110f0 6f 77 20 28 6c 69 73 74 20 23 66 20 23 66 20 23  ow (list #f #f #
11100 66 20 23 66 20 23 66 20 23 66 20 23 66 20 23 66  f #f #f #f #f #f
11110 20 23 66 29 29 20 39 29 29 0a 09 09 20 20 20 20   #f)) 9))...    
11120 28 63 61 74 65 67 6f 72 79 20 20 20 20 28 6c 69  (category    (li
11130 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f  st-ref padded-ro
11140 77 20 30 29 29 0a 09 09 20 20 20 20 28 76 61 72  w 0))...    (var
11150 69 61 62 6c 65 20 20 20 20 28 6c 69 73 74 2d 72  iable    (list-r
11160 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 31 29  ef padded-row 1)
11170 29 0a 09 09 20 20 20 20 28 76 61 6c 75 65 20 20  )...    (value  
11180 20 20 20 20 20 28 61 6e 79 2d 3e 6e 75 6d 62 65       (any->numbe
11190 72 2d 69 66 2d 70 6f 73 73 69 62 6c 65 20 28 6c  r-if-possible (l
111a0 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72  ist-ref padded-r
111b0 6f 77 20 32 29 29 29 0a 09 09 20 20 20 20 28 65  ow 2)))...    (e
111c0 78 70 65 63 74 65 64 20 20 20 20 28 61 6e 79 2d  xpected    (any-
111d0 3e 6e 75 6d 62 65 72 2d 69 66 2d 70 6f 73 73 69  >number-if-possi
111e0 62 6c 65 20 28 6c 69 73 74 2d 72 65 66 20 70 61  ble (list-ref pa
111f0 64 64 65 64 2d 72 6f 77 20 33 29 29 29 0a 09 09  dded-row 3)))...
11200 20 20 20 20 28 74 6f 6c 20 20 20 20 20 20 20 20      (tol        
11210 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 2d 69 66   (any->number-if
11220 2d 70 6f 73 73 69 62 6c 65 20 28 6c 69 73 74 2d  -possible (list-
11230 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 34  ref padded-row 4
11240 29 29 29 20 3b 3b 20 3e 2c 20 3c 2c 20 3e 3d 2c  ))) ;; >, <, >=,
11250 20 3c 3d 2c 20 6f 72 20 61 20 6e 75 6d 62 65 72   <=, or a number
11260 0a 09 09 20 20 20 20 28 75 6e 69 74 73 20 20 20  ...    (units   
11270 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61      (list-ref pa
11280 64 64 65 64 2d 72 6f 77 20 35 29 29 0a 09 09 20  dded-row 5))... 
11290 20 20 20 28 63 6f 6d 6d 65 6e 74 20 20 20 20 20     (comment     
112a0 28 6c 69 73 74 2d 72 65 66 20 70 61 64 64 65 64  (list-ref padded
112b0 2d 72 6f 77 20 36 29 29 0a 09 09 20 20 20 20 28  -row 6))...    (
112c0 73 74 61 74 75 73 20 20 20 20 20 20 28 6c 65 74  status      (let
112d0 20 28 28 73 20 28 6c 69 73 74 2d 72 65 66 20 70   ((s (list-ref p
112e0 61 64 64 65 64 2d 72 6f 77 20 37 29 29 29 0a 09  added-row 7)))..
112f0 09 09 09 20 20 20 28 69 66 20 28 61 6e 64 20 28  ...   (if (and (
11300 73 74 72 69 6e 67 3f 20 73 29 28 6f 72 20 28 73  string? s)(or (s
11310 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67  tring-match (reg
11320 65 78 70 20 22 5e 5c 5c 73 2a 24 22 29 20 73 29  exp "^\\s*$") s)
11330 0a 09 09 09 09 09 09 09 20 20 20 28 73 74 72 69  ........   (stri
11340 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70  ng-match (regexp
11350 20 22 5e 6e 2f 61 24 22 29 20 73 29 29 29 0a 09   "^n/a$") s)))..
11360 09 09 09 20 20 20 20 20 20 20 23 66 0a 09 09 09  ...       #f....
11370 09 20 20 20 20 20 20 20 73 29 29 29 20 3b 3b 20  .       s))) ;; 
11380 69 66 20 73 70 65 63 69 66 69 65 64 20 6f 6e 20  if specified on 
11390 74 68 65 20 69 6e 70 75 74 20 74 68 65 6e 20 75  the input then u
113a0 73 65 2c 20 65 6c 73 65 20 63 61 6c 63 75 6c 61  se, else calcula
113b0 74 65 0a 09 09 20 20 20 20 28 74 79 70 65 20 20  te...    (type  
113c0 20 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20        (list-ref 
113d0 70 61 64 64 65 64 2d 72 6f 77 20 38 29 29 29 0a  padded-row 8))).
113e0 09 20 20 20 20 20 20 20 3b 3b 20 6c 6f 6f 6b 20  .       ;; look 
113f0 75 70 20 65 78 70 65 63 74 65 64 2c 74 6f 6c 2c  up expected,tol,
11400 75 6e 69 74 73 20 66 72 6f 6d 20 70 72 65 76 69  units from previ
11410 6f 75 73 20 62 65 73 74 20 66 69 74 20 74 65 73  ous best fit tes
11420 74 20 69 66 20 74 68 65 79 20 61 72 65 20 61 6c  t if they are al
11430 6c 20 65 69 74 68 65 72 20 23 66 20 6f 72 20 27  l either #f or '
11440 27 0a 09 20 20 20 20 20 20 20 28 64 65 62 75 67  '..       (debug
11450 3a 70 72 69 6e 74 20 34 20 22 42 45 46 4f 52 45  :print 4 "BEFORE
11460 3a 20 63 61 74 65 67 6f 72 79 3a 20 22 20 63 61  : category: " ca
11470 74 65 67 6f 72 79 20 22 20 76 61 72 69 61 62 6c  tegory " variabl
11480 65 3a 20 22 20 76 61 72 69 61 62 6c 65 20 22 20  e: " variable " 
11490 76 61 6c 75 65 3a 20 22 20 76 61 6c 75 65 20 0a  value: " value .
114a0 09 09 09 20 20 20 20 22 2c 20 65 78 70 65 63 74  ...    ", expect
114b0 65 64 3a 20 22 20 65 78 70 65 63 74 65 64 20 22  ed: " expected "
114c0 20 74 6f 6c 3a 20 22 20 74 6f 6c 20 22 20 75 6e   tol: " tol " un
114d0 69 74 73 3a 20 22 20 75 6e 69 74 73 20 22 20 73  its: " units " s
114e0 74 61 74 75 73 3a 20 22 20 73 74 61 74 75 73 20  tatus: " status 
114f0 22 20 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f 6d  " comment: " com
11500 6d 65 6e 74 20 22 20 74 79 70 65 3a 20 22 20 74  ment " type: " t
11510 79 70 65 29 0a 0a 09 20 20 20 20 20 20 20 28 69  ype)...       (i
11520 66 20 28 61 6e 64 20 28 6f 72 20 28 6e 6f 74 20  f (and (or (not 
11530 65 78 70 65 63 74 65 64 29 28 65 71 75 61 6c 3f  expected)(equal?
11540 20 65 78 70 65 63 74 65 64 20 22 22 29 29 0a 09   expected ""))..
11550 09 09 28 6f 72 20 28 6e 6f 74 20 74 6f 6c 29 20  ..(or (not tol) 
11560 20 20 20 20 28 65 71 75 61 6c 3f 20 65 78 70 65      (equal? expe
11570 63 74 65 64 20 22 22 29 29 0a 09 09 09 28 6f 72  cted ""))....(or
11580 20 28 6e 6f 74 20 75 6e 69 74 73 29 20 20 20 28   (not units)   (
11590 65 71 75 61 6c 3f 20 65 78 70 65 63 74 65 64 20  equal? expected 
115a0 22 22 29 29 29 0a 09 09 20 20 20 28 6c 65 74 2d  "")))...   (let-
115b0 76 61 6c 75 65 73 20 28 28 28 6e 65 77 2d 65 78  values (((new-ex
115c0 70 65 63 74 65 64 20 6e 65 77 2d 74 6f 6c 20 6e  pected new-tol n
115d0 65 77 2d 75 6e 69 74 73 29 28 64 62 3a 67 65 74  ew-units)(db:get
115e0 2d 70 72 65 76 2d 74 6f 6c 2d 66 6f 72 2d 74 65  -prev-tol-for-te
115f0 73 74 20 64 62 20 74 65 73 74 2d 69 64 20 63 61  st db test-id ca
11600 74 65 67 6f 72 79 20 76 61 72 69 61 62 6c 65 29  tegory variable)
11610 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 65  ))....       (se
11620 74 21 20 65 78 70 65 63 74 65 64 20 6e 65 77 2d  t! expected new-
11630 65 78 70 65 63 74 65 64 29 0a 09 09 09 20 20 20  expected)....   
11640 20 20 20 20 28 73 65 74 21 20 74 6f 6c 20 20 20      (set! tol   
11650 20 20 20 6e 65 77 2d 74 6f 6c 29 0a 09 09 09 20     new-tol).... 
11660 20 20 20 20 20 20 28 73 65 74 21 20 75 6e 69 74        (set! unit
11670 73 20 20 20 20 6e 65 77 2d 75 6e 69 74 73 29 29  s    new-units))
11680 29 0a 0a 09 20 20 20 20 20 20 20 28 64 65 62 75  )...       (debu
11690 67 3a 70 72 69 6e 74 20 34 20 22 41 46 54 45 52  g:print 4 "AFTER
116a0 3a 20 20 63 61 74 65 67 6f 72 79 3a 20 22 20 63  :  category: " c
116b0 61 74 65 67 6f 72 79 20 22 20 76 61 72 69 61 62  ategory " variab
116c0 6c 65 3a 20 22 20 76 61 72 69 61 62 6c 65 20 22  le: " variable "
116d0 20 76 61 6c 75 65 3a 20 22 20 76 61 6c 75 65 20   value: " value 
116e0 0a 09 09 09 20 20 20 20 22 2c 20 65 78 70 65 63  ....    ", expec
116f0 74 65 64 3a 20 22 20 65 78 70 65 63 74 65 64 20  ted: " expected 
11700 22 20 74 6f 6c 3a 20 22 20 74 6f 6c 20 22 20 75  " tol: " tol " u
11710 6e 69 74 73 3a 20 22 20 75 6e 69 74 73 20 22 20  nits: " units " 
11720 73 74 61 74 75 73 3a 20 22 20 73 74 61 74 75 73  status: " status
11730 20 22 20 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f   " comment: " co
11740 6d 6d 65 6e 74 29 0a 09 20 20 20 20 20 20 20 3b  mment)..       ;
11750 3b 20 63 61 6c 63 75 6c 61 74 65 20 73 74 61 74  ; calculate stat
11760 75 73 20 69 66 20 4e 4f 54 20 73 70 65 63 69 66  us if NOT specif
11770 69 65 64 0a 09 20 20 20 20 20 20 20 28 69 66 20  ied..       (if 
11780 28 61 6e 64 20 28 6e 6f 74 20 73 74 61 74 75 73  (and (not status
11790 29 28 6e 75 6d 62 65 72 3f 20 65 78 70 65 63 74  )(number? expect
117a0 65 64 29 28 6e 75 6d 62 65 72 3f 20 76 61 6c 75  ed)(number? valu
117b0 65 29 29 20 3b 3b 20 6e 65 65 64 20 65 78 70 65  e)) ;; need expe
117c0 63 74 65 64 20 61 6e 64 20 76 61 6c 75 65 20 74  cted and value t
117d0 6f 20 62 65 20 6e 75 6d 62 65 72 73 0a 09 09 20  o be numbers... 
117e0 20 20 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 74    (if (number? t
117f0 6f 6c 29 20 3b 3b 20 69 66 20 74 6f 6c 20 69 73  ol) ;; if tol is
11800 20 61 20 6e 75 6d 62 65 72 20 74 68 65 6e 20 77   a number then w
11810 65 20 64 6f 20 74 68 65 20 73 74 61 6e 64 61 72  e do the standar
11820 64 20 63 6f 6d 70 61 72 69 73 6f 6e 0a 09 09 20  d comparison... 
11830 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6d 61        (let* ((ma
11840 78 2d 76 61 6c 20 28 2b 20 65 78 70 65 63 74 65  x-val (+ expecte
11850 64 20 74 6f 6c 29 29 0a 09 09 09 20 20 20 20 20  d tol))....     
11860 20 28 6d 69 6e 2d 76 61 6c 20 28 2d 20 65 78 70   (min-val (- exp
11870 65 63 74 65 64 20 74 6f 6c 29 29 0a 09 09 09 20  ected tol)).... 
11880 20 20 20 20 20 28 72 65 73 75 6c 74 20 20 28 61       (result  (a
11890 6e 64 20 28 3e 3d 20 20 76 61 6c 75 65 20 6d 69  nd (>=  value mi
118a0 6e 2d 76 61 6c 29 28 3c 3d 20 76 61 6c 75 65 20  n-val)(<= value 
118b0 6d 61 78 2d 76 61 6c 29 29 29 29 0a 09 09 09 20  max-val)))).... 
118c0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22  (debug:print 4 "
118d0 6d 61 78 2d 76 61 6c 3a 20 22 20 6d 61 78 2d 76  max-val: " max-v
118e0 61 6c 20 22 20 6d 69 6e 2d 76 61 6c 3a 20 22 20  al " min-val: " 
118f0 6d 69 6e 2d 76 61 6c 20 22 20 72 65 73 75 6c 74  min-val " result
11900 3a 20 22 20 72 65 73 75 6c 74 29 0a 09 09 09 20  : " result).... 
11910 28 73 65 74 21 20 73 74 61 74 75 73 20 28 69 66  (set! status (if
11920 20 72 65 73 75 6c 74 20 22 70 61 73 73 22 20 22   result "pass" "
11930 66 61 69 6c 22 29 29 29 0a 09 09 20 20 20 20 20  fail")))...     
11940 20 20 28 73 65 74 21 20 73 74 61 74 75 73 20 3b    (set! status ;
11950 3b 20 4e 42 2f 2f 20 6e 65 65 64 20 74 6f 20 61  ; NB// need to a
11960 73 73 65 73 73 20 65 61 63 68 20 6f 6e 65 20 28  ssess each one (
11970 69 2e 65 2e 20 6e 6f 74 20 72 65 74 75 72 6e 20  i.e. not return 
11980 6f 70 65 72 61 74 6f 72 20 73 69 6e 63 65 20 6e  operator since n
11990 65 65 64 20 74 6f 20 61 63 74 20 69 66 20 6e 6f  eed to act if no
119a0 74 20 76 61 6c 69 64 20 6f 70 2e 0a 09 09 09 20  t valid op..... 
119b0 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e      (case (strin
119c0 67 2d 3e 73 79 6d 62 6f 6c 20 74 6f 6c 29 20 3b  g->symbol tol) ;
119d0 3b 20 74 6f 6c 20 73 68 6f 75 6c 64 20 62 65 20  ; tol should be 
119e0 3e 2c 20 3c 2c 20 3e 3d 2c 20 3c 3d 0a 09 09 09  >, <, >=, <=....
119f0 20 20 20 20 20 20 20 28 28 3e 29 20 20 28 69 66         ((>)  (if
11a00 20 28 3e 20 20 76 61 6c 75 65 20 65 78 70 65 63   (>  value expec
11a10 74 65 64 29 20 22 70 61 73 73 22 20 22 66 61 69  ted) "pass" "fai
11a20 6c 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 28  l"))....       (
11a30 28 3c 29 20 20 28 69 66 20 28 3c 20 20 76 61 6c  (<)  (if (<  val
11a40 75 65 20 65 78 70 65 63 74 65 64 29 20 22 70 61  ue expected) "pa
11a50 73 73 22 20 22 66 61 69 6c 22 29 29 0a 09 09 09  ss" "fail"))....
11a60 20 20 20 20 20 20 20 28 28 3e 3d 29 20 28 69 66         ((>=) (if
11a70 20 28 3e 3d 20 76 61 6c 75 65 20 65 78 70 65 63   (>= value expec
11a80 74 65 64 29 20 22 70 61 73 73 22 20 22 66 61 69  ted) "pass" "fai
11a90 6c 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 28  l"))....       (
11aa0 28 3c 3d 29 20 28 69 66 20 28 3c 3d 20 76 61 6c  (<=) (if (<= val
11ab0 75 65 20 65 78 70 65 63 74 65 64 29 20 22 70 61  ue expected) "pa
11ac0 73 73 22 20 22 66 61 69 6c 22 29 29 0a 09 09 09  ss" "fail"))....
11ad0 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 63 6f         (else (co
11ae0 6e 63 20 22 45 52 52 4f 52 3a 20 62 61 64 20 74  nc "ERROR: bad t
11af0 6f 6c 20 63 6f 6d 70 61 72 61 74 6f 72 20 22 20  ol comparator " 
11b00 74 6f 6c 29 29 29 29 29 29 0a 09 20 20 20 20 20  tol))))))..     
11b10 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34    (debug:print 4
11b20 20 22 41 46 54 45 52 32 3a 20 63 61 74 65 67 6f   "AFTER2: catego
11b30 72 79 3a 20 22 20 63 61 74 65 67 6f 72 79 20 22  ry: " category "
11b40 20 76 61 72 69 61 62 6c 65 3a 20 22 20 76 61 72   variable: " var
11b50 69 61 62 6c 65 20 22 20 76 61 6c 75 65 3a 20 22  iable " value: "
11b60 20 76 61 6c 75 65 20 0a 09 09 09 20 20 20 20 22   value ....    "
11b70 2c 20 65 78 70 65 63 74 65 64 3a 20 22 20 65 78  , expected: " ex
11b80 70 65 63 74 65 64 20 22 20 74 6f 6c 3a 20 22 20  pected " tol: " 
11b90 74 6f 6c 20 22 20 75 6e 69 74 73 3a 20 22 20 75  tol " units: " u
11ba0 6e 69 74 73 20 22 20 73 74 61 74 75 73 3a 20 22  nits " status: "
11bb0 20 73 74 61 74 75 73 20 22 20 63 6f 6d 6d 65 6e   status " commen
11bc0 74 3a 20 22 20 63 6f 6d 6d 65 6e 74 29 0a 09 20  t: " comment).. 
11bd0 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65        (sqlite3:e
11be0 78 65 63 75 74 65 20 74 64 62 20 22 49 4e 53 45  xecute tdb "INSE
11bf0 52 54 20 4f 52 20 52 45 50 4c 41 43 45 20 49 4e  RT OR REPLACE IN
11c00 54 4f 20 74 65 73 74 5f 64 61 74 61 20 28 74 65  TO test_data (te
11c10 73 74 5f 69 64 2c 63 61 74 65 67 6f 72 79 2c 76  st_id,category,v
11c20 61 72 69 61 62 6c 65 2c 76 61 6c 75 65 2c 65 78  ariable,value,ex
11c30 70 65 63 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 73  pected,tol,units
11c40 2c 63 6f 6d 6d 65 6e 74 2c 73 74 61 74 75 73 2c  ,comment,status,
11c50 74 79 70 65 29 20 56 41 4c 55 45 53 20 28 3f 2c  type) VALUES (?,
11c60 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c  ?,?,?,?,?,?,?,?,
11c70 3f 29 3b 22 0a 09 09 09 09 74 65 73 74 2d 69 64  ?);".....test-id
11c80 20 63 61 74 65 67 6f 72 79 20 76 61 72 69 61 62   category variab
11c90 6c 65 20 76 61 6c 75 65 20 65 78 70 65 63 74 65  le value expecte
11ca0 64 20 74 6f 6c 20 75 6e 69 74 73 20 28 69 66 20  d tol units (if 
11cb0 63 6f 6d 6d 65 6e 74 20 63 6f 6d 6d 65 6e 74 20  comment comment 
11cc0 22 22 29 20 73 74 61 74 75 73 20 74 79 70 65 29  "") status type)
11cd0 0a 09 20 20 20 20 20 20 20 28 73 71 6c 69 74 65  ..       (sqlite
11ce0 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29  3:finalize! tdb)
11cf0 29 29 0a 09 20 20 20 63 73 76 6c 69 73 74 29 29  ))..   csvlist))
11d00 29 29 29 0a 0a 3b 3b 20 67 65 74 20 61 20 6c 69  )))..;; get a li
11d10 73 74 20 6f 66 20 74 65 73 74 5f 64 61 74 61 20  st of test_data 
11d20 72 65 63 6f 72 64 73 20 6d 61 74 63 68 69 6e 67  records matching
11d30 20 63 61 74 65 67 6f 72 79 70 61 74 74 0a 28 64   categorypatt.(d
11d40 65 66 69 6e 65 20 28 64 62 3a 72 65 61 64 2d 74  efine (db:read-t
11d50 65 73 74 2d 64 61 74 61 20 64 62 20 74 65 73 74  est-data db test
11d60 2d 69 64 20 63 61 74 65 67 6f 72 79 70 61 74 74  -id categorypatt
11d70 29 0a 20 20 28 6c 65 74 20 28 28 74 64 62 20 20  ).  (let ((tdb  
11d80 28 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d 64 62  (db:open-test-db
11d90 2d 62 79 2d 74 65 73 74 2d 69 64 20 64 62 20 74  -by-test-id db t
11da0 65 73 74 2d 69 64 29 29 29 0a 20 20 20 20 28 69  est-id))).    (i
11db0 66 20 74 64 62 0a 09 28 6c 65 74 20 28 28 72 65  f tdb..(let ((re
11dc0 73 20 27 28 29 29 29 0a 09 20 20 28 73 71 6c 69  s '()))..  (sqli
11dd0 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77  te3:for-each-row
11de0 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 69   ..   (lambda (i
11df0 64 20 74 65 73 74 5f 69 64 20 63 61 74 65 67 6f  d test_id catego
11e00 72 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75  ry variable valu
11e10 65 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 75  e expected tol u
11e20 6e 69 74 73 20 63 6f 6d 6d 65 6e 74 20 73 74 61  nits comment sta
11e30 74 75 73 20 74 79 70 65 29 0a 09 20 20 20 20 20  tus type)..     
11e40 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20  (set! res (cons 
11e50 28 76 65 63 74 6f 72 20 69 64 20 74 65 73 74 5f  (vector id test_
11e60 69 64 20 63 61 74 65 67 6f 72 79 20 76 61 72 69  id category vari
11e70 61 62 6c 65 20 76 61 6c 75 65 20 65 78 70 65 63  able value expec
11e80 74 65 64 20 74 6f 6c 20 75 6e 69 74 73 20 63 6f  ted tol units co
11e90 6d 6d 65 6e 74 20 73 74 61 74 75 73 20 74 79 70  mment status typ
11ea0 65 29 20 72 65 73 29 29 29 0a 09 20 20 20 74 64  e) res)))..   td
11eb0 62 0a 09 20 20 20 22 53 45 4c 45 43 54 20 69 64  b..   "SELECT id
11ec0 2c 74 65 73 74 5f 69 64 2c 63 61 74 65 67 6f 72  ,test_id,categor
11ed0 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 6c 75 65  y,variable,value
11ee0 2c 65 78 70 65 63 74 65 64 2c 74 6f 6c 2c 75 6e  ,expected,tol,un
11ef0 69 74 73 2c 63 6f 6d 6d 65 6e 74 2c 73 74 61 74  its,comment,stat
11f00 75 73 2c 74 79 70 65 20 46 52 4f 4d 20 74 65 73  us,type FROM tes
11f10 74 5f 64 61 74 61 20 57 48 45 52 45 20 74 65 73  t_data WHERE tes
11f20 74 5f 69 64 3d 3f 20 41 4e 44 20 63 61 74 65 67  t_id=? AND categ
11f30 6f 72 79 20 4c 49 4b 45 20 3f 20 4f 52 44 45 52  ory LIKE ? ORDER
11f40 20 42 59 20 63 61 74 65 67 6f 72 79 2c 76 61 72   BY category,var
11f50 69 61 62 6c 65 3b 22 20 74 65 73 74 2d 69 64 20  iable;" test-id 
11f60 63 61 74 65 67 6f 72 79 70 61 74 74 29 0a 09 20  categorypatt).. 
11f70 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69   (sqlite3:finali
11f80 7a 65 21 20 74 64 62 29 0a 09 20 20 28 72 65 76  ze! tdb)..  (rev
11f90 65 72 73 65 20 72 65 73 29 29 0a 09 27 28 29 29  erse res))..'())
11fa0 29 29 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 52 75 6e  ))..;; NOTE: Run
11fb0 20 74 68 69 73 20 6c 6f 63 61 6c 20 77 69 74 68   this local with
11fc0 20 23 66 20 66 6f 72 20 64 62 20 21 21 21 0a 28   #f for db !!!.(
11fd0 64 65 66 69 6e 65 20 28 64 62 3a 6c 6f 61 64 2d  define (db:load-
11fe0 74 65 73 74 2d 64 61 74 61 20 64 62 20 74 65 73  test-data db tes
11ff0 74 2d 69 64 29 0a 20 20 28 6c 65 74 20 6c 6f 6f  t-id).  (let loo
12000 70 20 28 28 6c 69 6e 20 28 72 65 61 64 2d 6c 69  p ((lin (read-li
12010 6e 65 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e  ne))).    (if (n
12020 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20  ot (eof-object? 
12030 6c 69 6e 29 29 0a 09 28 62 65 67 69 6e 0a 09 20  lin))..(begin.. 
12040 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20   (debug:print 4 
12050 6c 69 6e 29 0a 09 20 20 28 64 62 3a 63 73 76 2d  lin)..  (db:csv-
12060 3e 74 65 73 74 2d 64 61 74 61 20 64 62 20 74 65  >test-data db te
12070 73 74 2d 69 64 20 6c 69 6e 29 0a 09 20 20 28 6c  st-id lin)..  (l
12080 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 29 29  oop (read-line))
12090 29 29 29 0a 20 20 3b 3b 20 72 6f 6c 6c 20 75 70  ))).  ;; roll up
120a0 20 74 68 65 20 63 75 72 72 65 6e 74 20 72 65 73   the current res
120b0 75 6c 74 73 2e 0a 20 20 3b 3b 20 46 49 58 4d 45  ults..  ;; FIXME
120c0 3a 20 41 64 64 20 74 68 65 20 73 74 61 74 75 73  : Add the status
120d0 20 74 6f 20 0a 20 20 28 64 62 3a 74 65 73 74 2d   to .  (db:test-
120e0 64 61 74 61 2d 72 6f 6c 6c 75 70 20 64 62 20 74  data-rollup db t
120f0 65 73 74 2d 69 64 20 23 66 29 29 0a 0a 3b 3b 20  est-id #f))..;; 
12100 57 41 52 4e 49 4e 47 3a 20 44 6f 20 4e 4f 54 20  WARNING: Do NOT 
12110 63 61 6c 6c 20 74 68 69 73 20 66 6f 72 20 74 68  call this for th
12120 65 20 70 61 72 65 6e 74 20 74 65 73 74 20 6f 6e  e parent test on
12130 20 61 6e 20 69 74 65 72 61 74 65 64 20 74 65 73   an iterated tes
12140 74 0a 3b 3b 20 52 6f 6c 6c 20 75 70 20 74 65 73  t.;; Roll up tes
12150 74 5f 64 61 74 61 20 70 61 73 73 2f 66 61 69 6c  t_data pass/fail
12160 20 72 65 73 75 6c 74 73 0a 3b 3b 20 6c 6f 6f 6b   results.;; look
12170 20 61 74 20 74 68 65 20 74 65 73 74 5f 64 61 74   at the test_dat
12180 61 20 73 74 61 74 75 73 20 66 69 65 6c 64 2c 20  a status field, 
12190 0a 3b 3b 20 20 20 20 69 66 20 61 6c 6c 20 61 72  .;;    if all ar
121a0 65 20 70 61 73 73 20 28 61 6e 79 20 63 61 73 65  e pass (any case
121b0 29 20 61 6e 64 20 74 68 65 20 74 65 73 74 20 73  ) and the test s
121c0 74 61 74 75 73 20 69 73 20 50 41 53 53 20 6f 72  tatus is PASS or
121d0 20 4e 55 4c 4c 20 6f 72 20 27 27 20 74 68 65 6e   NULL or '' then
121e0 20 73 65 74 20 74 65 73 74 20 73 74 61 74 75 73   set test status
121f0 20 74 6f 20 50 41 53 53 2e 0a 3b 3b 20 20 20 20   to PASS..;;    
12200 69 66 20 6f 6e 65 20 6f 72 20 6d 6f 72 65 20 61  if one or more a
12210 72 65 20 66 61 69 6c 20 28 61 6e 79 20 63 61 73  re fail (any cas
12220 65 29 20 74 68 65 6e 20 73 65 74 20 74 65 73 74  e) then set test
12230 20 73 74 61 74 75 73 20 74 6f 20 50 41 53 53 2c   status to PASS,
12240 20 6e 6f 6e 20 22 70 61 73 73 22 20 6f 72 20 22   non "pass" or "
12250 66 61 69 6c 22 20 61 72 65 20 69 67 6e 6f 72 65  fail" are ignore
12260 64 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65  d.(define (db:te
12270 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 20 64  st-data-rollup d
12280 62 20 74 65 73 74 2d 69 64 20 73 74 61 74 75 73  b test-id status
12290 29 0a 20 20 28 6c 65 74 20 28 28 74 64 62 20 28  ).  (let ((tdb (
122a0 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d 64 62 2d  db:open-test-db-
122b0 62 79 2d 74 65 73 74 2d 69 64 20 64 62 20 74 65  by-test-id db te
122c0 73 74 2d 69 64 29 29 0a 09 28 66 61 69 6c 2d 63  st-id))..(fail-c
122d0 6f 75 6e 74 20 30 29 0a 09 28 70 61 73 73 2d 63  ount 0)..(pass-c
122e0 6f 75 6e 74 20 30 29 29 0a 20 20 20 20 28 69 66  ount 0)).    (if
122f0 20 74 64 62 0a 09 28 62 65 67 69 6e 0a 09 20 20   tdb..(begin..  
12300 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63  (sqlite3:for-eac
12310 68 2d 72 6f 77 0a 09 20 20 20 28 6c 61 6d 62 64  h-row..   (lambd
12320 61 20 28 66 63 6f 75 6e 74 20 70 63 6f 75 6e 74  a (fcount pcount
12330 29 0a 09 20 20 20 20 20 28 73 65 74 21 20 66 61  )..     (set! fa
12340 69 6c 2d 63 6f 75 6e 74 20 66 63 6f 75 6e 74 29  il-count fcount)
12350 0a 09 20 20 20 20 20 28 73 65 74 21 20 70 61 73  ..     (set! pas
12360 73 2d 63 6f 75 6e 74 20 70 63 6f 75 6e 74 29 29  s-count pcount))
12370 0a 09 20 20 20 74 64 62 20 0a 09 20 20 20 22 53  ..   tdb ..   "S
12380 45 4c 45 43 54 20 28 53 45 4c 45 43 54 20 63 6f  ELECT (SELECT co
12390 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 74 65 73  unt(id) FROM tes
123a0 74 5f 64 61 74 61 20 57 48 45 52 45 20 74 65 73  t_data WHERE tes
123b0 74 5f 69 64 3d 3f 20 41 4e 44 20 73 74 61 74 75  t_id=? AND statu
123c0 73 20 6c 69 6b 65 20 27 66 61 69 6c 27 29 20 41  s like 'fail') A
123d0 53 20 66 61 69 6c 5f 63 6f 75 6e 74 2c 0a 20 20  S fail_count,.  
123e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
123f0 20 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69   (SELECT count(i
12400 64 29 20 46 52 4f 4d 20 74 65 73 74 5f 64 61 74  d) FROM test_dat
12410 61 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d  a WHERE test_id=
12420 3f 20 41 4e 44 20 73 74 61 74 75 73 20 6c 69 6b  ? AND status lik
12430 65 20 27 70 61 73 73 27 29 20 41 53 20 70 61 73  e 'pass') AS pas
12440 73 5f 63 6f 75 6e 74 3b 22 0a 09 20 20 20 74 65  s_count;"..   te
12450 73 74 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09  st-id test-id)..
12460 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c    (sqlite3:final
12470 69 7a 65 21 20 74 64 62 29 0a 0a 09 20 20 3b 3b  ize! tdb)...  ;;
12480 20 4e 6f 77 20 72 6f 6c 6c 75 70 20 74 68 65 20   Now rollup the 
12490 63 6f 75 6e 74 73 20 74 6f 20 74 68 65 20 63 65  counts to the ce
124a0 6e 74 72 61 6c 20 6d 65 67 61 74 65 73 74 2e 64  ntral megatest.d
124b0 62 0a 09 20 20 28 63 64 62 3a 70 61 73 73 2d 66  b..  (cdb:pass-f
124c0 61 69 6c 2d 63 6f 75 6e 74 73 20 2a 72 75 6e 72  ail-counts *runr
124d0 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 20 66  emote* test-id f
124e0 61 69 6c 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63  ail-count pass-c
124f0 6f 75 6e 74 29 0a 09 20 20 3b 3b 20 28 73 71 6c  ount)..  ;; (sql
12500 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20  ite3:execute db 
12510 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45  "UPDATE tests SE
12520 54 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 3f 2c 70  T fail_count=?,p
12530 61 73 73 5f 63 6f 75 6e 74 3d 3f 20 57 48 45 52  ass_count=? WHER
12540 45 20 69 64 3d 3f 3b 22 20 0a 09 20 20 3b 3b 20  E id=?;" ..  ;; 
12550 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
12560 20 20 20 20 66 61 69 6c 2d 63 6f 75 6e 74 20 70      fail-count p
12570 61 73 73 2d 63 6f 75 6e 74 20 74 65 73 74 2d 69  ass-count test-i
12580 64 29 0a 09 20 20 28 63 64 62 3a 66 6c 75 73 68  d)..  (cdb:flush
12590 2d 71 75 65 75 65 20 2a 72 75 6e 72 65 6d 6f 74  -queue *runremot
125a0 65 2a 29 0a 09 20 20 3b 3b 20 28 74 68 72 65 61  e*)..  ;; (threa
125b0 64 2d 73 6c 65 65 70 21 20 31 29 20 3b 3b 20 70  d-sleep! 1) ;; p
125c0 6c 61 79 20 6e 69 63 65 20 77 69 74 68 20 74 68  lay nice with th
125d0 65 20 71 75 65 75 65 20 62 79 20 65 6e 73 75 72  e queue by ensur
125e0 69 6e 67 20 74 68 65 20 72 6f 6c 6c 75 70 20 69  ing the rollup i
125f0 73 20 61 74 20 6c 65 61 73 74 20 31 30 6d 73 20  s at least 10ms 
12600 6c 61 74 65 72 20 74 68 61 6e 20 74 68 65 20 73  later than the s
12610 65 74 0a 09 20 20 0a 09 20 20 3b 3b 20 69 66 20  et..  ..  ;; if 
12620 74 68 65 20 74 65 73 74 20 69 73 20 6e 6f 74 20  the test is not 
12630 46 41 49 4c 20 74 68 65 6e 20 73 65 74 20 73 74  FAIL then set st
12640 61 74 75 73 20 62 61 73 65 64 20 6f 6e 20 74 68  atus based on th
12650 65 20 66 61 69 6c 20 61 6e 64 20 70 61 73 73 20  e fail and pass 
12660 63 6f 75 6e 74 73 2e 0a 09 20 20 28 63 64 62 3a  counts...  (cdb:
12670 74 65 73 74 2d 72 6f 6c 6c 75 70 2d 74 65 73 74  test-rollup-test
12680 5f 64 61 74 61 2d 70 61 73 73 2d 66 61 69 6c 20  _data-pass-fail 
12690 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 73 74  *runremote* test
126a0 2d 69 64 29 0a 09 20 20 3b 3b 20 28 73 71 6c 69  -id)..  ;; (sqli
126b0 74 65 33 3a 65 78 65 63 75 74 65 0a 09 20 20 3b  te3:execute..  ;
126c0 3b 20 20 64 62 20 20 20 3b 3b 3b 20 4e 4f 54 45  ;  db   ;;; NOTE
126d0 3a 20 53 68 6f 75 6c 64 20 74 68 69 73 20 62 65  : Should this be
126e0 20 57 41 52 4e 2c 46 41 49 4c 3f 20 41 20 57 41   WARN,FAIL? A WA
126f0 52 4e 20 69 73 20 6e 6f 74 20 61 20 46 41 49 4c  RN is not a FAIL
12700 3f 3f 3f 3f 3f 20 42 55 47 20 46 49 58 4d 45 0a  ????? BUG FIXME.
12710 09 20 20 3b 3b 20 20 22 55 50 44 41 54 45 20 74  .  ;;  "UPDATE t
12720 65 73 74 73 0a 20 20 20 20 20 20 20 20 20 20 3b  ests.          ;
12730 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 53 45  ;             SE
12740 54 20 73 74 61 74 75 73 3d 43 41 53 45 20 57 48  T status=CASE WH
12750 45 4e 20 28 53 45 4c 45 43 54 20 66 61 69 6c 5f  EN (SELECT fail_
12760 63 6f 75 6e 74 20 46 52 4f 4d 20 74 65 73 74 73  count FROM tests
12770 20 57 48 45 52 45 20 69 64 3d 3f 29 20 3e 20 30   WHERE id=?) > 0
12780 20 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20   .          ;;  
12790 20 20 20 20 20 20 20 20 20 20 20 20 20 20 54 48                TH
127a0 45 4e 20 27 46 41 49 4c 27 0a 20 20 20 20 20 20  EN 'FAIL'.      
127b0 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20      ;;          
127c0 20 20 20 57 48 45 4e 20 28 53 45 4c 45 43 54 20     WHEN (SELECT 
127d0 70 61 73 73 5f 63 6f 75 6e 74 20 46 52 4f 4d 20  pass_count FROM 
127e0 74 65 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f  tests WHERE id=?
127f0 29 20 3e 20 30 20 41 4e 44 20 0a 20 20 20 20 20  ) > 0 AND .     
12800 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20       ;;         
12810 20 20 20 20 20 20 20 20 20 28 53 45 4c 45 43 54           (SELECT
12820 20 73 74 61 74 75 73 20 46 52 4f 4d 20 74 65 73   status FROM tes
12830 74 73 20 57 48 45 52 45 20 69 64 3d 3f 29 20 4e  ts WHERE id=?) N
12840 4f 54 20 49 4e 20 28 27 57 41 52 4e 27 2c 27 46  OT IN ('WARN','F
12850 41 49 4c 27 29 0a 20 20 20 20 20 20 20 20 20 20  AIL').          
12860 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 54  ;;             T
12870 48 45 4e 20 27 50 41 53 53 27 0a 20 20 20 20 20  HEN 'PASS'.     
12880 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20       ;;         
12890 20 20 20 20 45 4c 53 45 20 73 74 61 74 75 73 0a      ELSE status.
128a0 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20            ;;    
128b0 20 20 20 20 20 45 4e 44 20 57 48 45 52 45 20 69       END WHERE i
128c0 64 3d 3f 3b 22 0a 09 20 20 3b 3b 20 20 74 65 73  d=?;"..  ;;  tes
128d0 74 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 73  t-id test-id tes
128e0 74 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09 20  t-id test-id).. 
128f0 20 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28   ))))..(define (
12900 64 62 3a 67 65 74 2d 70 72 65 76 2d 74 6f 6c 2d  db:get-prev-tol-
12910 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 73 74  for-test db test
12920 2d 69 64 20 63 61 74 65 67 6f 72 79 20 76 61 72  -id category var
12930 69 61 62 6c 65 29 0a 20 20 3b 3b 20 46 69 6e 69  iable).  ;; Fini
12940 73 68 20 6d 65 3f 0a 20 20 28 76 61 6c 75 65 73  sh me?.  (values
12950 20 23 66 20 23 66 20 23 66 29 29 0a 0a 3b 3b 3d   #f #f #f))..;;=
12960 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
12970 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
12980 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
12990 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
129a0 3d 3d 3d 3d 3d 0a 3b 3b 20 53 20 54 20 45 20 50  =====.;; S T E P
129b0 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d   S .;;==========
129c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
129d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
129e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
129f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64  ============..(d
12a00 65 66 69 6e 65 20 28 64 62 3a 73 74 65 70 2d 67  efine (db:step-g
12a10 65 74 2d 74 69 6d 65 2d 61 73 2d 73 74 72 69 6e  et-time-as-strin
12a20 67 20 76 65 63 29 0a 20 20 28 73 65 63 6f 6e 64  g vec).  (second
12a30 73 2d 3e 74 69 6d 65 2d 73 74 72 69 6e 67 20 28  s->time-string (
12a40 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e  db:step-get-even
12a50 74 5f 74 69 6d 65 20 76 65 63 29 29 29 0a 0a 3b  t_time vec)))..;
12a60 3b 20 64 62 2d 67 65 74 2d 74 65 73 74 2d 73 74  ; db-get-test-st
12a70 65 70 73 2d 66 6f 72 2d 72 75 6e 0a 28 64 65 66  eps-for-run.(def
12a80 69 6e 65 20 28 64 62 3a 67 65 74 2d 73 74 65 70  ine (db:get-step
12a90 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65  s-for-test db te
12aa0 73 74 2d 69 64 29 0a 20 20 28 6c 65 74 2a 20 28  st-id).  (let* (
12ab0 28 74 64 62 20 28 64 62 3a 6f 70 65 6e 2d 74 65  (tdb (db:open-te
12ac0 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64  st-db-by-test-id
12ad0 20 64 62 20 74 65 73 74 2d 69 64 29 29 0a 09 20   db test-id)).. 
12ae0 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 28  (res '())).    (
12af0 69 66 20 74 64 62 0a 09 28 62 65 67 69 6e 0a 09  if tdb..(begin..
12b00 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65    (sqlite3:for-e
12b10 61 63 68 2d 72 6f 77 20 0a 09 20 20 20 28 6c 61  ach-row ..   (la
12b20 6d 62 64 61 20 28 69 64 20 74 65 73 74 2d 69 64  mbda (id test-id
12b30 20 73 74 65 70 6e 61 6d 65 20 73 74 61 74 65 20   stepname state 
12b40 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d  status event-tim
12b50 65 20 6c 6f 67 66 69 6c 65 29 0a 09 20 20 20 20  e logfile)..    
12b60 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73   (set! res (cons
12b70 20 28 76 65 63 74 6f 72 20 69 64 20 74 65 73 74   (vector id test
12b80 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 73 74 61  -id stepname sta
12b90 74 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d  te status event-
12ba0 74 69 6d 65 20 28 69 66 20 28 73 74 72 69 6e 67  time (if (string
12bb0 3f 20 6c 6f 67 66 69 6c 65 29 20 6c 6f 67 66 69  ? logfile) logfi
12bc0 6c 65 20 22 22 29 29 20 72 65 73 29 29 29 0a 09  le "")) res)))..
12bd0 20 20 20 74 64 62 0a 09 20 20 20 22 53 45 4c 45     tdb..   "SELE
12be0 43 54 20 69 64 2c 74 65 73 74 5f 69 64 2c 73 74  CT id,test_id,st
12bf0 65 70 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61  epname,state,sta
12c00 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 6c  tus,event_time,l
12c10 6f 67 66 69 6c 65 20 46 52 4f 4d 20 74 65 73 74  ogfile FROM test
12c20 5f 73 74 65 70 73 20 57 48 45 52 45 20 74 65 73  _steps WHERE tes
12c30 74 5f 69 64 3d 3f 20 4f 52 44 45 52 20 42 59 20  t_id=? ORDER BY 
12c40 69 64 20 41 53 43 3b 22 20 3b 3b 20 65 76 65 6e  id ASC;" ;; even
12c50 74 5f 74 69 6d 65 20 44 45 53 43 2c 69 64 20 41  t_time DESC,id A
12c60 53 43 3b 0a 09 20 20 20 74 65 73 74 2d 69 64 29  SC;..   test-id)
12c70 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e  ..  (sqlite3:fin
12c80 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 20 20 28  alize! tdb)..  (
12c90 72 65 76 65 72 73 65 20 72 65 73 29 29 0a 09 27  reverse res))..'
12ca0 28 29 29 29 29 0a 0a 3b 3b 20 67 65 74 20 61 20  ())))..;; get a 
12cb0 70 72 65 74 74 79 20 74 61 62 6c 65 20 74 6f 20  pretty table to 
12cc0 73 75 6d 6d 61 72 69 7a 65 20 73 74 65 70 73 0a  summarize steps.
12cd0 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67  ;;.(define (db:g
12ce0 65 74 2d 73 74 65 70 73 2d 74 61 62 6c 65 20 64  et-steps-table d
12cf0 62 20 74 65 73 74 2d 69 64 29 0a 20 20 28 6c 65  b test-id).  (le
12d00 74 20 28 28 73 74 65 70 73 20 20 20 28 64 62 3a  t ((steps   (db:
12d10 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65  get-steps-for-te
12d20 73 74 20 64 62 20 74 65 73 74 2d 69 64 29 29 29  st db test-id)))
12d30 0a 20 20 20 20 3b 3b 20 6f 72 67 61 6e 69 73 65  .    ;; organise
12d40 20 74 68 65 20 73 74 65 70 73 20 66 6f 72 20 62   the steps for b
12d50 65 74 74 65 72 20 72 65 61 64 61 62 69 6c 69 74  etter readabilit
12d60 79 0a 20 20 20 20 28 6c 65 74 20 28 28 72 65 73  y.    (let ((res
12d70 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c   (make-hash-tabl
12d80 65 29 29 29 0a 20 20 20 20 20 20 28 66 6f 72 2d  e))).      (for-
12d90 65 61 63 68 20 0a 20 20 20 20 20 20 20 28 6c 61  each .       (la
12da0 6d 62 64 61 20 28 73 74 65 70 29 0a 09 20 28 64  mbda (step).. (d
12db0 65 62 75 67 3a 70 72 69 6e 74 20 36 20 22 73 74  ebug:print 6 "st
12dc0 65 70 3d 22 20 73 74 65 70 29 0a 09 20 28 6c 65  ep=" step).. (le
12dd0 74 20 28 28 72 65 63 6f 72 64 20 28 68 61 73 68  t ((record (hash
12de0 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75  -table-ref/defau
12df0 6c 74 20 0a 09 09 09 72 65 73 20 0a 09 09 09 28  lt ....res ....(
12e00 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 70  db:step-get-step
12e10 6e 61 6d 65 20 73 74 65 70 29 20 0a 09 09 09 3b  name step) ....;
12e20 3b 20 20 20 20 20 20 20 20 73 74 65 70 6e 61 6d  ;        stepnam
12e30 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  e               
12e40 20 73 74 61 72 74 20 65 6e 64 20 73 74 61 74 75   start end statu
12e50 73 20 20 20 20 0a 09 09 09 28 76 65 63 74 6f 72  s    ....(vector
12e60 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74   (db:step-get-st
12e70 65 70 6e 61 6d 65 20 73 74 65 70 29 20 22 22 20  epname step) "" 
12e80 20 20 22 22 20 22 22 20 20 20 20 20 22 22 20 22    "" ""     "" "
12e90 22 29 29 29 29 0a 09 20 20 20 28 64 65 62 75 67  "))))..   (debug
12ea0 3a 70 72 69 6e 74 20 36 20 22 72 65 63 6f 72 64  :print 6 "record
12eb0 28 62 65 66 6f 72 65 29 20 3d 20 22 20 72 65 63  (before) = " rec
12ec0 6f 72 64 20 0a 09 09 09 22 5c 6e 69 64 3a 20 20  ord ...."\nid:  
12ed0 20 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d       " (db:step-
12ee0 67 65 74 2d 69 64 20 73 74 65 70 29 0a 09 09 09  get-id step)....
12ef0 22 5c 6e 73 74 65 70 6e 61 6d 65 3a 20 22 20 28  "\nstepname: " (
12f00 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 70  db:step-get-step
12f10 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 09 22 5c  name step)...."\
12f20 6e 73 74 61 74 65 3a 20 20 20 20 22 20 28 64 62  nstate:    " (db
12f30 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20  :step-get-state 
12f40 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74  step)...."\nstat
12f50 75 73 3a 20 20 20 22 20 28 64 62 3a 73 74 65 70  us:   " (db:step
12f60 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 70  -get-status step
12f70 29 0a 09 09 09 22 5c 6e 74 69 6d 65 3a 20 20 20  )...."\ntime:   
12f80 20 20 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74    " (db:step-get
12f90 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 70  -event_time step
12fa0 29 29 0a 09 20 20 20 28 63 61 73 65 20 28 73 74  ))..   (case (st
12fb0 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 64 62  ring->symbol (db
12fc0 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20  :step-get-state 
12fd0 73 74 65 70 29 29 0a 09 20 20 20 20 20 28 28 73  step))..     ((s
12fe0 74 61 72 74 29 28 76 65 63 74 6f 72 2d 73 65 74  tart)(vector-set
12ff0 21 20 72 65 63 6f 72 64 20 31 20 28 64 62 3a 73  ! record 1 (db:s
13000 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69  tep-get-event_ti
13010 6d 65 20 73 74 65 70 29 29 0a 09 20 20 20 20 20  me step))..     
13020 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65   (vector-set! re
13030 63 6f 72 64 20 33 20 28 69 66 20 28 65 71 75 61  cord 3 (if (equa
13040 6c 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72  l? (vector-ref r
13050 65 63 6f 72 64 20 33 29 20 22 22 29 0a 09 09 09  ecord 3) "")....
13060 09 09 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73  ..(db:step-get-s
13070 74 61 74 75 73 20 73 74 65 70 29 29 29 0a 09 20  tatus step))).. 
13080 20 20 20 20 20 28 69 66 20 28 3e 20 28 73 74 72       (if (> (str
13090 69 6e 67 2d 6c 65 6e 67 74 68 20 28 64 62 3a 73  ing-length (db:s
130a0 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20  tep-get-logfile 
130b0 73 74 65 70 29 29 0a 09 09 20 20 20 20 20 30 29  step))...     0)
130c0 0a 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74  ...  (vector-set
130d0 21 20 72 65 63 6f 72 64 20 35 20 28 64 62 3a 73  ! record 5 (db:s
130e0 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20  tep-get-logfile 
130f0 73 74 65 70 29 29 29 29 0a 09 20 20 20 20 20 28  step))))..     (
13100 28 65 6e 64 29 20 20 0a 09 20 20 20 20 20 20 28  (end)  ..      (
13110 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f  vector-set! reco
13120 72 64 20 32 20 28 61 6e 79 2d 3e 6e 75 6d 62 65  rd 2 (any->numbe
13130 72 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65  r (db:step-get-e
13140 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 29  vent_time step))
13150 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 6f 72  )..      (vector
13160 2d 73 65 74 21 20 72 65 63 6f 72 64 20 33 20 28  -set! record 3 (
13170 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74  db:step-get-stat
13180 75 73 20 73 74 65 70 29 29 0a 09 20 20 20 20 20  us step))..     
13190 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65   (vector-set! re
131a0 63 6f 72 64 20 34 20 28 6c 65 74 20 28 28 73 74  cord 4 (let ((st
131b0 61 72 74 74 20 28 61 6e 79 2d 3e 6e 75 6d 62 65  artt (any->numbe
131c0 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65  r (vector-ref re
131d0 63 6f 72 64 20 31 29 29 29 0a 09 09 09 09 09 20  cord 1)))...... 
131e0 20 28 65 6e 64 74 20 20 20 28 61 6e 79 2d 3e 6e   (endt   (any->n
131f0 75 6d 62 65 72 20 28 76 65 63 74 6f 72 2d 72 65  umber (vector-re
13200 66 20 72 65 63 6f 72 64 20 32 29 29 29 29 0a 09  f record 2))))..
13210 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a  ...      (debug:
13220 70 72 69 6e 74 20 34 20 22 72 65 63 6f 72 64 5b  print 4 "record[
13230 31 5d 3d 22 20 28 76 65 63 74 6f 72 2d 72 65 66  1]=" (vector-ref
13240 20 72 65 63 6f 72 64 20 31 29 20 0a 09 09 09 09   record 1) .....
13250 09 09 20 20 20 22 2c 20 73 74 61 72 74 74 3d 22  ..   ", startt="
13260 20 73 74 61 72 74 74 20 22 2c 20 65 6e 64 74 3d   startt ", endt=
13270 22 20 65 6e 64 74 0a 09 09 09 09 09 09 20 20 20  " endt.......   
13280 22 2c 20 67 65 74 2d 73 74 61 74 75 73 3a 20 22  ", get-status: "
13290 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74   (db:step-get-st
132a0 61 74 75 73 20 73 74 65 70 29 29 0a 09 09 09 09  atus step)).....
132b0 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28        (if (and (
132c0 6e 75 6d 62 65 72 3f 20 73 74 61 72 74 74 29 28  number? startt)(
132d0 6e 75 6d 62 65 72 3f 20 65 6e 64 74 29 29 0a 09  number? endt))..
132e0 09 09 09 09 20 20 28 73 65 63 6f 6e 64 73 2d 3e  ....  (seconds->
132f0 68 72 2d 6d 69 6e 2d 73 65 63 20 28 2d 20 65 6e  hr-min-sec (- en
13300 64 74 20 73 74 61 72 74 74 29 29 20 22 2d 31 22  dt startt)) "-1"
13310 29 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 28  )))..      (if (
13320 3e 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68  > (string-length
13330 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 6c 6f   (db:step-get-lo
13340 67 66 69 6c 65 20 73 74 65 70 29 29 0a 09 09 20  gfile step))... 
13350 20 20 20 20 30 29 0a 09 09 20 20 28 76 65 63 74      0)...  (vect
13360 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 35  or-set! record 5
13370 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 6c 6f   (db:step-get-lo
13380 67 66 69 6c 65 20 73 74 65 70 29 29 29 29 0a 09  gfile step))))..
13390 20 20 20 20 20 28 65 6c 73 65 0a 09 20 20 20 20       (else..    
133a0 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72    (vector-set! r
133b0 65 63 6f 72 64 20 32 20 28 64 62 3a 73 74 65 70  ecord 2 (db:step
133c0 2d 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29  -get-state step)
133d0 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 6f 72  )..      (vector
133e0 2d 73 65 74 21 20 72 65 63 6f 72 64 20 33 20 28  -set! record 3 (
133f0 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74  db:step-get-stat
13400 75 73 20 73 74 65 70 29 29 0a 09 20 20 20 20 20  us step))..     
13410 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65   (vector-set! re
13420 63 6f 72 64 20 34 20 28 64 62 3a 73 74 65 70 2d  cord 4 (db:step-
13430 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73  get-event_time s
13440 74 65 70 29 29 29 29 0a 09 20 20 20 28 68 61 73  tep))))..   (has
13450 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73  h-table-set! res
13460 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74   (db:step-get-st
13470 65 70 6e 61 6d 65 20 73 74 65 70 29 20 72 65 63  epname step) rec
13480 6f 72 64 29 0a 09 20 20 20 28 64 65 62 75 67 3a  ord)..   (debug:
13490 70 72 69 6e 74 20 36 20 22 72 65 63 6f 72 64 28  print 6 "record(
134a0 61 66 74 65 72 29 20 20 3d 20 22 20 72 65 63 6f  after)  = " reco
134b0 72 64 20 0a 09 09 09 22 5c 6e 69 64 3a 20 20 20  rd ...."\nid:   
134c0 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d 67      " (db:step-g
134d0 65 74 2d 69 64 20 73 74 65 70 29 0a 09 09 09 22  et-id step)...."
134e0 5c 6e 73 74 65 70 6e 61 6d 65 3a 20 22 20 28 64  \nstepname: " (d
134f0 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 70 6e  b:step-get-stepn
13500 61 6d 65 20 73 74 65 70 29 0a 09 09 09 22 5c 6e  ame step)...."\n
13510 73 74 61 74 65 3a 20 20 20 20 22 20 28 64 62 3a  state:    " (db:
13520 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73  step-get-state s
13530 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 75  tep)...."\nstatu
13540 73 3a 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d  s:   " (db:step-
13550 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 70 29  get-status step)
13560 0a 09 09 09 22 5c 6e 74 69 6d 65 3a 20 20 20 20  ...."\ntime:    
13570 20 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d   " (db:step-get-
13580 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29  event_time step)
13590 29 29 29 0a 20 20 20 20 20 20 20 3b 3b 20 28 65  ))).       ;; (e
135a0 6c 73 65 20 20 20 28 76 65 63 74 6f 72 2d 73 65  lse   (vector-se
135b0 74 21 20 72 65 63 6f 72 64 20 31 20 28 64 62 3a  t! record 1 (db:
135c0 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74  step-get-event_t
135d0 69 6d 65 20 73 74 65 70 29 29 29 0a 20 20 20 20  ime step))).    
135e0 20 20 20 28 73 6f 72 74 20 73 74 65 70 73 20 28     (sort steps (
135f0 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 09 09 20  lambda (a b)... 
13600 20 20 20 20 28 63 6f 6e 64 0a 09 09 20 20 20 20      (cond...    
13610 20 20 28 28 3c 20 20 20 28 64 62 3a 73 74 65 70    ((<   (db:step
13620 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20  -get-event_time 
13630 61 29 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65  a)(db:step-get-e
13640 76 65 6e 74 5f 74 69 6d 65 20 62 29 29 20 23 74  vent_time b)) #t
13650 29 0a 09 09 20 20 20 20 20 20 28 28 65 71 3f 20  )...      ((eq? 
13660 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65  (db:step-get-eve
13670 6e 74 5f 74 69 6d 65 20 61 29 28 64 62 3a 73 74  nt_time a)(db:st
13680 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d  ep-get-event_tim
13690 65 20 62 29 29 20 0a 09 09 20 20 20 20 20 20 20  e b)) ...       
136a0 28 3c 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65  (<   (db:step-ge
136b0 74 2d 69 64 20 61 29 20 20 20 20 20 20 20 20 28  t-id a)        (
136c0 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 20 62  db:step-get-id b
136d0 29 29 29 0a 09 09 20 20 20 20 20 20 28 65 6c 73  )))...      (els
136e0 65 20 23 66 29 29 29 29 29 0a 20 20 20 20 20 20  e #f))))).      
136f0 72 65 73 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d  res)))..;;======
13700 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
13710 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
13720 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
13730 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
13740 0a 3b 3b 20 4d 20 49 20 53 20 43 20 20 20 4d 20  .;; M I S C   M 
13750 41 20 4e 20 41 20 47 20 45 20 4d 20 45 20 4e 20  A N A G E M E N 
13760 54 20 20 20 49 20 54 20 45 20 4d 20 53 20 0a 3b  T   I T E M S .;
13770 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ;===============
13780 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
13790 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
137a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
137b0 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 74 68 65 20  =======..;; the 
137c0 6e 65 77 20 70 72 65 72 65 71 73 20 63 61 6c 63  new prereqs calc
137d0 75 6c 61 74 69 6f 6e 2c 20 6c 6f 6f 6b 73 20 61  ulation, looks a
137e0 6c 73 6f 20 61 74 20 69 74 65 6d 70 61 74 68 20  lso at itempath 
137f0 69 66 20 73 70 65 63 69 66 69 65 64 0a 3b 3b 20  if specified.;; 
13800 61 6c 6c 20 70 72 65 72 65 71 73 20 6d 75 73 74  all prereqs must
13810 20 62 65 20 6d 65 74 3a 0a 3b 3b 20 20 20 20 69   be met:.;;    i
13820 66 20 70 72 65 72 65 71 20 74 65 73 74 20 77 69  f prereq test wi
13830 74 68 20 69 74 65 6d 70 61 74 68 3d 27 27 20 69  th itempath='' i
13840 73 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20  s COMPLETED and 
13850 50 41 53 53 2c 20 57 41 52 4e 2c 20 43 48 45 43  PASS, WARN, CHEC
13860 4b 2c 20 6f 72 20 57 41 49 56 45 44 20 74 68 65  K, or WAIVED the
13870 6e 20 70 72 65 72 65 71 20 69 73 20 6d 65 74 0a  n prereq is met.
13880 3b 3b 20 20 20 20 69 66 20 70 72 65 72 65 71 20  ;;    if prereq 
13890 74 65 73 74 20 77 69 74 68 20 69 74 65 6d 70 61  test with itempa
138a0 74 68 3d 72 65 66 2d 69 74 65 6d 2d 70 61 74 68  th=ref-item-path
138b0 20 61 6e 64 20 43 4f 4d 50 4c 45 54 45 44 20 77   and COMPLETED w
138c0 69 74 68 20 50 41 53 53 2c 20 57 41 52 4e 2c 20  ith PASS, WARN, 
138d0 43 48 45 43 4b 2c 20 6f 72 20 57 41 49 56 45 44  CHECK, or WAIVED
138e0 20 74 68 65 6e 20 70 72 65 72 65 71 20 69 73 20   then prereq is 
138f0 6d 65 74 0a 3b 3b 0a 3b 3b 20 4e 6f 74 65 3a 20  met.;;.;; Note: 
13900 64 6f 20 6e 6f 74 20 63 6f 6e 76 65 72 74 20 74  do not convert t
13910 6f 20 72 65 6d 6f 74 65 20 61 73 20 69 74 20 63  o remote as it c
13920 61 6c 6c 73 20 72 65 6d 6f 74 65 20 75 6e 64 65  alls remote unde
13930 72 20 74 68 65 20 68 6f 6f 64 0a 3b 3b 20 4e 6f  r the hood.;; No
13940 74 65 3a 20 6d 6f 64 65 20 27 6e 6f 72 6d 61 6c  te: mode 'normal
13950 20 6d 65 61 6e 73 20 74 68 61 74 20 74 65 73 74   means that test
13960 73 20 6d 75 73 74 20 62 65 20 43 4f 4d 50 4c 45  s must be COMPLE
13970 54 45 44 20 61 6e 64 20 6f 6b 20 28 69 2e 65 2e  TED and ok (i.e.
13980 20 50 41 53 53 2c 20 57 41 52 4e 2c 20 43 48 45   PASS, WARN, CHE
13990 43 4b 2c 20 53 4b 49 50 20 6f 72 20 57 41 49 56  CK, SKIP or WAIV
139a0 45 44 29 0a 3b 3b 20 20 20 20 20 20 20 6d 6f 64  ED).;;       mod
139b0 65 20 27 74 6f 70 6c 65 76 65 6c 20 6d 65 61 6e  e 'toplevel mean
139c0 73 20 74 68 61 74 20 74 65 73 74 73 20 6d 75 73  s that tests mus
139d0 74 20 62 65 20 43 4f 4d 50 4c 45 54 45 44 20 6f  t be COMPLETED o
139e0 6e 6c 79 0a 3b 3b 20 20 20 20 20 20 20 6d 6f 64  nly.;;       mod
139f0 65 20 27 69 74 65 6d 6d 61 74 63 68 20 6d 65 61  e 'itemmatch mea
13a00 6e 73 20 74 68 61 74 20 74 65 73 74 73 20 69 74  ns that tests it
13a10 65 6d 73 20 6d 75 73 74 20 62 65 20 43 4f 4d 50  ems must be COMP
13a20 4c 45 54 45 44 20 61 6e 64 20 28 50 41 53 53 7c  LETED and (PASS|
13a30 57 41 52 4e 7c 57 41 49 56 45 44 7c 43 48 45 43  WARN|WAIVED|CHEC
13a40 4b 29 20 5b 5b 20 4e 42 2f 2f 20 4e 4f 54 20 49  K) [[ NB// NOT I
13a50 4d 50 4c 45 4d 45 4e 54 45 44 20 59 45 54 20 5d  MPLEMENTED YET ]
13a60 5d 0a 3b 3b 20 0a 28 64 65 66 69 6e 65 20 28 64  ].;; .(define (d
13a70 62 3a 67 65 74 2d 70 72 65 72 65 71 73 2d 6e 6f  b:get-prereqs-no
13a80 74 2d 6d 65 74 20 64 62 20 72 75 6e 2d 69 64 20  t-met db run-id 
13a90 77 61 69 74 6f 6e 73 20 72 65 66 2d 69 74 65 6d  waitons ref-item
13aa0 2d 70 61 74 68 20 23 21 6b 65 79 20 28 6d 6f 64  -path #!key (mod
13ab0 65 20 27 6e 6f 72 6d 61 6c 29 29 0a 20 20 28 69  e 'normal)).  (i
13ac0 66 20 28 6f 72 20 28 6e 6f 74 20 77 61 69 74 6f  f (or (not waito
13ad0 6e 73 29 0a 09 20 20 28 6e 75 6c 6c 3f 20 77 61  ns)..  (null? wa
13ae0 69 74 6f 6e 73 29 29 0a 20 20 20 20 20 20 27 28  itons)).      '(
13af0 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28  ).      (let* ((
13b00 75 6e 6d 65 74 2d 70 72 65 2d 72 65 71 73 20 27  unmet-pre-reqs '
13b10 28 29 29 0a 09 20 20 20 20 20 28 72 65 73 75 6c  ())..     (resul
13b20 74 20 20 20 20 20 20 20 20 20 27 28 29 29 29 0a  t         '())).
13b30 09 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 28 6c  .(for-each .. (l
13b40 61 6d 62 64 61 20 28 77 61 69 74 6f 6e 74 65 73  ambda (waitontes
13b50 74 2d 6e 61 6d 65 29 0a 09 20 20 20 3b 3b 20 62  t-name)..   ;; b
13b60 79 20 67 65 74 74 69 6e 67 20 74 68 65 20 74 65  y getting the te
13b70 73 74 73 20 77 69 74 68 20 6d 61 74 63 68 69 6e  sts with matchin
13b80 67 20 6e 61 6d 65 20 77 65 20 61 72 65 20 6c 6f  g name we are lo
13b90 6f 6b 69 6e 67 20 6f 6e 6c 79 20 61 74 20 74 68  oking only at th
13ba0 65 20 6d 61 74 63 68 69 6e 67 20 74 65 73 74 20  e matching test 
13bb0 0a 09 20 20 20 3b 3b 20 61 6e 64 20 72 65 6c 61  ..   ;; and rela
13bc0 74 65 64 20 73 75 62 20 69 74 65 6d 73 0a 09 20  ted sub items.. 
13bd0 20 20 28 6c 65 74 20 28 28 74 65 73 74 73 20 20    (let ((tests  
13be0 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 67             (db:g
13bf0 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e  et-tests-for-run
13c00 20 64 62 20 72 75 6e 2d 69 64 20 77 61 69 74 6f   db run-id waito
13c10 6e 74 65 73 74 2d 6e 61 6d 65 20 27 28 29 20 27  ntest-name '() '
13c20 28 29 29 29 0a 09 09 20 28 65 76 65 72 2d 73 65  ()))... (ever-se
13c30 65 6e 20 20 20 20 20 20 20 20 20 23 66 29 0a 09  en         #f)..
13c40 09 20 28 70 61 72 65 6e 74 2d 77 61 69 74 6f 6e  . (parent-waiton
13c50 2d 6d 65 74 20 23 66 29 0a 09 09 20 28 69 74 65  -met #f)... (ite
13c60 6d 2d 77 61 69 74 6f 6e 2d 6d 65 74 20 20 20 23  m-waiton-met   #
13c70 66 29 29 0a 09 20 20 20 20 20 28 66 6f 72 2d 65  f))..     (for-e
13c80 61 63 68 20 0a 09 20 20 20 20 20 20 28 6c 61 6d  ach ..      (lam
13c90 62 64 61 20 28 74 65 73 74 29 0a 09 09 3b 3b 20  bda (test)...;; 
13ca0 28 69 66 20 28 65 71 75 61 6c 3f 20 77 61 69 74  (if (equal? wait
13cb0 6f 6e 74 65 73 74 2d 6e 61 6d 65 20 28 64 62 3a  ontest-name (db:
13cc0 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d  test-get-testnam
13cd0 65 20 74 65 73 74 29 29 20 3b 3b 20 62 79 20 64  e test)) ;; by d
13ce0 65 66 69 6e 74 69 6f 6e 20 74 68 69 73 20 68 61  efintion this ha
13cf0 64 20 62 65 74 74 65 72 20 62 65 20 74 72 75 65  d better be true
13d00 20 2e 2e 2e 0a 09 09 28 6c 65 74 2a 20 28 28 73   ......(let* ((s
13d10 74 61 74 65 20 20 20 20 20 20 20 20 20 20 20 20  tate            
13d20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74   (db:test-get-st
13d30 61 74 65 20 74 65 73 74 29 29 0a 09 09 20 20 20  ate test))...   
13d40 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 20      (status     
13d50 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d         (db:test-
13d60 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 29  get-status test)
13d70 29 0a 09 09 20 20 20 20 20 20 20 28 69 74 65 6d  )...       (item
13d80 2d 70 61 74 68 20 20 20 20 20 20 20 20 20 28 64  -path         (d
13d90 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d  b:test-get-item-
13da0 70 61 74 68 20 74 65 73 74 29 29 0a 09 09 20 20  path test))...  
13db0 20 20 20 20 20 28 69 73 2d 63 6f 6d 70 6c 65 74       (is-complet
13dc0 65 64 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20  ed      (equal? 
13dd0 73 74 61 74 65 20 22 43 4f 4d 50 4c 45 54 45 44  state "COMPLETED
13de0 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 73  "))...       (is
13df0 2d 6f 6b 20 20 20 20 20 20 20 20 20 20 20 20 20  -ok             
13e00 28 6d 65 6d 62 65 72 20 73 74 61 74 75 73 20 27  (member status '
13e10 28 22 50 41 53 53 22 20 22 57 41 52 4e 22 20 22  ("PASS" "WARN" "
13e20 43 48 45 43 4b 22 20 22 57 41 49 56 45 44 22 20  CHECK" "WAIVED" 
13e30 22 53 4b 49 50 22 29 29 29 0a 09 09 20 20 20 20  "SKIP")))...    
13e40 20 20 20 28 73 61 6d 65 2d 69 74 65 6d 70 61 74     (same-itempat
13e50 68 20 20 20 20 20 28 65 71 75 61 6c 3f 20 72 65  h     (equal? re
13e60 66 2d 69 74 65 6d 2d 70 61 74 68 20 69 74 65 6d  f-item-path item
13e70 2d 70 61 74 68 29 29 29 0a 09 09 20 20 28 73 65  -path)))...  (se
13e80 74 21 20 65 76 65 72 2d 73 65 65 6e 20 23 74 29  t! ever-seen #t)
13e90 0a 09 09 20 20 28 63 6f 6e 64 0a 09 09 20 20 20  ...  (cond...   
13ea0 3b 3b 20 63 61 73 65 20 31 2c 20 6e 6f 6e 2d 69  ;; case 1, non-i
13eb0 74 65 6d 20 28 70 61 72 65 6e 74 20 74 65 73 74  tem (parent test
13ec0 29 20 69 73 20 0a 09 09 20 20 20 28 28 61 6e 64  ) is ...   ((and
13ed0 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61   (equal? item-pa
13ee0 74 68 20 22 22 29 20 3b 3b 20 74 68 69 73 20 69  th "") ;; this i
13ef0 73 20 74 68 65 20 70 61 72 65 6e 74 20 74 65 73  s the parent tes
13f00 74 0a 09 09 09 20 69 73 2d 63 6f 6d 70 6c 65 74  t.... is-complet
13f10 65 64 0a 09 09 09 20 28 6f 72 20 69 73 2d 6f 6b  ed.... (or is-ok
13f20 20 28 65 71 3f 20 6d 6f 64 65 20 27 74 6f 70 6c   (eq? mode 'topl
13f30 65 76 65 6c 29 29 29 0a 09 09 20 20 20 20 28 73  evel)))...    (s
13f40 65 74 21 20 70 61 72 65 6e 74 2d 77 61 69 74 6f  et! parent-waito
13f50 6e 2d 6d 65 74 20 23 74 29 29 0a 09 09 20 20 20  n-met #t))...   
13f60 28 28 61 6e 64 20 73 61 6d 65 2d 69 74 65 6d 70  ((and same-itemp
13f70 61 74 68 0a 09 09 09 20 69 73 2d 63 6f 6d 70 6c  ath.... is-compl
13f80 65 74 65 64 0a 09 09 09 20 28 6f 72 20 69 73 2d  eted.... (or is-
13f90 6f 6b 20 28 65 71 3f 20 6d 6f 64 65 20 27 74 6f  ok (eq? mode 'to
13fa0 70 6c 65 76 65 6c 29 29 29 0a 09 09 20 20 20 20  plevel)))...    
13fb0 28 73 65 74 21 20 69 74 65 6d 2d 77 61 69 74 6f  (set! item-waito
13fc0 6e 2d 6d 65 74 20 23 74 29 29 29 29 29 0a 09 20  n-met #t))))).. 
13fd0 20 20 20 20 20 74 65 73 74 73 29 0a 09 20 20 20       tests)..   
13fe0 20 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 70    (if (not (or p
13ff0 61 72 65 6e 74 2d 77 61 69 74 6f 6e 2d 6d 65 74  arent-waiton-met
14000 20 69 74 65 6d 2d 77 61 69 74 6f 6e 2d 6d 65 74   item-waiton-met
14010 29 29 0a 09 09 20 28 73 65 74 21 20 72 65 73 75  ))... (set! resu
14020 6c 74 20 28 61 70 70 65 6e 64 20 28 69 66 20 28  lt (append (if (
14030 6e 75 6c 6c 3f 20 74 65 73 74 73 29 20 28 6c 69  null? tests) (li
14040 73 74 20 77 61 69 74 6f 6e 74 65 73 74 2d 6e 61  st waitontest-na
14050 6d 65 29 20 74 65 73 74 73 29 20 72 65 73 75 6c  me) tests) resul
14060 74 29 29 29 0a 09 20 20 20 20 20 3b 3b 20 69 66  t)))..     ;; if
14070 20 74 68 65 20 74 65 73 74 20 69 73 20 6e 6f 74   the test is not
14080 20 66 6f 75 6e 64 20 74 68 65 6e 20 63 6c 65 61   found then clea
14090 72 6c 79 20 74 68 65 20 77 61 69 74 6f 6e 20 69  rly the waiton i
140a0 73 20 6e 6f 74 20 6d 65 74 2e 2e 2e 0a 09 20 20  s not met.....  
140b0 20 20 20 3b 3b 20 28 69 66 20 28 6e 6f 74 20 65     ;; (if (not e
140c0 76 65 72 2d 73 65 65 6e 29 28 73 65 74 21 20 72  ver-seen)(set! r
140d0 65 73 75 6c 74 20 28 63 6f 6e 73 20 77 61 69 74  esult (cons wait
140e0 6f 6e 74 65 73 74 2d 6e 61 6d 65 20 72 65 73 75  ontest-name resu
140f0 6c 74 29 29 29 29 29 0a 09 20 20 20 20 20 28 69  lt)))))..     (i
14100 66 20 28 6e 6f 74 20 65 76 65 72 2d 73 65 65 6e  f (not ever-seen
14110 29 0a 09 09 20 28 73 65 74 21 20 72 65 73 75 6c  )... (set! resul
14120 74 20 28 61 70 70 65 6e 64 20 28 69 66 20 28 6e  t (append (if (n
14130 75 6c 6c 3f 20 74 65 73 74 73 29 28 6c 69 73 74  ull? tests)(list
14140 20 77 61 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65   waitontest-name
14150 29 20 74 65 73 74 73 29 20 72 65 73 75 6c 74 29  ) tests) result)
14160 29 29 29 29 0a 09 20 77 61 69 74 6f 6e 73 29 0a  )))).. waitons).
14170 09 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61  .(delete-duplica
14180 74 65 73 20 72 65 73 75 6c 74 29 29 29 29 0a 0a  tes result))))..
14190 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74  (define (db:test
141a0 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21  step-set-status!
141b0 20 64 62 20 74 65 73 74 2d 69 64 20 74 65 73 74   db test-id test
141c0 73 74 65 70 2d 6e 61 6d 65 20 73 74 61 74 65 2d  step-name state-
141d0 69 6e 20 73 74 61 74 75 73 2d 69 6e 20 63 6f 6d  in status-in com
141e0 6d 65 6e 74 20 6c 6f 67 66 69 6c 65 29 0a 20 20  ment logfile).  
141f0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22  (debug:print 4 "
14200 74 65 73 74 2d 69 64 3a 20 22 20 74 65 73 74 2d  test-id: " test-
14210 69 64 20 22 20 74 65 73 74 73 74 65 70 2d 6e 61  id " teststep-na
14220 6d 65 3a 20 22 20 74 65 73 74 73 74 65 70 2d 6e  me: " teststep-n
14230 61 6d 65 29 0a 20 20 3b 3b 20 20 20 20 20 20 20  ame).  ;;       
14240 20 20 20 20 20 20 20 20 20 20 64 62 3a 6f 70 65            db:ope
14250 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 73  n-test-db-by-tes
14260 74 2d 69 64 20 64 6f 65 73 20 63 64 62 3a 72 65  t-id does cdb:re
14270 6d 6f 74 65 2d 72 75 6e 0a 20 20 28 6c 65 74 2a  mote-run.  (let*
14280 20 28 28 74 64 62 20 20 20 20 20 20 20 28 64 62   ((tdb       (db
14290 3a 6f 70 65 6e 2d 74 65 73 74 2d 64 62 2d 62 79  :open-test-db-by
142a0 2d 74 65 73 74 2d 69 64 20 64 62 20 74 65 73 74  -test-id db test
142b0 2d 69 64 29 29 0a 09 20 28 73 74 61 74 65 20 20  -id)).. (state  
142c0 20 20 20 28 69 74 65 6d 73 3a 63 68 65 63 6b 2d     (items:check-
142d0 76 61 6c 69 64 2d 69 74 65 6d 73 20 22 73 74 61  valid-items "sta
142e0 74 65 22 20 73 74 61 74 65 2d 69 6e 29 29 0a 09  te" state-in))..
142f0 20 28 73 74 61 74 75 73 20 20 20 20 28 69 74 65   (status    (ite
14300 6d 73 3a 63 68 65 63 6b 2d 76 61 6c 69 64 2d 69  ms:check-valid-i
14310 74 65 6d 73 20 22 73 74 61 74 75 73 22 20 73 74  tems "status" st
14320 61 74 75 73 2d 69 6e 29 29 29 0a 20 20 20 20 28  atus-in))).    (
14330 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 74  if (or (not stat
14340 65 29 28 6e 6f 74 20 73 74 61 74 75 73 29 29 0a  e)(not status)).
14350 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20  .(debug:print 3 
14360 22 57 41 52 4e 49 4e 47 3a 20 49 6e 76 61 6c 69  "WARNING: Invali
14370 64 20 22 20 28 69 66 20 73 74 61 74 75 73 20 22  d " (if status "
14380 73 74 61 74 75 73 22 20 22 73 74 61 74 65 22 29  status" "state")
14390 0a 09 09 20 20 20 20 20 22 20 76 61 6c 75 65 20  ...     " value 
143a0 5c 22 22 20 28 69 66 20 73 74 61 74 75 73 20 73  \"" (if status s
143b0 74 61 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69  tate-in status-i
143c0 6e 29 20 22 5c 22 2c 20 75 70 64 61 74 65 20 79  n) "\", update y
143d0 6f 75 72 20 76 61 6c 69 64 76 61 6c 75 65 73 20  our validvalues 
143e0 73 65 63 74 69 6f 6e 20 69 6e 20 6d 65 67 61 74  section in megat
143f0 65 73 74 2e 63 6f 6e 66 69 67 22 29 29 0a 20 20  est.config")).  
14400 20 20 28 69 66 20 74 64 62 0a 09 28 62 65 67 69    (if tdb..(begi
14410 6e 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78  n..  (sqlite3:ex
14420 65 63 75 74 65 20 0a 09 20 20 20 74 64 62 0a 09  ecute ..   tdb..
14430 20 20 20 22 49 4e 53 45 52 54 20 4f 52 20 52 45     "INSERT OR RE
14440 50 4c 41 43 45 20 69 6e 74 6f 20 74 65 73 74 5f  PLACE into test_
14450 73 74 65 70 73 20 28 74 65 73 74 5f 69 64 2c 73  steps (test_id,s
14460 74 65 70 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74  tepname,state,st
14470 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c  atus,event_time,
14480 63 6f 6d 6d 65 6e 74 2c 6c 6f 67 66 69 6c 65 29  comment,logfile)
14490 20 56 41 4c 55 45 53 28 3f 2c 3f 2c 3f 2c 3f 2c   VALUES(?,?,?,?,
144a0 3f 2c 3f 2c 3f 29 3b 22 0a 09 20 20 20 74 65 73  ?,?,?);"..   tes
144b0 74 2d 69 64 20 74 65 73 74 73 74 65 70 2d 6e 61  t-id teststep-na
144c0 6d 65 20 73 74 61 74 65 2d 69 6e 20 73 74 61 74  me state-in stat
144d0 75 73 2d 69 6e 20 28 63 75 72 72 65 6e 74 2d 73  us-in (current-s
144e0 65 63 6f 6e 64 73 29 20 28 69 66 20 63 6f 6d 6d  econds) (if comm
144f0 65 6e 74 20 63 6f 6d 6d 65 6e 74 20 22 22 29 20  ent comment "") 
14500 28 69 66 20 6c 6f 67 66 69 6c 65 20 6c 6f 67 66  (if logfile logf
14510 69 6c 65 20 22 22 29 29 0a 09 20 20 28 73 71 6c  ile ""))..  (sql
14520 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74  ite3:finalize! t
14530 64 62 29 0a 09 20 20 23 74 29 0a 09 23 66 29 29  db)..  #t)..#f))
14540 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  )..;;===========
14550 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
14560 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
14570 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
14580 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45  ===========.;; E
14590 78 74 72 61 63 74 20 6f 64 73 20 66 69 6c 65 20  xtract ods file 
145a0 66 72 6f 6d 20 74 68 65 20 64 62 0a 3b 3b 3d 3d  from the db.;;==
145b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
145c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
145d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
145e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
145f0 3d 3d 3d 3d 0a 0a 3b 3b 20 72 75 6e 73 70 61 74  ====..;; runspat
14600 74 20 69 73 20 61 20 63 6f 6d 6d 61 20 64 65 6c  t is a comma del
14610 69 6d 69 74 65 64 20 6c 69 73 74 20 6f 66 20 72  imited list of r
14620 75 6e 20 70 61 74 74 65 72 6e 73 0a 3b 3b 20 6b  un patterns.;; k
14630 65 79 70 61 74 74 2d 61 6c 69 73 74 20 6d 75 73  eypatt-alist mus
14640 74 20 63 6f 6e 74 61 69 6e 20 2a 61 6c 6c 2a 20  t contain *all* 
14650 6b 65 79 73 20 77 69 74 68 20 61 6e 20 61 73 73  keys with an ass
14660 6f 63 69 61 74 65 64 20 70 61 74 74 65 72 6e 3a  ociated pattern:
14670 20 27 28 20 28 22 4b 45 59 31 22 20 22 25 22 29   '( ("KEY1" "%")
14680 20 2e 2e 20 29 0a 28 64 65 66 69 6e 65 20 28 64   .. ).(define (d
14690 62 3a 65 78 74 72 61 63 74 2d 6f 64 73 2d 66 69  b:extract-ods-fi
146a0 6c 65 20 64 62 20 6f 75 74 70 75 74 66 69 6c 65  le db outputfile
146b0 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 74 20 72   keypatt-alist r
146c0 75 6e 73 70 61 74 74 20 70 61 74 68 6d 6f 64 29  unspatt pathmod)
146d0 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 73  .  (let* ((keyss
146e0 74 72 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65  tr  (string-inte
146f0 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 61 72  rsperse (map car
14700 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 74 29 20   keypatt-alist) 
14710 22 2c 22 29 29 0a 09 20 28 6b 65 79 71 72 79 20  ",")).. (keyqry 
14720 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73    (string-inters
14730 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62  perse (map (lamb
14740 64 61 20 28 70 29 28 63 6f 6e 63 20 28 63 61 72  da (p)(conc (car
14750 20 70 29 20 22 20 4c 49 4b 45 20 3f 20 22 29 29   p) " LIKE ? "))
14760 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 74 29 20   keypatt-alist) 
14770 22 20 41 4e 44 20 22 29 29 0a 09 20 28 6e 75 6d  " AND ")).. (num
14780 6b 65 79 73 20 20 28 6c 65 6e 67 74 68 20 6b 65  keys  (length ke
14790 79 70 61 74 74 2d 61 6c 69 73 74 29 29 0a 09 20  ypatt-alist)).. 
147a0 28 74 65 73 74 2d 69 64 73 20 27 28 29 29 0a 09  (test-ids '())..
147b0 20 28 77 69 6e 64 6f 77 73 20 20 28 61 6e 64 20   (windows  (and 
147c0 70 61 74 68 6d 6f 64 20 28 73 75 62 73 74 72 69  pathmod (substri
147d0 6e 67 2d 69 6e 64 65 78 20 22 5c 5c 22 20 70 61  ng-index "\\" pa
147e0 74 68 6d 6f 64 29 29 29 0a 09 20 28 74 65 6d 70  thmod))).. (temp
147f0 64 69 72 20 20 28 63 6f 6e 63 20 22 2f 74 6d 70  dir  (conc "/tmp
14800 2f 22 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72  /" (current-user
14810 2d 6e 61 6d 65 29 20 22 2f 22 20 72 75 6e 73 70  -name) "/" runsp
14820 61 74 74 20 22 5f 22 20 28 72 61 6e 64 6f 6d 20  att "_" (random 
14830 31 30 30 30 30 29 20 22 5f 22 20 28 63 75 72 72  10000) "_" (curr
14840 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29  ent-process-id))
14850 29 0a 09 20 28 72 75 6e 73 68 65 61 64 65 72 20  ).. (runsheader 
14860 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 22 52  (append (list "R
14870 75 6e 20 49 64 22 20 22 52 75 6e 6e 61 6d 65 22  un Id" "Runname"
14880 29 20 3b 20 30 20 31 0a 09 09 09 20 20 20 20 20  ) ; 0 1....     
14890 28 6d 61 70 20 63 61 72 20 6b 65 79 70 61 74 74  (map car keypatt
148a0 2d 61 6c 69 73 74 29 20 20 20 3b 20 2b 20 4e 20  -alist)   ; + N 
148b0 3d 20 6c 65 6e 67 74 68 20 6b 65 79 70 61 74 74  = length keypatt
148c0 2d 61 6c 69 73 74 0a 09 09 09 20 20 20 20 20 28  -alist....     (
148d0 6c 69 73 74 20 22 54 65 73 74 6e 61 6d 65 22 20  list "Testname" 
148e0 20 20 20 20 20 20 20 20 20 3b 20 32 0a 09 09 09           ; 2....
148f0 09 20 20 20 22 49 74 65 6d 20 50 61 74 68 22 20  .   "Item Path" 
14900 20 20 20 20 20 20 20 20 3b 20 33 20 0a 09 09 09          ; 3 ....
14910 09 20 20 20 22 44 65 73 63 72 69 70 74 69 6f 6e  .   "Description
14920 22 20 20 20 20 20 20 20 3b 20 34 20 0a 09 09 09  "       ; 4 ....
14930 09 20 20 20 22 53 74 61 74 65 22 20 20 20 20 20  .   "State"     
14940 20 20 20 20 20 20 20 20 3b 20 35 20 0a 09 09 09          ; 5 ....
14950 09 20 20 20 22 53 74 61 74 75 73 22 20 20 20 20  .   "Status"    
14960 20 20 20 20 20 20 20 20 3b 20 36 20 20 0a 09 09          ; 6  ...
14970 09 09 20 20 20 22 46 69 6e 61 6c 20 4c 6f 67 22  ..   "Final Log"
14980 20 20 20 20 20 20 20 20 20 3b 20 37 20 0a 09 09           ; 7 ...
14990 09 09 20 20 20 22 52 75 6e 20 44 75 72 61 74 69  ..   "Run Durati
149a0 6f 6e 22 20 20 20 20 20 20 3b 20 38 20 0a 09 09  on"      ; 8 ...
149b0 09 09 20 20 20 22 57 68 65 6e 20 52 75 6e 22 20  ..   "When Run" 
149c0 20 20 20 20 20 20 20 20 20 3b 20 39 20 0a 09 09           ; 9 ...
149d0 09 09 20 20 20 22 54 61 67 73 22 20 20 20 20 20  ..   "Tags"     
149e0 20 20 20 20 20 20 20 20 20 3b 20 31 30 0a 09 09           ; 10...
149f0 09 09 20 20 20 22 52 75 6e 20 4f 77 6e 65 72 22  ..   "Run Owner"
14a00 20 20 20 20 20 20 20 20 20 3b 20 31 31 0a 09 09           ; 11...
14a10 09 09 20 20 20 22 43 6f 6d 6d 65 6e 74 22 20 20  ..   "Comment"  
14a20 20 20 20 20 20 20 20 20 20 3b 20 31 32 0a 09 09           ; 12...
14a30 09 09 20 20 20 22 41 75 74 68 6f 72 22 20 20 20  ..   "Author"   
14a40 20 20 20 20 20 20 20 20 20 3b 20 31 33 0a 09 09           ; 13...
14a50 09 09 20 20 20 22 54 65 73 74 20 4f 77 6e 65 72  ..   "Test Owner
14a60 22 20 20 20 20 20 20 20 20 3b 20 31 34 0a 09 09  "        ; 14...
14a70 09 09 20 20 20 22 52 65 76 69 65 77 65 64 22 20  ..   "Reviewed" 
14a80 20 20 20 20 20 20 20 20 20 3b 20 31 35 0a 09 09           ; 15...
14a90 09 09 20 20 20 22 44 69 73 6b 66 72 65 65 22 20  ..   "Diskfree" 
14aa0 20 20 20 20 20 20 20 20 20 3b 20 31 36 0a 09 09           ; 16...
14ab0 09 09 20 20 20 22 55 6e 61 6d 65 22 20 20 20 20  ..   "Uname"    
14ac0 20 20 20 20 20 20 20 20 20 3b 20 31 37 0a 09 09           ; 17...
14ad0 09 09 20 20 20 22 52 75 6e 64 69 72 22 20 20 20  ..   "Rundir"   
14ae0 20 20 20 20 20 20 20 20 20 3b 20 31 38 0a 09 09           ; 18...
14af0 09 09 20 20 20 22 48 6f 73 74 22 20 20 20 20 20  ..   "Host"     
14b00 20 20 20 20 20 20 20 20 20 3b 20 31 39 0a 09 09           ; 19...
14b10 09 09 20 20 20 22 43 70 75 20 4c 6f 61 64 22 20  ..   "Cpu Load" 
14b20 20 20 20 20 20 20 20 20 20 3b 20 32 30 0a 09 09           ; 20...
14b30 09 09 20 20 20 29 29 29 0a 09 20 28 72 65 73 75  ..   ))).. (resu
14b40 6c 74 73 20 28 6c 69 73 74 20 72 75 6e 73 68 65  lts (list runshe
14b50 61 64 65 72 29 29 09 09 09 20 0a 09 20 28 74 65  ader))... .. (te
14b60 73 74 64 61 74 61 2d 68 65 61 64 65 72 20 28 6c  stdata-header (l
14b70 69 73 74 20 22 52 75 6e 20 49 64 22 20 22 54 65  ist "Run Id" "Te
14b80 73 74 6e 61 6d 65 22 20 22 49 74 65 6d 20 50 61  stname" "Item Pa
14b90 74 68 22 20 22 43 61 74 65 67 6f 72 79 22 20 22  th" "Category" "
14ba0 56 61 72 69 61 62 6c 65 22 20 22 56 61 6c 75 65  Variable" "Value
14bb0 22 20 22 45 78 70 65 63 74 65 64 22 20 22 54 6f  " "Expected" "To
14bc0 6c 22 20 22 55 6e 69 74 73 22 20 22 53 74 61 74  l" "Units" "Stat
14bd0 75 73 22 20 22 43 6f 6d 6d 65 6e 74 22 29 29 0a  us" "Comment")).
14be0 09 20 28 6d 61 69 6e 71 72 79 20 28 63 6f 6e 63  . (mainqry (conc
14bf0 20 22 53 45 4c 45 43 54 0a 20 20 20 20 20 20 20   "SELECT.       
14c00 20 20 20 20 20 20 20 74 2e 74 65 73 74 6e 61 6d         t.testnam
14c10 65 2c 72 2e 69 64 2c 72 75 6e 6e 61 6d 65 2c 22  e,r.id,runname,"
14c20 20 6b 65 79 73 73 74 72 20 22 2c 74 2e 74 65 73   keysstr ",t.tes
14c30 74 6e 61 6d 65 2c 0a 20 20 20 20 20 20 20 20 20  tname,.         
14c40 20 20 20 20 20 74 2e 69 74 65 6d 5f 70 61 74 68       t.item_path
14c50 2c 74 6d 2e 64 65 73 63 72 69 70 74 69 6f 6e 2c  ,tm.description,
14c60 74 2e 73 74 61 74 65 2c 74 2e 73 74 61 74 75 73  t.state,t.status
14c70 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ,.              
14c80 66 69 6e 61 6c 5f 6c 6f 67 66 2c 72 75 6e 5f 64  final_logf,run_d
14c90 75 72 61 74 69 6f 6e 2c 20 0a 20 20 20 20 20 20  uration, .      
14ca0 20 20 20 20 20 20 20 20 73 74 72 66 74 69 6d 65          strftime
14cb0 28 27 25 6d 2f 25 64 2f 25 59 20 25 48 3a 25 4d  ('%m/%d/%Y %H:%M
14cc0 3a 25 53 27 2c 64 61 74 65 74 69 6d 65 28 74 2e  :%S',datetime(t.
14cd0 65 76 65 6e 74 5f 74 69 6d 65 2c 27 75 6e 69 78  event_time,'unix
14ce0 65 70 6f 63 68 27 29 2c 27 6c 6f 63 61 6c 74 69  epoch'),'localti
14cf0 6d 65 27 29 2c 0a 20 20 20 20 20 20 20 20 20 20  me'),.          
14d00 20 20 20 20 74 6d 2e 74 61 67 73 2c 72 2e 6f 77      tm.tags,r.ow
14d10 6e 65 72 2c 74 2e 63 6f 6d 6d 65 6e 74 2c 0a 20  ner,t.comment,. 
14d20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 75 74               aut
14d30 68 6f 72 2c 0a 20 20 20 20 20 20 20 20 20 20 20  hor,.           
14d40 20 20 20 74 6d 2e 6f 77 6e 65 72 2c 72 65 76 69     tm.owner,revi
14d50 65 77 65 64 2c 0a 20 20 20 20 20 20 20 20 20 20  ewed,.          
14d60 20 20 20 20 64 69 73 6b 66 72 65 65 2c 75 6e 61      diskfree,una
14d70 6d 65 2c 72 75 6e 64 69 72 2c 0a 20 20 20 20 20  me,rundir,.     
14d80 20 20 20 20 20 20 20 20 20 68 6f 73 74 2c 63 70           host,cp
14d90 75 6c 6f 61 64 0a 20 20 20 20 20 20 20 20 20 20  uload.          
14da0 20 20 46 52 4f 4d 20 74 65 73 74 73 20 41 53 20    FROM tests AS 
14db0 74 20 4a 4f 49 4e 20 72 75 6e 73 20 41 53 20 72  t JOIN runs AS r
14dc0 20 4f 4e 20 74 2e 72 75 6e 5f 69 64 3d 72 2e 69   ON t.run_id=r.i
14dd0 64 20 4a 4f 49 4e 20 74 65 73 74 5f 6d 65 74 61  d JOIN test_meta
14de0 20 41 53 20 74 6d 20 4f 4e 20 74 6d 2e 74 65 73   AS tm ON tm.tes
14df0 74 6e 61 6d 65 3d 74 2e 74 65 73 74 6e 61 6d 65  tname=t.testname
14e00 0a 20 20 20 20 20 20 20 20 20 20 20 20 57 48 45  .            WHE
14e10 52 45 20 72 75 6e 6e 61 6d 65 20 4c 49 4b 45 20  RE runname LIKE 
14e20 3f 20 41 4e 44 20 22 20 6b 65 79 71 72 79 20 22  ? AND " keyqry "
14e30 3b 22 29 29 29 0a 20 20 20 20 28 64 65 62 75 67  ;"))).    (debug
14e40 3a 70 72 69 6e 74 20 32 20 22 55 73 69 6e 67 20  :print 2 "Using 
14e50 22 20 74 65 6d 70 64 69 72 20 22 20 66 6f 72 20  " tempdir " for 
14e60 63 6f 6e 73 74 72 75 63 74 69 6e 67 20 74 68 65  constructing the
14e70 20 6f 64 73 20 66 69 6c 65 2e 20 6b 65 79 71 72   ods file. keyqr
14e80 79 3a 20 22 20 6b 65 79 71 72 79 20 22 20 6b 65  y: " keyqry " ke
14e90 79 73 74 72 3a 20 22 20 6b 65 79 73 73 74 72 20  ystr: " keysstr 
14ea0 22 20 77 69 74 68 20 6b 65 79 73 3a 20 22 20 28  " with keys: " (
14eb0 6d 61 70 20 63 61 64 72 20 6b 65 79 70 61 74 74  map cadr keypatt
14ec0 2d 61 6c 69 73 74 29 0a 09 09 20 22 5c 6e 20 20  -alist)... "\n  
14ed0 20 20 20 20 6d 61 69 6e 71 72 79 3a 20 22 20 6d      mainqry: " m
14ee0 61 69 6e 71 72 79 29 0a 20 20 20 20 3b 3b 20 22  ainqry).    ;; "
14ef0 45 78 70 65 63 74 65 64 20 56 61 6c 75 65 22 0a  Expected Value".
14f00 20 20 20 20 3b 3b 20 22 56 61 6c 75 65 20 46 6f      ;; "Value Fo
14f10 75 6e 64 22 0a 20 20 20 20 3b 3b 20 22 54 6f 6c  und".    ;; "Tol
14f20 65 72 61 6e 63 65 22 0a 20 20 20 20 28 61 70 70  erance".    (app
14f30 6c 79 20 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65  ly sqlite3:for-e
14f40 61 63 68 2d 72 6f 77 0a 09 20 20 20 28 6c 61 6d  ach-row..   (lam
14f50 62 64 61 20 28 74 65 73 74 2d 69 64 20 2e 20 62  bda (test-id . b
14f60 29 0a 09 20 20 20 20 20 28 73 65 74 21 20 74 65  )..     (set! te
14f70 73 74 2d 69 64 73 20 28 63 6f 6e 73 20 74 65 73  st-ids (cons tes
14f80 74 2d 69 64 20 74 65 73 74 2d 69 64 73 29 29 20  t-id test-ids)) 
14f90 20 20 3b 3b 20 74 65 73 74 2d 69 64 20 69 73 20    ;; test-id is 
14fa0 6e 6f 77 20 74 65 73 74 6e 61 6d 65 0a 09 20 20  now testname..  
14fb0 20 20 20 28 73 65 74 21 20 72 65 73 75 6c 74 73     (set! results
14fc0 20 28 61 70 70 65 6e 64 20 72 65 73 75 6c 74 73   (append results
14fd0 20 3b 3b 20 6e 6f 74 65 2c 20 64 72 6f 70 20 74   ;; note, drop t
14fe0 68 65 20 74 65 73 74 2d 69 64 0a 09 09 09 09 20  he test-id..... 
14ff0 20 20 28 6c 69 73 74 0a 09 09 09 09 20 20 20 20    (list.....    
15000 28 69 66 20 70 61 74 68 6d 6f 64 0a 09 09 09 09  (if pathmod.....
15010 09 28 6c 65 74 2a 20 28 28 76 62 20 20 20 20 20  .(let* ((vb     
15020 20 20 20 28 61 70 70 6c 79 20 76 65 63 74 6f 72     (apply vector
15030 20 62 29 29 0a 09 09 09 09 09 20 20 20 20 20 20   b))......      
15040 20 28 6b 65 79 76 61 6c 73 20 20 20 28 6c 65 74   (keyvals   (let
15050 20 6c 6f 6f 70 20 28 28 69 20 20 20 20 30 29 0a   loop ((i    0).
15060 09 09 09 09 09 09 09 09 20 20 20 20 20 28 72 65  ........     (re
15070 73 20 27 28 29 29 29 0a 09 09 09 09 09 09 09 20  s '()))........ 
15080 20 20 20 28 69 66 20 28 3e 3d 20 69 20 6e 75 6d     (if (>= i num
15090 6b 65 79 73 29 0a 09 09 09 09 09 09 09 09 72 65  keys).........re
150a0 73 0a 09 09 09 09 09 09 09 09 28 6c 6f 6f 70 20  s.........(loop 
150b0 28 2b 20 69 20 31 29 0a 09 09 09 09 09 09 09 09  (+ i 1).........
150c0 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 72 65        (append re
150d0 73 20 28 6c 69 73 74 20 28 76 65 63 74 6f 72 2d  s (list (vector-
150e0 72 65 66 20 76 62 20 28 2b 20 69 20 32 29 29 29  ref vb (+ i 2)))
150f0 29 29 29 29 29 0a 09 09 09 09 09 20 20 20 20 20  )))))......     
15100 20 20 28 72 75 6e 6e 61 6d 65 20 20 20 28 76 65    (runname   (ve
15110 63 74 6f 72 2d 72 65 66 20 76 62 20 31 29 29 0a  ctor-ref vb 1)).
15120 09 09 09 09 09 20 20 20 20 20 20 20 28 74 65 73  .....       (tes
15130 74 6e 61 6d 65 20 20 28 76 65 63 74 6f 72 2d 72  tname  (vector-r
15140 65 66 20 76 62 20 28 2b 20 20 32 20 6e 75 6d 6b  ef vb (+  2 numk
15150 65 79 73 29 29 29 0a 09 09 09 09 09 20 20 20 20  eys)))......    
15160 20 20 20 28 69 74 65 6d 2d 70 61 74 68 20 28 76     (item-path (v
15170 65 63 74 6f 72 2d 72 65 66 20 76 62 20 28 2b 20  ector-ref vb (+ 
15180 20 33 20 6e 75 6d 6b 65 79 73 29 29 29 0a 09 09   3 numkeys)))...
15190 09 09 09 20 20 20 20 20 20 20 28 66 69 6e 61 6c  ...       (final
151a0 2d 6c 6f 67 20 28 76 65 63 74 6f 72 2d 72 65 66  -log (vector-ref
151b0 20 76 62 20 28 2b 20 20 37 20 6e 75 6d 6b 65 79   vb (+  7 numkey
151c0 73 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 20  s)))......      
151d0 20 28 72 75 6e 2d 64 69 72 20 20 20 28 76 65 63   (run-dir   (vec
151e0 74 6f 72 2d 72 65 66 20 76 62 20 28 2b 20 31 38  tor-ref vb (+ 18
151f0 20 6e 75 6d 6b 65 79 73 29 29 29 0a 09 09 09 09   numkeys))).....
15200 09 20 20 20 20 20 20 20 28 6c 6f 67 2d 66 70 61  .       (log-fpa
15210 74 68 20 28 63 6f 6e 63 20 72 75 6e 2d 64 69 72  th (conc run-dir
15220 20 22 2f 22 20 20 66 69 6e 61 6c 2d 6c 6f 67 29   "/"  final-log)
15230 29 29 20 3b 3b 20 28 73 74 72 69 6e 67 2d 69 6e  )) ;; (string-in
15240 74 65 72 73 70 65 72 73 65 20 6b 65 79 76 61 6c  tersperse keyval
15250 73 20 22 2f 22 29 20 22 2f 22 20 74 65 73 74 6e  s "/") "/" testn
15260 61 6d 65 20 22 2f 22 20 69 74 65 6d 2d 70 61 74  ame "/" item-pat
15270 68 20 22 2f 22 0a 09 09 09 09 09 20 20 28 64 65  h "/"......  (de
15280 62 75 67 3a 70 72 69 6e 74 20 34 20 22 6c 6f 67  bug:print 4 "log
15290 3a 20 22 20 6c 6f 67 2d 66 70 61 74 68 20 22 20  : " log-fpath " 
152a0 65 78 69 73 74 73 3a 20 22 20 28 66 69 6c 65 2d  exists: " (file-
152b0 65 78 69 73 74 73 3f 20 6c 6f 67 2d 66 70 61 74  exists? log-fpat
152c0 68 29 29 0a 09 09 09 09 09 20 20 28 76 65 63 74  h))......  (vect
152d0 6f 72 2d 73 65 74 21 20 76 62 20 28 2b 20 37 20  or-set! vb (+ 7 
152e0 6e 75 6d 6b 65 79 73 29 20 28 69 66 20 28 66 69  numkeys) (if (fi
152f0 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6f 67 2d 66  le-exists? log-f
15300 70 61 74 68 29 0a 09 09 09 09 09 09 09 09 09 20  path).......... 
15310 20 20 20 28 6c 65 74 20 28 28 6e 65 77 70 61 74     (let ((newpat
15320 68 20 28 63 6f 6e 63 20 70 61 74 68 6d 6f 64 20  h (conc pathmod 
15330 22 2f 22 0a 09 09 09 09 09 09 09 09 09 09 09 09  "/".............
15340 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70   (string-intersp
15350 65 72 73 65 20 6b 65 79 76 61 6c 73 20 22 2f 22  erse keyvals "/"
15360 29 0a 09 09 09 09 09 09 09 09 09 09 09 09 20 22  )............. "
15370 2f 22 20 72 75 6e 6e 61 6d 65 20 22 2f 22 20 74  /" runname "/" t
15380 65 73 74 6e 61 6d 65 20 22 2f 22 0a 09 09 09 09  estname "/".....
15390 09 09 09 09 09 09 09 09 20 28 69 66 20 28 73 74  ........ (if (st
153a0 72 69 6e 67 3d 3f 20 69 74 65 6d 2d 70 61 74 68  ring=? item-path
153b0 20 22 22 29 20 22 22 20 28 63 6f 6e 63 20 22 2f   "") "" (conc "/
153c0 22 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 09  " item-path))...
153d0 09 09 09 09 09 09 09 09 09 09 20 66 69 6e 61 6c  .......... final
153e0 2d 6c 6f 67 29 29 29 0a 09 09 09 09 09 09 09 09  -log))).........
153f0 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 6e 6f  .      ;; for no
15400 77 20 74 68 72 6f 77 20 61 77 61 79 20 6e 65 77  w throw away new
15410 70 61 74 68 20 61 6e 64 20 75 73 65 20 74 68 65  path and use the
15420 20 6c 6f 67 2d 66 70 61 74 68 20 63 6f 6e 63 27   log-fpath conc'
15430 64 20 77 69 74 68 20 70 61 74 68 6d 6f 64 0a 09  d with pathmod..
15440 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 73  ........      (s
15450 65 74 21 20 6e 65 77 70 61 74 68 20 28 63 6f 6e  et! newpath (con
15460 63 20 70 61 74 68 6d 6f 64 20 6c 6f 67 2d 66 70  c pathmod log-fp
15470 61 74 68 29 29 0a 09 09 09 09 09 09 09 09 09 20  ath)).......... 
15480 20 20 20 20 20 28 69 66 20 77 69 6e 64 6f 77 73       (if windows
15490 20 28 73 74 72 69 6e 67 2d 74 72 61 6e 73 6c 61   (string-transla
154a0 74 65 20 6e 65 77 70 61 74 68 20 22 2f 22 20 22  te newpath "/" "
154b0 5c 5c 22 29 20 6e 65 77 70 61 74 68 29 29 0a 09  \\") newpath))..
154c0 09 09 09 09 09 09 09 09 20 20 20 20 28 69 66 20  ........    (if 
154d0 28 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64  (debug:debug-mod
154e0 65 20 31 29 0a 09 09 09 09 09 09 09 09 09 09 28  e 1)...........(
154f0 63 6f 6e 63 20 66 69 6e 61 6c 2d 6c 6f 67 20 22  conc final-log "
15500 20 6e 6f 74 2d 66 6f 75 6e 64 22 29 0a 09 09 09   not-found")....
15510 09 09 09 09 09 09 09 22 22 29 29 29 0a 09 09 09  ......."")))....
15520 09 09 20 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73  ..  (vector->lis
15530 74 20 76 62 29 29 0a 09 09 09 09 09 62 29 29 29  t vb))......b)))
15540 29 29 0a 09 20 20 20 64 62 0a 09 20 20 20 6d 61  ))..   db..   ma
15550 69 6e 71 72 79 0a 09 20 20 20 72 75 6e 73 70 61  inqry..   runspa
15560 74 74 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79  tt (map cadr key
15570 70 61 74 74 2d 61 6c 69 73 74 29 29 0a 20 20 20  patt-alist)).   
15580 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20   (debug:print 2 
15590 22 46 6f 75 6e 64 20 22 20 28 6c 65 6e 67 74 68  "Found " (length
155a0 20 74 65 73 74 2d 69 64 73 29 20 22 20 72 65 63   test-ids) " rec
155b0 6f 72 64 73 22 29 0a 20 20 20 20 28 73 65 74 21  ords").    (set!
155c0 20 72 65 73 75 6c 74 73 20 28 6c 69 73 74 20 28   results (list (
155d0 63 6f 6e 73 20 22 52 75 6e 73 22 20 72 65 73 75  cons "Runs" resu
155e0 6c 74 73 29 29 29 0a 20 20 20 20 3b 3b 20 6e 6f  lts))).    ;; no
155f0 77 2c 20 66 6f 72 20 65 61 63 68 20 74 65 73 74  w, for each test
15600 2c 20 63 6f 6c 6c 65 63 74 20 74 68 65 20 74 65  , collect the te
15610 73 74 5f 64 61 74 61 20 69 6e 66 6f 20 61 6e 64  st_data info and
15620 20 61 64 64 20 61 20 6e 65 77 20 73 68 65 65 74   add a new sheet
15630 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20  .    (for-each. 
15640 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73      (lambda (tes
15650 74 2d 69 64 29 0a 20 20 20 20 20 20 20 28 6c 65  t-id).       (le
15660 74 20 28 28 74 65 73 74 2d 64 61 74 61 20 28 6c  t ((test-data (l
15670 69 73 74 20 74 65 73 74 64 61 74 61 2d 68 65 61  ist testdata-hea
15680 64 65 72 29 29 0a 09 20 20 20 20 20 28 63 75 72  der))..     (cur
15690 72 2d 74 65 73 74 2d 6e 61 6d 65 20 23 66 29 29  r-test-name #f))
156a0 0a 09 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d  .. (sqlite3:for-
156b0 65 61 63 68 2d 72 6f 77 0a 09 20 20 28 6c 61 6d  each-row..  (lam
156c0 62 64 61 20 28 72 75 6e 2d 69 64 20 74 65 73 74  bda (run-id test
156d0 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 63  name item-path c
156e0 61 74 65 67 6f 72 79 20 76 61 72 69 61 62 6c 65  ategory variable
156f0 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 20   value expected 
15700 74 6f 6c 20 75 6e 69 74 73 20 73 74 61 74 75 73  tol units status
15710 20 63 6f 6d 6d 65 6e 74 29 0a 09 20 20 20 20 28   comment)..    (
15720 73 65 74 21 20 63 75 72 72 2d 74 65 73 74 2d 6e  set! curr-test-n
15730 61 6d 65 20 74 65 73 74 6e 61 6d 65 29 0a 09 20  ame testname).. 
15740 20 20 20 28 73 65 74 21 20 74 65 73 74 2d 64 61     (set! test-da
15750 74 61 20 28 61 70 70 65 6e 64 20 74 65 73 74 2d  ta (append test-
15760 64 61 74 61 20 28 6c 69 73 74 20 28 6c 69 73 74  data (list (list
15770 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65   run-id testname
15780 20 69 74 65 6d 2d 70 61 74 68 20 63 61 74 65 67   item-path categ
15790 6f 72 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c  ory variable val
157a0 75 65 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20  ue expected tol 
157b0 75 6e 69 74 73 20 73 74 61 74 75 73 20 63 6f 6d  units status com
157c0 6d 65 6e 74 29 29 29 29 29 0a 09 20 20 64 62 20  ment)))))..  db 
157d0 0a 09 20 20 3b 3b 20 22 53 45 4c 45 43 54 20 72  ..  ;; "SELECT r
157e0 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69  un_id,testname,i
157f0 74 65 6d 5f 70 61 74 68 2c 63 61 74 65 67 6f 72  tem_path,categor
15800 79 2c 76 61 72 69 61 62 6c 65 2c 74 64 2e 76 61  y,variable,td.va
15810 6c 75 65 20 41 53 20 76 61 6c 75 65 2c 65 78 70  lue AS value,exp
15820 65 63 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 73 2c  ected,tol,units,
15830 74 64 2e 73 74 61 74 75 73 20 41 53 20 73 74 61  td.status AS sta
15840 74 75 73 2c 74 64 2e 63 6f 6d 6d 65 6e 74 20 41  tus,td.comment A
15850 53 20 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74  S comment FROM t
15860 65 73 74 5f 64 61 74 61 20 41 53 20 74 64 20 49  est_data AS td I
15870 4e 4e 45 52 20 4a 4f 49 4e 20 74 65 73 74 73 20  NNER JOIN tests 
15880 4f 4e 20 74 65 73 74 73 2e 69 64 3d 74 64 2e 74  ON tests.id=td.t
15890 65 73 74 5f 69 64 20 57 48 45 52 45 20 74 65 73  est_id WHERE tes
158a0 74 5f 69 64 3d 3f 3b 22 0a 09 20 20 22 53 45 4c  t_id=?;"..  "SEL
158b0 45 43 54 20 72 75 6e 5f 69 64 2c 74 65 73 74 6e  ECT run_id,testn
158c0 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2c 63 61  ame,item_path,ca
158d0 74 65 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c  tegory,variable,
158e0 74 64 2e 76 61 6c 75 65 20 41 53 20 76 61 6c 75  td.value AS valu
158f0 65 2c 74 64 2e 65 78 70 65 63 74 65 64 2c 74 64  e,td.expected,td
15900 2e 74 6f 6c 2c 74 64 2e 75 6e 69 74 73 2c 74 64  .tol,td.units,td
15910 2e 73 74 61 74 75 73 20 41 53 20 73 74 61 74 75  .status AS statu
15920 73 2c 74 64 2e 63 6f 6d 6d 65 6e 74 20 41 53 20  s,td.comment AS 
15930 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73  comment FROM tes
15940 74 5f 64 61 74 61 20 41 53 20 74 64 20 49 4e 4e  t_data AS td INN
15950 45 52 20 4a 4f 49 4e 20 74 65 73 74 73 20 4f 4e  ER JOIN tests ON
15960 20 74 65 73 74 73 2e 69 64 3d 74 64 2e 74 65 73   tests.id=td.tes
15970 74 5f 69 64 20 57 48 45 52 45 20 74 65 73 74 6e  t_id WHERE testn
15980 61 6d 65 3d 3f 3b 22 0a 09 20 20 74 65 73 74 2d  ame=?;"..  test-
15990 69 64 29 0a 09 20 28 69 66 20 63 75 72 72 2d 74  id).. (if curr-t
159a0 65 73 74 2d 6e 61 6d 65 0a 09 20 20 20 20 20 28  est-name..     (
159b0 73 65 74 21 20 72 65 73 75 6c 74 73 20 28 61 70  set! results (ap
159c0 70 65 6e 64 20 72 65 73 75 6c 74 73 20 28 6c 69  pend results (li
159d0 73 74 20 28 63 6f 6e 73 20 63 75 72 72 2d 74 65  st (cons curr-te
159e0 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d 64 61 74  st-name test-dat
159f0 61 29 29 29 29 29 0a 09 20 29 29 0a 20 20 20 20  a))))).. )).    
15a00 20 28 73 6f 72 74 20 28 64 65 6c 65 74 65 2d 64   (sort (delete-d
15a10 75 70 6c 69 63 61 74 65 73 20 74 65 73 74 2d 69  uplicates test-i
15a20 64 73 29 20 73 74 72 69 6e 67 3c 3d 29 29 0a 20  ds) string<=)). 
15a30 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63     (system (conc
15a40 20 22 6d 6b 64 69 72 20 2d 70 20 22 20 74 65 6d   "mkdir -p " tem
15a50 70 64 69 72 29 29 0a 20 20 20 20 3b 3b 20 28 70  pdir)).    ;; (p
15a60 70 20 72 65 73 75 6c 74 73 29 0a 20 20 20 20 28  p results).    (
15a70 6f 64 73 3a 6c 69 73 74 2d 3e 6f 64 73 20 0a 20  ods:list->ods . 
15a80 20 20 20 20 74 65 6d 70 64 69 72 0a 20 20 20 20      tempdir.    
15a90 20 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74   (if (string-mat
15aa0 63 68 20 28 72 65 67 65 78 70 20 22 5e 5b 2f 7e  ch (regexp "^[/~
15ab0 5d 2b 2e 2a 22 29 20 6f 75 74 70 75 74 66 69 6c  ]+.*") outputfil
15ac0 65 29 20 3b 3b 20 66 75 6c 6c 20 70 61 74 68 3f  e) ;; full path?
15ad0 0a 09 20 6f 75 74 70 75 74 66 69 6c 65 0a 09 20  .. outputfile.. 
15ae0 28 62 65 67 69 6e 0a 09 20 20 20 28 64 65 62 75  (begin..   (debu
15af0 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49  g:print 0 "WARNI
15b00 4e 47 3a 20 70 61 74 68 20 67 69 76 65 6e 2c 20  NG: path given, 
15b10 22 20 6f 75 74 70 75 74 66 69 6c 65 20 22 20 69  " outputfile " i
15b20 73 20 72 65 6c 61 74 69 76 65 2c 20 70 72 65 66  s relative, pref
15b30 69 78 69 6e 67 20 77 69 74 68 20 63 75 72 72 65  ixing with curre
15b40 6e 74 20 64 69 72 65 63 74 6f 72 79 22 29 0a 09  nt directory")..
15b50 20 20 20 28 63 6f 6e 63 20 28 63 75 72 72 65 6e     (conc (curren
15b60 74 2d 64 69 72 65 63 74 6f 72 79 29 20 22 2f 22  t-directory) "/"
15b70 20 6f 75 74 70 75 74 66 69 6c 65 29 29 29 0a 20   outputfile))). 
15b80 20 20 20 20 72 65 73 75 6c 74 73 29 0a 20 20 20      results).   
15b90 20 3b 3b 20 62 72 75 74 61 6c 20 63 6c 65 61 6e   ;; brutal clean
15ba0 20 75 70 0a 20 20 20 20 28 73 79 73 74 65 6d 20   up.    (system 
15bb0 22 72 6d 20 2d 72 66 20 74 65 6d 70 64 69 72 22  "rm -rf tempdir"
15bc0 29 29 29 0a 0a 3b 3b 20 28 64 62 3a 65 78 74 72  )))..;; (db:extr
15bd0 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 20  act-ods-file db 
15be0 22 6f 75 74 70 75 74 66 69 6c 65 2e 6f 64 73 22  "outputfile.ods"
15bf0 20 27 28 28 22 73 79 73 6e 61 6d 65 22 20 22 25   '(("sysname" "%
15c00 22 29 28 22 66 73 6e 61 6d 65 22 20 22 25 22 29  ")("fsname" "%")
15c10 28 22 64 61 74 61 70 61 74 68 22 20 22 25 22 29  ("datapath" "%")
15c20 29 20 22 25 22 29 0a                             ) "%").